diff options
| author | Chong Yidong | 2011-01-02 15:31:19 -0500 |
|---|---|---|
| committer | Chong Yidong | 2011-01-02 15:31:19 -0500 |
| commit | 7c420169baa7c50428589cca7f8eda71b462eb15 (patch) | |
| tree | b556f9e181818bbaf8b5b425844b4ae26e88f537 /lisp | |
| parent | bb7f5cbcda931661c8dc3311603ac764fa87a639 (diff) | |
| parent | d12f22f52cb7bb18b46f5ea8de5d8e8e04733e3f (diff) | |
| download | emacs-7c420169baa7c50428589cca7f8eda71b462eb15.tar.gz emacs-7c420169baa7c50428589cca7f8eda71b462eb15.zip | |
Merge changes from emacs-23 branch
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 118 | ||||
| -rw-r--r-- | lisp/emulation/edt-mapper.el | 42 | ||||
| -rw-r--r-- | lisp/eshell/em-hist.el | 4 | ||||
| -rw-r--r-- | lisp/files.el | 5 | ||||
| -rw-r--r-- | lisp/help-fns.el | 14 | ||||
| -rw-r--r-- | lisp/isearch.el | 7 | ||||
| -rw-r--r-- | lisp/mail/binhex.el | 7 | ||||
| -rw-r--r-- | lisp/mail/mail-utils.el | 40 | ||||
| -rw-r--r-- | lisp/mail/rmail.el | 137 | ||||
| -rw-r--r-- | lisp/mail/rmailmm.el | 998 | ||||
| -rw-r--r-- | lisp/mail/smtpmail.el | 9 | ||||
| -rw-r--r-- | lisp/term/w32-win.el | 30 | ||||
| -rw-r--r-- | lisp/textmodes/rst.el | 4 | ||||
| -rw-r--r-- | lisp/time.el | 4 | ||||
| -rw-r--r-- | lisp/version.el | 3 |
15 files changed, 1062 insertions, 360 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8e693845a4f..d1bcb77882f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,119 @@ | |||
| 1 | 2011-01-02 Eli Zaretskii <eliz@gnu.org> | ||
| 2 | |||
| 3 | * term/w32-win.el (dynamic-library-alist): Set up correctly for | ||
| 4 | libpng versions both before and after 1.4.0. (Bug#7716) | ||
| 5 | |||
| 6 | 2011-01-02 Eli Zaretskii <eliz@gnu.org> | ||
| 7 | |||
| 8 | * time.el (display-time-mode): Mention display-time-interval in | ||
| 9 | the doc string. (Bug#7713) | ||
| 10 | |||
| 11 | 2011-01-02 Kenichi Handa <handa@m17n.org> | ||
| 12 | |||
| 13 | * mail/rmailmm.el (rmail-mime-parse): Perform parsing in | ||
| 14 | condition-case and return an error message string if something | ||
| 15 | goes wrong. | ||
| 16 | (rmail-show-mime): Adjust for the above change. Insert the | ||
| 17 | header by rmail-mime-insert-header. | ||
| 18 | |||
| 19 | 2011-01-02 Kenichi Handa <handa@m17n.org> | ||
| 20 | |||
| 21 | * mail/rmailmm.el: New key bindings for rmail-mime-next-item, | ||
| 22 | rmail-mime-previous-item, and rmail-mime-toggle-hidden. | ||
| 23 | (rmail-mime-mbox-buffer) | ||
| 24 | (rmail-mime-view-buffer, rmail-mime-coding-system): New variables. | ||
| 25 | (rmail-mime-entity): Argument changed. All codes handling an | ||
| 26 | entity object are changed. | ||
| 27 | (rmail-mime-entity-header, rmail-mime-entity-body): Adjust for | ||
| 28 | the above change. | ||
| 29 | (rmail-mime-entity-children, rmail-mime-entity-handler) | ||
| 30 | (rmail-mime-entity-tagline): New functions. | ||
| 31 | (rmail-mime-message-p): New function. | ||
| 32 | (rmail-mime-save): Bind rmail-mime-mbox-buffer. | ||
| 33 | (rmail-mime-entity-segment, rmail-mime-next-item) | ||
| 34 | (rmail-mime-previous-item, rmail-mime-shown-mode) | ||
| 35 | (rmail-mime-hidden-mode, rmail-mime-raw-mode) | ||
| 36 | (rmail-mime-toggle-raw, rmail-mime-toggle-hidden) | ||
| 37 | (rmail-mime-insert-tagline, rmail-mime-insert-header): | ||
| 38 | New functions. | ||
| 39 | (rmail-mime-text-handler): Call rmail-mime-insert-text. | ||
| 40 | (rmail-mime-insert-decoded-text): New function. | ||
| 41 | (rmail-mime-insert-text): Call rmail-mime-insert-decoded-text. | ||
| 42 | (rmail-mime-insert-image): Argument changed. Caller changed. | ||
| 43 | (rmail-mime-image): Call rmail-mime-toggle-hidden. | ||
| 44 | (rmail-mime-set-bulk-data): New funciton. | ||
| 45 | (rmail-mime-insert-bulk): Argument changed. | ||
| 46 | (rmail-mime-multipart-handler): Return t. | ||
| 47 | (rmail-mime-process-multipart): Argument changed. | ||
| 48 | Handle "multipart/alternative" here. | ||
| 49 | (rmail-mime-process): Argument changed. | ||
| 50 | (rmail-mime-parse): Bind rmail-mime-mbox-buffer. | ||
| 51 | (rmail-mime-insert): Argument changed. Handle raw display mode. | ||
| 52 | (rmail-mime): Argument changed. Handle toggling of raw display | ||
| 53 | mode. | ||
| 54 | (rmail-show-mime): Bind rmail-mime-mbox-buffer and | ||
| 55 | rmail-mime-view-buffer. | ||
| 56 | (rmail-insert-mime-forwarded-message): Likewise. | ||
| 57 | (rmail-search-mime-message): Likewise. Don't bind rmail-buffer. | ||
| 58 | |||
| 59 | * mail/rmail.el (rmail-show-message-1): If rmail-enable-mime is | ||
| 60 | non-nil, handle the header in rmail-show-mime-function. | ||
| 61 | |||
| 62 | 2011-01-02 Leo <sdl.web@gmail.com> | ||
| 63 | |||
| 64 | * help-fns.el (describe-variable): Fix previous change. | ||
| 65 | |||
| 66 | 2011-01-02 Juri Linkov <juri@jurta.org> | ||
| 67 | |||
| 68 | * isearch.el (isearch-lazy-highlight-error): New variable. | ||
| 69 | (isearch-lazy-highlight-new-loop): Compare `isearch-error' and | ||
| 70 | `isearch-lazy-highlight-error'. Set `isearch-lazy-highlight-error' | ||
| 71 | to the current value of `isearch-error' (Bug#7468). | ||
| 72 | |||
| 73 | 2011-01-02 Chong Yidong <cyd@stupidchicken.com> | ||
| 74 | |||
| 75 | * help-fns.el (describe-variable): Don't emit trailing whitespace | ||
| 76 | (Bug#7511). | ||
| 77 | |||
| 78 | 2011-01-02 Chong Yidong <cyd@stupidchicken.com> | ||
| 79 | |||
| 80 | * textmodes/rst.el (rst-compile-pdf-preview) | ||
| 81 | (rst-compile-slides-preview): Use make-temp-file (Bug#7646). | ||
| 82 | |||
| 83 | 2011-01-02 Kevin Gallagher <Kevin.Gallagher@boeing.com> | ||
| 84 | |||
| 85 | * emulation/edt-mapper.el: Override mapping of function keys so | ||
| 86 | that the later call to read-key-sequence works. | ||
| 87 | |||
| 88 | 2011-01-02 Eli Zaretskii <eliz@gnu.org> | ||
| 89 | |||
| 90 | * mail/smtpmail.el (smtpmail-send-it): Write queued mail body with | ||
| 91 | Unix EOLs. (Bug#7589) | ||
| 92 | |||
| 93 | 2011-01-02 Leo <sdl.web@gmail.com> | ||
| 94 | |||
| 95 | * eshell/em-hist.el (eshell-previous-matching-input): Signal error | ||
| 96 | if point is not behind eshell-last-output-end (Bug#7585). | ||
| 97 | |||
| 98 | 2011-01-02 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 99 | |||
| 100 | * files.el (file-local-variables-alist): | ||
| 101 | Make permanent-local (bug#7767). | ||
| 102 | |||
| 103 | 2011-01-02 Glenn Morris <rgm@gnu.org> | ||
| 104 | |||
| 105 | * version.el (emacs-copyright): Set short copyright year to 2011. | ||
| 106 | |||
| 107 | 2011-01-02 Mark Lillibridge <mark.lillibridge@hp.com> (tiny change) | ||
| 108 | |||
| 109 | * mail/mail-utils.el (mail-strip-quoted-names): Avoid clobbering | ||
| 110 | an existing temp buffer. (Bug#7746) | ||
| 111 | |||
| 112 | 2011-01-02 Glenn Morris <rgm@gnu.org> | ||
| 113 | |||
| 114 | * mail/mail-utils.el (mail-mbox-from): Handle From: headers with | ||
| 115 | multiple addresses. (Bug#7760) | ||
| 116 | |||
| 1 | 2010-12-31 Michael Albinus <michael.albinus@gmx.de> | 117 | 2010-12-31 Michael Albinus <michael.albinus@gmx.de> |
| 2 | 118 | ||
| 3 | * net/tramp-sh.el (tramp-methods): Add recursive options to "scpc" | 119 | * net/tramp-sh.el (tramp-methods): Add recursive options to "scpc" |
| @@ -20285,7 +20401,7 @@ See ChangeLog.14 for earlier changes. | |||
| 20285 | ;; coding: utf-8 | 20401 | ;; coding: utf-8 |
| 20286 | ;; End: | 20402 | ;; End: |
| 20287 | 20403 | ||
| 20288 | Copyright (C) 2009, 2010 Free Software Foundation, Inc. | 20404 | Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. |
| 20289 | 20405 | ||
| 20290 | This file is part of GNU Emacs. | 20406 | This file is part of GNU Emacs. |
| 20291 | 20407 | ||
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index 6bf50db5442..09b28cca7fe 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el | |||
| @@ -142,6 +142,48 @@ | |||
| 142 | (setq edt-term (getenv "TERM"))) | 142 | (setq edt-term (getenv "TERM"))) |
| 143 | 143 | ||
| 144 | ;;; | 144 | ;;; |
| 145 | ;;; Implements a workaround for a feature that was added to simple.el. | ||
| 146 | ;;; | ||
| 147 | ;;; Many function keys have no Emacs functions assigned to them by | ||
| 148 | ;;; default. A subset of these are typically assigned functions in the | ||
| 149 | ;;; EDT emulation. This includes all the keypad keys and a some others | ||
| 150 | ;;; like Delete. | ||
| 151 | ;;; | ||
| 152 | ;;; Logic in simple.el maps some of these unassigned function keys to | ||
| 153 | ;;; ordinary typing keys. Where this is the case, a call to | ||
| 154 | ;;; read-key-sequence, below, does not return the name of the function | ||
| 155 | ;;; key pressd by the user but, instead, it returns the name of the | ||
| 156 | ;;; key to which it has been mapped. It needs to know the name of the | ||
| 157 | ;;; key pressed by the user. As a workaround, we assign a function to | ||
| 158 | ;;; each of the unassigned function keys of interest, here. These | ||
| 159 | ;;; assignments override the mapping to other keys and are only | ||
| 160 | ;;; temporary since, when edt-mapper is finished executing, it causes | ||
| 161 | ;;; Emacs to exit. | ||
| 162 | ;;; | ||
| 163 | |||
| 164 | (mapc | ||
| 165 | (lambda (function-key) | ||
| 166 | (if (not (lookup-key (current-global-map) function-key)) | ||
| 167 | (define-key (current-global-map) function-key 'forward-char))) | ||
| 168 | '([kp-0] [kp-1] [kp-2] [kp-3] [kp-4] | ||
| 169 | [kp-5] [kp-6] [kp-7] [kp-8] [kp-9] | ||
| 170 | [kp-space] | ||
| 171 | [kp-tab] | ||
| 172 | [kp-enter] | ||
| 173 | [kp-multiply] | ||
| 174 | [kp-add] | ||
| 175 | [kp-separator] | ||
| 176 | [kp-subtract] | ||
| 177 | [kp-decimal] | ||
| 178 | [kp-divide] | ||
| 179 | [kp-equal] | ||
| 180 | [backspace] | ||
| 181 | [delete] | ||
| 182 | [tab] | ||
| 183 | [linefeed] | ||
| 184 | [clear])) | ||
| 185 | |||
| 186 | ;;; | ||
| 145 | ;;; Make sure the window is big enough to display the instructions, | 187 | ;;; Make sure the window is big enough to display the instructions, |
| 146 | ;;; except where window cannot be re-sized. | 188 | ;;; except where window cannot be re-sized. |
| 147 | ;;; | 189 | ;;; |
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 1f644261337..82c9b0ccfc3 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el | |||
| @@ -837,6 +837,8 @@ With prefix argument N, search for Nth previous match. | |||
| 837 | If N is negative, find the next or Nth next match." | 837 | If N is negative, find the next or Nth next match." |
| 838 | (interactive (eshell-regexp-arg "Previous input matching (regexp): ")) | 838 | (interactive (eshell-regexp-arg "Previous input matching (regexp): ")) |
| 839 | (setq arg (eshell-search-arg arg)) | 839 | (setq arg (eshell-search-arg arg)) |
| 840 | (if (> eshell-last-output-end (point)) | ||
| 841 | (error "Point not located after prompt")) | ||
| 840 | (let ((pos (eshell-previous-matching-input-string-position regexp arg))) | 842 | (let ((pos (eshell-previous-matching-input-string-position regexp arg))) |
| 841 | ;; Has a match been found? | 843 | ;; Has a match been found? |
| 842 | (if (null pos) | 844 | (if (null pos) |
| @@ -844,7 +846,7 @@ If N is negative, find the next or Nth next match." | |||
| 844 | (setq eshell-history-index pos) | 846 | (setq eshell-history-index pos) |
| 845 | (unless (minibuffer-window-active-p (selected-window)) | 847 | (unless (minibuffer-window-active-p (selected-window)) |
| 846 | (message "History item: %d" (- (ring-length eshell-history-ring) pos))) | 848 | (message "History item: %d" (- (ring-length eshell-history-ring) pos))) |
| 847 | ;; Can't use kill-region as it sets this-command | 849 | ;; Can't use kill-region as it sets this-command |
| 848 | (delete-region eshell-last-output-end (point)) | 850 | (delete-region eshell-last-output-end (point)) |
| 849 | (insert-and-inherit (eshell-get-history pos))))) | 851 | (insert-and-inherit (eshell-get-history pos))))) |
| 850 | 852 | ||
diff --git a/lisp/files.el b/lisp/files.el index 76526de1c0a..1383c90dcb6 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -1,8 +1,8 @@ | |||
| 1 | ;;; files.el --- file input and output commands for Emacs | 1 | ;;; files.el --- file input and output commands for Emacs |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, | 3 | ;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, |
| 4 | ;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, | 4 | ;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, |
| 5 | ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 5 | ;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
| 6 | 6 | ||
| 7 | ;; Maintainer: FSF | 7 | ;; Maintainer: FSF |
| 8 | ;; Package: emacs | 8 | ;; Package: emacs |
| @@ -2876,6 +2876,7 @@ is a file-local variable (a symbol) and VALUE is the value | |||
| 2876 | specified. The actual value in the buffer may differ from VALUE, | 2876 | specified. The actual value in the buffer may differ from VALUE, |
| 2877 | if it is changed by the major or minor modes, or by the user.") | 2877 | if it is changed by the major or minor modes, or by the user.") |
| 2878 | (make-variable-buffer-local 'file-local-variables-alist) | 2878 | (make-variable-buffer-local 'file-local-variables-alist) |
| 2879 | (put 'file-local-variables-alist 'permanent-local t) | ||
| 2879 | 2880 | ||
| 2880 | (defvar dir-local-variables-alist nil | 2881 | (defvar dir-local-variables-alist nil |
| 2881 | "Alist of directory-local variable settings in the current buffer. | 2882 | "Alist of directory-local variable settings in the current buffer. |
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index b100a4e471d..9b8e7f1458c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -639,19 +639,16 @@ it is displayed along with the global value." | |||
| 639 | (if valvoid | 639 | (if valvoid |
| 640 | (princ " is void as a variable.") | 640 | (princ " is void as a variable.") |
| 641 | (princ "'s ")))) | 641 | (princ "'s ")))) |
| 642 | (if valvoid | 642 | (unless valvoid |
| 643 | nil | ||
| 644 | (with-current-buffer standard-output | 643 | (with-current-buffer standard-output |
| 645 | (setq val-start-pos (point)) | 644 | (setq val-start-pos (point)) |
| 646 | (princ "value is ") | 645 | (princ "value is ") |
| 647 | (terpri) | ||
| 648 | (let ((from (point))) | 646 | (let ((from (point))) |
| 647 | (terpri) | ||
| 649 | (pp val) | 648 | (pp val) |
| 650 | ;; Hyperlinks in variable's value are quite frequently | 649 | (if (< (point) (+ 68 (line-beginning-position 0))) |
| 651 | ;; inappropriate e.g C-h v <RET> features <RET> | 650 | (delete-region from (1+ from)) |
| 652 | ;; (help-xref-on-pp from (point)) | 651 | (delete-region (1- from) from)) |
| 653 | (if (< (point) (+ from 20)) | ||
| 654 | (delete-region (1- from) from)) | ||
| 655 | (let* ((sv (get variable 'standard-value)) | 652 | (let* ((sv (get variable 'standard-value)) |
| 656 | (origval (and (consp sv) | 653 | (origval (and (consp sv) |
| 657 | (condition-case nil | 654 | (condition-case nil |
| @@ -666,7 +663,6 @@ it is displayed along with the global value." | |||
| 666 | (if (< (point) (+ from 20)) | 663 | (if (< (point) (+ from 20)) |
| 667 | (delete-region (1- from) from))))))) | 664 | (delete-region (1- from) from))))))) |
| 668 | (terpri) | 665 | (terpri) |
| 669 | |||
| 670 | (when locus | 666 | (when locus |
| 671 | (if (bufferp locus) | 667 | (if (bufferp locus) |
| 672 | (princ (format "%socal in buffer %s; " | 668 | (princ (format "%socal in buffer %s; " |
diff --git a/lisp/isearch.el b/lisp/isearch.el index ebe2e8fa009..70508735f83 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el | |||
| @@ -2581,6 +2581,7 @@ since they have special meaning in a regexp." | |||
| 2581 | (defvar isearch-lazy-highlight-regexp nil) | 2581 | (defvar isearch-lazy-highlight-regexp nil) |
| 2582 | (defvar isearch-lazy-highlight-space-regexp nil) | 2582 | (defvar isearch-lazy-highlight-space-regexp nil) |
| 2583 | (defvar isearch-lazy-highlight-forward nil) | 2583 | (defvar isearch-lazy-highlight-forward nil) |
| 2584 | (defvar isearch-lazy-highlight-error nil) | ||
| 2584 | 2585 | ||
| 2585 | (defun lazy-highlight-cleanup (&optional force) | 2586 | (defun lazy-highlight-cleanup (&optional force) |
| 2586 | "Stop lazy highlighting and remove extra highlighting from current buffer. | 2587 | "Stop lazy highlighting and remove extra highlighting from current buffer. |
| @@ -2622,9 +2623,13 @@ by other Emacs features." | |||
| 2622 | (not (= (window-end) ; Window may have been split/joined. | 2623 | (not (= (window-end) ; Window may have been split/joined. |
| 2623 | isearch-lazy-highlight-window-end)) | 2624 | isearch-lazy-highlight-window-end)) |
| 2624 | (not (eq isearch-forward | 2625 | (not (eq isearch-forward |
| 2625 | isearch-lazy-highlight-forward)))) | 2626 | isearch-lazy-highlight-forward)) |
| 2627 | ;; In case we are recovering from an error. | ||
| 2628 | (not (equal isearch-error | ||
| 2629 | isearch-lazy-highlight-error)))) | ||
| 2626 | ;; something important did indeed change | 2630 | ;; something important did indeed change |
| 2627 | (lazy-highlight-cleanup t) ;kill old loop & remove overlays | 2631 | (lazy-highlight-cleanup t) ;kill old loop & remove overlays |
| 2632 | (setq isearch-lazy-highlight-error isearch-error) | ||
| 2628 | (when (not isearch-error) | 2633 | (when (not isearch-error) |
| 2629 | (setq isearch-lazy-highlight-start-limit beg | 2634 | (setq isearch-lazy-highlight-start-limit beg |
| 2630 | isearch-lazy-highlight-end-limit end) | 2635 | isearch-lazy-highlight-end-limit end) |
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index 42d2f35baed..d866fed371e 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; binhex.el --- elisp native binhex decode | 1 | ;;; binhex.el --- decode BinHex-encoded text |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 3 | ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
| @@ -23,6 +23,11 @@ | |||
| 23 | 23 | ||
| 24 | ;;; Commentary: | 24 | ;;; Commentary: |
| 25 | 25 | ||
| 26 | ;; BinHex is a binary-to-text encoding scheme similar to uuencode. | ||
| 27 | ;; The command `binhex-decode-region' decodes BinHex-encoded text, via | ||
| 28 | ;; the external program "hexbin" if that is available, or an Emacs | ||
| 29 | ;; Lisp implementation if not. | ||
| 30 | |||
| 26 | ;;; Code: | 31 | ;;; Code: |
| 27 | 32 | ||
| 28 | (eval-when-compile (require 'cl)) | 33 | (eval-when-compile (require 'cl)) |
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index a8d845146f6..81a2bd49441 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; mail-utils.el --- utility functions used both by rmail and rnews | 1 | ;;; mail-utils.el --- utility functions used both by rmail and rnews |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, | 3 | ;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, |
| 4 | ;; 2009, 2010 Free Software Foundation, Inc. | 4 | ;; 2009, 2010, 2011 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Maintainer: FSF | 6 | ;; Maintainer: FSF |
| 7 | ;; Keywords: mail, news | 7 | ;; Keywords: mail, news |
| @@ -185,8 +185,7 @@ Return a modified address list." | |||
| 185 | ;; Detect nested comments. | 185 | ;; Detect nested comments. |
| 186 | (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) | 186 | (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) |
| 187 | ;; Strip nested comments. | 187 | ;; Strip nested comments. |
| 188 | (with-current-buffer (get-buffer-create " *temp*") | 188 | (with-temp-buffer |
| 189 | (erase-buffer) | ||
| 190 | (insert address) | 189 | (insert address) |
| 191 | (set-syntax-table lisp-mode-syntax-table) | 190 | (set-syntax-table lisp-mode-syntax-table) |
| 192 | (goto-char 1) | 191 | (goto-char 1) |
| @@ -199,8 +198,7 @@ Return a modified address list." | |||
| 199 | (forward-sexp 1) | 198 | (forward-sexp 1) |
| 200 | (error (goto-char (point-max)))) | 199 | (error (goto-char (point-max)))) |
| 201 | (point)))) | 200 | (point)))) |
| 202 | (setq address (buffer-string)) | 201 | (setq address (buffer-string))) |
| 203 | (erase-buffer)) | ||
| 204 | ;; Strip non-nested comments an easier way. | 202 | ;; Strip non-nested comments an easier way. |
| 205 | (while (setq pos (string-match | 203 | (while (setq pos (string-match |
| 206 | ;; This doesn't hack rfc822 nested comments | 204 | ;; This doesn't hack rfc822 nested comments |
| @@ -235,12 +233,12 @@ Return a modified address list." | |||
| 235 | nil 'literal address 2))) | 233 | nil 'literal address 2))) |
| 236 | address)))) | 234 | address)))) |
| 237 | 235 | ||
| 238 | ;;; The following piece of ugliness is legacy code. The name was an | 236 | ;; The following piece of ugliness is legacy code. The name was an |
| 239 | ;;; unfortunate choice --- a flagrant violation of the Emacs Lisp | 237 | ;; unfortunate choice --- a flagrant violation of the Emacs Lisp |
| 240 | ;;; coding conventions. `mail-dont-reply-to' would have been | 238 | ;; coding conventions. `mail-dont-reply-to' would have been |
| 241 | ;;; infinitely better. Also, `rmail-dont-reply-to-names' might have | 239 | ;; infinitely better. Also, `rmail-dont-reply-to-names' might have |
| 242 | ;;; been better named `mail-dont-reply-to-names' and sourced from this | 240 | ;; been better named `mail-dont-reply-to-names' and sourced from this |
| 243 | ;;; file instead of in rmail.el. Yuck. -pmr | 241 | ;; file instead of in rmail.el. Yuck. -pmr |
| 244 | (defun rmail-dont-reply-to (destinations) | 242 | (defun rmail-dont-reply-to (destinations) |
| 245 | "Prune addresses from DESTINATIONS, a list of recipient addresses. | 243 | "Prune addresses from DESTINATIONS, a list of recipient addresses. |
| 246 | All addresses matching `rmail-dont-reply-to-names' are removed from | 244 | All addresses matching `rmail-dont-reply-to-names' are removed from |
| @@ -394,13 +392,19 @@ matches may be returned from the message body." | |||
| 394 | (defun mail-mbox-from () | 392 | (defun mail-mbox-from () |
| 395 | "Return an mbox \"From \" line for the current message. | 393 | "Return an mbox \"From \" line for the current message. |
| 396 | The buffer should be narrowed to just the header." | 394 | The buffer should be narrowed to just the header." |
| 397 | (let ((from (or (mail-fetch-field "from") | 395 | (let* ((from (mail-strip-quoted-names (or (mail-fetch-field "from") |
| 398 | (mail-fetch-field "really-from") | 396 | (mail-fetch-field "really-from") |
| 399 | (mail-fetch-field "sender") | 397 | (mail-fetch-field "sender") |
| 400 | (mail-fetch-field "return-path") | 398 | (mail-fetch-field "return-path") |
| 401 | "unknown")) | 399 | "unknown"))) |
| 402 | (date (mail-fetch-field "date"))) | 400 | (date (mail-fetch-field "date")) |
| 403 | (format "From %s %s\n" (mail-strip-quoted-names from) | 401 | ;; A From: header can contain multiple addresses, a "From " |
| 402 | ;; line must contain only one. (Bug#7760) | ||
| 403 | ;; See eg RFC 5322, 3.6.2. Originator Fields. | ||
| 404 | (end (string-match "[ \t]*[,\n]" from))) | ||
| 405 | (format "From %s %s\n" (if end | ||
| 406 | (substring from 0 end) | ||
| 407 | from) | ||
| 404 | (or (and date | 408 | (or (and date |
| 405 | (ignore-errors | 409 | (ignore-errors |
| 406 | (current-time-string (date-to-time date)))) | 410 | (current-time-string (date-to-time date)))) |
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7b896e579bc..250481c20b5 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el | |||
| @@ -2691,75 +2691,72 @@ The current mail message becomes the message displayed." | |||
| 2691 | (message "Showing message %d" msg)) | 2691 | (message "Showing message %d" msg)) |
| 2692 | (narrow-to-region beg end) | 2692 | (narrow-to-region beg end) |
| 2693 | (goto-char beg) | 2693 | (goto-char beg) |
| 2694 | (if (and rmail-enable-mime | ||
| 2695 | (re-search-forward "mime-version: 1.0" nil t)) | ||
| 2696 | (let ((rmail-buffer mbox-buf) | ||
| 2697 | (rmail-view-buffer view-buf)) | ||
| 2698 | (funcall rmail-show-mime-function)) | ||
| 2699 | (setq body-start (search-forward "\n\n" nil t)) | ||
| 2700 | (narrow-to-region beg (point)) | ||
| 2701 | (goto-char beg) | ||
| 2702 | (save-excursion | ||
| 2703 | (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) | ||
| 2704 | (setq coding-system (intern (match-string 1))) | ||
| 2705 | (setq coding-system (rmail-get-coding-system)))) | ||
| 2706 | (setq character-coding (mail-fetch-field "content-transfer-encoding") | ||
| 2707 | is-text-message (rmail-is-text-p)) | ||
| 2708 | (if character-coding | ||
| 2709 | (setq character-coding (downcase character-coding))) | ||
| 2710 | (narrow-to-region beg end) | ||
| 2711 | ;; Decode the message body into an empty view buffer using a | ||
| 2712 | ;; unibyte temporary buffer where the character decoding takes | ||
| 2713 | ;; place. | ||
| 2714 | (with-current-buffer rmail-view-buffer | ||
| 2715 | (erase-buffer)) | ||
| 2716 | (if (null character-coding) | ||
| 2717 | ;; Do it directly since that is fast. | ||
| 2718 | (rmail-decode-region body-start end coding-system view-buf) | ||
| 2719 | ;; Can this be done directly, skipping the temp buffer? | ||
| 2720 | (with-temp-buffer | ||
| 2721 | (set-buffer-multibyte nil) | ||
| 2722 | (insert-buffer-substring mbox-buf body-start end) | ||
| 2723 | (cond | ||
| 2724 | ((string= character-coding "quoted-printable") | ||
| 2725 | ;; See bug#5441. | ||
| 2726 | (or (mail-unquote-printable-region (point-min) (point-max) | ||
| 2727 | nil t 'unibyte) | ||
| 2728 | (message "Malformed MIME quoted-printable message"))) | ||
| 2729 | ((and (string= character-coding "base64") is-text-message) | ||
| 2730 | (condition-case err | ||
| 2731 | (base64-decode-region (point-min) (point-max)) | ||
| 2732 | (error (message "%s" (cdr err))))) | ||
| 2733 | ((eq character-coding 'uuencode) | ||
| 2734 | (error "uuencoded messages are not supported yet")) | ||
| 2735 | (t)) | ||
| 2736 | (rmail-decode-region (point-min) (point-max) | ||
| 2737 | coding-system view-buf)))) | ||
| 2738 | (with-current-buffer rmail-view-buffer | 2694 | (with-current-buffer rmail-view-buffer |
| 2739 | ;; We give the view buffer a buffer-local value of | 2695 | ;; We give the view buffer a buffer-local value of |
| 2740 | ;; rmail-header-style based on the binding in effect when | 2696 | ;; rmail-header-style based on the binding in effect when |
| 2741 | ;; this function is called; `rmail-toggle-headers' can | 2697 | ;; this function is called; `rmail-toggle-headers' can |
| 2742 | ;; inspect this value to determine how to toggle. | 2698 | ;; inspect this value to determine how to toggle. |
| 2743 | (set (make-local-variable 'rmail-header-style) header-style) | 2699 | (set (make-local-variable 'rmail-header-style) header-style)) |
| 2744 | ;; Unquote quoted From lines | 2700 | (if (and rmail-enable-mime |
| 2745 | (goto-char (point-min)) | 2701 | (re-search-forward "mime-version: 1.0" nil t)) |
| 2746 | (while (re-search-forward "^>+From " nil t) | 2702 | (let ((rmail-buffer mbox-buf) |
| 2747 | (beginning-of-line) | 2703 | (rmail-view-buffer view-buf)) |
| 2748 | (delete-char 1) | 2704 | (funcall rmail-show-mime-function)) |
| 2749 | (forward-line)) | 2705 | (setq body-start (search-forward "\n\n" nil t)) |
| 2750 | (goto-char (point-min))) | 2706 | (narrow-to-region beg (point)) |
| 2751 | ;; Copy the headers to the front of the message view buffer. | 2707 | (goto-char beg) |
| 2752 | (rmail-copy-headers beg end) | 2708 | (save-excursion |
| 2753 | ;; Add the separator (blank line) between headers and body; | 2709 | (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
| 2710 | (setq coding-system (intern (match-string 1))) | ||
| 2711 | (setq coding-system (rmail-get-coding-system)))) | ||
| 2712 | (setq character-coding (mail-fetch-field "content-transfer-encoding") | ||
| 2713 | is-text-message (rmail-is-text-p)) | ||
| 2714 | (if character-coding | ||
| 2715 | (setq character-coding (downcase character-coding))) | ||
| 2716 | (narrow-to-region beg end) | ||
| 2717 | ;; Decode the message body into an empty view buffer using a | ||
| 2718 | ;; unibyte temporary buffer where the character decoding takes | ||
| 2719 | ;; place. | ||
| 2720 | (with-current-buffer rmail-view-buffer | ||
| 2721 | (erase-buffer)) | ||
| 2722 | (if (null character-coding) | ||
| 2723 | ;; Do it directly since that is fast. | ||
| 2724 | (rmail-decode-region body-start end coding-system view-buf) | ||
| 2725 | ;; Can this be done directly, skipping the temp buffer? | ||
| 2726 | (with-temp-buffer | ||
| 2727 | (set-buffer-multibyte nil) | ||
| 2728 | (insert-buffer-substring mbox-buf body-start end) | ||
| 2729 | (cond | ||
| 2730 | ((string= character-coding "quoted-printable") | ||
| 2731 | ;; See bug#5441. | ||
| 2732 | (or (mail-unquote-printable-region (point-min) (point-max) | ||
| 2733 | nil t 'unibyte) | ||
| 2734 | (message "Malformed MIME quoted-printable message"))) | ||
| 2735 | ((and (string= character-coding "base64") is-text-message) | ||
| 2736 | (condition-case err | ||
| 2737 | (base64-decode-region (point-min) (point-max)) | ||
| 2738 | (error (message "%s" (cdr err))))) | ||
| 2739 | ((eq character-coding 'uuencode) | ||
| 2740 | (error "uuencoded messages are not supported yet")) | ||
| 2741 | (t)) | ||
| 2742 | (rmail-decode-region (point-min) (point-max) | ||
| 2743 | coding-system view-buf))) | ||
| 2744 | (with-current-buffer rmail-view-buffer | ||
| 2745 | ;; Prepare the separator (blank line) before the body. | ||
| 2746 | (goto-char (point-min)) | ||
| 2747 | (insert "\n") | ||
| 2748 | ;; Unquote quoted From lines | ||
| 2749 | (while (re-search-forward "^>+From " nil t) | ||
| 2750 | (beginning-of-line) | ||
| 2751 | (delete-char 1) | ||
| 2752 | (forward-line)) | ||
| 2753 | (goto-char (point-min))) | ||
| 2754 | ;; Copy the headers to the front of the message view buffer. | ||
| 2755 | (rmail-copy-headers beg end)) | ||
| 2754 | ;; highlight the message, activate any URL like text and add | 2756 | ;; highlight the message, activate any URL like text and add |
| 2755 | ;; special highlighting for and quoted material. | 2757 | ;; special highlighting for and quoted material. |
| 2756 | (with-current-buffer rmail-view-buffer | 2758 | (with-current-buffer rmail-view-buffer |
| 2757 | (insert "\n") | ||
| 2758 | (goto-char (point-min)) | 2759 | (goto-char (point-min)) |
| 2759 | ;; Decode the headers according to RFC2047. | ||
| 2760 | (save-excursion | ||
| 2761 | (search-forward "\n\n" nil 'move) | ||
| 2762 | (rfc2047-decode-region (point-min) (point))) | ||
| 2763 | (rmail-highlight-headers) | 2760 | (rmail-highlight-headers) |
| 2764 | ;(rmail-activate-urls) | 2761 | ;(rmail-activate-urls) |
| 2765 | ;(rmail-process-quoted-material) | 2762 | ;(rmail-process-quoted-material) |
| @@ -4289,18 +4286,28 @@ With prefix argument N moves forward N messages with these labels. | |||
| 4289 | 4286 | ||
| 4290 | ;;;*** | 4287 | ;;;*** |
| 4291 | 4288 | ||
| 4292 | ;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "b1ce015fd919b54cc7b1d0b2155489f9") | 4289 | ;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "3735f9bfe6ff3e612091857cc6b401b6") |
| 4293 | ;;; Generated autoloads from rmailmm.el | 4290 | ;;; Generated autoloads from rmailmm.el |
| 4294 | 4291 | ||
| 4295 | (autoload 'rmail-mime "rmailmm" "\ | 4292 | (autoload 'rmail-mime "rmailmm" "\ |
| 4296 | Process the current Rmail message as a MIME message. | 4293 | Toggle displaying of a MIME message. |
| 4297 | This creates a temporary \"*RMAIL*\" buffer holding a decoded | 4294 | |
| 4298 | copy of the message. Inline content-types are handled according to | 4295 | The actualy behavior depends on the value of `rmail-enable-mime'. |
| 4296 | |||
| 4297 | If `rmail-enable-mime' is t (default), this command change the | ||
| 4298 | displaying of a MIME message between decoded presentation form | ||
| 4299 | and raw data. | ||
| 4300 | |||
| 4301 | With ARG, toggle the displaying of the current MIME entity only. | ||
| 4302 | |||
| 4303 | If `rmail-enable-mime' is nil, this creates a temporary | ||
| 4304 | \"*RMAIL*\" buffer holding a decoded copy of the message. Inline | ||
| 4305 | content-types are handled according to | ||
| 4299 | `rmail-mime-media-type-handlers-alist'. By default, this | 4306 | `rmail-mime-media-type-handlers-alist'. By default, this |
| 4300 | displays text and multipart messages, and offers to download | 4307 | displays text and multipart messages, and offers to download |
| 4301 | attachments as specfied by `rmail-mime-attachment-dirs-alist'. | 4308 | attachments as specfied by `rmail-mime-attachment-dirs-alist'. |
| 4302 | 4309 | ||
| 4303 | \(fn)" t nil) | 4310 | \(fn &optional ARG)" t nil) |
| 4304 | 4311 | ||
| 4305 | ;;;*** | 4312 | ;;;*** |
| 4306 | 4313 | ||
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 708ec64706e..70c4ca36c63 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el | |||
| @@ -53,7 +53,7 @@ | |||
| 53 | ;; | 53 | ;; |
| 54 | ;; rmail-mime | 54 | ;; rmail-mime |
| 55 | ;; +- rmail-mime-show <----------------------------------+ | 55 | ;; +- rmail-mime-show <----------------------------------+ |
| 56 | ;; +- rmail-mime-process | | 56 | ;; +- rmail-mime-process | |
| 57 | ;; +- rmail-mime-handle | | 57 | ;; +- rmail-mime-handle | |
| 58 | ;; +- rmail-mime-text-handler | | 58 | ;; +- rmail-mime-text-handler | |
| 59 | ;; +- rmail-mime-bulk-handler | | 59 | ;; +- rmail-mime-bulk-handler | |
| @@ -97,7 +97,9 @@ The first item is a regular expression matching a content-type. | |||
| 97 | The remaining elements are handler functions to run, in order of | 97 | The remaining elements are handler functions to run, in order of |
| 98 | decreasing preference. These are called until one returns non-nil. | 98 | decreasing preference. These are called until one returns non-nil. |
| 99 | Note that this only applies to items with an inline Content-Disposition, | 99 | Note that this only applies to items with an inline Content-Disposition, |
| 100 | all others are handled by `rmail-mime-bulk-handler'." | 100 | all others are handled by `rmail-mime-bulk-handler'. |
| 101 | Note also that this alist is ignored when the variable | ||
| 102 | `rmail-enable-mime' is non-nil." | ||
| 101 | :type '(alist :key-type regexp :value-type (repeat function)) | 103 | :type '(alist :key-type regexp :value-type (repeat function)) |
| 102 | :version "23.1" | 104 | :version "23.1" |
| 103 | :group 'rmail-mime) | 105 | :group 'rmail-mime) |
| @@ -131,18 +133,36 @@ automatically display the image in the buffer." | |||
| 131 | 133 | ||
| 132 | ;;; End of user options. | 134 | ;;; End of user options. |
| 133 | 135 | ||
| 136 | ;;; Global variables that always have let-binding when referred. | ||
| 137 | |||
| 138 | (defvar rmail-mime-mbox-buffer nil | ||
| 139 | "Buffer containing the mbox data. | ||
| 140 | The value is usually nil, and bound to a proper value while | ||
| 141 | processing MIME.") | ||
| 142 | |||
| 143 | (defvar rmail-mime-view-buffer nil | ||
| 144 | "Buffer showing a message. | ||
| 145 | The value is usually nil, and bound to a proper value while | ||
| 146 | processing MIME.") | ||
| 147 | |||
| 148 | (defvar rmail-mime-coding-system nil | ||
| 149 | "The first coding-system used for decoding a MIME entity. | ||
| 150 | The value is usually nil, and bound to non-nil while inserting | ||
| 151 | MIME entities.") | ||
| 152 | |||
| 134 | ;;; MIME-entity object | 153 | ;;; MIME-entity object |
| 135 | 154 | ||
| 136 | (defun rmail-mime-entity (type disposition transfer-encoding | 155 | (defun rmail-mime-entity (type disposition transfer-encoding |
| 137 | header body children) | 156 | display header tagline body children handler) |
| 138 | "Retrun a newly created MIME-entity object. | 157 | "Retrun a newly created MIME-entity object from arguments. |
| 139 | 158 | ||
| 140 | A MIME-entity is a vector of 6 elements: | 159 | A MIME-entity is a vector of 9 elements: |
| 141 | 160 | ||
| 142 | [ TYPE DISPOSITION TRANSFER-ENCODING HEADER BODY CHILDREN ] | 161 | [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY |
| 143 | 162 | CHILDREN HANDLER] | |
| 144 | TYPE and DISPOSITION correspond to MIME headers Content-Type: and | 163 | |
| 145 | Cotent-Disposition: respectively, and has this format: | 164 | TYPE and DISPOSITION correspond to MIME headers Content-Type and |
| 165 | Cotent-Disposition respectively, and has this format: | ||
| 146 | 166 | ||
| 147 | \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...) | 167 | \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...) |
| 148 | 168 | ||
| @@ -161,31 +181,61 @@ The corresponding TYPE argument must be: | |||
| 161 | TRANSFER-ENCODING corresponds to MIME header | 181 | TRANSFER-ENCODING corresponds to MIME header |
| 162 | Content-Transfer-Encoding, and is a lowercased string. | 182 | Content-Transfer-Encoding, and is a lowercased string. |
| 163 | 183 | ||
| 164 | HEADER and BODY are a cons (BEG . END), where BEG and END specify | 184 | DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how |
| 165 | the region of the corresponding part in RMAIL's data (mbox) | 185 | the header, tagline, and body of the entity are displayed now, |
| 166 | buffer. BODY may be nil. In that case, the current buffer is | 186 | and NEW indicates how their displaying should be updated. |
| 167 | narrowed to the body part. | 187 | Both elements are vector [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY], |
| 168 | 188 | where each element is a symbol for the corresponding item that | |
| 169 | CHILDREN is a list of MIME-entities for a \"multipart\" entity, and | 189 | has these values: |
| 170 | nil for the other types." | 190 | nil: not displayed |
| 171 | (vector type disposition transfer-encoding header body children)) | 191 | t: displayed by the decoded presentation form |
| 192 | raw: displayed by the raw MIME data (for the header and body only) | ||
| 193 | |||
| 194 | HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and | ||
| 195 | END specify the region of the header or body lines in RMAIL's | ||
| 196 | data (mbox) buffer, and DISPLAY-FLAG non-nil means that the | ||
| 197 | header or body is, by default, displayed by the decoded | ||
| 198 | presentation form. | ||
| 199 | |||
| 200 | TAGLINE is a vector [TAG BULK-DATA DISPLAY-FLAG], where TAG is a | ||
| 201 | string indicating the depth and index number of the entity, | ||
| 202 | BULK-DATA is a cons (SIZE . TYPE) indicating the size and type of | ||
| 203 | an attached data, DISPLAY-FLAG non-nil means that the tagline is, | ||
| 204 | by default, displayed. | ||
| 205 | |||
| 206 | CHILDREN is a list of child MIME-entities. A \"multipart/*\" | ||
| 207 | entity have one or more children. A \"message/rfc822\" entity | ||
| 208 | has just one child. Any other entity has no child. | ||
| 209 | |||
| 210 | HANDLER is a function to insert the entity according to DISPLAY. | ||
| 211 | It is called with one argument ENTITY." | ||
| 212 | (vector type disposition transfer-encoding | ||
| 213 | display header tagline body children handler)) | ||
| 172 | 214 | ||
| 173 | ;; Accessors for a MIME-entity object. | 215 | ;; Accessors for a MIME-entity object. |
| 174 | (defsubst rmail-mime-entity-type (entity) (aref entity 0)) | 216 | (defsubst rmail-mime-entity-type (entity) (aref entity 0)) |
| 175 | (defsubst rmail-mime-entity-disposition (entity) (aref entity 1)) | 217 | (defsubst rmail-mime-entity-disposition (entity) (aref entity 1)) |
| 176 | (defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2)) | 218 | (defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2)) |
| 177 | (defsubst rmail-mime-entity-header (entity) (aref entity 3)) | 219 | (defsubst rmail-mime-entity-display (entity) (aref entity 3)) |
| 178 | (defsubst rmail-mime-entity-body (entity) (aref entity 4)) | 220 | (defsubst rmail-mime-entity-header (entity) (aref entity 4)) |
| 179 | (defsubst rmail-mime-entity-children (entity) (aref entity 5)) | 221 | (defsubst rmail-mime-entity-tagline (entity) (aref entity 5)) |
| 222 | (defsubst rmail-mime-entity-body (entity) (aref entity 6)) | ||
| 223 | (defsubst rmail-mime-entity-children (entity) (aref entity 7)) | ||
| 224 | (defsubst rmail-mime-entity-handler (entity) (aref entity 8)) | ||
| 225 | |||
| 226 | (defsubst rmail-mime-message-p () | ||
| 227 | "Non-nil if and only if the current message is a MIME." | ||
| 228 | (or (get-text-property (point) 'rmail-mime-entity) | ||
| 229 | (get-text-property (point-min) 'rmail-mime-entity))) | ||
| 180 | 230 | ||
| 181 | ;;; Buttons | 231 | ;;; Buttons |
| 182 | 232 | ||
| 183 | (defun rmail-mime-save (button) | 233 | (defun rmail-mime-save (button) |
| 184 | "Save the attachment using info in the BUTTON." | 234 | "Save the attachment using info in the BUTTON." |
| 185 | (let* ((filename (button-get button 'filename)) | 235 | (let* ((rmail-mime-mbox-buffer rmail-view-buffer) |
| 236 | (filename (button-get button 'filename)) | ||
| 186 | (directory (button-get button 'directory)) | 237 | (directory (button-get button 'directory)) |
| 187 | (data (button-get button 'data)) | 238 | (data (button-get button 'data)) |
| 188 | (mbox-buf rmail-view-buffer) | ||
| 189 | (ofilename filename)) | 239 | (ofilename filename)) |
| 190 | (setq filename (expand-file-name | 240 | (setq filename (expand-file-name |
| 191 | (read-file-name (format "Save as (default: %s): " filename) | 241 | (read-file-name (format "Save as (default: %s): " filename) |
| @@ -210,7 +260,8 @@ nil for the other types." | |||
| 210 | ;; DATA is a MIME-entity object. | 260 | ;; DATA is a MIME-entity object. |
| 211 | (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) | 261 | (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) |
| 212 | (body (rmail-mime-entity-body data))) | 262 | (body (rmail-mime-entity-body data))) |
| 213 | (insert-buffer-substring mbox-buf (car body) (cdr body)) | 263 | (insert-buffer-substring rmail-mime-mbox-buffer |
| 264 | (aref body 0) (aref body 1)) | ||
| 214 | (cond ((string= transfer-encoding "base64") | 265 | (cond ((string= transfer-encoding "base64") |
| 215 | (ignore-errors (base64-decode-region (point-min) (point-max)))) | 266 | (ignore-errors (base64-decode-region (point-min) (point-max)))) |
| 216 | ((string= transfer-encoding "quoted-printable") | 267 | ((string= transfer-encoding "quoted-printable") |
| @@ -219,34 +270,293 @@ nil for the other types." | |||
| 219 | 270 | ||
| 220 | (define-button-type 'rmail-mime-save 'action 'rmail-mime-save) | 271 | (define-button-type 'rmail-mime-save 'action 'rmail-mime-save) |
| 221 | 272 | ||
| 273 | (defun rmail-mime-entity-segment (pos &optional entity) | ||
| 274 | "Return a vector describing the displayed region of a MIME-entity at POS. | ||
| 275 | Optional 2nd argument ENTITY is the MIME-entity at POS. | ||
| 276 | The value is a vector [ INDEX HEADER TAGLINE BODY END], where | ||
| 277 | HEADER: the position of the beginning of a header | ||
| 278 | TAGLINE: the position of the beginning of a tagline | ||
| 279 | BODY: the position of the beginning of a body | ||
| 280 | END: the position of the end of the entity. | ||
| 281 | INDEX: index into the returned vector indicating where POS is." | ||
| 282 | (save-excursion | ||
| 283 | (or entity | ||
| 284 | (setq entity (get-text-property pos 'rmail-mime-entity))) | ||
| 285 | (if (not entity) | ||
| 286 | (vector 1 (point) (point) (point) (point)) | ||
| 287 | (let ((current (aref (rmail-mime-entity-display entity) 0)) | ||
| 288 | (beg (if (and (> pos (point-min)) | ||
| 289 | (eq (get-text-property (1- pos) 'rmail-mime-entity) | ||
| 290 | entity)) | ||
| 291 | (previous-single-property-change pos 'rmail-mime-entity | ||
| 292 | nil (point-min)) | ||
| 293 | pos)) | ||
| 294 | (index 1) | ||
| 295 | tagline-beg body-beg end) | ||
| 296 | (goto-char beg) | ||
| 297 | (if (aref current 0) | ||
| 298 | (search-forward "\n\n" nil t)) | ||
| 299 | (setq tagline-beg (point)) | ||
| 300 | (if (>= pos tagline-beg) | ||
| 301 | (setq index 2)) | ||
| 302 | (if (aref current 1) | ||
| 303 | (forward-line 1)) | ||
| 304 | (setq body-beg (point)) | ||
| 305 | (if (>= pos body-beg) | ||
| 306 | (setq index 3)) | ||
| 307 | (if (aref current 2) | ||
| 308 | (let ((tag (aref (rmail-mime-entity-tagline entity) 0)) | ||
| 309 | tag2) | ||
| 310 | (setq end (next-single-property-change beg 'rmail-mime-entity | ||
| 311 | nil (point-max))) | ||
| 312 | (while (and (< end (point-max)) | ||
| 313 | (setq entity (get-text-property end 'rmail-mime-entity) | ||
| 314 | tag2 (aref (rmail-mime-entity-tagline entity) 0)) | ||
| 315 | (and (> (length tag2) 0) | ||
| 316 | (eq (string-match tag tag2) 0))) | ||
| 317 | (setq end (next-single-property-change end 'rmail-mime-entity | ||
| 318 | nil (point-max))))) | ||
| 319 | (setq end body-beg)) | ||
| 320 | (vector index beg tagline-beg body-beg end))))) | ||
| 321 | |||
| 322 | (defun rmail-mime-next-item () | ||
| 323 | "Move point to the next displayed item of the current MIME entity. | ||
| 324 | A MIME entity has three items; header, tagline, and body. | ||
| 325 | If we are in the last item of the entity, move point to the first | ||
| 326 | item of the next entity. If we reach the end of buffer, move | ||
| 327 | point to the first item of the first entity (i.e. the beginning | ||
| 328 | of buffer)." | ||
| 329 | (interactive) | ||
| 330 | (if (rmail-mime-message-p) | ||
| 331 | (let* ((segment (rmail-mime-entity-segment (point))) | ||
| 332 | (next-pos (aref segment (1+ (aref segment 0)))) | ||
| 333 | (button (next-button (point)))) | ||
| 334 | (goto-char (if (and button (< (button-start button) next-pos)) | ||
| 335 | (button-start button) | ||
| 336 | next-pos)) | ||
| 337 | (if (eobp) | ||
| 338 | (goto-char (point-min)))))) | ||
| 339 | |||
| 340 | (defun rmail-mime-previous-item () | ||
| 341 | "Move point to the previous displayed item of the current MIME message. | ||
| 342 | A MIME entity has three items; header, tagline, and body. | ||
| 343 | If we are at the beginning of the first item of the entity, move | ||
| 344 | point to the last item of the previous entity. If we reach the | ||
| 345 | beginning of buffer, move point to the last item of the last | ||
| 346 | entity." | ||
| 347 | (interactive) | ||
| 348 | (when (rmail-mime-message-p) | ||
| 349 | (if (bobp) | ||
| 350 | (goto-char (point-max))) | ||
| 351 | (let* ((segment (rmail-mime-entity-segment (1- (point)))) | ||
| 352 | (prev-pos (aref segment (aref segment 0))) | ||
| 353 | (button (previous-button (point)))) | ||
| 354 | (goto-char (if (and button (> (button-start button) prev-pos)) | ||
| 355 | (button-start button) | ||
| 356 | prev-pos))))) | ||
| 357 | |||
| 358 | (defun rmail-mime-shown-mode (entity) | ||
| 359 | "Make MIME-entity ENTITY displayed by the default way." | ||
| 360 | (let ((new (aref (rmail-mime-entity-display entity) 1))) | ||
| 361 | (aset new 0 (aref (rmail-mime-entity-header entity) 2)) | ||
| 362 | (aset new 1 (aref (rmail-mime-entity-tagline entity) 2)) | ||
| 363 | (aset new 2 (aref (rmail-mime-entity-body entity) 2)))) | ||
| 364 | |||
| 365 | (defun rmail-mime-hidden-mode (entity top) | ||
| 366 | "Make MIME-entity ENTITY displayed in the hidden mode. | ||
| 367 | If TOP is non-nil, display ENTITY only by the tagline. | ||
| 368 | Otherwise, don't display ENTITY." | ||
| 369 | (if top | ||
| 370 | (let ((new (aref (rmail-mime-entity-display entity) 1))) | ||
| 371 | (aset new 0 nil) | ||
| 372 | (aset new 1 top) | ||
| 373 | (aset new 2 nil) | ||
| 374 | (aset (rmail-mime-entity-body entity) 2 nil)) | ||
| 375 | (let ((current (aref (rmail-mime-entity-display entity) 0))) | ||
| 376 | (aset current 0 nil) | ||
| 377 | (aset current 1 nil) | ||
| 378 | (aset current 2 nil))) | ||
| 379 | (dolist (child (rmail-mime-entity-children entity)) | ||
| 380 | (rmail-mime-hidden-mode child nil))) | ||
| 381 | |||
| 382 | (defun rmail-mime-raw-mode (entity) | ||
| 383 | "Make MIME-entity ENTITY displayed in the raw mode." | ||
| 384 | (let ((new (aref (rmail-mime-entity-display entity) 1))) | ||
| 385 | (aset new 0 'raw) | ||
| 386 | (aset new 1 nil) | ||
| 387 | (aset new 2 'raw) | ||
| 388 | (dolist (child (rmail-mime-entity-children entity)) | ||
| 389 | (rmail-mime-hidden-mode child nil)))) | ||
| 390 | |||
| 391 | (defun rmail-mime-toggle-raw (entity) | ||
| 392 | "Toggle on and off the raw display mode of MIME-entity ENTITY." | ||
| 393 | (let* ((pos (if (eobp) (1- (point-max)) (point))) | ||
| 394 | (entity (get-text-property pos 'rmail-mime-entity)) | ||
| 395 | (current (aref (rmail-mime-entity-display entity) 0)) | ||
| 396 | (segment (rmail-mime-entity-segment pos entity))) | ||
| 397 | (if (not (eq (aref current 0) 'raw)) | ||
| 398 | ;; Enter the raw mode. | ||
| 399 | (rmail-mime-raw-mode entity) | ||
| 400 | ;; Enter the shown mode. | ||
| 401 | (rmail-mime-shown-mode entity)) | ||
| 402 | (let ((inhibit-read-only t) | ||
| 403 | (modified (buffer-modified-p))) | ||
| 404 | (save-excursion | ||
| 405 | (goto-char (aref segment 1)) | ||
| 406 | (rmail-mime-insert entity) | ||
| 407 | (restore-buffer-modified-p modified))))) | ||
| 408 | |||
| 409 | (defun rmail-mime-toggle-hidden () | ||
| 410 | "Toggle on and off the hidden display mode of MIME-entity ENTITY." | ||
| 411 | (interactive) | ||
| 412 | (when (rmail-mime-message-p) | ||
| 413 | (let* ((rmail-mime-mbox-buffer rmail-view-buffer) | ||
| 414 | (rmail-mime-view-buffer (current-buffer)) | ||
| 415 | (pos (if (eobp) (1- (point-max)) (point))) | ||
| 416 | (entity (get-text-property pos 'rmail-mime-entity)) | ||
| 417 | (current (aref (rmail-mime-entity-display entity) 0)) | ||
| 418 | (segment (rmail-mime-entity-segment pos entity))) | ||
| 419 | (if (aref current 2) | ||
| 420 | ;; Enter the hidden mode. | ||
| 421 | (progn | ||
| 422 | ;; If point is in the body part, move it to the tagline | ||
| 423 | ;; (or the header if headline is not displayed). | ||
| 424 | (if (= (aref segment 0) 3) | ||
| 425 | (goto-char (aref segment 2))) | ||
| 426 | (rmail-mime-hidden-mode entity t) | ||
| 427 | ;; If the current entity is the topmost one, display the | ||
| 428 | ;; header. | ||
| 429 | (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min))) | ||
| 430 | (let ((new (aref (rmail-mime-entity-display entity) 1))) | ||
| 431 | (aset new 0 t)))) | ||
| 432 | ;; Enter the shown mode. | ||
| 433 | (aset (rmail-mime-entity-body entity) 2 t) | ||
| 434 | (rmail-mime-shown-mode entity)) | ||
| 435 | (let ((inhibit-read-only t) | ||
| 436 | (modified (buffer-modified-p)) | ||
| 437 | (rmail-mime-mbox-buffer rmail-view-buffer) | ||
| 438 | (rmail-mime-view-buffer rmail-buffer)) | ||
| 439 | (save-excursion | ||
| 440 | (goto-char (aref segment 1)) | ||
| 441 | (rmail-mime-insert entity) | ||
| 442 | (restore-buffer-modified-p modified)))))) | ||
| 443 | |||
| 444 | (define-key rmail-mode-map "\t" 'rmail-mime-next-item) | ||
| 445 | (define-key rmail-mode-map [backtab] 'rmail-mime-previous-item) | ||
| 446 | (define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden) | ||
| 447 | |||
| 222 | ;;; Handlers | 448 | ;;; Handlers |
| 223 | 449 | ||
| 450 | (defun rmail-mime-insert-tagline (entity &rest item-list) | ||
| 451 | "Insert a tag line for MIME-entity ENTITY. | ||
| 452 | ITEM-LIST is a list of strings or button-elements (list) to be added | ||
| 453 | to the tag line." | ||
| 454 | (insert "[") | ||
| 455 | (let ((tag (aref (rmail-mime-entity-tagline entity) 0))) | ||
| 456 | (if (> (length tag) 0) (insert (substring tag 1) ":"))) | ||
| 457 | (insert (car (rmail-mime-entity-type entity))) | ||
| 458 | (dolist (item item-list) | ||
| 459 | (when item | ||
| 460 | (if (stringp item) | ||
| 461 | (insert item) | ||
| 462 | (apply 'insert-button item)))) | ||
| 463 | (insert "]\n")) | ||
| 464 | |||
| 465 | (defun rmail-mime-insert-header (header) | ||
| 466 | "Decode and insert a MIME-entity header HEADER in the current buffer. | ||
| 467 | HEADER is a vector [BEG END DEFAULT-STATUS]. | ||
| 468 | See `rmail-mime-entity' for the detail." | ||
| 469 | (let ((pos (point)) | ||
| 470 | (last-coding-system-used nil)) | ||
| 471 | (save-restriction | ||
| 472 | (narrow-to-region pos pos) | ||
| 473 | (with-current-buffer rmail-mime-mbox-buffer | ||
| 474 | (let ((rmail-buffer rmail-mime-mbox-buffer) | ||
| 475 | (rmail-view-buffer rmail-mime-view-buffer)) | ||
| 476 | (save-excursion | ||
| 477 | (goto-char (aref header 0)) | ||
| 478 | (rmail-copy-headers (point) (aref header 1))))) | ||
| 479 | (rfc2047-decode-region pos (point)) | ||
| 480 | (if (and last-coding-system-used (not rmail-mime-coding-system)) | ||
| 481 | (setq rmail-mime-coding-system last-coding-system-used)) | ||
| 482 | (goto-char (point-min)) | ||
| 483 | (rmail-highlight-headers) | ||
| 484 | (goto-char (point-max)) | ||
| 485 | (insert "\n")))) | ||
| 486 | |||
| 224 | (defun rmail-mime-text-handler (content-type | 487 | (defun rmail-mime-text-handler (content-type |
| 225 | content-disposition | 488 | content-disposition |
| 226 | content-transfer-encoding) | 489 | content-transfer-encoding) |
| 227 | "Handle the current buffer as a plain text MIME part." | 490 | "Handle the current buffer as a plain text MIME part." |
| 228 | (let* ((charset (cdr (assq 'charset (cdr content-type)))) | 491 | (rmail-mime-insert-text |
| 229 | (coding-system (when charset | 492 | (rmail-mime-entity content-type content-disposition |
| 230 | (intern (downcase charset))))) | 493 | content-transfer-encoding |
| 231 | (when (coding-system-p coding-system) | 494 | (vector (vector nil nil nil) (vector nil nil t)) |
| 232 | (decode-coding-region (point-min) (point-max) coding-system)))) | 495 | (vector nil nil nil) (vector "" (cons nil nil) t) |
| 233 | 496 | (vector nil nil nil) nil 'rmail-mime-insert-text)) | |
| 234 | (defun rmail-mime-insert-text (entity) | 497 | t) |
| 235 | "Insert MIME-entity ENTITY as a plain text MIME part in the current buffer." | 498 | |
| 499 | (defun rmail-mime-insert-decoded-text (entity) | ||
| 500 | "Decode and insert the text body of MIME-entity ENTITY." | ||
| 236 | (let* ((content-type (rmail-mime-entity-type entity)) | 501 | (let* ((content-type (rmail-mime-entity-type entity)) |
| 237 | (charset (cdr (assq 'charset (cdr content-type)))) | 502 | (charset (cdr (assq 'charset (cdr content-type)))) |
| 238 | (coding-system (if charset (intern (downcase charset)))) | 503 | (coding-system (if charset |
| 239 | (transfer-encoding (rmail-mime-entity-transfer-encoding entity)) | 504 | (coding-system-from-name charset))) |
| 240 | (body (rmail-mime-entity-body entity))) | 505 | (body (rmail-mime-entity-body entity)) |
| 241 | (save-restriction | 506 | (pos (point))) |
| 242 | (narrow-to-region (point) (point)) | 507 | (or (and coding-system (coding-system-p coding-system)) |
| 243 | (insert-buffer-substring rmail-buffer (car body) (cdr body)) | 508 | (setq coding-system 'undecided)) |
| 244 | (cond ((string= transfer-encoding "base64") | 509 | (if (stringp (aref body 0)) |
| 245 | (ignore-errors (base64-decode-region (point-min) (point-max)))) | 510 | (insert (aref body 0)) |
| 246 | ((string= transfer-encoding "quoted-printable") | 511 | (let ((transfer-encoding (rmail-mime-entity-transfer-encoding entity))) |
| 247 | (quoted-printable-decode-region (point-min) (point-max)))) | 512 | (insert-buffer-substring rmail-mime-mbox-buffer |
| 248 | (if (coding-system-p coding-system) | 513 | (aref body 0) (aref body 1)) |
| 249 | (decode-coding-region (point-min) (point-max) coding-system))))) | 514 | (cond ((string= transfer-encoding "base64") |
| 515 | (ignore-errors (base64-decode-region pos (point)))) | ||
| 516 | ((string= transfer-encoding "quoted-printable") | ||
| 517 | (quoted-printable-decode-region pos (point)))))) | ||
| 518 | (decode-coding-region pos (point) coding-system) | ||
| 519 | (or rmail-mime-coding-system | ||
| 520 | (setq rmail-mime-coding-system coding-system)) | ||
| 521 | (or (bolp) (insert "\n")))) | ||
| 522 | |||
| 523 | (defun rmail-mime-insert-text (entity) | ||
| 524 | "Presentation handler for a plain text MIME entity." | ||
| 525 | (let ((current (aref (rmail-mime-entity-display entity) 0)) | ||
| 526 | (new (aref (rmail-mime-entity-display entity) 1)) | ||
| 527 | (header (rmail-mime-entity-header entity)) | ||
| 528 | (tagline (rmail-mime-entity-tagline entity)) | ||
| 529 | (body (rmail-mime-entity-body entity)) | ||
| 530 | (beg (point)) | ||
| 531 | (segment (rmail-mime-entity-segment (point) entity))) | ||
| 532 | |||
| 533 | (or (integerp (aref body 0)) | ||
| 534 | (let ((data (buffer-string))) | ||
| 535 | (aset body 0 data) | ||
| 536 | (delete-region (point-min) (point-max)))) | ||
| 537 | |||
| 538 | ;; header | ||
| 539 | (if (eq (aref current 0) (aref new 0)) | ||
| 540 | (goto-char (aref segment 2)) | ||
| 541 | (if (aref current 0) | ||
| 542 | (delete-char (- (aref segment 2) (aref segment 1)))) | ||
| 543 | (if (aref new 0) | ||
| 544 | (rmail-mime-insert-header header))) | ||
| 545 | ;; tagline | ||
| 546 | (if (eq (aref current 1) (aref new 1)) | ||
| 547 | (forward-char (- (aref segment 3) (aref segment 2))) | ||
| 548 | (if (aref current 1) | ||
| 549 | (delete-char (- (aref segment 3) (aref segment 2)))) | ||
| 550 | (if (aref new 1) | ||
| 551 | (rmail-mime-insert-tagline entity))) | ||
| 552 | ;; body | ||
| 553 | (if (eq (aref current 2) (aref new 2)) | ||
| 554 | (forward-char (- (aref segment 4) (aref segment 3))) | ||
| 555 | (if (aref current 2) | ||
| 556 | (delete-char (- (aref segment 4) (aref segment 3)))) | ||
| 557 | (if (aref new 2) | ||
| 558 | (rmail-mime-insert-decoded-text entity))) | ||
| 559 | (put-text-property beg (point) 'rmail-mime-entity entity))) | ||
| 250 | 560 | ||
| 251 | ;; FIXME move to the test/ directory? | 561 | ;; FIXME move to the test/ directory? |
| 252 | (defun test-rmail-mime-handler () | 562 | (defun test-rmail-mime-handler () |
| @@ -265,35 +575,35 @@ MIME-Version: 1.0 | |||
| 265 | (set-buffer-multibyte t))) | 575 | (set-buffer-multibyte t))) |
| 266 | 576 | ||
| 267 | 577 | ||
| 268 | (defun rmail-mime-insert-image (type data) | 578 | (defun rmail-mime-insert-image (entity) |
| 269 | "Insert an image of type TYPE, where DATA is the image data. | 579 | "Decode and insert the image body of MIME-entity ENTITY." |
| 270 | If DATA is not a string, it is a MIME-entity object." | 580 | (let* ((content-type (car (rmail-mime-entity-type entity))) |
| 271 | (end-of-line) | 581 | (bulk-data (aref (rmail-mime-entity-tagline entity) 1)) |
| 272 | (let ((modified (buffer-modified-p))) | 582 | (body (rmail-mime-entity-body entity)) |
| 273 | (insert ?\n) | 583 | data) |
| 274 | (unless (stringp data) | 584 | (if (stringp (aref body 0)) |
| 275 | ;; DATA is a MIME-entity. | 585 | (setq data (aref body 0)) |
| 276 | (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) | 586 | (let ((rmail-mime-mbox-buffer rmail-view-buffer) |
| 277 | (body (rmail-mime-entity-body data)) | 587 | (transfer-encoding (rmail-mime-entity-transfer-encoding entity))) |
| 278 | (mbox-buffer rmail-view-buffer)) | ||
| 279 | (with-temp-buffer | 588 | (with-temp-buffer |
| 280 | (set-buffer-multibyte nil) | 589 | (set-buffer-multibyte nil) |
| 281 | (setq buffer-undo-list t) | 590 | (setq buffer-undo-list t) |
| 282 | (insert-buffer-substring mbox-buffer (car body) (cdr body)) | 591 | (insert-buffer-substring rmail-mime-mbox-buffer |
| 592 | (aref body 0) (aref body 1)) | ||
| 283 | (cond ((string= transfer-encoding "base64") | 593 | (cond ((string= transfer-encoding "base64") |
| 284 | (ignore-errors (base64-decode-region (point-min) (point-max)))) | 594 | (ignore-errors (base64-decode-region (point-min) (point-max)))) |
| 285 | ((string= transfer-encoding "quoted-printable") | 595 | ((string= transfer-encoding "quoted-printable") |
| 286 | (quoted-printable-decode-region (point-min) (point-max)))) | 596 | (quoted-printable-decode-region (point-min) (point-max)))) |
| 287 | (setq data | 597 | (setq data |
| 288 | (buffer-substring-no-properties (point-min) (point-max)))))) | 598 | (buffer-substring-no-properties (point-min) (point-max)))))) |
| 289 | (insert-image (create-image data type t)) | 599 | (insert-image (create-image data (cdr bulk-data) t)) |
| 290 | (set-buffer-modified-p modified))) | 600 | (insert "\n"))) |
| 291 | 601 | ||
| 292 | (defun rmail-mime-image (button) | 602 | (defun rmail-mime-image (button) |
| 293 | "Display the image associated with BUTTON." | 603 | "Display the image associated with BUTTON." |
| 294 | (let ((inhibit-read-only t)) | 604 | (save-excursion |
| 295 | (rmail-mime-insert-image (button-get button 'image-type) | 605 | (goto-char (button-end button)) |
| 296 | (button-get button 'image-data)))) | 606 | (rmail-mime-toggle-hidden))) |
| 297 | 607 | ||
| 298 | (define-button-type 'rmail-mime-image 'action 'rmail-mime-image) | 608 | (define-button-type 'rmail-mime-image 'action 'rmail-mime-image) |
| 299 | 609 | ||
| @@ -306,15 +616,60 @@ For images that Emacs is capable of displaying, the behavior | |||
| 306 | depends upon the value of `rmail-mime-show-images'." | 616 | depends upon the value of `rmail-mime-show-images'." |
| 307 | (rmail-mime-insert-bulk | 617 | (rmail-mime-insert-bulk |
| 308 | (rmail-mime-entity content-type content-disposition content-transfer-encoding | 618 | (rmail-mime-entity content-type content-disposition content-transfer-encoding |
| 309 | nil nil nil))) | 619 | (vector (vector nil nil nil) (vector nil t nil)) |
| 620 | (vector nil nil nil) (vector "" (cons nil nil) t) | ||
| 621 | (vector nil nil nil) nil 'rmail-mime-insert-bulk))) | ||
| 622 | |||
| 623 | (defun rmail-mime-set-bulk-data (entity) | ||
| 624 | "Setup the information about the attachment object for MIME-entity ENTITY. | ||
| 625 | The value is non-nil if and only if the attachment object should be shown | ||
| 626 | directly." | ||
| 627 | (let ((content-type (car (rmail-mime-entity-type entity))) | ||
| 628 | (size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity))))) | ||
| 629 | (bulk-data (aref (rmail-mime-entity-tagline entity) 1)) | ||
| 630 | (body (rmail-mime-entity-body entity)) | ||
| 631 | size type to-show) | ||
| 632 | (cond (size | ||
| 633 | (setq size (string-to-number size))) | ||
| 634 | ((stringp (aref body 0)) | ||
| 635 | (setq size (length (aref body 0)))) | ||
| 636 | (t | ||
| 637 | ;; Rough estimation of the size. | ||
| 638 | (let ((encoding (rmail-mime-entity-transfer-encoding entity))) | ||
| 639 | (setq size (- (aref body 1) (aref body 0))) | ||
| 640 | (cond ((string= encoding "base64") | ||
| 641 | (setq size (/ (* size 3) 4))) | ||
| 642 | ((string= encoding "quoted-printable") | ||
| 643 | (setq size (/ (* size 7) 3))))))) | ||
| 644 | |||
| 645 | (cond | ||
| 646 | ((string-match "text/" content-type) | ||
| 647 | (setq type 'text)) | ||
| 648 | ((string-match "image/\\(.*\\)" content-type) | ||
| 649 | (setq type (image-type-from-file-name | ||
| 650 | (concat "." (match-string 1 content-type)))) | ||
| 651 | (if (and (memq type image-types) | ||
| 652 | (image-type-available-p type)) | ||
| 653 | (if (and rmail-mime-show-images | ||
| 654 | (not (eq rmail-mime-show-images 'button)) | ||
| 655 | (or (not (numberp rmail-mime-show-images)) | ||
| 656 | (< size rmail-mime-show-images))) | ||
| 657 | (setq to-show t)) | ||
| 658 | (setq type nil)))) | ||
| 659 | (setcar bulk-data size) | ||
| 660 | (setcdr bulk-data type) | ||
| 661 | to-show)) | ||
| 310 | 662 | ||
| 311 | (defun rmail-mime-insert-bulk (entity) | 663 | (defun rmail-mime-insert-bulk (entity) |
| 312 | "Inesrt a MIME-entity ENTITY as an attachment. | 664 | "Presentation handler for an attachment MIME entity." |
| 313 | The optional second arg DATA, if non-nil, is a string containing | ||
| 314 | the attachment data that is already decoded." | ||
| 315 | ;; Find the default directory for this media type. | 665 | ;; Find the default directory for this media type. |
| 316 | (let* ((content-type (rmail-mime-entity-type entity)) | 666 | (let* ((content-type (rmail-mime-entity-type entity)) |
| 317 | (content-disposition (rmail-mime-entity-disposition entity)) | 667 | (content-disposition (rmail-mime-entity-disposition entity)) |
| 668 | (current (aref (rmail-mime-entity-display entity) 0)) | ||
| 669 | (new (aref (rmail-mime-entity-display entity) 1)) | ||
| 670 | (header (rmail-mime-entity-header entity)) | ||
| 671 | (tagline (rmail-mime-entity-tagline entity)) | ||
| 672 | (bulk-data (aref tagline 1)) | ||
| 318 | (body (rmail-mime-entity-body entity)) | 673 | (body (rmail-mime-entity-body entity)) |
| 319 | (directory (catch 'directory | 674 | (directory (catch 'directory |
| 320 | (dolist (entry rmail-mime-attachment-dirs-alist) | 675 | (dolist (entry rmail-mime-attachment-dirs-alist) |
| @@ -325,47 +680,70 @@ the attachment data that is already decoded." | |||
| 325 | (filename (or (cdr (assq 'name (cdr content-type))) | 680 | (filename (or (cdr (assq 'name (cdr content-type))) |
| 326 | (cdr (assq 'filename (cdr content-disposition))) | 681 | (cdr (assq 'filename (cdr content-disposition))) |
| 327 | "noname")) | 682 | "noname")) |
| 328 | (label (format "\nAttached %s file: " (car content-type))) | ||
| 329 | (units '(B kB MB GB)) | 683 | (units '(B kB MB GB)) |
| 330 | data udata size osize type) | 684 | (segment (rmail-mime-entity-segment (point) entity)) |
| 331 | (if body | 685 | beg data size) |
| 686 | |||
| 687 | (if (integerp (aref body 0)) | ||
| 332 | (setq data entity | 688 | (setq data entity |
| 333 | udata entity | 689 | size (car bulk-data)) |
| 334 | size (- (cdr body) (car body))) | 690 | (if (stringp (aref body 0)) |
| 335 | (setq data (buffer-string) | 691 | (setq data (aref body 0)) |
| 336 | udata (string-as-unibyte data) | 692 | (setq data (string-as-unibyte (buffer-string))) |
| 337 | size (length udata)) | 693 | (aset body 0 data) |
| 338 | (delete-region (point-min) (point-max))) | 694 | (rmail-mime-set-bulk-data entity) |
| 339 | (setq osize size) | 695 | (delete-region (point-min) (point-max))) |
| 696 | (setq size (length data))) | ||
| 340 | (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message | 697 | (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message |
| 341 | (cdr units)) | 698 | (cdr units)) |
| 342 | (setq size (/ size 1024.0) | 699 | (setq size (/ size 1024.0) |
| 343 | units (cdr units))) | 700 | units (cdr units))) |
| 344 | (insert label) | 701 | |
| 345 | (insert-button filename | 702 | (setq beg (point)) |
| 346 | :type 'rmail-mime-save | 703 | |
| 347 | 'help-echo "mouse-2, RET: Save attachment" | 704 | ;; header |
| 348 | 'filename filename | 705 | (if (eq (aref current 0) (aref new 0)) |
| 349 | 'directory (file-name-as-directory directory) | 706 | (goto-char (aref segment 2)) |
| 350 | 'data data) | 707 | (if (aref current 0) |
| 351 | (insert (format " (%.0f%s)" size (car units))) | 708 | (delete-char (- (aref segment 2) (aref segment 1)))) |
| 352 | (when (and rmail-mime-show-images | 709 | (if (aref new 0) |
| 353 | (string-match "image/\\(.*\\)" (setq type (car content-type))) | 710 | (rmail-mime-insert-header header))) |
| 354 | (setq type (concat "." (match-string 1 type)) | 711 | |
| 355 | type (image-type-from-file-name type)) | 712 | ;; tagline |
| 356 | (memq type image-types) | 713 | (if (eq (aref current 1) (aref new 1)) |
| 357 | (image-type-available-p type)) | 714 | (forward-char (- (aref segment 3) (aref segment 2))) |
| 358 | (insert " ") | 715 | (if (aref current 1) |
| 359 | (cond ((or (eq rmail-mime-show-images 'button) | 716 | (delete-char (- (aref segment 3) (aref segment 2)))) |
| 360 | (and (numberp rmail-mime-show-images) | 717 | (if (aref new 1) |
| 361 | (>= osize rmail-mime-show-images))) | 718 | (rmail-mime-insert-tagline |
| 362 | (insert-button "Display" | 719 | entity |
| 363 | :type 'rmail-mime-image | 720 | " file:" |
| 364 | 'help-echo "mouse-2, RET: Show image" | 721 | (list filename |
| 365 | 'image-type type | 722 | :type 'rmail-mime-save |
| 366 | 'image-data udata)) | 723 | 'help-echo "mouse-2, RET: Save attachment" |
| 367 | (t | 724 | 'filename filename |
| 368 | (rmail-mime-insert-image type udata)))))) | 725 | 'directory (file-name-as-directory directory) |
| 726 | 'data data) | ||
| 727 | (format " (%.0f%s)" size (car units)) | ||
| 728 | (if (cdr bulk-data) | ||
| 729 | " ") | ||
| 730 | (if (cdr bulk-data) | ||
| 731 | (list "Toggle show/hide" | ||
| 732 | :type 'rmail-mime-image | ||
| 733 | 'help-echo "mouse-2, RET: Toggle show/hide" | ||
| 734 | 'image-type (cdr bulk-data) | ||
| 735 | 'image-data data))))) | ||
| 736 | ;; body | ||
| 737 | (if (eq (aref current 2) (aref new 2)) | ||
| 738 | (forward-char (- (aref segment 4) (aref segment 3))) | ||
| 739 | (if (aref current 2) | ||
| 740 | (delete-char (- (aref segment 4) (aref segment 3)))) | ||
| 741 | (if (aref new 2) | ||
| 742 | (cond ((eq (cdr bulk-data) 'text) | ||
| 743 | (rmail-mime-insert-decoded-text entity)) | ||
| 744 | ((cdr bulk-data) | ||
| 745 | (rmail-mime-insert-image entity))))) | ||
| 746 | (put-text-property beg (point) 'rmail-mime-entity entity))) | ||
| 369 | 747 | ||
| 370 | (defun test-rmail-mime-bulk-handler () | 748 | (defun test-rmail-mime-bulk-handler () |
| 371 | "Test of a mail used as an example in RFC 2183." | 749 | "Test of a mail used as an example in RFC 2183." |
| @@ -397,19 +775,21 @@ CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values | |||
| 397 | of the respective parsed headers. See `rmail-mime-handle' for their | 775 | of the respective parsed headers. See `rmail-mime-handle' for their |
| 398 | format." | 776 | format." |
| 399 | (rmail-mime-process-multipart | 777 | (rmail-mime-process-multipart |
| 400 | content-type content-disposition content-transfer-encoding nil)) | 778 | content-type content-disposition content-transfer-encoding nil) |
| 779 | t) | ||
| 401 | 780 | ||
| 402 | (defun rmail-mime-process-multipart (content-type | 781 | (defun rmail-mime-process-multipart (content-type |
| 403 | content-disposition | 782 | content-disposition |
| 404 | content-transfer-encoding | 783 | content-transfer-encoding |
| 405 | parse-only) | 784 | parse-tag) |
| 406 | "Process the current buffer as a multipart MIME body. | 785 | "Process the current buffer as a multipart MIME body. |
| 407 | 786 | ||
| 408 | If PARSE-ONLY is nil, modify the current buffer directly for showing | 787 | If PARSE-TAG is nil, modify the current buffer directly for |
| 409 | the MIME body and return nil. | 788 | showing the MIME body and return nil. |
| 410 | 789 | ||
| 411 | Otherwise, just parse the current buffer and return a list of | 790 | Otherwise, PARSE-TAG is a string indicating the depth and index |
| 412 | MIME-entity objects. | 791 | number of the entity. In this case, parse the current buffer and |
| 792 | return a list of MIME-entity objects. | ||
| 413 | 793 | ||
| 414 | The other arguments are the same as `rmail-mime-multipart-handler'." | 794 | The other arguments are the same as `rmail-mime-multipart-handler'." |
| 415 | ;; Some MUAs start boundaries with "--", while it should start | 795 | ;; Some MUAs start boundaries with "--", while it should start |
| @@ -420,6 +800,8 @@ The other arguments are the same as `rmail-mime-multipart-handler'." | |||
| 420 | ;; of the preceding part. | 800 | ;; of the preceding part. |
| 421 | ;; We currently don't handle that. | 801 | ;; We currently don't handle that. |
| 422 | (let ((boundary (cdr (assq 'boundary content-type))) | 802 | (let ((boundary (cdr (assq 'boundary content-type))) |
| 803 | (subtype (cadr (split-string (car content-type) "/"))) | ||
| 804 | (index 0) | ||
| 423 | beg end next entities) | 805 | beg end next entities) |
| 424 | (unless boundary | 806 | (unless boundary |
| 425 | (rmail-mm-get-boundary-error-message | 807 | (rmail-mm-get-boundary-error-message |
| @@ -430,12 +812,20 @@ The other arguments are the same as `rmail-mime-multipart-handler'." | |||
| 430 | (goto-char (point-min)) | 812 | (goto-char (point-min)) |
| 431 | (when (and (search-forward boundary nil t) | 813 | (when (and (search-forward boundary nil t) |
| 432 | (looking-at "[ \t]*\n")) | 814 | (looking-at "[ \t]*\n")) |
| 433 | (if parse-only | 815 | (if parse-tag |
| 434 | (narrow-to-region (match-end 0) (point-max)) | 816 | (narrow-to-region (match-end 0) (point-max)) |
| 435 | (delete-region (point-min) (match-end 0)))) | 817 | (delete-region (point-min) (match-end 0)))) |
| 818 | |||
| 819 | ;; Change content-type to the proper default one for the children. | ||
| 820 | (cond ((string-match "mixed" subtype) | ||
| 821 | (setq content-type '("text/plain"))) | ||
| 822 | ((string-match "digest" subtype) | ||
| 823 | (setq content-type '("message/rfc822")))) | ||
| 824 | |||
| 436 | ;; Loop over all body parts, where beg points at the beginning of | 825 | ;; Loop over all body parts, where beg points at the beginning of |
| 437 | ;; the part and end points at the end of the part. next points at | 826 | ;; the part and end points at the end of the part. next points at |
| 438 | ;; the beginning of the next part. | 827 | ;; the beginning of the next part. The current point is just |
| 828 | ;; after the boundary tag. | ||
| 439 | (setq beg (point-min)) | 829 | (setq beg (point-min)) |
| 440 | (while (search-forward boundary nil t) | 830 | (while (search-forward boundary nil t) |
| 441 | (setq end (match-beginning 0)) | 831 | (setq end (match-beginning 0)) |
| @@ -450,17 +840,46 @@ The other arguments are the same as `rmail-mime-multipart-handler'." | |||
| 450 | (rmail-mm-get-boundary-error-message | 840 | (rmail-mm-get-boundary-error-message |
| 451 | "Malformed boundary" content-type content-disposition | 841 | "Malformed boundary" content-type content-disposition |
| 452 | content-transfer-encoding))) | 842 | content-transfer-encoding))) |
| 843 | |||
| 844 | (setq index (1+ index)) | ||
| 453 | ;; Handle the part. | 845 | ;; Handle the part. |
| 454 | (if parse-only | 846 | (if parse-tag |
| 455 | (save-restriction | 847 | (save-restriction |
| 456 | (narrow-to-region beg end) | 848 | (narrow-to-region beg end) |
| 457 | (setq entities (cons (rmail-mime-process nil t) entities))) | 849 | (let ((child (rmail-mime-process |
| 850 | nil (format "%s/%d" parse-tag index) | ||
| 851 | content-type content-disposition))) | ||
| 852 | ;; Display a tagline. | ||
| 853 | (aset (aref (rmail-mime-entity-display child) 1) 1 | ||
| 854 | (aset (rmail-mime-entity-tagline child) 2 t)) | ||
| 855 | (push child entities))) | ||
| 856 | |||
| 458 | (delete-region end next) | 857 | (delete-region end next) |
| 459 | (save-restriction | 858 | (save-restriction |
| 460 | (narrow-to-region beg end) | 859 | (narrow-to-region beg end) |
| 461 | (rmail-mime-show))) | 860 | (rmail-mime-show))) |
| 462 | (goto-char (setq beg next))) | 861 | (goto-char (setq beg next))) |
| 463 | (nreverse entities))) | 862 | |
| 863 | (when parse-tag | ||
| 864 | (setq entities (nreverse entities)) | ||
| 865 | (if (string-match "alternative" subtype) | ||
| 866 | ;; Find the best entity to show, and hide all the others. | ||
| 867 | (let (best second) | ||
| 868 | (dolist (child entities) | ||
| 869 | (if (string= (or (car (rmail-mime-entity-disposition child)) | ||
| 870 | (car content-disposition)) | ||
| 871 | "inline") | ||
| 872 | (if (string-match "text/plain" | ||
| 873 | (car (rmail-mime-entity-type child))) | ||
| 874 | (setq best child) | ||
| 875 | (if (string-match "text/.*" | ||
| 876 | (car (rmail-mime-entity-type child))) | ||
| 877 | (setq second child))))) | ||
| 878 | (or best (not second) (setq best second)) | ||
| 879 | (dolist (child entities) | ||
| 880 | (or (eq best child) | ||
| 881 | (rmail-mime-hidden-mode child t))))) | ||
| 882 | entities))) | ||
| 464 | 883 | ||
| 465 | (defun test-rmail-mime-multipart-handler () | 884 | (defun test-rmail-mime-multipart-handler () |
| 466 | "Test of a mail used as an example in RFC 2046." | 885 | "Test of a mail used as an example in RFC 2046." |
| @@ -493,6 +912,40 @@ This is the epilogue. It is also to be ignored.")) | |||
| 493 | (insert mail) | 912 | (insert mail) |
| 494 | (rmail-mime-show t))) | 913 | (rmail-mime-show t))) |
| 495 | 914 | ||
| 915 | (defun rmail-mime-insert-multipart (entity) | ||
| 916 | "Presentation handler for a multipart MIME entity." | ||
| 917 | (let ((current (aref (rmail-mime-entity-display entity) 0)) | ||
| 918 | (new (aref (rmail-mime-entity-display entity) 1)) | ||
| 919 | (header (rmail-mime-entity-header entity)) | ||
| 920 | (tagline (rmail-mime-entity-tagline entity)) | ||
| 921 | (body (rmail-mime-entity-body entity)) | ||
| 922 | (beg (point)) | ||
| 923 | (segment (rmail-mime-entity-segment (point) entity))) | ||
| 924 | ;; header | ||
| 925 | (if (eq (aref current 0) (aref new 0)) | ||
| 926 | (goto-char (aref segment 2)) | ||
| 927 | (if (aref current 0) | ||
| 928 | (delete-char (- (aref segment 2) (aref segment 1)))) | ||
| 929 | (if (aref new 0) | ||
| 930 | (rmail-mime-insert-header header))) | ||
| 931 | ;; tagline | ||
| 932 | (if (eq (aref current 1) (aref new 1)) | ||
| 933 | (forward-char (- (aref segment 3) (aref segment 2))) | ||
| 934 | (if (aref current 1) | ||
| 935 | (delete-char (- (aref segment 3) (aref segment 2)))) | ||
| 936 | (if (aref new 1) | ||
| 937 | (rmail-mime-insert-tagline entity))) | ||
| 938 | |||
| 939 | (put-text-property beg (point) 'rmail-mime-entity entity) | ||
| 940 | ;; body | ||
| 941 | (if (eq (aref current 2) (aref new 2)) | ||
| 942 | (forward-char (- (aref segment 4) (aref segment 3))) | ||
| 943 | (if (aref current 2) | ||
| 944 | (delete-char (- (aref segment 4) (aref segment 3)))) | ||
| 945 | (if (aref new 2) | ||
| 946 | (dolist (child (rmail-mime-entity-children entity)) | ||
| 947 | (rmail-mime-insert child)))))) | ||
| 948 | |||
| 496 | ;;; Main code | 949 | ;;; Main code |
| 497 | 950 | ||
| 498 | (defun rmail-mime-handle (content-type | 951 | (defun rmail-mime-handle (content-type |
| @@ -565,7 +1018,9 @@ The current buffer must contain a single message. It will be | |||
| 565 | modified." | 1018 | modified." |
| 566 | (rmail-mime-process show-headers nil)) | 1019 | (rmail-mime-process show-headers nil)) |
| 567 | 1020 | ||
| 568 | (defun rmail-mime-process (show-headers parse-only) | 1021 | (defun rmail-mime-process (show-headers parse-tag &optional |
| 1022 | default-content-type | ||
| 1023 | default-content-disposition) | ||
| 569 | (let ((end (point-min)) | 1024 | (let ((end (point-min)) |
| 570 | content-type | 1025 | content-type |
| 571 | content-transfer-encoding | 1026 | content-transfer-encoding |
| @@ -596,45 +1051,76 @@ modified." | |||
| 596 | (setq content-type | 1051 | (setq content-type |
| 597 | (if content-type | 1052 | (if content-type |
| 598 | (mail-header-parse-content-type content-type) | 1053 | (mail-header-parse-content-type content-type) |
| 599 | ;; FIXME: Default "message/rfc822" in a "multipart/digest" | 1054 | (or default-content-type '("text/plain")))) |
| 600 | ;; according to RFC 2046. | ||
| 601 | '("text/plain"))) | ||
| 602 | (setq content-disposition | 1055 | (setq content-disposition |
| 603 | (if content-disposition | 1056 | (if content-disposition |
| 604 | (mail-header-parse-content-disposition content-disposition) | 1057 | (mail-header-parse-content-disposition content-disposition) |
| 605 | ;; If none specified, we are free to choose what we deem | 1058 | ;; If none specified, we are free to choose what we deem |
| 606 | ;; suitable according to RFC 2183. We like inline. | 1059 | ;; suitable according to RFC 2183. We like inline. |
| 607 | '("inline"))) | 1060 | (or default-content-disposition '("inline")))) |
| 608 | ;; Unrecognized disposition types are to be treated like | 1061 | ;; Unrecognized disposition types are to be treated like |
| 609 | ;; attachment according to RFC 2183. | 1062 | ;; attachment according to RFC 2183. |
| 610 | (unless (member (car content-disposition) '("inline" "attachment")) | 1063 | (unless (member (car content-disposition) '("inline" "attachment")) |
| 611 | (setq content-disposition '("attachment"))) | 1064 | (setq content-disposition '("attachment"))) |
| 612 | 1065 | ||
| 613 | (if parse-only | 1066 | (if parse-tag |
| 614 | (cond ((string-match "multipart/.*" (car content-type)) | 1067 | (let* ((is-inline (string= (car content-disposition) "inline")) |
| 615 | (setq end (1- end)) | 1068 | (header (vector (point-min) end nil)) |
| 616 | (save-restriction | 1069 | (tagline (vector parse-tag (cons nil nil) t)) |
| 617 | (let ((header (if show-headers (cons (point-min) end)))) | 1070 | (body (vector end (point-max) is-inline)) |
| 1071 | (new (vector (aref header 2) (aref tagline 2) (aref body 2))) | ||
| 1072 | children handler entity) | ||
| 1073 | (cond ((string-match "multipart/.*" (car content-type)) | ||
| 1074 | (save-restriction | ||
| 1075 | (narrow-to-region (1- end) (point-max)) | ||
| 1076 | (setq children (rmail-mime-process-multipart | ||
| 1077 | content-type | ||
| 1078 | content-disposition | ||
| 1079 | content-transfer-encoding | ||
| 1080 | parse-tag) | ||
| 1081 | handler 'rmail-mime-insert-multipart))) | ||
| 1082 | ((string-match "message/rfc822" (car content-type)) | ||
| 1083 | (save-restriction | ||
| 618 | (narrow-to-region end (point-max)) | 1084 | (narrow-to-region end (point-max)) |
| 619 | (rmail-mime-entity content-type | 1085 | (let* ((msg (rmail-mime-process t parse-tag |
| 620 | content-disposition | 1086 | '("text/plain") '("inline"))) |
| 621 | content-transfer-encoding | 1087 | (msg-new (aref (rmail-mime-entity-display msg) 1))) |
| 622 | header nil | 1088 | ;; Show header of the child. |
| 623 | (rmail-mime-process-multipart | 1089 | (aset msg-new 0 t) |
| 624 | content-type content-disposition | 1090 | (aset (rmail-mime-entity-header msg) 2 t) |
| 625 | content-transfer-encoding t))))) | 1091 | ;; Hide tagline of the child. |
| 626 | ((string-match "message/rfc822" (car content-type)) | 1092 | (aset msg-new 1 nil) |
| 627 | (or show-headers | 1093 | (aset (rmail-mime-entity-tagline msg) 2 nil) |
| 628 | (narrow-to-region end (point-max))) | 1094 | (setq children (list msg) |
| 629 | (rmail-mime-process t t)) | 1095 | handler 'rmail-mime-insert-multipart)))) |
| 630 | (t | 1096 | ((and is-inline (string-match "text/" (car content-type))) |
| 631 | (rmail-mime-entity content-type | 1097 | ;; Don't need a tagline. |
| 632 | content-disposition | 1098 | (aset new 1 (aset tagline 2 nil)) |
| 633 | content-transfer-encoding | 1099 | (setq handler 'rmail-mime-insert-text)) |
| 634 | nil | 1100 | (t |
| 635 | (cons end (point-max)) | 1101 | ;; Force hidden mode. |
| 636 | nil))) | 1102 | (aset new 1 (aset tagline 2 t)) |
| 1103 | (aset new 2 (aset body 2 nil)) | ||
| 1104 | (setq handler 'rmail-mime-insert-bulk))) | ||
| 1105 | (setq entity (rmail-mime-entity content-type | ||
| 1106 | content-disposition | ||
| 1107 | content-transfer-encoding | ||
| 1108 | (vector (vector nil nil nil) new) | ||
| 1109 | header tagline body children handler)) | ||
| 1110 | (if (and (eq handler 'rmail-mime-insert-bulk) | ||
| 1111 | (rmail-mime-set-bulk-data entity)) | ||
| 1112 | ;; Show the body. | ||
| 1113 | (aset new 2 (aset body 2 t))) | ||
| 1114 | entity) | ||
| 1115 | |||
| 637 | ;; Hide headers and handle the part. | 1116 | ;; Hide headers and handle the part. |
| 1117 | (put-text-property (point-min) (point-max) 'rmail-mime-entity | ||
| 1118 | (rmail-mime-entity | ||
| 1119 | content-type content-disposition | ||
| 1120 | content-transfer-encoding | ||
| 1121 | (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw)) | ||
| 1122 | (vector nil nil 'raw) (vector "" (cons nil nil) nil) | ||
| 1123 | (vector nil nil 'raw) nil nil)) | ||
| 638 | (save-restriction | 1124 | (save-restriction |
| 639 | (cond ((string= (car content-type) "message/rfc822") | 1125 | (cond ((string= (car content-type) "message/rfc822") |
| 640 | (narrow-to-region end (point-max))) | 1126 | (narrow-to-region end (point-max))) |
| @@ -643,102 +1129,117 @@ modified." | |||
| 643 | (rmail-mime-handle content-type content-disposition | 1129 | (rmail-mime-handle content-type content-disposition |
| 644 | content-transfer-encoding))))) | 1130 | content-transfer-encoding))))) |
| 645 | 1131 | ||
| 646 | (defun rmail-mime-insert-multipart (entity) | ||
| 647 | "Insert MIME-entity ENTITY of multipart type in the current buffer." | ||
| 648 | (let ((subtype (cadr (split-string (car (rmail-mime-entity-type entity)) | ||
| 649 | "/"))) | ||
| 650 | (disposition (rmail-mime-entity-disposition entity)) | ||
| 651 | (header (rmail-mime-entity-header entity)) | ||
| 652 | (children (rmail-mime-entity-children entity))) | ||
| 653 | (if header | ||
| 654 | (let ((pos (point))) | ||
| 655 | (or (bolp) | ||
| 656 | (insert "\n")) | ||
| 657 | (insert-buffer-substring rmail-buffer (car header) (cdr header)) | ||
| 658 | (rfc2047-decode-region pos (point)) | ||
| 659 | (insert "\n"))) | ||
| 660 | (cond | ||
| 661 | ((string= subtype "mixed") | ||
| 662 | (dolist (child children) | ||
| 663 | (rmail-mime-insert child '("text/plain") disposition))) | ||
| 664 | ((string= subtype "digest") | ||
| 665 | (dolist (child children) | ||
| 666 | (rmail-mime-insert child '("message/rfc822") disposition))) | ||
| 667 | ((string= subtype "alternative") | ||
| 668 | (let (best-plain-text best-text) | ||
| 669 | (dolist (child children) | ||
| 670 | (if (string= (or (car (rmail-mime-entity-disposition child)) | ||
| 671 | (car disposition)) | ||
| 672 | "inline") | ||
| 673 | (if (string-match "text/plain" | ||
| 674 | (car (rmail-mime-entity-type child))) | ||
| 675 | (setq best-plain-text child) | ||
| 676 | (if (string-match "text/.*" | ||
| 677 | (car (rmail-mime-entity-type child))) | ||
| 678 | (setq best-text child))))) | ||
| 679 | (if (or best-plain-text best-text) | ||
| 680 | (rmail-mime-insert (or best-plain-text best-text)) | ||
| 681 | ;; No child could be handled. Insert all. | ||
| 682 | (dolist (child children) | ||
| 683 | (rmail-mime-insert child nil disposition))))) | ||
| 684 | (t | ||
| 685 | ;; Unsupported subtype. Insert all of them. | ||
| 686 | (dolist (child children) | ||
| 687 | (rmail-mime-insert child)))))) | ||
| 688 | |||
| 689 | (defun rmail-mime-parse () | 1132 | (defun rmail-mime-parse () |
| 690 | "Parse the current Rmail message as a MIME message. | 1133 | "Parse the current Rmail message as a MIME message. |
| 691 | The value is a MIME-entiy object (see `rmail-mime-enty-new')." | 1134 | The value is a MIME-entiy object (see `rmail-mime-entity'). |
| 692 | (save-excursion | 1135 | If an error occurs, return an error message string." |
| 693 | (goto-char (point-min)) | 1136 | (let ((rmail-mime-mbox-buffer (if (rmail-buffers-swapped-p) |
| 694 | (condition-case nil | 1137 | rmail-view-buffer |
| 695 | (rmail-mime-process nil t) | 1138 | (current-buffer)))) |
| 696 | (error nil)))) | 1139 | (condition-case err |
| 697 | 1140 | (with-current-buffer rmail-mime-mbox-buffer | |
| 698 | (defun rmail-mime-insert (entity &optional content-type disposition) | 1141 | (save-excursion |
| 1142 | (goto-char (point-min)) | ||
| 1143 | (let* ((entity (rmail-mime-process t "" | ||
| 1144 | '("text/plain") '("inline"))) | ||
| 1145 | (new (aref (rmail-mime-entity-display entity) 1))) | ||
| 1146 | ;; Show header. | ||
| 1147 | (aset new 0 (aset (rmail-mime-entity-header entity) 2 t)) | ||
| 1148 | ;; Show tagline if and only if body is not shown. | ||
| 1149 | (if (aref new 2) | ||
| 1150 | (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil)) | ||
| 1151 | (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t))) | ||
| 1152 | entity))) | ||
| 1153 | (error (format "%s" err))))) | ||
| 1154 | |||
| 1155 | (defun rmail-mime-insert (entity) | ||
| 699 | "Insert a MIME-entity ENTITY in the current buffer. | 1156 | "Insert a MIME-entity ENTITY in the current buffer. |
| 700 | 1157 | ||
| 701 | This function will be called recursively if multiple parts are | 1158 | This function will be called recursively if multiple parts are |
| 702 | available." | 1159 | available." |
| 703 | (if (rmail-mime-entity-children entity) | 1160 | (let ((current (aref (rmail-mime-entity-display entity) 0)) |
| 704 | (rmail-mime-insert-multipart entity) | 1161 | (new (aref (rmail-mime-entity-display entity) 1))) |
| 705 | (setq content-type | 1162 | (if (not (eq (aref new 0) 'raw)) |
| 706 | (or (rmail-mime-entity-type entity) content-type)) | 1163 | ;; Not a raw-mode. Each handler should handle it. |
| 707 | (setq disposition | 1164 | (funcall (rmail-mime-entity-handler entity) entity) |
| 708 | (or (rmail-mime-entity-disposition entity) disposition)) | 1165 | (let ((header (rmail-mime-entity-header entity)) |
| 709 | (if (and (string= (car disposition) "inline") | 1166 | (tagline (rmail-mime-entity-tagline entity)) |
| 710 | (string-match "text/.*" (car content-type))) | 1167 | (body (rmail-mime-entity-body entity)) |
| 711 | (rmail-mime-insert-text entity) | 1168 | (beg (point)) |
| 712 | (rmail-mime-insert-bulk entity)))) | 1169 | (segment (rmail-mime-entity-segment (point) entity))) |
| 1170 | ;; header | ||
| 1171 | (if (eq (aref current 0) (aref new 0)) | ||
| 1172 | (goto-char (aref segment 2)) | ||
| 1173 | (if (aref current 0) | ||
| 1174 | (delete-char (- (aref segment 2) (aref segment 1)))) | ||
| 1175 | (insert-buffer-substring rmail-mime-mbox-buffer | ||
| 1176 | (aref header 0) (aref header 1))) | ||
| 1177 | ;; tagline | ||
| 1178 | (if (aref current 1) | ||
| 1179 | (delete-char (- (aref segment 3) (aref segment 2)))) | ||
| 1180 | ;; body | ||
| 1181 | (if (eq (aref current 2) (aref new 2)) | ||
| 1182 | (forward-char (- (aref segment 4) (aref segment 3))) | ||
| 1183 | (if (aref current 2) | ||
| 1184 | (delete-char (- (aref segment 4) (aref segment 3)))) | ||
| 1185 | (insert-buffer-substring rmail-mime-mbox-buffer | ||
| 1186 | (aref body 0) (aref body 1))) | ||
| 1187 | (put-text-property beg (point) 'rmail-mime-entity entity))) | ||
| 1188 | (dotimes (i 3) | ||
| 1189 | (aset current i (aref new i))))) | ||
| 713 | 1190 | ||
| 714 | (define-derived-mode rmail-mime-mode fundamental-mode "RMIME" | 1191 | (define-derived-mode rmail-mime-mode fundamental-mode "RMIME" |
| 715 | "Major mode used in `rmail-mime' buffers." | 1192 | "Major mode used in `rmail-mime' buffers." |
| 716 | (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil))) | 1193 | (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil))) |
| 717 | 1194 | ||
| 718 | ;;;###autoload | 1195 | ;;;###autoload |
| 719 | (defun rmail-mime () | 1196 | (defun rmail-mime (&optional arg) |
| 720 | "Process the current Rmail message as a MIME message. | 1197 | "Toggle displaying of a MIME message. |
| 721 | This creates a temporary \"*RMAIL*\" buffer holding a decoded | 1198 | |
| 722 | copy of the message. Inline content-types are handled according to | 1199 | The actualy behavior depends on the value of `rmail-enable-mime'. |
| 1200 | |||
| 1201 | If `rmail-enable-mime' is t (default), this command change the | ||
| 1202 | displaying of a MIME message between decoded presentation form | ||
| 1203 | and raw data. | ||
| 1204 | |||
| 1205 | With ARG, toggle the displaying of the current MIME entity only. | ||
| 1206 | |||
| 1207 | If `rmail-enable-mime' is nil, this creates a temporary | ||
| 1208 | \"*RMAIL*\" buffer holding a decoded copy of the message. Inline | ||
| 1209 | content-types are handled according to | ||
| 723 | `rmail-mime-media-type-handlers-alist'. By default, this | 1210 | `rmail-mime-media-type-handlers-alist'. By default, this |
| 724 | displays text and multipart messages, and offers to download | 1211 | displays text and multipart messages, and offers to download |
| 725 | attachments as specfied by `rmail-mime-attachment-dirs-alist'." | 1212 | attachments as specfied by `rmail-mime-attachment-dirs-alist'." |
| 726 | (interactive) | 1213 | (interactive "P") |
| 727 | (let ((data (rmail-apply-in-message rmail-current-message 'buffer-string)) | 1214 | (if rmail-enable-mime |
| 728 | (buf (get-buffer-create "*RMAIL*"))) | 1215 | (if (rmail-mime-message-p) |
| 729 | (set-buffer buf) | 1216 | (let ((rmail-mime-mbox-buffer rmail-view-buffer) |
| 730 | (setq buffer-undo-list t) | 1217 | (rmail-mime-view-buffer rmail-buffer) |
| 731 | (let ((inhibit-read-only t)) | 1218 | (entity (get-text-property (point) 'rmail-mime-entity))) |
| 732 | ;; Decoding the message in fundamental mode for speed, only | 1219 | (if arg |
| 733 | ;; switching to rmail-mime-mode at the end for display. Eg | 1220 | (if entity |
| 734 | ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993). | 1221 | (rmail-mime-toggle-raw entity)) |
| 735 | (fundamental-mode) | 1222 | (goto-char (point-min)) |
| 736 | (erase-buffer) | 1223 | (rmail-mime-toggle-raw |
| 737 | (insert data) | 1224 | (get-text-property (point) 'rmail-mime-entity)))) |
| 738 | (rmail-mime-show t) | 1225 | (message "Not a MIME message")) |
| 739 | (rmail-mime-mode) | 1226 | (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string)) |
| 740 | (set-buffer-modified-p nil)) | 1227 | (buf (get-buffer-create "*RMAIL*")) |
| 741 | (view-buffer buf))) | 1228 | (rmail-mime-mbox-buffer rmail-view-buffer) |
| 1229 | (rmail-mime-view-buffer buf)) | ||
| 1230 | (set-buffer buf) | ||
| 1231 | (setq buffer-undo-list t) | ||
| 1232 | (let ((inhibit-read-only t)) | ||
| 1233 | ;; Decoding the message in fundamental mode for speed, only | ||
| 1234 | ;; switching to rmail-mime-mode at the end for display. Eg | ||
| 1235 | ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993). | ||
| 1236 | (fundamental-mode) | ||
| 1237 | (erase-buffer) | ||
| 1238 | (insert data) | ||
| 1239 | (rmail-mime-show t) | ||
| 1240 | (rmail-mime-mode) | ||
| 1241 | (set-buffer-modified-p nil)) | ||
| 1242 | (view-buffer buf)))) | ||
| 742 | 1243 | ||
| 743 | (defun rmail-mm-get-boundary-error-message (message type disposition encoding) | 1244 | (defun rmail-mm-get-boundary-error-message (message type disposition encoding) |
| 744 | "Return MESSAGE with more information on the main mime components." | 1245 | "Return MESSAGE with more information on the main mime components." |
| @@ -747,34 +1248,41 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'." | |||
| 747 | 1248 | ||
| 748 | (defun rmail-show-mime () | 1249 | (defun rmail-show-mime () |
| 749 | "Function to set in `rmail-show-mime-function' (which see)." | 1250 | "Function to set in `rmail-show-mime-function' (which see)." |
| 750 | (let ((mbox-buf rmail-buffer) | 1251 | (let ((entity (rmail-mime-parse)) |
| 751 | (entity (rmail-mime-parse))) | 1252 | (rmail-mime-mbox-buffer rmail-buffer) |
| 752 | (if entity | 1253 | (rmail-mime-view-buffer rmail-view-buffer) |
| 753 | (with-current-buffer rmail-view-buffer | 1254 | (rmail-mime-coding-system nil)) |
| 754 | (let ((inhibit-read-only t) | 1255 | (if (vectorp entity) |
| 755 | (rmail-buffer mbox-buf)) | 1256 | (with-current-buffer rmail-mime-view-buffer |
| 756 | (erase-buffer) | 1257 | (erase-buffer) |
| 757 | (rmail-mime-insert entity))) | 1258 | (rmail-mime-insert entity) |
| 758 | ;; Decoding failed. Insert the original message body as is. | 1259 | (if rmail-mime-coding-system |
| 759 | (let ((region (with-current-buffer mbox-buf | 1260 | (set-buffer-file-coding-system rmail-mime-coding-system t t))) |
| 1261 | ;; Decoding failed. ENTITY is an error message. Insert the | ||
| 1262 | ;; original message body as is, and show warning. | ||
| 1263 | (let ((region (with-current-buffer rmail-mime-mbox-buffer | ||
| 760 | (goto-char (point-min)) | 1264 | (goto-char (point-min)) |
| 761 | (re-search-forward "^$" nil t) | 1265 | (re-search-forward "^$" nil t) |
| 762 | (forward-line 1) | 1266 | (forward-line 1) |
| 763 | (cons (point) (point-max))))) | 1267 | (vector (point-min) (point) (point-max))))) |
| 764 | (with-current-buffer rmail-view-buffer | 1268 | (with-current-buffer rmail-mime-view-buffer |
| 765 | (let ((inhibit-read-only t)) | 1269 | (let ((inhibit-read-only t)) |
| 766 | (erase-buffer) | 1270 | (erase-buffer) |
| 767 | (insert-buffer-substring mbox-buf (car region) (cdr region)))) | 1271 | (rmail-mime-insert-header region) |
| 768 | (message "MIME decoding failed"))))) | 1272 | (insert-buffer-substring rmail-mime-mbox-buffer |
| 1273 | (aref region 1) (aref region 2)))) | ||
| 1274 | (set-buffer-file-coding-system 'no-conversion t t) | ||
| 1275 | (message "MIME decoding failed: %s" entity))))) | ||
| 769 | 1276 | ||
| 770 | (setq rmail-show-mime-function 'rmail-show-mime) | 1277 | (setq rmail-show-mime-function 'rmail-show-mime) |
| 771 | 1278 | ||
| 772 | (defun rmail-insert-mime-forwarded-message (forward-buffer) | 1279 | (defun rmail-insert-mime-forwarded-message (forward-buffer) |
| 773 | "Function to set in `rmail-insert-mime-forwarded-message-function' (which see)." | 1280 | "Function to set in `rmail-insert-mime-forwarded-message-function' (which see)." |
| 774 | (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer))) | 1281 | (let ((rmail-mime-mbox-buffer |
| 1282 | (with-current-buffer forward-buffer rmail-view-buffer))) | ||
| 775 | (save-restriction | 1283 | (save-restriction |
| 776 | (narrow-to-region (point) (point)) | 1284 | (narrow-to-region (point) (point)) |
| 777 | (message-forward-make-body-mime mbox-buf)))) | 1285 | (message-forward-make-body-mime rmail-mime-mbox-buffer)))) |
| 778 | 1286 | ||
| 779 | (setq rmail-insert-mime-forwarded-message-function | 1287 | (setq rmail-insert-mime-forwarded-message-function |
| 780 | 'rmail-insert-mime-forwarded-message) | 1288 | 'rmail-insert-mime-forwarded-message) |
| @@ -795,15 +1303,16 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'." | |||
| 795 | "Function to set in `rmail-search-mime-message-function' (which see)." | 1303 | "Function to set in `rmail-search-mime-message-function' (which see)." |
| 796 | (save-restriction | 1304 | (save-restriction |
| 797 | (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg)) | 1305 | (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg)) |
| 798 | (let ((mbox-buf (current-buffer)) | 1306 | (let* ((rmail-mime-mbox-buffer (current-buffer)) |
| 799 | (header-end (save-excursion | 1307 | (rmail-mime-view-buffer rmail-view-buffer) |
| 800 | (re-search-forward "^$" nil 'move) (point))) | 1308 | (header-end (save-excursion |
| 801 | (body-end (point-max)) | 1309 | (re-search-forward "^$" nil 'move) (point))) |
| 802 | (entity (rmail-mime-parse))) | 1310 | (body-end (point-max)) |
| 803 | (or | 1311 | (entity (rmail-mime-parse))) |
| 1312 | (or | ||
| 804 | ;; At first, just search the headers. | 1313 | ;; At first, just search the headers. |
| 805 | (with-temp-buffer | 1314 | (with-temp-buffer |
| 806 | (insert-buffer-substring mbox-buf nil header-end) | 1315 | (insert-buffer-substring rmail-mime-mbox-buffer nil header-end) |
| 807 | (rfc2047-decode-region (point-min) (point)) | 1316 | (rfc2047-decode-region (point-min) (point)) |
| 808 | (goto-char (point-min)) | 1317 | (goto-char (point-min)) |
| 809 | (re-search-forward regexp nil t)) | 1318 | (re-search-forward regexp nil t)) |
| @@ -811,13 +1320,12 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'." | |||
| 811 | (if (and entity | 1320 | (if (and entity |
| 812 | (let* ((content-type (rmail-mime-entity-type entity)) | 1321 | (let* ((content-type (rmail-mime-entity-type entity)) |
| 813 | (charset (cdr (assq 'charset (cdr content-type))))) | 1322 | (charset (cdr (assq 'charset (cdr content-type))))) |
| 814 | (or (not (string-match "text/.*" (car content-type))) | 1323 | (or (not (string-match "text/.*" (car content-type))) |
| 815 | (and charset | 1324 | (and charset |
| 816 | (not (string= (downcase charset) "us-ascii")))))) | 1325 | (not (string= (downcase charset) "us-ascii")))))) |
| 817 | ;; Search the decoded MIME message. | 1326 | ;; Search the decoded MIME message. |
| 818 | (with-temp-buffer | 1327 | (with-temp-buffer |
| 819 | (let ((rmail-buffer mbox-buf)) | 1328 | (rmail-mime-insert entity) |
| 820 | (rmail-mime-insert entity)) | ||
| 821 | (goto-char (point-min)) | 1329 | (goto-char (point-min)) |
| 822 | (re-search-forward regexp nil t)) | 1330 | (re-search-forward regexp nil t)) |
| 823 | ;; Search the body without decoding. | 1331 | ;; Search the body without decoding. |
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 62bfbb740c4..7aed6a549ef 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el | |||
| @@ -392,7 +392,14 @@ The list is in preference order.") | |||
| 392 | (make-directory smtpmail-queue-dir t)) | 392 | (make-directory smtpmail-queue-dir t)) |
| 393 | (with-current-buffer buffer-data | 393 | (with-current-buffer buffer-data |
| 394 | (erase-buffer) | 394 | (erase-buffer) |
| 395 | (set-buffer-file-coding-system smtpmail-code-conv-from nil t) | 395 | (set-buffer-file-coding-system |
| 396 | ;; We will be reading the file with no-conversion in | ||
| 397 | ;; smtpmail-send-queued-mail below, so write it out | ||
| 398 | ;; with Unix EOLs. | ||
| 399 | (coding-system-change-eol-conversion | ||
| 400 | (or smtpmail-code-conv-from 'undecided) | ||
| 401 | 'unix) | ||
| 402 | nil t) | ||
| 396 | (insert-buffer-substring tembuf) | 403 | (insert-buffer-substring tembuf) |
| 397 | (write-file file-data) | 404 | (write-file file-data) |
| 398 | (set-buffer buffer-elisp) | 405 | (set-buffer buffer-elisp) |
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index a1ab5a8225c..df4057aba24 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el | |||
| @@ -190,17 +190,25 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") | |||
| 190 | 190 | ||
| 191 | ;;; Set default known names for external libraries | 191 | ;;; Set default known names for external libraries |
| 192 | (setq dynamic-library-alist | 192 | (setq dynamic-library-alist |
| 193 | '((xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll") | 193 | (list |
| 194 | (png "libpng12d.dll" "libpng12.dll" "libpng.dll" | 194 | '(xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll") |
| 195 | ;; these are libpng 1.2.8 from GTK+ | 195 | ;; Versions of libpng 1.4.x and later are incompatible with |
| 196 | "libpng13d.dll" "libpng13.dll") | 196 | ;; earlier versions. Set up the list of libraries according to |
| 197 | (jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll") | 197 | ;; the version we were compiled against. (If we were compiled |
| 198 | (tiff "libtiff3.dll" "libtiff.dll") | 198 | ;; without PNG support, libpng-version's value is -1.) |
| 199 | (gif "giflib4.dll" "libungif4.dll" "libungif.dll") | 199 | (if (>= libpng-version 10400) |
| 200 | (svg "librsvg-2-2.dll") | 200 | ;; libpng14-14.dll is libpng 1.4.3 from GTK+ |
| 201 | (gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") | 201 | '(png "libpng14-14.dll" "libpng14.dll") |
| 202 | (glib "libglib-2.0-0.dll") | 202 | '(png "libpng12d.dll" "libpng12.dll" "libpng3.dll" "libpng.dll" |
| 203 | (gobject "libgobject-2.0-0.dll"))) | 203 | ;; these are libpng 1.2.8 from GTK+ |
| 204 | "libpng13d.dll" "libpng13.dll")) | ||
| 205 | '(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll") | ||
| 206 | '(tiff "libtiff3.dll" "libtiff.dll") | ||
| 207 | '(gif "giflib4.dll" "libungif4.dll" "libungif.dll") | ||
| 208 | '(svg "librsvg-2-2.dll") | ||
| 209 | '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") | ||
| 210 | '(glib "libglib-2.0-0.dll") | ||
| 211 | '(gobject "libgobject-2.0-0.dll"))) | ||
| 204 | 212 | ||
| 205 | ;;; multi-tty support | 213 | ;;; multi-tty support |
| 206 | (defvar w32-initialized nil | 214 | (defvar w32-initialized nil |
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 5bf1a7c7894..067fa3a06d7 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el | |||
| @@ -3340,7 +3340,7 @@ or of the entire buffer, if the region is not selected." | |||
| 3340 | (defun rst-compile-pdf-preview () | 3340 | (defun rst-compile-pdf-preview () |
| 3341 | "Convert the document to a PDF file and launch a preview program." | 3341 | "Convert the document to a PDF file and launch a preview program." |
| 3342 | (interactive) | 3342 | (interactive) |
| 3343 | (let* ((tmp-filename "/tmp/out.pdf") | 3343 | (let* ((tmp-filename (make-temp-file "rst-out" nil ".pdf")) |
| 3344 | (command (format "rst2pdf.py %s %s && %s %s" | 3344 | (command (format "rst2pdf.py %s %s && %s %s" |
| 3345 | buffer-file-name tmp-filename | 3345 | buffer-file-name tmp-filename |
| 3346 | rst-pdf-program tmp-filename))) | 3346 | rst-pdf-program tmp-filename))) |
| @@ -3355,7 +3355,7 @@ or of the entire buffer, if the region is not selected." | |||
| 3355 | (defun rst-compile-slides-preview () | 3355 | (defun rst-compile-slides-preview () |
| 3356 | "Convert the document to an S5 slide presentation and launch a preview program." | 3356 | "Convert the document to an S5 slide presentation and launch a preview program." |
| 3357 | (interactive) | 3357 | (interactive) |
| 3358 | (let* ((tmp-filename "/tmp/slides.html") | 3358 | (let* ((tmp-filename (make-temp-file "rst-slides" nil ".html")) |
| 3359 | (command (format "rst2s5.py %s %s && %s %s" | 3359 | (command (format "rst2s5.py %s %s && %s %s" |
| 3360 | buffer-file-name tmp-filename | 3360 | buffer-file-name tmp-filename |
| 3361 | rst-slides-program tmp-filename))) | 3361 | rst-slides-program tmp-filename))) |
diff --git a/lisp/time.el b/lisp/time.el index 006fd758a7c..3fc17ec6eee 100644 --- a/lisp/time.el +++ b/lisp/time.el | |||
| @@ -463,7 +463,9 @@ update which can wait for the next redisplay." | |||
| 463 | "Toggle display of time, load level, and mail flag in mode lines. | 463 | "Toggle display of time, load level, and mail flag in mode lines. |
| 464 | With a numeric arg, enable this display if arg is positive. | 464 | With a numeric arg, enable this display if arg is positive. |
| 465 | 465 | ||
| 466 | When this display is enabled, it updates automatically every minute. | 466 | When this display is enabled, it updates automatically every minute |
| 467 | \(you can control the number of seconds between updates by | ||
| 468 | customizing `display-time-interval'). | ||
| 467 | If `display-time-day-and-date' is non-nil, the current day and date | 469 | If `display-time-day-and-date' is non-nil, the current day and date |
| 468 | are displayed as well. | 470 | are displayed as well. |
| 469 | This runs the normal hook `display-time-hook' after each update." | 471 | This runs the normal hook `display-time-hook' after each update." |
diff --git a/lisp/version.el b/lisp/version.el index b4e2c61b570..f1146e8a510 100644 --- a/lisp/version.el +++ b/lisp/version.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; version.el --- record version number of Emacs -*- no-byte-compile: t -*- | 1 | ;;; version.el --- record version number of Emacs -*- no-byte-compile: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003, | 3 | ;; Copyright (C) 1985, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003, |
| 4 | ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 | 4 | ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 |
| 5 | ;; Free Software Foundation, Inc. | 5 | ;; Free Software Foundation, Inc. |
| 6 | 6 | ||
| 7 | ;; Maintainer: FSF | 7 | ;; Maintainer: FSF |
| @@ -88,5 +88,4 @@ to the system configuration; look at `system-configuration' instead." | |||
| 88 | ;;version-control: never | 88 | ;;version-control: never |
| 89 | ;;End: | 89 | ;;End: |
| 90 | 90 | ||
| 91 | ;; arch-tag: e60dc445-6218-4a4c-a7df-f15a818642a0 | ||
| 92 | ;;; version.el ends here | 91 | ;;; version.el ends here |