From 11dce356dee90fe9e71c190f459e18ff939c71af Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 8 May 2000 00:57:46 +0000 Subject: [PATCH] Importing Gnus v5.8.6. --- lisp/ChangeLog | 207 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-art.el | 17 +++-- lisp/gnus-draft.el | 13 ++-- lisp/gnus-ems.el | 78 +++++++++++++------ lisp/gnus-msg.el | 85 ++++++++++++++------- lisp/gnus-score.el | 4 + lisp/gnus-start.el | 17 ++--- lisp/gnus-util.el | 7 +- lisp/gnus.el | 52 ++++++++----- lisp/lpath.el | 4 + lisp/mailcap.el | 134 ++++++++++++++++---------------- lisp/message.el | 115 +++++++++++++++++++++++++--- lisp/mm-bodies.el | 11 +-- lisp/mm-decode.el | 105 +++++++++---------------- lisp/mm-partial.el | 153 +++++++++++++++++++++++++++++++++++++ lisp/mm-view.el | 29 +++---- lisp/mml.el | 147 ++++++++++++++++++++++------------- lisp/nndoc.el | 4 +- lisp/nnmbox.el | 3 +- lisp/rfc2047.el | 35 ++++++--- lisp/webmail.el | 15 ++-- texi/ChangeLog | 15 ++++ texi/Makefile.in | 4 +- texi/emacs-mime.texi | 38 +++++++++ texi/gnus.texi | 34 ++++++--- texi/message.texi | 17 ++++- 26 files changed, 989 insertions(+), 354 deletions(-) create mode 100644 lisp/mm-partial.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dcd5c94..43754b3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,210 @@ +Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.8.6 is released. + +2000-04-28 21:14:21 Shenghuo ZHU + + * rfc2047.el (rfc2047-q-encoding-alist): Encode HTAB. + +2000-04-28 16:37:09 Shenghuo ZHU + + * message.el (message-send-mail-partially): Use forward-line. + +2000-04-28 16:01:09 Shenghuo ZHU + + * gnus-art.el (gnus-mime-button-menu): Use call-interactively. + +2000-04-28 15:30:17 Shenghuo ZHU + + * mml.el (mml-generate-mime-1): Ignore 0x1b. + (mml-insert-mime): No markup only for text/plain. + (mime-to-mml): Remove MIME headers. + +2000-04-28 14:23:14 Shenghuo ZHU + + * mml.el (mml-preview): Set gnus-newsgroup-charset. + * rfc2047.el (rfc2047-encode-message-header): Encode non-ascii + as 8-bit. + * lpath.el: Fbind image functions. + +2000-04-28 Dave Love + + * gnus.el (gnus-group-startup-message): Maybe use image in Emacs + 21. + + * mailcap.el (mailcap-parse-mailcaps): Revert last change to + search order. Use parse-colon-path and remove some redundancy. + Doc fix. + (mailcap-parse-mimetypes): Code consistently with + mailcap-parse-mailcaps. Doc fix. + + * gnus-start.el (gnus-unload): Iterate over `features', not + `load-history'. + +2000-04-28 09:52:21 Shenghuo ZHU + + * mml.el (mml-parse-1): Don't create blank parts. + (mml-read-part): Fix mml tag. + (mml-insert-mime): Convert message/rfc822. + (mml-insert-mml-markup): Add mmlp parameter. + +2000-04-28 01:16:10 Shenghuo ZHU + + * message.el (message-send-mail-partially): Remove CTE. + +2000-04-28 00:31:53 Shenghuo ZHU + + * lpath.el: Fbind put-image for XEmacs. + * mm-view.el (mm-inline-image): Fset it. + +2000-04-27 23:23:37 Shenghuo ZHU + + * nndoc.el (nndoc-type-alist): Change forward regexp. + +2000-04-27 21:57:10 Shenghuo ZHU + + * message.el (message-send-mail-partially-limit): Change the + default value. + +2000-04-27 21:53:32 Erik Toubro Nielsen + + * gnus-util.el (gnus-extract-address-components): Name might be + "". + +2000-04-27 20:32:06 Shenghuo ZHU + + * gnus-msg.el (gnus-summary-mail-forward): Use ARG. + (gnus-summary-post-forward): Ditto. + * message.el (message-forward-show-mml): New variable. + (message-forward): Use it. + * mml.el (mml-parse-1): Add tag mml. + (mml-read-part): Ditto. + (mml-generate-mime): Support reentance. + (mml-generate-mime-1): Support mml tag. + +2000-04-27 Dave Love + + * gnus-art.el: Don't bother to require custom, browse-url. + (gnus-article-x-face-command): Include gnus-article-display-xface. + + * gnus-ems.el: Assume only (X)Emacs 20+. Simplify XEmacs checks. + Use defalias, not fset. + (gnus-article-display-xface): New function. + + * mm-view.el (mm-inline-image-emacs): Use put-image, remove-images. + + * mm-decode.el: Small doc fixes. Require cl when compiling. + (mm-xemacs-p): Deleted. + (mm-get-image-emacs, mm-get-image-xemacs): Deleted. + (mm-get-image): Amalgamate Emacs and XEmacs code here; for Emacs, + use create-image and don't special-case xbm. + (mm-valid-image-format-p): Use display-graphic-p. + +2000-04-27 15:27:54 Shenghuo ZHU + + * message.el (message-send-mail-partially-limit): New variable. + (message-send-mail-partially): New function. + (message-send-mail): Use it. + * mm-bodies.el (mm-decode-content-transfer-encoding): Remove + all blank lines inside of base64. + * mm-partial.el (mm-inline-partial): Add an option. Remove tail + blank lines. + +2000-04-27 10:03:36 Shenghuo ZHU + + * mml.el (mml-insert-tag): Match more special characters. + +2000-04-27 09:06:29 Shenghuo ZHU + + * gnus-msg.el (gnus-bug): Avoid attaching the external buffer. + +2000-04-27 00:58:43 Shenghuo ZHU + + * mm-decode.el (mm-inline-media-tests): Add message/partial. + (mm-inlined-types): Ditto. + * mm-partial.el: New file. + +2000-04-27 Dave Love + + * mailcap.el (mailcap-mime-data): Fix octet-stream syntax -- might + matter in Emacs 21. + +2000-04-26 Florian Weimer + + * mm-bodies.el (mm-encode-body): Remove reference to + mm-default-charset in comment. + +2000-04-24 00:56:00 Björn Torkelsson + + * rfc2047.el (rfc2047-encode-message-header): Fixing typo. + +2000-04-26 12:27:41 Shenghuo ZHU + + * gnus-draft.el (gnus-draft-send): Move gnus-draft-setup inside of + let. + +2000-04-26 12:26:10 Pavel Janik ml. + + * gnus-draft.el (gnus-draft-setup): Fix comments. + +2000-04-26 10:06:12 Shenghuo ZHU + + * nnmbox.el (nnmbox-create-mbox): Use nnmbox-file-coding-system, + if nnmbox-file-coding-system-for-write is nil. + +2000-04-26 02:17:44 Shenghuo ZHU + + * gnus-msg.el (gnus-configure-posting-styles): Just remove the + header if nil. + +2000-04-26 00:23:46 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Insert directly if decoded. + * mml.el (autoload): Typo. + +2000-04-25 22:46:36 Shenghuo ZHU + + * mml.el (mml-preview): Set up posting-charset. + * gnus-msg.el (gnus-group-posting-charset-alist): Add koi8-r. + +2000-04-25 21:23:54 Shenghuo ZHU + + * webmail.el: Fix yahoo mail. + +2000-04-25 20:12:17 Shenghuo ZHU + + * rfc2047.el (rfc2047-dissect-region): Don't include LWS ahead of + word if not necessary. + (rfc2047-encode-region): Put space between encoded words. + +2000-04-24 21:11:48 Shenghuo ZHU + + * gnus-util.el (gnus-netrc-machine): Another default to nntp. + +2000-04-24 18:14:12 Shenghuo ZHU + + * gnus-draft.el (gnus-draft-setup): Restore mml only when + required. + (gnus-draft-edit-message): Require restoration. + +2000-04-24 16:51:04 Shenghuo ZHU + + * gnus-score.el (gnus-score-headers): Copy gnus-newsgrou-scored + back. + +2000-04-24 16:01:15 Shenghuo ZHU + + * gnus-art.el (gnus-treat-article): Make sure that the summary + buffer is live. + +2000-04-24 15:42:53 Shenghuo ZHU + + * mailcap.el (mailcap-parse-mailcaps): Reorder. + (mailcap-parse-mailcap): Backwards parsing. + (mailcap-possible-viewers): Remove nreverse. + (mailcap-mime-info): Ditto. + (mailcap-add-mailcap-entry): Keep alternative viewer. + Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.8.5 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 1211ce1..94d97e5 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -27,12 +27,10 @@ (eval-when-compile (require 'cl)) -(require 'custom) (require 'gnus) (require 'gnus-sum) (require 'gnus-spec) (require 'gnus-int) -(require 'browse-url) (require 'mm-bodies) (require 'mail-parse) (require 'mm-decode) @@ -201,11 +199,17 @@ regexp. If it matches, the text in question is not a signature." :group 'gnus-article-hiding) (defcustom gnus-article-x-face-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -" + (if (and (fboundp 'image-type-available-p) + (or (image-type-available-p 'xpm) + (image-type-available-p 'xbm))) + 'gnus-article-display-xface + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -") "*String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." - :type 'string ;Leave function case to Lisp. + :type '(choice string + (function-item gnus-article-display-xface) + function) :group 'gnus-article-washing) (defcustom gnus-article-x-face-too-ugly nil @@ -2817,7 +2821,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (cons (caddr c) (car c))) gnus-mime-button-commands)))))) (if response - (funcall response)))))) + (call-interactively response)))))) (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." @@ -4581,7 +4585,8 @@ For example: (while (setq elem (pop alist)) (setq val (save-excursion - (set-buffer gnus-summary-buffer) + (if (gnus-buffer-live-p gnus-summary-buffer) + (set-buffer gnus-summary-buffer)) (symbol-value (car elem)))) (when (and (or (consp val) treated-type) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 34c8b3a..5e7850e 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -96,7 +96,7 @@ (interactive) (let ((article (gnus-summary-article-number))) (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-draft-setup article gnus-newsgroup-name) + (gnus-draft-setup article gnus-newsgroup-name t) (set-buffer-modified-p t) (save-buffer) (let ((gnus-verbose-backends nil)) @@ -122,7 +122,6 @@ (defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (gnus-draft-setup article (or group "nndraft:queue")) (let ((message-syntax-checks (if interactive nil 'dont-check-for-anything-just-trust-me)) (message-inhibit-body-encoding (or (not group) @@ -130,8 +129,10 @@ message-inhibit-body-encoding)) (message-send-hook (and group (not (equal group "nndraft:queue")) message-send-hook)) - (message-setup-hook nil) + (message-setup-hook (and group (not (equal group "nndraft:queue")) + message-setup-hook)) type method) + (gnus-draft-setup article (or group "nndraft:queue")) ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction @@ -187,16 +188,16 @@ ;;;!!!but for the time being, we'll just run this tiny function uncompiled. (progn - (defun gnus-draft-setup (narticle group) + (defun gnus-draft-setup (narticle group &optional restore) (gnus-setup-message 'forward (let ((article narticle)) (message-mail) (erase-buffer) (if (not (gnus-request-restore-buffer article group)) (error "Couldn't restore the article") - ;; Insert the separator. - (if (equal group "nndraft:queue") + (if (and restore (equal group "nndraft:queue")) (mime-to-mml)) + ;; Insert the separator. (goto-char (point-min)) (search-forward "\n\n") (forward-char -1) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 9866398..844513f 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -30,8 +30,9 @@ ;;; Function aliases later to be redefined for XEmacs usage. -(defvar gnus-xemacs (string-match "XEmacs\\|Lucid" emacs-version) - "Non-nil if running under XEmacs.") +(eval-and-compile + (defvar gnus-xemacs (string-match "XEmacs" emacs-version) + "Non-nil if running under XEmacs.")) (defvar gnus-mouse-2 [mouse-2]) (defvar gnus-down-mouse-3 [down-mouse-3]) @@ -59,18 +60,10 @@ valstr))) (eval-and-compile - (if (string-match "XEmacs\\|Lucid" emacs-version) - nil - + (if gnus-xemacs + (gnus-xmas-define) (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions.")) - - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (gnus-xmas-define)) - - ((boundp 'MULE) - (provide 'gnusutil)))) + "Property used for highlighting mouse regions."))) (eval-and-compile (cond @@ -80,7 +73,7 @@ set-face-background x-popup-menu))) (while funcs (unless (fboundp (car funcs)) - (fset (car funcs) 'gnus-dummy-func)) + (defalias (car funcs) 'gnus-dummy-func)) (setq funcs (cdr funcs))))))) (eval-and-compile @@ -106,32 +99,32 @@ (defun gnus-ems-redefine () (cond - ((string-match "XEmacs\\|Lucid" emacs-version) + (gnus-xemacs (gnus-xmas-redefine)) ((featurep 'mule) ;; Mule and new Emacs definitions ;; [Note] Now there are three kinds of mule implementations, - ;; original MULE, XEmacs/mule and beta version of Emacs including - ;; some mule features. Unfortunately these API are different. In + ;; original MULE, XEmacs/mule and Emacs 20+ including + ;; MULE features. Unfortunately these API are different. In ;; particular, Emacs (including original MULE) and XEmacs are - ;; quite different. + ;; quite different. Howvere, this version of Gnus doesn't support + ;; anything other than XEmacs 20+ and Emacs 20.3+. + ;; Predicates to check are following: ;; (boundp 'MULE) is t only if MULE (original; anything older than ;; Mule 2.3) is running. ;; (featurep 'mule) is t when every mule variants are running. - ;; These implementations may be able to share between original - ;; MULE and beta version of new Emacs. In addition, it is able to - ;; detect XEmacs/mule by (featurep 'mule) and to check variable - ;; `emacs-version'. In this case, implementation for XEmacs/mule - ;; may be able to share between XEmacs and XEmacs/mule. + ;; It is possible to detect XEmacs/mule by (featurep 'mule) and + ;; checking `emacs-version'. In this case, the implementation for + ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. (defvar gnus-summary-display-table nil "Display table used in summary mode buffers.") - (fset 'gnus-max-width-function 'gnus-mule-max-width-function) - (fset 'gnus-summary-set-display-table (lambda ())) + (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) + (defalias 'gnus-summary-set-display-table (lambda ())) (when (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting @@ -207,6 +200,41 @@ (goto-char (point-min)) (sit-for 0)))))) +(defun gnus-article-display-xface (beg end) + "Display an XFace header from between BEG and END in the current article. +This requires support for XPM or XBM images in your Emacs and the +external programs `uncompface', `icontopbm' and either `ppmtoxpm' (for +XPM support) or `ppmtoxbm' (for XBM support). On a GNU/Linux system +these might be in packages with names like `compface' or `faces-xface' +and `netpbm' or `libgr-progs', for instance. + +This function is for Emacs 21+. See `gnus-xmas-article-display-xface' +for XEmacs." + (save-excursion + (let ((cur (current-buffer)) + image type) + (when (and (fboundp 'image-type-available-p) + (cond ((image-type-available-p 'xpm) (setq type 'xpm)) + ((image-type-available-p 'xbm) (setq type 'xbm)))) + (with-temp-buffer + (insert-buffer-substring cur beg end) + (call-process-region (point-min) (point-max) "uncompface" + 'delete '(t nil)) + (goto-char (point-min)) + (insert "/* Width=48, Height=48 */\n") + (and (eq 0 (call-process-region (point-min) (point-max) "icontopbm" + 'delete '(t nil))) + (eq 0 (call-process-region (point-min) (point-max) + (if (eq type 'xpm) + "ppmtoxpm" + "pbmtoxbm") + 'delete '(t nil))) + (setq image (create-image (buffer-string) type t)))) + (when image + (goto-char (point-min)) + (re-search-forward "^From:" nil 'move) + (insert-image image " ")))))) + (provide 'gnus-ems) ;; Local Variables: diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index e0a43a3..31e42c0 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -103,6 +103,7 @@ the second with the current group name.") (defcustom gnus-group-posting-charset-alist '(("^\\(no\\|fr\\|dk\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\|dk\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1)) + ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r)) (message-this-is-mail nil nil) (message-this-is-news nil t)) "Alist of regexps and permitted unencoded charsets for posting. @@ -660,25 +661,53 @@ The original article will be yanked." (interactive "P") (gnus-summary-reply-with-original n t)) -(defun gnus-summary-mail-forward (&optional not-used post) - "Forward the current message to another user. +(defun gnus-summary-mail-forward (&optional arg post) + "Forward the current message to another user. +If ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml'; +if ARG is 1, decode the message and forward directly inline; +if ARG is 2, foward message as an rfc822 MIME section; +if ARG is 3, decode message and forward as an rfc822 MIME section; +if ARG is 4, foward message directly inline; +otherwise, use flipped `message-forward-as-mime'. If POST, post instead of mail." (interactive "P") - (gnus-setup-message 'forward - (gnus-summary-select-article) - (let (text) - (save-excursion - (set-buffer gnus-original-article-buffer) - (setq text (buffer-string))) - (set-buffer (gnus-get-buffer-create - (generate-new-buffer-name " *Gnus forward*"))) - (erase-buffer) - (insert text) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ") ) - (run-hooks 'gnus-article-decode-hook) - (message-forward post)))) + (let ((message-forward-as-mime message-forward-as-mime) + (message-forward-show-mml message-forward-show-mml)) + (cond + ((null arg)) + ((eq arg 1) (setq message-forward-as-mime nil + message-forward-show-mml t)) + ((eq arg 2) (setq message-forward-as-mime t + message-forward-show-mml nil)) + ((eq arg 3) (setq message-forward-as-mime t + message-forward-show-mml t)) + ((eq arg 4) (setq message-forward-as-mime nil + message-forward-show-mml nil)) + (t (setq message-forward-as-mime (not message-forward-as-mime)))) + (gnus-setup-message 'forward + (gnus-summary-select-article) + (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) + text) + (save-excursion + (set-buffer gnus-original-article-buffer) + (setq text (buffer-string))) + (set-buffer + (if message-forward-show-mml + (gnus-get-buffer-create + (generate-new-buffer-name " *Gnus forward*")) + (mm-with-unibyte-current-buffer + ;; create an unibyte buffer + (gnus-get-buffer-create + (generate-new-buffer-name " *Gnus forward*"))))) + (erase-buffer) + (insert text) + (goto-char (point-min)) + (when (looking-at "From ") + (replace-match "X-From-Line: ") ) + (if message-forward-show-mml + (mime-to-mml)) + (message-forward post))))) (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." @@ -691,11 +720,11 @@ If POST, post instead of mail." (set-buffer gnus-original-article-buffer) (message-resend address))))) -(defun gnus-summary-post-forward (&optional full-headers) +(defun gnus-summary-post-forward (&optional arg) "Forward the current article to a newsgroup. -If FULL-HEADERS (the prefix), include full headers when forwarding." +See `gnus-summary-mail-forward' for ARG." (interactive "P") - (gnus-summary-mail-forward full-headers t)) + (gnus-summary-mail-forward arg t)) (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" @@ -868,10 +897,12 @@ If YANK is non-nil, include the original article." (stringp nntp-server-type)) (insert nntp-server-type)) (insert "\n\n\n\n\n") - (save-excursion - (set-buffer (gnus-get-buffer-create " *gnus environment info*")) - (gnus-debug)) - (insert "<#part type=application/x-emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>") + (let (text) + (save-excursion + (set-buffer (gnus-get-buffer-create " *gnus environment info*")) + (gnus-debug) + (setq text (buffer-string))) + (insert "<#part type=application/x-emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>")) (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) @@ -1232,8 +1263,10 @@ this is a reply." `(lambda () (save-excursion (message-remove-header ,header) - (message-goto-eoh) - (insert ,header ": " ,(cdr result) "\n")))))))) + (let ((value ,(cdr result))) + (when value + (message-goto-eoh) + (insert ,header ": " value "\n")))))))))) (when (or name address) (add-hook 'message-setup-hook `(lambda () diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index c3ce5e0..49232b0 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1462,6 +1462,10 @@ EXTRA is the possible non-standard header." (when (setq new (funcall (nth 2 entry) scores header now expire trace)) (push new news)))) + (when (gnus-buffer-live-p gnus-summary-buffer) + (let ((scored gnus-newsgroup-scored)) + (with-current-buffer gnus-summary-buffer + (setq gnus-newsgroup-scored scored)))) ;; Remove the buffer. (kill-buffer (current-buffer))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 6a15660..58f8b70 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -732,17 +732,14 @@ prompt the user for the name of an NNTP server to use." ;;;###autoload (defun gnus-unload () - "Unload all Gnus features." + "Unload all Gnus features. +\(For some value of `all' or `Gnus'.) Currently, features whose names +have prefixes `gnus-', `nn', `mm-' or `rfc' are unloaded. Use +cautiously -- unloading may cause trouble." (interactive) - (unless (boundp 'load-history) - (error "Sorry, `gnus-unload' is not implemented in this Emacs version")) - (let ((history load-history) - feature) - (while history - (and (string-match "^\\(gnus\\|nn\\)" (caar history)) - (setq feature (cdr (assq 'provide (car history)))) - (unload-feature feature 'force)) - (setq history (cdr history))))) + (dolist (feature features) + (if (string-match "^\\(gnus-\\|nn\\|mm-\\|rfc\\)" (symbol-name feature)) + (unload-feature feature 'force)))) ;;; diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 6c5bf66..1df730a 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -165,8 +165,8 @@ (and (string-match "(.*" from) (setq name (substring from (1+ (match-beginning 0)) (match-end 0))))) - ;; Fix by Hallvard B Furuseth . - (list (or name from) (or address from)))) + (list (if (string= name "") nil name) (or address from)))) + (defun gnus-fetch-field (field) "Return the value of the header FIELD of current article." @@ -873,7 +873,8 @@ ARG is passed to the first function." (setq result (nreverse result)) (while (and result (not (equal (or port "nntp") - (gnus-netrc-get (car result) "port")))) + (or (gnus-netrc-get (car result) "port") + "nntp")))) (pop result)) (car result)))) diff --git a/lisp/gnus.el b/lisp/gnus.el index 585c338..d972c7e 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,7 +1,6 @@ ;;; gnus.el --- a newsreader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000 -;; Free Software Foundation, Inc. +;; 1997, 1998, 2000 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -258,7 +257,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.8.5" +(defconst gnus-version-number "5.8.6" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -748,8 +747,23 @@ be set in `.emacs' instead." "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) - (insert - (format " %s + (cond + ((and (fboundp 'find-image) + (display-graphic-p) + (let ((image (find-image '((:type xpm :file "gnus.xpm") + (:type xbm :file "gnus.xbm"))))) + (when image + (insert-image image " ") + (goto-char (point-min)) + (while (not (eobp)) + (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) + ?\ )) + (forward-line 1)) + (setq gnus-simple-splash nil) + t)))) + (t + (insert + (format " %s _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -769,21 +783,21 @@ be set in `.emacs' instead." __ " - "")) - ;; And then hack it. - (gnus-indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) - (goto-char (point-min)) - (forward-line 1) - (let* ((pheight (count-lines (point-min) (point-max))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - ;; Fontify some. - (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) + "")) + ;; And then hack it. + (gnus-indent-rigidly (point-min) (point-max) + (/ (max (- (window-width) (or x 46)) 0) 2)) + (goto-char (point-min)) + (forward-line 1) + (let* ((pheight (count-lines (point-min) (point-max))) + (wheight (window-height)) + (rest (- wheight pheight))) + (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) + ;; Fontify some. + (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) + (setq gnus-simple-splash t))) (goto-char (point-min)) (setq mode-line-buffer-identification (concat " " gnus-version)) - (setq gnus-simple-splash t) (set-buffer-modified-p t)) (eval-when (load) @@ -909,7 +923,7 @@ see the manual for details." "*Method used for archiving messages you've sent. This should be a mail method. -It's probably not a very effective to change this variable once you've +It's probably not very effective to change this variable once you've run Gnus once. After doing that, you must edit this server from the server buffer." :group 'gnus-server diff --git a/lisp/lpath.el b/lisp/lpath.el index 1f89b48..519625c 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -43,6 +43,8 @@ temp-directory babel-fetch babel-wash find-coding-systems-for-charsets sc-cite-regexp vcard-pretty-print image-type-available-p + put-image create-image display-graphic-p + find-image insert-image make-overlay overlay-put)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count @@ -95,6 +97,8 @@ rmail-summary-exists rmail-select-summary rmail-update-summary url-generic-parse-url valid-image-instantiator-format-p babel-fetch babel-wash babel-as-string sc-cite-regexp + put-image create-image display-graphic-p + find-image insert-image vcard-pretty-print image-type-available-p))) (setq load-path (cons "." load-path)) diff --git a/lisp/mailcap.el b/lisp/mailcap.el index cda6987..3450905 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -52,7 +52,7 @@ ("octet-stream" (viewer . mailcap-save-binary-file) (non-viewer . t) - (type ."application/octet-stream")) + (type . "application/octet-stream")) ("dvi" (viewer . "open %s") (type . "application/dvi") @@ -305,8 +305,12 @@ not.") (defvar mailcap-parsed-p nil) (defun mailcap-parse-mailcaps (&optional path force) - "Parse out all the mailcaps specified in a unix-style path string PATH. -If FORCE, re-parse even if already parsed." + "Parse out all the mailcaps specified in a path string PATH. +Components of PATH are separated by the `path-separator' character +appropriate for this system. If FORCE, re-parse even if already +parsed. If PATH is omitted, use the value of environment variable +MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus +/usr/local/etc/mailcap." (interactive (list nil t)) (when (or (not mailcap-parsed-p) force) @@ -314,27 +318,24 @@ If FORCE, re-parse even if already parsed." (path nil) ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) ((memq system-type '(ms-dos ms-windows windows-nt)) - (setq path (mapconcat 'expand-file-name - '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap") - ";"))) - (t (setq path (mapconcat 'expand-file-name - '("~/.mailcap" - "/etc/mailcap:/usr/etc/mailcap" - "/usr/local/etc/mailcap") ":")))) + (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) + (t (setq path + ;; This is per RFC 1524, specifically + ;; with /usr before /usr/local. + '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" + "/usr/local/etc/mailcap")))) (let ((fnames (reverse - (split-string - path (if (memq system-type - '(ms-dos ms-windows windows-nt)) - ";" - ":")))) + (if (stringp path) + (parse-colon-path path) + path))) fname) (while fnames (setq fname (car fnames)) - (if (and (file-exists-p fname) (file-readable-p fname) + (if (and (file-readable-p fname) (file-regular-p fname)) - (mailcap-parse-mailcap (car fnames))) + (mailcap-parse-mailcap fname)) (setq fnames (cdr fnames)))) - (setq mailcap-parsed-p t))) + (setq mailcap-parsed-p t))) (defun mailcap-parse-mailcap (fname) ;; Parse out the mailcap file specified by FNAME @@ -348,25 +349,24 @@ If FORCE, re-parse even if already parsed." (insert-file-contents fname) (set-syntax-table mailcap-parse-args-syntax-table) (mailcap-replace-regexp "#.*" "") ; Remove all comments + (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces (mailcap-replace-regexp "\n+" "\n") ; And blank lines - (mailcap-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces - (mailcap-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "") (goto-char (point-max)) (skip-chars-backward " \t\n") (delete-region (point) (point-max)) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n") + (while (not (bobp)) + (skip-chars-backward " \t\n") + (beginning-of-line) (setq save-pos (point) info nil) (skip-chars-forward "^/; \t\n") (downcase-region save-pos (point)) (setq major (buffer-substring save-pos (point))) - (skip-chars-forward " \t\n") + (skip-chars-forward " \t") (setq minor "") (when (eq (char-after) ?/) (forward-char) - (skip-chars-forward " \t\n") + (skip-chars-forward " \t") (setq save-pos (point)) (skip-chars-forward "^; \t\n") (downcase-region save-pos (point)) @@ -375,14 +375,14 @@ If FORCE, re-parse even if already parsed." ((eq ?* (or (char-after save-pos) 0)) ".*") ((= (point) save-pos) ".*") (t (regexp-quote (buffer-substring save-pos (point))))))) - (skip-chars-forward " \t\n") + (skip-chars-forward " \t") ;;; Got the major/minor chunks, now for the viewers/etc ;;; The first item _must_ be a viewer, according to the ;;; RFC for mailcap files (#1343) (setq viewer "") (when (eq (char-after) ?\;) (forward-char) - (skip-chars-forward " \t\n") + (skip-chars-forward " \t") (setq save-pos (point)) (skip-chars-forward "^;\n") ;; skip \; @@ -408,7 +408,8 @@ If FORCE, re-parse even if already parsed." "*" minor)))) (mailcap-parse-mailcap-extras save-pos (point)))) (mailcap-mailcap-entry-passes-test info) - (mailcap-add-mailcap-entry major minor info)))))) + (mailcap-add-mailcap-entry major minor info)) + (beginning-of-line))))) (defun mailcap-parse-mailcap-extras (st nd) ;; Grab all the extra stuff from a mailcap entry @@ -497,7 +498,7 @@ If FORCE, re-parse even if already parsed." ((and minor (string-match (car (car major)) minor)) (setq wildcard (cons (cdr (car major)) wildcard)))) (setq major (cdr major))) - (nconc (nreverse exact) (nreverse wildcard)))) + (nconc exact wildcard))) (defun mailcap-unescape-mime-test (test type-info) (let (save-pos save-chr subst) @@ -590,16 +591,19 @@ If FORCE, re-parse even if already parsed." (setq mailcap-mime-data (cons (cons major (list (cons minor info))) mailcap-mime-data)) - (let ((cur-minor (assoc minor old-major))) - (cond - ((or (null cur-minor) ; New minor area, or - (assq 'test info)) ; Has a test, insert at beginning - (setcdr old-major (cons (cons minor info) (cdr old-major)))) - ((and (not (assq 'test info)) ; No test info, replace completely - (not (assq 'test cur-minor))) - (setcdr cur-minor info)) - (t - (setcdr old-major (cons (cons minor info) (cdr old-major))))))))) + (let ((cur-minor (assoc minor old-major))) + (cond + ((or (null cur-minor) ; New minor area, or + (assq 'test info)) ; Has a test, insert at beginning + (setcdr old-major (cons (cons minor info) (cdr old-major)))) + ((and (not (assq 'test info)) ; No test info, replace completely + (not (assq 'test cur-minor)) + (equal (assq 'viewer info) ; Keep alternative viewer + (assq 'viewer cur-minor))) + (setcdr cur-minor info)) + (t + (setcdr old-major (cons (cons minor info) (cdr old-major)))))) + ))) (defun mailcap-add (type viewer &optional test) "Add VIEWER as a handler for TYPE. @@ -670,9 +674,8 @@ this type is returned." (if (mailcap-viewer-passes-test (car viewers) info) (setq passed (cons (car viewers) passed))) (setq viewers (cdr viewers))) - (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp)) + (setq passed (sort passed 'mailcap-viewer-lessp)) (setq viewer (car passed)))) - (setq passed (nreverse passed)) (when (and (stringp (cdr (assq 'viewer viewer))) passed) (setq viewer (car passed))) @@ -796,38 +799,37 @@ this type is returned." "An assoc list of file extensions and corresponding MIME content-types.") (defun mailcap-parse-mimetypes (&optional path) - ;; Parse out all the mimetypes specified in a unix-style path string PATH + "Parse out all the mimetypes specified in a unix-style path string PATH. +Components of PATH are separated by the `path-separator' character +appropriate for this system. If PATH is omitted, use the value of +environment variable MIMETYPES if set; otherwise use a default path." (cond (path nil) ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES"))) ((memq system-type '(ms-dos ms-windows windows-nt)) - (setq path (mapconcat 'expand-file-name - '("~/mime.typ" "~/etc/mime.typ") ";"))) - (t (setq path (mapconcat - 'expand-file-name - ;; mime.types seems to be the normal name, - ;; definitely so on current GNUish systems. The - ;; ordering follows that for mailcap. - '("~/.mime.types" - "/etc/mime.types" - "/usr/etc/mime.types" - "/usr/local/etc/mime.types" - "/usr/local/www/conf/mime.types" - "~/.mime-types" - "/etc/mime-types" - "/usr/etc/mime-types" - "/usr/local/etc/mime-types" - "/usr/local/www/conf/mime-types") ":")))) - (let ((fnames (reverse - (split-string path - (if (memq system-type - '(ms-dos ms-windows windows-nt)) - ";" ":")))) + (setq path '("~/mime.typ" "~/etc/mime.typ"))) + (t (setq path + ;; mime.types seems to be the normal name, definitely so + ;; on current GNUish systems. The search order follows + ;; that for mailcap. + '("~/.mime.types" + "/etc/mime.types" + "/usr/etc/mime.types" + "/usr/local/etc/mime.types" + "/usr/local/www/conf/mime.types" + "~/.mime-types" + "/etc/mime-types" + "/usr/etc/mime-types" + "/usr/local/etc/mime-types" + "/usr/local/www/conf/mime-types")))) + (let ((fnames (reverse (if (stringp path) + (parse-colon-path path) + path))) fname) (while fnames (setq fname (car fnames)) - (if (and (file-exists-p fname) (file-readable-p fname)) - (mailcap-parse-mimetype-file (car fnames))) + (if (and (file-readable-p fname)) + (mailcap-parse-mimetype-file fname)) (setq fnames (cdr fnames))))) (defun mailcap-parse-mimetype-file (fname) diff --git a/lisp/message.el b/lisp/message.el index 4414e43..8c1cc95 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -299,6 +299,11 @@ The provided functions are: :group 'message-forwarding :type 'boolean) +(defcustom message-forward-show-mml t + "*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged." + :group 'message-forwarding + :type 'boolean) + (defcustom message-forward-before-signature t "*If non-nil, put forwarded message before signature, else after." :group 'message-forwarding @@ -844,7 +849,7 @@ Defaults to `text-mode-abbrev-table'.") "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[:>|}].*") (0 'message-cited-text-face)) - ("<#/?\\(multipart\\|part\\|external\\).*>" + ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>" (0 'message-mml-face)))) "Additional expressions to highlight in Message mode.") @@ -889,6 +894,14 @@ The cdr of ech entry is a function for applying the face to a region.") mm-auto-save-coding-system "Coding system to compose mail.") +(defcustom message-send-mail-partially-limit 1000000 + "The limitation of messages sent as message/partial. +The lower bound of message size in characters, beyond which the message +should be sent in several parts. If it is nil, the size is unlimited." + :group 'message-buffers + :type '(choice (const :tag "unlimited" nil) + (integer 1000000))) + ;;; Internal variables. (defvar message-buffer-list nil) @@ -2146,6 +2159,71 @@ It should typically alter the sending method in some way or other." (eval (car actions))))) (pop actions))) +(defun message-send-mail-partially () + "Sendmail as message/partial." + (let ((p (goto-char (point-min))) + (tembuf (message-generate-new-buffer-clone-locals " message temp")) + (curbuf (current-buffer)) + (id (message-make-message-id)) (n 1) + plist total header required-mail-headers) + (while (not (eobp)) + (if (< (point-max) (+ p message-send-mail-partially-limit)) + (goto-char (point-max)) + (goto-char (+ p message-send-mail-partially-limit)) + (beginning-of-line) + (if (<= (point) p) (forward-line 1))) ;; In case of bad message. + (push p plist) + (setq p (point))) + (setq total (length plist)) + (push (point-max) plist) + (setq plist (nreverse plist)) + (unwind-protect + (save-excursion + (setq p (pop plist)) + (while plist + (set-buffer curbuf) + (copy-to-buffer tembuf p (car plist)) + (set-buffer tembuf) + (goto-char (point-min)) + (if header + (progn + (goto-char (point-min)) + (narrow-to-region (point) (point)) + (insert header)) + (message-goto-eoh) + (setq header (buffer-substring (point-min) (point))) + (goto-char (point-min)) + (narrow-to-region (point) (point)) + (insert header) + (message-remove-header "Mime-Version") + (message-remove-header "Content-Type") + (message-remove-header "Content-Transfer-Encoding") + (message-remove-header "Message-ID") + (message-remove-header "Lines") + (goto-char (point-max)) + (insert "Mime-Version: 1.0\n") + (setq header (buffer-substring (point-min) (point-max)))) + (goto-char (point-max)) + (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n" + id n total)) + (let ((mail-header-separator "")) + (when (memq 'Message-ID message-required-mail-headers) + (insert "Message-ID: " (message-make-message-id) "\n")) + (when (memq 'Lines message-required-mail-headers) + (let ((mail-header-separator "")) + (insert "Lines: " (message-make-lines) "\n"))) + (message-goto-subject) + (end-of-line) + (insert (format " (%d/%d)" n total)) + (goto-char (point-max)) + (insert "\n") + (widen) + (funcall message-send-mail-function)) + (setq n (+ n 1)) + (setq p (pop plist)) + (erase-buffer))) + (kill-buffer tembuf)))) + (defun message-send-mail (&optional arg) (require 'mail-utils) (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp")) @@ -2192,7 +2270,11 @@ It should typically alter the sending method in some way or other." (or (message-fetch-field "cc") (message-fetch-field "to"))) (message-insert-courtesy-copy)) - (funcall message-send-mail-function)) + (if (or (not message-send-mail-partially-limit) + (< (point-max) message-send-mail-partially-limit) + (not (y-or-n-p "The message size is too large, should it be sent partially?"))) + (funcall message-send-mail-function) + (message-send-mail-partially))) (kill-buffer tembuf)) (set-buffer mailbuf) (push 'mail message-sent-message-via))) @@ -3921,9 +4003,12 @@ the message." "Forward the current message via mail. Optional NEWS will use news to forward instead of mail." (interactive "P") - (let ((cur (current-buffer)) - (subject (message-make-forward-subject)) - art-beg) + (let* ((cur (current-buffer)) + (subject (if message-forward-show-mml + (message-make-forward-subject) + (mail-decode-encoded-word-string + (message-make-forward-subject)))) + art-beg) (if news (message-news nil subject) (message-mail nil subject)) @@ -3933,17 +4018,27 @@ Optional NEWS will use news to forward instead of mail." (message-goto-body) (goto-char (point-max))) (if message-forward-as-mime - (insert "\n\n<#part type=message/rfc822 disposition=inline>\n") + (if message-forward-show-mml + (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") + (insert "\n\n<#part type=message/rfc822 disposition=inline" + " buffer=\"" (buffer-name cur) "\">\n")) (insert "\n-------------------- Start of forwarded message --------------------\n")) (let ((b (point)) e) - (mml-insert-buffer cur) + (if message-forward-show-mml + (insert-buffer-substring cur) + (unless message-forward-as-mime + (mml-insert-buffer cur))) (setq e (point)) (if message-forward-as-mime - (insert "<#/part>\n") + (if message-forward-show-mml + (insert "<#/mml>\n") + (insert "<#/part>\n")) (insert "\n-------------------- End of forwarded message --------------------\n")) - (when (and (not current-prefix-arg) - message-forward-ignored-headers) + (when (and (or message-forward-show-mml + (not message-forward-as-mime)) + (not current-prefix-arg) + message-forward-ignored-headers) (save-restriction (narrow-to-region b e) (goto-char b) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 3a545d3..8c42436 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -60,7 +60,7 @@ If successful, the MIME charset is returned. If no encoding was done, nil is returned." (if (not (featurep 'mule)) ;; In the non-Mule case, we search for non-ASCII chars and - ;; return the value of `mm-default-charset' if any are found. + ;; return the value of `mail-parse-charset' if any are found. (save-excursion (goto-char (point-min)) (if (re-search-forward "[^\x0-\x7f]" nil t) @@ -168,12 +168,9 @@ If no encoding was done, nil is returned." ;; have been added by mailing list software. (save-excursion (goto-char (point-min)) - (if (re-search-forward "^[\t ]*$" nil t) - (delete-region (point) (point-max)) - (goto-char (point-max))) - (skip-chars-backward "\n\t ") - (delete-region (point) (point-max)) - (point)))) + (while (re-search-forward "^[\t ]*\r?\n" nil t) + (delete-region (match-beginning 0) (match-end 0))) + (point-max)))) ((memq encoding '(7bit 8bit binary)) ;; Do nothing. ) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 717e017..6e8413e 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -27,8 +27,10 @@ (require 'mail-parse) (require 'mailcap) (require 'mm-bodies) +(eval-when-compile (require 'cl)) -(defvar mm-xemacs-p (string-match "XEmacs" (emacs-version))) +(eval-and-compile + (autoload 'mm-inline-partial "mm-partial")) (defgroup mime-display () "Display of MIME in mail and news articles." @@ -126,6 +128,7 @@ (locate-library "vcard")))) ("message/delivery-status" mm-inline-text identity) ("message/rfc822" mm-inline-message identity) + ("message/partial" mm-inline-partial identity) ("text/.*" mm-inline-text identity) ("audio/wav" mm-inline-audio (lambda (handle) @@ -148,6 +151,7 @@ (defcustom mm-inlined-types '("image/.*" "text/.*" "message/delivery-status" "message/rfc822" + "message/partial" "application/pgp-signature") "List of media types that are to be displayed inline." :type '(repeat string) @@ -181,7 +185,7 @@ Viewing agents are supposed to view the last possible part of a message, as that is supposed to be the richest. However, users may prefer other types instead, and this list says what types are most unwanted. If, -for instance, text/html parts are very unwanted, and text/richtech are +for instance, text/html parts are very unwanted, and text/richtext are somewhat unwanted, then the value of this variable should be set to: @@ -227,7 +231,7 @@ to: (if (or (not ctl) (not (string-match "/" (car ctl)))) (mm-dissect-singlepart - '("text/plain") + '("text/plain") (and cte (intern (downcase (mail-header-remove-whitespace (mail-header-remove-comments cte))))) @@ -392,7 +396,7 @@ external if displayed external." (unwind-protect (start-process "*display*" nil "xterm" - "-e" shell-file-name + "-e" shell-file-name shell-command-switch (mm-mailcap-command method file (mm-handle-type handle))) @@ -407,7 +411,7 @@ external if displayed external." (unwind-protect (progn (call-process shell-file-name nil - (setq buffer + (setq buffer (generate-new-buffer "*mm*")) nil shell-command-switch @@ -464,7 +468,7 @@ external if displayed external." (mapconcat 'identity (nreverse out) ""))) (defun mm-remove-parts (handles) - "Remove the displayed MIME parts represented by HANDLE." + "Remove the displayed MIME parts represented by HANDLES." (if (and (listp handles) (bufferp (car handles))) (mm-remove-part handles) @@ -481,7 +485,7 @@ external if displayed external." (mm-remove-part handle))))))) (defun mm-destroy-parts (handles) - "Remove the displayed MIME parts represented by HANDLE." + "Remove the displayed MIME parts represented by HANDLES." (if (and (listp handles) (bufferp (car handles))) (mm-destroy-part handles) @@ -720,9 +724,8 @@ external if displayed external." result)) (defun mm-preferred-alternative-precedence (handles) - "Return the precedence based on HANDLES and mm-discouraged-alternatives." - (let ((seq (nreverse (mapcar (lambda (h) - (mm-handle-media-type h)) + "Return the precedence based on HANDLES and `mm-discouraged-alternatives'." + (let ((seq (nreverse (mapcar #'mm-handle-media-type handles)))) (dolist (disc (reverse mm-discouraged-alternatives)) (dolist (elem (copy-sequence seq)) @@ -734,37 +737,7 @@ external if displayed external." "Return the handle(s) referred to by ID." (cdr (assoc id mm-content-id-alist))) -(defun mm-get-image-emacs (handle) - "Return an image instance based on HANDLE." - (let ((type (mm-handle-media-subtype handle)) - spec) - ;; Allow some common translations. - (setq type - (cond - ((equal type "x-pixmap") - "xpm") - ((equal type "x-xbitmap") - "xbm") - (t type))) - (or (mm-handle-cache handle) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (prog1 - (setq spec - (ignore-errors - (cond - ((equal type "xbm") - ;; xbm images require special handling, since - ;; the only way to create glyphs from these - ;; (without a ton of work) is to write them - ;; out to a file, and then create a file - ;; specifier. - (error "Don't know what to do for XBMs right now.")) - (t - (list 'image :type (intern type) :data (buffer-string)))))) - (mm-handle-set-cache handle spec)))))) - -(defun mm-get-image-xemacs (handle) +(defun mm-get-image (handle) "Return an image instance based on HANDLE." (let ((type (mm-handle-media-subtype handle)) spec) @@ -782,32 +755,29 @@ external if displayed external." (prog1 (setq spec (ignore-errors - (cond - ((equal type "xbm") - ;; xbm images require special handling, since - ;; the only way to create glyphs from these - ;; (without a ton of work) is to write them - ;; out to a file, and then create a file - ;; specifier. - (let ((file (make-temp-name - (expand-file-name "emm.xbm" - mm-tmp-directory)))) - (unwind-protect - (progn - (write-region (point-min) (point-max) file) - (make-glyph (list (cons 'x file)))) - (ignore-errors - (delete-file file))))) - (t - (make-glyph - (vector (intern type) :data (buffer-string))))))) + (if (fboundp 'make-glyph) + (cond + ((equal type "xbm") + ;; xbm images require special handling, since + ;; the only way to create glyphs from these + ;; (without a ton of work) is to write them + ;; out to a file, and then create a file + ;; specifier. + (let ((file (make-temp-name + (expand-file-name "emm.xbm" + mm-tmp-directory)))) + (unwind-protect + (progn + (write-region (point-min) (point-max) file) + (make-glyph (list (cons 'x file)))) + (ignore-errors + (delete-file file))))) + (t + (make-glyph + (vector (intern type) :data (buffer-string))))) + (create-image (buffer-string) (intern type) 'data-p)))) (mm-handle-set-cache handle spec)))))) -(defun mm-get-image (handle) - (if mm-xemacs-p - (mm-get-image-xemacs handle) - (mm-get-image-emacs handle))) - (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) @@ -830,7 +800,8 @@ external if displayed external." (valid-image-instantiator-format-p format)) ;; Handle Emacs 21 ((fboundp 'image-type-available-p) - (image-type-available-p format)) + (and (display-graphic-p) + (image-type-available-p format))) ;; Nobody else can do images yet. (t nil))) @@ -843,4 +814,4 @@ external if displayed external." (provide 'mm-decode) -;; mm-decode.el ends here +;;; mm-decode.el ends here diff --git a/lisp/mm-partial.el b/lisp/mm-partial.el new file mode 100644 index 0000000..4d60a85 --- /dev/null +++ b/lisp/mm-partial.el @@ -0,0 +1,153 @@ +;;; mm-partial.el --- showing message/partial +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu +;; Keywords: message partial + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'gnus-sum) +(require 'mm-util) +(require 'mm-decode) + +(defun mm-partial-find-parts (id &optional art) + (let ((headers (save-excursion + (set-buffer gnus-summary-buffer) + gnus-newsgroup-headers)) + phandles handles header) + (while (setq header (pop headers)) + (unless (eq (aref header 0) art) + (mm-with-unibyte-buffer + (gnus-request-article-this-buffer (aref header 0) + gnus-newsgroup-name) + (when (search-forward id nil t) + (let ((nhandles (mm-dissect-buffer)) nid) + (setq handles gnus-article-mime-handles) + (if (consp (car nhandles)) + (mm-destroy-parts nhandles) + (setq nid (cdr (assq 'id + (cdr (mm-handle-type nhandles))))) + (if (not (equal id nid)) + (mm-destroy-parts nhandles) + (push nhandles phandles)))))))) + phandles)) + +;;;###autoload +(defun mm-inline-partial (handle &optional no-display) + "Show the partial part of HANDLE. +This function replaces the buffer of HANDLE with a buffer contains +the entire message. +If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." + (let ((id (cdr (assq 'id (cdr (mm-handle-type handle))))) + phandles + (b (point)) (n 1) total + phandle nn ntotal + gnus-displaying-mime handles buffer) + (unless (mm-handle-cache handle) + (unless id + (error "Can not find message/partial id.")) + (setq phandles + (sort (cons handle + (mm-partial-find-parts + id + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-article-number)))) + #'(lambda (a b) + (let ((anumber (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type a)))))) + (bnumber (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type b))))))) + (< anumber bnumber))))) + (setq gnus-article-mime-handles + (append (if (listp (car gnus-article-mime-handles)) + gnus-article-mime-handles + (list gnus-article-mime-handles)) + phandles)) + (save-excursion + (set-buffer (generate-new-buffer "*mm*")) + (while (setq phandle (pop phandles)) + (setq nn (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type phandle)))))) + (setq ntotal (string-to-number + (cdr (assq 'total + (cdr (mm-handle-type phandle)))))) + (if ntotal + (if total + (unless (eq total ntotal) + (error "The numbers of total are different.")) + (setq total ntotal))) + (unless (< nn n) + (unless (eq nn n) + (error "Missing part %d" n)) + (mm-insert-part phandle) + (goto-char (point-max)) + (when (not (eq 0 (skip-chars-backward "\r\n"))) + ;; remove tail blank spaces except one + (if (looking-at "\r?\n") + (goto-char (match-end 0))) + (delete-region (point) (point-max))) + (setq n (+ n 1)))) + (unless total + (error "Don't known the total number of")) + (if (<= n total) + (error "Missing part %d" n)) + (kill-buffer (mm-handle-buffer handle)) + (setcar handle (current-buffer)) + (mm-handle-set-cache handle t))) + (unless no-display + (save-excursion + (save-restriction + (narrow-to-region b b) + (mm-insert-part handle) + (let (gnus-article-mime-handles) + (run-hooks 'gnus-article-decode-hook) + (gnus-article-prepare-display) + (setq handles gnus-article-mime-handles)) + (when handles + ;; It is in article buffer. + (setq gnus-article-mime-handles + (nconc (if (listp (car gnus-article-mime-handles)) + gnus-article-mime-handles + (list gnus-article-mime-handles)) + (if (listp (car handles)) + handles (list handles))))) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (condition-case nil + ;; This is only valid on XEmacs. + (mapcar (lambda (prop) + (remove-specifier + (face-property 'default prop) (current-buffer))) + '(background background-pixmap foreground)) + (error nil)) + (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) + +;; mm-partial.el ends here diff --git a/lisp/mm-view.el b/lisp/mm-view.el index b63de67..fe36cf6 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -40,23 +40,13 @@ ;;; Functions for displaying various formats inline ;;; (defun mm-inline-image-emacs (handle) - (let ((b (point)) - (overlay nil) - (string (copy-sequence "[MM-INLINED-IMAGE]")) + (let ((b (point-marker)) buffer-read-only) (insert "\n") - (buffer-name) - (setq overlay (make-overlay (point) (point) (current-buffer))) - (put-text-property 0 (length string) 'display (mm-get-image handle) string) - (overlay-put overlay 'before-string string) - + (put-image (mm-get-image handle) b "x") (mm-handle-set-undisplayer handle - `(lambda () - (let (buffer-read-only) - (delete-overlay ,overlay) - (delete-region ,(set-marker (make-marker) b) - ,(set-marker (make-marker) (point)))))))) + `(lambda () (remove-images ,b (1+ ,b)))))) (defun mm-inline-image-xemacs (handle) (let ((b (point)) @@ -73,10 +63,10 @@ (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t))) -(defun mm-inline-image (handle) - (if mm-xemacs-p - (mm-inline-image-xemacs handle) - (mm-inline-image-emacs handle))) +(eval-and-compile + (if (string-match "XEmacs" (emacs-version)) + (fset 'mm-inline-image 'mm-inline-image-xemacs) + (fset 'mm-inline-image 'mm-inline-image-emacs))) (defvar mm-w3-setup nil) (defun mm-setup-w3 () @@ -157,11 +147,12 @@ (vcard-parse-string (mm-get-part handle) 'vcard-standard-filter)))))) (t - (setq text (mm-get-part handle)) (let ((b (point)) (charset (mail-content-type-get (mm-handle-type handle) 'charset))) - (insert (mm-decode-string text charset)) + (if (eq charset 'gnus-decoded) + (mm-insert-part handle) + (insert (mm-decode-string (mm-get-part handle) charset))) (when (and (equal type "plain") (equal (cdr (assoc 'format (mm-handle-type handle))) "flowed")) diff --git a/lisp/mml.el b/lisp/mml.el index 334cb8d..b966a17 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -27,9 +27,13 @@ (require 'mm-bodies) (require 'mm-encode) (require 'mm-decode) +(eval-when-compile 'cl) (eval-and-compile - (autoload 'message-make-message-id "message")) + (autoload 'message-make-message-id "message") + (autoload 'gnus-setup-posting-charset "gnus-msg") + (autoload 'message-fetch-field "message") + (autoload 'message-posting-charset "message")) (defvar mml-generate-multipart-alist nil "*Alist of multipart generation functions. @@ -80,7 +84,7 @@ one charsets.") (defun mml-parse-1 () "Parse the current buffer as an MML document." - (let (struct tag point contents charsets warn use-ascii) + (let (struct tag point contents charsets warn use-ascii no-markup-p) (while (and (not (eobp)) (not (looking-at "<#/multipart"))) (cond @@ -90,12 +94,13 @@ one charsets.") (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part)))) struct)) (t - (if (looking-at "<#part") + (if (or (looking-at "<#part") (looking-at "<#mml")) (setq tag (mml-read-tag)) (setq tag (list 'part '(type . "text/plain")) + no-markup-p t warn t)) (setq point (point) - contents (mml-read-part) + contents (mml-read-part (eq 'mml (car tag))) charsets (mm-find-mime-charset-region point (point))) (when (memq nil charsets) (if (or (memq 'unknown-encoding mml-confirmation-set) @@ -108,8 +113,11 @@ one charsets.") (setq warn nil)) (error "Edit your message to remove those characters"))) (if (< (length charsets) 2) - (push (nconc tag (list (cons 'contents contents))) - struct) + (if (or (not no-markup-p) + (string-match "[^ \t\r\n]" contents)) + ;; Don't create blank parts. + (push (nconc tag (list (cons 'contents contents))) + struct)) (let ((nstruct (mml-parse-singlepart-with-multiple-charsets tag point (point) use-ascii))) (when (and warn @@ -200,22 +208,32 @@ one charsets.") (skip-chars-forward " \t\n") (cons (intern name) (nreverse contents)))) -(defun mml-read-part () - "Return the buffer up till the next part, multipart or closing part or multipart." - (let ((beg (point))) +(defun mml-read-part (&optional mml) + "Return the buffer up till the next part, multipart or closing part or multipart. +If MML is non-nil, return the buffer up till the correspondent mml tag." + (let ((beg (point)) (count 1)) ;; If the tag ended at the end of the line, we go to the next line. (when (looking-at "[ \t]*\n") (forward-line 1)) - (if (re-search-forward - "<#\\(/\\)?\\(multipart\\|part\\|external\\)." nil t) - (prog1 - (buffer-substring-no-properties beg (match-beginning 0)) - (if (or (not (match-beginning 1)) - (equal (match-string 2) "multipart")) - (goto-char (match-beginning 0)) - (when (looking-at "[ \t]*\n") - (forward-line 1)))) - (buffer-substring-no-properties beg (goto-char (point-max)))))) + (if mml + (progn + (while (and (> count 0) (not (eobp))) + (if (re-search-forward "<#\\(/\\)?mml." nil t) + (setq count (+ count (if (match-beginning 1) -1 1))) + (goto-char (point-max)))) + (buffer-substring-no-properties beg (if (> count 0) + (point) + (match-beginning 0)))) + (if (re-search-forward + "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) + (prog1 + (buffer-substring-no-properties beg (match-beginning 0)) + (if (or (not (match-beginning 1)) + (equal (match-string 2) "multipart")) + (goto-char (match-beginning 0)) + (when (looking-at "[ \t]*\n") + (forward-line 1)))) + (buffer-substring-no-properties beg (goto-char (point-max))))))) (defvar mml-boundary nil) (defvar mml-base-boundary "-=-=") @@ -224,7 +242,7 @@ one charsets.") (defun mml-generate-mime () "Generate a MIME message based on the current MML document." (let ((cont (mml-parse)) - (mml-multipart-number 0)) + (mml-multipart-number mml-multipart-number)) (if (not cont) nil (with-temp-buffer @@ -237,7 +255,7 @@ one charsets.") (defun mml-generate-mime-1 (cont) (cond - ((eq (car cont) 'part) + ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let (coded encoding charset filename type) (setq type (or (cdr (assq 'type cont)) "text/plain")) (if (member (car (split-string type "/")) '("text" "message")) @@ -248,6 +266,8 @@ one charsets.") ((and (setq filename (cdr (assq 'filename cont))) (not (equal (cdr (assq 'nofile cont)) "yes"))) (mm-insert-file-contents filename)) + ((eq 'mml (car cont)) + (insert (cdr (assq 'contents cont)))) (t (save-restriction (narrow-to-region (point) (point)) @@ -255,22 +275,25 @@ one charsets.") ;; Remove quotes from quoted tags. (goto-char (point-min)) (while (re-search-forward - "<#!+/?\\(part\\|multipart\\|external\\)" nil t) + "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t) (delete-region (+ (match-beginning 0) 2) (+ (match-beginning 0) 3)))))) - (when (string= (car (split-string type "/")) "message") - ;; message/rfc822 parts have to have their heads encoded. - (save-restriction - (message-narrow-to-head) - (let ((rfc2047-header-encoding-alist nil)) - (mail-encode-encoded-word-buffer)))) - (setq charset (mm-encode-body)) - (setq encoding (mm-body-encoding - charset - (if (string= (car (split-string type "/")) - "message") - '8bit - (cdr (assq 'encoding cont))))) + (cond + ((eq (car cont) 'mml) + (let ((mml-boundary (funcall mml-boundary-function + (incf mml-multipart-number)))) + (mml-to-mime)) + (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) + ;; ignore 0x1b, it is part of iso-2022-jp + (setq encoding (mm-body-7-or-8)))) + ((string= (car (split-string type "/")) "message") + (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) + ;; ignore 0x1b, it is part of iso-2022-jp + (setq encoding (mm-body-7-or-8)))) + (t + (setq charset (mm-encode-body)) + (setq encoding (mm-body-encoding + charset (cdr (assq 'encoding cont)))))) (setq coded (buffer-string))) (mm-with-unibyte-buffer (cond @@ -479,7 +502,13 @@ one charsets.") (if (stringp (car handles)) (mml-insert-mime handles) (mml-insert-mime handles t)) - (mm-destroy-parts handles))) + (mm-destroy-parts handles)) + (save-restriction + (message-narrow-to-head) + ;; Remove them, they are confusing. + (message-remove-header "Content-Type") + (message-remove-header "MIME-Version") + (message-remove-header "Content-Transfer-Encoding"))) (defun mml-to-mime () "Translate the current buffer from MML to MIME." @@ -489,17 +518,26 @@ one charsets.") (mail-encode-encoded-word-buffer))) (defun mml-insert-mime (handle &optional no-markup) - (let (textp buffer) + (let (textp buffer mmlp) ;; Determine type and stuff. (unless (stringp (car handle)) - (unless (setq textp (equal (mm-handle-media-supertype handle) - "text")) + (unless (setq textp (equal (mm-handle-media-supertype handle) "text")) (save-excursion (set-buffer (setq buffer (generate-new-buffer " *mml*"))) - (mm-insert-part handle)))) - (unless no-markup - (mml-insert-mml-markup handle buffer textp)) + (mm-insert-part handle) + (if (setq mmlp (equal (mm-handle-media-type handle) + "message/rfc822")) + (mime-to-mml))))) + (if mmlp + (mml-insert-mml-markup handle nil t t) + (unless (and no-markup + (equal (mm-handle-media-type handle) "text/plain")) + (mml-insert-mml-markup handle buffer textp))) (cond + (mmlp + (insert-buffer buffer) + (goto-char (point-max)) + (insert "<#/mml>\n")) ((stringp (car handle)) (mapcar 'mml-insert-mime (cdr handle)) (insert "<#/multipart>\n")) @@ -512,12 +550,14 @@ one charsets.") (t (insert "<#/part>\n"))))) -(defun mml-insert-mml-markup (handle &optional buffer nofile) +(defun mml-insert-mml-markup (handle &optional buffer nofile mmlp) "Take a MIME handle and insert an MML tag." (if (stringp (car handle)) (insert "<#multipart type=" (mm-handle-media-subtype handle) ">\n") - (insert "<#part type=" (mm-handle-media-type handle)) + (if mmlp + (insert "<#mml type=" (mm-handle-media-type handle)) + (insert "<#part type=" (mm-handle-media-type handle))) (dolist (elem (append (cdr (mm-handle-type handle)) (cdr (mm-handle-disposition handle)))) (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")) @@ -626,8 +666,7 @@ one charsets.") 'list (mm-delete-duplicates (nconc - (mapcar (lambda (m) (cdr m)) - mailcap-mime-extensions) + (mapcar 'cdr mailcap-mime-extensions) (apply 'nconc (mapcar @@ -663,7 +702,7 @@ one charsets.") (goto-char (point-min)) ;; Quote parts. (while (re-search-forward - "<#/?!*\\(multipart\\|part\\|external\\)" nil t) + "<#/?!*\\(multipart\\|part\\|external\\|mml\\)" nil t) ;; Insert ! after the #. (goto-char (+ (match-beginning 0) 2)) (insert "!"))))) @@ -678,7 +717,7 @@ one charsets.") (value (pop plist))) (when value ;; Quote VALUE if it contains suspicious characters. - (when (string-match "[\"\\~/* \t\n]" value) + (when (string-match "[\"'\\~/*;() \t\n]" value) (setq value (prin1-to-string value))) (insert (format " %s=%s" key value))))) (insert ">\n")) @@ -751,7 +790,10 @@ TYPE is the MIME type to use." "Display current buffer with Gnus, in a new buffer. If RAW, don't highlight the article." (interactive "P") - (let ((buf (current-buffer))) + (let ((buf (current-buffer)) + (message-posting-charset (or (gnus-setup-posting-charset + (message-fetch-field "Newsgroups")) + message-posting-charset))) (switch-to-buffer (get-buffer-create (concat (if raw "*Raw MIME preview of " "*MIME preview of ") (buffer-name)))) @@ -762,9 +804,10 @@ If RAW, don't highlight the article." (replace-match "\n")) (mml-to-mime) (unless raw - (run-hooks 'gnus-article-decode-hook) - (let ((gnus-newsgroup-name "dummy")) - (gnus-article-prepare-display))) + (let ((gnus-newsgroup-charset (car message-posting-charset))) + (run-hooks 'gnus-article-decode-hook) + (let ((gnus-newsgroup-name "dummy")) + (gnus-article-prepare-display)))) (fundamental-mode) (setq buffer-read-only t) (goto-char (point-min)))) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 3ab4729..afdeab8 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -71,8 +71,8 @@ from the document.") (body-begin-function . nndoc-babyl-body-begin) (head-begin-function . nndoc-babyl-head-begin)) (forward - (article-begin . "^-+ Start of forwarded message -+\n+") - (body-end . "^-+ End of forwarded message -+$") + (article-begin . "^-+ \\(Start of \\)?forwarded message -+\n+") + (body-end . "^-+ End \\(of \\)?forwarded message -+$") (prepare-body-function . nndoc-unquote-dashes)) (rfc934 (article-begin . "^--.*\n+") diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 1793852..5f6ecd1 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -519,7 +519,8 @@ (defun nnmbox-create-mbox () (when (not (file-exists-p nnmbox-mbox-file)) (let ((nnmail-file-coding-system - nnmbox-file-coding-system-for-write)) + (or nnmbox-file-coding-system-for-write + nnmbox-file-coding-system))) (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)))) (defun nnmbox-read-mbox () diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 8875891..d404285 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -80,7 +80,7 @@ Valid encodings are nil, `Q' and `B'.") (defvar rfc2047-q-encoding-alist '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/=_") - ("." . "^\000-\007\013\015-\037\200-\377=_?")) + ("." . "^\000-\007\011\013\015-\037\200-\377=_?")) "Alist of header regexps and valid Q characters.") ;;; @@ -112,7 +112,13 @@ Should be called narrowed to the head of the message." (while (not (eobp)) (save-restriction (rfc2047-narrow-to-field) - (when (rfc2047-encodable-p) + (if (not (rfc2047-encodable-p)) + (if (mm-body-7-or-8) + ;; 8 bit must be decoded. + (if (car message-posting-charset) + ;; Is message-posting-charset a coding system? + (mm-encode-coding-region (point-min) (point-max) + (car message-posting-charset)))) ;; We found something that may perhaps be encoded. (while (setq elem (pop alist)) (when (or (and (stringp (car elem)) @@ -128,7 +134,7 @@ Should be called narrowed to the head of the message." (t))) (goto-char (point-max))))) (when mail-parse-charset - (encode-coding-region + (mm-encode-coding-region (point-min) (point-max) mail-parse-charset)))) (defun rfc2047-encodable-p (&optional header) @@ -158,11 +164,9 @@ Should be called narrowed to the head of the message." (while (not (eobp)) (cond ((not state) - (if (memq (char-after) blank-list) - (setq state 'blank) - (setq state 'word) - (if (not (eq (setq cs (mm-charset-after)) 'ascii)) - (setq current cs))) + (setq state 'word) + (if (not (eq (setq cs (mm-charset-after)) 'ascii)) + (setq current cs)) (setq b (point))) ((eq state 'blank) (cond @@ -171,6 +175,8 @@ Should be called narrowed to the head of the message." ((memq (char-after) blank-list)) (t (setq state 'word) + (unless b + (setq b (point))) (if (not (eq (setq cs (mm-charset-after)) 'ascii)) (setq current cs))))) ((eq state 'word) @@ -181,9 +187,11 @@ Should be called narrowed to the head of the message." (setq current nil)) ((memq (char-after) blank-list) (setq state 'blank) - (push (list b (point) current) words) - (setq current nil) - (setq b (point))) + (if (not current) + (setq b nil) + (push (list b (point) current) words) + (setq b (point)) + (setq current nil))) ((or (eq (setq cs (mm-charset-after)) 'ascii) (if current (eq current cs) @@ -207,7 +215,10 @@ Should be called narrowed to the head of the message." (if (equal (nth 2 word) current) (setq beg (nth 0 word)) (when current - (rfc2047-encode beg end current)) + (when (prog1 (and (eq beg (nth 1 word)) (nth 2 word)) + (rfc2047-encode beg end current)) + (goto-char beg) + (insert " "))) (setq current (nth 2 word) beg (nth 0 word) end (nth 1 word)))) diff --git a/lisp/webmail.el b/lisp/webmail.el index 78b518c..bc33f3a 100644 --- a/lisp/webmail.el +++ b/lisp/webmail.el @@ -23,6 +23,9 @@ ;;; Commentary: +;; Note: Now mail.yahoo.com provides POP3 service, the webmail +;; fetching is not going to be supported. + ;; Note: You need to have `url' and `w3' installed for this backend to ;; work. `w3' must be 4.0pre46+one-line-cookie patch or standalone ;; `url'. @@ -82,21 +85,21 @@ "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox=" webmail-aux user id)) (yahoo - (paranoid cookie post) + (paranoid agent cookie post) (address . "mail.yahoo.com") (open-url "http://mail.yahoo.com/") (open-snarf . webmail-yahoo-open) (login-url;; yahoo will not accept GET content ("%s" webmail-aux) - ".tries=1&.src=ym&.last=&promo=&lg=us&.intl=us&.bypass=&.chkP=Y&.done=http%%253a%%2F%%2Fedit.yahoo.com%%2Fconfig%%2Fmail%%253f.intl%%3D&login=%s&passwd=%s" + ".tries=&.src=ym&.last=&promo=&.intl=&.bypass=&.partner=&.chkP=Y&.done=&login=%s&passwd=%s" user password) (login-snarf . webmail-yahoo-login) (list-url "%s&rb=Inbox&YN=1" webmail-aux) (list-snarf . webmail-yahoo-list) (article-snarf . webmail-yahoo-article) (trash-url - "%s/ym/us/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2=" + "%s/ym/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2=" webmail-aux id)) (netaddress (paranoid cookie post) @@ -580,11 +583,11 @@ (defun webmail-yahoo-login () (goto-char (point-min)) - (if (re-search-forward "http://[a-zA-Z][0-9]\\.mail\\.yahoo\\.com/" nil t) + (if (re-search-forward "http://[^/]+[0-9]\\.mail\\.yahoo\\.com/" nil t) (setq webmail-aux (match-string 0)) (webmail-error "login@1")) (if (re-search-forward "YY=[0-9]+" nil t) - (setq webmail-aux (concat webmail-aux "ym/us/ShowFolder?" + (setq webmail-aux (concat webmail-aux "ym/ShowFolder?" (match-string 0))) (webmail-error "login@2"))) @@ -600,7 +603,7 @@ (webmail-error "list@1")) (goto-char (point-min)) (while (re-search-forward - "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/us/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\"" + "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\"" nil t) (if (setq url (match-string 1)) (progn diff --git a/texi/ChangeLog b/texi/ChangeLog index cd81980..1c05270 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,18 @@ +2000-04-27 Dave Love + + * gnus.texi (Article Washing): Update x-face bit. + +2000-04-26 Florian Weimer + + * message.texi (Various Message Variables): Document + message-default-charset. + + * emacs-mime.texi (Charset Translation): New section. + +2000-04-26 02:30:06 Shenghuo ZHU + + * gnus.texi (Posting Styles): Addition. + 2000-04-24 17:09:17 Felix Natter * gnusref.tex: New version. diff --git a/texi/Makefile.in b/texi/Makefile.in index 5a99614..63a96b0 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -69,10 +69,10 @@ makeinfo: makeinfo -o message message.texi texi2latex.elc: texi2latex.el - $(EMACS) -batch -l bytecomp --eval '(byte-compile-file "texi2latex.el")' + $(EMACSINFO) -batch -l bytecomp --eval '(byte-compile-file "texi2latex.el")' latex: gnus.texi texi2latex.elc - $(EMACS) -batch -q -no-site-file gnus.texi -l ./texi2latex.elc -f latexi-translate + $(EMACSINFO) -batch -q -no-site-file gnus.texi -l ./texi2latex.elc -f latexi-translate latexps: make texi2latex.elc diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 82afa01..efda9aa 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -960,6 +960,7 @@ string containing the @sc{mime} message. * Simple MML Example:: An example MML document. * MML Definition:: All valid MML elements. * Advanced MML Example:: Another example MML document. +* Charset Translation:: How charsets are mapped from @sc{mule} to MIME. * Conversion:: Going from @sc{mime} to MML and vice versa. @end menu @@ -1181,6 +1182,43 @@ This plain text part is an attachment. --=-=-=-- @end example +@node Charset Translation +@section Charset Translation +@cindex charsets + +During translation from MML to @sc{mime}, for each @sc{mime} part which +has been composed inside Emacs, an appropriate charset has to be chosen. + +@vindex mail-parse-charset +If you are running a non-@sc{mule} Emacs, this process is simple: If the +part contains any non-ASCII (8-bit) characters, the @sc{mime} charset +given by @code{mail-parse-charset} (a symbol) is used. (Never set this +variable directly, though. If you want to change the default charset, +please consult the documentation of the package which you use to process +@sc{mime} messages. +@xref{Various Message Variables, , Various Message Variables, message, + Message Manual}, for example.) +If there are only ASCII characters, the @sc{mime} charset US-ASCII is +used, of course. + +@cindex MULE +@cindex UTF-8 +@cindex Unicode +@vindex mm-mime-mule-charset-alist +Things are slightly more complicated when running Emacs with @sc{mule} +support. In this case, a list of the @sc{mule} charsets used in the +part is obtained, and the @sc{mule} charsets are translated to @sc{mime} +charsets by consulting the variable @code{mm-mime-mule-charset-alist}. +If this results in a single @sc{mime} charset, this is used to encode +the part. But if the resulting list of @sc{mime} charsets contains more +than one element, two things can happen: If it is possible to encode the +part via UTF-8, this charset is used. (For this, Emacs must support +the @code{utf-8} coding system, and the part must consist entirely of +characters which have Unicode counterparts.) If UTF-8 is not available +for some reason, the part is split into several ones, so that each one +can be encoded with a single @sc{mime} charset. The part can only be +split at line boundaries, though---if more than one @sc{mime} charset is +required to encode a single line, it is not possible to encode the part. @node Conversion @section Conversion diff --git a/texi/gnus.texi b/texi/gnus.texi index 366d522..51562e5 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -355,7 +355,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Gnus 5.8.5. +This manual corresponds to Gnus 5.8.6. @end ifinfo @@ -7332,12 +7332,18 @@ If this variable is a string, this string will be executed in a sub-shell. If it is a function, this function will be called with the face as the argument. If the @code{gnus-article-x-face-too-ugly} (which is a regexp) matches the @code{From} header, the face will not be shown. -The default action under Emacs is to fork off an @code{xv} to view the -face; under XEmacs the default action is to display the face before the +The default action under Emacs is to fork off the @code{display} +program@footnote{@code{display} is from the ImageMagick package. For the +@code{uncompface} and @code{icontopbm} programs look for a package +like `compface' or `faces-xface' on a GNU/Linux system.} +to view the face. Under XEmacs or Emacs 21+ with suitable image +support, the default action is to display the face before the @code{From} header. (It's nicer if XEmacs has been compiled with X-Face support---that will make display somewhat faster. If there's no native X-Face support, Gnus will try to convert the @code{X-Face} header using -external programs from the @code{pbmplus} package and friends.) If you +external programs from the @code{pbmplus} package and +friends.@footnote{On a GNU/Linux system look for packages with names +like @code{netpbm} or @code{libgr-progs}.}) If you want to have this function in the display hook, it should probably come last. @@ -9700,8 +9706,9 @@ attribute name can be one of @code{signature}, @code{signature-file}, @code{organization}, @code{address}, @code{name} or @code{body}. The attribute name can also be a string. In that case, this will be used as a header name, and the value will be inserted in the headers of the -article. If the attribute name is @code{eval}, the form is evaluated, -and the result is thrown away. +article; if the value is @code{nil}, the header name will be removed. +If the attribute name is @code{eval}, the form is evaluated, and the +result is thrown away. The attribute value can be a string (used verbatim), a function with zero arguments (the return value will be used), a variable (its value @@ -11193,11 +11200,14 @@ An example @sc{imap} mail source: @end lisp @item webmail -Get mail from a webmail server, such as www.hotmail.com, -mail.yahoo.com, www.netaddress.com and www.my-deja.com. +Get mail from a webmail server, such as www.hotmail.com, +webmail.netscape.com, www.netaddress.com, www.my-deja.com. -NOTE: Webmail largely depends on w3 (url) package, whose version of "WWW -4.0pre.46 1999/10/01" or previous ones may not work. +NOTE: Now mail.yahoo.com provides POP3 service, so @sc{pop} mail source +is suggested. + +NOTE: Webmail largely depends cookies. A "one-line-cookie" patch is +required for url "4.0pre.46". WARNING: Mails may lost. NO WARRANTY. @@ -11206,7 +11216,7 @@ Keywords: @table @code @item :subtype The type of the webmail server. The default is @code{hotmail}. The -alternatives are @code{yahoo}, @code{netaddress}, @code{my-deja}. +alternatives are @code{netscape}, @code{netaddress}, @code{my-deja}. @item :user The user name to give to the webmail server. The default is the login @@ -11225,7 +11235,7 @@ folder after finishing the fetch. An example webmail source: @lisp -(webmail :subtype 'yahoo :user "user-name" :password "secret") +(webmail :subtype 'hotmail :user "user-name" :password "secret") @end lisp @end table diff --git a/texi/message.texi b/texi/message.texi index 26b7693..da25d5e 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Message 5.8.5 Manual +@settitle Message 5.8.6 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Message 5.8.5 Manual +@title Message 5.8.6 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Message 5.8.5. Message is distributed with +This manual corresponds to Message 5.8.6. Message is distributed with the Gnus distribution bearing the same version number as this manual. @@ -1028,6 +1028,17 @@ posting a prepared news message. @section Various Message Variables @table @code +@item message-default-charset +@vindex message-default-charset +@cindex charset +Symbol naming a @sc{mime} charset. Non-ASCII characters in messages are +assumed to be encoded using this charset. The default is @code{nil}, +which means ask the user. (This variable is used only on non-@sc{mule} +Emacsen. +@xref{Charset Translation, , Charset Translation, emacs-mime, + Emacs MIME Manual}, for details on the @sc{mule}-to-@sc{mime} +translation process. + @item message-signature-separator @vindex message-signature-separator Regexp matching the signature separator. It is @samp{^-- *$} by -- 1.7.10.4