From: ueno Date: Sat, 4 Dec 1999 17:10:54 +0000 (+0000) Subject: * lisp/{rfc2047.el,nnweb.el,nnultimate.el,nntp.el,nnslashdot.el, X-Git-Tag: t-gnus-6_14_0-00~3 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=7ab0d92af27fe27abf4c10a26e7d3a1c3c9c9e18;p=elisp%2Fgnus.git- * lisp/{rfc2047.el,nnweb.el,nnultimate.el,nntp.el,nnslashdot.el, nnmh.el,nnfolder.el,nndoc.el,mml.el,mm-view.el,mm-util.el, mm-bodies.el,message.el,mail-source.el,gnus.el,gnus-uu.el, gnus-sum.el,gnus-start.el,gnus-msg.el,gnus-int.el,gnus-cache.el, gnus-art.el,dgnushack.el,ChangeLog}: Sync up with Gnus v5.8.2. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 46c0f9c..16f290a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,184 @@ +Fri Dec 3 20:34:11 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v5.8.2 is released. + +Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v5.8.1 is released. + +1999-11-11 Hrvoje Niksic + + * mml.el (mml-insert-tag): Don't close the tag. + (mml-insert-empty-tag): New function. + (mml-attach-file): Use mml-insert-empty-tag instead of + mml-insert-tag. + (mml-attach-buffer): Ditto. + (mml-attach-external): Ditto. + (mml-insert-multipart): Ditto. + +1999-12-03 08:49:53 Shenghuo ZHU + + * nnfolder.el (nnfolder-request-article): Return -1 if not find + the article number. + +1999-12-03 01:12:41 Shenghuo ZHU + + * gnus.el (gnus-find-method-for-group): The method of a new group + is not the native one. + +1999-12-03 01:26:55 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-embedded-url): Always call browse-url. + +1999-12-02 18:00:15 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-retrieve-headers): Use + mm-with-unibyte-current-buffer. + (nnultimate-request-article): Ditto. + +1999-12-02 14:57:46 Shenghuo ZHU + + * nntp.el (nntp-retrieve-groups): Set to process buffer. + +1999-12-02 11:14:50 Shenghuo ZHU + + * mm-util.el (mm-with-unibyte-current-buffer): New macro. + * nnweb.el (nnweb-retrieve-headers): Use it. + (nnweb-request-article): Use it. + + * nnweb.el (nnweb-dejanews-create-mapping): Set a default date in + case matching failed. + +1999-12-02 John Wiegley + + * mail-source.el (mail-source-keyword-map): Add backslash to + Delete-flag. + +1999-12-02 07:24:35 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-group-charset-alist): Default nnweb groups to + Latin-1. + (gnus-group-charset-alist): No, don't. + + * nnweb.el (nnweb-init): Make the buffer unibyte. + +1999-12-01 23:02:48 Shenghuo ZHU + + * mail-source.el (mail-source-set-common-1): Fix to get the + default value. + +1999-12-02 00:27:46 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-read-groups): Unibyte. + + * nnultimate.el (nnultimate-request-list): Use unibyte. + + * gnus-uu.el (gnus-uu-grab-articles): Bind + gnus-display-mime-function to nil. + + * message.el (message-send-mail-with-sendmail): Use the + user-mail-address variable. + + * gnus-art.el (gnus-ignored-headers): More headers. + + * message.el (message-shorten-1): Use list. + +1999-12-01 21:59:36 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-configure-posting-styles): Ignore nil + signatures. + + * nnweb.el (nnweb-dejanews-create-mapping): Get the data. + (nnweb-dejanews-create-mapping): Do the properish date. + +1999-12-01 17:41:21 Shenghuo ZHU + + * mail-source.el (mail-source-common-keyword-map): New variable. + (mail-source-bind-common): New macro. + (mail-source-fetch): Support plugged mail source. + * gnus-int.el (gnus-request-scan): Use them. + +1999-12-01 21:59:36 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-message): Check whether charset is a + string. + + * nnslashdot.el (nnslashdot-request-post): Insert

