Mercurial > emacs
changeset 82975:590114f9753d gnus-5_10-pre-merge-josefsson
2004-08-31 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote.
* gnus-sum.el (gnus-newsgroup-variables): Doc fix (tiny change).
From Helmut Waitzmann <Helmut.Waitzmann@web.de>.
* gnus-agent.el (gnus-agent-regenerate-group): Activate the group
when the group's active is not available.
* gnus-art.el (article-hide-headers): Refer to the values for
gnus-ignored-headers and gnus-visible-headers in the summary
buffer since a user may have set them as group parameters.
(gnus-article-next-page): Fix the way to find a real end-of-buffer
(tiny change). From YAGI Tatsuya <ynyaaa@ybb.ne.jp>.
(gnus-article-read-summary-keys): Restore new window-start and
hscroll to summary window.
(gnus-prev-page-map): Remove duplicated one.
* gnus-cite.el (gnus-cite-ignore-quoted-from): New user option.
(gnus-cite-parse): Ignore quoted envelope From_. Suggested by
Karl Chen <quarl@nospam.quarl.org> and Reiner Steib
<Reiner.Steib@gmx.de>.
* gnus-cus.el (gnus-agent-cat-prepare-category-field): Replace
pp-to-string with gnus-pp-to-string.
* gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp.
* gnus-group.el (gnus-group-make-kiboze-group): Replace pp with
gnus-pp.
* gnus-msg.el (gnus-setup-message): Ignore an article copy while
parsing gnus-posting-styles when the message is not for replying.
(gnus-summary-resend-message-edit): Call mime-to-mml. Suggested
by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
(gnus-debug): Replace pp with gnus-pp.
* gnus-score.el (gnus-score-save): Replace pp with gnus-pp.
* gnus-spec.el (gnus-update-format): Replace pp-to-string with
gnus-pp-to-string.
* gnus-sum.el (gnus-read-header): Don't remove a header for the
parent article of a sparse article in the thread hashtb. From
Stefan Wiens <s.wi@gmx.net>.
* gnus-util.el (gnus-bind-print-variables): New macro.
(gnus-prin1): Use it.
(gnus-prin1-to-string): Use it.
(gnus-pp): New function.
(gnus-pp-to-string): New function.
* gnus.el: Don't make unnecessary *Group* buffer when loading.
* mail-source.el (mail-source-touch-pop): Doc fix.
* message.el (message-mode): Don't modify paragraph-separate there.
(message-setup-fill-variables): Add mml tags to paragraph-start
and paragraph-separate. Suggested by Andrew Korty <ajk@iu.edu>.
(message-smtpmail-send-it): Doc fix.
(message-exchange-point-and-mark): Don't activate region if it was
inactive. Suggested by Hiroshi Fujishima
<pooh@nature.tsukuba.ac.jp> and Jesper Harder <harder@ifa.au.dk>.
* mm-decode.el (mm-save-part): Bind enable-multibyte-characters to
t while entering a file name using the mm-with-multibyte macro.
Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
* mm-encode.el (mm-content-transfer-encoding-defaults): Use
qp-or-base64 for the application/* types.
(mm-safer-encoding): Consider 7bit is safe.
* mm-util.el (mm-with-multibyte-buffer): New macro.
(mm-with-multibyte): New macro.
* mm-view.el (mm-inline-render-with-function): Use multibyte
buffer; decode html source by charset.
* nndoc.el (nndoc-type-alist): Improve regexp for article-begin,
add generate-head-function and generate-article-function to the
rfc822-forward entry.
(nndoc-forward-type-p): Recognize envelope From_.
(nndoc-rfc822-forward-generate-article): New function.
(nndoc-rfc822-forward-generate-head): New function.
From David Hedbor <dhedbor@real.com>.
* nnmail.el (nnmail-split-lowercase-expanded): New user option.
(nnmail-expand-newtext): Lowercase expanded entries if
nnmail-split-lowercase-expanded is non-nil.
* score-mode.el (gnus-score-pretty-print): Replace pp with gnus-pp.
* webmail.el (webmail-debug): Replace pp with gnus-pp.
* gnus-art.el (gnus-article-wash-html-with-w3m): Bind
w3m-safe-url-regexp as the value for mm-w3m-safe-url-regexp; use
w3m-minor-mode-map instead of mm-w3m-local-map-property.
(gnus-mime-save-part-and-strip): Use mm-complicated-handles
instead of mm-multiple-handles.
(gnus-mime-delete-part): Ditto.
* mm-decode.el (mm-multiple-handles): Recognize a string as a mime
handle, as well as a list.
(mm-complicated-handles): Former definition of mm-multiple-handles.
* mm-view.el (mm-w3m-mode-map): Remove.
(mm-w3m-local-map-property): Remove.
(mm-w3m-cid-retrieve-1): Call itself recursively. Suggested by
ARISAWA Akihiro <ari@mbf.sphere.ne.jp>.
(mm-w3m-cid-retrieve): Simplify.
(mm-inline-text-html-render-with-w3m): Decode html source by
charset; check META tags only when charsets are not specified in
headers; specify charset to w3m-region; use w3m-minor-mode-map
instead of mm-w3m-local-map-property.
author | Reiner Steib <Reiner.Steib@gmx.de> |
---|---|
date | Tue, 31 Aug 2004 14:47:59 +0000 |
parents | e88e622cd27a |
children | 5a51a57faa6d |
files | lisp/gnus/ChangeLog lisp/gnus/gnus-agent.el lisp/gnus/gnus-art.el lisp/gnus/gnus-cite.el lisp/gnus/gnus-cus.el lisp/gnus/gnus-eform.el lisp/gnus/gnus-group.el lisp/gnus/gnus-msg.el lisp/gnus/gnus-score.el lisp/gnus/gnus-spec.el lisp/gnus/gnus-sum.el lisp/gnus/gnus-util.el lisp/gnus/gnus.el lisp/gnus/mail-source.el lisp/gnus/message.el lisp/gnus/mm-decode.el lisp/gnus/mm-encode.el lisp/gnus/mm-util.el lisp/gnus/mm-view.el lisp/gnus/nndoc.el lisp/gnus/nnmail.el lisp/gnus/score-mode.el lisp/gnus/webmail.el |
diffstat | 23 files changed, 488 insertions(+), 251 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/ChangeLog Tue Aug 31 14:47:59 2004 +0000 @@ -1,3 +1,119 @@ +2004-08-31 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. + + * gnus-sum.el (gnus-newsgroup-variables): Doc fix (tiny change). + From Helmut Waitzmann <Helmut.Waitzmann@web.de>. + + * gnus-agent.el (gnus-agent-regenerate-group): Activate the group + when the group's active is not available. + + * gnus-art.el (article-hide-headers): Refer to the values for + gnus-ignored-headers and gnus-visible-headers in the summary + buffer since a user may have set them as group parameters. + (gnus-article-next-page): Fix the way to find a real end-of-buffer + (tiny change). From YAGI Tatsuya <ynyaaa@ybb.ne.jp>. + (gnus-article-read-summary-keys): Restore new window-start and + hscroll to summary window. + (gnus-prev-page-map): Remove duplicated one. + + * gnus-cite.el (gnus-cite-ignore-quoted-from): New user option. + (gnus-cite-parse): Ignore quoted envelope From_. Suggested by + Karl Chen <quarl@nospam.quarl.org> and Reiner Steib + <Reiner.Steib@gmx.de>. + + * gnus-cus.el (gnus-agent-cat-prepare-category-field): Replace + pp-to-string with gnus-pp-to-string. + + * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp. + + * gnus-group.el (gnus-group-make-kiboze-group): Replace pp with + gnus-pp. + + * gnus-msg.el (gnus-setup-message): Ignore an article copy while + parsing gnus-posting-styles when the message is not for replying. + (gnus-summary-resend-message-edit): Call mime-to-mml. Suggested + by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>. + (gnus-debug): Replace pp with gnus-pp. + + * gnus-score.el (gnus-score-save): Replace pp with gnus-pp. + + * gnus-spec.el (gnus-update-format): Replace pp-to-string with + gnus-pp-to-string. + + * gnus-sum.el (gnus-read-header): Don't remove a header for the + parent article of a sparse article in the thread hashtb. From + Stefan Wiens <s.wi@gmx.net>. + + * gnus-util.el (gnus-bind-print-variables): New macro. + (gnus-prin1): Use it. + (gnus-prin1-to-string): Use it. + (gnus-pp): New function. + (gnus-pp-to-string): New function. + + * gnus.el: Don't make unnecessary *Group* buffer when loading. + + * mail-source.el (mail-source-touch-pop): Doc fix. + + * message.el (message-mode): Don't modify paragraph-separate there. + (message-setup-fill-variables): Add mml tags to paragraph-start + and paragraph-separate. Suggested by Andrew Korty <ajk@iu.edu>. + (message-smtpmail-send-it): Doc fix. + (message-exchange-point-and-mark): Don't activate region if it was + inactive. Suggested by Hiroshi Fujishima + <pooh@nature.tsukuba.ac.jp> and Jesper Harder <harder@ifa.au.dk>. + + * mm-decode.el (mm-save-part): Bind enable-multibyte-characters to + t while entering a file name using the mm-with-multibyte macro. + Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>. + + * mm-encode.el (mm-content-transfer-encoding-defaults): Use + qp-or-base64 for the application/* types. + (mm-safer-encoding): Consider 7bit is safe. + + * mm-util.el (mm-with-multibyte-buffer): New macro. + (mm-with-multibyte): New macro. + + * mm-view.el (mm-inline-render-with-function): Use multibyte + buffer; decode html source by charset. + + * nndoc.el (nndoc-type-alist): Improve regexp for article-begin, + add generate-head-function and generate-article-function to the + rfc822-forward entry. + (nndoc-forward-type-p): Recognize envelope From_. + (nndoc-rfc822-forward-generate-article): New function. + (nndoc-rfc822-forward-generate-head): New function. + + From David Hedbor <dhedbor@real.com>. + * nnmail.el (nnmail-split-lowercase-expanded): New user option. + (nnmail-expand-newtext): Lowercase expanded entries if + nnmail-split-lowercase-expanded is non-nil. + + * score-mode.el (gnus-score-pretty-print): Replace pp with gnus-pp. + + * webmail.el (webmail-debug): Replace pp with gnus-pp. + + * gnus-art.el (gnus-article-wash-html-with-w3m): Bind + w3m-safe-url-regexp as the value for mm-w3m-safe-url-regexp; use + w3m-minor-mode-map instead of mm-w3m-local-map-property. + (gnus-mime-save-part-and-strip): Use mm-complicated-handles + instead of mm-multiple-handles. + (gnus-mime-delete-part): Ditto. + + * mm-decode.el (mm-multiple-handles): Recognize a string as a mime + handle, as well as a list. + (mm-complicated-handles): Former definition of mm-multiple-handles. + + * mm-view.el (mm-w3m-mode-map): Remove. + (mm-w3m-local-map-property): Remove. + (mm-w3m-cid-retrieve-1): Call itself recursively. Suggested by + ARISAWA Akihiro <ari@mbf.sphere.ne.jp>. + (mm-w3m-cid-retrieve): Simplify. + (mm-inline-text-html-render-with-w3m): Decode html source by + charset; check META tags only when charsets are not specified in + headers; specify charset to w3m-region; use w3m-minor-mode-map + instead of mm-w3m-local-map-property. + 2004-08-30 Juanma Barranquero <lektu@terra.es> * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant.
--- a/lisp/gnus/gnus-agent.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-agent.el Tue Aug 31 14:47:59 2004 +0000 @@ -682,7 +682,8 @@ "Restore GCC field from saved header." (save-excursion (goto-char (point-min)) - (while (re-search-forward (concat gnus-agent-gcc-header ":") nil t) + (while (re-search-forward + (concat "^" (regexp-quote gnus-agent-gcc-header) ":") nil t) (replace-match "Gcc:" 'fixedcase)))) (defun gnus-agent-any-covered-gcc () @@ -3630,7 +3631,8 @@ ;; recalculate the number of unread articles in the group (let ((group (gnus-group-real-name group)) - (group-active (gnus-active group))) + (group-active (or (gnus-active group) + (gnus-activate-group group)))) (gnus-agent-possibly-alter-active group group-active))))) (when (and reread gnus-agent-article-alist)
--- a/lisp/gnus/gnus-art.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-art.el Tue Aug 31 14:47:59 2004 +0000 @@ -1555,25 +1555,35 @@ (interactive) ;; This function might be inhibited. (unless gnus-inhibit-hiding - (save-excursion - (save-restriction - (let ((inhibit-read-only t) - (case-fold-search t) - (max (1+ (length gnus-sorted-header-list))) - (ignored (when (not gnus-visible-headers) - (cond ((stringp gnus-ignored-headers) - gnus-ignored-headers) - ((listp gnus-ignored-headers) - (mapconcat 'identity gnus-ignored-headers - "\\|"))))) - (visible - (cond ((stringp gnus-visible-headers) - gnus-visible-headers) - ((and gnus-visible-headers - (listp gnus-visible-headers)) - (mapconcat 'identity gnus-visible-headers "\\|")))) - (inhibit-point-motion-hooks t) - beg) + (let ((inhibit-read-only nil) + (case-fold-search t) + (max (1+ (length gnus-sorted-header-list))) + (inhibit-point-motion-hooks t) + (cur (current-buffer)) + ignored visible beg) + (save-excursion + ;; `gnus-ignored-headers' and `gnus-visible-headers' may be + ;; group parameters, so we should go to the summary buffer. + (when (prog1 + (condition-case nil + (progn (set-buffer gnus-summary-buffer) t) + (error nil)) + (setq ignored (when (not gnus-visible-headers) + (cond ((stringp gnus-ignored-headers) + gnus-ignored-headers) + ((listp gnus-ignored-headers) + (mapconcat 'identity + gnus-ignored-headers + "\\|")))) + visible (cond ((stringp gnus-visible-headers) + gnus-visible-headers) + ((and gnus-visible-headers + (listp gnus-visible-headers)) + (mapconcat 'identity + gnus-visible-headers + "\\|"))))) + (set-buffer cur)) + (save-restriction ;; First we narrow to just the headers. (article-narrow-to-head) ;; Hide any "From " lines at the beginning of (mail) articles. @@ -2382,16 +2392,17 @@ (mm-setup-w3m) (save-restriction (narrow-to-region (point) (point-max)) - (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images - nil - "\\`cid:")) + (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) w3m-force-redisplay) (w3m-region (point-min) (point-max))) - (when mm-inline-text-html-with-w3m-keymap + (when (and mm-inline-text-html-with-w3m-keymap + (boundp 'w3m-minor-mode-map) + w3m-minor-mode-map) (add-text-properties (point-min) (point-max) - (nconc (mm-w3m-local-map-property) - '(mm-inline-text-html-with-w3m t)))))) + (list 'keymap w3m-minor-mode-map + ;; Put the mark meaning this part was rendered by emacs-w3m. + 'mm-inline-text-html-with-w3m t))))) (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. @@ -3942,72 +3953,81 @@ "Save the MIME part under point then replace it with an external body." (interactive) (gnus-article-check-buffer) - (let* ((data (get-text-property (point) 'gnus-data)) - file param - (handles gnus-article-mime-handles)) - (if (mm-multiple-handles gnus-article-mime-handles) - (error "This function is not implemented")) - (setq file (and data (mm-save-part data))) - (when file - (with-current-buffer (mm-handle-buffer data) - (erase-buffer) - (insert "Content-Type: " (mm-handle-media-type data)) - (mml-insert-parameter-string (cdr (mm-handle-type data)) - '(charset)) - (insert "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: binary\n") - (insert "\n")) - (setcdr data - (cdr (mm-make-handle nil - `("message/external-body" - (access-type . "LOCAL-FILE") - (name . ,file))))) - (set-buffer gnus-summary-buffer) - (gnus-article-edit-article - `(lambda () - (erase-buffer) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - (mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (insert-buffer gnus-original-article-buffer) - (mime-to-mml ',handles) - (setq gnus-article-mime-handles nil) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (set (make-local-variable 'mml-buffer-list) mbl1)) - (gnus-make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) - `(lambda (no-highlight) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (message-options message-options) - (message-options-set-recipient) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets))) - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list)) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight)))))) + (when (gnus-group-read-only-p) + (error "The current group does not support deleting of parts")) + (when (mm-complicated-handles gnus-article-mime-handles) + (error "\ +The current article has a complicated MIME structure, giving up...")) + (when (gnus-yes-or-no-p "\ +Deleting parts may malfunction or destroy the article; continue? ") + (let* ((data (get-text-property (point) 'gnus-data)) + file param + (handles gnus-article-mime-handles)) + (setq file (and data (mm-save-part data))) + (when file + (with-current-buffer (mm-handle-buffer data) + (erase-buffer) + (insert "Content-Type: " (mm-handle-media-type data)) + (mml-insert-parameter-string (cdr (mm-handle-type data)) + '(charset)) + (insert "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: binary\n") + (insert "\n")) + (setcdr data + (cdr (mm-make-handle nil + `("message/external-body" + (access-type . "LOCAL-FILE") + (name . ,file))))) + (set-buffer gnus-summary-buffer) + (gnus-article-edit-article + `(lambda () + (erase-buffer) + (let ((mail-parse-charset (or gnus-article-charset + ',gnus-newsgroup-charset)) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) + (mbl mml-buffer-list)) + (setq mml-buffer-list nil) + (insert-buffer gnus-original-article-buffer) + (mime-to-mml ',handles) + (setq gnus-article-mime-handles nil) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (set (make-local-variable 'mml-buffer-list) mbl1)) + (gnus-make-local-hook 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) + `(lambda (no-highlight) + (let ((mail-parse-charset (or gnus-article-charset + ',gnus-newsgroup-charset)) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets + ',gnus-newsgroup-ignored-charsets))) + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + 'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list)) + (gnus-summary-edit-article-done + ,(or (mail-header-references gnus-current-headers) "") + ,(gnus-group-read-only-p) + ,gnus-summary-buffer no-highlight))))))) (defun gnus-mime-delete-part () "Delete the MIME part under point. Replace it with some information about the removed part." (interactive) (gnus-article-check-buffer) - (unless (and gnus-novice-user - (not (gnus-yes-or-no-p - "Really delete attachment forever? "))) + (when (gnus-group-read-only-p) + (error "The current group does not support deleting of parts")) + (when (mm-complicated-handles gnus-article-mime-handles) + (error "\ +The current article has a complicated MIME structure, giving up...")) + (when (gnus-yes-or-no-p "\ +Deleting parts may malfunction or destroy the article; continue? ") (let* ((data (get-text-property (point) 'gnus-data)) (handles gnus-article-mime-handles) (none "(none)") @@ -4019,8 +4039,8 @@ (or (mail-content-type-get (mm-handle-disposition data) 'filename) none)) (type (mm-handle-media-type data))) - (if (mm-multiple-handles gnus-article-mime-handles) - (error "This function is not implemented")) + (unless data + (error "No MIME part under point")) (with-current-buffer (mm-handle-buffer data) (let ((bsize (format "%s" (buffer-size)))) (erase-buffer) @@ -5016,6 +5036,7 @@ (save-excursion (save-restriction (widen) + (forward-line) (eobp)))) ;Real end-of-buffer? (progn (when gnus-article-over-scroll @@ -5173,11 +5194,13 @@ (let ((obuf (current-buffer)) (owin (current-window-configuration)) (opoint (point)) - (summary gnus-article-current-summary) - func in-buffer selected) - (if not-restore-window - (pop-to-buffer summary 'norecord) - (switch-to-buffer summary 'norecord)) + win func in-buffer selected new-sum-start new-sum-hscroll) + (cond (not-restore-window + (pop-to-buffer gnus-article-current-summary 'norecord)) + ((setq win (get-buffer-window gnus-article-current-summary)) + (select-window win)) + (t + (switch-to-buffer gnus-article-current-summary 'norecord))) (setq in-buffer (current-buffer)) ;; We disable the pick minor mode commands. (if (and (setq func (let (gnus-pick-mode) @@ -5185,7 +5208,10 @@ (functionp func)) (progn (call-interactively func) - (setq new-sum-point (point)) + (when (eq win (selected-window)) + (setq new-sum-point (point) + new-sum-start (window-start win) + new-sum-hscroll (window-hscroll win)) (when (eq in-buffer (current-buffer)) (setq selected (gnus-summary-select-article)) (set-buffer obuf) @@ -5197,10 +5223,12 @@ 1) (set-window-point (get-buffer-window (current-buffer)) (point))) - (let ((win (get-buffer-window gnus-article-current-summary))) - (when win - (set-window-point win new-sum-point)))) ) - (switch-to-buffer gnus-article-buffer) + (when (and (not not-restore-window) + new-sum-point) + (set-window-point win new-sum-point) + (set-window-start win new-sum-start) + (set-window-hscroll win new-sum-hscroll))))) + (set-window-configuration owin) (ding)))))) (defun gnus-article-describe-key (key) @@ -6678,6 +6706,15 @@ (define-key map "\r" 'gnus-button-prev-page) map)) +(defvar gnus-next-page-map + (let ((map (make-sparse-keymap))) + (unless (>= emacs-major-version 21) + ;; XEmacs doesn't care. + (set-keymap-parent map gnus-article-mode-map)) + (define-key map gnus-mouse-2 'gnus-button-next-page) + (define-key map "\r" 'gnus-button-next-page) + map)) + (defun gnus-insert-prev-page-button () (let ((b (point)) (inhibit-read-only t)) @@ -6695,24 +6732,6 @@ :action 'gnus-button-prev-page :button-keymap gnus-prev-page-map))) -(defvar gnus-prev-page-map - (let ((map (make-sparse-keymap))) - (unless (>= emacs-major-version 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) - (define-key map gnus-mouse-2 'gnus-button-prev-page) - (define-key map "\r" 'gnus-button-prev-page) - map)) - -(defvar gnus-next-page-map - (let ((map (make-sparse-keymap))) - (unless (>= emacs-major-version 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) - (define-key map gnus-mouse-2 'gnus-button-next-page) - (define-key map "\r" 'gnus-button-next-page) - map)) - (defun gnus-button-next-page (&optional args more-args) "Go to the next page." (interactive)
--- a/lisp/gnus/gnus-cite.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-cite.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,6 +1,6 @@ ;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Per Abhiddenware @@ -127,6 +127,13 @@ :group 'gnus-cite :type 'regexp) +(defcustom gnus-cite-ignore-quoted-from t + "Non-nil means don't regard lines beginning with \">From \" as cited text. +Those lines may have been quoted by MTAs in order not to mix up with +the envelope From line." + :group 'gnus-cite + :type 'boolean) + (defface gnus-cite-attribution-face '((t (:italic t))) "Face used for attribution lines.") @@ -739,6 +746,13 @@ ;; Ignore very long prefixes. (when (> end (+ begin gnus-cite-max-prefix)) (setq end (+ begin gnus-cite-max-prefix))) + ;; Ignore quoted envelope From_. + (when (and gnus-cite-ignore-quoted-from + (prog2 + (setq case-fold-search nil) + (looking-at ">From ") + (setq case-fold-search t))) + (setq end (1+ begin))) (while (re-search-forward prefix-regexp (1- end) t) ;; Each prefix. (setq end (match-end 0)
--- a/lisp/gnus/gnus-cus.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-cus.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,6 +1,6 @@ ;;; gnus-cus.el --- customization commands for Gnus ;; -;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> @@ -915,7 +915,8 @@ (val (,field info)) (deflt (if (,field defaults) (concat " [" (gnus-trim-whitespace - (pp-to-string (,field defaults))) "]"))) + (gnus-pp-to-string (,field defaults))) + "]"))) symb) (if (eq (car type) 'radio)
--- a/lisp/gnus/gnus-eform.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-eform.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,5 @@ ;;; gnus-eform.el --- a mode for editing forms for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -106,7 +106,7 @@ (insert ";; Type `C-c C-c' after you've finished editing.\n") (insert "\n") (let ((p (point))) - (pp form (current-buffer)) + (gnus-pp form) (insert "\n") (goto-char p))))
--- a/lisp/gnus/gnus-group.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-group.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,5 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -2703,7 +2703,7 @@ (make-directory score-dir)) (with-temp-file score-file (let (emacs-lisp-mode-hook) - (pp scores (current-buffer)))))) + (gnus-pp scores))))) (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group."
--- a/lisp/gnus/gnus-msg.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-msg.el Tue Aug 31 14:47:59 2004 +0000 @@ -395,8 +395,13 @@ ;; added an optional argument to `gnus-configure-posting-styles' to ;; make sure that the correct value for the group name is used. -- drv (add-hook 'message-mode-hook - (lambda () - (gnus-configure-posting-styles ,group))) + (if (memq ,config '(reply-yank reply)) + (lambda () + (gnus-configure-posting-styles ,group)) + (lambda () + ;; There may be an old " *gnus article copy*" buffer. + (let (gnus-article-copy) + (gnus-configure-posting-styles ,group))))) (gnus-pull ',(intern gnus-draft-meta-information-header) message-required-headers) (when (and ,group @@ -1261,6 +1266,7 @@ ;; Get a normal message buffer. (message-pop-to-buffer (message-buffer-name "Resend" to)) (insert-buffer-substring cur) + (mime-to-mml) (message-narrow-to-head-1) ;; Gnus will generate a new one when sending. (message-remove-header "Message-ID") @@ -1510,14 +1516,14 @@ (while olist (if (boundp (car olist)) (ignore-errors - (pp `(setq ,(car olist) - ,(if (or (consp (setq sym (symbol-value (car olist)))) - (and (symbolp sym) - (not (or (eq sym nil) - (eq sym t))))) - (list 'quote (symbol-value (car olist))) - (symbol-value (car olist)))) - (current-buffer))) + (gnus-pp + `(setq ,(car olist) + ,(if (or (consp (setq sym (symbol-value (car olist)))) + (and (symbolp sym) + (not (or (eq sym nil) + (eq sym t))))) + (list 'quote (symbol-value (car olist))) + (symbol-value (car olist)))))) (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) (setq olist (cdr olist))) (insert "\n\n")
--- a/lisp/gnus/gnus-score.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-score.el Tue Aug 31 14:47:59 2004 +0000 @@ -1411,7 +1411,7 @@ ;; This is a normal score file, so we print it very ;; prettily. (let ((lisp-mode-syntax-table score-mode-syntax-table)) - (pp score (current-buffer))))) + (gnus-pp score)))) (gnus-make-directory (file-name-directory file)) ;; If the score file is empty, we delete it. (if (zerop (buffer-size))
--- a/lisp/gnus/gnus-spec.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-spec.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,5 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -180,7 +180,7 @@ (pop-to-buffer "*Gnus Format*") (erase-buffer) (lisp-interaction-mode) - (insert (pp-to-string spec)))) + (insert (gnus-pp-to-string spec)))) (defun gnus-update-format-specifications (&optional force &rest types) "Update all (necessary) format specifications."
--- a/lisp/gnus/gnus-sum.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-sum.el Tue Aug 31 14:47:59 2004 +0000 @@ -1379,11 +1379,19 @@ (defvar gnus-newsgroup-variables nil "A list of variables that have separate values in different newsgroups. A list of newsgroup (summary buffer) local variables, or cons of -variables and their default values (when the default values are not -nil), that should be made global while the summary buffer is active. +variables and their default expressions to be evalled (when the default +values are not nil), that should be made global while the summary buffer +is active. + +Note: The default expressions will be evaluated (using function `eval') +before assignment to the local variable rather than just assigned to it. +If the default expression is the symbol `global', that symbol will not +be evaluated but the global value of the local variable will be used +instead. + These variables can be used to set variables in the group parameters -while still allowing them to affect operations done in other -buffers. For example: +while still allowing them to affect operations done in other buffers. +For example: \(setq gnus-newsgroup-variables '(message-use-followup-to @@ -11148,14 +11156,6 @@ (not (gnus-summary-article-sparse-p (mail-header-number header)))) ;; We have found the header. header - ;; If this is a sparse article, we have to nix out its - ;; previous entry in the thread hashtb. - (when (and header - (gnus-summary-article-sparse-p (mail-header-number header))) - (let* ((parent (gnus-parent-id (mail-header-references header))) - (thread (and parent (gnus-id-to-thread parent)))) - (when thread - (delq (assq header thread) thread)))) ;; We have to really fetch the header to this article. (save-excursion (set-buffer nntp-server-buffer)
--- a/lisp/gnus/gnus-util.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus-util.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,5 @@ ;;; gnus-util.el --- utility functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -628,24 +628,49 @@ (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) [menu-bar edit] 'undefined)) +(defmacro gnus-bind-print-variables (&rest forms) + "Bind print-* variables and evaluate FORMS. +This macro is used with `prin1', `pp', etc. in order to ensure printed +Lisp objects are loadable. Bind `print-quoted' and `print-readably' +to t, and `print-escape-multibyte', `print-escape-newlines', +`print-escape-nonascii', `print-length', `print-level' and +`print-string-length' to nil." + `(let ((print-quoted t) + (print-readably t) + ;;print-circle + ;;print-continuous-numbering + print-escape-multibyte + print-escape-newlines + print-escape-nonascii + ;;print-gensym + print-length + print-level + print-string-length) + ,@forms)) + (defun gnus-prin1 (form) "Use `prin1' on FORM in the current buffer. -Bind `print-quoted' and `print-readably' to t while printing." - (let ((print-quoted t) - (print-readably t) - (print-escape-multibyte nil) - print-level print-length) - (prin1 form (current-buffer)))) +Bind `print-quoted' and `print-readably' to t, and `print-length' and +`print-level' to nil. See also `gnus-bind-print-variables'." + (gnus-bind-print-variables (prin1 form (current-buffer)))) (defun gnus-prin1-to-string (form) "The same as `prin1'. -Bind `print-quoted' and `print-readably' to t, and `print-length' -and `print-level' to nil." - (let ((print-quoted t) - (print-readably t) - (print-length nil) - (print-level nil)) - (prin1-to-string form))) +Bind `print-quoted' and `print-readably' to t, and `print-length' and +`print-level' to nil. See also `gnus-bind-print-variables'." + (gnus-bind-print-variables (prin1-to-string form))) + +(defun gnus-pp (form) + "Use `pp' on FORM in the current buffer. +Bind `print-quoted' and `print-readably' to t, and `print-length' and +`print-level' to nil. See also `gnus-bind-print-variables'." + (gnus-bind-print-variables (pp form (current-buffer)))) + +(defun gnus-pp-to-string (form) + "The same as `pp-to-string'. +Bind `print-quoted' and `print-readably' to t, and `print-length' and +`print-level' to nil. See also `gnus-bind-print-variables'." + (gnus-bind-print-variables (pp-to-string form))) (defun gnus-make-directory (directory) "Make DIRECTORY (and all its parents) if it doesn't exist."
--- a/lisp/gnus/gnus.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/gnus.el Tue Aug 31 14:47:59 2004 +0000 @@ -940,10 +940,10 @@ (eval-when (load) (let ((command (format "%s" this-command))) - (if (and (string-match "gnus" command) - (not (string-match "gnus-other-frame" command))) - (gnus-splash) - (gnus-get-buffer-create gnus-group-buffer)))) + (when (string-match "gnus" command) + (if (string-match "gnus-other-frame" command) + (gnus-get-buffer-create gnus-group-buffer) + (gnus-splash))))) ;;; Do the rest.
--- a/lisp/gnus/mail-source.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/mail-source.el Tue Aug 31 14:47:59 2004 +0000 @@ -826,12 +826,13 @@ "Open and close a POP connection shortly. POP server should be defined in `mail-source-primary-source' (which is preferred) or `mail-sources'. You may use it for the POP-before-SMTP -authentication. To do that, you need to set the option -`message-send-mail-function' to `message-smtpmail-send-it' and put the -following line in .gnus file: +authentication. To do that, you need to set the +`message-send-mail-function' variable as `message-smtpmail-send-it' +and put the following line in your ~/.gnus.el file: \(add-hook 'message-send-mail-hook 'mail-source-touch-pop) -" + +See the Gnus manual for details." (let ((sources (if mail-source-primary-source (list mail-source-primary-source) mail-sources)))
--- a/lisp/gnus/message.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/message.el Tue Aug 31 14:47:59 2004 +0000 @@ -2444,11 +2444,6 @@ (set (make-local-variable 'message-checksum) nil) (set (make-local-variable 'message-mime-part) 0) (message-setup-fill-variables) - (set - (make-local-variable 'paragraph-separate) - (format "\\(%s\\)\\|\\(%s\\)" - paragraph-separate - "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)")) ;; Allow using comment commands to add/remove quoting. ;; (set (make-local-variable 'comment-start) message-yank-prefix) (when message-yank-prefix @@ -2504,7 +2499,9 @@ "---+$\\|" ; delimiters for forwarded messages page-delimiter "$\\|" ; spoiler warnings ".*wrote:$\\|" ; attribution lines - quote-prefix-regexp "$")) ; empty lines in quoted text + quote-prefix-regexp "$\\|" ; empty lines in quoted text + ; mml tags + "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)")) (setq paragraph-separate paragraph-start) (setq adaptive-fill-regexp (concat quote-prefix-regexp "\\|" adaptive-fill-regexp)) @@ -3894,8 +3891,8 @@ "Send the prepared message buffer with `smtpmail-send-it'. This only differs from `smtpmail-send-it' that this command evaluates `message-send-mail-hook' just before sending a message. It is useful -if your ISP requires the POP-before-SMTP authentication. See the -documentation for the function `mail-source-touch-pop'." +if your ISP requires the POP-before-SMTP authentication. See the Gnus +manual for details." (run-hooks 'message-send-mail-hook) (smtpmail-send-it)) @@ -6490,7 +6487,13 @@ (if (eq (char-after) (char-after (- (point) 2))) (delete-char -2)))))) -(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) +(defun message-exchange-point-and-mark () + "Exchange point and mark, but don't activate region if it was inactive." + (unless (prog1 + (message-mark-active-p) + (exchange-point-and-mark)) + (setq mark-active nil))) + (defalias 'message-make-overlay 'make-overlay) (defalias 'message-delete-overlay 'delete-overlay) (defalias 'message-overlay-put 'overlay-put)
--- a/lisp/gnus/mm-decode.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/mm-decode.el Tue Aug 31 14:47:59 2004 +0000 @@ -1091,9 +1091,10 @@ (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) (setq file - (read-file-name "Save MIME part to: " - (or mm-default-directory default-directory) - nil nil (or filename name ""))) + (mm-with-multibyte + (read-file-name "Save MIME part to: " + (or mm-default-directory default-directory) + nil nil (or filename name "")))) (setq mm-default-directory (file-name-directory file)) (and (or (not (file-exists-p file)) (yes-or-no-p (format "File %s already exists; overwrite? " @@ -1452,6 +1453,12 @@ parts)) (defun mm-multiple-handles (handles) + (and (listp handles) + (> (length handles) 1) + (or (listp (car handles)) + (stringp (car handles))))) + +(defun mm-complicated-handles (handles) (and (listp (car handles)) (> (length handles) 1)))
--- a/lisp/gnus/mm-encode.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/mm-encode.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,5 @@ ;;; mm-encode.el --- Functions for encoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -36,13 +36,23 @@ '(("text/x-patch" 8bit) ("text/.*" qp-or-base64) ("message/rfc822" 8bit) - ("application/emacs-lisp" 8bit) - ("application/x-emacs-lisp" 8bit) - ("application/x-patch" 8bit) + ("application/emacs-lisp" qp-or-base64) + ("application/x-emacs-lisp" qp-or-base64) + ("application/x-patch" qp-or-base64) (".*" base64)) "Alist of regexps that match MIME types and their encodings. If the encoding is `qp-or-base64', then either quoted-printable -or base64 will be used, depending on what is more efficient." +or base64 will be used, depending on what is more efficient. + +`qp-or-base64' has another effect. It will fold long lines so that +MIME parts may not be broken by MTA. So do `quoted-printable' and +`base64'. + +Note: It affects body encoding only when a part is a raw forwarded +message (which will be made by `gnus-summary-mail-forward' with the +arg 2 for example) or is neither the text/* type nor the message/* +type. Even though in those cases, you can use the `encoding' MML tag +to specify encoding of non-ASCII MIME parts." :type '(repeat (list (regexp :tag "MIME type") (choice :tag "encoding" (const 7bit) @@ -88,7 +98,8 @@ (defun mm-safer-encoding (encoding) "Return an encoding similar to ENCODING but safer than it." (cond - ((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable) + ((eq encoding '7bit) '7bit) ;; 7bit is considered safe. + ((memq encoding '(8bit quoted-printable)) 'quoted-printable) ;; The remaining encodings are binary and base64 (and perhaps some ;; non-standard ones), which are both turned into base64. (t 'base64)))
--- a/lisp/gnus/mm-util.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/mm-util.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,5 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -611,6 +611,14 @@ (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) +(defmacro mm-with-multibyte-buffer (&rest forms) + "Create a temporary buffer, and evaluate FORMS there like `progn'. +Use multibyte mode for this." + `(let ((default-enable-multibyte-characters t)) + (with-temp-buffer ,@forms))) +(put 'mm-with-multibyte-buffer 'lisp-indent-function 0) +(put 'mm-with-multibyte-buffer 'edebug-form-spec '(body)) + (defmacro mm-with-unibyte-current-buffer (&rest forms) "Evaluate FORMS with current buffer temporarily made unibyte. Also bind `default-enable-multibyte-characters' to nil. @@ -632,12 +640,19 @@ (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) (defmacro mm-with-unibyte (&rest forms) - "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ." + "Eval the FORMS with the default value of `enable-multibyte-characters' nil." `(let (default-enable-multibyte-characters) ,@forms)) (put 'mm-with-unibyte 'lisp-indent-function 0) (put 'mm-with-unibyte 'edebug-form-spec '(body)) +(defmacro mm-with-multibyte (&rest forms) + "Eval the FORMS with the default value of `enable-multibyte-characters' t." + `(let ((default-enable-multibyte-characters t)) + ,@forms)) +(put 'mm-with-multibyte 'lisp-indent-function 0) +(put 'mm-with-multibyte 'edebug-form-spec '(body)) + (defun mm-find-charset-region (b e) "Return a list of Emacs charsets in the region B to E." (cond
--- a/lisp/gnus/mm-view.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/mm-view.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,6 @@ ;;; mm-view.el --- functions for viewing MIME objects -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; This file is part of GNU Emacs. @@ -198,44 +199,21 @@ (setq w3m-display-inline-images mm-inline-text-html-with-images)) (defun mm-w3m-cid-retrieve-1 (url handle) - (dolist (elem handle) - (when (and (listp elem) - (equal url (mm-handle-id elem))) - (mm-insert-part elem) - (throw 'found-handle (mm-handle-media-type elem))))) + (if (mm-multiple-handles handle) + (dolist (elem handle) + (mm-w3m-cid-retrieve-1 url elem)) + (when (and (listp handle) + (equal url (mm-handle-id handle))) + (mm-insert-part handle) + (throw 'found-handle (mm-handle-media-type handle))))) (defun mm-w3m-cid-retrieve (url &rest args) "Insert a content pointed by URL if it has the cid: scheme." (when (string-match "\\`cid:" url) - (setq url (concat "<" (substring url (match-end 0)) ">")) (catch 'found-handle - (let ((handles (with-current-buffer w3m-current-buffer - gnus-article-mime-handles))) - (if (mm-multiple-handles handles) - (dolist (handle handles) - (mm-w3m-cid-retrieve-1 url handle)) - (mm-w3m-cid-retrieve-1 url handles)))))) - -(eval-and-compile - (unless (or (featurep 'xemacs) - (>= emacs-major-version 21)) - (defvar mm-w3m-mode-map nil - "Keymap for text/html parts rendered by emacs-w3m. -This keymap will be bound only when Emacs 20 is running and overwritten -by the value of `w3m-minor-mode-map'. In order to add some commands to -this keymap, add them to `w3m-minor-mode-map' instead of this keymap."))) - -(defun mm-w3m-local-map-property () - (when (and (boundp 'w3m-minor-mode-map) w3m-minor-mode-map) - (if (or (featurep 'xemacs) - (>= emacs-major-version 21)) - (list 'keymap w3m-minor-mode-map) - (list 'local-map - (or mm-w3m-mode-map - (progn - (setq mm-w3m-mode-map (copy-keymap w3m-minor-mode-map)) - (set-keymap-parent mm-w3m-mode-map gnus-article-mode-map) - mm-w3m-mode-map)))))) + (mm-w3m-cid-retrieve-1 (concat "<" (substring url (match-end 0)) ">") + (with-current-buffer w3m-current-buffer + gnus-article-mime-handles))))) (defun mm-inline-text-html-render-with-w3m (handle) "Render a text/html part using emacs-w3m." @@ -244,25 +222,25 @@ (b (point)) (charset (mail-content-type-get (mm-handle-type handle) 'charset))) (save-excursion - (insert text) + (insert (if charset (mm-decode-string text charset) text)) (save-restriction (narrow-to-region b (point)) - (goto-char (point-min)) - (when (re-search-forward w3m-meta-content-type-charset-regexp nil t) - (setq charset (or (w3m-charset-to-coding-system (match-string 2)) - charset))) - (when charset - (delete-region (point-min) (point-max)) - (insert (mm-decode-string text charset))) + (unless charset + (goto-char (point-min)) + (when (setq charset (w3m-detect-meta-charset)) + (delete-region (point-min) (point-max)) + (insert (mm-decode-string text charset)))) (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) w3m-force-redisplay) - (w3m-region (point-min) (point-max))) - (when mm-inline-text-html-with-w3m-keymap + (w3m-region (point-min) (point-max) nil charset)) + (when (and mm-inline-text-html-with-w3m-keymap + (boundp 'w3m-minor-mode-map) + w3m-minor-mode-map) (add-text-properties (point-min) (point-max) - (nconc (mm-w3m-local-map-property) - ;; Put the mark meaning this part was rendered by emacs-w3m. - '(mm-inline-text-html-with-w3m t))))) + (list 'keymap w3m-minor-mode-map + ;; Put the mark meaning this part was rendered by emacs-w3m. + 'mm-inline-text-html-with-w3m t)))) (mm-handle-set-undisplayer handle `(lambda () @@ -319,11 +297,14 @@ (buffer-string))))) (defun mm-inline-render-with-function (handle func &rest args) - (let ((source (mm-get-part handle))) + (let ((source (mm-get-part handle)) + (charset (mail-content-type-get (mm-handle-type handle) 'charset))) (mm-insert-inline handle - (mm-with-unibyte-buffer - (insert source) + (mm-with-multibyte-buffer + (insert (if charset + (mm-decode-string source charset) + source)) (apply func args) (buffer-string)))))
--- a/lisp/gnus/nndoc.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/nndoc.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,5 @@ ;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -130,8 +130,10 @@ (article-transform-function . nndoc-transform-lanl-gov-announce) (subtype preprints guess)) (rfc822-forward - (article-begin . "^\n") - (body-end-function . nndoc-rfc822-forward-body-end-function)) + (article-begin . "^\n+") + (body-end-function . nndoc-rfc822-forward-body-end-function) + (generate-head-function . nndoc-rfc822-forward-generate-head) + (generate-article-function . nndoc-rfc822-forward-generate-article)) (outlook (article-begin-function . nndoc-outlook-article-begin) (body-end . "\0")) @@ -469,7 +471,7 @@ (defun nndoc-forward-type-p () (when (and (re-search-forward "^-+ \\(Start of \\)?forwarded message.*\n+" nil t) - (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")) + (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:\\|^>?From ")) t)) (defun nndoc-rfc934-type-p () @@ -492,6 +494,29 @@ (defun nndoc-rfc822-forward-body-end-function () (goto-char (point-max))) +(defun nndoc-rfc822-forward-generate-article (article &optional head) + (let ((entry (cdr (assq article nndoc-dissection-alist))) + (begin (point)) + encoding) + (with-current-buffer nndoc-current-buffer + (save-restriction + (message-narrow-to-head) + (setq encoding (message-fetch-field "content-transfer-encoding")))) + (insert-buffer-substring nndoc-current-buffer (car entry) (nth 3 entry)) + (when encoding + (save-restriction + (narrow-to-region begin (point-max)) + (mm-decode-content-transfer-encoding + (intern (downcase (mail-header-strip encoding)))))) + (when head + (goto-char begin) + (when (search-forward "\n\n" nil t) + (delete-region (1- (point)) (point-max))))) + t) + +(defun nndoc-rfc822-forward-generate-head (article) + (nndoc-rfc822-forward-generate-article article 'head)) + (defun nndoc-mime-parts-type-p () (let ((case-fold-search t) (limit (search-forward "\n\n" nil t)))
--- a/lisp/gnus/nnmail.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/nnmail.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,5 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -575,6 +575,13 @@ :group 'nnmail :type 'boolean) +(defcustom nnmail-split-lowercase-expanded t + "Whether to lowercase expanded entries (i.e. \\N) when splitting mails. +This avoids the creation of multiple groups when users send to an address +using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." + :group 'nnmail + :type 'boolean) + ;;; Internal variables. (defvar nnmail-article-buffer " *nnmail incoming*" @@ -1469,7 +1476,10 @@ (setq N 0) (setq N (- c ?0))) (when (match-beginning N) - (push (buffer-substring (match-beginning N) (match-end N)) + (push (if nnmail-split-lowercase-expanded + (downcase (buffer-substring (match-beginning N) + (match-end N))) + (buffer-substring (match-beginning N) (match-end N))) expanded)))) (setq pos (1+ pos))) (if did-expand
--- a/lisp/gnus/score-mode.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/score-mode.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,6 +1,6 @@ ;;; score-mode.el --- mode for editing Gnus score files -;; Copyright (C) 1996, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001, 2004 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news, mail @@ -28,6 +28,7 @@ (eval-when-compile (require 'cl)) (require 'mm-util) ; for mm-universal-coding-system +(require 'gnus-util) ; for gnus-pp (defvar gnus-score-mode-hook nil "*Hook run in score mode buffers.") @@ -94,7 +95,7 @@ (let ((form (read (current-buffer)))) (erase-buffer) (let ((emacs-lisp-mode-syntax-table score-mode-syntax-table)) - (pp form (current-buffer)))) + (gnus-pp form))) (goto-char (point-min))) (defun gnus-score-edit-exit ()
--- a/lisp/gnus/webmail.el Mon Aug 30 21:15:37 2004 +0000 +++ b/lisp/gnus/webmail.el Tue Aug 31 14:47:59 2004 +0000 @@ -1,5 +1,5 @@ ;;; webmail.el --- interface of web mail -;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2004 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: hotmail netaddress my-deja netscape @@ -196,7 +196,7 @@ (insert "\n---------------- A bug at " str " ------------------\n") (mapcar #'(lambda (sym) (if (boundp sym) - (pp `(setq ,sym ',(eval sym)) (current-buffer)))) + (gnus-pp `(setq ,sym ',(eval sym))))) '(webmail-type user)) (insert "---------------- webmail buffer ------------------\n\n") (insert-buffer-substring webmail-buffer)