changeset 31764:54ae1def18cf

Merge from Gnus trunk.
author Dave Love <fx@gnu.org>
date Wed, 20 Sep 2000 11:46:48 +0000
parents 1d2b57dffb60
children 57964eceb2e2
files lisp/gnus/mail-source.el lisp/gnus/mm-decode.el lisp/gnus/mm-view.el lisp/gnus/mml.el lisp/gnus/rfc2047.el
diffstat 5 files changed, 166 insertions(+), 17 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/mail-source.el	Wed Sep 20 11:22:36 2000 +0000
+++ b/lisp/gnus/mail-source.el	Wed Sep 20 11:46:48 2000 +0000
@@ -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 @@
 
 (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 @@
     (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 @@
 	       (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
--- a/lisp/gnus/mm-decode.el	Wed Sep 20 11:22:36 2000 +0000
+++ b/lisp/gnus/mm-decode.el	Wed Sep 20 11:46:48 2000 +0000
@@ -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)
--- a/lisp/gnus/mm-view.el	Wed Sep 20 11:22:36 2000 +0000
+++ b/lisp/gnus/mm-view.el	Wed Sep 20 11:46:48 2000 +0000
@@ -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
--- a/lisp/gnus/mml.el	Wed Sep 20 11:22:36 2000 +0000
+++ b/lisp/gnus/mml.el	Wed Sep 20 11:46:48 2000 +0000
@@ -126,10 +126,7 @@
 		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 @@
 		  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 @@
 	(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"))
--- a/lisp/gnus/rfc2047.el	Wed Sep 20 11:22:36 2000 +0000
+++ b/lisp/gnus/rfc2047.el	Wed Sep 20 11:46:48 2000 +0000
@@ -79,8 +79,11 @@
   "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.")
 
 ;;;