[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r102737: Merge changes from emacs-23
|
From: |
Chong Yidong |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r102737: Merge changes from emacs-23 branch |
|
Date: |
Sun, 02 Jan 2011 15:31:19 -0500 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 102737 [merge]
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sun 2011-01-02 15:31:19 -0500
message:
Merge changes from emacs-23 branch
modified:
admin/ChangeLog
doc/emacs/ChangeLog
doc/emacs/frames.texi
doc/emacs/maintaining.texi
doc/emacs/rmail.texi
doc/emacs/trouble.texi
doc/lispref/ChangeLog
doc/lispref/modes.texi
doc/man/ChangeLog
doc/man/emacsclient.1
etc/ChangeLog
etc/NEWS.23
lib-src/ChangeLog
lib-src/ebrowse.c
lib-src/etags.c
lib-src/rcs2log
lisp/ChangeLog
lisp/emulation/edt-mapper.el
lisp/eshell/em-hist.el
lisp/files.el
lisp/help-fns.el
lisp/isearch.el
lisp/mail/binhex.el
lisp/mail/mail-utils.el
lisp/mail/rmail.el
lisp/mail/rmailmm.el
lisp/mail/smtpmail.el
lisp/term/w32-win.el
lisp/textmodes/rst.el
lisp/time.el
lisp/version.el
nextstep/ChangeLog
nextstep/Cocoa/Emacs.base/Contents/Info.plist
nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings
nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist
nt/ChangeLog
nt/INSTALL
nt/README.W32
nt/configure.bat
src/.gdbinit
src/ChangeLog
src/fileio.c
src/image.c
src/keyboard.c
src/window.c
src/xdisp.c
src/xterm.c
=== modified file 'admin/ChangeLog'
--- a/admin/ChangeLog 2010-12-27 01:27:08 +0000
+++ b/admin/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,8 @@
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * nt/README.W32: Update the information about PNG support libraries.
+ (Bug#7716)
+
2010-12-27 Stefan Monnier <address@hidden>
* bzrmerge.el: New file to help merge branches while skipping
=== modified file 'doc/emacs/ChangeLog'
--- a/doc/emacs/ChangeLog 2010-12-30 20:23:13 +0000
+++ b/doc/emacs/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,29 @@
+2011-01-02 Chong Yidong <address@hidden>
+
+ * rmail.texi (Rmail Display): Edit for grammar and conciseness.
+
+2011-01-02 Kenichi Handa <address@hidden>
+
+ * rmail.texi (Rmail Display): Describe new features of Rmail in Info.
+
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * frames.texi (Cut and Paste): Modify the section's name and text:
+ don't mix "cut/paste" with "kill/yank".
+ (Cut/Paste Other App): Describe the per-session emulation of PRIMARY.
+ (Bug#7702)
+
+ * trouble.texi (Checklist): Mention debug-on-quit. (Bug#7667)
+
+2011-01-02 Glenn Morris <address@hidden>
+
+ * maintaining.texi: Move inclusion of emerge after EDE, so that it
+ matches its position in the menu. (Bug#7674)
+
+2011-01-02 Glenn Morris <address@hidden>
+
+ * trouble.texi (Checklist): Mention not replying via news either.
+
2010-12-30 Tassilo Horn <address@hidden>
* misc.texi (Document View): Update DocView section with newly
=== modified file 'doc/emacs/frames.texi'
--- a/doc/emacs/frames.texi 2010-09-02 10:17:02 +0000
+++ b/doc/emacs/frames.texi 2011-01-02 20:28:40 +0000
@@ -58,10 +58,10 @@
@end menu
@node Cut and Paste
address@hidden Killing and Yanking on Graphical Displays
address@hidden Cutting and Pasting on Graphical Displays
- This section describes commands for selecting a region, killing, and
-yanking using the mouse.
+ This section describes commands for selecting a region, cutting, and
+pasting using the mouse.
@menu
* Mouse Commands:: Moving, cutting, and pasting, with the mouse.
@@ -248,6 +248,14 @@
selection, either in Emacs or in another X application, the previous
contents of the primary selection are lost.
address@hidden MS-Windows, and primary selection
+ MS-Windows provides no primary selection, but Emacs emulates it
+within a single Emacs session, by storing the selected text
+internally. Therefore, all the features and commands related to the
+primary selection work on Windows as they do on X, for cutting and
+pasting within the same session, but not across Emacs sessions or with
+other applications.
+
Whenever you kill some text using a command such as @kbd{C-w}
(@code{kill-region}), or copy it into the kill ring using a command
such as @kbd{M-w} (@code{kill-ring-save}), that text is also saved in
=== modified file 'doc/emacs/maintaining.texi'
--- a/doc/emacs/maintaining.texi 2010-12-21 07:10:31 +0000
+++ b/doc/emacs/maintaining.texi 2011-01-02 20:28:40 +0000
@@ -2354,7 +2354,3 @@
@ifnottex
@include emerge-xtra.texi
@end ifnottex
-
address@hidden
- arch-tag: b9d83dfb-82ea-4ff6-bab5-05a3617091fb
address@hidden ignore
=== modified file 'doc/emacs/rmail.texi'
--- a/doc/emacs/rmail.texi 2010-11-13 13:29:31 +0000
+++ b/doc/emacs/rmail.texi 2011-01-02 20:28:40 +0000
@@ -1101,57 +1101,90 @@
@node Rmail Display
@section Display of Messages
- Rmail reformats the header of each message before displaying it for
-the first time. Reformatting hides uninteresting header fields to
-reduce clutter. You can use the @kbd{t} command to show the entire
-header or to repeat the header reformatting operation.
+ This section describes how Rmail displays mail headers,
address@hidden sections and attachments, and URLs.
@table @kbd
@item t
Toggle display of complete header (@code{rmail-toggle-header}).
@end table
address@hidden t @r{(Rmail)}
address@hidden rmail-toggle-header
+ Before displaying each message for the first time, Rmail reformats
+its header, hiding uninteresting header fields to reduce clutter. The
address@hidden (@code{rmail-toggle-header}) command toggles this, switching
+between showing the reformatted header fields and showing the
+complete, original header. With a positive prefix argument, the
+command shows the reformatted header; with a zero or negative prefix
+argument, it shows the full header. Selecting the message again also
+reformats it if necessary.
+
@vindex rmail-ignored-headers
address@hidden rmail-displayed-headers
@vindex rmail-nonignored-headers
- Reformatting the header involves deleting most header fields, on the
-grounds that they are not interesting. The variable
address@hidden holds a regular expression that specifies
-which header fields to hide in this way---if it matches the beginning
-of a header field, that whole field is hidden. However, the variable
address@hidden provides a further override: a header
-matching that regular expression is shown even if it matches
address@hidden too.
-
address@hidden rmail-displayed-headers
- As an alternative to the previous two variables, you can set
address@hidden instead. If address@hidden, this should
-be a regular expression specifying which headers to display.
-
address@hidden t @r{(Rmail)}
address@hidden rmail-toggle-header
- To see the complete, original header, use the @kbd{t} command
-(@code{rmail-toggle-header}). This discards the reformatted headers of
-the current message and displays it with the original header. Repeating
address@hidden reformats the message again, which shows only the interesting
-headers according to the current values of the above variables.
-Selecting the message again also reformats it if necessary.
-
- When the @kbd{t} command has a prefix argument, a positive argument
-means to show the reformatted header, and a zero or negative argument
-means to show the full header.
+ The variable @code{rmail-ignored-headers} holds a regular expression
+specifying the header fields to hide; any matching header line will be
+hidden. The variable @code{rmail-nonignored-headers} overrides this:
+any header field matching that regular expression is shown even if it
+matches @code{rmail-ignored-headers} too. The variable
address@hidden is an alternative to these two
+variables; if address@hidden, this should be a regular expression
+specifying which headers to display (the default is @code{nil}).
@vindex rmail-highlighted-headers
Rmail highlights certain header fields that are especially
interesting---by default, the @samp{From} and @samp{Subject} fields.
-The variable @code{rmail-highlighted-headers} holds a regular expression
-that specifies the header fields to highlight; if it matches the
-beginning of a header field, that whole field is highlighted. To turn
-off this feature, set @code{rmail-highlighted-headers} to @code{nil}.
-Customize the face @code{rmail-highlight} to adjust the style of the
-highlighting.
-
- You can highlight and activate URLs in incoming messages using
-Goto Address mode:
+This highlighting uses the @code{rmail-highlight} face. The variable
address@hidden holds a regular expression specifying
+the header fields to highlight; if it matches the beginning of a
+header field, that whole field is highlighted. To disable this
+feature, set @code{rmail-highlighted-headers} to @code{nil}.
+
address@hidden MIME messages (Rmail)
address@hidden rmail-enable-mime
+ By default, Rmail automatically decodes @acronym{MIME} (Multipurpose
+Internet Mail Extensions) messages. If the message contains multiple
+parts (@acronym{MIME} entities), each part is represented by a tagline
+in the Rmail buffer. The tagline summarizes the part's depth, index,
+and type, and may also contain a button for handling it, e.g. saving
+it to a file or displaying it as an image in the Rmail buffer.
+
address@hidden @kbd
address@hidden rmail-mime-toggle-hidden
address@hidden @key{RET}
+Hide or show the @acronym{MIME} part at point
+(@code{rmail-mime-toggle-hidden}).
+
address@hidden rmail-mime-next-item
address@hidden @key{TAB}
+Move point to the next @acronym{MIME} part
+(@code{rmail-mime-next-item}).
+
address@hidden rmail-mime-previous-item
address@hidden @key{BackTab}
+Move point to the previous @acronym{MIME} part
+(@code{rmail-mime-previous-item}).
+
address@hidden rmail-mime
address@hidden v
address@hidden v @r{(Rmail)}
+Toggle between @acronym{MIME} display and raw message
+(@code{rmail-mime}).
address@hidden table
+
+ The @kbd{v} (@code{rmail-mime}) command toggles between the default
address@hidden display described above, and a ``raw'' display showing
+the undecoded @acronym{MIME} data. With a prefix argument, this
+command toggles the display of only an entity at point.
+
+ To prevent Rmail from handling MIME decoded messages, change the
+variable @code{rmail-enable-mime} to @code{nil}. When this is the
+case, the @kbd{v} (@code{rmail-mime}) command instead creates a
+temporary buffer to display the current @acronym{MIME} message.
+
+ You can highlight and activate URLs in the Rmail buffer using Goto
+Address mode:
@c FIXME goto-addr.el commentary says to use goto-address instead.
@smallexample
@@ -1163,13 +1196,6 @@
(or @kbd{Mouse-1} quickly) or by moving to one and typing @kbd{C-c
@key{RET}}. @xref{Goto Address mode, Activating URLs, Activating URLs}.
address@hidden MIME messages (Rmail)
address@hidden rmail-mime
address@hidden v @r{(Rmail)}
- The @kbd{v} (@code{rmail-mime}) command creates a temporary buffer
-displaying the current MIME message. By default, it displays plain text
-and multipart messages, and offers buttons to save attachments.
-
@node Rmail Coding
@section Rmail and Coding Systems
=== modified file 'doc/emacs/trouble.texi'
--- a/doc/emacs/trouble.texi 2010-12-10 03:33:51 +0000
+++ b/doc/emacs/trouble.texi 2010-12-25 10:35:16 +0000
@@ -630,9 +630,10 @@
All mail sent to the @samp{bug-gnu-emacs} mailing list is also
gatewayed to the @samp{gnu.emacs.bug} newsgroup. The reverse is also
-true, but we ask you not to post bug reports via the newsgroup. It
-can make it much harder to contact you if we need to ask for more
-information, and it does not integrate well with the bug tracker.
+true, but we ask you not to post bug reports (or replies) via the
+newsgroup. It can make it much harder to contact you if we need to ask
+for more information, and it does not integrate well with the bug
+tracker.
If your data is more than 500,000 bytes, please don't include it
directly in the bug report; instead, offer to send it on request, or
@@ -805,6 +806,13 @@
bug happen again. If you can't make it happen again, at least copy
the whole error message.
address@hidden debug-on-quit
+If Emacs appears to be stuck in an infinite loop or in a very long
+operation, typing @kbd{C-g} with the variable @code{debug-on-quit}
address@hidden will start the Lisp debugger and show a backtrace.
+This backtrace is useful for debugging such long loops, so if you can
+produce it, copy it into the bug report.
+
@item
Check whether any programs you have loaded into the Lisp world,
including your @file{.emacs} file, set any variables that may affect the
=== modified file 'doc/lispref/ChangeLog'
--- a/doc/lispref/ChangeLog 2010-12-18 16:28:15 +0000
+++ b/doc/lispref/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,12 @@
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * modes.texi (Emulating Mode Line): Fix last change.
+
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * modes.texi (Emulating Mode Line): Update documentation of
+ format-mode-line according to changes that fixed bug #7587.
+
2010-12-18 Stefan Monnier <address@hidden>
* modes.texi (Derived Modes): Mention prog-mode.
=== modified file 'doc/lispref/modes.texi'
--- a/doc/lispref/modes.texi 2010-12-18 16:28:15 +0000
+++ b/doc/lispref/modes.texi 2011-01-02 20:28:40 +0000
@@ -2112,29 +2112,38 @@
based on a certain mode-line specification.
@defun format-mode-line format &optional face window buffer
-This function formats a line of text according to @var{format} as if
-it were generating the mode line for @var{window}, but instead of
-displaying the text in the mode line or the header line, it returns
-the text as a string. The argument @var{window} defaults to the
-selected window. If @var{buffer} is address@hidden, all the
-information used is taken from @var{buffer}; by default, it comes from
address@hidden's buffer.
+This function formats a line of text according to @var{format} as if it
+were generating the mode line for @var{window}, but it also returns the
+text as a string. The argument @var{window} defaults to the selected
+window. If @var{buffer} is address@hidden, all the information used is
+taken from @var{buffer}; by default, it comes from @var{window}'s
+buffer.
The value string normally has text properties that correspond to the
-faces, keymaps, etc., that the mode line would have. And any character
-for which no @code{face} property is specified gets a default
-value which is usually @var{face}. (If @var{face} is @code{t},
-that stands for either @code{mode-line} if @var{window} is selected,
+faces, keymaps, etc., that the mode line would have. Any character for
+which no @code{face} property is specified by @var{format} gets a
+default value determined by @var{face}. If @var{face} is @code{t}, that
+stands for either @code{mode-line} if @var{window} is selected,
otherwise @code{mode-line-inactive}. If @var{face} is @code{nil} or
-omitted, that stands for no face property.)
-
-However, if @var{face} is an integer, the value has no text properties.
+omitted, that stands for the default face. If @var{face} is an integer,
+the value returned by this function will have no text properties.
+
+You can also specify other valid faces as the value of @var{face}.
+If specified, that face provides the @code{face} property for characters
+whose face is not specified by @var{format}.
+
+Note that using @code{mode-line}, @code{mode-line-inactive}, or
address@hidden as @var{face} will actually redisplay the mode line
+or the header line, respectively, using the current definitions of the
+corresponding face, in addition to returning the formatted string.
+(Other faces do not cause redisplay.)
For example, @code{(format-mode-line header-line-format)} returns the
text that would appear in the selected window's header line (@code{""}
if it has no header line). @code{(format-mode-line header-line-format
'header-line)} returns the same text, with each character
-carrying the face that it will have in the header line itself.
+carrying the face that it will have in the header line itself, and also
+redraws the header line.
@end defun
@node Imenu
=== modified file 'doc/man/ChangeLog'
--- a/doc/man/ChangeLog 2010-10-11 23:57:49 +0000
+++ b/doc/man/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,7 @@
+2011-01-02 Jari Aalto <address@hidden> (tiny change)
+
+ * emacsclient.1: Arrange options alphabetically (Bug#7620).
+
2010-10-12 Glenn Morris <address@hidden>
* emacs.1: Small fixes.
=== modified file 'doc/man/emacsclient.1'
--- a/doc/man/emacsclient.1 2008-12-13 04:14:26 +0000
+++ b/doc/man/emacsclient.1 2010-12-29 03:42:53 +0000
@@ -49,36 +49,36 @@
The programs follow the usual GNU command line syntax, with long
options starting with two dashes (`-').
.TP
-.B \-nw, \-t, \-\-tty
-open a new Emacs frame on the current terminal
+.B \-a, \-\-alternate-editor=EDITOR
+if the Emacs server is not running, run the specified editor instead.
+This can also be specified via the `ALTERNATE_EDITOR' environment variable.
+If the value of EDITOR is the empty string, then Emacs is started in
+daemon mode and emacsclient will try to connect to it.
.TP
.B -c, \-\-create-frame
create a new frame instead of trying to use the current Emacs frame
.TP
+.B \-d, \-\-display=DISPLAY
+tell the server to display the files on the given display.
+.TP
.B \-e, \-\-eval
do not visit files but instead evaluate the arguments as Emacs
Lisp expressions.
.TP
+.B \-f, \-\-server-file=FILENAME
+use TCP configuration file FILENAME for communication.
+This can also be specified via the `EMACS_SERVER_FILE' environment variable.
+.TP
.B \-n, \-\-no-wait
returns
immediately without waiting for you to "finish" the buffer in Emacs.
.TP
+.B \-nw, \-t, \-\-tty
+open a new Emacs frame on the current terminal
+.TP
.B \-s, \-\-socket-name=FILENAME
use socket named FILENAME for communication.
.TP
-.B \-f, \-\-server-file=FILENAME
-use TCP configuration file FILENAME for communication.
-This can also be specified via the `EMACS_SERVER_FILE' environment variable.
-.TP
-.B \-a, \-\-alternate-editor=EDITOR
-if the Emacs server is not running, run the specified editor instead.
-This can also be specified via the `ALTERNATE_EDITOR' environment variable.
-If the value of EDITOR is the empty string, then Emacs is started in
-daemon mode and emacsclient will try to connect to it.
-.TP
-.B \-d, \-\-display=DISPLAY
-tell the server to display the files on the given display.
-.TP
.B \-V, \-\-version
print version information and exit
.TP
=== modified file 'etc/ChangeLog'
--- a/etc/ChangeLog 2010-12-20 00:17:26 +0000
+++ b/etc/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,7 @@
+2011-01-02 Kenichi Handa <address@hidden>
+
+ * NEWS.23: Describe the changes for rmail's MIME handling.
+
2010-12-18 Chong Yidong <address@hidden>
* images/separator.xpm: Tweak colors.
=== modified file 'etc/NEWS.23'
--- a/etc/NEWS.23 2010-11-27 20:04:57 +0000
+++ b/etc/NEWS.23 2011-01-02 20:28:40 +0000
@@ -67,6 +67,27 @@
Git, Mercurial, and Monotone recognize "Author" and "Date".
Any unknown header is left as is in the message, so it is not lost.
+** Rmail
+
+*** The default value of `rmail-enable-mime' is now t. Rmail decodes
+MIME contents automatically. You can customize the variable
+`rmail-enable-mime' back to `nil' to disable this automatic MIME
+decoding.
+
+*** The command `rmail-mime' change the displaying of a MIME message
+between decoded presentation form and raw data if `rmail-enable-mime'
+is non-nil. And, with prefix argument, it change only the displaying
+of the MIME entity at point.
+
+*** The new command `rmail-mime-next-item' (bound to TAB) moves point
+to the next item of MIME message.
+
+*** The new command `rmail-mime-previous-item' (bound to backtab) moves
+point to the previous item of MIME message.
+
+*** The new command `rmail-mime-toggle-hidden' (RET) hide or show the
+body of the MIME entity at point.
+
** Obsolete packages
+++
=== modified file 'lib-src/ChangeLog'
--- a/lib-src/ChangeLog 2010-11-27 20:04:57 +0000
+++ b/lib-src/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,9 @@
+2011-01-02 Glenn Morris <address@hidden>
+
+ * ebrowse.c (version) <emacs_copyright>:
+ * etags.c (print_version) <emacs_copyright>:
+ * rcs2log (Copyright): Set short copyright year to 2011.
+
2010-11-27 Joe Matarazzo <address@hidden> (tiny change)
* ebrowse.c (yylex): If end of input buffer encountered while
=== modified file 'lib-src/ebrowse.c'
--- a/lib-src/ebrowse.c 2010-11-27 20:04:57 +0000
+++ b/lib-src/ebrowse.c 2011-01-02 20:28:40 +0000
@@ -1,8 +1,8 @@
/* ebrowse.c --- parsing files for the ebrowse C++ browser
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
- Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -3577,7 +3577,7 @@
version (void)
{
/* Makes it easier to update automatically. */
- char emacs_copyright[] = "Copyright (C) 2010 Free Software Foundation, Inc.";
+ char emacs_copyright[] = "Copyright (C) 2011 Free Software Foundation, Inc.";
printf ("ebrowse %s\n", VERSION);
puts (emacs_copyright);
@@ -3877,7 +3877,4 @@
return EXIT_SUCCESS;
}
-/* arch-tag: fc03b4bc-91a9-4c3d-b3b9-12a77fa86dd8
- (do not change this comment) */
-
/* ebrowse.c ends here */
=== modified file 'lib-src/etags.c'
--- a/lib-src/etags.c 2010-09-25 21:42:48 +0000
+++ b/lib-src/etags.c 2011-01-02 20:28:40 +0000
@@ -29,8 +29,8 @@
Copyright (C) 1984, 1987, 1988, 1989, 1993, 1994, 1995, 1998, 1999,
- 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
- Free Software Foundation, Inc.
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+ 2011 Free Software Foundation, Inc.
This file is not considered part of GNU Emacs.
@@ -891,7 +891,7 @@
print_version (void)
{
/* Makes it easier to update automatically. */
- char emacs_copyright[] = "Copyright (C) 2010 Free Software Foundation, Inc.";
+ char emacs_copyright[] = "Copyright (C) 2011 Free Software Foundation, Inc.";
printf ("%s (%s %s)\n", (CTAGS) ? "ctags" : "etags", EMACS_NAME, VERSION);
puts (emacs_copyright);
@@ -6725,7 +6725,4 @@
* End:
*/
-/* arch-tag: 8a9b748d-390c-4922-99db-2eeefa921051
- (do not change this comment) */
-
/* etags.c ends here */
=== modified file 'lib-src/rcs2log'
--- a/lib-src/rcs2log 2010-01-11 07:51:51 +0000
+++ b/lib-src/rcs2log 2011-01-02 02:46:30 +0000
@@ -3,8 +3,8 @@
# RCS to ChangeLog generator
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2001, 2002, 2003,
-# 2004, 2005, 2006, 2007, 2008, 2009, 2010
-# Free Software Foundation, Inc.
+# 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+# Free Software Foundation, Inc.
# Author: Paul Eggert <address@hidden>
@@ -22,7 +22,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
-Copyright='Copyright (C) 2010 Free Software Foundation, Inc.
+Copyright='Copyright (C) 2011 Free Software Foundation, Inc.
This program comes with NO WARRANTY, to the extent permitted by law.
You may redistribute copies of this program
under the terms of the GNU General Public License.
@@ -777,4 +777,3 @@
# tab-width:4
# End:
-# arch-tag: cea067bd-a552-4254-ba17-078208933073
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2010-12-31 19:57:05 +0000
+++ b/lisp/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,119 @@
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * term/w32-win.el (dynamic-library-alist): Set up correctly for
+ libpng versions both before and after 1.4.0. (Bug#7716)
+
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * time.el (display-time-mode): Mention display-time-interval in
+ the doc string. (Bug#7713)
+
+2011-01-02 Kenichi Handa <address@hidden>
+
+ * mail/rmailmm.el (rmail-mime-parse): Perform parsing in
+ condition-case and return an error message string if something
+ goes wrong.
+ (rmail-show-mime): Adjust for the above change. Insert the
+ header by rmail-mime-insert-header.
+
+2011-01-02 Kenichi Handa <address@hidden>
+
+ * mail/rmailmm.el: New key bindings for rmail-mime-next-item,
+ rmail-mime-previous-item, and rmail-mime-toggle-hidden.
+ (rmail-mime-mbox-buffer)
+ (rmail-mime-view-buffer, rmail-mime-coding-system): New variables.
+ (rmail-mime-entity): Argument changed. All codes handling an
+ entity object are changed.
+ (rmail-mime-entity-header, rmail-mime-entity-body): Adjust for
+ the above change.
+ (rmail-mime-entity-children, rmail-mime-entity-handler)
+ (rmail-mime-entity-tagline): New functions.
+ (rmail-mime-message-p): New function.
+ (rmail-mime-save): Bind rmail-mime-mbox-buffer.
+ (rmail-mime-entity-segment, rmail-mime-next-item)
+ (rmail-mime-previous-item, rmail-mime-shown-mode)
+ (rmail-mime-hidden-mode, rmail-mime-raw-mode)
+ (rmail-mime-toggle-raw, rmail-mime-toggle-hidden)
+ (rmail-mime-insert-tagline, rmail-mime-insert-header):
+ New functions.
+ (rmail-mime-text-handler): Call rmail-mime-insert-text.
+ (rmail-mime-insert-decoded-text): New function.
+ (rmail-mime-insert-text): Call rmail-mime-insert-decoded-text.
+ (rmail-mime-insert-image): Argument changed. Caller changed.
+ (rmail-mime-image): Call rmail-mime-toggle-hidden.
+ (rmail-mime-set-bulk-data): New funciton.
+ (rmail-mime-insert-bulk): Argument changed.
+ (rmail-mime-multipart-handler): Return t.
+ (rmail-mime-process-multipart): Argument changed.
+ Handle "multipart/alternative" here.
+ (rmail-mime-process): Argument changed.
+ (rmail-mime-parse): Bind rmail-mime-mbox-buffer.
+ (rmail-mime-insert): Argument changed. Handle raw display mode.
+ (rmail-mime): Argument changed. Handle toggling of raw display
+ mode.
+ (rmail-show-mime): Bind rmail-mime-mbox-buffer and
+ rmail-mime-view-buffer.
+ (rmail-insert-mime-forwarded-message): Likewise.
+ (rmail-search-mime-message): Likewise. Don't bind rmail-buffer.
+
+ * mail/rmail.el (rmail-show-message-1): If rmail-enable-mime is
+ non-nil, handle the header in rmail-show-mime-function.
+
+2011-01-02 Leo <address@hidden>
+
+ * help-fns.el (describe-variable): Fix previous change.
+
+2011-01-02 Juri Linkov <address@hidden>
+
+ * isearch.el (isearch-lazy-highlight-error): New variable.
+ (isearch-lazy-highlight-new-loop): Compare `isearch-error' and
+ `isearch-lazy-highlight-error'. Set `isearch-lazy-highlight-error'
+ to the current value of `isearch-error' (Bug#7468).
+
+2011-01-02 Chong Yidong <address@hidden>
+
+ * help-fns.el (describe-variable): Don't emit trailing whitespace
+ (Bug#7511).
+
+2011-01-02 Chong Yidong <address@hidden>
+
+ * textmodes/rst.el (rst-compile-pdf-preview)
+ (rst-compile-slides-preview): Use make-temp-file (Bug#7646).
+
+2011-01-02 Kevin Gallagher <address@hidden>
+
+ * emulation/edt-mapper.el: Override mapping of function keys so
+ that the later call to read-key-sequence works.
+
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * mail/smtpmail.el (smtpmail-send-it): Write queued mail body with
+ Unix EOLs. (Bug#7589)
+
+2011-01-02 Leo <address@hidden>
+
+ * eshell/em-hist.el (eshell-previous-matching-input): Signal error
+ if point is not behind eshell-last-output-end (Bug#7585).
+
+2011-01-02 Stefan Monnier <address@hidden>
+
+ * files.el (file-local-variables-alist):
+ Make permanent-local (bug#7767).
+
+2011-01-02 Glenn Morris <address@hidden>
+
+ * version.el (emacs-copyright): Set short copyright year to 2011.
+
+2011-01-02 Mark Lillibridge <address@hidden> (tiny change)
+
+ * mail/mail-utils.el (mail-strip-quoted-names): Avoid clobbering
+ an existing temp buffer. (Bug#7746)
+
+2011-01-02 Glenn Morris <address@hidden>
+
+ * mail/mail-utils.el (mail-mbox-from): Handle From: headers with
+ multiple addresses. (Bug#7760)
+
2010-12-31 Michael Albinus <address@hidden>
* net/tramp-sh.el (tramp-methods): Add recursive options to "scpc"
@@ -20285,7 +20401,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+ Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
This file is part of GNU Emacs.
=== modified file 'lisp/emulation/edt-mapper.el'
--- a/lisp/emulation/edt-mapper.el 2010-08-29 16:17:13 +0000
+++ b/lisp/emulation/edt-mapper.el 2011-01-02 20:28:40 +0000
@@ -142,6 +142,48 @@
(setq edt-term (getenv "TERM")))
;;;
+;;; Implements a workaround for a feature that was added to simple.el.
+;;;
+;;; Many function keys have no Emacs functions assigned to them by
+;;; default. A subset of these are typically assigned functions in the
+;;; EDT emulation. This includes all the keypad keys and a some others
+;;; like Delete.
+;;;
+;;; Logic in simple.el maps some of these unassigned function keys to
+;;; ordinary typing keys. Where this is the case, a call to
+;;; read-key-sequence, below, does not return the name of the function
+;;; key pressd by the user but, instead, it returns the name of the
+;;; key to which it has been mapped. It needs to know the name of the
+;;; key pressed by the user. As a workaround, we assign a function to
+;;; each of the unassigned function keys of interest, here. These
+;;; assignments override the mapping to other keys and are only
+;;; temporary since, when edt-mapper is finished executing, it causes
+;;; Emacs to exit.
+;;;
+
+(mapc
+ (lambda (function-key)
+ (if (not (lookup-key (current-global-map) function-key))
+ (define-key (current-global-map) function-key 'forward-char)))
+ '([kp-0] [kp-1] [kp-2] [kp-3] [kp-4]
+ [kp-5] [kp-6] [kp-7] [kp-8] [kp-9]
+ [kp-space]
+ [kp-tab]
+ [kp-enter]
+ [kp-multiply]
+ [kp-add]
+ [kp-separator]
+ [kp-subtract]
+ [kp-decimal]
+ [kp-divide]
+ [kp-equal]
+ [backspace]
+ [delete]
+ [tab]
+ [linefeed]
+ [clear]))
+
+;;;
;;; Make sure the window is big enough to display the instructions,
;;; except where window cannot be re-sized.
;;;
=== modified file 'lisp/eshell/em-hist.el'
--- a/lisp/eshell/em-hist.el 2010-09-25 21:51:55 +0000
+++ b/lisp/eshell/em-hist.el 2011-01-02 20:28:40 +0000
@@ -837,6 +837,8 @@
If N is negative, find the next or Nth next match."
(interactive (eshell-regexp-arg "Previous input matching (regexp): "))
(setq arg (eshell-search-arg arg))
+ (if (> eshell-last-output-end (point))
+ (error "Point not located after prompt"))
(let ((pos (eshell-previous-matching-input-string-position regexp arg)))
;; Has a match been found?
(if (null pos)
@@ -844,7 +846,7 @@
(setq eshell-history-index pos)
(unless (minibuffer-window-active-p (selected-window))
(message "History item: %d" (- (ring-length eshell-history-ring) pos)))
- ;; Can't use kill-region as it sets this-command
+ ;; Can't use kill-region as it sets this-command
(delete-region eshell-last-output-end (point))
(insert-and-inherit (eshell-get-history pos)))))
=== modified file 'lisp/files.el'
--- a/lisp/files.el 2010-12-30 18:08:18 +0000
+++ b/lisp/files.el 2011-01-02 20:28:40 +0000
@@ -1,8 +1,8 @@
;;; files.el --- file input and output commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996,
-;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Package: emacs
@@ -2876,6 +2876,7 @@
specified. The actual value in the buffer may differ from VALUE,
if it is changed by the major or minor modes, or by the user.")
(make-variable-buffer-local 'file-local-variables-alist)
+(put 'file-local-variables-alist 'permanent-local t)
(defvar dir-local-variables-alist nil
"Alist of directory-local variable settings in the current buffer.
=== modified file 'lisp/help-fns.el'
--- a/lisp/help-fns.el 2010-12-21 06:45:11 +0000
+++ b/lisp/help-fns.el 2011-01-02 20:28:40 +0000
@@ -639,19 +639,16 @@
(if valvoid
(princ " is void as a variable.")
(princ "'s "))))
- (if valvoid
- nil
+ (unless valvoid
(with-current-buffer standard-output
(setq val-start-pos (point))
(princ "value is ")
- (terpri)
(let ((from (point)))
+ (terpri)
(pp val)
- ;; Hyperlinks in variable's value are quite frequently
- ;; inappropriate e.g C-h v <RET> features <RET>
- ;; (help-xref-on-pp from (point))
- (if (< (point) (+ from 20))
- (delete-region (1- from) from))
+ (if (< (point) (+ 68 (line-beginning-position 0)))
+ (delete-region from (1+ from))
+ (delete-region (1- from) from))
(let* ((sv (get variable 'standard-value))
(origval (and (consp sv)
(condition-case nil
@@ -666,7 +663,6 @@
(if (< (point) (+ from 20))
(delete-region (1- from) from)))))))
(terpri)
-
(when locus
(if (bufferp locus)
(princ (format "%socal in buffer %s; "
=== modified file 'lisp/isearch.el'
--- a/lisp/isearch.el 2010-10-02 02:46:13 +0000
+++ b/lisp/isearch.el 2011-01-02 20:28:40 +0000
@@ -2581,6 +2581,7 @@
(defvar isearch-lazy-highlight-regexp nil)
(defvar isearch-lazy-highlight-space-regexp nil)
(defvar isearch-lazy-highlight-forward nil)
+(defvar isearch-lazy-highlight-error nil)
(defun lazy-highlight-cleanup (&optional force)
"Stop lazy highlighting and remove extra highlighting from current buffer.
@@ -2622,9 +2623,13 @@
(not (= (window-end) ; Window may have been split/joined.
isearch-lazy-highlight-window-end))
(not (eq isearch-forward
- isearch-lazy-highlight-forward))))
+ isearch-lazy-highlight-forward))
+ ;; In case we are recovering from an error.
+ (not (equal isearch-error
+ isearch-lazy-highlight-error))))
;; something important did indeed change
(lazy-highlight-cleanup t) ;kill old loop & remove overlays
+ (setq isearch-lazy-highlight-error isearch-error)
(when (not isearch-error)
(setq isearch-lazy-highlight-start-limit beg
isearch-lazy-highlight-end-limit end)
=== modified file 'lisp/mail/binhex.el'
--- a/lisp/mail/binhex.el 2010-09-02 00:55:51 +0000
+++ b/lisp/mail/binhex.el 2011-01-02 20:28:40 +0000
@@ -1,4 +1,4 @@
-;;; binhex.el --- elisp native binhex decode
+;;; binhex.el --- decode BinHex-encoded text
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
@@ -23,6 +23,11 @@
;;; Commentary:
+;; BinHex is a binary-to-text encoding scheme similar to uuencode.
+;; The command `binhex-decode-region' decodes BinHex-encoded text, via
+;; the external program "hexbin" if that is available, or an Emacs
+;; Lisp implementation if not.
+
;;; Code:
(eval-when-compile (require 'cl))
=== modified file 'lisp/mail/mail-utils.el'
--- a/lisp/mail/mail-utils.el 2010-12-14 04:26:01 +0000
+++ b/lisp/mail/mail-utils.el 2011-01-02 20:28:40 +0000
@@ -1,7 +1,7 @@
;;; mail-utils.el --- utility functions used both by rmail and rnews
;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Free Software Foundation, Inc.
+;; 2009, 2010, 2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail, news
@@ -185,8 +185,7 @@
;; Detect nested comments.
(if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address)
;; Strip nested comments.
- (with-current-buffer (get-buffer-create " *temp*")
- (erase-buffer)
+ (with-temp-buffer
(insert address)
(set-syntax-table lisp-mode-syntax-table)
(goto-char 1)
@@ -199,8 +198,7 @@
(forward-sexp 1)
(error (goto-char (point-max))))
(point))))
- (setq address (buffer-string))
- (erase-buffer))
+ (setq address (buffer-string)))
;; Strip non-nested comments an easier way.
(while (setq pos (string-match
;; This doesn't hack rfc822 nested comments
@@ -235,12 +233,12 @@
nil 'literal address 2)))
address))))
-;;; The following piece of ugliness is legacy code. The name was an
-;;; unfortunate choice --- a flagrant violation of the Emacs Lisp
-;;; coding conventions. `mail-dont-reply-to' would have been
-;;; infinitely better. Also, `rmail-dont-reply-to-names' might have
-;;; been better named `mail-dont-reply-to-names' and sourced from this
-;;; file instead of in rmail.el. Yuck. -pmr
+;; The following piece of ugliness is legacy code. The name was an
+;; unfortunate choice --- a flagrant violation of the Emacs Lisp
+;; coding conventions. `mail-dont-reply-to' would have been
+;; infinitely better. Also, `rmail-dont-reply-to-names' might have
+;; been better named `mail-dont-reply-to-names' and sourced from this
+;; file instead of in rmail.el. Yuck. -pmr
(defun rmail-dont-reply-to (destinations)
"Prune addresses from DESTINATIONS, a list of recipient addresses.
All addresses matching `rmail-dont-reply-to-names' are removed from
@@ -394,13 +392,19 @@
(defun mail-mbox-from ()
"Return an mbox \"From \" line for the current message.
The buffer should be narrowed to just the header."
- (let ((from (or (mail-fetch-field "from")
- (mail-fetch-field "really-from")
- (mail-fetch-field "sender")
- (mail-fetch-field "return-path")
- "unknown"))
- (date (mail-fetch-field "date")))
- (format "From %s %s\n" (mail-strip-quoted-names from)
+ (let* ((from (mail-strip-quoted-names (or (mail-fetch-field "from")
+ (mail-fetch-field "really-from")
+ (mail-fetch-field "sender")
+ (mail-fetch-field "return-path")
+ "unknown")))
+ (date (mail-fetch-field "date"))
+ ;; A From: header can contain multiple addresses, a "From "
+ ;; line must contain only one. (Bug#7760)
+ ;; See eg RFC 5322, 3.6.2. Originator Fields.
+ (end (string-match "[ \t]*[,\n]" from)))
+ (format "From %s %s\n" (if end
+ (substring from 0 end)
+ from)
(or (and date
(ignore-errors
(current-time-string (date-to-time date))))
=== modified file 'lisp/mail/rmail.el'
--- a/lisp/mail/rmail.el 2010-12-15 02:05:38 +0000
+++ b/lisp/mail/rmail.el 2011-01-02 20:31:19 +0000
@@ -2691,75 +2691,72 @@
(message "Showing message %d" msg))
(narrow-to-region beg end)
(goto-char beg)
+ (with-current-buffer rmail-view-buffer
+ ;; We give the view buffer a buffer-local value of
+ ;; rmail-header-style based on the binding in effect when
+ ;; this function is called; `rmail-toggle-headers' can
+ ;; inspect this value to determine how to toggle.
+ (set (make-local-variable 'rmail-header-style) header-style))
(if (and rmail-enable-mime
(re-search-forward "mime-version: 1.0" nil t))
(let ((rmail-buffer mbox-buf)
(rmail-view-buffer view-buf))
(funcall rmail-show-mime-function))
- (setq body-start (search-forward "\n\n" nil t))
- (narrow-to-region beg (point))
- (goto-char beg)
- (save-excursion
- (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
- (setq coding-system (intern (match-string 1)))
- (setq coding-system (rmail-get-coding-system))))
- (setq character-coding (mail-fetch-field "content-transfer-encoding")
- is-text-message (rmail-is-text-p))
- (if character-coding
- (setq character-coding (downcase character-coding)))
- (narrow-to-region beg end)
- ;; Decode the message body into an empty view buffer using a
- ;; unibyte temporary buffer where the character decoding takes
- ;; place.
- (with-current-buffer rmail-view-buffer
- (erase-buffer))
- (if (null character-coding)
- ;; Do it directly since that is fast.
- (rmail-decode-region body-start end coding-system view-buf)
- ;; Can this be done directly, skipping the temp buffer?
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-buffer-substring mbox-buf body-start end)
- (cond
- ((string= character-coding "quoted-printable")
- ;; See bug#5441.
- (or (mail-unquote-printable-region (point-min) (point-max)
- nil t 'unibyte)
- (message "Malformed MIME quoted-printable message")))
- ((and (string= character-coding "base64") is-text-message)
- (condition-case err
- (base64-decode-region (point-min) (point-max))
- (error (message "%s" (cdr err)))))
- ((eq character-coding 'uuencode)
- (error "uuencoded messages are not supported yet"))
- (t))
- (rmail-decode-region (point-min) (point-max)
- coding-system view-buf))))
- (with-current-buffer rmail-view-buffer
- ;; We give the view buffer a buffer-local value of
- ;; rmail-header-style based on the binding in effect when
- ;; this function is called; `rmail-toggle-headers' can
- ;; inspect this value to determine how to toggle.
- (set (make-local-variable 'rmail-header-style) header-style)
- ;; Unquote quoted From lines
- (goto-char (point-min))
- (while (re-search-forward "^>+From " nil t)
- (beginning-of-line)
- (delete-char 1)
- (forward-line))
- (goto-char (point-min)))
- ;; Copy the headers to the front of the message view buffer.
- (rmail-copy-headers beg end)
- ;; Add the separator (blank line) between headers and body;
+ (setq body-start (search-forward "\n\n" nil t))
+ (narrow-to-region beg (point))
+ (goto-char beg)
+ (save-excursion
+ (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
+ (setq coding-system (intern (match-string 1)))
+ (setq coding-system (rmail-get-coding-system))))
+ (setq character-coding (mail-fetch-field "content-transfer-encoding")
+ is-text-message (rmail-is-text-p))
+ (if character-coding
+ (setq character-coding (downcase character-coding)))
+ (narrow-to-region beg end)
+ ;; Decode the message body into an empty view buffer using a
+ ;; unibyte temporary buffer where the character decoding takes
+ ;; place.
+ (with-current-buffer rmail-view-buffer
+ (erase-buffer))
+ (if (null character-coding)
+ ;; Do it directly since that is fast.
+ (rmail-decode-region body-start end coding-system view-buf)
+ ;; Can this be done directly, skipping the temp buffer?
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-buffer-substring mbox-buf body-start end)
+ (cond
+ ((string= character-coding "quoted-printable")
+ ;; See bug#5441.
+ (or (mail-unquote-printable-region (point-min) (point-max)
+ nil t 'unibyte)
+ (message "Malformed MIME quoted-printable message")))
+ ((and (string= character-coding "base64") is-text-message)
+ (condition-case err
+ (base64-decode-region (point-min) (point-max))
+ (error (message "%s" (cdr err)))))
+ ((eq character-coding 'uuencode)
+ (error "uuencoded messages are not supported yet"))
+ (t))
+ (rmail-decode-region (point-min) (point-max)
+ coding-system view-buf)))
+ (with-current-buffer rmail-view-buffer
+ ;; Prepare the separator (blank line) before the body.
+ (goto-char (point-min))
+ (insert "\n")
+ ;; Unquote quoted From lines
+ (while (re-search-forward "^>+From " nil t)
+ (beginning-of-line)
+ (delete-char 1)
+ (forward-line))
+ (goto-char (point-min)))
+ ;; Copy the headers to the front of the message view buffer.
+ (rmail-copy-headers beg end))
;; highlight the message, activate any URL like text and add
;; special highlighting for and quoted material.
(with-current-buffer rmail-view-buffer
- (insert "\n")
(goto-char (point-min))
- ;; Decode the headers according to RFC2047.
- (save-excursion
- (search-forward "\n\n" nil 'move)
- (rfc2047-decode-region (point-min) (point)))
(rmail-highlight-headers)
;(rmail-activate-urls)
;(rmail-process-quoted-material)
@@ -4289,18 +4286,28 @@
;;;***
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el"
"b1ce015fd919b54cc7b1d0b2155489f9")
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el"
"3735f9bfe6ff3e612091857cc6b401b6")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\
-Process the current Rmail message as a MIME message.
-This creates a temporary \"*RMAIL*\" buffer holding a decoded
-copy of the message. Inline content-types are handled according to
+Toggle displaying of a MIME message.
+
+The actualy behavior depends on the value of `rmail-enable-mime'.
+
+If `rmail-enable-mime' is t (default), this command change the
+displaying of a MIME message between decoded presentation form
+and raw data.
+
+With ARG, toggle the displaying of the current MIME entity only.
+
+If `rmail-enable-mime' is nil, this creates a temporary
+\"*RMAIL*\" buffer holding a decoded copy of the message. Inline
+content-types are handled according to
`rmail-mime-media-type-handlers-alist'. By default, this
displays text and multipart messages, and offers to download
attachments as specfied by `rmail-mime-attachment-dirs-alist'.
-\(fn)" t nil)
+\(fn &optional ARG)" t nil)
;;;***
=== modified file 'lisp/mail/rmailmm.el'
--- a/lisp/mail/rmailmm.el 2010-12-13 15:27:36 +0000
+++ b/lisp/mail/rmailmm.el 2011-01-02 20:28:40 +0000
@@ -53,7 +53,7 @@
;;
;; rmail-mime
;; +- rmail-mime-show <----------------------------------+
-;; +- rmail-mime-process |
+;; +- rmail-mime-process |
;; +- rmail-mime-handle |
;; +- rmail-mime-text-handler |
;; +- rmail-mime-bulk-handler |
@@ -97,7 +97,9 @@
The remaining elements are handler functions to run, in order of
decreasing preference. These are called until one returns non-nil.
Note that this only applies to items with an inline Content-Disposition,
-all others are handled by `rmail-mime-bulk-handler'."
+all others are handled by `rmail-mime-bulk-handler'.
+Note also that this alist is ignored when the variable
+`rmail-enable-mime' is non-nil."
:type '(alist :key-type regexp :value-type (repeat function))
:version "23.1"
:group 'rmail-mime)
@@ -131,18 +133,36 @@
;;; End of user options.
+;;; Global variables that always have let-binding when referred.
+
+(defvar rmail-mime-mbox-buffer nil
+ "Buffer containing the mbox data.
+The value is usually nil, and bound to a proper value while
+processing MIME.")
+
+(defvar rmail-mime-view-buffer nil
+ "Buffer showing a message.
+The value is usually nil, and bound to a proper value while
+processing MIME.")
+
+(defvar rmail-mime-coding-system nil
+ "The first coding-system used for decoding a MIME entity.
+The value is usually nil, and bound to non-nil while inserting
+MIME entities.")
+
;;; MIME-entity object
(defun rmail-mime-entity (type disposition transfer-encoding
- header body children)
- "Retrun a newly created MIME-entity object.
-
-A MIME-entity is a vector of 6 elements:
-
- [ TYPE DISPOSITION TRANSFER-ENCODING HEADER BODY CHILDREN ]
-
-TYPE and DISPOSITION correspond to MIME headers Content-Type: and
-Cotent-Disposition: respectively, and has this format:
+ display header tagline body children handler)
+ "Retrun a newly created MIME-entity object from arguments.
+
+A MIME-entity is a vector of 9 elements:
+
+ [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY
+ CHILDREN HANDLER]
+
+TYPE and DISPOSITION correspond to MIME headers Content-Type and
+Cotent-Disposition respectively, and has this format:
\(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
@@ -161,31 +181,61 @@
TRANSFER-ENCODING corresponds to MIME header
Content-Transfer-Encoding, and is a lowercased string.
-HEADER and BODY are a cons (BEG . END), where BEG and END specify
-the region of the corresponding part in RMAIL's data (mbox)
-buffer. BODY may be nil. In that case, the current buffer is
-narrowed to the body part.
-
-CHILDREN is a list of MIME-entities for a \"multipart\" entity, and
-nil for the other types."
- (vector type disposition transfer-encoding header body children))
+DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
+the header, tagline, and body of the entity are displayed now,
+and NEW indicates how their displaying should be updated.
+Both elements are vector [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
+where each element is a symbol for the corresponding item that
+has these values:
+ nil: not displayed
+ t: displayed by the decoded presentation form
+ raw: displayed by the raw MIME data (for the header and body only)
+
+HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
+END specify the region of the header or body lines in RMAIL's
+data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
+header or body is, by default, displayed by the decoded
+presentation form.
+
+TAGLINE is a vector [TAG BULK-DATA DISPLAY-FLAG], where TAG is a
+string indicating the depth and index number of the entity,
+BULK-DATA is a cons (SIZE . TYPE) indicating the size and type of
+an attached data, DISPLAY-FLAG non-nil means that the tagline is,
+by default, displayed.
+
+CHILDREN is a list of child MIME-entities. A \"multipart/*\"
+entity have one or more children. A \"message/rfc822\" entity
+has just one child. Any other entity has no child.
+
+HANDLER is a function to insert the entity according to DISPLAY.
+It is called with one argument ENTITY."
+ (vector type disposition transfer-encoding
+ display header tagline body children handler))
;; Accessors for a MIME-entity object.
(defsubst rmail-mime-entity-type (entity) (aref entity 0))
(defsubst rmail-mime-entity-disposition (entity) (aref entity 1))
(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2))
-(defsubst rmail-mime-entity-header (entity) (aref entity 3))
-(defsubst rmail-mime-entity-body (entity) (aref entity 4))
-(defsubst rmail-mime-entity-children (entity) (aref entity 5))
+(defsubst rmail-mime-entity-display (entity) (aref entity 3))
+(defsubst rmail-mime-entity-header (entity) (aref entity 4))
+(defsubst rmail-mime-entity-tagline (entity) (aref entity 5))
+(defsubst rmail-mime-entity-body (entity) (aref entity 6))
+(defsubst rmail-mime-entity-children (entity) (aref entity 7))
+(defsubst rmail-mime-entity-handler (entity) (aref entity 8))
+
+(defsubst rmail-mime-message-p ()
+ "Non-nil if and only if the current message is a MIME."
+ (or (get-text-property (point) 'rmail-mime-entity)
+ (get-text-property (point-min) 'rmail-mime-entity)))
;;; Buttons
(defun rmail-mime-save (button)
"Save the attachment using info in the BUTTON."
- (let* ((filename (button-get button 'filename))
+ (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (filename (button-get button 'filename))
(directory (button-get button 'directory))
(data (button-get button 'data))
- (mbox-buf rmail-view-buffer)
(ofilename filename))
(setq filename (expand-file-name
(read-file-name (format "Save as (default: %s): " filename)
@@ -210,7 +260,8 @@
;; DATA is a MIME-entity object.
(let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
(body (rmail-mime-entity-body data)))
- (insert-buffer-substring mbox-buf (car body) (cdr body))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref body 0) (aref body 1))
(cond ((string= transfer-encoding "base64")
(ignore-errors (base64-decode-region (point-min) (point-max))))
((string= transfer-encoding "quoted-printable")
@@ -219,34 +270,293 @@
(define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
+(defun rmail-mime-entity-segment (pos &optional entity)
+ "Return a vector describing the displayed region of a MIME-entity at POS.
+Optional 2nd argument ENTITY is the MIME-entity at POS.
+The value is a vector [ INDEX HEADER TAGLINE BODY END], where
+ HEADER: the position of the beginning of a header
+ TAGLINE: the position of the beginning of a tagline
+ BODY: the position of the beginning of a body
+ END: the position of the end of the entity.
+ INDEX: index into the returned vector indicating where POS is."
+ (save-excursion
+ (or entity
+ (setq entity (get-text-property pos 'rmail-mime-entity)))
+ (if (not entity)
+ (vector 1 (point) (point) (point) (point))
+ (let ((current (aref (rmail-mime-entity-display entity) 0))
+ (beg (if (and (> pos (point-min))
+ (eq (get-text-property (1- pos) 'rmail-mime-entity)
+ entity))
+ (previous-single-property-change pos 'rmail-mime-entity
+ nil (point-min))
+ pos))
+ (index 1)
+ tagline-beg body-beg end)
+ (goto-char beg)
+ (if (aref current 0)
+ (search-forward "\n\n" nil t))
+ (setq tagline-beg (point))
+ (if (>= pos tagline-beg)
+ (setq index 2))
+ (if (aref current 1)
+ (forward-line 1))
+ (setq body-beg (point))
+ (if (>= pos body-beg)
+ (setq index 3))
+ (if (aref current 2)
+ (let ((tag (aref (rmail-mime-entity-tagline entity) 0))
+ tag2)
+ (setq end (next-single-property-change beg 'rmail-mime-entity
+ nil (point-max)))
+ (while (and (< end (point-max))
+ (setq entity (get-text-property end
'rmail-mime-entity)
+ tag2 (aref (rmail-mime-entity-tagline entity)
0))
+ (and (> (length tag2) 0)
+ (eq (string-match tag tag2) 0)))
+ (setq end (next-single-property-change end 'rmail-mime-entity
+ nil (point-max)))))
+ (setq end body-beg))
+ (vector index beg tagline-beg body-beg end)))))
+
+(defun rmail-mime-next-item ()
+ "Move point to the next displayed item of the current MIME entity.
+A MIME entity has three items; header, tagline, and body.
+If we are in the last item of the entity, move point to the first
+item of the next entity. If we reach the end of buffer, move
+point to the first item of the first entity (i.e. the beginning
+of buffer)."
+ (interactive)
+ (if (rmail-mime-message-p)
+ (let* ((segment (rmail-mime-entity-segment (point)))
+ (next-pos (aref segment (1+ (aref segment 0))))
+ (button (next-button (point))))
+ (goto-char (if (and button (< (button-start button) next-pos))
+ (button-start button)
+ next-pos))
+ (if (eobp)
+ (goto-char (point-min))))))
+
+(defun rmail-mime-previous-item ()
+ "Move point to the previous displayed item of the current MIME message.
+A MIME entity has three items; header, tagline, and body.
+If we are at the beginning of the first item of the entity, move
+point to the last item of the previous entity. If we reach the
+beginning of buffer, move point to the last item of the last
+entity."
+ (interactive)
+ (when (rmail-mime-message-p)
+ (if (bobp)
+ (goto-char (point-max)))
+ (let* ((segment (rmail-mime-entity-segment (1- (point))))
+ (prev-pos (aref segment (aref segment 0)))
+ (button (previous-button (point))))
+ (goto-char (if (and button (> (button-start button) prev-pos))
+ (button-start button)
+ prev-pos)))))
+
+(defun rmail-mime-shown-mode (entity)
+ "Make MIME-entity ENTITY displayed by the default way."
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (aset new 0 (aref (rmail-mime-entity-header entity) 2))
+ (aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
+ (aset new 2 (aref (rmail-mime-entity-body entity) 2))))
+
+(defun rmail-mime-hidden-mode (entity top)
+ "Make MIME-entity ENTITY displayed in the hidden mode.
+If TOP is non-nil, display ENTITY only by the tagline.
+Otherwise, don't display ENTITY."
+ (if top
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (aset new 0 nil)
+ (aset new 1 top)
+ (aset new 2 nil)
+ (aset (rmail-mime-entity-body entity) 2 nil))
+ (let ((current (aref (rmail-mime-entity-display entity) 0)))
+ (aset current 0 nil)
+ (aset current 1 nil)
+ (aset current 2 nil)))
+ (dolist (child (rmail-mime-entity-children entity))
+ (rmail-mime-hidden-mode child nil)))
+
+(defun rmail-mime-raw-mode (entity)
+ "Make MIME-entity ENTITY displayed in the raw mode."
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (aset new 0 'raw)
+ (aset new 1 nil)
+ (aset new 2 'raw)
+ (dolist (child (rmail-mime-entity-children entity))
+ (rmail-mime-hidden-mode child nil))))
+
+(defun rmail-mime-toggle-raw (entity)
+ "Toggle on and off the raw display mode of MIME-entity ENTITY."
+ (let* ((pos (if (eobp) (1- (point-max)) (point)))
+ (entity (get-text-property pos 'rmail-mime-entity))
+ (current (aref (rmail-mime-entity-display entity) 0))
+ (segment (rmail-mime-entity-segment pos entity)))
+ (if (not (eq (aref current 0) 'raw))
+ ;; Enter the raw mode.
+ (rmail-mime-raw-mode entity)
+ ;; Enter the shown mode.
+ (rmail-mime-shown-mode entity))
+ (let ((inhibit-read-only t)
+ (modified (buffer-modified-p)))
+ (save-excursion
+ (goto-char (aref segment 1))
+ (rmail-mime-insert entity)
+ (restore-buffer-modified-p modified)))))
+
+(defun rmail-mime-toggle-hidden ()
+ "Toggle on and off the hidden display mode of MIME-entity ENTITY."
+ (interactive)
+ (when (rmail-mime-message-p)
+ (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer (current-buffer))
+ (pos (if (eobp) (1- (point-max)) (point)))
+ (entity (get-text-property pos 'rmail-mime-entity))
+ (current (aref (rmail-mime-entity-display entity) 0))
+ (segment (rmail-mime-entity-segment pos entity)))
+ (if (aref current 2)
+ ;; Enter the hidden mode.
+ (progn
+ ;; If point is in the body part, move it to the tagline
+ ;; (or the header if headline is not displayed).
+ (if (= (aref segment 0) 3)
+ (goto-char (aref segment 2)))
+ (rmail-mime-hidden-mode entity t)
+ ;; If the current entity is the topmost one, display the
+ ;; header.
+ (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (aset new 0 t))))
+ ;; Enter the shown mode.
+ (aset (rmail-mime-entity-body entity) 2 t)
+ (rmail-mime-shown-mode entity))
+ (let ((inhibit-read-only t)
+ (modified (buffer-modified-p))
+ (rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer rmail-buffer))
+ (save-excursion
+ (goto-char (aref segment 1))
+ (rmail-mime-insert entity)
+ (restore-buffer-modified-p modified))))))
+
+(define-key rmail-mode-map "\t" 'rmail-mime-next-item)
+(define-key rmail-mode-map [backtab] 'rmail-mime-previous-item)
+(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
+
;;; Handlers
+(defun rmail-mime-insert-tagline (entity &rest item-list)
+ "Insert a tag line for MIME-entity ENTITY.
+ITEM-LIST is a list of strings or button-elements (list) to be added
+to the tag line."
+ (insert "[")
+ (let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
+ (if (> (length tag) 0) (insert (substring tag 1) ":")))
+ (insert (car (rmail-mime-entity-type entity)))
+ (dolist (item item-list)
+ (when item
+ (if (stringp item)
+ (insert item)
+ (apply 'insert-button item))))
+ (insert "]\n"))
+
+(defun rmail-mime-insert-header (header)
+ "Decode and insert a MIME-entity header HEADER in the current buffer.
+HEADER is a vector [BEG END DEFAULT-STATUS].
+See `rmail-mime-entity' for the detail."
+ (let ((pos (point))
+ (last-coding-system-used nil))
+ (save-restriction
+ (narrow-to-region pos pos)
+ (with-current-buffer rmail-mime-mbox-buffer
+ (let ((rmail-buffer rmail-mime-mbox-buffer)
+ (rmail-view-buffer rmail-mime-view-buffer))
+ (save-excursion
+ (goto-char (aref header 0))
+ (rmail-copy-headers (point) (aref header 1)))))
+ (rfc2047-decode-region pos (point))
+ (if (and last-coding-system-used (not rmail-mime-coding-system))
+ (setq rmail-mime-coding-system last-coding-system-used))
+ (goto-char (point-min))
+ (rmail-highlight-headers)
+ (goto-char (point-max))
+ (insert "\n"))))
+
(defun rmail-mime-text-handler (content-type
content-disposition
content-transfer-encoding)
"Handle the current buffer as a plain text MIME part."
- (let* ((charset (cdr (assq 'charset (cdr content-type))))
- (coding-system (when charset
- (intern (downcase charset)))))
- (when (coding-system-p coding-system)
- (decode-coding-region (point-min) (point-max) coding-system))))
+ (rmail-mime-insert-text
+ (rmail-mime-entity content-type content-disposition
+ content-transfer-encoding
+ (vector (vector nil nil nil) (vector nil nil t))
+ (vector nil nil nil) (vector "" (cons nil nil) t)
+ (vector nil nil nil) nil 'rmail-mime-insert-text))
+ t)
+
+(defun rmail-mime-insert-decoded-text (entity)
+ "Decode and insert the text body of MIME-entity ENTITY."
+ (let* ((content-type (rmail-mime-entity-type entity))
+ (charset (cdr (assq 'charset (cdr content-type))))
+ (coding-system (if charset
+ (coding-system-from-name charset)))
+ (body (rmail-mime-entity-body entity))
+ (pos (point)))
+ (or (and coding-system (coding-system-p coding-system))
+ (setq coding-system 'undecided))
+ (if (stringp (aref body 0))
+ (insert (aref body 0))
+ (let ((transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref body 0) (aref body 1))
+ (cond ((string= transfer-encoding "base64")
+ (ignore-errors (base64-decode-region pos (point))))
+ ((string= transfer-encoding "quoted-printable")
+ (quoted-printable-decode-region pos (point))))))
+ (decode-coding-region pos (point) coding-system)
+ (or rmail-mime-coding-system
+ (setq rmail-mime-coding-system coding-system))
+ (or (bolp) (insert "\n"))))
(defun rmail-mime-insert-text (entity)
- "Insert MIME-entity ENTITY as a plain text MIME part in the current buffer."
- (let* ((content-type (rmail-mime-entity-type entity))
- (charset (cdr (assq 'charset (cdr content-type))))
- (coding-system (if charset (intern (downcase charset))))
- (transfer-encoding (rmail-mime-entity-transfer-encoding entity))
- (body (rmail-mime-entity-body entity)))
- (save-restriction
- (narrow-to-region (point) (point))
- (insert-buffer-substring rmail-buffer (car body) (cdr body))
- (cond ((string= transfer-encoding "base64")
- (ignore-errors (base64-decode-region (point-min) (point-max))))
- ((string= transfer-encoding "quoted-printable")
- (quoted-printable-decode-region (point-min) (point-max))))
- (if (coding-system-p coding-system)
- (decode-coding-region (point-min) (point-max) coding-system)))))
+ "Presentation handler for a plain text MIME entity."
+ (let ((current (aref (rmail-mime-entity-display entity) 0))
+ (new (aref (rmail-mime-entity-display entity) 1))
+ (header (rmail-mime-entity-header entity))
+ (tagline (rmail-mime-entity-tagline entity))
+ (body (rmail-mime-entity-body entity))
+ (beg (point))
+ (segment (rmail-mime-entity-segment (point) entity)))
+
+ (or (integerp (aref body 0))
+ (let ((data (buffer-string)))
+ (aset body 0 data)
+ (delete-region (point-min) (point-max))))
+
+ ;; header
+ (if (eq (aref current 0) (aref new 0))
+ (goto-char (aref segment 2))
+ (if (aref current 0)
+ (delete-char (- (aref segment 2) (aref segment 1))))
+ (if (aref new 0)
+ (rmail-mime-insert-header header)))
+ ;; tagline
+ (if (eq (aref current 1) (aref new 1))
+ (forward-char (- (aref segment 3) (aref segment 2)))
+ (if (aref current 1)
+ (delete-char (- (aref segment 3) (aref segment 2))))
+ (if (aref new 1)
+ (rmail-mime-insert-tagline entity)))
+ ;; body
+ (if (eq (aref current 2) (aref new 2))
+ (forward-char (- (aref segment 4) (aref segment 3)))
+ (if (aref current 2)
+ (delete-char (- (aref segment 4) (aref segment 3))))
+ (if (aref new 2)
+ (rmail-mime-insert-decoded-text entity)))
+ (put-text-property beg (point) 'rmail-mime-entity entity)))
;; FIXME move to the test/ directory?
(defun test-rmail-mime-handler ()
@@ -265,35 +575,35 @@
(set-buffer-multibyte t)))
-(defun rmail-mime-insert-image (type data)
- "Insert an image of type TYPE, where DATA is the image data.
-If DATA is not a string, it is a MIME-entity object."
- (end-of-line)
- (let ((modified (buffer-modified-p)))
- (insert ?\n)
- (unless (stringp data)
- ;; DATA is a MIME-entity.
- (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
- (body (rmail-mime-entity-body data))
- (mbox-buffer rmail-view-buffer))
+(defun rmail-mime-insert-image (entity)
+ "Decode and insert the image body of MIME-entity ENTITY."
+ (let* ((content-type (car (rmail-mime-entity-type entity)))
+ (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
+ (body (rmail-mime-entity-body entity))
+ data)
+ (if (stringp (aref body 0))
+ (setq data (aref body 0))
+ (let ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
(with-temp-buffer
(set-buffer-multibyte nil)
(setq buffer-undo-list t)
- (insert-buffer-substring mbox-buffer (car body) (cdr body))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref body 0) (aref body 1))
(cond ((string= transfer-encoding "base64")
(ignore-errors (base64-decode-region (point-min) (point-max))))
((string= transfer-encoding "quoted-printable")
(quoted-printable-decode-region (point-min) (point-max))))
(setq data
(buffer-substring-no-properties (point-min) (point-max))))))
- (insert-image (create-image data type t))
- (set-buffer-modified-p modified)))
+ (insert-image (create-image data (cdr bulk-data) t))
+ (insert "\n")))
(defun rmail-mime-image (button)
"Display the image associated with BUTTON."
- (let ((inhibit-read-only t))
- (rmail-mime-insert-image (button-get button 'image-type)
- (button-get button 'image-data))))
+ (save-excursion
+ (goto-char (button-end button))
+ (rmail-mime-toggle-hidden)))
(define-button-type 'rmail-mime-image 'action 'rmail-mime-image)
@@ -306,15 +616,60 @@
depends upon the value of `rmail-mime-show-images'."
(rmail-mime-insert-bulk
(rmail-mime-entity content-type content-disposition
content-transfer-encoding
- nil nil nil)))
+ (vector (vector nil nil nil) (vector nil t nil))
+ (vector nil nil nil) (vector "" (cons nil nil) t)
+ (vector nil nil nil) nil 'rmail-mime-insert-bulk)))
+
+(defun rmail-mime-set-bulk-data (entity)
+ "Setup the information about the attachment object for MIME-entity ENTITY.
+The value is non-nil if and only if the attachment object should be shown
+directly."
+ (let ((content-type (car (rmail-mime-entity-type entity)))
+ (size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity)))))
+ (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
+ (body (rmail-mime-entity-body entity))
+ size type to-show)
+ (cond (size
+ (setq size (string-to-number size)))
+ ((stringp (aref body 0))
+ (setq size (length (aref body 0))))
+ (t
+ ;; Rough estimation of the size.
+ (let ((encoding (rmail-mime-entity-transfer-encoding entity)))
+ (setq size (- (aref body 1) (aref body 0)))
+ (cond ((string= encoding "base64")
+ (setq size (/ (* size 3) 4)))
+ ((string= encoding "quoted-printable")
+ (setq size (/ (* size 7) 3)))))))
+
+ (cond
+ ((string-match "text/" content-type)
+ (setq type 'text))
+ ((string-match "image/\\(.*\\)" content-type)
+ (setq type (image-type-from-file-name
+ (concat "." (match-string 1 content-type))))
+ (if (and (memq type image-types)
+ (image-type-available-p type))
+ (if (and rmail-mime-show-images
+ (not (eq rmail-mime-show-images 'button))
+ (or (not (numberp rmail-mime-show-images))
+ (< size rmail-mime-show-images)))
+ (setq to-show t))
+ (setq type nil))))
+ (setcar bulk-data size)
+ (setcdr bulk-data type)
+ to-show))
(defun rmail-mime-insert-bulk (entity)
- "Inesrt a MIME-entity ENTITY as an attachment.
-The optional second arg DATA, if non-nil, is a string containing
-the attachment data that is already decoded."
+ "Presentation handler for an attachment MIME entity."
;; Find the default directory for this media type.
(let* ((content-type (rmail-mime-entity-type entity))
(content-disposition (rmail-mime-entity-disposition entity))
+ (current (aref (rmail-mime-entity-display entity) 0))
+ (new (aref (rmail-mime-entity-display entity) 1))
+ (header (rmail-mime-entity-header entity))
+ (tagline (rmail-mime-entity-tagline entity))
+ (bulk-data (aref tagline 1))
(body (rmail-mime-entity-body entity))
(directory (catch 'directory
(dolist (entry rmail-mime-attachment-dirs-alist)
@@ -325,47 +680,70 @@
(filename (or (cdr (assq 'name (cdr content-type)))
(cdr (assq 'filename (cdr content-disposition)))
"noname"))
- (label (format "\nAttached %s file: " (car content-type)))
(units '(B kB MB GB))
- data udata size osize type)
- (if body
+ (segment (rmail-mime-entity-segment (point) entity))
+ beg data size)
+
+ (if (integerp (aref body 0))
(setq data entity
- udata entity
- size (- (cdr body) (car body)))
- (setq data (buffer-string)
- udata (string-as-unibyte data)
- size (length udata))
- (delete-region (point-min) (point-max)))
- (setq osize size)
+ size (car bulk-data))
+ (if (stringp (aref body 0))
+ (setq data (aref body 0))
+ (setq data (string-as-unibyte (buffer-string)))
+ (aset body 0 data)
+ (rmail-mime-set-bulk-data entity)
+ (delete-region (point-min) (point-max)))
+ (setq size (length data)))
(while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
(cdr units))
(setq size (/ size 1024.0)
units (cdr units)))
- (insert label)
- (insert-button filename
- :type 'rmail-mime-save
- 'help-echo "mouse-2, RET: Save attachment"
- 'filename filename
- 'directory (file-name-as-directory directory)
- 'data data)
- (insert (format " (%.0f%s)" size (car units)))
- (when (and rmail-mime-show-images
- (string-match "image/\\(.*\\)" (setq type (car content-type)))
- (setq type (concat "." (match-string 1 type))
- type (image-type-from-file-name type))
- (memq type image-types)
- (image-type-available-p type))
- (insert " ")
- (cond ((or (eq rmail-mime-show-images 'button)
- (and (numberp rmail-mime-show-images)
- (>= osize rmail-mime-show-images)))
- (insert-button "Display"
- :type 'rmail-mime-image
- 'help-echo "mouse-2, RET: Show image"
- 'image-type type
- 'image-data udata))
- (t
- (rmail-mime-insert-image type udata))))))
+
+ (setq beg (point))
+
+ ;; header
+ (if (eq (aref current 0) (aref new 0))
+ (goto-char (aref segment 2))
+ (if (aref current 0)
+ (delete-char (- (aref segment 2) (aref segment 1))))
+ (if (aref new 0)
+ (rmail-mime-insert-header header)))
+
+ ;; tagline
+ (if (eq (aref current 1) (aref new 1))
+ (forward-char (- (aref segment 3) (aref segment 2)))
+ (if (aref current 1)
+ (delete-char (- (aref segment 3) (aref segment 2))))
+ (if (aref new 1)
+ (rmail-mime-insert-tagline
+ entity
+ " file:"
+ (list filename
+ :type 'rmail-mime-save
+ 'help-echo "mouse-2, RET: Save attachment"
+ 'filename filename
+ 'directory (file-name-as-directory directory)
+ 'data data)
+ (format " (%.0f%s)" size (car units))
+ (if (cdr bulk-data)
+ " ")
+ (if (cdr bulk-data)
+ (list "Toggle show/hide"
+ :type 'rmail-mime-image
+ 'help-echo "mouse-2, RET: Toggle show/hide"
+ 'image-type (cdr bulk-data)
+ 'image-data data)))))
+ ;; body
+ (if (eq (aref current 2) (aref new 2))
+ (forward-char (- (aref segment 4) (aref segment 3)))
+ (if (aref current 2)
+ (delete-char (- (aref segment 4) (aref segment 3))))
+ (if (aref new 2)
+ (cond ((eq (cdr bulk-data) 'text)
+ (rmail-mime-insert-decoded-text entity))
+ ((cdr bulk-data)
+ (rmail-mime-insert-image entity)))))
+ (put-text-property beg (point) 'rmail-mime-entity entity)))
(defun test-rmail-mime-bulk-handler ()
"Test of a mail used as an example in RFC 2183."
@@ -397,19 +775,21 @@
of the respective parsed headers. See `rmail-mime-handle' for their
format."
(rmail-mime-process-multipart
- content-type content-disposition content-transfer-encoding nil))
+ content-type content-disposition content-transfer-encoding nil)
+ t)
(defun rmail-mime-process-multipart (content-type
content-disposition
content-transfer-encoding
- parse-only)
+ parse-tag)
"Process the current buffer as a multipart MIME body.
-If PARSE-ONLY is nil, modify the current buffer directly for showing
-the MIME body and return nil.
+If PARSE-TAG is nil, modify the current buffer directly for
+showing the MIME body and return nil.
-Otherwise, just parse the current buffer and return a list of
-MIME-entity objects.
+Otherwise, PARSE-TAG is a string indicating the depth and index
+number of the entity. In this case, parse the current buffer and
+return a list of MIME-entity objects.
The other arguments are the same as `rmail-mime-multipart-handler'."
;; Some MUAs start boundaries with "--", while it should start
@@ -420,6 +800,8 @@
;; of the preceding part.
;; We currently don't handle that.
(let ((boundary (cdr (assq 'boundary content-type)))
+ (subtype (cadr (split-string (car content-type) "/")))
+ (index 0)
beg end next entities)
(unless boundary
(rmail-mm-get-boundary-error-message
@@ -430,12 +812,20 @@
(goto-char (point-min))
(when (and (search-forward boundary nil t)
(looking-at "[ \t]*\n"))
- (if parse-only
+ (if parse-tag
(narrow-to-region (match-end 0) (point-max))
(delete-region (point-min) (match-end 0))))
+
+ ;; Change content-type to the proper default one for the children.
+ (cond ((string-match "mixed" subtype)
+ (setq content-type '("text/plain")))
+ ((string-match "digest" subtype)
+ (setq content-type '("message/rfc822"))))
+
;; Loop over all body parts, where beg points at the beginning of
;; the part and end points at the end of the part. next points at
- ;; the beginning of the next part.
+ ;; the beginning of the next part. The current point is just
+ ;; after the boundary tag.
(setq beg (point-min))
(while (search-forward boundary nil t)
(setq end (match-beginning 0))
@@ -450,17 +840,46 @@
(rmail-mm-get-boundary-error-message
"Malformed boundary" content-type content-disposition
content-transfer-encoding)))
+
+ (setq index (1+ index))
;; Handle the part.
- (if parse-only
+ (if parse-tag
(save-restriction
(narrow-to-region beg end)
- (setq entities (cons (rmail-mime-process nil t) entities)))
+ (let ((child (rmail-mime-process
+ nil (format "%s/%d" parse-tag index)
+ content-type content-disposition)))
+ ;; Display a tagline.
+ (aset (aref (rmail-mime-entity-display child) 1) 1
+ (aset (rmail-mime-entity-tagline child) 2 t))
+ (push child entities)))
+
(delete-region end next)
(save-restriction
(narrow-to-region beg end)
(rmail-mime-show)))
(goto-char (setq beg next)))
- (nreverse entities)))
+
+ (when parse-tag
+ (setq entities (nreverse entities))
+ (if (string-match "alternative" subtype)
+ ;; Find the best entity to show, and hide all the others.
+ (let (best second)
+ (dolist (child entities)
+ (if (string= (or (car (rmail-mime-entity-disposition child))
+ (car content-disposition))
+ "inline")
+ (if (string-match "text/plain"
+ (car (rmail-mime-entity-type child)))
+ (setq best child)
+ (if (string-match "text/.*"
+ (car (rmail-mime-entity-type child)))
+ (setq second child)))))
+ (or best (not second) (setq best second))
+ (dolist (child entities)
+ (or (eq best child)
+ (rmail-mime-hidden-mode child t)))))
+ entities)))
(defun test-rmail-mime-multipart-handler ()
"Test of a mail used as an example in RFC 2046."
@@ -493,6 +912,40 @@
(insert mail)
(rmail-mime-show t)))
+(defun rmail-mime-insert-multipart (entity)
+ "Presentation handler for a multipart MIME entity."
+ (let ((current (aref (rmail-mime-entity-display entity) 0))
+ (new (aref (rmail-mime-entity-display entity) 1))
+ (header (rmail-mime-entity-header entity))
+ (tagline (rmail-mime-entity-tagline entity))
+ (body (rmail-mime-entity-body entity))
+ (beg (point))
+ (segment (rmail-mime-entity-segment (point) entity)))
+ ;; header
+ (if (eq (aref current 0) (aref new 0))
+ (goto-char (aref segment 2))
+ (if (aref current 0)
+ (delete-char (- (aref segment 2) (aref segment 1))))
+ (if (aref new 0)
+ (rmail-mime-insert-header header)))
+ ;; tagline
+ (if (eq (aref current 1) (aref new 1))
+ (forward-char (- (aref segment 3) (aref segment 2)))
+ (if (aref current 1)
+ (delete-char (- (aref segment 3) (aref segment 2))))
+ (if (aref new 1)
+ (rmail-mime-insert-tagline entity)))
+
+ (put-text-property beg (point) 'rmail-mime-entity entity)
+ ;; body
+ (if (eq (aref current 2) (aref new 2))
+ (forward-char (- (aref segment 4) (aref segment 3)))
+ (if (aref current 2)
+ (delete-char (- (aref segment 4) (aref segment 3))))
+ (if (aref new 2)
+ (dolist (child (rmail-mime-entity-children entity))
+ (rmail-mime-insert child))))))
+
;;; Main code
(defun rmail-mime-handle (content-type
@@ -565,7 +1018,9 @@
modified."
(rmail-mime-process show-headers nil))
-(defun rmail-mime-process (show-headers parse-only)
+(defun rmail-mime-process (show-headers parse-tag &optional
+ default-content-type
+ default-content-disposition)
(let ((end (point-min))
content-type
content-transfer-encoding
@@ -596,45 +1051,76 @@
(setq content-type
(if content-type
(mail-header-parse-content-type content-type)
- ;; FIXME: Default "message/rfc822" in a "multipart/digest"
- ;; according to RFC 2046.
- '("text/plain")))
+ (or default-content-type '("text/plain"))))
(setq content-disposition
(if content-disposition
(mail-header-parse-content-disposition content-disposition)
;; If none specified, we are free to choose what we deem
;; suitable according to RFC 2183. We like inline.
- '("inline")))
+ (or default-content-disposition '("inline"))))
;; Unrecognized disposition types are to be treated like
;; attachment according to RFC 2183.
(unless (member (car content-disposition) '("inline" "attachment"))
(setq content-disposition '("attachment")))
- (if parse-only
- (cond ((string-match "multipart/.*" (car content-type))
- (setq end (1- end))
- (save-restriction
- (let ((header (if show-headers (cons (point-min) end))))
+ (if parse-tag
+ (let* ((is-inline (string= (car content-disposition) "inline"))
+ (header (vector (point-min) end nil))
+ (tagline (vector parse-tag (cons nil nil) t))
+ (body (vector end (point-max) is-inline))
+ (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
+ children handler entity)
+ (cond ((string-match "multipart/.*" (car content-type))
+ (save-restriction
+ (narrow-to-region (1- end) (point-max))
+ (setq children (rmail-mime-process-multipart
+ content-type
+ content-disposition
+ content-transfer-encoding
+ parse-tag)
+ handler 'rmail-mime-insert-multipart)))
+ ((string-match "message/rfc822" (car content-type))
+ (save-restriction
(narrow-to-region end (point-max))
- (rmail-mime-entity content-type
- content-disposition
- content-transfer-encoding
- header nil
- (rmail-mime-process-multipart
- content-type content-disposition
- content-transfer-encoding t)))))
- ((string-match "message/rfc822" (car content-type))
- (or show-headers
- (narrow-to-region end (point-max)))
- (rmail-mime-process t t))
- (t
- (rmail-mime-entity content-type
- content-disposition
- content-transfer-encoding
- nil
- (cons end (point-max))
- nil)))
+ (let* ((msg (rmail-mime-process t parse-tag
+ '("text/plain") '("inline")))
+ (msg-new (aref (rmail-mime-entity-display msg) 1)))
+ ;; Show header of the child.
+ (aset msg-new 0 t)
+ (aset (rmail-mime-entity-header msg) 2 t)
+ ;; Hide tagline of the child.
+ (aset msg-new 1 nil)
+ (aset (rmail-mime-entity-tagline msg) 2 nil)
+ (setq children (list msg)
+ handler 'rmail-mime-insert-multipart))))
+ ((and is-inline (string-match "text/" (car content-type)))
+ ;; Don't need a tagline.
+ (aset new 1 (aset tagline 2 nil))
+ (setq handler 'rmail-mime-insert-text))
+ (t
+ ;; Force hidden mode.
+ (aset new 1 (aset tagline 2 t))
+ (aset new 2 (aset body 2 nil))
+ (setq handler 'rmail-mime-insert-bulk)))
+ (setq entity (rmail-mime-entity content-type
+ content-disposition
+ content-transfer-encoding
+ (vector (vector nil nil nil) new)
+ header tagline body children handler))
+ (if (and (eq handler 'rmail-mime-insert-bulk)
+ (rmail-mime-set-bulk-data entity))
+ ;; Show the body.
+ (aset new 2 (aset body 2 t)))
+ entity)
+
;; Hide headers and handle the part.
+ (put-text-property (point-min) (point-max) 'rmail-mime-entity
+ (rmail-mime-entity
+ content-type content-disposition
+ content-transfer-encoding
+ (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
+ (vector nil nil 'raw) (vector "" (cons nil nil) nil)
+ (vector nil nil 'raw) nil nil))
(save-restriction
(cond ((string= (car content-type) "message/rfc822")
(narrow-to-region end (point-max)))
@@ -643,102 +1129,117 @@
(rmail-mime-handle content-type content-disposition
content-transfer-encoding)))))
-(defun rmail-mime-insert-multipart (entity)
- "Insert MIME-entity ENTITY of multipart type in the current buffer."
- (let ((subtype (cadr (split-string (car (rmail-mime-entity-type entity))
- "/")))
- (disposition (rmail-mime-entity-disposition entity))
- (header (rmail-mime-entity-header entity))
- (children (rmail-mime-entity-children entity)))
- (if header
- (let ((pos (point)))
- (or (bolp)
- (insert "\n"))
- (insert-buffer-substring rmail-buffer (car header) (cdr header))
- (rfc2047-decode-region pos (point))
- (insert "\n")))
- (cond
- ((string= subtype "mixed")
- (dolist (child children)
- (rmail-mime-insert child '("text/plain") disposition)))
- ((string= subtype "digest")
- (dolist (child children)
- (rmail-mime-insert child '("message/rfc822") disposition)))
- ((string= subtype "alternative")
- (let (best-plain-text best-text)
- (dolist (child children)
- (if (string= (or (car (rmail-mime-entity-disposition child))
- (car disposition))
- "inline")
- (if (string-match "text/plain"
- (car (rmail-mime-entity-type child)))
- (setq best-plain-text child)
- (if (string-match "text/.*"
- (car (rmail-mime-entity-type child)))
- (setq best-text child)))))
- (if (or best-plain-text best-text)
- (rmail-mime-insert (or best-plain-text best-text))
- ;; No child could be handled. Insert all.
- (dolist (child children)
- (rmail-mime-insert child nil disposition)))))
- (t
- ;; Unsupported subtype. Insert all of them.
- (dolist (child children)
- (rmail-mime-insert child))))))
-
(defun rmail-mime-parse ()
"Parse the current Rmail message as a MIME message.
-The value is a MIME-entiy object (see `rmail-mime-enty-new')."
- (save-excursion
- (goto-char (point-min))
- (condition-case nil
- (rmail-mime-process nil t)
- (error nil))))
+The value is a MIME-entiy object (see `rmail-mime-entity').
+If an error occurs, return an error message string."
+ (let ((rmail-mime-mbox-buffer (if (rmail-buffers-swapped-p)
+ rmail-view-buffer
+ (current-buffer))))
+ (condition-case err
+ (with-current-buffer rmail-mime-mbox-buffer
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((entity (rmail-mime-process t ""
+ '("text/plain") '("inline")))
+ (new (aref (rmail-mime-entity-display entity) 1)))
+ ;; Show header.
+ (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
+ ;; Show tagline if and only if body is not shown.
+ (if (aref new 2)
+ (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil))
+ (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t)))
+ entity)))
+ (error (format "%s" err)))))
-(defun rmail-mime-insert (entity &optional content-type disposition)
+(defun rmail-mime-insert (entity)
"Insert a MIME-entity ENTITY in the current buffer.
This function will be called recursively if multiple parts are
available."
- (if (rmail-mime-entity-children entity)
- (rmail-mime-insert-multipart entity)
- (setq content-type
- (or (rmail-mime-entity-type entity) content-type))
- (setq disposition
- (or (rmail-mime-entity-disposition entity) disposition))
- (if (and (string= (car disposition) "inline")
- (string-match "text/.*" (car content-type)))
- (rmail-mime-insert-text entity)
- (rmail-mime-insert-bulk entity))))
+ (let ((current (aref (rmail-mime-entity-display entity) 0))
+ (new (aref (rmail-mime-entity-display entity) 1)))
+ (if (not (eq (aref new 0) 'raw))
+ ;; Not a raw-mode. Each handler should handle it.
+ (funcall (rmail-mime-entity-handler entity) entity)
+ (let ((header (rmail-mime-entity-header entity))
+ (tagline (rmail-mime-entity-tagline entity))
+ (body (rmail-mime-entity-body entity))
+ (beg (point))
+ (segment (rmail-mime-entity-segment (point) entity)))
+ ;; header
+ (if (eq (aref current 0) (aref new 0))
+ (goto-char (aref segment 2))
+ (if (aref current 0)
+ (delete-char (- (aref segment 2) (aref segment 1))))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref header 0) (aref header 1)))
+ ;; tagline
+ (if (aref current 1)
+ (delete-char (- (aref segment 3) (aref segment 2))))
+ ;; body
+ (if (eq (aref current 2) (aref new 2))
+ (forward-char (- (aref segment 4) (aref segment 3)))
+ (if (aref current 2)
+ (delete-char (- (aref segment 4) (aref segment 3))))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref body 0) (aref body 1)))
+ (put-text-property beg (point) 'rmail-mime-entity entity)))
+ (dotimes (i 3)
+ (aset current i (aref new i)))))
(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
"Major mode used in `rmail-mime' buffers."
(setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil)))
;;;###autoload
-(defun rmail-mime ()
- "Process the current Rmail message as a MIME message.
-This creates a temporary \"*RMAIL*\" buffer holding a decoded
-copy of the message. Inline content-types are handled according to
+(defun rmail-mime (&optional arg)
+ "Toggle displaying of a MIME message.
+
+The actualy behavior depends on the value of `rmail-enable-mime'.
+
+If `rmail-enable-mime' is t (default), this command change the
+displaying of a MIME message between decoded presentation form
+and raw data.
+
+With ARG, toggle the displaying of the current MIME entity only.
+
+If `rmail-enable-mime' is nil, this creates a temporary
+\"*RMAIL*\" buffer holding a decoded copy of the message. Inline
+content-types are handled according to
`rmail-mime-media-type-handlers-alist'. By default, this
displays text and multipart messages, and offers to download
attachments as specfied by `rmail-mime-attachment-dirs-alist'."
- (interactive)
- (let ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
- (buf (get-buffer-create "*RMAIL*")))
- (set-buffer buf)
- (setq buffer-undo-list t)
- (let ((inhibit-read-only t))
- ;; Decoding the message in fundamental mode for speed, only
- ;; switching to rmail-mime-mode at the end for display. Eg
- ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993).
- (fundamental-mode)
- (erase-buffer)
- (insert data)
- (rmail-mime-show t)
- (rmail-mime-mode)
- (set-buffer-modified-p nil))
- (view-buffer buf)))
+ (interactive "P")
+ (if rmail-enable-mime
+ (if (rmail-mime-message-p)
+ (let ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer rmail-buffer)
+ (entity (get-text-property (point) 'rmail-mime-entity)))
+ (if arg
+ (if entity
+ (rmail-mime-toggle-raw entity))
+ (goto-char (point-min))
+ (rmail-mime-toggle-raw
+ (get-text-property (point) 'rmail-mime-entity))))
+ (message "Not a MIME message"))
+ (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
+ (buf (get-buffer-create "*RMAIL*"))
+ (rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer buf))
+ (set-buffer buf)
+ (setq buffer-undo-list t)
+ (let ((inhibit-read-only t))
+ ;; Decoding the message in fundamental mode for speed, only
+ ;; switching to rmail-mime-mode at the end for display. Eg
+ ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993).
+ (fundamental-mode)
+ (erase-buffer)
+ (insert data)
+ (rmail-mime-show t)
+ (rmail-mime-mode)
+ (set-buffer-modified-p nil))
+ (view-buffer buf))))
(defun rmail-mm-get-boundary-error-message (message type disposition encoding)
"Return MESSAGE with more information on the main mime components."
@@ -747,34 +1248,41 @@
(defun rmail-show-mime ()
"Function to set in `rmail-show-mime-function' (which see)."
- (let ((mbox-buf rmail-buffer)
- (entity (rmail-mime-parse)))
- (if entity
- (with-current-buffer rmail-view-buffer
- (let ((inhibit-read-only t)
- (rmail-buffer mbox-buf))
- (erase-buffer)
- (rmail-mime-insert entity)))
- ;; Decoding failed. Insert the original message body as is.
- (let ((region (with-current-buffer mbox-buf
+ (let ((entity (rmail-mime-parse))
+ (rmail-mime-mbox-buffer rmail-buffer)
+ (rmail-mime-view-buffer rmail-view-buffer)
+ (rmail-mime-coding-system nil))
+ (if (vectorp entity)
+ (with-current-buffer rmail-mime-view-buffer
+ (erase-buffer)
+ (rmail-mime-insert entity)
+ (if rmail-mime-coding-system
+ (set-buffer-file-coding-system rmail-mime-coding-system t t)))
+ ;; Decoding failed. ENTITY is an error message. Insert the
+ ;; original message body as is, and show warning.
+ (let ((region (with-current-buffer rmail-mime-mbox-buffer
(goto-char (point-min))
(re-search-forward "^$" nil t)
(forward-line 1)
- (cons (point) (point-max)))))
- (with-current-buffer rmail-view-buffer
+ (vector (point-min) (point) (point-max)))))
+ (with-current-buffer rmail-mime-view-buffer
(let ((inhibit-read-only t))
(erase-buffer)
- (insert-buffer-substring mbox-buf (car region) (cdr region))))
- (message "MIME decoding failed")))))
+ (rmail-mime-insert-header region)
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref region 1) (aref region 2))))
+ (set-buffer-file-coding-system 'no-conversion t t)
+ (message "MIME decoding failed: %s" entity)))))
(setq rmail-show-mime-function 'rmail-show-mime)
(defun rmail-insert-mime-forwarded-message (forward-buffer)
"Function to set in `rmail-insert-mime-forwarded-message-function' (which
see)."
- (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer)))
+ (let ((rmail-mime-mbox-buffer
+ (with-current-buffer forward-buffer rmail-view-buffer)))
(save-restriction
(narrow-to-region (point) (point))
- (message-forward-make-body-mime mbox-buf))))
+ (message-forward-make-body-mime rmail-mime-mbox-buffer))))
(setq rmail-insert-mime-forwarded-message-function
'rmail-insert-mime-forwarded-message)
@@ -795,15 +1303,16 @@
"Function to set in `rmail-search-mime-message-function' (which see)."
(save-restriction
(narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg))
- (let ((mbox-buf (current-buffer))
- (header-end (save-excursion
- (re-search-forward "^$" nil 'move) (point)))
- (body-end (point-max))
- (entity (rmail-mime-parse)))
- (or
+ (let* ((rmail-mime-mbox-buffer (current-buffer))
+ (rmail-mime-view-buffer rmail-view-buffer)
+ (header-end (save-excursion
+ (re-search-forward "^$" nil 'move) (point)))
+ (body-end (point-max))
+ (entity (rmail-mime-parse)))
+ (or
;; At first, just search the headers.
(with-temp-buffer
- (insert-buffer-substring mbox-buf nil header-end)
+ (insert-buffer-substring rmail-mime-mbox-buffer nil header-end)
(rfc2047-decode-region (point-min) (point))
(goto-char (point-min))
(re-search-forward regexp nil t))
@@ -811,13 +1320,12 @@
(if (and entity
(let* ((content-type (rmail-mime-entity-type entity))
(charset (cdr (assq 'charset (cdr content-type)))))
- (or (not (string-match "text/.*" (car content-type)))
+ (or (not (string-match "text/.*" (car content-type)))
(and charset
(not (string= (downcase charset) "us-ascii"))))))
;; Search the decoded MIME message.
(with-temp-buffer
- (let ((rmail-buffer mbox-buf))
- (rmail-mime-insert entity))
+ (rmail-mime-insert entity)
(goto-char (point-min))
(re-search-forward regexp nil t))
;; Search the body without decoding.
=== modified file 'lisp/mail/smtpmail.el'
--- a/lisp/mail/smtpmail.el 2010-12-09 01:46:03 +0000
+++ b/lisp/mail/smtpmail.el 2010-12-13 15:12:01 +0000
@@ -392,7 +392,14 @@
(make-directory smtpmail-queue-dir t))
(with-current-buffer buffer-data
(erase-buffer)
- (set-buffer-file-coding-system smtpmail-code-conv-from nil t)
+ (set-buffer-file-coding-system
+ ;; We will be reading the file with no-conversion in
+ ;; smtpmail-send-queued-mail below, so write it out
+ ;; with Unix EOLs.
+ (coding-system-change-eol-conversion
+ (or smtpmail-code-conv-from 'undecided)
+ 'unix)
+ nil t)
(insert-buffer-substring tembuf)
(write-file file-data)
(set-buffer buffer-elisp)
=== modified file 'lisp/term/w32-win.el'
--- a/lisp/term/w32-win.el 2010-10-24 22:04:45 +0000
+++ b/lisp/term/w32-win.el 2011-01-02 20:28:40 +0000
@@ -190,17 +190,25 @@
;;; Set default known names for external libraries
(setq dynamic-library-alist
- '((xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll")
- (png "libpng12d.dll" "libpng12.dll" "libpng.dll"
- ;; these are libpng 1.2.8 from GTK+
- "libpng13d.dll" "libpng13.dll")
- (jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")
- (tiff "libtiff3.dll" "libtiff.dll")
- (gif "giflib4.dll" "libungif4.dll" "libungif.dll")
- (svg "librsvg-2-2.dll")
- (gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
- (glib "libglib-2.0-0.dll")
- (gobject "libgobject-2.0-0.dll")))
+ (list
+ '(xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll")
+ ;; Versions of libpng 1.4.x and later are incompatible with
+ ;; earlier versions. Set up the list of libraries according to
+ ;; the version we were compiled against. (If we were compiled
+ ;; without PNG support, libpng-version's value is -1.)
+ (if (>= libpng-version 10400)
+ ;; libpng14-14.dll is libpng 1.4.3 from GTK+
+ '(png "libpng14-14.dll" "libpng14.dll")
+ '(png "libpng12d.dll" "libpng12.dll" "libpng3.dll" "libpng.dll"
+ ;; these are libpng 1.2.8 from GTK+
+ "libpng13d.dll" "libpng13.dll"))
+ '(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")
+ '(tiff "libtiff3.dll" "libtiff.dll")
+ '(gif "giflib4.dll" "libungif4.dll" "libungif.dll")
+ '(svg "librsvg-2-2.dll")
+ '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
+ '(glib "libglib-2.0-0.dll")
+ '(gobject "libgobject-2.0-0.dll")))
;;; multi-tty support
(defvar w32-initialized nil
=== modified file 'lisp/textmodes/rst.el'
--- a/lisp/textmodes/rst.el 2010-11-18 03:02:15 +0000
+++ b/lisp/textmodes/rst.el 2011-01-02 20:28:40 +0000
@@ -3340,7 +3340,7 @@
(defun rst-compile-pdf-preview ()
"Convert the document to a PDF file and launch a preview program."
(interactive)
- (let* ((tmp-filename "/tmp/out.pdf")
+ (let* ((tmp-filename (make-temp-file "rst-out" nil ".pdf"))
(command (format "rst2pdf.py %s %s && %s %s"
buffer-file-name tmp-filename
rst-pdf-program tmp-filename)))
@@ -3355,7 +3355,7 @@
(defun rst-compile-slides-preview ()
"Convert the document to an S5 slide presentation and launch a preview
program."
(interactive)
- (let* ((tmp-filename "/tmp/slides.html")
+ (let* ((tmp-filename (make-temp-file "rst-slides" nil ".html"))
(command (format "rst2s5.py %s %s && %s %s"
buffer-file-name tmp-filename
rst-slides-program tmp-filename)))
=== modified file 'lisp/time.el'
--- a/lisp/time.el 2010-10-02 13:21:43 +0000
+++ b/lisp/time.el 2011-01-02 20:28:40 +0000
@@ -463,7 +463,9 @@
"Toggle display of time, load level, and mail flag in mode lines.
With a numeric arg, enable this display if arg is positive.
-When this display is enabled, it updates automatically every minute.
+When this display is enabled, it updates automatically every minute
+\(you can control the number of seconds between updates by
+customizing `display-time-interval').
If `display-time-day-and-date' is non-nil, the current day and date
are displayed as well.
This runs the normal hook `display-time-hook' after each update."
=== modified file 'lisp/version.el'
--- a/lisp/version.el 2010-12-13 15:27:36 +0000
+++ b/lisp/version.el 2011-01-02 20:28:40 +0000
@@ -1,7 +1,7 @@
;;; version.el --- record version number of Emacs -*- no-byte-compile: t -*-
;; Copyright (C) 1985, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -88,5 +88,4 @@
;;version-control: never
;;End:
-;; arch-tag: e60dc445-6218-4a4c-a7df-f15a818642a0
;;; version.el ends here
=== modified file 'nextstep/ChangeLog'
--- a/nextstep/ChangeLog 2010-10-13 03:17:59 +0000
+++ b/nextstep/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,10 @@
+2011-01-02 Glenn Morris <address@hidden>
+
+ * Cocoa/Emacs.base/Contents/Info.plist:
+ * Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:
+ * GNUstep/Emacs.base/Resources/Info-gnustep.plist:
+ Set short copyright year to 2011.
+
2010-10-13 Glenn Morris <address@hidden>
* README: Remove information duplicated in AUTHORS.
=== modified file 'nextstep/Cocoa/Emacs.base/Contents/Info.plist'
--- a/nextstep/Cocoa/Emacs.base/Contents/Info.plist 2010-12-13 15:27:36
+0000
+++ b/nextstep/Cocoa/Emacs.base/Contents/Info.plist 2011-01-02 20:28:40
+0000
@@ -1,5 +1,5 @@
<!--
-Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
+Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -553,7 +553,7 @@
<key>CFBundleExecutable</key>
<string>Emacs</string>
<key>CFBundleGetInfoString</key>
- <string>Emacs 24.0.50 Copyright (C) 2010 Free Software Foundation,
Inc.</string>
+ <string>Emacs 24.0.50 Copyright (C) 2011 Free Software Foundation,
Inc.</string>
<key>CFBundleIconFile</key>
<string>Emacs.icns</string>
<key>CFBundleIdentifier</key>
=== modified file
'nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings'
---
a/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings
2010-12-13 15:27:36 +0000
+++
b/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings
2011-01-02 20:28:40 +0000
@@ -3,4 +3,4 @@
CFBundleName = "Emacs";
CFBundleShortVersionString = "Version 24.0.50";
CFBundleGetInfoString = "Emacs version 24.0.50, NS Windowing";
-NSHumanReadableCopyright = "Copyright (C) 2010 Free Software Foundation, Inc.";
+NSHumanReadableCopyright = "Copyright (C) 2011 Free Software Foundation, Inc.";
=== modified file 'nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist'
--- a/nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist 2010-12-13
15:27:36 +0000
+++ b/nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist 2011-01-02
20:28:40 +0000
@@ -11,7 +11,7 @@
"Carl Edman (NeXTStep)",
"..see http://emacs-app.sf.net/authorship.html";
);
- Copyright = "Copyright (C) 2010 Free Software Foundation, Inc.";
+ Copyright = "Copyright (C) 2011 Free Software Foundation, Inc.";
CopyrightDescription = "Released under the GNU General Public License
Version 3 or later";
FullVersionID = "Emacs 24.0.50, NS Windowing";
NSExecutable = Emacs;
=== modified file 'nt/ChangeLog'
--- a/nt/ChangeLog 2010-11-23 20:21:16 +0000
+++ b/nt/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,11 @@
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * configure.bat (end): Unset environment variables used by this
+ batch file.
+
+ * INSTALL: Update the information about PNG support libraries.
+ (Bug#7716)
+
2010-11-23 Eli Zaretskii <address@hidden>
* config.nt (EXTERNALLY_VISIBLE): Define.
=== modified file 'nt/INSTALL'
--- a/nt/INSTALL 2010-11-18 03:54:14 +0000
+++ b/nt/INSTALL 2011-01-02 20:28:40 +0000
@@ -290,6 +290,23 @@
If GTK 2.0 is installed, addpm will arrange for its image libraries
to be on the DLL search path for Emacs.
+ For PNG images, we recommend to use versions 1.4.x and later of
+ libpng, because previous versions had security issues. You can find
+ precompiled libraries and headers on the GTK download page for
+ Windows (http://www.gtk.org/download-windows.html).
+
+ Versions 1.4.0 and later of libpng are binary incompatible with
+ earlier versions, so Emacs will only look for libpng libraries which
+ are compatible with the version it was compiled against. That
+ version is given by the value of the Lisp variable `libpng-version';
+ e.g., 10403 means version 1.4.3. The variable `image-library-alist'
+ is automatically set to name only those DLL names that are known to
+ be compatible with the version given by `libpng-version'. If PNG
+ support does not work for you even though you have the support DLL
+ installed, check the name of the installed DLL against
+ `image-library-alist' and the value of `libpng-version', and
+ download compatible DLLs if needed.
+
* Experimental SVG support
SVG support is currently experimental, and not built by default.
=== modified file 'nt/README.W32'
--- a/nt/README.W32 2010-10-23 02:46:06 +0000
+++ b/nt/README.W32 2011-01-02 20:28:40 +0000
@@ -116,14 +116,19 @@
libXpm library from X11R7.3.
Emacs can also support some other image formats with appropriate
- libraries. These libraries are all available as part of GTK, or from
- gnuwin32.sourceforge.net. Emacs will find them if the directory they
- are installed in is on the PATH.
+ libraries. These libraries are all available as part of GTK
+ download for Windows (http://www.gtk.org/download-windows.html), or
+ from the GnuWin32 project. Emacs will find them if the directory
+ they are installed in is on the PATH.
- PNG: requires the PNG reference library 1.2 or later, which will
- be named libpng13d.dll, libpng13.dll, libpng12d.dll, libpng12.dll
- or libpng.dll. LibPNG requires zlib, which should come from the same
- source as you got libpng.
+ PNG: requires the PNG reference library 1.4 or later, which will
+ be named libpng14.dll or libpng14-14.dll. LibPNG requires zlib,
+ which should come from the same source as you got libpng.
+ Starting with Emacs 23.3, the precompiled Emacs binaries are
+ built with libpng 1.4.x and later, and are incompatible with
+ earlier versions of libpng DLLs. So if you have libpng 1.2.x,
+ the PNG support will not work, and you will have to download
+ newer versions.
JPEG: requires the Independant JPEG Group's libjpeg 6b or later,
which will be called jpeg62.dll, libjpeg.dll, jpeg-62.dll or jpeg.dll.
@@ -134,6 +139,9 @@
GIF: requires libungif or giflib 4.1 or later, which will be
called giflib4.dll, libungif4.dll or libungif.dll.
+ If you have image support DLLs under different names, customize the
+ value of `image-library-alist'.
+
In addition, Emacs can be compiled to support SVG. This precompiled
distribution has not been compiled that way, since the SVG library
or one or more of its extensive dependencies appear to be
=== modified file 'nt/configure.bat'
--- a/nt/configure.bat 2010-09-29 13:58:11 +0000
+++ b/nt/configure.bat 2011-01-02 20:28:40 +0000
@@ -788,6 +788,19 @@
set distfiles=
set HAVE_DISTFILES=
set distFilesOk=
+set pngsupport=
+set jpegsupport=
+set gifsupport=
+set tiffsupport=
+set xpmsupport=
+set svgsupport=
+set libsOK=
+set HAVE_GIF=
+set HAVE_JPEG=
+set HAVE_PNG=
+set HAVE_TIFF=
+set HAVE_XPM=
+set dbginfo=
goto skipArchTag
arch-tag: 300d20a4-1675-4e75-b615-7ce1a8c5376c
=== modified file 'src/.gdbinit'
--- a/src/.gdbinit 2010-11-13 13:29:31 +0000
+++ b/src/.gdbinit 2011-01-02 20:28:40 +0000
@@ -1,5 +1,5 @@
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001,
-# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
# Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
@@ -51,7 +51,7 @@
# Using a constant runs into GDB bugs sometimes.
define xgetptr
set $bugfix = $arg0
- set $ptr = (gdb_use_union ? $bugfix.u.val : $bugfix & $valmask) |
gdb_data_seg_bits
+ set $ptr = (gdb_use_union ? (gdb_use_lsb ? $bugfix.u.val << gdb_gctypebits :
$bugfix.u.val) : $bugfix & $valmask) | gdb_data_seg_bits
end
define xgetint
@@ -1227,7 +1227,8 @@
xprintsym (*$bt->function)
printf " (0x%x)\n", $bt->args
else
- printf "0x%x ", *$bt->function
+ xgetptr *$bt->function
+ printf "0x%x ", $ptr
if $type == Lisp_Vectorlike
xgetptr (*$bt->function)
set $size = ((struct Lisp_Vector *) $ptr)->size
=== modified file 'src/ChangeLog'
--- a/src/ChangeLog 2011-01-01 06:02:36 +0000
+++ b/src/ChangeLog 2011-01-02 20:28:40 +0000
@@ -1,3 +1,54 @@
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * keyboard.c (Vselect_active_regions): Doc fix. (Bug#7702)
+
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * image.c <Qlibpng_version>: New variable.
+ (syms_of_image): Intern and staticpro it. Set its value to the
+ version of PNG library we were compiled with.
+ (my_png_error, png_load): Avoid GCC warnings about direct access
+ to png_ptr->jmpbuf. (Bug#7716)
+ (png_jmpbuf): New macro.
+ (my_png_error, png_load): Use it instead of #ifdef'ing according
+ to PNG_LIBPNG_VER_MAJOR and PNG_LIBPNG_VER_MINOR.
+
+2011-01-02 Stefan Monnier <address@hidden>
+
+ * .gdbinit (xgetptr): Fix the union+lsb case.
+ (xbacktrace): Fix the union case.
+
+2011-01-02 Stefan Monnier <address@hidden>
+
+ * window.c (Fmove_to_window_line): Avoid abort when called in a buffer
+ different from selected-window's.
+
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * keyboard.c (parse_menu_item): Prepend " " to the key sequence
+ equivalent of a menu item when the key sequence is given by the
+ `:keys' attribute. (Bug#7662)
+
+ * xdisp.c (Fformat_mode_line): Doc fix: no need to state that only
+ the basic faces are supported.
+
+2011-01-02 Jan Djärv <address@hidden>
+
+ * xterm.c (x_check_fullscreen): Fix pixel/character mixup.
+
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * xdisp.c (Fformat_mode_line): Fix last change.
+
+2011-01-02 Chong Yidong <address@hidden>
+
+ * xdisp.c (Fformat_mode_line): Restrict the FACE argument to basic
+ faces (Bug#7587).
+
+2011-01-02 Eli Zaretskii <address@hidden>
+
+ * fileio.c (Fexpand_file_name): One more doc fix.
+
2011-01-01 Chong Yidong <address@hidden>
* gtkutil.c (xg_get_tool_bar_widgets): Use NULL for a missing
=== modified file 'src/fileio.c'
--- a/src/fileio.c 2010-12-13 15:27:36 +0000
+++ b/src/fileio.c 2011-01-02 20:28:40 +0000
@@ -782,6 +782,8 @@
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
\(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
the current buffer's value of `default-directory' is used.
+NAME should be a string that is a valid file name for the underlying
+filesystem.
File name components that are `.' are removed, and
so are file name components followed by `..', along with the `..' itself;
note that these simplifications are done without checking the resulting
=== modified file 'src/image.c'
--- a/src/image.c 2010-12-19 05:43:42 +0000
+++ b/src/image.c 2011-01-02 20:28:40 +0000
@@ -94,6 +94,11 @@
without modifying lots of files). */
extern void x_query_colors (struct frame *f, XColor *colors, int ncolors);
extern void x_query_color (struct frame *f, XColor *color);
+
+/* Version of libpng that we were compiled with, or -1 if no PNG
+ support was compiled in. This is tested by w32-win.el to correctly
+ set up the alist used to search for PNG libraries. */
+Lisp_Object Qlibpng_version;
#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
@@ -5523,6 +5528,12 @@
#endif /* HAVE_NTGUI */
+/* libpng before 1.4.0 didn't have png_jmpbuf; v1.4.0 and later
+ deprecate direct access to png_ptr fields. */
+#ifndef png_jmpbuf
+# define png_jmpbuf(PTR) ((PTR)->jmpbuf)
+#endif
+
/* Error and warning handlers installed when the PNG library
is initialized. */
@@ -5530,8 +5541,10 @@
my_png_error (png_struct *png_ptr, const char *msg)
{
xassert (png_ptr != NULL);
+ /* Avoid compiler warning about deprecated direct access to
+ png_ptr's fields in libpng versions 1.4.x. */
image_error ("PNG error: %s", build_string (msg), Qnil);
- longjmp (png_ptr->jmpbuf, 1);
+ longjmp (png_jmpbuf (png_ptr), 1);
}
@@ -5693,7 +5706,7 @@
/* Set error jump-back. We come back here when the PNG library
detects an error. */
- if (setjmp (png_ptr->jmpbuf))
+ if (setjmp (png_jmpbuf (png_ptr)))
{
error:
if (png_ptr)
@@ -8776,6 +8789,16 @@
staticpro (&QCpt_height);
#endif /* HAVE_GHOSTSCRIPT */
+#ifdef HAVE_NTGUI
+ Qlibpng_version = intern_c_string ("libpng-version");
+ staticpro (&Qlibpng_version);
+#if HAVE_PNG
+ SET_SYMBOL_VAL (XSYMBOL (Qlibpng_version), make_number (PNG_LIBPNG_VER));
+#else
+ SET_SYMBOL_VAL (XSYMBOL (Qlibpng_version), make_number (-1));
+#endif
+#endif
+
#if defined (HAVE_XPM) || defined (HAVE_NS)
Qxpm = intern_c_string ("xpm");
staticpro (&Qxpm);
=== modified file 'src/keyboard.c'
--- a/src/keyboard.c 2010-12-20 00:17:26 +0000
+++ b/src/keyboard.c 2011-01-02 20:28:40 +0000
@@ -7968,7 +7968,7 @@
/* The previous code preferred :key-sequence to :keys, so we
preserve this behavior. */
if (STRINGP (keyeq) && !CONSP (keyhint))
- keyeq = Fsubstitute_command_keys (keyeq);
+ keyeq = concat2 (build_string (" "), Fsubstitute_command_keys (keyeq));
else
{
Lisp_Object prefix = keyeq;
@@ -12386,7 +12386,7 @@
DEFVAR_LISP ("select-active-regions",
&Vselect_active_regions,
- doc: /* If non-nil, an active region automatically becomes the
window selection.
+ doc: /* If non-nil, an active region automatically sets the
primary selection.
If the value is `only', only temporarily active regions (usually made
by mouse-dragging or shift-selection) set the window selection.
=== modified file 'src/window.c'
--- a/src/window.c 2010-12-29 11:16:44 +0000
+++ b/src/window.c 2011-01-02 20:28:40 +0000
@@ -5762,6 +5762,12 @@
int this_scroll_margin;
#endif
+ if (!(BUFFERP (w->buffer)
+ && XBUFFER (w->buffer) == current_buffer))
+ /* This test is needed to make sure PT/PT_BYTE make sense in w->buffer
+ when passed below to set_marker_both. */
+ error ("move-to-window-line called from unrelated buffer");
+
window = selected_window;
start = marker_position (w->start);
if (start < BEGV || start > ZV)
=== modified file 'src/xdisp.c'
--- a/src/xdisp.c 2010-12-20 00:17:26 +0000
+++ b/src/xdisp.c 2011-01-02 20:28:40 +0000
@@ -19068,23 +19068,27 @@
First arg FORMAT specifies the mode line format (see `mode-line-format'
for details) to use.
-Optional second arg FACE specifies the face property to put
-on all characters for which no face is specified.
-The value t means whatever face the window's mode line currently uses
-\(either `mode-line' or `mode-line-inactive', depending).
-A value of nil means the default is no face property.
-If FACE is an integer, the value string has no text properties.
+By default, the format is evaluated for the currently selected window.
+
+Optional second arg FACE specifies the face property to put on all
+characters for which no face is specified. The value nil means the
+default face. The value t means whatever face the window's mode line
+currently uses (either `mode-line' or `mode-line-inactive',
+depending on whether the window is the selected window or not).
+An integer value means the value string has no text
+properties.
Optional third and fourth args WINDOW and BUFFER specify the window
and buffer to use as the context for the formatting (defaults
-are the selected window and the window's buffer). */)
- (Lisp_Object format, Lisp_Object face, Lisp_Object window, Lisp_Object
buffer)
+are the selected window and the WINDOW's buffer). */)
+ (Lisp_Object format, Lisp_Object face,
+ Lisp_Object window, Lisp_Object buffer)
{
struct it it;
int len;
struct window *w;
struct buffer *old_buffer = NULL;
- int face_id = -1;
+ int face_id;
int no_props = INTEGERP (face);
int count = SPECPDL_INDEX ();
Lisp_Object str;
@@ -19107,15 +19111,14 @@
if (no_props)
face = Qnil;
- if (!NILP (face))
- {
- if (EQ (face, Qt))
- face = (EQ (window, selected_window) ? Qmode_line :
Qmode_line_inactive);
- face_id = lookup_named_face (XFRAME (WINDOW_FRAME (w)), face, 0);
- }
-
- if (face_id < 0)
- face_id = DEFAULT_FACE_ID;
+ face_id = (NILP (face) || EQ (face, Qdefault)) ? DEFAULT_FACE_ID
+ : EQ (face, Qt) ? (EQ (window, selected_window)
+ ? MODE_LINE_FACE_ID : MODE_LINE_INACTIVE_FACE_ID)
+ : EQ (face, Qmode_line) ? MODE_LINE_FACE_ID
+ : EQ (face, Qmode_line_inactive) ? MODE_LINE_INACTIVE_FACE_ID
+ : EQ (face, Qheader_line) ? HEADER_LINE_FACE_ID
+ : EQ (face, Qtool_bar) ? TOOL_BAR_FACE_ID
+ : DEFAULT_FACE_ID;
if (XBUFFER (buffer) != current_buffer)
old_buffer = current_buffer;
=== modified file 'src/xterm.c'
--- a/src/xterm.c 2010-12-28 16:34:04 +0000
+++ b/src/xterm.c 2011-01-02 20:28:40 +0000
@@ -8612,9 +8612,13 @@
if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
return; /* Only fullscreen without WM or with EWM hints (above). */
+ /* Setting fullscreen to nil doesn't do anything. We could save the
+ last non-fullscreen size and restore it, but it seems like a
+ lot of work for this unusual case (no window manager running). */
+
if (f->want_fullscreen != FULLSCREEN_NONE)
{
- int width = FRAME_COLS (f), height = FRAME_LINES (f);
+ int width = FRAME_PIXEL_WIDTH (f), height = FRAME_PIXEL_HEIGHT (f);
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
switch (f->want_fullscreen)
@@ -8632,12 +8636,8 @@
height = x_display_pixel_height (dpyinfo);
}
- if (FRAME_COLS (f) != width || FRAME_LINES (f) != height)
- {
- change_frame_size (f, height, width, 0, 1, 0);
- SET_FRAME_GARBAGED (f);
- cancel_mouse_face (f);
- }
+ XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ width, height);
}
}
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r102737: Merge changes from emacs-23 branch,
Chong Yidong <=