summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorReiner Steib <Reiner.Steib@gmx.de>2004-08-31 14:47:59 +0000
committerReiner Steib <Reiner.Steib@gmx.de>2004-08-31 14:47:59 +0000
commit02375b9fc6833d6cb73a14b96ee846df541e2c3f (patch)
tree47b243fd9cd71cc1ee1912c01f93c5496dd02501
parent9d0f6365dcf091a8161536e8c1a23de2d4983c72 (diff)
downloademacs-02375b9fc6833d6cb73a14b96ee846df541e2c3f.tar.gz
2004-08-31 Katsumi Yamaoka <yamaoka@jpl.org>gnus-5_10-pre-merge-josefsson
* 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.
-rw-r--r--lisp/gnus/ChangeLog116
-rw-r--r--lisp/gnus/gnus-agent.el6
-rw-r--r--lisp/gnus/gnus-art.el249
-rw-r--r--lisp/gnus/gnus-cite.el16
-rw-r--r--lisp/gnus/gnus-cus.el5
-rw-r--r--lisp/gnus/gnus-eform.el4
-rw-r--r--lisp/gnus/gnus-group.el4
-rw-r--r--lisp/gnus/gnus-msg.el26
-rw-r--r--lisp/gnus/gnus-score.el2
-rw-r--r--lisp/gnus/gnus-spec.el4
-rw-r--r--lisp/gnus/gnus-sum.el24
-rw-r--r--lisp/gnus/gnus-util.el53
-rw-r--r--lisp/gnus/gnus.el8
-rw-r--r--lisp/gnus/mail-source.el9
-rw-r--r--lisp/gnus/message.el21
-rw-r--r--lisp/gnus/mm-decode.el13
-rw-r--r--lisp/gnus/mm-encode.el23
-rw-r--r--lisp/gnus/mm-util.el19
-rw-r--r--lisp/gnus/mm-view.el81
-rw-r--r--lisp/gnus/nndoc.el33
-rw-r--r--lisp/gnus/nnmail.el14
-rw-r--r--lisp/gnus/score-mode.el5
-rw-r--r--lisp/gnus/webmail.el4
23 files changed, 488 insertions, 251 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index bc87d412d67..58b3021539f 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -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.
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index ef92c00821e..2ab1fb0421d 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -682,7 +682,8 @@ be a select method."
"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 @@ entry of article %s deleted." l1))
;; 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)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 902a26b3e0f..d18b86b7cb0 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1555,25 +1555,35 @@ Initialized from `text-mode-syntax-table.")
(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 @@ If READ-CHARSET, ask for a coding system."
(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 @@ General format specifiers can also be used. See Info node
"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 @@ Replace it with some information about the removed part."
(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 @@ Argument LINES specifies lines to be scrolled up."
(save-excursion
(save-restriction
(widen)
+ (forward-line)
(eobp)))) ;Real end-of-buffer?
(progn
(when gnus-article-over-scroll
@@ -5173,11 +5194,13 @@ not have a face in `gnus-article-boring-faces'."
(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 @@ not have a face in `gnus-article-boring-faces'."
(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 @@ not have a face in `gnus-article-boring-faces'."
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 @@ specified by `gnus-button-alist'."
(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 @@ specified by `gnus-button-alist'."
: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)
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 9e262f101cc..51617918a4c 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -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 @@ The text matching the first grouping will be used as a button."
: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 @@ See also the documentation for `gnus-article-highlight-citation'."
;; 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)
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index c177c2a5e55..4388db5c9e5 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -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 @@ articles in the thread.
(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)
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index e43e01c99fe..ae5debaff01 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -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 @@ of the buffer."
(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))))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index a91ddf543df..96d1a864f13 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -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 @@ score file entries for articles to include in the group."
(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."
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 09d3ba23622..0b66c508767 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -395,8 +395,13 @@ Thank you for your help in stamping out bugs.
;; 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 @@ composing a new message."
;; 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 @@ The source file has to be in the Emacs load path."
(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")
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index a78e5087dcb..de59e862ebc 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1411,7 +1411,7 @@ If FORMAT, also format the current score file."
;; 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))
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index d0f2ca9731a..690fc7e026a 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -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 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
(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."
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index e65a1d95bd4..01140e5ce59 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1379,11 +1379,19 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
(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 @@ If REVERSE, save parts that do not match TYPE."
(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)
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index b5fcff394ca..472f02afa55 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -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 @@ If N, return the Nth ancestor instead."
(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."
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 99e14a4148b..5d09c4b5c3c 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -940,10 +940,10 @@ be set in `.emacs' instead."
(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.
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 04b7ce043ec..3c055c82000 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -826,12 +826,13 @@ Pass INFO on to CALLBACK."
"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)))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index a47a3d6c532..7c17f5fd317 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2444,11 +2444,6 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(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 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
"---+$\\|" ; 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 @@ to find out how to use this."
"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 @@ which specify the range to operate on."
(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)
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index f82985e8f37..c396789957c 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1091,9 +1091,10 @@ string if you do not like underscores."
(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 @@ If RECURSIVE, search recursively."
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)))
diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el
index ecd88b3dac9..63c963b49c1 100644
--- a/lisp/gnus/mm-encode.el
+++ b/lisp/gnus/mm-encode.el
@@ -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 @@ This variable should never be set directly, but bound before a call to
(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)))
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 0139beec788..6cb01ee2f44 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -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 @@ Use unibyte mode for this."
(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 @@ Equivalent to `progn' in XEmacs"
(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
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 607a4ddaf74..c0ed098fa6f 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -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 @@ this keymap, add them to `w3m-minor-mode-map' instead of this keymap.")))
(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 @@ this keymap, add them to `w3m-minor-mode-map' instead of this keymap.")))
(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)))))
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 47ff9575727..47a3cbd0292 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -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 @@ from the document.")
(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 @@ from the document.")
(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 @@ from the document.")
(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)))
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index c2c4612ced7..bebf7ceaf07 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -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 @@ by anything."
: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 @@ See the documentation for the variable `nnmail-split-fancy' for details."
(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
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index ff67a9e823d..a54b57f6fa4 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -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 @@ This mode is an extended emacs-lisp mode.
(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 ()
diff --git a/lisp/gnus/webmail.el b/lisp/gnus/webmail.el
index b2466a75db6..b9670137139 100644
--- a/lisp/gnus/webmail.el
+++ b/lisp/gnus/webmail.el
@@ -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)