From d20e4b39f3e68ed15b71811924c11de4084d5371 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 4 May 2003 14:00:00 +0000 Subject: [PATCH] Synch to Gnus 200305041100. --- lisp/ChangeLog | 125 +++++++++++++ lisp/gnus-art.el | 2 +- lisp/gnus-cite.el | 1 + lisp/gnus-ems.el | 30 ++-- lisp/gnus-int.el | 3 +- lisp/gnus-util.el | 14 +- lisp/gnus.el | 2 +- lisp/mail-source.el | 13 +- lisp/message.el | 47 ++--- lisp/mm-bodies.el | 89 ++++------ lisp/mm-encode.el | 30 ++-- lisp/mm-extern.el | 8 +- lisp/mm-util.el | 119 +++---------- lisp/mml-smime.el | 1 + lisp/mml1991.el | 4 +- lisp/mml2015.el | 5 +- lisp/nnheader.el | 1 + lisp/nntp.el | 4 + lisp/pop3.el | 1 + lisp/rfc2047.el | 472 +++++++++++++++++++++++++++++--------------------- lisp/rfc2231.el | 3 + lisp/sieve-manage.el | 3 +- lisp/sieve.el | 14 +- lisp/smime.el | 2 + texi/ChangeLog | 5 + texi/gnus-ja.texi | 32 +++- texi/gnus.texi | 25 ++- 27 files changed, 616 insertions(+), 439 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 18436da..c656d29 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,128 @@ +2003-05-04 Dave Love + + * rfc2047.el (with-syntax-table): Define if necessary. + (rfc2047-syntax-table): Fix last change for XEmacs. + +2003-05-03 Jesper Harder + + * gnus.el: Don't test for `mm-guess-mime-charset'. + + * mm-util.el (mm-guess-mime-charset): Remove. Not used any more. + + * gnus.el (gnus-default-charset): Set default value to + `undecided'. + + * gnus-art.el (article-decode-charset): Don't supply 4th arg to + mm-decode-body. + + * mm-bodies.el (mm-decode-coding-region-safely): Remove. + (mm-decode-body): Don't use mm-decode-coding-region-safely. + +2003-05-03 Vasily Korytov (tiny change) + + * gnus-util.el (gnus-multiple-choice): Add ", ?". + +2003-05-03 Dave Love + + * rfc2047.el (rfc2047-syntax-table): Don't call make-char-table + with 2 args. + (rfc2047-decode-string): Don't set the buffer multibyte before + calling buffer-string. + + * mm-encode.el (mm-long-lines-p): Autoload. + (mm-encode-content-transfer-encoding): Doc fix. Don't make buffer + unibyte. Signal error on unknown encoding. + (mm-encode-buffer, mm-qp-or-base64): Doc fix. + + * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): New. + Callers of gnus- versions changed to use them. + (rfc2047-header-encoding-alist): Add `address-mime' part. Doc + fixes. + (rfc2047-encoding-type): New. + (rfc2047-encode-message-header): Use mm-charset-to-coding-system. + Don't include header name field in encoding. Add `address-mime' + case and bind rfc2047-encoding-type for `mime' case. + (rfc2047-encodable-p): Deleted. + (rfc2047-syntax-table): New. + (rfc2047-encode-region, rfc2047-encode): Rewritten to take account + of rfc2047 rules with respect to rfc2822 tokens and to do encoding + in place rather than by passing strings. + (rfc2047-encode-string): Doc fix. + (rfc2047-q-encode-region): Don't use + mm-with-unibyte-current-buffer. + (rfc2047-encoded-word-regexp): eval-and-compile. + (rfc2047-decode-region): Avoid concatenation in loop. + (rfc2047-parse-and-decode): Remove useless disjunction. + +2003-05-02 Dave Love + + * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode): Use + mm-with-unibyte-current-buffer. + (ietf-drums, gnus-util): don't require. + + * sieve.el (sieve-manage-mode-menu): Define before use. + + * mml-smime.el (message-narrow-to-headers): Autoload. + + * mm-util.el (mm-coding-system-p): Don't override nil from + coding-system-p. + (mm-mule4-p, mm-disable-multibyte-mule4) + (mm-with-unibyte-current-buffer-mule4): Deleted. + (mm-multibyte-p): Use defun, not defalias. + (mm-make-temp-file): Moved to group at top of file. + (mm-point-at-eol, mm-point-at-bol): New. + + * gnus-cite.el (gnus-art): Require. + + * gnus-ems.el (gnus-get-buffer-create) + (nnheader-find-etc-directory, message-text-with-property): + Autoload. + (gnus-tmp-unread, gnus-tmp-replied, gnus-tmp-score-char) + (gnus-tmp-indentation, gnus-tmp-opening-bracket, gnus-tmp-lines) + (gnus-tmp-name, gnus-tmp-closing-bracket, gnus-tmp-subject-or-nil) + (gnus-check-before-posting): Only defvar when compiling. + + * gnus-int.el (gnus-agent-expire): Autoload, don't defun. + + * gnus-util.el (rmail-default-rmail-file, mm-text-coding-system): + Defvar when compiling. + (gnus-output-to-rmail): Require mm-util. + + * mail-source.el (mail-source-callback): Use mm-make-temp-file. + (mail-source-make-complex-temp-name): Deleted. + + * message.el (message-use-idna): Use mm-coding-system-p. + (message-tokenize-header, message-make-organization) + (message-make-from): Use with-temp-buffer. + (message-set-work-buffer): Deleted. + (message-fill-paragraph): Use `if' not `and' for compiler warning. + (message-check-news-header-syntax): Remove useless lambda. + (message-forward-make-body): Use mm-disable-multibyte, + mm-with-unibyte-current-buffer, mm-enable-multibyte. + (message-replace-chars-in-string): Deleted. + + * mm-extern.el (mm-extern-local-file): Use mm-disable-multibyte. + (mm-extern-url): Use mm-with-unibyte-current-buffer, + mm-disable-multibyte. + (mm-extern-anon-ftp): Use mm-disable-multibyte. + + * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt): Use + mm-with-unibyte-current-buffer. + + * mml2015.el (mml): Require. + (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt): Use + mm-with-unibyte-current-buffer. + + * nnheader.el (gnus-util): Require. + + * nntp.el (format-spec, format-spec-make, open-tls-stream): + Autoload. + + * rfc2231.el (mail-header-remove-comments, mm-encode-body) + (mail-header-remove-whitespace): Autoload. + + * sieve-manage.el (starttls-negotiate): Autoload. + 2003-05-01 Lars Magne Ingebrigtsen * nnrss.el (nnrss-find-rss-via-syndic8): Indent. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 9c5399e..27dd39a 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2251,7 +2251,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte)))) - (car ctl) prompt)))))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 31ee34a..b7d5158 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -31,6 +31,7 @@ (require 'gnus) (require 'gnus-range) +(require 'gnus-art) (require 'message) ; for message-cite-prefix-regexp ;;; Customization: diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index aa535b4..660e057 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -46,13 +46,18 @@ (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") (autoload 'gnus-xmas-redefine "gnus-xmas") - (autoload 'appt-select-lowest-window "appt")) + (autoload 'appt-select-lowest-window "appt") + (autoload 'gnus-get-buffer-create "gnus") + (autoload 'nnheader-find-etc-directory "nnheader")) (if (or (featurep 'xemacs) (>= emacs-major-version 21)) (autoload 'smiley-region "smiley") (autoload 'smiley-region "smiley-mule")) +;; Fixme: shouldn't require message +(autoload 'message-text-with-property "message") + (defun gnus-kill-all-overlays () "Delete all overlays in the current buffer." (let* ((overlayss (overlay-lists)) @@ -75,16 +80,19 @@ (defvar gnus-mouse-face-prop 'mouse-face "Property used for highlighting mouse regions."))) -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) -(defvar gnus-check-before-posting) +(eval-when-compile + (defvar gnus-tmp-unread) + (defvar gnus-tmp-replied) + (defvar gnus-tmp-score-char) + (defvar gnus-tmp-indentation) + (defvar gnus-tmp-opening-bracket) + (defvar gnus-tmp-lines) + (defvar gnus-tmp-name) + (defvar gnus-tmp-closing-bracket) + (defvar gnus-tmp-subject-or-nil) + (defvar gnus-check-before-posting) + (defvar gnus-mouse-face) + (defvar gnus-group-buffer)) (defun gnus-ems-redefine () (cond diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 835cb91..64b603e 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -33,8 +33,7 @@ (require 'message) (require 'gnus-range) -(eval-when-compile - (defun gnus-agent-expire (&optional a b c))) +(autoload 'gnus-agent-expire "gnus-agent") (defcustom gnus-open-server-hook nil "Hook called just before opening connection to the news server." diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 0033120..46a7094 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -30,6 +30,9 @@ ;; used by Gnus and may be used by any other package without loading ;; Gnus first. +;; [Unfortunately, it does depend on other parts of Gnus, e.g. the +;; autoloads below...] + ;;; Code: (eval-when-compile @@ -846,10 +849,14 @@ with potentially long computations." ;;; Functions for saving to babyl/mail files. -(defvar rmail-default-rmail-file) +(eval-when-compile + (defvar rmail-default-rmail-file) + (defvar mm-text-coding-system)) + (defun gnus-output-to-rmail (filename &optional ask) "Append the current article to an Rmail file named FILENAME." (require 'rmail) + (require 'mm-util) ;; Most of these codes are borrowed from rmailout.el. (setq filename (expand-file-name filename)) (setq rmail-default-rmail-file filename) @@ -1347,8 +1354,9 @@ CHOICE is a list of the choice char and help message at IDX." (while (not tchar) (message "%s (%s): " prompt - (mapconcat (lambda (s) (char-to-string (car s))) - choice ", ")) + (concat + (mapconcat (lambda (s) (char-to-string (car s))) + choice ", ") ", ?")) (setq tchar (read-char)) (when (not (assq tchar choice)) (setq tchar nil) diff --git a/lisp/gnus.el b/lisp/gnus.el index 6e16028..d8daefe 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -2160,7 +2160,7 @@ You also need to enable `gnus-agent' for this to have any affect." :group 'gnus-agent :type 'boolean) -(defcustom gnus-default-charset 'iso-8859-1 +(defcustom gnus-default-charset 'undecided "Default charset assumed to be used when viewing non-ASCII characters. This variable is overridden on a group-to-group basis by the `gnus-group-charset-alist' variable and is only used on groups not diff --git a/lisp/mail-source.el b/lisp/mail-source.el index e84f79c..11e7f3a 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -512,17 +512,6 @@ Return the number of files that were found." (error "Cannot get new mail")) 0))))))))) -(eval-and-compile - (if (fboundp 'make-temp-file) - (defalias 'mail-source-make-complex-temp-name 'make-temp-file) - (defun mail-source-make-complex-temp-name (prefix) - (let ((newname (make-temp-name prefix)) - (newprefix prefix)) - (while (file-exists-p newname) - (setq newprefix (concat newprefix "x")) - (setq newname (make-temp-name newprefix))) - newname)))) - (defun mail-source-delete-old-incoming (&optional age confirm) "Remove incoming files older than AGE days. If CONFIRM is non-nil, ask for confirmation before removing a file." @@ -567,7 +556,7 @@ Pass INFO on to CALLBACK." (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) (let ((incoming - (mail-source-make-complex-temp-name + (mm-make-temp-file (expand-file-name mail-source-incoming-file-prefix mail-source-directory)))) diff --git a/lisp/message.el b/lisp/message.el index 25355f8..df307d8 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -227,6 +227,8 @@ few false positives here." :group 'message-various :type 'regexp) +;; Fixme: Why are all these things autoloaded? + ;;; marking inserted text ;;;###autoload @@ -1521,8 +1523,7 @@ no, only reply back to the author." (defcustom message-use-idna (and (condition-case nil (require 'idna) (file-error)) - (fboundp 'coding-system-p) - (coding-system-p 'utf-8) + (mm-coding-system-p 'utf-8) 'ask) "Whether to encode non-ASCII in domain names into ASCII according to IDNA." :group 'message-headers @@ -1728,8 +1729,8 @@ is used by default." (beg 1) (first t) quoted elems paren) - (save-excursion - (message-set-work-buffer) + (with-temp-buffer + (set-buffer-multibyte t) (insert header) (goto-char (point-min)) (while (not (eobp)) @@ -1823,14 +1824,6 @@ is used by default." (mail-narrow-to-head) (message-fetch-field header)))) -(defun message-set-work-buffer () - (if (get-buffer " *message work*") - (progn - (set-buffer " *message work*") - (erase-buffer)) - (set-buffer (get-buffer-create " *message work*")) - (kill-all-local-variables))) - (defun message-functionp (form) "Return non-nil if FORM is funcallable." (or (and (symbolp form) (fboundp form)) @@ -2986,7 +2979,7 @@ Prefix arg means justify as well." (defun message-fill-paragraph (&optional arg) "Like `fill-paragraph'." (interactive (list (if current-prefix-arg 'full))) - (if (and (boundp 'filladapt-mode) filladapt-mode) + (if (if (boundp 'filladapt-mode) filladapt-mode) nil (message-newline-and-reformat arg t) t)) @@ -4484,7 +4477,7 @@ Otherwise, generate and save a value for `canlock-password' first." (length (setq to (completing-read "Followups to (default: no Followup-To header) " - (mapcar (lambda (g) (list g)) + (mapcar #'list (cons "poster" (message-tokenize-header newsgroups))))))))) @@ -5023,8 +5016,8 @@ If NOW, use that time instead." (if (message-functionp message-user-organization) (funcall message-user-organization) message-user-organization)))) - (save-excursion - (message-set-work-buffer) + (with-temp-buffer + (set-buffer-multibyte t) (cond ((stringp organization) (insert organization)) ((and (eq t organization) @@ -5108,8 +5101,8 @@ If NOW, use that time instead." (user-full-name)))) (when (string= fullname "&") (setq fullname (user-login-name))) - (save-excursion - (message-set-work-buffer) + (with-temp-buffer + (set-buffer-multibyte t) (cond ((or (null style) (equal fullname "")) @@ -7166,24 +7159,6 @@ regexp varstr." (set-alist 'mime-edit-message-inserter-alist 'message-mode (function message-mime-insert-article)) -;;; Miscellaneous functions - -;; stolen (and renamed) from nnheader.el -(static-if (fboundp 'subst-char-in-string) - (defsubst message-replace-chars-in-string (string from to) - (subst-char-in-string from to string)) - (defun message-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string))) - ;;; ;;; MIME functions ;;; diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index ee14049..c0686e2 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -234,66 +234,41 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (while (search-forward "\r\n" nil t) (replace-match "\n" t t))))) -(defun mm-decode-body (charset &optional encoding type force) +(defun mm-decode-body (charset &optional encoding type) "Decode the current article that has been encoded with ENCODING. The characters in CHARSET should then be decoded. If FORCE is non-nil use the supplied charset unconditionally." - (let ((charset-supplied charset)) - (when (stringp charset) - (setq charset (intern (downcase charset)))) - (when (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 - charset-supplied nil)) - (save-excursion - (when encoding - (mm-decode-content-transfer-encoding encoding type)) - (when (featurep 'mule) - (let ((coding-system (mm-charset-to-coding-system charset))) - (if (and (not coding-system) - (listp mail-parse-ignored-charsets) - (memq 'gnus-unknown mail-parse-ignored-charsets)) - (setq coding-system - (mm-charset-to-coding-system mail-parse-charset))) - (when (and charset coding-system - ;; buffer-file-coding-system - ;;Article buffer is nil coding system - ;;in XEmacs - (mm-multibyte-p) - (or (not (eq coding-system 'ascii)) - (setq coding-system mail-parse-charset)) - (not (eq coding-system 'gnus-decoded))) - (if (or force - ;; If a charset was supplied, then use the - ;; supplied charset unconditionally. - charset-supplied) - (mm-decode-coding-region (point-min) (point-max) - coding-system) - ;; Otherwise allow Emacs to auto-detect the charset. - (mm-decode-coding-region-safely (point-min) (point-max) - coding-system))) - (setq buffer-file-coding-system - (if (boundp 'last-coding-system-used) - (symbol-value 'last-coding-system-used) - coding-system))))))) - -(defun mm-decode-coding-region-safely (start end coding-system) - "Decode region between START and END with CODING-SYSTEM. -If CODING-SYSTEM is not a valid coding system for the text, let Emacs -decide which coding system to use." - (let* ((orig (buffer-substring start end)) - charsets) - (save-restriction - (narrow-to-region start end) - (mm-decode-coding-region (point-min) (point-max) coding-system) - (setq charsets (find-charset-region (point-min) (point-max))) - (when (or (memq 'eight-bit-control charsets) - (memq 'eight-bit-graphic charsets)) - (delete-region (point-min) (point-max)) - (insert orig) - (mm-decode-coding-region (point-min) (point-max) 'undecided))))) + (when (stringp charset) + (setq charset (intern (downcase charset)))) + (when (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 ((coding-system (mm-charset-to-coding-system charset))) + (if (and (not coding-system) + (listp mail-parse-ignored-charsets) + (memq 'gnus-unknown mail-parse-ignored-charsets)) + (setq coding-system + (mm-charset-to-coding-system mail-parse-charset))) + (when (and charset coding-system + ;; buffer-file-coding-system + ;;Article buffer is nil coding system + ;;in XEmacs + (mm-multibyte-p) + (or (not (eq coding-system 'ascii)) + (setq coding-system mail-parse-charset)) + (not (eq coding-system 'gnus-decoded))) + (mm-decode-coding-region (point-min) (point-max) + coding-system)) + (setq buffer-file-coding-system + (if (boundp 'last-coding-system-used) + (symbol-value 'last-coding-system-used) + coding-system)))))) (defun mm-decode-string (string charset) "Decode STRING with CHARSET." diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 770d106..cb17414 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -29,7 +29,8 @@ (require 'mail-parse) (require 'gnus-mailcap) (eval-and-compile - (autoload 'mm-body-7-or-8 "mm-bodies")) + (autoload 'mm-body-7-or-8 "mm-bodies") + (autoload 'mm-long-lines-p "mm-bodies")) (defcustom mm-content-transfer-encoding-defaults '(("text/x-patch" 8bit) @@ -85,7 +86,7 @@ This variable should never be set directly, but bound before a call to (mailcap-extension-to-mime (match-string 0 file)))) (defun mm-safer-encoding (encoding) - "Return a safer but similar encoding." + "Return an encoding similar to ENCODING but safer than it." (cond ((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable) ;; The remaining encodings are binary and base64 (and perhaps some @@ -93,33 +94,38 @@ This variable should never be set directly, but bound before a call to (t 'base64))) (defun mm-encode-content-transfer-encoding (encoding &optional type) + "Encode the current buffer with ENCODING for MIME type TYPE. +ENCODING can be: nil (do nothing); one of `quoted-printable', `base64'; +`7bit', `8bit' or `binary' (all do nothing); a function to do the encoding." (cond ((eq encoding 'quoted-printable) - (mm-with-unibyte-current-buffer-mule4 - (quoted-printable-encode-region (point-min) (point-max) t))) + ;; This used to try to make a multibyte buffer unibyte. That's + ;; completely wrong, since you'd get QP-encoded emacs-mule. If + ;; this gets run on multibyte text it's an error that needs + ;; fixing, and the encoding function will signal an error. + ;; Likewise base64 below. + (quoted-printable-encode-region (point-min) (point-max) t)) ((eq encoding 'base64) (when (equal type "text/plain") (goto-char (point-min)) (while (search-forward "\n" nil t) (replace-match "\r\n" t t))) - (condition-case error - (base64-encode-region (point-min) (point-max)) - (error - (message "Error while decoding: %s" error) - nil))) + (base64-encode-region (point-min) (point-max))) ((memq encoding '(7bit 8bit binary)) ;; Do nothing. ) ((null encoding) ;; Do nothing. ) + ;; Fixme: Ignoring errors here looks bogus. ((functionp encoding) (ignore-errors (funcall encoding (point-min) (point-max)))) (t - (message "Unknown encoding %s; treating it as 8bit" encoding)))) + (error "Unknown encoding %s" encoding)))) (defun mm-encode-buffer (type) - "Encode the buffer which contains data of TYPE. + "Encode the buffer which contains data of MIME type TYPE. +TYPE is a string or a list of the components. The encoding used is returned." (let* ((mime-type (if (stringp type) type (car type))) (encoding @@ -165,6 +171,8 @@ The encoding used is returned." (pop rules))))) (defun mm-qp-or-base64 () + "Return the type with which to encode the buffer. +This is either `base64' or `quoted-printable'." (if (equal mm-use-ultra-safe-encoding '(sign . "pgp")) ;; perhaps not always accurate? 'quoted-printable diff --git a/lisp/mm-extern.el b/lisp/mm-extern.el index 2627397..b063ee8 100644 --- a/lisp/mm-extern.el +++ b/lisp/mm-extern.el @@ -49,7 +49,7 @@ (coding-system-for-read mm-binary-coding-system)) (unless name (error "The filename is not specified")) - (mm-disable-multibyte-mule4) + (mm-disable-multibyte) (if (file-exists-p name) (mm-insert-file-contents name nil nil nil nil t) (error (format "File %s is gone" name))))) @@ -61,9 +61,9 @@ (coding-system-for-read mm-binary-coding-system)) (unless url (error "URL is not specified")) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (mm-url-insert-file-contents url)) - (mm-disable-multibyte-mule4) + (mm-disable-multibyte) (setq buffer-file-name name))) (defun mm-extern-anon-ftp (handle) @@ -79,7 +79,7 @@ (coding-system-for-read mm-binary-coding-system)) (unless name (error "The filename is not specified")) - (mm-disable-multibyte-mule4) + (mm-disable-multibyte) (mm-insert-file-contents path nil nil nil nil t))) (defun mm-extern-ftp (handle) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 08d9284..aee2c9e 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -75,6 +75,16 @@ (string-make-unibyte . identity) (string-as-multibyte . identity) (multibyte-string-p . ignore) + ;; It is not a MIME function, but some MIME functions use it. + (make-temp-file . (lambda (prefix &optional dir-flag) + (let ((file (expand-file-name + (make-temp-name prefix) + (if (fboundp 'temp-directory) + (temp-directory) + temporary-file-directory)))) + (if dir-flag + (make-directory file)) + file))) (insert-byte . insert-char) (multibyte-char-to-unibyte . identity)))) @@ -108,8 +118,9 @@ (defun mm-coding-system-p (sym) "Return non-nil if SYM is a coding system." - (or (and (fboundp 'coding-system-p) (coding-system-p sym)) - (memq sym (mm-get-coding-system-list)))) + (if (fboundp 'coding-system-p) + (coding-system-p sym) + (memq sym (mm-get-coding-system-list)))) (defvar mm-charset-synonym-alist `( @@ -122,8 +133,8 @@ ;; Apparently not defined in Emacs 20, but is a valid MIME name. ,@(unless (mm-coding-system-p 'gb2312) '((gb2312 . cn-gb-2312))) - ;; ISO-8859-15 is very similar to ISO-8859-1. - ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it. + ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_! + ,@(unless (mm-coding-system-p 'iso-8859-15) '((iso-8859-15 . iso-8859-1))) ;; Windows-1252 is actually a superset of Latin-1. See also ;; `gnus-article-dumbquotes-map'. @@ -383,12 +394,7 @@ used as the line break code type of the coding system." (boundp 'default-enable-multibyte-characters) default-enable-multibyte-characters (fboundp 'set-buffer-multibyte)) - "Emacs mule.") - - (defvar mm-mule4-p (and mm-emacs-mule - (fboundp 'charsetp) - (not (charsetp 'eight-bit-control))) - "Mule version 4.") + "True in Emacs with Mule.") (if mm-emacs-mule (defun mm-enable-multibyte () @@ -403,27 +409,14 @@ non-nil. This is a no-op in XEmacs." "Unset the multibyte flag of in the current buffer. This is a no-op in XEmacs." (set-buffer-multibyte nil)) - (defalias 'mm-disable-multibyte 'ignore)) - - (if mm-mule4-p - (defun mm-enable-multibyte-mule4 () - "Enable multibyte in the current buffer. -Only used in Emacs Mule 4." - (set-buffer-multibyte t)) - (defalias 'mm-enable-multibyte-mule4 'ignore)) - - (if mm-mule4-p - (defun mm-disable-multibyte-mule4 () - "Disable multibyte in the current buffer. -Only used in Emacs Mule 4." - (set-buffer-multibyte nil)) - (defalias 'mm-disable-multibyte-mule4 'ignore))) + (defalias 'mm-disable-multibyte 'ignore))) (defun mm-preferred-coding-system (charset) ;; A typo in some Emacs versions. (or (get-charset-property charset 'preferred-coding-system) (get-charset-property charset 'prefered-coding-system))) +;; Mule charsets shouldn't be used. (defsubst mm-guess-charset () "Guess Mule charset from the language environment." (or @@ -454,7 +447,7 @@ If the charset is `composition', return the actual one." (setq charset 'ascii) ;; charset-after is fake in some Emacsen. (setq charset (and (fboundp 'char-charset) (char-charset char))) - (if (eq charset 'composition) + (if (eq charset 'composition) ; Mule 4 (let ((p (or pos (point)))) (cadr (find-charset-region p (1+ p)))) (if (and charset (not (memq charset '(ascii eight-bit-control @@ -490,13 +483,13 @@ If the charset is `composition', return the actual one." (setq result (cons head result))) (nreverse result))) -(if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters)) - (defalias 'mm-multibyte-p - (lambda () - "Say whether multibyte is enabled in the current buffer." - enable-multibyte-characters)) - (defalias 'mm-multibyte-p (lambda () (featurep 'mule)))) +(eval-and-compile + (if (and (not (featurep 'xemacs)) + (boundp 'enable-multibyte-characters)) + (defun mm-multibyte-p () + "Non-nil if multibyte is enabled in the current buffer." + enable-multibyte-characters) + (defun mm-multibyte-p () (featurep 'mule)))) (defun mm-iso-8859-x-to-15-region (&optional b e) (if (fboundp 'char-charset) @@ -595,7 +588,7 @@ Equivalent to `progn' in XEmacs" (let ((multibyte (make-symbol "multibyte")) (buffer (make-symbol "buffer"))) `(if mm-emacs-mule - (let ((,multibyte enable-multibyte-characters) + (let ((,multibyte enable-multibyte-characters) (,buffer (current-buffer))) (unwind-protect (let (default-enable-multibyte-characters) @@ -608,25 +601,6 @@ Equivalent to `progn' in XEmacs" (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) -(defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms) - "Evaluate FORMS there like `progn' in current buffer. -Mule4 only." - (let ((multibyte (make-symbol "multibyte")) - (buffer (make-symbol "buffer"))) - `(if mm-mule4-p - (let ((,multibyte enable-multibyte-characters) - (,buffer (current-buffer))) - (unwind-protect - (let (default-enable-multibyte-characters) - (set-buffer-multibyte nil) - ,@forms) - (set-buffer ,buffer) - (set-buffer-multibyte ,multibyte))) - (let (default-enable-multibyte-characters) - ,@forms)))) -(put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0) -(put 'mm-with-unibyte-current-buffer-mule4 'edebug-form-spec '(body)) - (defmacro mm-with-unibyte (&rest forms) "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ." `(let (default-enable-multibyte-characters) @@ -771,6 +745,7 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (push dir result)) (push path result)))) +;; Fixme: This doesn't look useful where it's used. (if (fboundp 'detect-coding-region) (defun mm-detect-coding-region (start end) "Like `detect-coding-region' except returning the best one." @@ -796,44 +771,6 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (let ((cs (mm-detect-coding-region start end))) cs))) -(defun mm-guess-mime-charset () - "Guess the default MIME charset from the language environment." - (let ((language-info - (and (boundp 'current-language-environment) - (assoc current-language-environment - language-info-alist))) - item) - (cond - ((null language-info) - 'iso-8859-1) - ((setq item - (cadr - (or (assq 'coding-priority language-info) - (assq 'coding-system language-info)))) - (if (fboundp 'coding-system-get) - (or (coding-system-get item 'mime-charset) - item) - item)) - ((setq item (car (last (assq 'charset language-info)))) - (if (eq item 'ascii) - 'iso-8859-1 - (mm-mime-charset item))) - (t - 'iso-8859-1)))) - -;; It is not a MIME function, but some MIME functions use it. -(defalias 'mm-make-temp-file - (if (fboundp 'make-temp-file) - 'make-temp-file - (lambda (prefix &optional dir-flag) - (let ((file (expand-file-name - (make-temp-name prefix) - (if (fboundp 'temp-directory) - (temp-directory) - temporary-file-directory)))) - (if dir-flag - (make-directory file)) - file)))) (provide 'mm-util) diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el index bccc8a1..82d13df 100644 --- a/lisp/mml-smime.el +++ b/lisp/mml-smime.el @@ -27,6 +27,7 @@ (require 'smime) (require 'mm-decode) +(autoload 'message-narrow-to-headers "message") (defun mml-smime-sign (cont) (when (null smime-keys) diff --git a/lisp/mml1991.el b/lisp/mml1991.el index 741cfe2..a687d75 100644 --- a/lisp/mml1991.el +++ b/lisp/mml1991.el @@ -104,7 +104,7 @@ (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (with-temp-buffer (setq cipher (current-buffer)) (insert-buffer-substring text) @@ -178,7 +178,7 @@ (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (with-temp-buffer (flet ((gpg-encrypt-func (sign plaintext ciphertext result recipients &optional diff --git a/lisp/mml2015.el b/lisp/mml2015.el index ef2fe9f..b7cdbcb 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -32,6 +32,7 @@ (eval-when-compile (require 'gnus-clfns)) (require 'mm-decode) (require 'mm-util) +(require 'mml) (defvar mml2015-use (or (progn @@ -330,7 +331,7 @@ (or (y-or-n-p "Sign the message? ") 'not)))) 'never))) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (mc-encrypt-generic (or (message-options-get 'message-recipients) (message-options-set 'message-recipients @@ -582,7 +583,7 @@ (funcall mml-boundary-function (incf mml-multipart-number))) (text (current-buffer)) cipher) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (with-temp-buffer ;; set up a function to call the correct gpg encrypt routine ;; with the right arguments. (FIXME: this should be done diff --git a/lisp/nnheader.el b/lisp/nnheader.el index f919c03..afb1824 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -39,6 +39,7 @@ ;;(eval-when-compile (require 'gnus-util)) (require 'mail-utils) +(require 'gnus-util) ;; Reduce the required value of `recursive-load-depth-limit' for Emacs 21. (require 'pces) diff --git a/lisp/nntp.el b/lisp/nntp.el index 62a6b16..bbe7e7d 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1208,6 +1208,10 @@ password contained in '~/.nntp-authinfo'." (open-network-stream-as-binary "nntpd" buffer nntp-address nntp-port-number)) +(autoload 'format-spec "format") +(autoload 'format-spec-make "format") +(autoload 'open-tls-stream "tls") + (defun nntp-open-ssl-stream (buffer) (let* ((process-connection-type nil) (proc (as-binary-process diff --git a/lisp/pop3.el b/lisp/pop3.el index 2b1373e..510884f 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -705,6 +705,7 @@ If msgno is invalid, return nil. Otherwise, return a string." (set-buffer (process-buffer process)) (goto-char start) (while (not (re-search-forward "^\\.\r\n" nil t)) + ;; Fixme: Shouldn't depend on nnheader. (nnheader-accept-process-output process) (goto-char start)) (setq pop3-read-point (point-marker)) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 81005a9..b452e60 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -1,5 +1,5 @@ -;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages +;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -29,23 +29,49 @@ (eval-when-compile (require 'cl) - (defvar message-posting-charset)) + (defvar message-posting-charset) + (unless (fboundp 'with-syntax-table) ; not in Emacs 20 + (defmacro with-syntax-table (table &rest body) + "Evaluate BODY with syntax table of current buffer set to TABLE. +The syntax table of the current buffer is saved, BODY is evaluated, and the +saved table is restored, even in case of an abnormal exit. +Value is what BODY returns." + (let ((old-table (make-symbol "table")) + (old-buffer (make-symbol "buffer"))) + `(let ((,old-table (syntax-table)) + (,old-buffer (current-buffer))) + (unwind-protect + (progn + (set-syntax-table ,table) + ,@body) + (save-current-buffer + (set-buffer ,old-buffer) + (set-syntax-table ,old-table)))))))) (require 'qp) (require 'mm-util) -(require 'ietf-drums) +;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus. (require 'mail-prsvr) (require 'base64) -;; Fixme: Avoid this (for gnus-point-at-...) mm dependence on gnus. -(require 'gnus-util) (autoload 'mm-body-7-or-8 "mm-bodies") +;; Avoid gnus-util for mm- code. +(defalias 'rfc2047-point-at-bol + (if (fboundp 'point-at-bol) + 'point-at-bol + 'line-beginning-position)) + +(defalias 'rfc2047-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position)) + (defvar rfc2047-header-encoding-alist '(("Newsgroups" . nil) ("Followup-To" . nil) ("Message-ID" . nil) ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" . - "-A-Za-z0-9!*+/=_") + address-mime) (t . mime)) "*Header/encoding method alist. The list is traversed sequentially. The keys can either be @@ -55,10 +81,11 @@ The values can be: 1) nil, in which case no encoding is done; 2) `mime', in which case the header will be encoded according to RFC2047; -3) a charset, in which case it will be encoded as that charset; -4) `default', in which case the field will be encoded as the rest - of the article. -5) a string, like `mime', expect for using it as word-chars.") +3) `address-mime', like `mime', but takes account of the rules for address + fields (where quoted strings and comments must be treated separately); +4) a charset, in which case it will be encoded as that charset; +5) `default', in which case the field will be encoded as the rest + of the article.") (defvar rfc2047-charset-encoding-alist '((us-ascii . nil) @@ -128,6 +155,12 @@ quoted-printable and base64 respectively.") (re-search-forward ":[ \t\n]*" nil t) (buffer-substring (point) (point-max))))) +(defvar rfc2047-encoding-type 'address-mime + "The type of encoding done by `rfc2047-encode-region'. +This should be dynamically bound around calls to +`rfc2047-encode-region' to either `mime' or `address-mime'. See +`rfc2047-header-encoding-alist', for definitions.") + (defun rfc2047-encode-message-header () "Encode the message header according to `rfc2047-header-encoding-alist'. Should be called narrowed to the head of the message." @@ -145,11 +178,10 @@ Should be called narrowed to the head of the message." (mm-coding-system-p (car message-posting-charset))) ;; 8 bit must be decoded. - ;; Is message-posting-charset a coding system? (mm-encode-coding-region (point-min) (point-max) - (car message-posting-charset)) - nil) + (mm-charset-to-coding-system + (car message-posting-charset)))) ;; No encoding necessary, but folding is nice (rfc2047-fold-region (save-excursion @@ -168,46 +200,46 @@ Should be called narrowed to the head of the message." (eq (car elem) t)) (setq alist nil method (cdr elem)))) + (goto-char (point-min)) + (re-search-forward "^[^:]+: *" nil t) (cond - ((stringp method) - (rfc2047-encode-region (point-min) (point-max) method)) + ((eq method 'address-mime) + (rfc2047-encode-region (point) (point-max))) ((eq method 'mime) - (rfc2047-encode-region (point-min) (point-max))) + (let (rfc2047-encoding-type) + (rfc2047-encode-region (point) (point-max)))) ((eq method 'default) (if (and (featurep 'mule) (if (boundp 'default-enable-multibyte-characters) default-enable-multibyte-characters) mail-parse-charset) - (mm-encode-coding-region (point-min) (point-max) + (mm-encode-coding-region (point) (point-max) mail-parse-charset))) ;; We get this when CC'ing messsages to newsgroups with - ;; 8-bit names. The group name mail copy just get + ;; 8-bit names. The group name mail copy just got ;; unconditionally encoded. Previously, it would ask ;; whether to encode, which was quite confusing for the ;; user. If the new behaviour is wrong, tell me. I have ;; left the old code commented out below. ;; -- Per Abrahamsen Date: 2001-10-07. + ;; Modified by Dave Love, with the commented-out code changed + ;; in accordance with changes elsewhere. ((null method) - (when (delq 'ascii - (mm-find-charset-region (point-min) (point-max))) - (rfc2047-encode-region (point-min) (point-max)))) -;;; ((null method) -;;; (and (delq 'ascii -;;; (mm-find-charset-region (point-min) -;;; (point-max))) -;;; (if (or (message-options-get -;;; 'rfc2047-encode-message-header-encode-any) -;;; (message-options-set -;;; 'rfc2047-encode-message-header-encode-any -;;; (y-or-n-p -;;; "Some texts are not encoded. Encode anyway?"))) -;;; (rfc2047-encode-region (point-min) (point-max)) -;;; (error "Cannot send unencoded text")))) + (rfc2047-encode-region (point) (point-max))) +;;; ((null method) +;;; (if (or (message-options-get +;;; 'rfc2047-encode-message-header-encode-any) +;;; (message-options-set +;;; 'rfc2047-encode-message-header-encode-any +;;; (y-or-n-p +;;; "Some texts are not encoded. Encode anyway?"))) +;;; (rfc2047-encode-region (point-min) (point-max)) +;;; (error "Cannot send unencoded text"))) ((mm-coding-system-p method) (if (and (featurep 'mule) (if (boundp 'default-enable-multibyte-characters) default-enable-multibyte-characters)) - (mm-encode-coding-region (point-min) (point-max) method))) + (mm-encode-coding-region (point) (point-max) method))) ;; Hm. (t))) (goto-char (point-max))))))) @@ -221,137 +253,183 @@ Should be called narrowed to the head of the message." The buffer may be narrowed." (require 'message) ; for message-posting-charset (let ((charsets - (mapcar - 'mm-mime-charset - (mm-find-charset-region (point-min) (point-max)))) - (cs (list 'us-ascii (car message-posting-charset))) - found) - (while charsets - (unless (memq (pop charsets) cs) - (setq found t))) - found)) - -(defun rfc2047-dissect-region (b e &optional word-chars) - "Dissect the region between B and E into words." - (unless word-chars - ;; Anything except most CTLs, WSP - (setq word-chars "\010\012\014\041-\177")) - (let (mail-parse-mule-charset - words point current - result word) - (save-restriction - (narrow-to-region b e) - (goto-char (point-min)) - (skip-chars-forward "\000-\177") - (while (not (eobp)) - (setq point (point)) - (skip-chars-backward word-chars b) - (unless (eq b (point)) - (push (cons (buffer-substring b (point)) nil) words)) - (setq b (point)) - (goto-char point) - (setq current (mm-charset-after)) - (forward-char 1) - (skip-chars-forward word-chars) - (while (and (not (eobp)) - (eq (mm-charset-after) current)) - (forward-char 1) - (skip-chars-forward word-chars)) - (unless (eq b (point)) - (push (cons (buffer-substring b (point)) current) words)) - (setq b (point)) - (skip-chars-forward "\000-\177")) - (unless (eq b (point)) - (push (cons (buffer-substring b (point)) nil) words))) - ;; merge adjacent words - (setq word (pop words)) - (while word - (if (and (cdr word) - (caar words) - (not (cdar words)) - (not (string-match "[^ \t]" (caar words)))) - (if (eq (cdr (nth 1 words)) (cdr word)) - (progn - (setq word (cons (concat - (car (nth 1 words)) (caar words) - (car word)) - (cdr word))) - (pop words) - (pop words)) - (push (cons (concat (caar words) (car word)) (cdr word)) - result) - (pop words) - (setq word (pop words))) - (push word result) - (setq word (pop words)))) - result)) - -(defun rfc2047-encode-region (b e &optional word-chars) - "Encode all encodable words in region B to E." - (let ((words (rfc2047-dissect-region b e word-chars)) word) - (save-restriction - (narrow-to-region b e) - (delete-region (point-min) (point-max)) - (while (setq word (pop words)) - (if (not (cdr word)) - (insert (car word)) - (rfc2047-fold-region (gnus-point-at-bol) (point)) - (goto-char (point-max)) - (if (> (- (point) (save-restriction - (widen) - (gnus-point-at-bol))) 76) - (insert "\n ")) - ;; Insert blank between encoded words - (if (eq (char-before) ?=) (insert " ")) - (rfc2047-encode (point) - (progn (insert (car word)) (point)) - (cdr word)))) - (rfc2047-fold-region (point-min) (point-max))))) - -(defun rfc2047-encode-string (string &optional word-chars) - "Encode words in STRING." + (mm-find-mime-charset-region (point-min) (point-max)))) + (and charsets (not (equal charsets (list message-posting-charset)))))) + +;; Use this syntax table when parsing into regions that may need +;; encoding. Double quotes are string delimiters, backslash is +;; character quoting, and all other RFC 2822 special characters are +;; treated as punctuation so we can use forward-sexp/forward-word to +;; skip to the end of regions appropriately. Nb. ietf-drums does +;; things differently. +(defconst rfc2047-syntax-table + ;; This is what we should do, but XEmacs doesn't support the optional + ;; arg of `make-syntax-table': +;; (let ((table (make-char-table 'syntax-table '(2)))) + (let ((table (make-syntax-table))) + (map-char-table (lambda (k v) (modify-syntax-entry k "w" table)) table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\( "." table) + (modify-syntax-entry ?\) "." table) + (modify-syntax-entry ?\< "." table) + (modify-syntax-entry ?\> "." table) + (modify-syntax-entry ?\[ "." table) + (modify-syntax-entry ?\] "." table) + (modify-syntax-entry ?: "." table) + (modify-syntax-entry ?\; "." table) + (modify-syntax-entry ?, "." table) + (modify-syntax-entry ?@ "." table) + table)) + +(defun rfc2047-encode-region (b e) + "Encode words in region B to E that need encoding. +By default, the region is treated as containing RFC2822 addresses. +Dynamically bind `rfc2047-encoding-type' to change that." + (save-restriction + (narrow-to-region b e) + (if (eq 'mime rfc2047-encoding-type) + ;; Simple case -- treat as single word. + (progn + (goto-char (point-min)) + ;; Does it need encoding? + (skip-chars-forward "\000-\177" e) + (unless (eobp) + (rfc2047-encode b e))) + ;; `address-mime' case -- take care of quoted words, comments. + (with-syntax-table rfc2047-syntax-table + (let ((start) ; start of current token + end ; end of current token + ;; Whether there's an encoded word before the current + ;; token, either immediately or separated by space. + last-encoded) + (goto-char (point-min)) + (condition-case nil ; in case of unbalanced quotes + ;; Look for rfc2822-style: sequences of atoms, quoted + ;; strings, specials, whitespace. (Specials mustn't be + ;; encoded.) + (while (not (eobp)) + (setq start (point)) + ;; Skip whitespace. + (unless (= 0 (skip-chars-forward " \t")) + (setq start (point))) + (cond + ((not (char-after))) ; eob + ;; else token start + ((eq ?\" (char-syntax (char-after))) + ;; Quoted word. + (forward-sexp) + (setq end (point)) + ;; Does it need encoding? + (goto-char start) + (skip-chars-forward "\000-\177" end) + (if (= end (point)) + (setq last-encoded nil) + ;; It needs encoding. Strip the quotes first, + ;; since encoded words can't occur in quotes. + (goto-char end) + (delete-backward-char 1) + (goto-char start) + (delete-char 1) + (when last-encoded + ;; There was a preceding quoted word. We need + ;; to include any separating whitespace in this + ;; word to avoid it getting lost. + (skip-chars-backward " \t") + ;; A space is needed between the encoded words. + (insert ? ) + (setq start (point) + end (1+ end))) + ;; Adjust the end position for the deleted quotes. + (rfc2047-encode start (- end 2)) + (setq last-encoded t))) ; record that it was encoded + ((eq ?. (char-syntax (char-after))) + ;; Skip other delimiters, but record that they've + ;; potentially separated quoted words. + (forward-char) + (setq last-encoded nil)) + (t ; normal token/whitespace sequence + ;; Find the end. + (forward-word 1) + (skip-chars-backward " \t") + (setq end (point)) + ;; Deal with encoding and leading space as for + ;; quoted words. + (goto-char start) + (skip-chars-forward "\000-\177" end) + (if (= end (point)) + (setq last-encoded nil) + (when last-encoded + (goto-char start) + (skip-chars-backward " \t") + (insert ? ) + (setq start (point) + end (1+ end))) + (rfc2047-encode start end) + (setq last-encoded t))))) + (error (error "Invalid data for rfc2047 encoding: %s" + (buffer-substring b e))))))) + (rfc2047-fold-region b (point)))) + +(defun rfc2047-encode-string (string) + "Encode words in STRING. +By default, the string is treated as containing addresses (see +`rfc2047-special-chars')." (with-temp-buffer (insert string) - (rfc2047-encode-region (point-min) (point-max) word-chars) + (rfc2047-encode-region (point-min) (point-max)) (buffer-string))) -(defun rfc2047-encode (b e charset) - "Encode the word in the region B to E with CHARSET." - (let* ((mime-charset (mm-mime-charset charset)) - (cs (mm-charset-to-coding-system mime-charset)) - (encoding (or (cdr (assq mime-charset +(defun rfc2047-encode (b e) + "Encode the word(s) in the region B to E. +By default, the region is treated as containing addresses (see +`rfc2047-special-chars')." + (let* ((mime-charset (mm-find-mime-charset-region b e)) + (cs (if (> (length mime-charset) 1) + ;; Fixme: Instead of this, try to break region into + ;; parts that can be encoded separately. + (error "Can't rfc2047-encode `%s'" + (buffer-substring b e)) + (setq mime-charset (car mime-charset)) + (mm-charset-to-coding-system mime-charset))) + ;; Fixme: Better, calculate the number of non-ASCII + ;; characters, at least for 8-bit charsets. + (encoding (if (assq mime-charset + rfc2047-charset-encoding-alist) + (cdr (assq mime-charset rfc2047-charset-encoding-alist)) - 'B)) + 'B)) (start (concat "=?" (downcase (symbol-name mime-charset)) "?" (downcase (symbol-name encoding)) "?")) (first t)) - (save-restriction - (narrow-to-region b e) - (when (eq encoding 'B) - ;; break into lines before encoding - (goto-char (point-min)) - (while (not (eobp)) - (goto-char (min (point-max) (+ 15 (point)))) - (unless (eobp) - (insert "\n")))) - (if (and (mm-multibyte-p) - (mm-coding-system-p cs)) - (mm-encode-coding-region (point-min) (point-max) cs)) - (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) - (point-min) (point-max)) - (goto-char (point-min)) - (while (not (eobp)) - (unless first - (insert " ")) - (setq first nil) - (insert start) - (end-of-line) - (insert "?=") - (forward-line 1))))) + (if mime-charset + (save-restriction + (narrow-to-region b e) + (when (eq encoding 'B) + ;; break into lines before encoding + (goto-char (point-min)) + (while (not (eobp)) + (goto-char (min (point-max) (+ 15 (point)))) + (unless (eobp) + (insert ?\n)))) + (if (and (mm-multibyte-p) + (mm-coding-system-p cs)) + (mm-encode-coding-region (point-min) (point-max) cs)) + (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) + (point-min) (point-max)) + (goto-char (point-min)) + (while (not (eobp)) + (unless first + (insert ? )) + (setq first nil) + (insert start) + (end-of-line) + (insert "?=") + (forward-line 1)))))) (defun rfc2047-fold-field () - "Fold the current line." + "Fold the current header field." (save-excursion (save-restriction (rfc2047-narrow-to-field) @@ -367,7 +445,7 @@ The buffer may be narrowed." (first t) (bol (save-restriction (widen) - (gnus-point-at-bol)))) + (rfc2047-point-at-bol)))) (while (not (eobp)) (when (and (or break qword-break) (> (- (point) bol) 76)) @@ -375,7 +453,7 @@ The buffer may be narrowed." (setq break nil qword-break nil) (if (looking-at "[ \t]") - (insert "\n") + (insert ?\n) (insert "\n ")) (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. @@ -414,7 +492,7 @@ The buffer may be narrowed." (setq break nil qword-break nil) (if (looking-at "[ \t]") - (insert "\n") + (insert ?\n) (insert "\n ")) (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. @@ -436,18 +514,19 @@ The buffer may be narrowed." (goto-char (point-min)) (let ((bol (save-restriction (widen) - (gnus-point-at-bol))) - (eol (gnus-point-at-eol))) + (rfc2047-point-at-bol))) + (eol (rfc2047-point-at-eol)) + leading) (forward-line 1) (while (not (eobp)) (if (and (looking-at "[ \t]") - (< (- (gnus-point-at-eol) bol) 76)) + (< (- (rfc2047-point-at-eol) bol) 76)) (delete-region eol (progn (goto-char eol) (skip-chars-forward "\r\n") (point))) - (setq bol (gnus-point-at-bol))) - (setq eol (gnus-point-at-eol)) + (setq bol (rfc2047-point-at-bol))) + (setq eol (rfc2047-point-at-eol)) (forward-line 1))))) (defun rfc2047-b-encode-region (b e) @@ -468,12 +547,10 @@ The buffer may be narrowed." (let ((alist rfc2047-q-encoding-alist) (bol (save-restriction (widen) - (gnus-point-at-bol)))) + (rfc2047-point-at-bol)))) (while alist (when (looking-at (caar alist)) - (mm-with-unibyte-current-buffer-mule4 - (quoted-printable-encode-region - (point-min) (point-max) nil (cdar alist))) + (quoted-printable-encode-region b e nil (cdar alist)) (subst-char-in-region (point-min) (point-max) ? ?_) (setq alist nil)) (pop alist)) @@ -487,15 +564,21 @@ The buffer may be narrowed." (goto-char (min (point-max) (+ 56 bol))) (search-backward "=" (- (point) 2) t) (unless (or (bobp) (eobp)) - (insert "\n") + (insert ?\n) (setq bol (point))))))))) ;;; ;;; Functions for decoding RFC2047 messages ;;; -(defvar rfc2047-encoded-word-regexp - "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]*\\)\\?=") +(eval-and-compile + (defconst rfc2047-encoded-word-regexp + "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\ +\\?\\([!->@-~ +]*\\)\\?=")) + +;; Fixme: This should decode in place, not cons intermediate strings. +;; Also check whether it needs to worry about delimiting fields like +;; encoding. (defun rfc2047-decode-region (start end) "Decode MIME-encoded words in region between START and END." @@ -508,9 +591,10 @@ The buffer may be narrowed." (goto-char (point-min)) ;; Remove whitespace between encoded words. (while (re-search-forward - (concat "\\(" rfc2047-encoded-word-regexp "\\)" - "\\(\n?[ \t]\\)+" - "\\(" rfc2047-encoded-word-regexp "\\)") + (eval-when-compile + (concat "\\(" rfc2047-encoded-word-regexp "\\)" + "\\(\n?[ \t]\\)+" + "\\(" rfc2047-encoded-word-regexp "\\)")) nil t) (delete-region (goto-char (match-end 1)) (match-beginning 6))) ;; Decode the encoded words. @@ -521,8 +605,8 @@ The buffer may be narrowed." (prog1 (match-string 0) (delete-region (match-beginning 0) (match-end 0))))) - ;; Remove newlines between decoded words. Though such things - ;; must not be essentially there. + ;; Remove newlines between decoded words, though such things + ;; essentially must not be there. (save-restriction (narrow-to-region e (point)) (goto-char e) @@ -539,44 +623,45 @@ The buffer may be narrowed." mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-region-safely b (point-max) mail-parse-charset)))))) + (mm-decode-coding-region b (point-max) mail-parse-charset)))))) (defun rfc2047-decode-string (string) "Decode the quoted-printable-encoded STRING and return the results." (let ((m (mm-multibyte-p))) (if (string-match "=\\?" string) (with-temp-buffer + ;; Fixme: This logic is wrong, but seems to be required by + ;; Gnus summary buffer generation. The value of `m' depends + ;; on the current buffer, not global multibyteness or that + ;; of the string. Also the string returned should always be + ;; multibyte in a multibyte session, i.e. the buffer should + ;; be multibyte before `buffer-string' is called. (when m (mm-enable-multibyte)) (insert string) (inline (rfc2047-decode-region (point-min) (point-max))) (buffer-string)) + ;; Fixme: As above, `m' here is inappropriate. (if (and m mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (let* ((decoded (mm-decode-coding-string string mail-parse-charset)) - (charsets (find-charset-string decoded))) - (if (or (memq 'eight-bit-control charsets) - (memq 'eight-bit-graphic charsets)) - (mm-decode-coding-string string 'undecided) - decoded)) - string)))) + (mm-decode-coding-string string mail-parse-charset) + (mm-string-as-multibyte string))))) (defun rfc2047-parse-and-decode (word) "Decode WORD and return it if it is an encoded word. -Return WORD if not." +Return WORD if it is not not an encoded word or if the charset isn't +decodable." (if (not (string-match rfc2047-encoded-word-regexp word)) word - (or - (condition-case nil - (rfc2047-decode - (match-string 1 word) - (upcase (match-string 2 word)) - (match-string 3 word)) - (error word)) - word))) + (condition-case nil + (rfc2047-decode + (match-string 1 word) + (upcase (match-string 2 word)) + (match-string 3 word)) + (error word)))) (defun rfc2047-pad-base64 (string) "Pad STRING to quartets." @@ -609,7 +694,8 @@ If your Emacs implementation can't decode CHARSET, return nil." (when (and (eq cs 'ascii) mail-parse-charset) (setq cs mail-parse-charset)) - (mm-with-unibyte-current-buffer-mule4 + ;; Fixme: What's this for? The following comment makes no sense. -- fx + (mm-with-unibyte-current-buffer ;; In Emacs Mule 4, decoding UTF-8 should be in unibyte mode. (mm-decode-coding-string (cond diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index f0866f8..c4b282b 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -30,6 +30,9 @@ (eval-when-compile (require 'cl)) (require 'ietf-drums) (require 'rfc2047) +(autoload 'mm-encode-body "mm-bodies") +(autoload 'mail-header-remove-whitespace "mail-parse") +(autoload 'mail-header-remove-comments "mail-parse") (defun rfc2231-get-value (ct attribute) "Return the value of ATTRIBUTE from CT." diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el index 8897dd1..bda44dc 100644 --- a/lisp/sieve-manage.el +++ b/lisp/sieve-manage.el @@ -74,7 +74,8 @@ (or (fboundp 'md5) (require 'md5)) (eval-and-compile - (autoload 'starttls-open-stream "starttls")) + (autoload 'starttls-open-stream "starttls") + (autoload 'starttls-negotiate "starttls")) ;; User customizable variables: diff --git a/lisp/sieve.el b/lisp/sieve.el index 8297f57..83dd4f3 100644 --- a/lisp/sieve.el +++ b/lisp/sieve.el @@ -131,6 +131,13 @@ require \"fileinto\"; (define-key sieve-manage-mode-map [(down-mouse-2)] 'sieve-edit-script) (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-manage-mode-menu)) +(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map + "Sieve Menu." + '("Manage Sieve" + ["Edit script" sieve-edit-script t] + ["Activate script" sieve-activate t] + ["Deactivate script" sieve-deactivate t])) + (define-derived-mode sieve-manage-mode fundamental-mode "SIEVE" "Mode used for sieve script management." (setq mode-name "SIEVE") @@ -140,13 +147,6 @@ require \"fileinto\"; (put 'sieve-manage-mode 'mode-class 'special) -(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map - "Sieve Menu." - '("Manage Sieve" - ["Edit script" sieve-edit-script t] - ["Activate script" sieve-activate t] - ["Deactivate script" sieve-deactivate t])) - ;; This is necessary to allow correct handling of \\[cvs-mode-diff-map] ;; in substitute-command-keys. ;(fset 'sieve-manage-mode-map sieve-manage-mode-map) diff --git a/lisp/smime.el b/lisp/smime.el index 5701ec8..a4c70cc 100644 --- a/lisp/smime.el +++ b/lisp/smime.el @@ -194,6 +194,7 @@ If nil, use system defaults." (defvar smime-details-buffer "*OpenSSL output*") +;; Use mm-util? (eval-and-compile (defalias 'smime-make-temp-file (if (fboundp 'make-temp-file) @@ -489,6 +490,7 @@ A string or a list of strings is returned." (caddr curkey) (smime-get-certfiles keyfile otherkeys))))) +;; Use mm-util? (eval-and-compile (defalias 'smime-point-at-eol (if (fboundp 'point-at-eol) diff --git a/texi/ChangeLog b/texi/ChangeLog index 08041c4..386a645 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,8 @@ +2003-05-03 Kai Gro,A_(Bjohann + + * gnus.texi (Agent Basics): Explain that some servers can be + agentized, whereas others aren't. + 2003-05-01 Reiner Steib * gnus.texi (Oort Gnus): Add prefix limit feature. diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 4f50fd8..973fa24 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -16727,6 +16727,30 @@ Gnus $B$r(B ``$B%*%U%i%$%s(B'' $B$N%K%e!<%9%j!<%@!<$H$7$F;EN)$F$k$N$O6K$a$F $B%^%7%s$K