aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorChong Yidong2011-01-02 15:31:19 -0500
committerChong Yidong2011-01-02 15:31:19 -0500
commit7c420169baa7c50428589cca7f8eda71b462eb15 (patch)
treeb556f9e181818bbaf8b5b425844b4ae26e88f537 /lisp
parentbb7f5cbcda931661c8dc3311603ac764fa87a639 (diff)
parentd12f22f52cb7bb18b46f5ea8de5d8e8e04733e3f (diff)
downloademacs-7c420169baa7c50428589cca7f8eda71b462eb15.tar.gz
emacs-7c420169baa7c50428589cca7f8eda71b462eb15.zip
Merge changes from emacs-23 branch
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog118
-rw-r--r--lisp/emulation/edt-mapper.el42
-rw-r--r--lisp/eshell/em-hist.el4
-rw-r--r--lisp/files.el5
-rw-r--r--lisp/help-fns.el14
-rw-r--r--lisp/isearch.el7
-rw-r--r--lisp/mail/binhex.el7
-rw-r--r--lisp/mail/mail-utils.el40
-rw-r--r--lisp/mail/rmail.el137
-rw-r--r--lisp/mail/rmailmm.el998
-rw-r--r--lisp/mail/smtpmail.el9
-rw-r--r--lisp/term/w32-win.el30
-rw-r--r--lisp/textmodes/rst.el4
-rw-r--r--lisp/time.el4
-rw-r--r--lisp/version.el3
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 @@
12011-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
62011-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
112011-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
192011-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
622011-01-02 Leo <sdl.web@gmail.com>
63
64 * help-fns.el (describe-variable): Fix previous change.
65
662011-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
732011-01-02 Chong Yidong <cyd@stupidchicken.com>
74
75 * help-fns.el (describe-variable): Don't emit trailing whitespace
76 (Bug#7511).
77
782011-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
832011-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
882011-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
932011-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
982011-01-02 Stefan Monnier <monnier@iro.umontreal.ca>
99
100 * files.el (file-local-variables-alist):
101 Make permanent-local (bug#7767).
102
1032011-01-02 Glenn Morris <rgm@gnu.org>
104
105 * version.el (emacs-copyright): Set short copyright year to 2011.
106
1072011-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
1122011-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
12010-12-31 Michael Albinus <michael.albinus@gmx.de> 1172010-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.
837If N is negative, find the next or Nth next match." 837If 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
2876specified. The actual value in the buffer may differ from VALUE, 2876specified. The actual value in the buffer may differ from VALUE,
2877if it is changed by the major or minor modes, or by the user.") 2877if 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.
246All addresses matching `rmail-dont-reply-to-names' are removed from 244All 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.
396The buffer should be narrowed to just the header." 394The 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" "\
4296Process the current Rmail message as a MIME message. 4293Toggle displaying of a MIME message.
4297This creates a temporary \"*RMAIL*\" buffer holding a decoded 4294
4298copy of the message. Inline content-types are handled according to 4295The actualy behavior depends on the value of `rmail-enable-mime'.
4296
4297If `rmail-enable-mime' is t (default), this command change the
4298displaying of a MIME message between decoded presentation form
4299and raw data.
4300
4301With ARG, toggle the displaying of the current MIME entity only.
4302
4303If `rmail-enable-mime' is nil, this creates a temporary
4304\"*RMAIL*\" buffer holding a decoded copy of the message. Inline
4305content-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
4300displays text and multipart messages, and offers to download 4307displays text and multipart messages, and offers to download
4301attachments as specfied by `rmail-mime-attachment-dirs-alist'. 4308attachments 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.
97The remaining elements are handler functions to run, in order of 97The remaining elements are handler functions to run, in order of
98decreasing preference. These are called until one returns non-nil. 98decreasing preference. These are called until one returns non-nil.
99Note that this only applies to items with an inline Content-Disposition, 99Note that this only applies to items with an inline Content-Disposition,
100all others are handled by `rmail-mime-bulk-handler'." 100all others are handled by `rmail-mime-bulk-handler'.
101Note 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.
140The value is usually nil, and bound to a proper value while
141processing MIME.")
142
143(defvar rmail-mime-view-buffer nil
144 "Buffer showing a message.
145The value is usually nil, and bound to a proper value while
146processing MIME.")
147
148(defvar rmail-mime-coding-system nil
149 "The first coding-system used for decoding a MIME entity.
150The value is usually nil, and bound to non-nil while inserting
151MIME 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
140A MIME-entity is a vector of 6 elements: 159A 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]
144TYPE and DISPOSITION correspond to MIME headers Content-Type: and 163
145Cotent-Disposition: respectively, and has this format: 164TYPE and DISPOSITION correspond to MIME headers Content-Type and
165Cotent-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:
161TRANSFER-ENCODING corresponds to MIME header 181TRANSFER-ENCODING corresponds to MIME header
162Content-Transfer-Encoding, and is a lowercased string. 182Content-Transfer-Encoding, and is a lowercased string.
163 183
164HEADER and BODY are a cons (BEG . END), where BEG and END specify 184DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
165the region of the corresponding part in RMAIL's data (mbox) 185the header, tagline, and body of the entity are displayed now,
166buffer. BODY may be nil. In that case, the current buffer is 186and NEW indicates how their displaying should be updated.
167narrowed to the body part. 187Both elements are vector [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
168 188where each element is a symbol for the corresponding item that
169CHILDREN is a list of MIME-entities for a \"multipart\" entity, and 189has these values:
170nil 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
194HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
195END specify the region of the header or body lines in RMAIL's
196data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
197header or body is, by default, displayed by the decoded
198presentation form.
199
200TAGLINE is a vector [TAG BULK-DATA DISPLAY-FLAG], where TAG is a
201string indicating the depth and index number of the entity,
202BULK-DATA is a cons (SIZE . TYPE) indicating the size and type of
203an attached data, DISPLAY-FLAG non-nil means that the tagline is,
204by default, displayed.
205
206CHILDREN is a list of child MIME-entities. A \"multipart/*\"
207entity have one or more children. A \"message/rfc822\" entity
208has just one child. Any other entity has no child.
209
210HANDLER is a function to insert the entity according to DISPLAY.
211It 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.
275Optional 2nd argument ENTITY is the MIME-entity at POS.
276The 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.
324A MIME entity has three items; header, tagline, and body.
325If we are in the last item of the entity, move point to the first
326item of the next entity. If we reach the end of buffer, move
327point to the first item of the first entity (i.e. the beginning
328of 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.
342A MIME entity has three items; header, tagline, and body.
343If we are at the beginning of the first item of the entity, move
344point to the last item of the previous entity. If we reach the
345beginning of buffer, move point to the last item of the last
346entity."
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.
367If TOP is non-nil, display ENTITY only by the tagline.
368Otherwise, 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.
452ITEM-LIST is a list of strings or button-elements (list) to be added
453to 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.
467HEADER is a vector [BEG END DEFAULT-STATUS].
468See `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."
270If 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
306depends upon the value of `rmail-mime-show-images'." 616depends 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.
625The value is non-nil if and only if the attachment object should be shown
626directly."
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."
313The optional second arg DATA, if non-nil, is a string containing
314the 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
397of the respective parsed headers. See `rmail-mime-handle' for their 775of the respective parsed headers. See `rmail-mime-handle' for their
398format." 776format."
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
408If PARSE-ONLY is nil, modify the current buffer directly for showing 787If PARSE-TAG is nil, modify the current buffer directly for
409the MIME body and return nil. 788showing the MIME body and return nil.
410 789
411Otherwise, just parse the current buffer and return a list of 790Otherwise, PARSE-TAG is a string indicating the depth and index
412MIME-entity objects. 791number of the entity. In this case, parse the current buffer and
792return a list of MIME-entity objects.
413 793
414The other arguments are the same as `rmail-mime-multipart-handler'." 794The 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
565modified." 1018modified."
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.
691The value is a MIME-entiy object (see `rmail-mime-enty-new')." 1134The value is a MIME-entiy object (see `rmail-mime-entity').
692 (save-excursion 1135If 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
701This function will be called recursively if multiple parts are 1158This function will be called recursively if multiple parts are
702available." 1159available."
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.
721This creates a temporary \"*RMAIL*\" buffer holding a decoded 1198
722copy of the message. Inline content-types are handled according to 1199The actualy behavior depends on the value of `rmail-enable-mime'.
1200
1201If `rmail-enable-mime' is t (default), this command change the
1202displaying of a MIME message between decoded presentation form
1203and raw data.
1204
1205With ARG, toggle the displaying of the current MIME entity only.
1206
1207If `rmail-enable-mime' is nil, this creates a temporary
1208\"*RMAIL*\" buffer holding a decoded copy of the message. Inline
1209content-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
724displays text and multipart messages, and offers to download 1211displays text and multipart messages, and offers to download
725attachments as specfied by `rmail-mime-attachment-dirs-alist'." 1212attachments 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.
464With a numeric arg, enable this display if arg is positive. 464With a numeric arg, enable this display if arg is positive.
465 465
466When this display is enabled, it updates automatically every minute. 466When this display is enabled, it updates automatically every minute
467\(you can control the number of seconds between updates by
468customizing `display-time-interval').
467If `display-time-day-and-date' is non-nil, the current day and date 469If `display-time-day-and-date' is non-nil, the current day and date
468are displayed as well. 470are displayed as well.
469This runs the normal hook `display-time-hook' after each update." 471This 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