summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorChong Yidong <cyd@stupidchicken.com>2010-11-27 15:04:57 -0500
committerChong Yidong <cyd@stupidchicken.com>2010-11-27 15:04:57 -0500
commit07976ae3b816dea4fd541bbba862603d3132eb2c (patch)
tree4a437b7cb3abb01fb144530a130c991882a1b7f2 /lisp
parent9610796712a3bc43730c99005906571a2c0bccbd (diff)
parent402c8a49571227f8a4e678d4a6cdd6ba7841aef9 (diff)
downloademacs-07976ae3b816dea4fd541bbba862603d3132eb2c.tar.gz
Merge changes from emacs-23 branch
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog122
-rw-r--r--lisp/ChangeLog.138
-rw-r--r--lisp/dired.el8
-rw-r--r--lisp/emacs-lisp/smie.el120
-rw-r--r--lisp/gnus/ChangeLog5
-rw-r--r--lisp/gnus/pop3.el19
-rw-r--r--lisp/locate.el14
-rw-r--r--lisp/lpr.el18
-rw-r--r--lisp/mail/rmail.el54
-rw-r--r--lisp/mail/rmailmm.el367
-rw-r--r--lisp/mail/rmailsum.el22
-rw-r--r--lisp/net/tramp.el14
-rw-r--r--lisp/progmodes/python.el52
-rw-r--r--lisp/progmodes/which-func.el8
-rw-r--r--lisp/vc/log-edit.el7
15 files changed, 657 insertions, 181 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f26911298e3..8544b0e53d3 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,113 @@
+2010-11-27 Chong Yidong <cyd@stupidchicken.com>
+
+ * log-edit.el (log-edit-font-lock-keywords): Don't try matching
+ stand-alone lines, since that is handled by log-edit-match-to-eoh
+ (Bug#6465).
+
+2010-11-27 Eduard Wiebe <usenet@pusto.de>
+
+ * dired.el (dired-get-filename): Replace backslashes with slashes
+ in file names on MS-Windows, needed by `locate'. (Bug#7308)
+ * locate.el (locate-default-make-command-line): Don't consider
+ drive letter and root directory part of
+ `directory-listing-before-filename-regexp'. (Bug#7308)
+ (locate-post-command-hook, locate-post-command-hook): New defcustoms.
+
+2010-11-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-prec2->grammar): Simplify handling
+ of :smie-open/close-alist.
+ (smie-next-sexp): Make it accept a "start token" as argument.
+ (smie-indent-keyword): Be careful not to misidentify tokens that span
+ more than one line, as empty lines. Add argument `token'.
+
+2010-11-27 Kenichi Handa <handa@m17n.org>
+
+ * mail/rmailmm.el (rmail-mime-insert-multipart): For unsupported
+ multipart subtypes, insert all as usual.
+
+ * mail/rmail.el: Require rfc2047.
+
+2010-11-27 Kenichi Handa <handa@m17n.org>
+
+ * mail/rmailmm.el (rmail-mime-entity, rmail-mime-entity-type)
+ (rmail-mime-entity-disposition)
+ (rmail-mime-entity-transfer-encoding, rmail-mime-entity-header)
+ (rmail-mime-entity-body, rmail-mime-entity-children): New functions.
+ (rmail-mime-save): Handle the case that the button's `data' is a
+ MIME entity.
+ (rmail-mime-insert-text): New function.
+ (rmail-mime-insert-image): Handle the case that DATA is a MIME
+ entity.
+ (rmail-mime-bulk-handler): Just call rmail-mime-insert-bulk.
+ (rmail-mime-insert-bulk): New function mostly copied from the old
+ rmail-mime-bulk-handler.
+ (rmail-mime-multipart-handler): Just call
+ rmail-mime-process-multipart.
+ (rmail-mime-process-multipart): New funciton mostly copied from
+ the old rmail-mime-multipart-handler.
+ (rmail-mime-show): Just call rmail-mime-process.
+ (rmail-mime-process): New funciton mostly copied from the old
+ rmail-mime-show.
+ (rmail-mime-insert-multipart, rmail-mime-parse)
+ (rmail-mime-insert, rmail-show-mime)
+ (rmail-insert-mime-forwarded-message)
+ (rmail-insert-mime-resent-message): New functions.
+ (rmail-insert-mime-forwarded-message-function): Set to
+ rmail-insert-mime-forwarded-message.
+ (rmail-insert-mime-resent-message-function): Set to
+ rmail-insert-mime-resent-message.
+
+ * mail/rmailsum.el: Require rfc2047.
+ (rmail-header-summary): Handle multiline Subject: field.
+ (rmail-summary-line-decoder): Change the default to
+ rfc2047-decode-string.
+
+ * mail/rmail.el (rmail-enable-mime): Change the default to t.
+ (rmail-mime-feature): Change the default to `rmailmm'.
+ (rmail-quit): Delete the specifal code for rmail-enable-mime.
+ (rmail-display-labels): Likewise.
+ (rmail-show-message-1): Check rmail-enable-mime, and use
+ rmail-show-mime-function for a MIME message. Decode the headers
+ according to RFC2047.
+
+2010-11-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/which-func.el (which-func-imenu-joiner-function):
+ Return a string, as expected.
+ (which-function-mode): Make sure we stop any previous timer before
+ starting a new one.
+
+2010-11-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-default-method-alist)
+ (tramp-default-user-alist, tramp-default-proxies-alist):
+ Adapt custom options type. (Bug#7445)
+
+2010-11-27 Chong Yidong <cyd@stupidchicken.com>
+
+ * progmodes/python.el: Add Ipython support (Bug#5390).
+ (python-shell-prompt-alist)
+ (python-shell-continuation-prompt-alist): New options.
+ (python--set-prompt-regexp): New function.
+ (inferior-python-mode, run-python, python-shell):
+ Require ansi-color. Use python--set-prompt-regexp to set the comint
+ prompt based on the Python interpreter.
+ (python--prompt-regexp): New var.
+ (python-check-comint-prompt)
+ (python-comint-output-filter-function): Use it.
+ (run-python): Use a pipe (Bug#5694).
+
+2010-11-27 Chong Yidong <cyd@stupidchicken.com>
+
+ * progmodes/python.el (run-python): Doc fix.
+ (python-keep-current-directory-in-path): New var (Bug#7454).
+
+2010-11-27 Chong Yidong <cyd@stupidchicken.com>
+
+ * lpr.el (lpr-buffer, print-buffer, lpr-region, print-region):
+ Prompt user before actually printing.
+
2010-11-27 Eli Zaretskii <eliz@gnu.org>
* international/characters.el (glyphless-char-display-control):
@@ -227,7 +337,8 @@
2010-11-18 Stefan Monnier <monnier@iro.umontreal.ca>
* simple.el (kill-new, kill-append, kill-region):
- * comint.el (comint-kill-region): Make the yank-handler argument obsolete.
+ * comint.el (comint-kill-region): Make the yank-handler argument
+ obsolete.
2010-11-18 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -6074,7 +6185,7 @@
* vc/vc-annotate.el (vc-annotate): Add an optional argument for the
VC backend. Use it when non-nil.
(vc-annotate-warp-revision): Pass the VC backend to vc-annotate.
- (Bug#6487)
+ (Bug#6487).
Fix vc-annotate-show-changeset-diff-revision-at-line for git.
* vc/vc-annotate.el (vc-annotate-show-diff-revision-at-line-internal):
@@ -9735,7 +9846,8 @@
2010-02-06 Dan Nicolaescu <dann@ics.uci.edu>
- * vc-bzr.el (vc-bzr-dir-extra-headers): Disable the pending merges header.
+ * vc-bzr.el (vc-bzr-dir-extra-headers):
+ Disable the pending merges header.
2010-02-05 Juri Linkov <juri@jurta.org>
@@ -10624,8 +10736,8 @@
2009-12-18 Ulf Jasper <ulf.jasper@web.de>
* calendar/icalendar.el (icalendar--convert-tz-offset):
- Fix timezone names.
- (icalendar--convert-tz-offset): Fix the "last-day-problem".
+ Fixed timezone names.
+ (icalendar--convert-tz-offset): Fixed the "last-day-problem".
(icalendar--add-diary-entry): Remove the trailing blank that
diary-make-entry inserts.
diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13
index fa82dc2fc63..d8ec37390f1 100644
--- a/lisp/ChangeLog.13
+++ b/lisp/ChangeLog.13
@@ -6680,8 +6680,9 @@
buffer if the parent buffer is in vc-dired-mode.
2007-11-23 Mark A. Hershberger <mah@everybody.org>
+ James Clark <none@example.com>
- * nxml: Initial merge of nxml. Kept nxml/char-name subdir for now.
+ * nxml/: Initial merge of nxml. Kept nxml/char-name subdir for now.
2007-11-23 Juri Linkov <juri@jurta.org>
@@ -16693,10 +16694,9 @@ See ChangeLog.12 for earlier changes.
;; Local Variables:
;; coding: utf-8
-;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -16712,5 +16712,3 @@ See ChangeLog.12 for earlier changes.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; arch-tag: 1e8aa93a-fc6c-4ac3-9b10-1f445e1840af
diff --git a/lisp/dired.el b/lisp/dired.el
index bd3fb531d77..104cf4970ad 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2011,6 +2011,14 @@ Otherwise, an error occurs in these cases."
;; with quotation marks in their names.
(while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file)
(setq file (replace-match "\\\"" nil t file 1)))
+
+ (when (eq system-type 'windows-nt)
+ (save-match-data
+ (let ((start 0))
+ (while (string-match "\\\\" file start)
+ (aset file (match-beginning 0) ?/)
+ (setq start (match-end 0))))))
+
(setq file (read (concat "\"" file "\"")))
;; The above `read' will return a unibyte string if FILE
;; contains eight-bit-control/graphic characters.
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 179e0a9f094..a7021b3cf7b 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -76,8 +76,6 @@
;; TODO & BUGS:
;;
-;; - FIXME: I think the behavior on empty lines is wrong. It shouldn't
-;; look at the next token on subsequent lines.
;; - Using the structural information SMIE gives us, it should be possible to
;; implement a `smie-align' command that would automatically figure out what
;; there is to align and how to do it (something like: align the token of
@@ -470,7 +468,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or
(to (cdar eqs)))
(setq eqs (cdr eqs))
(if (eq to from)
- nil ;Nothing to do.
+ nil ;Nothing to do.
(dolist (other-eq eqs)
(if (eq from (cdr other-eq)) (setcdr other-eq to))
(when (eq from (car other-eq))
@@ -523,24 +521,23 @@ PREC2 is a table as returned by `smie-precs->prec2' or
(setcar (car eq) (cadr eq))
;; (smie-check-grammar table prec2 'step2)
)
- ;; Finally, fill in the remaining vars (which only appeared on the
- ;; right side of the < constraints).
- (let ((classification-table (gethash :smie-open/close-alist prec2)))
- (dolist (x table)
- ;; When both sides are nil, it means this operator binds very
- ;; very tight, but it's still just an operator, so we give it
- ;; the highest precedence.
- ;; OTOH if only one side is nil, it usually means it's like an
- ;; open-paren, which is very important for indentation purposes,
- ;; so we keep it nil if so, to make it easier to recognize.
- (unless (or (nth 1 x)
- (eq 'opener (cdr (assoc (car x) classification-table))))
- (setf (nth 1 x) i)
- (incf i)) ;See other (incf i) above.
- (unless (or (nth 2 x)
- (eq 'closer (cdr (assoc (car x) classification-table))))
- (setf (nth 2 x) i)
- (incf i))))) ;See other (incf i) above.
+ ;; Finally, fill in the remaining vars (which did not appear on the
+ ;; left side of any < constraint).
+ (dolist (x table)
+ (unless (nth 1 x)
+ (setf (nth 1 x) i)
+ (incf i)) ;See other (incf i) above.
+ (unless (nth 2 x)
+ (setf (nth 2 x) i)
+ (incf i)))) ;See other (incf i) above.
+ ;; Mark closers and openers.
+ (dolist (x (gethash :smie-open/close-alist prec2))
+ (let* ((token (car x))
+ (cons (case (cdr x)
+ (closer (cddr (assoc token table)))
+ (opener (cdr (assoc token table))))))
+ (assert (numberp (car cons)))
+ (setf (car cons) (list (car cons)))))
(let ((ca (gethash :smie-closer-alist prec2)))
(when ca (push (cons :smie-closer-alist ca) table)))
;; (smie-check-grammar table prec2 'step3)
@@ -611,6 +608,8 @@ OP-FORW is the accessor to the forward level of the level data.
OP-BACK is the accessor to the backward level of the level data.
HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
first token we see is an operator, skip over its left-hand-side argument.
+HALFSEXP can also be a token, in which case it means to parse as if
+we had just successfully passed this token.
Possible return values:
(FORW-LEVEL POS TOKEN): we couldn't skip TOKEN because its back-level
is too high. FORW-LEVEL is the forw-level of TOKEN,
@@ -619,7 +618,10 @@ Possible return values:
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(catch 'return
- (let ((levels ()))
+ (let ((levels
+ (if (stringp halfsexp)
+ (prog1 (list (cdr (assoc halfsexp smie-grammar)))
+ (setq halfsexp nil)))))
(while
(let* ((pos (point))
(token (funcall next-token))
@@ -697,6 +699,8 @@ Possible return values:
"Skip over one sexp.
HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
first token we see is an operator, skip over its left-hand-side argument.
+HALFSEXP can also be a token, in which case we should skip the text
+assuming it is the left-hand-side argument of that token.
Possible return values:
(LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level
is too high. LEFT-LEVEL is the left-level of TOKEN,
@@ -714,7 +718,9 @@ Possible return values:
(defun smie-forward-sexp (&optional halfsexp)
"Skip over one sexp.
HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
-first token we see is an operator, skip over its left-hand-side argument.
+first token we see is an operator, skip over its right-hand-side argument.
+HALFSEXP can also be a token, in which case we should skip the text
+assuming it is the right-hand-side argument of that token.
Possible return values:
(RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level
is too high. RIGHT-LEVEL is the right-level of TOKEN,
@@ -791,7 +797,7 @@ Possible return values:
(push (car other) found))))))
(cond
((null found) (error "No known closer for opener %s" open))
- ;; FIXME: what should we do if there are various closers?
+ ;; What should we do if there are various closers?
(t (car found))))))))))
(unless (save-excursion (skip-chars-backward " \t") (bolp))
(newline))
@@ -1094,9 +1100,6 @@ Only meaningful when called from within `smie-rules-function'."
;; line, in which case we want to align it with its enclosing parent.
(cond
((and (eq method :before) (smie-rule-bolp) (not (smie-rule-sibling-p)))
- ;; FIXME: Rather than consult the number of spaces, we could *set* the
- ;; number of spaces so as to align the separator with the close-paren
- ;; while aligning the content with the rest.
(let ((parent-col (cdr (smie-rule-parent)))
(parent-pos-col ;FIXME: we knew this when computing smie--parent.
(save-excursion
@@ -1225,39 +1228,48 @@ in order to figure out the indentation of some other (further down) point."
(smie-indent-virtual)) ;:not-hanging
(scan-error nil)))))
-(defun smie-indent-keyword ()
- ;; Align closing token with the corresponding opening one.
- ;; (e.g. "of" with "case", or "in" with "let").
+(defun smie-indent-keyword (&optional token)
+ "Indent point based on the token that follows it immediately.
+If TOKEN is non-nil, assume that that is the token that follows point.
+Returns either a column number or nil if it considers that indentation
+should not be computed on the basis of the following token."
(save-excursion
(let* ((pos (point))
- (toklevels (smie-indent-forward-token))
- (token (pop toklevels)))
+ (toklevels
+ (if token
+ (assoc token smie-grammar)
+ (let* ((res (smie-indent-forward-token)))
+ ;; Ignore tokens on subsequent lines.
+ (if (and (< pos (line-beginning-position))
+ ;; Make sure `token' also *starts* on another line.
+ (save-excursion
+ (smie-indent-backward-token)
+ (< pos (line-beginning-position))))
+ nil
+ (goto-char pos)
+ res)))))
+ (setq token (pop toklevels))
(cond
- ((< pos (line-beginning-position))
- ;; The token we just read is actually not on the line where we started.
- nil)
+ ((null (cdr toklevels)) nil) ;Not a keyword.
((not (numberp (car toklevels)))
- (save-excursion
- (goto-char pos)
- ;; Different cases:
- ;; - smie-indent--bolp: "indent according to others".
- ;; - common hanging: "indent according to others".
- ;; - SML-let hanging: "indent like parent".
- ;; - if-after-else: "indent-like parent".
- ;; - middle-of-line: "trust current position".
- (cond
- ((null (cdr toklevels)) nil) ;Not a keyword.
- ((smie-indent--rule :before token))
- ((smie-indent--bolp) ;I.e. non-virtual indent.
- ;; For an open-paren-like thingy at BOL, always indent only
- ;; based on other rules (typically smie-indent-after-keyword).
- nil)
- (t
- ;; By default use point unless we're hanging.
- (unless (smie-indent--hanging-p) (current-column))))))
+ ;; Different cases:
+ ;; - smie-indent--bolp: "indent according to others".
+ ;; - common hanging: "indent according to others".
+ ;; - SML-let hanging: "indent like parent".
+ ;; - if-after-else: "indent-like parent".
+ ;; - middle-of-line: "trust current position".
+ (cond
+ ((smie-indent--rule :before token))
+ ((smie-indent--bolp) ;I.e. non-virtual indent.
+ ;; For an open-paren-like thingy at BOL, always indent only
+ ;; based on other rules (typically smie-indent-after-keyword).
+ nil)
+ (t
+ ;; By default use point unless we're hanging.
+ (unless (smie-indent--hanging-p) (current-column)))))
(t
;; FIXME: This still looks too much like black magic!!
- (let* ((parent (smie-backward-sexp 'halfsexp)))
+ (let* ((parent (smie-backward-sexp token)))
;; Different behaviors:
;; - align with parent.
;; - parent + offset.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 3ae3c5bc740..651cfef7f00 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
+2010-11-27 Yuri Karaban <tech@askold.net> (tiny change)
+
+ * pop3.el (pop3-open-server): Read server greeting before starting TLS
+ negotiation.
+
2010-11-26 Julien Danjou <julien@danjou.info>
* color.el: Rename various rgb functions to srgb.
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 327c5297492..eef53c2797d 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -327,21 +327,22 @@ Returns the process associated with the connection."
;; gnutls-cli, openssl don't accept service names
(if (equal port "pop3")
(setq port 110))
- (let ((process (starttls-open-stream "POP" (current-buffer)
- mailhost (or port 110))))
- (pop3-send-command process "STLS")
- (let ((response (pop3-read-response process t)))
- (if (and response (string-match "+OK" response))
- (starttls-negotiate process)
- (pop3-quit process)
- (error "POP server doesn't support starttls")))
- process))
+ ;; Delay STLS until server greeting is read (Bug#7438).
+ (starttls-open-stream "POP" (current-buffer)
+ mailhost (or port 110)))
(t
(open-network-stream "POP" (current-buffer) mailhost port))))
(let ((response (pop3-read-response process t)))
(setq pop3-timestamp
(substring response (or (string-match "<" response) 0)
(+ 1 (or (string-match ">" response) -1)))))
+ (when (eq pop3-stream-type 'starttls)
+ (pop3-send-command process "STLS")
+ (let ((response (pop3-read-response process t)))
+ (if (and response (string-match "+OK" response))
+ (starttls-negotiate process)
+ (pop3-quit process)
+ (error "POP server doesn't support starttls"))))
(pop3-set-process-query-on-exit-flag process nil)
process)))
diff --git a/lisp/locate.el b/lisp/locate.el
index 4e8925665ca..4c4312b9598 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -145,6 +145,11 @@ the version.)"
:type 'string
:group 'locate)
+(defcustom locate-post-command-hook nil
+ "List of hook functions run after `locate' (see `run-hooks')."
+ :type 'hook
+ :group 'locate)
+
(defvar locate-history-list nil
"The history list used by the \\[locate] command.")
@@ -226,6 +231,11 @@ that is, with a prefix arg, you get the default behavior."
:group 'locate
:type 'boolean)
+(defcustom locate-mode-hook nil
+ "List of hook functions run by `locate-mode' (see `run-mode-hooks')."
+ :type 'hook
+ :group 'locate)
+
;; Functions
(defun locate-default-make-command-line (search-string)
@@ -471,9 +481,9 @@ do not work in subdirectories.
(make-local-variable 'directory-listing-before-filename-regexp)
;; This should support both Unix and Windoze style names
(setq directory-listing-before-filename-regexp
- (concat "^."
+ (concat "^.\\("
(make-string (1- locate-filename-indentation) ?\s)
- "\\(/\\|[A-Za-z]:\\)\\|"
+ "\\)\\|"
(default-value 'directory-listing-before-filename-regexp)))
(make-local-variable 'dired-actual-switches)
(setq dired-actual-switches "")
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 559dc5513ae..3b91172a7ef 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -152,7 +152,9 @@ The variable `lpr-page-header-program' specifies the program to use."
"Print buffer contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command."
- (interactive)
+ (interactive
+ (unless (y-or-n-p "Send current buffer to default printer? ")
+ (error "Cancelled")))
(print-region-1 (point-min) (point-max) lpr-switches nil))
;;;###autoload
@@ -169,7 +171,9 @@ in the print command itself; we expect them to request pagination.
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command."
- (interactive)
+ (interactive
+ (unless (y-or-n-p "Send current buffer to default printer? ")
+ (error "Cancelled")))
(print-region-1 (point-min) (point-max) lpr-switches t))
;;;###autoload
@@ -177,7 +181,10 @@ for further customization of the printer command."
"Print region contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command."
- (interactive "r")
+ (interactive
+ (if (y-or-n-p "Send selected text to default printer? ")
+ (list (region-beginning) (region-end))
+ (error "Cancelled")))
(print-region-1 start end lpr-switches nil))
;;;###autoload
@@ -194,7 +201,10 @@ in the print command itself; we expect them to request pagination.
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command."
- (interactive "r")
+ (interactive
+ (if (y-or-n-p "Send selected text to default printer? ")
+ (list (region-beginning) (region-end))
+ (error "Cancelled")))
(print-region-1 start end lpr-switches t))
(defun print-region-1 (start end switches page-headers)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 47e52f27aa1..a2629dfe1c7 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -39,6 +39,7 @@
;;
(require 'mail-utils)
+(require 'rfc2047)
(defconst rmail-attribute-header "X-RMAIL-ATTRIBUTES"
"The header that stores the Rmail attribute data.")
@@ -638,7 +639,7 @@ Element N specifies the summary line for message N+1.")
This is set to nil by default.")
-(defcustom rmail-enable-mime nil
+(defcustom rmail-enable-mime t
"If non-nil, RMAIL uses MIME features.
If the value is t, RMAIL automatically shows MIME decoded message.
If the value is neither t nor nil, RMAIL does not show MIME decoded message
@@ -649,6 +650,7 @@ unless the feature specified by `rmail-mime-feature' is available."
:type '(choice (const :tag "on" t)
(const :tag "off" nil)
(other :tag "when asked" ask))
+ :version "23.3"
:group 'rmail)
(defvar rmail-enable-mime-composing nil
@@ -693,13 +695,12 @@ start of the header) with three arguments MSG, REGEXP, and LIMIT,
where MSG is the message number, REGEXP is the regular
expression, LIMIT is the position specifying the end of header.")
-(defvar rmail-mime-feature 'rmail-mime
+(defvar rmail-mime-feature 'rmailmm
"Feature to require to load MIME support in Rmail.
When starting Rmail, if `rmail-enable-mime' is non-nil,
this feature is required with `require'.
-The default value is `rmail-mime'. This feature is provided by
-the rmail-mime package available at <http://www.m17n.org/rmail-mime/>.")
+The default value is `rmailmm'")
;; FIXME this is unused.
(defvar rmail-decode-mime-charset t
@@ -1509,17 +1510,9 @@ Hook `rmail-quit-hook' is run after expunging."
(set-buffer-modified-p nil))
(replace-buffer-in-windows rmail-summary-buffer)
(bury-buffer rmail-summary-buffer))
- (if rmail-enable-mime
- (let ((obuf rmail-buffer)
- (ovbuf rmail-view-buffer))
- (set-buffer rmail-view-buffer)
- (quit-window)
- (replace-buffer-in-windows ovbuf)
- (replace-buffer-in-windows obuf)
- (bury-buffer obuf))
- (let ((obuf (current-buffer)))
- (quit-window)
- (replace-buffer-in-windows obuf))))
+ (let ((obuf (current-buffer)))
+ (quit-window)
+ (replace-buffer-in-windows obuf)))
(defun rmail-bury ()
"Bury current Rmail buffer and its summary buffer."
@@ -2219,15 +2212,7 @@ If nil, that means the current message."
(let ((blurb (rmail-get-labels)))
(setq mode-line-process
(format " %d/%d%s"
- rmail-current-message rmail-total-messages blurb))
- ;; If rmail-enable-mime is non-nil, we may have to update
- ;; `mode-line-process' of rmail-view-buffer too.
- (if (and rmail-enable-mime
- (not (eq (current-buffer) rmail-view-buffer))
- (buffer-live-p rmail-view-buffer))
- (let ((mlp mode-line-process))
- (with-current-buffer rmail-view-buffer
- (setq mode-line-process mlp))))))
+ rmail-current-message rmail-total-messages blurb))))
(defun rmail-get-attr-value (attr state)
"Return the character value for ATTR.
@@ -2706,6 +2691,11 @@ The current mail message becomes the message displayed."
(message "Showing message %d" msg))
(narrow-to-region beg end)
(goto-char beg)
+ (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)
@@ -2722,11 +2712,6 @@ The current mail message becomes the message displayed."
;; unibyte temporary buffer where the character decoding takes
;; place.
(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)
(erase-buffer))
(if (null character-coding)
;; Do it directly since that is fast.
@@ -2749,8 +2734,13 @@ The current mail message becomes the message displayed."
(error "uuencoded messages are not supported yet"))
(t))
(rmail-decode-region (point-min) (point-max)
- coding-system view-buf)))
+ 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)
@@ -2766,6 +2756,10 @@ The current mail message becomes the message displayed."
(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)
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 3882c9e47c8..918d2dfc365 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -27,17 +27,57 @@
;; Essentially based on the design of Alexander Pohoyda's MIME
;; extensions (mime-display.el and mime.el).
-;; Call `M-x rmail-mime' when viewing an Rmail message.
+
+;; This file provides two operation modes for viewing a MIME message.
+
+;; (1) When rmail-enable-mime is non-nil (now it is the default), the
+;; function `rmail-show-mime' is automatically called. That function
+;; shows a MIME message directly in RMAIL's view buffer.
+
+;; (2) When rmail-enable-mime is nil, the command 'v' (or M-x
+;; rmail-mime) shows a MIME message in a new buffer "*RMAIL*".
+
+;; Both operations share the intermediate functions rmail-mime-process
+;; and rmail-mime-process-multipart as below.
+
+;; rmail-show-mime
+;; +- rmail-mime-parse
+;; | +- rmail-mime-process <--+------------+
+;; | | +---------+ |
+;; | + rmail-mime-process-multipart --+
+;; |
+;; + rmail-mime-insert <----------------+
+;; +- rmail-mime-insert-text |
+;; +- rmail-mime-insert-bulk |
+;; +- rmail-mime-insert-multipart --+
+;;
+;; rmail-mime
+;; +- rmail-mime-show <----------------------------------+
+;; +- rmail-mime-process |
+;; +- rmail-mime-handle |
+;; +- rmail-mime-text-handler |
+;; +- rmail-mime-bulk-handler |
+;; | + rmail-mime-insert-bulk
+;; +- rmail-mime-multipart-handler |
+;; +- rmail-mime-process-multipart --+
+
+;; In addition, for the case of rmail-enable-mime being non-nil, this
+;; file provides two functions rmail-insert-mime-forwarded-message and
+;; rmail-insert-mime-resent-message for composing forwarded and resent
+;; messages respectively.
;; Todo:
-;; Handle multipart/alternative.
+;; Make rmail-mime-media-type-handlers-alist usable in the first
+;; operation mode.
+;; Handle multipart/alternative in the second operation mode.
;; Offer the option to call external/internal viewers (doc-view, xpdf, etc).
;;; Code:
(require 'rmail)
(require 'mail-parse)
+(require 'message)
;;; User options.
@@ -91,6 +131,52 @@ automatically display the image in the buffer."
;;; End of user options.
+;;; 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:
+
+ \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
+
+VALUE is a string and ATTRIBUTE is a symbol.
+
+Consider the following header, for example:
+
+Content-Type: multipart/mixed;
+ boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"
+
+The corresponding TYPE argument must be:
+
+\(\"multipart/mixed\"
+ \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
+
+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))
+
+;; 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))
;;; Buttons
@@ -99,6 +185,7 @@ automatically display the image in the buffer."
(let* ((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)
@@ -117,7 +204,17 @@ automatically display the image in the buffer."
;; file, the magic signature compares equal with the unibyte
;; signature string recorded in jka-compr-compression-info-list.
(set-buffer-multibyte nil)
- (insert data)
+ (setq buffer-undo-list t)
+ (if (stringp data)
+ (insert data)
+ ;; 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))
+ (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))))))
(write-region nil nil filename nil nil nil t))))
(define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
@@ -134,6 +231,23 @@ automatically display the image in the buffer."
(when (coding-system-p coding-system)
(decode-coding-region (point-min) (point-max) coding-system))))
+(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)))))
+
;; FIXME move to the test/ directory?
(defun test-rmail-mime-handler ()
"Test of a mail using no MIME parts at all."
@@ -152,10 +266,28 @@ MIME-Version: 1.0
(defun rmail-mime-insert-image (type data)
- "Insert an image of type TYPE, where DATA is the image 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)
- (insert ?\n)
- (insert-image (create-image data type t)))
+ (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))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (setq buffer-undo-list t)
+ (insert-buffer-substring mbox-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))))
+ (setq data
+ (buffer-substring-no-properties (point-min) (point-max))))))
+ (insert-image (create-image data type t))
+ (set-buffer-modified-p modified)))
(defun rmail-mime-image (button)
"Display the image associated with BUTTON."
@@ -172,8 +304,19 @@ MIME-Version: 1.0
"Handle the current buffer as an attachment to download.
For images that Emacs is capable of displaying, the behavior
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)))
+
+(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."
;; Find the default directory for this media type.
- (let* ((directory (catch 'directory
+ (let* ((content-type (rmail-mime-entity-type entity))
+ (content-disposition (rmail-mime-entity-disposition entity))
+ (body (rmail-mime-entity-body entity))
+ (directory (catch 'directory
(dolist (entry rmail-mime-attachment-dirs-alist)
(when (string-match (car entry) (car content-type))
(dolist (dir (cdr entry))
@@ -183,17 +326,21 @@ depends upon the value of `rmail-mime-show-images'."
(cdr (assq 'filename (cdr content-disposition)))
"noname"))
(label (format "\nAttached %s file: " (car content-type)))
- (data (buffer-string))
- (udata (string-as-unibyte data))
- (size (length udata))
- (osize size)
(units '(B kB MB GB))
- type)
- (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
+ data udata size osize type)
+ (if body
+ (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)
+ (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
(cdr units))
(setq size (/ size 1024.0)
units (cdr units)))
- (delete-region (point-min) (point-max))
(insert label)
(insert-button filename
:type 'rmail-mime-save
@@ -249,6 +396,22 @@ The current buffer should be narrowed to the body. CONTENT-TYPE,
CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values
of the respective parsed headers. See `rmail-mime-handle' for their
format."
+ (rmail-mime-process-multipart
+ content-type content-disposition content-transfer-encoding nil))
+
+(defun rmail-mime-process-multipart (content-type
+ content-disposition
+ content-transfer-encoding
+ parse-only)
+ "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.
+
+Otherwise, just 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
;; with "CRLF--", as defined by RFC 2046:
;; The boundary delimiter MUST occur at the beginning of a line,
@@ -257,7 +420,7 @@ format."
;; of the preceding part.
;; We currently don't handle that.
(let ((boundary (cdr (assq 'boundary content-type)))
- beg end next)
+ beg end next entities)
(unless boundary
(rmail-mm-get-boundary-error-message
"No boundary defined" content-type content-disposition
@@ -267,7 +430,9 @@ format."
(goto-char (point-min))
(when (and (search-forward boundary nil t)
(looking-at "[ \t]*\n"))
- (delete-region (point-min) (match-end 0)))
+ (if parse-only
+ (narrow-to-region (match-end 0) (point-max))
+ (delete-region (point-min) (match-end 0))))
;; 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.
@@ -285,13 +450,17 @@ format."
(rmail-mm-get-boundary-error-message
"Malformed boundary" content-type content-disposition
content-transfer-encoding)))
- (delete-region end next)
;; Handle the part.
- (save-restriction
- (narrow-to-region beg end)
- (rmail-mime-show))
- (goto-char (setq beg next)))))
-
+ (if parse-only
+ (save-restriction
+ (narrow-to-region beg end)
+ (setq entities (cons (rmail-mime-process nil t) entities)))
+ (delete-region end next)
+ (save-restriction
+ (narrow-to-region beg end)
+ (rmail-mime-show)))
+ (goto-char (setq beg next)))
+ (nreverse entities)))
(defun test-rmail-mime-multipart-handler ()
"Test of a mail used as an example in RFC 2046."
@@ -394,6 +563,9 @@ called recursively if multiple parts are available.
The current buffer must contain a single message. It will be
modified."
+ (rmail-mime-process show-headers nil))
+
+(defun rmail-mime-process (show-headers parse-only)
(let ((end (point-min))
content-type
content-transfer-encoding
@@ -437,14 +609,105 @@ modified."
;; attachment according to RFC 2183.
(unless (member (car content-disposition) '("inline" "attachment"))
(setq content-disposition '("attachment")))
- ;; Hide headers and handle the part.
- (save-restriction
- (cond ((string= (car content-type) "message/rfc822")
- (narrow-to-region end (point-max)))
- ((not show-headers)
- (delete-region (point-min) end)))
- (rmail-mime-handle content-type content-disposition
- content-transfer-encoding))))
+
+ (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))))
+ (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)))
+ ;; Hide headers and handle the part.
+ (save-restriction
+ (cond ((string= (car content-type) "message/rfc822")
+ (narrow-to-region end (point-max)))
+ ((not show-headers)
+ (delete-region (point-min) end)))
+ (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))
+ (rmail-mime-process nil t)))
+
+(defun rmail-mime-insert (entity &optional content-type disposition)
+ "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))))
(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
"Major mode used in `rmail-mime' buffers."
@@ -480,6 +743,50 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
(error "%s; type: %s; disposition: %s; encoding: %s"
message type disposition encoding))
+(defun rmail-show-mime ()
+ (let ((mbox-buf rmail-buffer))
+ (condition-case nil
+ (let ((entity (rmail-mime-parse)))
+ (with-current-buffer rmail-view-buffer
+ (let ((inhibit-read-only t)
+ (rmail-buffer mbox-buf))
+ (erase-buffer)
+ (rmail-mime-insert entity))))
+ (error
+ ;; Decoding failed. Insert the original message body as is.
+ (let ((region (with-current-buffer mbox-buf
+ (goto-char (point-min))
+ (re-search-forward "^$" nil t)
+ (forward-line 1)
+ (cons (point) (point-max)))))
+ (with-current-buffer rmail-view-buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert-buffer-substring mbox-buf (car region) (cdr region))))
+ (message "MIME decoding failed"))))))
+
+(setq rmail-show-mime-function 'rmail-show-mime)
+
+(defun rmail-insert-mime-forwarded-message (forward-buffer)
+ (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (message-forward-make-body-mime mbox-buf))))
+
+(setq rmail-insert-mime-forwarded-message-function
+ 'rmail-insert-mime-forwarded-message)
+
+(defun rmail-insert-mime-resent-message (forward-buffer)
+ (insert-buffer-substring
+ (with-current-buffer forward-buffer rmail-view-buffer))
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (forward-line 1)
+ (delete-region (point-min) (point))))
+
+(setq rmail-insert-mime-resent-message-function
+ 'rmail-insert-mime-resent-message)
+
(provide 'rmailmm)
;; Local Variables:
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 0b8abbca6a5..f1efb33e6cb 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -32,6 +32,7 @@
;; For rmail-select-summary.
(require 'rmail)
+(require 'rfc2047)
(defcustom rmail-summary-scroll-between-messages t
"Non-nil means Rmail summary scroll commands move between messages.
@@ -364,13 +365,15 @@ The current buffer contains the unrestricted message collection."
(aset rmail-summary-vector (1- msgnum) line))
line))
-(defcustom rmail-summary-line-decoder (function identity)
+(defcustom rmail-summary-line-decoder (function rfc2047-decode-string)
"Function to decode a Rmail summary line.
It receives the summary line for one message as a string
and should return the decoded string.
-By default, it is `identity', which returns the string unaltered."
+By default, it is `rfc2047-decode-string', which decodes MIME-encoded
+subject."
:type 'function
+ :version "23.3"
:group 'rmail-summary)
(defun rmail-create-summary-line (msgnum)
@@ -589,10 +592,17 @@ the message being processed."
(t (- mch 14))))
(min len (+ lo 25)))))))))
(concat (if (re-search-forward "^Subject:" nil t)
- (progn (skip-chars-forward " \t")
- (buffer-substring (point)
- (progn (end-of-line)
- (point))))
+ (let (pos str)
+ (skip-chars-forward " \t")
+ (setq pos (point))
+ (forward-line 1)
+ (setq str (buffer-substring pos (1- (point))))
+ (while (looking-at "\\s ")
+ (setq str (concat str " "
+ (buffer-substring (match-end 0)
+ (line-end-position))))
+ (forward-line 1))
+ str)
(re-search-forward "[\n][\n]+" nil t)
(buffer-substring (point) (progn (end-of-line) (point))))
"\n")))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 10b3c7bd04c..789677ce643 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -331,9 +331,9 @@ empty string for the user name.
See `tramp-methods' for a list of possibilities for METHOD."
:group 'tramp
- :type '(repeat (list (regexp :tag "Host regexp")
- (regexp :tag "User regexp")
- (string :tag "Method"))))
+ :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
+ (choice :tag "User regexp" regexp sexp)
+ (choice :tag "Method name" string (const nil)))))
(defcustom tramp-default-user nil
"*Default user to use for transferring files.
@@ -355,9 +355,9 @@ matches, the variable `tramp-default-user' takes effect.
If the file name does not specify the method, lookup is done using the
empty string for the method name."
:group 'tramp
- :type '(repeat (list (regexp :tag "Method regexp")
- (regexp :tag "Host regexp")
- (string :tag "User"))))
+ :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
+ (choice :tag " Host regexp" regexp sexp)
+ (choice :tag " User name" string (const nil)))))
(defcustom tramp-default-host (system-name)
"*Default host to use for transferring files.
@@ -382,7 +382,7 @@ interpreted as a regular expression which always matches."
:group 'tramp
:type '(repeat (list (choice :tag "Host regexp" regexp sexp)
(choice :tag "User regexp" regexp sexp)
- (choice :tag "Proxy remote name" string (const nil)))))
+ (choice :tag " Proxy name" string (const nil)))))
(defconst tramp-local-host-regexp
(concat
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 9fe57beec30..0a641d0945f 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1462,6 +1462,16 @@ Default ignores all inputs of 0, 1, or 2 non-blank characters."
:type 'regexp
:group 'python)
+(defcustom python-remove-cwd-from-path t
+ "Whether to allow loading of Python modules from the current directory.
+If this is non-nil, Emacs removes '' from sys.path when starting
+an inferior Python process. This is the default, for security
+reasons, as it is easy for the Python process to be started
+without the user's realization (e.g. to perform completion)."
+ :type 'boolean
+ :group 'python
+ :version "23.3")
+
(defun python-input-filter (str)
"`comint-input-filter' function for inferior Python.
Don't save anything for STR matching `inferior-python-filter-regexp'."
@@ -1559,20 +1569,24 @@ print version_info >= (2, 2) and version_info < (3, 0)\""))))
;;;###autoload
(defun run-python (&optional cmd noshow new)
"Run an inferior Python process, input and output via buffer *Python*.
-CMD is the Python command to run. NOSHOW non-nil means don't show the
-buffer automatically.
-
-Normally, if there is a process already running in `python-buffer',
-switch to that buffer. Interactively, a prefix arg allows you to edit
-the initial command line (default is `python-command'); `-i' etc. args
-will be added to this as appropriate. A new process is started if:
-one isn't running attached to `python-buffer', or interactively the
-default `python-command', or argument NEW is non-nil. See also the
-documentation for `python-buffer'.
-
-Runs the hook `inferior-python-mode-hook' \(after the
-`comint-mode-hook' is run). \(Type \\[describe-mode] in the process
-buffer for a list of commands.)"
+CMD is the Python command to run. NOSHOW non-nil means don't
+show the buffer automatically.
+
+Interactively, a prefix arg means to prompt for the initial
+Python command line (default is `python-command').
+
+A new process is started if one isn't running attached to
+`python-buffer', or if called from Lisp with non-nil arg NEW.
+Otherwise, if a process is already running in `python-buffer',
+switch to that buffer.
+
+This command runs the hook `inferior-python-mode-hook' after
+running `comint-mode-hook'. Type \\[describe-mode] in the
+process buffer for a list of commands.
+
+By default, Emacs inhibits the loading of Python modules from the
+current working directory, for security reasons. To disable this
+behavior, change `python-remove-cwd-from-path' to nil."
(interactive (if current-prefix-arg
(list (read-string "Run Python: " python-command) nil t)
(list python-command)))
@@ -1586,13 +1600,9 @@ buffer for a list of commands.)"
(when (or new (not (comint-check-proc python-buffer)))
(with-current-buffer
(let* ((cmdlist
- (append (python-args-to-list cmd)
- ;; It's easy for the user to cause the process to be
- ;; started without realizing it (e.g. to perform
- ;; completion); for this reason loading files from the
- ;; current directory is a security risk. See
- ;; http://article.gmane.org/gmane.emacs.devel/103569
- '("-i" "-c" "import sys; sys.path.remove('')")))
+ (append (python-args-to-list cmd) '("-i")
+ (if python-remove-cwd-from-path
+ '("-c" "import sys; sys.path.remove('')"))))
(path (getenv "PYTHONPATH"))
(process-environment ; to import emacs.py
(cons (concat "PYTHONPATH="
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 469786e04dd..049d708d191 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -154,7 +154,7 @@ mouse-3: go to end")
:type 'sexp)
;;;###autoload (put 'which-func-format 'risky-local-variable t)
-(defvar which-func-imenu-joiner-function #'last
+(defvar which-func-imenu-joiner-function (lambda (x) (car (last x)))
"Function to join together multiple levels of imenu nomenclature.
Called with a single argument, a list of strings giving the names
of the menus we had to traverse to get to the item. Returns a
@@ -242,6 +242,9 @@ continuously displayed in the mode line, in certain major modes.
With prefix ARG, turn Which Function mode on if arg is positive,
and off otherwise."
:global t :group 'which-func
+ (when (timerp which-func-update-timer)
+ (cancel-timer which-func-update-timer))
+ (setq which-func-update-timer nil)
(if which-function-mode
;;Turn it on
(progn
@@ -253,9 +256,6 @@ and off otherwise."
(or (eq which-func-modes t)
(member major-mode which-func-modes))))))
;; Turn it off
- (when (timerp which-func-update-timer)
- (cancel-timer which-func-update-timer))
- (setq which-func-update-timer nil)
(dolist (buf (buffer-list))
(with-current-buffer buf (setq which-func-mode nil)))))
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index c0aa595d968..2bce58f50f2 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -350,17 +350,16 @@ automatically."
(defvar log-edit-font-lock-keywords
;; Copied/inspired by message-font-lock-keywords.
`((log-edit-match-to-eoh
- (,(concat "^\\(\\([a-z]+\\):\\)" log-edit-header-contents-regexp
- "\\|\\(.*\\)")
+ (,(concat "^\\(\\([a-z]+\\):\\)" log-edit-header-contents-regexp)
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
(1 (if (assoc (match-string 2) log-edit-headers-alist)
'log-edit-header
'log-edit-unknown-header)
nil lax)
+ ;; From `log-edit-header-contents-regexp':
(3 (or (cdr (assoc (match-string 2) log-edit-headers-alist))
'log-edit-header)
- nil lax)
- (4 font-lock-warning-face)))))
+ nil lax)))))
;;;###autoload
(defun log-edit (callback &optional setup params buffer mode &rest ignore)