's. + + * message.el (message-mode-map): Changed keystroke for + message-yank-buffer. + +1999-11-26 Hrvoje Niksic + + * message.el (message-shorten-references): Cut references to 31 + elements, then either fold them or shorten them to 988 characters. + (message-shorten-1): New function. + (message-cater-to-broken-inn): New variable. + +1999-12-01 21:47:10 Eric Marsden + + * nnslashdot.el (nnslashdot-lose): New function. + +1999-12-01 21:08:48 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-message): Not the right type of charset is + being fetched here. Let the group charset rule. + (mm-inline-message): Ignore us-ascii. + +1999-11-24 Carsten Leonhardt + + * mail-source.el (mail-source-fetch-maildir): work around the + ommitted "file-regular-p" in efs/ange-ftp + +1999-12-01 19:59:25 Lars Magne Ingebrigtsen + + * mml.el (mml-generate-mime-1): Don't insert extra empty line. + (mml-generate-mime-1): Use the encoding param. + + * gnus-sum.el (gnus-summary-show-article): Don't bind gnus-visual. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Require + gnus-art before binding its variables. + + * gnus-art.el (gnus-article-prepare-display): Run the prepare + after the MIME. + +1999-12-01 19:48:14 Rupa Schomaker + + * message.el (message-clone-locals): Use it. + + * gnus-msg.el (gnus-configure-posting-styles): Make + user-mail-address local. + +1999-11-20 Simon Josefsson + + * gnus-start.el (gnus-get-unread-articles): Scan each method only + once. + +1999-12-01 17:37:18 Lars Magne Ingebrigtsen + + * message.el (message-generate-new-buffer-clone-locals): Use varstr. + (message-clone-locals): Ditto. + + * gnus-sum.el (gnus-summary-enter-digest-group): Have the digest + group inherit reply-to or from. + +1999-12-01 13:04:09 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-show-article): Support numbered ARG + for charset. + (gnus-summary-show-article-charset-alist): New variable. + + * mm-bodies.el (mm-decode-string): Support gnus-all and + gnus-unknown. + (mm-decode-body): Ditto. + * rfc2047.el (rfc2047-decode): Ditto. + +1999-12-01 17:37:18 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-delete-incoming): Change default to + t. + Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.99 is released. diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index cdedb1b..3c1c0d0 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -113,7 +113,7 @@ (defvar srcdir (or (getenv "srcdir") ".")) -(push srcdir load-path) +;(push "/usr/share/emacs/site-lisp" load-path) ;; Attempt to pickup the additional load-path(s). (load (expand-file-name "dgnuspath.el" srcdir) nil nil t) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index cf5e933..1a6bc9e 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -139,7 +139,8 @@ "^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:" "^List-[A-Za-z]+:" "^X-Listprocessor-Version:" "^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:" - "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:") + "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:" + "^X-Received:" "^Content-length:" "X-precedence:") "*All headers that start with this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." @@ -4900,10 +4901,7 @@ forbidden in URL encoding." (defun gnus-button-embedded-url (address) "Browse ADDRESS." - ;; In Emacs 20, `browse-url-browser-function' may be an alist. - (if (listp browse-url-browser-function) - (browse-url (gnus-strip-whitespace address)) - (funcall browse-url-browser-function (gnus-strip-whitespace address)))) + (browse-url (gnus-strip-whitespace address))) ;;; Next/prev buttons in the article buffer. diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 12b491a..2f715a8 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -178,6 +178,7 @@ it's not cached." t ; The article already is saved. (save-excursion (set-buffer nntp-server-buffer) + (require 'gnus-art) (let ((gnus-use-cache nil) (gnus-article-decode-hook nil)) (gnus-request-article-this-buffer number group)) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index df5fdc8..97061da 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -451,13 +451,14 @@ If BUFFER, insert the article in that group." (defun gnus-request-scan (group gnus-command-method) "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD. If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." - (when gnus-plugged - (let ((gnus-command-method - (if group (gnus-find-method-for-group group) gnus-command-method)) - (gnus-inhibit-demon t)) - (funcall (gnus-get-function gnus-command-method 'request-scan) - (and group (gnus-group-real-name group)) - (nth 1 gnus-command-method))))) + (let ((gnus-command-method + (if group (gnus-find-method-for-group group) gnus-command-method)) + (gnus-inhibit-demon t) + (mail-source-plugged gnus-plugged)) + (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) + (funcall (gnus-get-function gnus-command-method 'request-scan) + (and group (gnus-group-real-name group)) + (nth 1 gnus-command-method))))) (defsubst gnus-request-update-info (info gnus-command-method) "Request that GNUS-COMMAND-METHOD update INFO." diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index b6a61c8..b16b12d 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1311,11 +1311,13 @@ this is a reply." ((eq 'signature (car result)) (set (make-local-variable 'message-signature) nil) (set (make-local-variable 'message-signature-file) nil) - `(lambda () - (save-excursion - (let ((message-signature ,(cdr result))) - (when message-signature - (message-insert-signature)))))) + (if (not (cdr result)) + 'ignore + `(lambda () + (save-excursion + (let ((message-signature ,(cdr result))) + (when message-signature + (message-insert-signature))))))) (t (let ((header (if (symbolp (car result)) @@ -1329,6 +1331,8 @@ this is a reply." (when (or name address) (add-hook 'message-setup-hook `(lambda () + (set (make-local-variable 'user-mail-address) + ,(or (cdr address) user-mail-address)) (let ((user-full-name ,(or (cdr name) (user-full-name))) (user-mail-address ,(or (cdr address) user-mail-address))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index bf285a5..e711c42 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1502,7 +1502,7 @@ newsgroup." gnus-activate-foreign-newsgroups) (t 0)) level)) - info group active method retrievegroups) + scanned-methods info group active method retrievegroups) (gnus-message 5 "Checking new news...") (while newsrc @@ -1546,7 +1546,10 @@ newsgroup." (setcdr (assoc method retrievegroups) (cons group (cdr (assoc method retrievegroups)))) (push (list method group) retrievegroups)) - (setq active (gnus-activate-group group 'scan)) + (if (member method scanned-methods) + (setq active (gnus-activate-group group)) + (setq active (gnus-activate-group group 'scan)) + (push method scanned-methods)) (inline (gnus-close-group group)))))) ;; Get the number of unread articles in the group. diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 7587108..34aa130 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -897,6 +897,17 @@ by moving the mouse over the edge of the article window." :type 'integer :group 'gnus-summary-maneuvering) +(defcustom gnus-summary-show-article-charset-alist + nil + "Alist of number and charset. +The article will be shown with the charset corresponding to the +numbered argument. +For example: ((1 . cn-gb-2312) (2 . big5))." + :type '(repeat (cons (number :tag "Argument" 1) + (symbol :tag "Charset"))) + :group 'gnus-charset) + + ;;; Internal variables (defvar gnus-scores-exclude-files nil) @@ -6843,8 +6854,14 @@ to guess what the document format is." (list (cons 'save-article-group ogroup)))) (case-fold-search t) (buf (current-buffer)) - dig) + dig to-address) (save-excursion + (set-buffer gnus-original-article-buffer) + ;; Have the digest group inherit the main mail address of + ;; the parent article. + (when (setq to-address (or (message-fetch-field "reply-to") + (message-fetch-field "from"))) + (setq params (append (list (cons 'to-address to-address))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) (insert-buffer-substring gnus-original-article-buffer) ;; Remove lines that may lead nndoc to misinterpret the @@ -7262,12 +7279,23 @@ to save in." (defun gnus-summary-show-article (&optional arg) "Force re-fetching of the current article. -If ARG (the prefix) is non-nil, show the raw article without any -article massaging functions being run." +If ARG (the prefix) is a number, show the article with the charset +defined in `gnus-summary-show-article-charset-alist', or the charset +inputed. +If ARG (the prefix) is non-nil and not a number, show the raw article +without any article massaging functions being run." (interactive "P") - (if (not arg) - ;; Select the article the normal way. - (gnus-summary-select-article nil 'force) + (cond + ((numberp arg) + (let ((gnus-newsgroup-charset + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) + (read-coding-system "Charset: "))) + (gnus-newsgroup-ignored-charsets 'gnus-all)) + (gnus-summary-select-article nil 'force))) + ((not arg) + ;; Select the article the normal way. + (gnus-summary-select-article nil 'force)) + (t ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) @@ -7278,9 +7306,8 @@ article massaging functions being run." gnus-article-prepare-hook gnus-article-decode-hook gnus-break-pages - gnus-show-mime - gnus-visual) - (gnus-summary-select-article nil 'force))) + gnus-show-mime) + (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -9669,10 +9696,9 @@ If REVERSE, save parts that do not match TYPE." (setq gnus-newsgroup-charset (or gnus-newsgroup-ephemeral-charset (and gnus-newsgroup-name - (or (gnus-group-find-parameter gnus-newsgroup-name - 'charset) + (or (gnus-group-find-parameter gnus-newsgroup-name 'charset) (let ((alist gnus-group-charset-alist) - elem (charset nil)) + elem charset) (while (setq elem (pop alist)) (when (and name (string-match (car elem) name)) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index b3f6a37..5e7f9a9 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1210,7 +1210,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-inhibit-treatment t) has-been-begin article result-file result-files process-state gnus-summary-display-article-function - gnus-article-display-hook gnus-article-prepare-hook + gnus-article-display-hook gnus-article-prepare-hook gnus-display-mime-function article-series files) (while (and articles diff --git a/lisp/gnus.el b/lisp/gnus.el index 5a648ba..6de59ef 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -265,18 +265,18 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.13.4" +(defconst gnus-version-number "6.14.0" "Version number for this version of gnus.") -(defconst gnus-revision-number "01" +(defconst gnus-revision-number "00" "Revision number for this version of gnus.") -(defconst gnus-original-version-number "0.99" +(defconst gnus-original-version-number "5.8.2" "Version number for this version of Gnus.") (provide 'running-pterodactyl-gnus-0_73-or-later) -(defconst gnus-original-product-name "Pterodactyl Gnus" +(defconst gnus-original-product-name "Gnus" "Product name of the original version of Gnus.") (defconst gnus-version @@ -2812,6 +2812,8 @@ If NEWSGROUP is nil, return the global kill file name instead." (or gnus-override-method (and (not group) gnus-select-method) + (and (not (gnus-group-entry group)) ;; a new group + (gnus-group-name-to-method group)) (let ((info (or info (gnus-get-info group))) method) (if (or (not info) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index f288242..ccbfccc 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -55,7 +55,7 @@ This variable is a list of mail source specifiers." :group 'mail-source :type 'integer) -(defcustom mail-source-delete-incoming nil +(defcustom mail-source-delete-incoming t "*If non-nil, delete incoming files after handling." :group 'mail-source :type 'boolean) @@ -66,6 +66,11 @@ This variable is a list of mail source specifiers." "A dynamically bound string that says what the current mail source is.") (eval-and-compile + (defvar mail-source-common-keyword-map + '((:plugged)) + "Mapping from keywords to default values. +Common keywords should be listed here.") + (defvar mail-source-keyword-map '((file (:prescript) @@ -101,7 +106,7 @@ This variable is a list of mail source specifiers." (:password) (:mailbox "INBOX") (:predicate "UNSEEN UNDELETED") - (:fetchflag "\Deleted") + (:fetchflag "\\Deleted") (:dontexpunge)) (webmail (:subtype hotmail) @@ -122,6 +127,8 @@ All keywords that can be used must be listed here.")) (defvar mail-source-password-cache nil) +(defvar mail-source-plugged t) + ;;; Functions (eval-and-compile @@ -169,6 +176,39 @@ the `mail-source-keyword-map' variable." (mail-source-value value) (mail-source-value (cadr default))))))) +(eval-and-compile + (defun mail-source-bind-common-1 () + (let* ((defaults mail-source-common-keyword-map) + default bind) + (while (setq default (pop defaults)) + (push (list (mail-source-strip-keyword (car default)) + nil) + bind)) + bind))) + +(defun mail-source-set-common-1 (source) + (let* ((type (pop source)) + (defaults mail-source-common-keyword-map) + (defaults-1 (cdr (assq type mail-source-keyword-map))) + default value keyword) + (while (setq default (pop defaults)) + (set (mail-source-strip-keyword (setq keyword (car default))) + (if (setq value (plist-get source keyword)) + (mail-source-value value) + (if (setq value (assq keyword defaults-1)) + (mail-source-value (cadr value)) + (mail-source-value (cadr default)))))))) + +(defmacro mail-source-bind-common (source &rest body) + "Return a `let' form that binds all common variables. +See `mail-source-bind'." + `(let ,(mail-source-bind-common-1) + (mail-source-set-common-1 source) + ,@body)) + +(put 'mail-source-bind-common 'lisp-indent-function 1) +(put 'mail-source-bind-common 'edebug-form-spec '(form body)) + (defun mail-source-value (value) "Return the value of VALUE." (cond @@ -188,24 +228,26 @@ the `mail-source-keyword-map' variable." CALLBACK will be called with the name of the file where (some of) the mail from SOURCE is put. Return the number of files that were found." - (save-excursion - (let ((function (cadr (assq (car source) mail-source-fetcher-alist))) - (found 0)) - (unless function - (error "%S is an invalid mail source specification" source)) - ;; If there's anything in the crash box, we do it first. - (when (file-exists-p mail-source-crash-box) - (message "Processing mail from %s..." mail-source-crash-box) - (setq found (mail-source-callback - callback mail-source-crash-box))) - (+ found - (condition-case err - (funcall function source callback) - (error - (unless (yes-or-no-p - (format "Mail source error (%s). Continue? " err)) - (error "Cannot get new mail.")) - 0)))))) + (mail-source-bind-common source + (if (or mail-source-plugged plugged) + (save-excursion + (let ((function (cadr (assq (car source) mail-source-fetcher-alist))) + (found 0)) + (unless function + (error "%S is an invalid mail source specification" source)) + ;; If there's anything in the crash box, we do it first. + (when (file-exists-p mail-source-crash-box) + (message "Processing mail from %s..." mail-source-crash-box) + (setq found (mail-source-callback + callback mail-source-crash-box))) + (+ found + (condition-case err + (funcall function source callback) + (error + (unless (yes-or-no-p + (format "Mail source error (%s). Continue? " err)) + (error "Cannot get new mail.")) + 0)))))))) (defun mail-source-make-complex-temp-name (prefix) (let ((newname (make-temp-name prefix)) @@ -441,7 +483,7 @@ If ARGS, PROMPT is used as an argument to `format'." (let ((found 0) (mail-source-string (format "maildir:%s" path))) (dolist (file (directory-files path t)) - (when (and (file-regular-p file) + (when (and (not (file-directory-p file)) (not (if function (funcall function file mail-source-crash-box) (rename-file file mail-source-crash-box)))) diff --git a/lisp/message.el b/lisp/message.el index c1cb1ff..9a9ab93 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -532,10 +532,9 @@ is never used." (const :tag "always" use) (const :tag "ask" ask))) -;; stuff relating to broken sendmail in MMDF (defcustom message-sendmail-f-is-evil nil - "*Non-nil means that \"-f username\" should not be added to the sendmail -command line, because it is even more evil than leaving it out." + "*Non-nil means that \"-f username\" should not be added to the sendmail command line. +Doing so would be even more evil than leaving it out." :group 'message-sending :type 'boolean) @@ -555,6 +554,11 @@ might set this variable to '(\"-f\" \"you@some.where\")." :group 'message-sending :type '(repeat string)) +(defvar message-cater-to-broken-inn t + "Non-nil means Gnus should not fold the `References' header. +Folding `References' makes ancient versions of INN create incorrect +NOV lines.") + (defvar gnus-post-method) (defvar gnus-select-method) (defcustom message-post-method @@ -1663,7 +1667,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) (define-key message-mode-map "\C-c\C-y" 'message-yank-original) - (define-key message-mode-map "\C-c\C-Y" 'message-yank-buffer) + (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) (define-key message-mode-map "\C-c\M-h" 'message-insert-headers) @@ -2731,7 +2735,7 @@ This sub function is for exclusive use of `message-send-mail'." (defun message-send-mail-with-sendmail () "Send off the prepared buffer with sendmail." (let ((errbuf (if message-interactive - (generate-new-buffer " sendmail errors") + (message-generate-new-buffer-clone-locals " sendmail errors") 0)) resend-to-addresses delimline) (let ((case-fold-search t)) @@ -2768,7 +2772,10 @@ This sub function is for exclusive use of `message-send-mail'." ;; But some systems are more broken with -f, so ;; we'll let users override this. (if (null message-sendmail-f-is-evil) - (list "-f" (user-login-name))) + (list "-f" + (if (null user-mail-address) + (user-login-name) + user-mail-address))) ;; These mean "report errors by mail" ;; and "deliver in background". (if (null message-interactive) '("-oem" "-odb")) @@ -3911,23 +3918,60 @@ Headers already prepared in the buffer are not modified." (replace-match " " t t)) (goto-char (point-max))))) +(defun message-shorten-1 (list cut surplus) + ;; Cut SURPLUS elements out of LIST, beginning with CUTth one. + (setcdr (nthcdr (- cut 2) list) + (nthcdr (+ (- cut 2) surplus 1) list))) + (defun message-shorten-references (header references) - "Limit REFERENCES to be shorter than 988 characters." - (let ((max 988) - (cut 4) + "Trim REFERENCES to be less than 31 Message-ID long, and fold them. +If folding is disallowed, also check that the REFERENCES are less +than 988 characters long, and if they are not, trim them until they are." + (let ((maxcount 31) + (count 0) + (cut 6) refs) (with-temp-buffer (insert references) (goto-char (point-min)) + ;; Cons a list of valid references. (while (re-search-forward "<[^>]+>" nil t) (push (match-string 0) refs)) - (setq refs (nreverse refs)) - (while (> (length (mapconcat 'identity refs " ")) max) - (when (< (length refs) (1+ cut)) - (decf cut)) - (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs))))) - (insert (capitalize (symbol-name header)) ": " - (mapconcat 'identity refs " ") "\n"))) + (setq refs (nreverse refs) + count (length refs))) + + ;; If the list has more than MAXCOUNT elements, trim it by + ;; removing the CUTth element and the required number of + ;; elements that follow. + (when (> count maxcount) + (let ((surplus (- count maxcount))) + (message-shorten-1 refs cut surplus) + (decf count surplus))) + + ;; If folding is disallowed, make sure the total length (including + ;; the spaces between) will be less than MAXSIZE characters. + (when message-cater-to-broken-inn + (let ((maxsize 988) + (totalsize (+ (apply #'+ (mapcar #'length refs)) + (1- count))) + (surplus 0) + (ptr (nthcdr (1- cut) refs))) + ;; Decide how many elements to cut off... + (while (> totalsize maxsize) + (decf totalsize (1+ (length (car ptr)))) + (incf surplus) + (setq ptr (cdr ptr))) + ;; ...and do it. + (when (> surplus 0) + (message-shorten-1 refs cut surplus)))) + + ;; Finally, collect the references back into a string and insert + ;; it into the buffer. + (let ((refstring (mapconcat #'identity refs " "))) + (if message-cater-to-broken-inn + (insert (capitalize (symbol-name header)) ": " + refstring "\n") + (message-fill-header header refstring))))) (defun message-position-point () "Move point to where the user probably wants to find it." @@ -5016,10 +5060,10 @@ regexp varstr." (let ((oldbuf (current-buffer))) (save-excursion (set-buffer (generate-new-buffer name)) - (message-clone-locals oldbuf) + (message-clone-locals oldbuf varstr) (current-buffer)))) -(defun message-clone-locals (buffer) +(defun message-clone-locals (buffer &optional varstr) "Clone the local variables from BUFFER to the current buffer." (let ((locals (save-excursion (set-buffer buffer) @@ -5030,7 +5074,9 @@ regexp varstr." (lambda (local) (when (and (consp local) (car local) - (string-match regexp (symbol-name (car local)))) + (string-match regexp (symbol-name (car local))) + (or (null varstr) + (string-match varstr (symbol-name (car local))))) (ignore-errors (set (make-local-variable (car local)) (cdr local))))) @@ -5119,7 +5165,7 @@ regexp varstr." (delete-char 1) (search-forward "\n\n") (setq lines (buffer-substring (point-min) (1- (point)))) - (delete-region (point-min) (point)))))) + (delete-region (point-min) (point)))))) (save-restriction (message-narrow-to-headers-or-head) (message-remove-header "Mime-Version") diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index ad7bbeb..64bcac3 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -95,7 +95,7 @@ If no encoding was done, nil is returned." (setq start nil))) charset))))))) -(defun mm-body-encoding (charset) +(defun mm-body-encoding (charset &optional encoding) "Do Content-Transfer-Encoding and return the encoding of the current buffer." (let ((bits (mm-body-7-or-8))) (cond @@ -104,7 +104,8 @@ If no encoding was done, nil is returned." ((eq charset mail-parse-charset) bits) (t - (let ((encoding (or (cdr (assq charset mm-body-charset-encoding-alist)) + (let ((encoding (or encoding + (cdr (assq charset mm-body-charset-encoding-alist)) (mm-qp-or-base64)))) (mm-encode-content-transfer-encoding encoding "text/plain") encoding))))) @@ -179,15 +180,22 @@ If no encoding was done, nil is returned." The characters in CHARSET should then be decoded." (if (stringp charset) (setq charset (intern (downcase charset)))) - (if (or (not charset) (memq charset mail-parse-ignored-charsets)) + (if (or (not charset) + (eq 'gnus-all mail-parse-ignored-charsets) + (memq 'gnus-all mail-parse-ignored-charsets) + (memq charset mail-parse-ignored-charsets)) (setq charset mail-parse-charset)) (save-excursion (when encoding (mm-decode-content-transfer-encoding encoding type)) (when (featurep 'mule) - (let (mule-charset) - (when (and charset - (setq mule-charset (mm-charset-to-coding-system charset)) + (let ((mule-charset (mm-charset-to-coding-system charset))) + (if (and (not mule-charset) + (listp mail-parse-ignored-charsets) + (memq 'gnus-unknown mail-parse-ignored-charsets)) + (setq mule-charset + (mm-charset-to-coding-system mail-parse-charset))) + (when (and charset mule-charset ;; buffer-file-coding-system ;;Article buffer is nil coding system ;;in XEmacs @@ -201,13 +209,20 @@ The characters in CHARSET should then be decoded." "Decode STRING with CHARSET." (if (stringp charset) (setq charset (intern (downcase charset)))) - (if (or (not charset) (memq charset mail-parse-ignored-charsets)) + (if (or (not charset) + (eq 'gnus-all mail-parse-ignored-charsets) + (memq 'gnus-all mail-parse-ignored-charsets) + (memq charset mail-parse-ignored-charsets)) (setq charset mail-parse-charset)) (or (when (featurep 'mule) - (let (mule-charset) - (when (and charset - (setq mule-charset (mm-charset-to-coding-system charset)) + (let ((mule-charset (mm-charset-to-coding-system charset))) + (if (and (not mule-charset) + (listp mail-parse-ignored-charsets) + (memq 'gnus-unknown mail-parse-ignored-charsets)) + (setq mule-charset + (mm-charset-to-coding-system mail-parse-charset))) + (when (and charset mule-charset (mm-multibyte-p) (or (not (eq mule-charset 'ascii)) (setq mule-charset mail-parse-charset))) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index a23a7f6..8006fec 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -271,6 +271,24 @@ See also `with-temp-file' and `with-output-to-string'." (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) +(defmacro mm-with-unibyte-current-buffer (&rest forms) + "Evaluate FORMS there like `progn' in current buffer." + (let ((multibyte (make-symbol "multibyte"))) + `(if (or (string-match "XEmacs\\|Lucid" emacs-version) + (not (fboundp 'set-buffer-multibyte))) + (progn + ,@forms) + (let ((,multibyte (default-value 'enable-multibyte-characters))) + (unwind-protect + (let ((buffer-file-coding-system mm-binary-coding-system) + (coding-system-for-read mm-binary-coding-system) + (coding-system-for-write mm-binary-coding-system)) + (set-buffer-multibyte nil) + ,@forms) + (set-buffer-multibyte ,multibyte)))))) +(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) +(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) + (defun mm-find-charset-region (b e) "Return a list of charsets in the region." (cond diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 7a4851a..f076c2e 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -190,12 +190,18 @@ (charset (mail-content-type-get (mm-handle-type handle) 'charset)) gnus-displaying-mime handles) + (when (and charset + (stringp charset)) + (setq charset (intern (downcase charset))) + (when (eq charset 'us-ascii) + (setq charset nil))) (save-excursion (save-restriction (narrow-to-region b b) (mm-insert-part handle) (let (gnus-article-mime-handles - (gnus-newsgroup-charset (or charset gnus-newsgroup-charset))) + (gnus-newsgroup-charset + (or charset gnus-newsgroup-charset))) (run-hooks 'gnus-article-decode-hook) (gnus-article-prepare-display) (setq handles gnus-article-mime-handles)) diff --git a/lisp/mml.el b/lisp/mml.el index e84e955..9203465 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -241,7 +241,8 @@ called for this message.") (delete-region (+ (match-beginning 0) 2) (+ (match-beginning 0) 3)))))) (setq charset (mm-encode-body)) - (setq encoding (mm-body-encoding charset)) + (setq encoding (mm-body-encoding charset + (cdr (assq 'encoding cont)))) (setq coded (buffer-string))) (mm-with-unibyte-buffer (cond @@ -300,7 +301,6 @@ called for this message.") (let ((mml-boundary (mml-compute-boundary cont))) (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" type mml-boundary)) - (insert "\n") (setq cont (cddr cont)) (while cont (insert "\n--" mml-boundary "\n") @@ -654,7 +654,14 @@ called for this message.") (when (string-match "[\"\\~/* \t\n]" value) (setq value (prin1-to-string value))) (insert (format " %s=%s" key value))))) - (insert ">\n<#/" name ">\n")) + (insert ">\n")) + +(defun mml-insert-empty-tag (name &rest plist) + "Insert an empty MML tag described by NAME and PLIST." + (when (symbolp name) + (setq name (symbol-name name))) + (apply #'mml-insert-tag name plist) + (insert "<#/" name ">\n")) ;;; Attachment functions. @@ -671,8 +678,8 @@ description of the attachment." (type (mml-minibuffer-read-type file)) (description (mml-minibuffer-read-description))) (list file type description))) - (mml-insert-tag 'part 'type type 'filename file 'disposition "attachment" - 'description description)) + (mml-insert-empty-tag 'part 'type type 'filename file + 'disposition "attachment" 'description description)) (defun mml-attach-buffer (buffer &optional type description) "Attach a buffer to the outgoing MIME message. @@ -682,8 +689,8 @@ See `mml-attach-file' for details of operation." (type (mml-minibuffer-read-type buffer "text/plain")) (description (mml-minibuffer-read-description))) (list buffer type description))) - (mml-insert-tag 'part 'type type 'buffer buffer 'disposition "attachment" - 'description description)) + (mml-insert-empty-tag 'part 'type type 'buffer buffer + 'disposition "attachment" 'description description)) (defun mml-attach-external (file &optional type description) "Attach an external file into the buffer. @@ -694,8 +701,8 @@ TYPE is the MIME type to use." (type (mml-minibuffer-read-type file)) (description (mml-minibuffer-read-description))) (list file type description))) - (mml-insert-tag 'external 'type type 'name file 'disposition "attachment" - 'description description)) + (mml-insert-empty-tag 'external 'type type 'name file + 'disposition "attachment" 'description description)) (defun mml-insert-multipart (&optional type) (interactive (list (completing-read "Multipart type (default mixed): " @@ -704,7 +711,7 @@ TYPE is the MIME type to use." nil nil "mixed"))) (or type (setq type "mixed")) - (mml-insert-tag "multipart" 'type type) + (mml-insert-empty-tag "multipart" 'type type) (forward-line -1)) (defun mml-preview (&optional raw) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 180d03c..9758f61 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -292,6 +292,7 @@ from the document.") (setq nndoc-dissection-alist nil) (save-excursion (set-buffer nndoc-current-buffer) + (mm-enable-multibyte) (erase-buffer) (if (stringp nndoc-address) (nnheader-insert-file-contents nndoc-address) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 3146e54..c942f6f 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -186,11 +186,13 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (if (numberp article) (cons nnfolder-current-group article) (goto-char (point-min)) - (search-forward (concat "\n" nnfolder-article-marker)) (cons nnfolder-current-group - (string-to-int - (buffer-substring - (point) (progn (end-of-line) (point))))))))))) + (if (search-forward (concat "\n" nnfolder-article-marker) + nil t) + (string-to-int + (buffer-substring + (point) (progn (end-of-line) (point)))) + -1)))))))) (deffoo nnfolder-request-group (group &optional server dont-check) (nnfolder-possibly-change-group group server t) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 37415e5..1199d22 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -61,7 +61,7 @@ (defvoo nnmh-status-string "") (defvoo nnmh-group-alist nil) -(defvoo nnmh-allow-delete-final nil) +(defvar nnmh-allow-delete-final nil) diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index c28e35c..fbf1509 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -90,10 +90,12 @@ (deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old) (nnslashdot-possibly-change-server group server) - (unless gnus-nov-is-evil - (if nnslashdot-threaded - (nnslashdot-threaded-retrieve-headers articles group) - (nnslashdot-sane-retrieve-headers articles group)))) + (condition-case why + (unless gnus-nov-is-evil + (if nnslashdot-threaded + (nnslashdot-threaded-retrieve-headers articles group) + (nnslashdot-sane-retrieve-headers articles group))) + (search-failed (nnslashdot-lose why)))) (deffoo nnslashdot-threaded-retrieve-headers (articles group) (let ((last (car (last articles))) @@ -310,30 +312,33 @@ (deffoo nnslashdot-request-article (article &optional group server buffer) (nnslashdot-possibly-change-server group server) (let (contents) - (save-excursion - (set-buffer nnslashdot-buffer) - (let ((case-fold-search t)) - (goto-char (point-min)) - (when (and (stringp article) - (string-match "%\\([0-9]+\\)@" article)) - (setq article (string-to-number (match-string 1 article)))) - (when (numberp article) - (if (= article 1) - (progn - (re-search-forward "Posted by .* on ") - (forward-line 1) + (condition-case why + (save-excursion + (set-buffer nnslashdot-buffer) + (let ((case-fold-search t)) + (goto-char (point-min)) + (when (and (stringp article) + (string-match "%\\([0-9]+\\)@" article)) + (setq article (string-to-number (match-string 1 article)))) + (when (numberp article) + (if (= article 1) + (progn + (re-search-forward "Posted by .* on ") + (forward-line 1) + (setq contents + (buffer-substring + (point) + (progn + (re-search-forward + "

.*A href=http://slashdot.org/article.pl") + (match-beginning 0))))) + (search-forward (format "" (1- article))) (setq contents (buffer-substring - (point) - (progn - (re-search-forward - "

.*A href=http://slashdot.org/article.pl") - (match-beginning 0))))) - (search-forward (format "" (1- article))) - (setq contents - (buffer-substring - (re-search-forward "]+>") - (search-forward ""))))))) + (re-search-forward "]+>") + (search-forward ""))))))) + (search-failed (nnslashdot-lose why))) + (when contents (save-excursion (set-buffer (or buffer nntp-server-buffer)) @@ -363,49 +368,51 @@ (nnslashdot-possibly-change-server nil server) (let ((number 0) sid elem description articles gname) - ;; First we do the Ultramode to get info on all the latest groups. - (with-temp-buffer - (nnweb-insert "http://slashdot.org/slashdot.xml") - (goto-char (point-min)) - (while (search-forward "" nil t) - (narrow-to-region (point) (search-forward "")) - (goto-char (point-min)) - (re-search-forward "\\([^<]+\\)") - (setq description (match-string 1)) - (re-search-forward "\\([^<]+\\)") - (setq sid (match-string 1)) - (string-match "/\\([0-9/]+\\).shtml" sid) - (setq sid (match-string 1 sid)) - (re-search-forward "\\([^<]+\\)") - (setq articles (string-to-number (match-string 1))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid) nnslashdot-groups)) - (goto-char (point-max)) - (widen))) - ;; Then do the older groups. - (while (> (- nnslashdot-group-number number) 0) - (with-temp-buffer - (let ((case-fold-search t)) - (nnweb-insert (format nnslashdot-active-url number)) - (goto-char (point-min)) - (while (re-search-forward - "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" nil t) - (setq sid (match-string 1) - description (match-string 2)) - (forward-line 1) - (when (re-search-forward "\\([0-9]+\\)" nil t) - (setq articles (string-to-number (match-string 1)))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid) nnslashdot-groups))))) - (incf number 30)) + (condition-case why + ;; First we do the Ultramode to get info on all the latest groups. + (mm-with-unibyte-buffer + (nnweb-insert "http://slashdot.org/slashdot.xml") + (goto-char (point-min)) + (while (search-forward "" nil t) + (narrow-to-region (point) (search-forward "")) + (goto-char (point-min)) + (re-search-forward "\\([^<]+\\)") + (setq description (match-string 1)) + (re-search-forward "\\([^<]+\\)") + (setq sid (match-string 1)) + (string-match "/\\([0-9/]+\\).shtml" sid) + (setq sid (match-string 1 sid)) + (re-search-forward "\\([^<]+\\)") + (setq articles (string-to-number (match-string 1))) + (setq gname (concat description " (" sid ")")) + (if (setq elem (assoc gname nnslashdot-groups)) + (setcar (cdr elem) articles) + (push (list gname articles sid) nnslashdot-groups)) + (goto-char (point-max)) + (widen))) + ;; Then do the older groups. + (while (> (- nnslashdot-group-number number) 0) + (mm-with-unibyte-buffer + (let ((case-fold-search t)) + (nnweb-insert (format nnslashdot-active-url number)) + (goto-char (point-min)) + (while (re-search-forward + "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" nil t) + (setq sid (match-string 1) + description (match-string 2)) + (forward-line 1) + (when (re-search-forward "\\([0-9]+\\)" nil t) + (setq articles (string-to-number (match-string 1)))) + (setq gname (concat description " (" sid ")")) + (if (setq elem (assoc gname nnslashdot-groups)) + (setcar (cdr elem) articles) + (push (list gname articles sid) nnslashdot-groups))))) + (incf number 30)) + (search-failed (nnslashdot-lose why))) (nnslashdot-write-groups) (nnslashdot-generate-active) t)) - + (deffoo nnslashdot-request-newgroups (date &optional server) (nnslashdot-possibly-change-server nil server) (nnslashdot-generate-active) @@ -434,6 +441,9 @@ (insert "\n") (setq quoted nil))) (forward-line 1)) + (goto-char (point-min)) + (while (re-search-forward "^ *\n" nil t) + (replace-match "

\n")) (widen) (when (message-goto-signature) (forward-line -1) @@ -472,7 +482,7 @@ (defun nnslashdot-read-groups () (let ((file (expand-file-name "groups" nnslashdot-directory))) (when (file-exists-p file) - (with-temp-buffer + (mm-with-unibyte-buffer (insert-file-contents file) (goto-char (point-min)) (setq nnslashdot-groups (read (current-buffer))))))) @@ -508,6 +518,9 @@ (insert (prin1-to-string (car elem)) " " (number-to-string (cadr elem)) " 1 y\n")))) +(defun nnslashdot-lose (why) + (error "Slashdot HTML has changed; please get a new version of nnslashdot")) + (provide 'nnslashdot) ;;; nnslashdot.el ends here diff --git a/lisp/nntp.el b/lisp/nntp.el index 1f3e23d..adac986 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -498,6 +498,7 @@ noticing asynchronous data.") (received 0) (last-point (point-min)) (nntp-inhibit-erase t) + (buf (nntp-find-connection-buffer nntp-server-buffer)) (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP"))) (while groups ;; Send the command to the server. @@ -509,6 +510,9 @@ noticing asynchronous data.") (zerop (% count nntp-maximum-request))) (nntp-accept-response) (while (progn + ;; Search `blue moon' in this file for the + ;; reason why set-buffer here. + (set-buffer buf) (goto-char last-point) ;; Count replies. (while (re-search-forward "^[0-9]" nil t) @@ -518,10 +522,12 @@ noticing asynchronous data.") (nntp-accept-response)))) ;; Wait for the reply from the final command. + (set-buffer buf) (goto-char (point-max)) (re-search-backward "^[0-9]" nil t) (when (looking-at "^[23]") (while (progn + (set-buffer buf) (goto-char (point-max)) (if (not nntp-server-list-active-group) (not (re-search-backward "\r?\n" (- (point) 3) t)) @@ -529,6 +535,7 @@ noticing asynchronous data.") (nntp-accept-response))) ;; Now all replies are received. We remove CRs. + (set-buffer buf) (goto-char (point-min)) (while (search-forward "\r" nil t) (replace-match "" t t)) diff --git a/lisp/nnultimate.el b/lisp/nnultimate.el index b2ff2bf..b1962ac 100644 --- a/lisp/nnultimate.el +++ b/lisp/nnultimate.el @@ -114,7 +114,7 @@ (set-buffer nntp-server-buffer) (erase-buffer)) (setq nnultimate-articles nil) - (with-temp-buffer + (mm-with-unibyte-buffer (dolist (elem fetchers) (setq pages 1 current-page 1 @@ -197,9 +197,10 @@ (setq nnultimate-headers (sort headers 'car-less-than-car)) (save-excursion (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (header nnultimate-headers) - (nnheader-insert-nov (cdr header))))) + (mm-with-unibyte-current-buffer + (erase-buffer) + (dolist (header nnultimate-headers) + (nnheader-insert-nov (cdr header)))))) 'nov))) (deffoo nnultimate-request-group (group &optional server dont-check) @@ -230,13 +231,14 @@ (goto-char (point-min)) (insert "Content-Type: text/html\nMIME-Version: 1.0\n") (let ((header (cdr (assq article nnultimate-headers)))) - (nnheader-insert-header header)) + (mm-with-unibyte-current-buffer + (nnheader-insert-header header))) (nnheader-report 'nnultimate "Fetched article %s" article) (cons group article))))) (deffoo nnultimate-request-list (&optional server) (nnultimate-possibly-change-server nil server) - (with-temp-buffer + (mm-with-unibyte-buffer (nnweb-insert (if (string-match "/$" nnultimate-address) (concat nnultimate-address "Ultimate.cgi") @@ -299,7 +301,7 @@ (furls (list (concat nnultimate-address (format furl sid)))) contents forum-contents furl-fetched a subject href garticles topic tinfo old-max inc parse) - (with-temp-buffer + (mm-with-unibyte-buffer (while furls (erase-buffer) (nnweb-insert (pop furls)) @@ -387,7 +389,7 @@ (setq nnultimate-groups-alist nil) (let ((file (expand-file-name "groups" nnultimate-directory))) (when (file-exists-p file) - (with-temp-buffer + (mm-with-unibyte-buffer (insert-file-contents file) (goto-char (point-min)) (setq nnultimate-groups-alist (read (current-buffer))))))) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index b3327da..1695f1e 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -111,9 +111,10 @@ and `altavista'.") (set-buffer nntp-server-buffer) (erase-buffer) (let (article header) - (while (setq article (pop articles)) - (when (setq header (cadr (assq article nnweb-articles))) - (nnheader-insert-nov header))) + (mm-with-unibyte-current-buffer + (while (setq article (pop articles)) + (when (setq header (cadr (assq article nnweb-articles))) + (nnheader-insert-nov header)))) 'nov))) (deffoo nnweb-request-scan (&optional group server) @@ -167,7 +168,8 @@ and `altavista'.") (let* ((header (cadr (assq article nnweb-articles))) (url (and header (mail-header-xref header)))) (when (or (and url - (nnweb-fetch-url url)) + (mm-with-unibyte-current-buffer + (nnweb-fetch-url url))) (and (stringp article) (nnweb-definition 'id t) (let ((fetch (nnweb-definition 'id)) @@ -176,8 +178,9 @@ and `altavista'.") (setq art (match-string 1 article))) (and fetch art - (nnweb-fetch-url - (format fetch article)))))) + (mm-with-unibyte-current-buffer + (nnweb-fetch-url + (format fetch article))))))) (unless nnheader-callback-function (funcall (nnweb-definition 'article)) (nnweb-decode-entities)) @@ -229,7 +232,7 @@ and `altavista'.") (defun nnweb-read-overview (group) "Read the overview of GROUP and build the map." (when (file-exists-p (nnweb-overview-file group)) - (with-temp-buffer + (mm-with-unibyte-buffer (nnheader-insert-file-contents (nnweb-overview-file group)) (goto-char (point-min)) (let (header) @@ -297,22 +300,34 @@ and `altavista'.") (unless (gnus-buffer-live-p nnweb-buffer) (setq nnweb-buffer (save-excursion - (nnheader-set-temp-buffer - (format " *nnweb %s %s %s*" nnweb-type nnweb-search server)))))) + (let ((multibyte (default-value 'enable-multibyte-characters))) + (unwind-protect + (progn + (setq-default enable-multibyte-characters nil) + (nnheader-set-temp-buffer + (format " *nnweb %s %s %s*" + nnweb-type nnweb-search server))) + (setq-default enable-multibyte-characters multibyte)) + (current-buffer)))))) (defun nnweb-fetch-url (url) - (save-excursion - (if (not nnheader-callback-function) - (let ((buf (current-buffer))) - (save-excursion - (set-buffer nnweb-buffer) + (let (buf) + (save-excursion + (if (not nnheader-callback-function) + (progn + (with-temp-buffer + (mm-enable-multibyte) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (default-process-coding-system 'binary)) + (nnweb-insert url)) + (setq buf (buffer-string))) (erase-buffer) - (url-insert-file-contents url) - (copy-to-buffer buf (point-min) (point-max)) - t)) - (nnweb-url-retrieve-asynch - url 'nnweb-callback (current-buffer) nnheader-callback-function) - t))) + (insert buf) + t) + (nnweb-url-retrieve-asynch + url 'nnweb-callback (current-buffer) nnheader-callback-function) + t)))) (defun nnweb-callback (buffer callback) (when (gnus-buffer-live-p url-working-buffer) @@ -366,18 +381,20 @@ and `altavista'.") (dolist (row (nth 2 (car (nth 2 table)))) (setq a (nnweb-parse-find 'a row) url (cdr (assq 'href (nth 1 a))) - text (nnweb-text row)) + text (nreverse (nnweb-text row))) (when a - (setq subject (nth 2 text) - group (nth 4 text) - date (nth 5 text) - from (nth 6 text)) - (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date) - (setq date (format "%s %s %s" - (car (rassq (string-to-number - (match-string 2 date)) - parse-time-months)) - (match-string 3 date) (match-string 1 date))) + (setq subject (nth 4 text) + group (nth 2 text) + date (nth 1 text) + from (nth 0 text)) + (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date) + (setq date (format "%s %s 00:00:00 %s" + (car (rassq (string-to-number + (match-string 2 date)) + parse-time-months)) + (match-string 3 date) + (match-string 1 date))) + (setq date "Jan 1 00:00:00 0000")) (incf i) (setq url (concat url "&fmt=text")) (unless (nnweb-get-hashtb url) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 1a08b3c..3344753 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -338,9 +338,16 @@ Valid ENCODINGs are \"B\" and \"Q\". If your Emacs implementation can't decode CHARSET, it returns nil." (if (stringp charset) (setq charset (intern (downcase charset)))) - (if (or (not charset) (memq charset mail-parse-ignored-charsets)) + (if (or (not charset) + (eq 'gnus-all mail-parse-ignored-charsets) + (memq 'gnus-all mail-parse-ignored-charsets) + (memq charset mail-parse-ignored-charsets)) (setq charset mail-parse-charset)) (let ((cs (mm-charset-to-coding-system charset))) + (if (and (not cs) charset + (listp mail-parse-ignored-charsets) + (memq 'gnus-unknown mail-parse-ignored-charsets)) + (setq cs (mm-charset-to-coding-system mail-parse-charset))) (when cs (when (and (eq cs 'ascii) mail-parse-charset)