From ce9401f30b839389617facbbeb10a8aab3a51ba9 Mon Sep 17 00:00:00 2001 From: Dave Love Date: Wed, 20 Sep 2000 11:46:48 +0000 Subject: [PATCH] Merge from Gnus trunk. --- lisp/gnus/mail-source.el | 145 +++++++++++++++++++++++++++++++++++++-- lisp/gnus/mm-decode.el | 6 +- lisp/gnus/mm-view.el | 10 ++- lisp/gnus/mml.el | 15 ++-- lisp/gnus/rfc2047.el | 7 +- 5 files changed, 166 insertions(+), 17 deletions(-) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index f2a431dc265..0d3c88a2218 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -33,13 +33,145 @@ (defgroup mail-source nil "The mail-fetching library." + :version "21.1" :group 'gnus) -(defcustom mail-sources nil +(defcustom mail-sources '((file)) "*Where the mail backends will look for incoming mail. -This variable is a list of mail source specifiers." +This variable is a list of mail source specifiers. +See Info node `(gnus)Mail Source Specifiers'." :group 'mail-source - :type 'sexp) + ;; This specification should be tidied up, particularly to avoid + ;; constant items appearing. (Perhaps there's scope for improvment + ;; in the widget code.) + :type `(repeat + (choice (const :tag "Default spool file" (file)) + (list :tag "Specified spool file" + (const file) + (const :value :path) + file) + (cons :tag "Several files in a directory" + (const directory) + (choice + :tag "Options" + (const :tag "None" nil) + (repeat + (choice + (list :inline t :tag "path" + (const :value :path) directory) + (list :inline t :tag "suffix" + (const :value :suffix) string) + (list :inline t :tag "predicate" + (const :value :predicate) function) + (list :inline t :tag "prescript" + (const :value :prescript) string) + (list :inline t :tag "postscript" + (const :value :postscript) string) + (list :inline t :tag "plugged" + (const :value :plugged) boolean))))) + (cons :tag "POP3 server" + (const pop) + (choice + :tag "Options" + (const :tag "None" nil) + (repeat + (choice + (list :inline t :tag "server" + (const :value :server) string) + (list :inline t :tag "port" + (const :value :port) (choice number string)) + (list :inline t :tag "user" + (const :value :user) string) + (list :inline t :tag "password" + (const :value :password) string) + (list :inline t :tag "program" + (const :value :program) string) + (list :inline t :tag "prescript" + (const :value :prescript) string) + (list :inline t :tag "postscript" + (const :value :postscript) string) + (list :inline t :tag "function" + (const :value :function) function) + (list :inline t :tag "authentication" + (const :value :authentication) + (choice (const password) + (const apop))) + (list :inline t :tag "plugged" + (const :value :plugged) boolean))))) + (cons :tag "Maildir (qmail, postfix...)" + (const maildir) + (choice + :tag "Options" + (const :tag "None" nil) + (repeat + (choice + (list :inline t :tag "path" + (const :value :path) directory) + (list :inline t :tag "plugged" + (const :value :plugged) boolean))))) + (cons :tag "IMAP server" + (const imap) + (choice + :tag "Options" + (const :tag "None" nil) + (repeat + (choice + (list :inline t :tag "server" + (const :value :server) string) + (list :inline t :tag "port" + (const :value :port) + (choice number string)) + (list :inline t :tag "user" + (const :value :user) string) + (list :inline t :tag "password" + (const :value :password) string) + (list :inline t :tag "stream" + (const :value :stream) + (choice ,@(progn (require 'imap) + (mapcar + (lambda (a) + (list 'const (car a))) + imap-stream-alist)))) + (list :inline t :tag "authenticator" + (const :value :authenticator) + (choice ,@(progn (require 'imap) + (mapcar + (lambda (a) + (list 'const (car a))) + imap-authenticator-alist)))) + (list :inline t :tag "mailbox" + (const :value :mailbox) string) + (list :inline t :tag "predicate" + (const :value :predicate) function) + (list :inline t :tag "fetchflag" + (const :value :fetchflag) string) + (list :inline t :tag "dontexpunge" + (const :value :dontexpunge) boolean) + (list :inline t :tag "plugged" + (const :value :plugged) ))))) + (cons :tag "Webmail server" + (const webmail) + (choice + :tag "Options" + (const :tag "None" nil) + (repeat + (choice + (list :inline t :tag "subtype" + (const :value :subtype) + ;; Should be generated from + ;; `webmail-type-definition', but we + ;; can't require webmail without W3. + (choice (const hotmail) (const yahoo) + (const netaddress) (const netscape) + (const my-deja))) + (list :inline t :tag "user" + (const :value :user) string) + (list :inline t :tag "password" + (const :value :password) string) + (list :inline t :tag "dontexpunge" + (const :value :dontexpunge) boolean) + (list :inline t :tag "plugged" + (const :value :plugged) boolean)))))))) (defcustom mail-source-primary-source nil "*Primary source for incoming mail. @@ -397,7 +529,7 @@ If ARGS, PROMPT is used as an argument to `format'." (defun mail-source-fetch-with-program (program) (zerop (call-process shell-file-name nil nil nil - shell-command-switch program))) + shell-command-switch program))) (defun mail-source-run-script (script spec &optional delay) (when script @@ -595,6 +727,7 @@ This only works when `display-time' is enabled." (if on (progn (require 'time) + ;; display-time-mail-function is an Emacs 21 feature. (setq display-time-mail-function #'mail-source-new-mail-p) ;; Set up the main timer. (setq mail-source-report-new-mail-timer @@ -673,6 +806,10 @@ This only works when `display-time' is enabled." (imap-mailbox-select mailbox nil buf)) (let (str (coding-system-for-write 'binary)) (with-temp-file mail-source-crash-box + ;; In some versions of FSF Emacs, inserting unibyte + ;; string into multibyte buffer may convert 8-bit chars + ;; into latin-iso8859-1 chars, which results \201's. + (mm-disable-multibyte) ;; remember password (with-current-buffer buf (when (or imap-password diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 69f0d1898ad..97fa35b4c1f 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -119,6 +119,7 @@ ("text/x-patch" mm-display-patch-inline (lambda (handle) (locate-library "diff-mode"))) + ("application/emacs-lisp" mm-display-elisp-inline identity) ("text/html" mm-inline-text (lambda (handle) @@ -153,7 +154,7 @@ (defcustom mm-inlined-types '("image/.*" "text/.*" "message/delivery-status" "message/rfc822" - "message/partial" + "message/partial" "application/emacs-lisp" "application/pgp-signature") "List of media types that are to be displayed inline." :type '(repeat string) @@ -162,7 +163,8 @@ (defcustom mm-automatic-display '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" - "message/rfc822" "text/x-patch" "application/pgp-signature") + "message/rfc822" "text/x-patch" "application/pgp-signature" + "application/emacs-lisp") "A list of MIME types to be displayed automatically." :type '(repeat string) :group 'mime-display) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 45ed4d2a7e2..5bf4f09e3b9 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -260,11 +260,11 @@ (error nil)) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) -(defun mm-display-patch-inline (handle) +(defun mm-display-inline-fontify (handle mode) (let (text) (with-temp-buffer (mm-insert-part handle) - (diff-mode) + (funcall mode) (font-lock-fontify-buffer) (when (fboundp 'extent-list) (map-extents (lambda (ext ignored) @@ -274,6 +274,12 @@ (setq text (buffer-string))) (mm-insert-inline handle text))) +(defun mm-display-patch-inline (handle) + (mm-display-inline-fontify handle 'diff-mode)) + +(defun mm-display-elisp-inline (handle) + (mm-display-inline-fontify handle 'emacs-lisp-mode)) + (provide 'mm-view) ;; mm-view.el ends here diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 86faed8aa53..1d71f4bc3a3 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -126,10 +126,7 @@ The function is called with one parameter, which is the generated part.") warn t)) (setq raw (cdr (assq 'raw tag)) point (point) - contents (if raw - (mm-with-unibyte-current-buffer - (mml-read-part (eq 'mml (car tag)))) - (mml-read-part (eq 'mml (car tag)))) + contents (mml-read-part (eq 'mml (car tag))) charsets (if raw nil (mm-find-mime-charset-region point (point)))) (when (and (not raw) (memq nil charsets)) @@ -352,8 +349,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." coded (buffer-string)))) (mml-insert-mime-headers cont type charset encoding) (insert "\n") - (mm-with-unibyte-current-buffer - (insert coded)))) + (insert coded))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string @@ -852,7 +848,12 @@ If RAW, don't highlight the article." (replace-match "\n")) (mml-to-mime) (if raw - (mm-disable-multibyte) + (when (fboundp 'set-buffer-multibyte) + (let ((s (buffer-string))) + ;; Insert the content into unibyte buffer. + (erase-buffer) + (mm-disable-multibyte) + (insert s))) (let ((gnus-newsgroup-charset (car message-posting-charset))) (run-hooks 'gnus-article-decode-hook) (let ((gnus-newsgroup-name "dummy")) diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index 7a86311396e..0b10d04d44d 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -79,8 +79,11 @@ Valid encodings are nil, `Q' and `B'.") "Alist of RFC2047 encodings to encoding functions.") (defvar rfc2047-q-encoding-alist - '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/=_") - ("." . "^\000-\007\011\013\015-\037\200-\377=_?")) + '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/") + ;; = (\075), _ (\137), ? (\077) are used in the encoded word. + ;; Avoid using 8bit characters. Some versions of Emacs has bug! + ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" + ("." . "\010\012\014\040-\074\076\100-\136\140-\177")) "Alist of header regexps and valid Q characters.") ;;; -- 2.39.2