From 4573e0dfb8136b7b92a4caee7f87c2561565fbae Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Thu, 16 Nov 2006 11:10:48 +0000 Subject: Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 164-166) - Update from CVS 2006-11-15 Reiner Steib * lisp/gnus/gnus-util.el (gnus-extract-address-components): Improve comment. 2006-11-14 Katsumi Yamaoka * lisp/gnus/gnus-util.el (gnus-extract-address-components): Work with address in which the name portion contains @. 2006-11-14 Reiner Steib * lisp/gnus/gnus.el (gnus-start): Move custom group up. (gnus-select-method): Don't autoload, but make it available for `customize-variable'. (gnus-getenv-nntpserver): Don't autoload. 2006-11-14 Katsumi Yamaoka * lisp/gnus/mml.el (mml-generate-mime-1): Use mm-string-as-unibyte instead of mm-with-unibyte-current-buffer to make string unibyte. * lisp/gnus/mm-decode.el (mm-insert-part): Use mm-string-to-multibyte instead of mm-string-as-multibyte. 2006-11-09 Reiner Steib * lisp/gnus/message.el: Merge from the trunk to fix the bug WRT double encoded subjects. (message-replacement-char): New variable. (message-fix-before-sending): Use it. (message-simplify-subject): New function to remove duplicate code. (message-reply, message-followup): Use it. (message-simplify-subject-functions): New variable. (message-strip-subject-encoded-words): New function 2006-11-08 Wolfgang Jenkner (tiny change) * lisp/gnus/gnus-sum.el (gnus-summary-catchup): Use gnus-sorted-intersection instead of gnus-intersection because arguments of gnus-sorted-nunion must be sorted. This avoids corruption of gnus-newsgroup-unreads. Revision: emacs@sv.gnu.org/emacs--devo--0--patch-515 --- lisp/gnus/ChangeLog | 41 ++++++++++++++ lisp/gnus/gnus-sum.el | 4 +- lisp/gnus/gnus-util.el | 9 ++- lisp/gnus/gnus.el | 17 ++++-- lisp/gnus/message.el | 146 ++++++++++++++++++++++++++++++++++++++++++++----- lisp/gnus/mm-decode.el | 2 +- lisp/gnus/mml.el | 6 +- 7 files changed, 198 insertions(+), 27 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index aa222ee43a5..95e8bff4d16 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,44 @@ +2006-11-15 Reiner Steib + + * gnus-util.el (gnus-extract-address-components): Improve comment. + +2006-11-14 Katsumi Yamaoka + + * gnus-util.el (gnus-extract-address-components): Work with address in + which the name portion contains @. + +2006-11-14 Reiner Steib + + * gnus.el (gnus-start): Move custom group up. + (gnus-select-method): Don't autoload, but make it available for + `customize-variable'. + (gnus-getenv-nntpserver): Don't autoload. + +2006-11-14 Katsumi Yamaoka + + * mml.el (mml-generate-mime-1): Use mm-string-as-unibyte instead of + mm-with-unibyte-current-buffer to make string unibyte. + + * mm-decode.el (mm-insert-part): Use mm-string-to-multibyte instead of + mm-string-as-multibyte. + +2006-11-09 Reiner Steib + + * message.el: Merge from the trunk to fix the bug WRT double encoded + subjects. + (message-replacement-char): New variable. + (message-fix-before-sending): Use it. + (message-simplify-subject): New function to remove duplicate code. + (message-reply, message-followup): Use it. + (message-simplify-subject-functions): New variable. + (message-strip-subject-encoded-words): New function + +2006-11-08 Wolfgang Jenkner (tiny change) + + * gnus-sum.el (gnus-summary-catchup): Use gnus-sorted-intersection + instead of gnus-intersection because arguments of gnus-sorted-nunion + must be sorted. This avoids corruption of gnus-newsgroup-unreads. + 2006-11-03 Juanma Barranquero * gnus-diary.el (gnus-diary-delay-format-function): diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 7d0b7203654..6bf4142216d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -10470,8 +10470,8 @@ The number of articles marked as read is returned." gnus-newsgroup-dormant nil)) (setq gnus-newsgroup-unreads (gnus-sorted-nunion - (gnus-intersection gnus-newsgroup-unreads - gnus-newsgroup-downloadable) + (gnus-sorted-intersection gnus-newsgroup-unreads + gnus-newsgroup-downloadable) gnus-newsgroup-unfetched))) ;; We actually mark all articles as canceled, which we ;; have to do when using auto-expiry or adaptive scoring. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 09d7ab9432e..b88a433b5fc 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -202,8 +202,13 @@ is slower." ;; First find the address - the thing with the @ in it. This may ;; not be accurate in mail addresses, but does the trick most of ;; the time in news messages. - (when (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) - (setq address (substring from (match-beginning 0) (match-end 0)))) + (cond (;; Check ``'' first in order to handle the quite common + ;; form ``"abc@xyz" '' (i.e. ``@'' as part of a comment) + ;; correctly. + (string-match "<\\([^@ \t<>]+[!@][^@ \t<>]+\\)>" from) + (setq address (substring from (match-beginning 1) (match-end 1)))) + ((string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) + (setq address (substring from (match-beginning 0) (match-end 0))))) ;; Then we check whether the "name
" format is used. (and address ;; Linear white space is not required. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 94e890b02c3..41a79ccc1ca 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -51,6 +51,10 @@ :group 'news :group 'mail) +(defgroup gnus-start nil + "Starting your favorite newsreader." + :group 'gnus) + (defgroup gnus-format nil "Dealing with formatting issues." :group 'gnus) @@ -70,10 +74,6 @@ "Article Registry." :group 'gnus) -(defgroup gnus-start nil - "Starting your favorite newsreader." - :group 'gnus) - (defgroup gnus-start-server nil "Server options at startup." :group 'gnus-start) @@ -1239,7 +1239,6 @@ used to 899, you would say something along these lines: :group 'gnus-server :type 'file) -;;;###autoload (defun gnus-getenv-nntpserver () "Find default nntp server. Check the NNTPSERVER environment variable and the @@ -1251,7 +1250,11 @@ Check the NNTPSERVER environment variable and the (when (re-search-forward "[^ \t\n\r]+" nil t) (match-string 0)))))) -;;;###autoload +;; `M-x customize-variable RET gnus-select-method RET' should work without +;; starting or even loading Gnus. +;;;###autoload(when (fboundp 'custom-autoload) +;;;###autoload (custom-autoload 'gnus-select-method "gnus")) + (defcustom gnus-select-method (condition-case nil (nconc @@ -1285,6 +1288,8 @@ If you use this variable, you must set `gnus-nntp-server' to nil. There is a lot more to know about select methods and virtual servers - see the manual for details." :group 'gnus-server + :group 'gnus-start + :initialize 'custom-initialize-default :type 'gnus-select-method) (defcustom gnus-message-archive-method "archive" diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fc3859345f3..a3d0298ce0e 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1786,6 +1786,96 @@ see `message-narrow-to-headers-or-head'." (substring subject (match-end 0)) subject)) +(defcustom message-replacement-char "." + "Replacement character used instead of unprintable or not decodable chars." + :group 'message-various + :version "22.1" ;; Gnus 5.10.9 + :type '(choice string + (const ".") + (const "?"))) + +;; FIXME: We also should call `message-strip-subject-encoded-words' +;; when forwarding. Probably in `message-make-forward-subject' and +;; `message-forward-make-body'. + +(defun message-strip-subject-encoded-words (subject) + "Fix non-decodable words in SUBJECT." + ;; Cf. `gnus-simplify-subject-fully'. + (let* ((case-fold-search t) + (replacement-chars (format "[%s%s%s]" + message-replacement-char + message-replacement-char + message-replacement-char)) + (enc-word-re "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)") + cs-string + (have-marker + (with-temp-buffer + (insert subject) + (goto-char (point-min)) + (when (re-search-forward enc-word-re nil t) + (setq cs-string (match-string 1))))) + cs-coding q-or-b word-beg word-end) + (if (or (not have-marker) ;; No encoded word found... + ;; ... or double encoding was correct: + (and (stringp cs-string) + (setq cs-string (downcase cs-string)) + (mm-coding-system-p (intern cs-string)) + (not (prog1 + (y-or-n-p + (format "\ +Decoded Subject \"%s\" +contains a valid encoded word. Decode again? " + subject)) + (setq cs-coding (intern cs-string)))))) + subject + (with-temp-buffer + (insert subject) + (goto-char (point-min)) + (while (re-search-forward enc-word-re nil t) + (setq cs-string (downcase (match-string 1)) + q-or-b (match-string 2) + word-beg (match-beginning 0) + word-end (match-end 0)) + (setq cs-coding + (if (mm-coding-system-p (intern cs-string)) + (setq cs-coding (intern cs-string)) + nil)) + ;; No double encoded subject? => bogus charset. + (unless cs-coding + (setq cs-coding + (mm-read-coding-system + (format "\ +Decoded Subject \"%s\" +contains an encoded word. The charset `%s' is unknown or invalid. +Hit RET to replace non-decodable characters with \"%s\" or enter replacement +charset: " + subject cs-string message-replacement-char))) + (if cs-coding + (replace-match (concat "=?" (symbol-name cs-coding) + "?\\2?\\3\\4\\5")) + (save-excursion + (goto-char word-beg) + (re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t) + (replace-match "") + ;; QP or base64 + (if (string-match "\\`Q\\'" q-or-b) + ;; QP + (progn + (message "Replacing non-decodable characters with \"%s\"." + message-replacement-char) + (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+" + word-end t) + (replace-match message-replacement-char))) + ;; base64 + (message "Replacing non-decodable characters with \"%s\"." + replacement-chars) + (re-search-forward "[^?]+" word-end t) + (replace-match replacement-chars)) + (re-search-forward "\\?=") + (replace-match ""))))) + (rfc2047-decode-region (point-min) (point-max)) + (buffer-string))))) + ;;; Start of functions adopted from `message-utils.el'. (defun message-strip-subject-trailing-was (subject) @@ -3614,8 +3704,10 @@ It should typically alter the sending method in some way or other." (setq choice (gnus-multiple-choice "Non-printable characters found. Continue sending?" - '((?d "Remove non-printable characters and send") - (?r "Replace non-printable characters with dots and send") + `((?d "Remove non-printable characters and send") + (?r ,(format + "Replace non-printable characters with \"%s\" and send" + message-replacement-char)) (?i "Ignore non-printable characters and send") (?e "Continue editing")))) (if (eq choice ?e) @@ -3638,7 +3730,7 @@ It should typically alter the sending method in some way or other." (message-kill-all-overlays) (delete-char 1) (when (eq choice ?r) - (insert ".")))) + (insert message-replacement-char)))) (forward-char) (skip-chars-forward mm-7bit-chars)))))) @@ -5816,6 +5908,39 @@ want to get rid of this query permanently."))) (push (cons 'Cc recipients) follow-to))) follow-to)) +(defcustom message-simplify-subject-functions + '(message-strip-list-identifiers + message-strip-subject-re + message-strip-subject-trailing-was + message-strip-subject-encoded-words) + "List of functions taking a string argument that simplify subjects. +The functions are applied when replying to a message. + +Useful functions to put in this list include: +`message-strip-list-identifiers', `message-strip-subject-re', +`message-strip-subject-trailing-was', and +`message-strip-subject-encoded-words'." + :version "22.1" ;; Gnus 5.10.9 + :group 'message-various + :type '(repeat function)) + +(defun message-simplify-subject (subject &optional functions) + "Return simplified SUBJECT." + (unless functions + ;; Simplify fully: + (setq functions message-simplify-subject-functions)) + (when (and (memq 'message-strip-list-identifiers functions) + gnus-list-identifiers) + (setq subject (message-strip-list-identifiers subject))) + (when (memq 'message-strip-subject-re functions) + (setq subject (concat "Re: " (message-strip-subject-re subject)))) + (when (and (memq 'message-strip-subject-trailing-was functions) + message-subject-trailing-was-query) + (setq subject (message-strip-subject-trailing-was subject))) + (when (memq 'message-strip-subject-encoded-words functions) + (setq subject (message-strip-subject-encoded-words subject))) + subject) + ;;;###autoload (defun message-reply (&optional to-address wide) "Start editing a reply to the article in the current buffer." @@ -5845,11 +5970,9 @@ want to get rid of this query permanently."))) date (message-fetch-field "date") from (or (message-fetch-field "from") "nobody") subject (or (message-fetch-field "subject") "none")) - (when gnus-list-identifiers - (setq subject (message-strip-list-identifiers subject))) - (setq subject (concat "Re: " (message-strip-subject-re subject))) - (when message-subject-trailing-was-query - (setq subject (message-strip-subject-trailing-was subject))) + + ;; Strip list identifiers, "Re: ", and "was:" + (setq subject (message-simplify-subject subject)) (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) @@ -5919,11 +6042,8 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (let ((case-fold-search t)) (string-match "world" distribution))) (setq distribution nil)) - (if gnus-list-identifiers - (setq subject (message-strip-list-identifiers subject))) - (setq subject (concat "Re: " (message-strip-subject-re subject))) - (when message-subject-trailing-was-query - (setq subject (message-strip-subject-trailing-was subject))) + ;; Strip list identifiers, "Re: ", and "was:" + (setq subject (message-simplify-subject subject)) (widen)) (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index c5fd5d3c258..7e6f93be1f1 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1135,7 +1135,7 @@ are ignored." (with-current-buffer (mm-handle-buffer handle) (buffer-string))) ((mm-multibyte-p) - (mm-string-as-multibyte (mm-get-part handle no-cache))) + (mm-string-to-multibyte (mm-get-part handle no-cache))) (t (mm-get-part handle no-cache)))))) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 159039914f5..0ae4487f869 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -501,9 +501,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (mm-with-unibyte-buffer (cond ((cdr (assq 'buffer cont)) - (insert (with-current-buffer (cdr (assq 'buffer cont)) - (mm-with-unibyte-current-buffer - (buffer-string))))) + (insert (mm-string-as-unibyte + (with-current-buffer (cdr (assq 'buffer cont)) + (buffer-string))))) ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) (let ((coding-system-for-read mm-binary-coding-system)) -- cgit v1.2.3