+Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen <lmi@quimbies.gnus.org>
+
+ * gnus.el: Gnus v5.8.6 is released.
+
+2000-04-28 21:14:21 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2047.el (rfc2047-q-encoding-alist): Encode HTAB.
+
+2000-04-28 16:37:09 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-send-mail-partially): Use forward-line.
+
+2000-04-28 16:01:09 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-button-menu): Use call-interactively.
+
+2000-04-28 15:30:17 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * 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 <fx@gnu.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * message.el (message-send-mail-partially): Remove CTE.
+
+2000-04-28 00:31:53 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * lpath.el: Fbind put-image for XEmacs.
+ * mm-view.el (mm-inline-image): Fset it.
+
+2000-04-27 23:23:37 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * nndoc.el (nndoc-type-alist): Change forward regexp.
+
+2000-04-27 21:57:10 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-send-mail-partially-limit): Change the
+ default value.
+
+2000-04-27 21:53:32 Erik Toubro Nielsen <erik@ifad.dk>
+
+ * gnus-util.el (gnus-extract-address-components): Name might be
+ "".
+
+2000-04-27 20:32:06 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <fx@gnu.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * mml.el (mml-insert-tag): Match more special characters.
+
+2000-04-27 09:06:29 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-bug): Avoid attaching the external buffer.
+
+2000-04-27 00:58:43 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-inline-media-tests): Add message/partial.
+ (mm-inlined-types): Ditto.
+ * mm-partial.el: New file.
+
+2000-04-27 Dave Love <fx@gnu.org>
+
+ * mailcap.el (mailcap-mime-data): Fix octet-stream syntax -- might
+ matter in Emacs 21.
+
+2000-04-26 Florian Weimer <fw@deneb.cygnus.argh.org>
+
+ * mm-bodies.el (mm-encode-body): Remove reference to
+ mm-default-charset in comment.
+
+2000-04-24 00:56:00 Björn Torkelsson <torkel@hpc2n.umu.se>
+
+ * rfc2047.el (rfc2047-encode-message-header): Fixing typo.
+
+2000-04-26 12:27:41 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-draft.el (gnus-draft-send): Move gnus-draft-setup inside of
+ let.
+
+2000-04-26 12:26:10 Pavel Janik ml. <Pavel.Janik@inet.cz>
+
+ * gnus-draft.el (gnus-draft-setup): Fix comments.
+
+2000-04-26 10:06:12 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-configure-posting-styles): Just remove the
+ header if nil.
+
+2000-04-26 00:23:46 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-view.el (mm-inline-text): Insert directly if decoded.
+ * mml.el (autoload): Typo.
+
+2000-04-25 22:46:36 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * webmail.el: Fix yahoo mail.
+
+2000-04-25 20:12:17 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-netrc-machine): Another default to nntp.
+
+2000-04-24 18:14:12 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * gnus-score.el (gnus-score-headers): Copy gnus-newsgrou-scored
+ back.
+
+2000-04-24 16:01:15 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-treat-article): Make sure that the summary
+ buffer is live.
+
+2000-04-24 15:42:53 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <lmi@quimbies.gnus.org>
* gnus.el: Gnus v5.8.5 is released.
(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)
: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
(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."
(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)
(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))
(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)
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
;;;!!!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)
;;; 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])
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
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
(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
(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:
(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.
(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."
(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"
(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 "")))
`(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 ()
(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)))
;;;###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))))
\f
;;;
(and (string-match "(.*" from)
(setq name (substring from (1+ (match-beginning 0))
(match-end 0)))))
- ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
- (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."
(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))))
;;; 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 <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
: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)
"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
_ ___ _ _
_ ___ __ ___ __ _ ___
__ _ ___ __ ___
__
"
- ""))
- ;; 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)
"*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
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
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))
("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")
(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)
(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
(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))
((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 \;
"*" 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
((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)
(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.
(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)))
"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)
: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
"\\([" 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.")
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)
(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"))
(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)))
"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))
(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)
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)
;; 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.
)
(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."
(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)
(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)
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:
(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)))))
(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)))
(unwind-protect
(progn
(call-process shell-file-name nil
- (setq buffer
+ (setq buffer
(generate-new-buffer "*mm*"))
nil
shell-command-switch
(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)
(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)
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))
"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)
(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)))
(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)))
(provide 'mm-decode)
-;; mm-decode.el ends here
+;;; mm-decode.el ends here
--- /dev/null
+;;; mm-partial.el --- showing message/partial
+;; Copyright (C) 2000 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; 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
;;; 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))
(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 ()
(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"))
(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.
(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
(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)
(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
(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 "-=-=")
(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
(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"))
((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))
;; 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
(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."
(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"))
(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) "\""))
'list
(mm-delete-duplicates
(nconc
- (mapcar (lambda (m) (cdr m))
- mailcap-mime-extensions)
+ (mapcar 'cdr mailcap-mime-extensions)
(apply
'nconc
(mapcar
(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 "!")))))
(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"))
"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))))
(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))))
(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+")
(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 ()
(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.")
;;;
(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))
(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)
(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
((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)
(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)
(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))))
;;; 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'.
"%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)
(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")))
(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
+2000-04-27 Dave Love <fx@gnu.org>
+
+ * gnus.texi (Article Washing): Update x-face bit.
+
+2000-04-26 Florian Weimer <fw@deneb.cygnus.argh.org>
+
+ * message.texi (Various Message Variables): Document
+ message-default-charset.
+
+ * emacs-mime.texi (Charset Translation): New section.
+
+2000-04-26 02:30:06 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.texi (Posting Styles): Addition.
+
2000-04-24 17:09:17 Felix Natter <f.natter@ndh.net>
* gnusref.tex: New version.
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
* 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
--=-=-=--
@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
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
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.
@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
@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.
@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
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
\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
@tex
@titlepage
-@title Message 5.8.5 Manual
+@title Message 5.8.6 Manual
@author by Lars Magne Ingebrigtsen
@page
* 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.
@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
projects / elisp / gnus.git- / commitdiff