* lisp/gnus.el (gnus-version-number): Update to 6.10.017.
authoryamaoka <yamaoka>
Fri, 11 Sep 1998 09:14:57 +0000 (09:14 +0000)
committeryamaoka <yamaoka>
Fri, 11 Sep 1998 09:14:57 +0000 (09:14 +0000)
* lisp/gnus-art.el (gnus-show-mime) (gnus-summary-toggle-mime):
Revived.

* lisp/gnus-mailcap.el: New file. Renamed from `mailcap.el'.

* Sync up with Pterodactyl Gnus 0.25.

A snapshot is available from
 ftp://ftp.jpl.org/pub/tmp/semi-gnus-pgnus-ichikawa-19980911-2.tar.gz

18 files changed:
ChangeLog
lisp/ChangeLog
lisp/drums.el
lisp/earcon.el
lisp/gnus-art.el
lisp/gnus-mailcap.el [new file with mode: 0644]
lisp/gnus-sum.el
lisp/gnus-util.el
lisp/gnus-xmas.el
lisp/gnus.el
lisp/lpath.el
lisp/mm-bodies.el
lisp/mm-decode.el
lisp/mm-util.el
lisp/parse-time.el
texi/gnus-ja.texi
texi/gnus.texi
texi/message.texi

index 16ae315..0107831 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,16 @@
 1998-09-11  Katsumi Yamaoka   <yamaoka@jpl.org>
 
+       * lisp/gnus.el (gnus-version-number): Update to 6.10.017.
+
+       * lisp/gnus-art.el (gnus-show-mime) (gnus-summary-toggle-mime):
+       Revived.
+
+       * lisp/gnus-mailcap.el: New file. Renamed from `mailcap.el'.
+
+       * Sync up with Pterodactyl Gnus 0.25.
+
+1998-09-11  Katsumi Yamaoka   <yamaoka@jpl.org>
+
        * lisp/gnus-art.el (article-make-date-line): Add TZ value to
        `local' and `ut' date.
 
index 312755f..f088f06 100644 (file)
@@ -1,3 +1,51 @@
+Fri Sep 11 08:09:40 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
+
+       * gnus.el: Pterodactyl Gnus v0.25 is released.
+
+1998-09-11 07:38:14  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-art.el (article-remove-trailing-blank-lines): Don't remove
+       annotations. 
+
+       * gnus.el ((featurep 'gnus-xmas)): New
+       'gnus-annotation-in-region-p alias.
+
+1998-09-10 06:20:52  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * mm-util.el (mm-with-unibyte-buffer): New function.
+
+       * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Renamed.
+
+       * mm-decode.el (mm-inline-media-tests): New variable.
+
+       * gnus-sum.el (gnus-summary-exit): Destroy handles.
+
+       * gnus-art.el (gnus-article-mime-handles): New variable.
+
+       * drums.el (drums-narrow-to-header): New function.
+
+       * gnus-art.el (article-decode-charset): Use it.
+
+       * drums.el (drums-content-type-get): New function.
+
+       * mm-util.el (mm-content-type-charset): Removed.
+
+       * drums.el (drums-syntax-table): @ is word.
+       (drums-parse-content-type): New function.
+
+       * parse-time.el (parse-time-rules): Parse "Wed, 29 Apr 98 0:26:01
+       EDT" times.
+
+       * gnus-util.el (gnus-date-get-time): Use safe date.
+
+       * gnus-sum.el (gnus-show-mime): Removed.
+       (gnus-summary-toggle-mime): Removed.
+
+       * gnus-art.el (gnus-strict-mime): Removed.
+       (gnus-article-prepare): Don't do MIME.
+       (gnus-decode-encoded-word-method): Removed.
+       (gnus-show-mime-method): Removed.
+
 Thu Sep 10 04:03:29 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
 
        * gnus.el: Pterodactyl Gnus v0.24 is released.
index 0344956..b13ec15 100644 (file)
@@ -29,6 +29,7 @@
 ;;; Code:
 
 (require 'time-date)
+(require 'mm-util)
 
 (defvar drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177"
   "US-ASCII control characters excluding CR, LF and white space.")
 (defvar drums-qtext-token
   (concat drums-no-ws-ctl-token "\041\043-\133\135-\177")
   "Non-white-space control characaters, plus the rest of ASCII excluding backslash and doublequote.")
-  
+(defvar drums-tspecials "][()<>@,;:\\\"/?="
+  "Tspecials.")
+
 (defvar drums-syntax-table
   (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
     (modify-syntax-entry ?\\ "/" table)
     (modify-syntax-entry ?< "(" table)
     (modify-syntax-entry ?> ")" table)
-    (modify-syntax-entry ?( "(" table)
-    (modify-syntax-entry ?) ")" table)
+    (modify-syntax-entry ?@ "w" table)
+    (modify-syntax-entry ?/ "w" table)
+    (modify-syntax-entry ?= " " table)
+    (modify-syntax-entry ?\; " " table)
     table))
 
+(defun drums-token-to-list (token)
+  "Translate TOKEN into a list of characters."
+  (let ((i 0)
+       b e c out range)
+    (while (< i (length token))
+      (setq c (mm-char-int (aref token i)))
+      (incf i)
+      (cond
+       ((eq c (mm-char-int ?-))
+       (if b
+           (setq range t)
+         (push c out)))
+       (range
+       (while (<= b c)
+         (push (mm-make-char 'ascii b) out)
+         (incf b))
+       (setq range nil))
+       ((= i (length token))
+       (push (mm-make-char 'ascii c) out))
+       (t
+       (setq b c))))
+    (nreverse out)))
+
 (defsubst drums-init (string)
   (set-syntax-table drums-syntax-table)
   (insert string)
        (cond
         ((eq c ?\")
          (forward-sexp 1))
-        ((memq c '(? ?\t))
+        ((memq c '(? ?\t ?\n))
          (delete-char 1))
         (t
          (forward-char 1))))
 (defun drums-parse-date (string)
   "Return an Emacs time spec from STRING."
   (apply 'encode-time (parse-time-string string)))
-    
+
+(defun drums-content-type-get (ct attribute)
+  "Return the value of ATTRIBUTE from CT."
+  (cdr (assq attribute (cdr ct))))
+
+(defun drums-parse-content-type (string)
+  "Parse STRING and return a list."
+  (with-temp-buffer
+    (let ((ttoken (drums-token-to-list drums-text-token))
+         (stoken (drums-token-to-list drums-tspecials))
+         display-name mailbox c display-string parameters
+         attribute value type subtype)
+      (drums-init (drums-remove-whitespace (drums-remove-comments string)))
+      (setq c (following-char))
+      (when (and (memq c ttoken)
+                (not (memq c stoken)))
+       (setq type (downcase (buffer-substring
+                             (point) (progn (forward-sexp 1) (point)))))
+       ;; Do the params
+       (while (not (eobp))
+         (setq c (following-char))
+         (unless (eq c ?\;)
+           (error "Invalid header: %s" string))
+         (forward-char 1)
+         (setq c (following-char))
+         (if (and (memq c ttoken)
+                  (not (memq c stoken)))
+             (setq attribute
+                   (intern
+                    (downcase
+                     (buffer-substring
+                      (point) (progn (forward-sexp 1) (point))))))
+           (error "Invalid header: %s" string))
+         (setq c (following-char))
+         (unless (eq c ?=)
+           (error "Invalid header: %s" string))
+         (forward-char 1)
+         (setq c (following-char))
+         (cond
+          ((eq c ?\")
+           (setq value
+                 (buffer-substring (1+ (point))
+                                   (progn (forward-sexp 1) (1- (point))))))
+          ((and (memq c ttoken)
+                (not (memq c stoken)))
+           (setq value (buffer-substring
+                        (point) (progn (forward-sexp 1) (point)))))
+          (t
+           (error "Invalid header: %s" string)))
+         (push (cons attribute value) parameters))
+       `(,type ,@(nreverse parameters))))))
+
+(defun drums-narrow-to-header ()
+  "Narrow to the header of the current buffer."
+  (narrow-to-region
+   (goto-char (point-min))
+   (if (search-forward "\n\n" nil 1)
+       (1- (point))
+     (point-max)))
+  (goto-char (point-min)))
+
 (provide 'drums)
 
 ;;; drums.el ends here
index 4302182..a698479 100644 (file)
@@ -74,8 +74,6 @@
 (defvar earcon-button-marker-list nil)
 (make-variable-buffer-local 'earcon-button-marker-list)
 
-
-
 ;;; FIXME!! clone of code from gnus-vis.el FIXME!!
 (defun earcon-article-push-button (event)
   "Check text under the mouse pointer for a callback function.
@@ -156,7 +154,6 @@ If N is negative, move backward instead."
        (setq entry nil)))
     entry))
 
-
 (defun earcon-button-push (marker)
   ;; Push button starting at MARKER.
   (save-excursion
index c99f47e..6fb1f84 100644 (file)
@@ -376,11 +376,6 @@ be used as possible file names."
                         (cons :value ("" "") regexp (repeat string))
                         (sexp :value nil))))
 
-(defcustom gnus-strict-mime t
-  "*If nil, MIME-decode even if there is no MIME-Version header."
-  :group 'gnus-article-mime
-  :type 'boolean)
-
 (defcustom gnus-article-display-method-for-mime
   'gnus-article-display-mime-message
   "Function to display a MIME message.
@@ -557,7 +552,9 @@ displayed by the first non-nil matching CONTENT face."
                               (face :value default)))))
 
 (defcustom gnus-article-decode-hook nil
-  "*Hook run to decode charsets in articles.")
+  "*Hook run to decode charsets in articles."
+  :group 'gnus-article-headers
+  :type 'hook)
 
 ;;; Internal variables
 
@@ -904,7 +901,9 @@ characters to translate to."
        (point)
        (progn
         (while (and (not (bobp))
-                    (looking-at "^[ \t]*$"))
+                    (looking-at "^[ \t]*$")
+                    (not (gnus-annotation-in-region-p
+                          (point) (gnus-point-at-eol))))
           (forward-line -1))
         (forward-line 1)
         (point))))))
@@ -1071,7 +1070,9 @@ always hide."
       (goto-char (point-min))
       (search-forward "\n\n" nil t)
       (while (re-search-forward "\n\n\n+" nil t)
-       (replace-match "\n\n" t t)))))
+       (unless (gnus-annotation-in-region-p
+                (match-beginning 0) (match-end 0))
+         (replace-match "\n\n" t t))))))
 
 (defun article-strip-leading-space ()
   "Remove all white space from the beginning of the lines in the article."
@@ -2084,10 +2085,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                     (if gnus-show-mime
                         (progn
                           (mime-parse-buffer)
-                          (if (or (not gnus-strict-mime)
-                                  (mime-fetch-field "MIME-Version"))
-                              gnus-article-display-method-for-mime
-                            gnus-article-display-method-for-encoded-word))
+                          gnus-article-display-method-for-mime)
                       gnus-article-display-method-for-traditional)))
                ;; Hooks for getting information from the article.
                ;; This hook must be called before being narrowed.
diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el
new file mode 100644 (file)
index 0000000..d401499
--- /dev/null
@@ -0,0 +1,830 @@
+;;; mailcap.el --- Functions for displaying MIME parts
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: William M. Perry <wmperry@aventail.com>
+;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: news, mail
+
+;; 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-and-compile
+  (require 'cl))
+(require 'drums)
+
+(defvar mailcap-parse-args-syntax-table
+  (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
+    (modify-syntax-entry ?' "\"" table)
+    (modify-syntax-entry ?` "\"" table)
+    (modify-syntax-entry ?{ "(" table)
+    (modify-syntax-entry ?} ")" table)
+    table)
+  "A syntax table for parsing sgml attributes.")
+
+(defvar mailcap-mime-data
+  '(("multipart"
+     (".*"
+      ("viewer" . mailcap-save-binary-file)
+      ("type"   . "multipart/*")))
+    ("application"
+     ("x-x509-ca-cert"
+      ("viewer" . ssl-view-site-cert)
+      ("test" . (fboundp 'ssl-view-site-cert))
+      ("type" . "application/x-x509-ca-cert"))
+     ("x-x509-user-cert"
+      ("viewer" . ssl-view-user-cert)
+      ("test" . (fboundp 'ssl-view-user-cert))
+      ("type" . "application/x-x509-user-cert"))
+     ("octet-stream"
+      ("viewer" . mailcap-save-binary-file)
+      ("type" ."application/octet-stream"))
+     ("dvi"
+      ("viewer" . "open %s")
+      ("type"   . "application/dvi")
+      ("test"   . (eq (mm-device-type) 'ns)))
+     ("dvi"
+      ("viewer" . "xdvi %s")
+      ("test"   . (eq (mm-device-type) 'x))
+      ("needsx11")
+      ("type"   . "application/dvi"))
+     ("dvi"
+      ("viewer" . "dvitty %s")
+      ("test"   . (not (getenv "DISPLAY")))
+      ("type"   . "application/dvi"))
+     ("emacs-lisp"
+      ("viewer" . mailcap-maybe-eval)
+      ("type"   . "application/emacs-lisp"))
+     ("x-tar"
+      ("viewer" . mailcap-save-binary-file)
+      ("type"   . "application/x-tar"))
+     ("x-latex"
+      ("viewer" . tex-mode)
+      ("test"   . (fboundp 'tex-mode))
+      ("type"   . "application/x-latex"))
+     ("x-tex"
+      ("viewer" . tex-mode)
+      ("test"   . (fboundp 'tex-mode))
+      ("type"   . "application/x-tex"))
+     ("latex"
+      ("viewer" . tex-mode)
+      ("test"   . (fboundp 'tex-mode))
+      ("type"   . "application/latex"))
+     ("tex"
+      ("viewer" . tex-mode)
+      ("test"   . (fboundp 'tex-mode))
+      ("type"   . "application/tex"))
+     ("texinfo"
+      ("viewer" . texinfo-mode)
+      ("test"   . (fboundp 'texinfo-mode))
+      ("type"   . "application/tex"))
+     ("zip"
+      ("viewer" . mailcap-save-binary-file)
+      ("type"   . "application/zip")
+      ("copiousoutput"))
+     ("pdf"
+      ("viewer" . "acroread %s")
+      ("type"   . "application/pdf"))
+     ("postscript"
+      ("viewer" . "open %s")
+      ("type"   . "application/postscript")
+      ("test"   . (eq (mm-device-type) 'ns)))
+     ("postscript" 
+      ("viewer" . "ghostview %s")
+      ("type" . "application/postscript")
+      ("test"   . (eq (mm-device-type) 'x))
+      ("needsx11"))
+     ("postscript"
+      ("viewer" . "ps2ascii %s")
+      ("type" . "application/postscript")
+      ("test" . (not (getenv "DISPLAY")))
+      ("copiousoutput")))
+    ("audio"
+     ("x-mpeg"
+      ("viewer" . "maplay %s")
+      ("type"   . "audio/x-mpeg"))
+     (".*"
+      ("viewer" . mailcap-play-sound-file)
+      ("test"   . (or (featurep 'nas-sound)
+                     (featurep 'native-sound)))
+      ("type"   . "audio/*"))
+     (".*"
+      ("viewer" . "showaudio")
+      ("type"   . "audio/*")))
+    ("message"
+     ("rfc-*822"
+      ("viewer" . vm-mode)
+      ("test"   . (fboundp 'vm-mode))
+      ("type"   . "message/rfc-822"))
+     ("rfc-*822"
+      ("viewer" . w3-mode)
+      ("test"   . (fboundp 'w3-mode))
+      ("type"   . "message/rfc-822"))
+     ("rfc-*822"
+      ("viewer" . view-mode)
+      ("test"   . (fboundp 'view-mode))
+      ("type"   . "message/rfc-822"))
+     ("rfc-*822" 
+      ("viewer" . fundamental-mode)
+      ("type"   . "message/rfc-822")))
+    ("image"
+     ("x-xwd"
+      ("viewer"  . "xwud -in %s")
+      ("type"    . "image/x-xwd")
+      ("compose" . "xwd -frame > %s")
+      ("test"    . (eq (mm-device-type) 'x))
+      ("needsx11"))
+     ("x11-dump"
+      ("viewer" . "xwud -in %s")
+      ("type" . "image/x-xwd")
+      ("compose" . "xwd -frame > %s")
+      ("test"   . (eq (mm-device-type) 'x))
+      ("needsx11"))
+     ("windowdump"
+      ("viewer" . "xwud -in %s")
+      ("type" . "image/x-xwd")
+      ("compose" . "xwd -frame > %s")
+      ("test"   . (eq (mm-device-type) 'x))
+      ("needsx11"))
+     (".*"
+      ("viewer" . "aopen %s")
+      ("type"   . "image/*")
+      ("test"   . (eq (mm-device-type) 'ns)))
+     (".*"
+      ("viewer" . "xv -perfect %s")
+      ("type" . "image/*")
+      ("test"   . (eq (mm-device-type) 'x))
+      ("needsx11")))
+    ("text"
+     ("plain"
+      ("viewer"  . w3-mode)
+      ("test"    . (fboundp 'w3-mode))
+      ("type"    . "text/plain"))
+     ("plain"
+      ("viewer"  . view-mode)
+      ("test"    . (fboundp 'view-mode))
+      ("type"    . "text/plain"))
+     ("plain"
+      ("viewer"  . fundamental-mode)
+      ("type"    . "text/plain"))
+     ("enriched"
+      ("viewer" . enriched-decode-region)
+      ("test"   . (fboundp 'enriched-decode-region))
+      ("type"   . "text/enriched"))
+     ("html"
+      ("viewer" . w3-prepare-buffer)
+      ("test"   . (fboundp 'w3-prepare-buffer))
+      ("type"   . "text/html")))
+    ("video"
+     ("mpeg"
+      ("viewer" . "mpeg_play %s")
+      ("type"   . "video/mpeg")
+      ("test"   . (eq (mm-device-type) 'x))
+      ("needsx11")))
+    ("x-world"
+     ("x-vrml"
+      ("viewer"  . "webspace -remote %s -URL %u")
+      ("type"    . "x-world/x-vrml")
+      ("description"
+       "VRML document")))
+    ("archive"
+     ("tar"
+      ("viewer" . tar-mode)
+      ("type" . "archive/tar")
+      ("test" . (fboundp 'tar-mode)))))
+     "*The mailcap structure is an assoc list of assoc lists.
+1st assoc list is keyed on the major content-type
+2nd assoc list is keyed on the minor content-type (which can be a regexp)
+
+Which looks like:
+-----------------
+ ((\"application\"
+   (\"postscript\" . <info>))
+  (\"text\"
+   (\"plain\" . <info>)))
+
+Where <info> is another assoc list of the various information
+related to the mailcap RFC.  This is keyed on the lowercase
+attribute name (viewer, test, etc).  This looks like:
+ ((\"viewer\" . viewerinfo)
+  (\"test\"   . testinfo)
+  (\"xxxx\"   . \"string\"))
+
+Where viewerinfo specifies how the content-type is viewed.  Can be
+a string, in which case it is run through a shell, with
+appropriate parameters, or a symbol, in which case the symbol is
+funcall'd, with the buffer as an argument.
+
+testinfo is a list of strings, or nil.  If nil, it means the
+viewer specified is always valid.  If it is a list of strings,
+these are used to determine whether a viewer passes the 'test' or
+not.")
+
+(defvar mailcap-download-directory nil
+  "*Where downloaded files should go by default.")
+
+(defvar mailcap-temporary-directory (or (getenv "TMPDIR") "/tmp")
+  "*Where temporary files go.")
+
+;;;
+;;; Utility functions
+;;;
+
+(defun mailcap-generate-unique-filename (&optional fmt)
+  "Generate a unique filename in mailcap-temporary-directory"
+  (if (not fmt)
+      (let ((base (format "mailcap-tmp.%d" (user-real-uid)))
+           (fname "")
+           (x 0))
+       (setq fname (format "%s%d" base x))
+       (while (file-exists-p
+               (expand-file-name fname mailcap-temporary-directory))
+         (setq x (1+ x)
+               fname (concat base (int-to-string x))))
+       (expand-file-name fname mailcap-temporary-directory))
+    (let ((base (concat "mm" (int-to-string (user-real-uid))))
+         (fname "")
+         (x 0))
+      (setq fname (format fmt (concat base (int-to-string x))))
+      (while (file-exists-p
+             (expand-file-name fname mailcap-temporary-directory))
+       (setq x (1+ x)
+             fname (format fmt (concat base (int-to-string x)))))
+      (expand-file-name fname mailcap-temporary-directory))))
+
+(defun mailcap-save-binary-file ()
+  ;; Ok, this is truly fucked.  In XEmacs, if you use the mouse to select
+  ;; a URL that gets saved via this function, read-file-name will pop up a
+  ;; dialog box for file selection.  For some reason which buffer we are in
+  ;; gets royally screwed (even with save-excursions and the whole nine
+  ;; yards).  SO, we just keep the old buffer name around and away we go.
+  (let ((old-buff (current-buffer))
+       (file (read-file-name "Filename to save as: "
+                             (or mailcap-download-directory "~/")
+                             (file-name-nondirectory (url-view-url t))
+                             nil
+                             (file-name-nondirectory (url-view-url t))))
+       (require-final-newline nil))
+    (set-buffer old-buff)
+    (mule-write-region-no-coding-system (point-min) (point-max) file)
+    (kill-buffer (current-buffer))))
+
+(defun mailcap-maybe-eval ()
+  "Maybe evaluate a buffer of emacs lisp code"
+  (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ")
+      (eval-buffer (current-buffer))
+    (emacs-lisp-mode)))
+
+;;;
+;;; The mailcap parser
+;;;
+
+(defun mailcap-replace-regexp (regexp to-string)
+  ;; Quiet replace-regexp.
+  (goto-char (point-min))
+  (while (re-search-forward regexp nil t)
+    (replace-match to-string t nil)))
+
+(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."
+  (when (or (not mailcap-parsed-p)
+           force)
+    (cond
+     (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")
+                           ";")))
+     (t (setq path (mapconcat 'expand-file-name
+                             '("~/.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))
+                            ";"
+                          ":"))))
+         fname)
+      (while fnames
+       (setq fname (car fnames))
+       (if (and (file-exists-p fname) (file-readable-p fname))
+           (mailcap-parse-mailcap (car fnames)))
+       (setq fnames (cdr fnames))))
+    (setq mailcap-parsed-p t)))
+
+(defun mailcap-parse-mailcap (fname)
+  ;; Parse out the mailcap file specified by FNAME
+  (let (major                          ; The major mime type (image/audio/etc)
+       minor                           ; The minor mime type (gif, basic, etc)
+       save-pos                        ; Misc saved positions used in parsing
+       viewer                          ; How to view this mime type
+       info                            ; Misc info about this mime type
+       )
+    (with-temp-buffer
+      (insert-file-contents fname)
+      (set-syntax-table mailcap-parse-args-syntax-table)
+      (mailcap-replace-regexp "#.*" "")        ; Remove all comments
+      (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")
+       (setq save-pos (point)
+             info nil)
+       (skip-chars-forward "^/;")
+       (downcase-region save-pos (point))
+       (setq major (buffer-substring save-pos (point)))
+       (skip-chars-forward "/ \t\n")
+       (setq save-pos (point))
+       (skip-chars-forward "^;")
+       (downcase-region save-pos (point))
+       (setq minor
+             (cond
+              ((= ?* (or (char-after save-pos) 0)) ".*")
+              ((= (point) save-pos) ".*")
+              (t (buffer-substring save-pos (point)))))
+       (skip-chars-forward "; \t\n")
+       ;;; 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)
+       (skip-chars-forward "; \t\n")
+       (setq save-pos (point))
+       (skip-chars-forward "^;\n")
+       (if (= (or (char-after save-pos) 0) ?')
+           (setq viewer (progn
+                          (narrow-to-region (1+ save-pos) (point))
+                          (goto-char (point-min))
+                          (prog1
+                              (read (current-buffer))
+                            (goto-char (point-max))
+                            (widen))))
+         (setq viewer (buffer-substring save-pos (point))))
+       (setq save-pos (point))
+       (end-of-line)
+       (setq info (nconc (list (cons "viewer" viewer)
+                               (cons "type" (concat major "/"
+                                                    (if (string= minor ".*")
+                                                        "*" minor))))
+                         (mailcap-parse-mailcap-extras save-pos (point))))
+       (mailcap-mailcap-entry-passes-test info)
+       (mailcap-add-mailcap-entry major minor info)))))
+
+(defun mailcap-parse-mailcap-extras (st nd)
+  ;; Grab all the extra stuff from a mailcap entry
+  (let (
+       name                            ; From name=
+       value                           ; its value
+       results                         ; Assoc list of results
+       name-pos                        ; Start of XXXX= position
+       val-pos                         ; Start of value position
+       done                            ; Found end of \'d ;s?
+       )
+    (save-restriction
+      (narrow-to-region st nd)
+      (goto-char (point-min))
+      (skip-chars-forward " \n\t;")
+      (while (not (eobp))
+       (setq done nil)
+       (skip-chars-forward " \";\n\t")
+       (setq name-pos (point))
+       (skip-chars-forward "^ \n\t=")
+       (downcase-region name-pos (point))
+       (setq name (buffer-substring name-pos (point)))
+       (skip-chars-forward " \t\n")
+       (if (/= (or (char-after (point)) 0)  ?=) ; There is no value
+           (setq value nil)
+         (skip-chars-forward " \t\n=")
+         (setq val-pos (point))
+         (if (memq (char-after val-pos) '(?\" ?'))
+             (progn
+               (setq val-pos (1+ val-pos))
+               (condition-case nil
+                   (progn
+                     (forward-sexp 1)
+                     (backward-char 1))
+                 (error (goto-char (point-max)))))
+           (while (not done)
+             (skip-chars-forward "^;")
+             (if (= (or (char-after (1- (point))) 0) ?\\ )
+                 (progn
+                   (subst-char-in-region (1- (point)) (point) ?\\ ? )
+                   (skip-chars-forward ";"))
+               (setq done t))))
+         (setq value (buffer-substring val-pos (point))))
+       (setq results (cons (cons name value) results)))
+      results)))  
+
+(defun mailcap-mailcap-entry-passes-test (info)
+  ;; Return t iff a mailcap entry passes its test clause or no test
+  ;; clause is present.
+  (let (status                         ; Call-process-regions return value
+       (test (assoc "test" info))      ; The test clause
+       )
+    (setq status (and test (split-string (cdr test) " ")))
+    (if (and (assoc "needsx11" info) (not (getenv "DISPLAY")))
+       (setq status nil)
+      (cond
+       ((and (equal (nth 0 status) "test")
+            (equal (nth 1 status) "-n")
+            (or (equal (nth 2 status) "$DISPLAY")
+                (equal (nth 2 status) "\"$DISPLAY\"")))
+       (setq status (if (getenv "DISPLAY") t nil)))
+       ((and (equal (nth 0 status) "test")
+            (equal (nth 1 status) "-z")
+            (or (equal (nth 2 status) "$DISPLAY")
+                (equal (nth 2 status) "\"$DISPLAY\"")))
+       (setq status (if (getenv "DISPLAY") nil t)))
+       (test nil)
+       (t nil)))
+    (and test (listp test) (setcdr test status))))
+
+;;;
+;;; The action routines.
+;;;
+
+(defun mailcap-possible-viewers (major minor)
+  ;; Return a list of possible viewers from MAJOR for minor type MINOR
+  (let ((exact '())
+       (wildcard '()))
+    (while major
+      (cond
+       ((equal (car (car major)) minor)
+       (setq exact (cons (cdr (car major)) exact)))
+       ((string-match (car (car major)) minor)
+       (setq wildcard (cons (cdr (car major)) wildcard))))
+      (setq major (cdr major)))
+    (nconc (nreverse exact) (nreverse wildcard))))
+
+(defun mailcap-unescape-mime-test (test type-info)
+  (let (save-pos save-chr subst)
+    (cond
+     ((symbolp test) test)
+     ((and (listp test) (symbolp (car test))) test)
+     ((or (stringp test)
+         (and (listp test) (stringp (car test))
+              (setq test (mapconcat 'identity test " "))))
+      (with-temp-buffer
+       (insert test)
+       (goto-char (point-min))
+       (while (not (eobp))
+         (skip-chars-forward "^%")
+         (if (/= (- (point)
+                    (progn (skip-chars-backward "\\\\")
+                           (point)))
+                 0)                    ; It is an escaped %
+             (progn
+               (delete-char 1)
+               (skip-chars-forward "%."))
+           (setq save-pos (point))
+           (skip-chars-forward "%")
+           (setq save-chr (char-after (point)))
+           (cond
+            ((null save-chr) nil)
+            ((= save-chr ?t)
+             (delete-region save-pos (progn (forward-char 1) (point)))
+             (insert (or (cdr (assoc "type" type-info)) "\"\"")))
+            ((= save-chr ?M)
+             (delete-region save-pos (progn (forward-char 1) (point)))
+             (insert "\"\""))
+            ((= save-chr ?n)
+             (delete-region save-pos (progn (forward-char 1) (point)))
+             (insert "\"\""))
+            ((= save-chr ?F)
+             (delete-region save-pos (progn (forward-char 1) (point)))
+             (insert "\"\""))
+            ((= save-chr ?{)
+             (forward-char 1)
+             (skip-chars-forward "^}")
+             (downcase-region (+ 2 save-pos) (point))
+             (setq subst (buffer-substring (+ 2 save-pos) (point)))
+             (delete-region save-pos (1+ (point)))
+             (insert (or (cdr (assoc subst type-info)) "\"\"")))
+            (t nil))))
+       (buffer-string)))
+     (t (error "Bad value to mailcap-unescape-mime-test. %s" test)))))
+
+(defvar mailcap-viewer-test-cache nil)
+
+(defun mailcap-viewer-passes-test (viewer-info type-info)
+  ;; Return non-nil iff the viewer specified by VIEWER-INFO passes its
+  ;; test clause (if any).
+  (let* ((test-info   (assoc "test"   viewer-info))
+        (test (cdr test-info))
+        (otest test)
+        (viewer (cdr (assoc "viewer" viewer-info)))
+        (default-directory (expand-file-name "~/"))
+        status parsed-test cache result)
+    (if (setq cache (assoc test mailcap-viewer-test-cache))
+       (cadr cache)
+      (setq
+       result
+       (cond
+       ((not test-info) t)             ; No test clause
+       ((not test) nil)                ; Already failed test
+       ((eq test t) t)                 ; Already passed test
+       ((and (symbolp test)            ; Lisp function as test
+             (fboundp test))
+        (funcall test type-info))
+       ((and (symbolp test)            ; Lisp variable as test
+             (boundp test))
+        (symbol-value test))
+       ((and (listp test)              ; List to be eval'd
+             (symbolp (car test)))
+        (eval test))
+       (t
+        (setq test (mailcap-unescape-mime-test test type-info)
+              test (list shell-file-name nil nil nil
+                         shell-command-switch test)
+              status (apply 'call-process test))
+        (= 0 status))))
+      (push (list otest result) mailcap-viewer-test-cache)
+      result)))
+
+(defun mailcap-add-mailcap-entry (major minor info)
+  (let ((old-major (assoc major mailcap-mime-data)))
+    (if (null old-major)               ; New major area
+       (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
+             (assoc "test" info))      ; Has a test, insert at beginning
+         (setcdr old-major (cons (cons minor info) (cdr old-major))))
+        ((and (not (assoc "test" info)) ; No test info, replace completely
+              (not (assoc "test" cur-minor)))
+         (setcdr cur-minor info))
+        (t
+         (setcdr old-major (cons (cons minor info) (cdr old-major)))))))))
+
+;;;
+;;; The main whabbo
+;;;
+
+(defun mailcap-viewer-lessp (x y)
+  ;; Return t iff viewer X is more desirable than viewer Y
+  (let ((x-wild (string-match "[*?]" (or (cdr-safe (assoc "type" x)) "")))
+       (y-wild (string-match "[*?]" (or (cdr-safe (assoc "type" y)) "")))
+       (x-lisp (not (stringp (or (cdr-safe (assoc "viewer" x)) ""))))
+       (y-lisp (not (stringp (or (cdr-safe (assoc "viewer" y)) "")))))
+    (cond
+     ((and x-lisp (not y-lisp))
+      t)
+     ((and (not y-lisp) x-wild (not y-wild))
+      t)
+     ((and (not x-wild) y-wild)
+      t)
+     (t nil))))
+
+(defun mailcap-mime-info (string &optional request)
+  "Get the mime viewer command for HEADERLINE, return nil if none found.
+Expects a complete content-type header line as its argument.  This can
+be simple like text/html, or complex like text/plain; charset=blah; foo=bar
+
+Second argument REQUEST specifies what information to return.  If it is
+nil or the empty string, the viewer (second field of the mailcap
+entry) will be returned.  If it is a string, then the mailcap field
+corresponding to that string will be returned (print, description,
+whatever).  If a number, then all the information for this specific
+viewer is returned."
+  (let (
+       major                           ; Major encoding (text, etc)
+       minor                           ; Minor encoding (html, etc)
+       info                            ; Other info
+       save-pos                        ; Misc. position during parse
+       major-info                      ; (assoc major mailcap-mime-data)
+       minor-info                      ; (assoc minor major-info)
+       test                            ; current test proc.
+       viewers                         ; Possible viewers
+       passed                          ; Viewers that passed the test
+       viewer                          ; The one and only viewer
+       ctl)
+    (save-excursion
+      (setq ctl (drums-parse-content-type (or string "text/plain")))
+      (setq major (split-string (car ctl) "/"))
+      (setq minor (cadr major)
+           major (car major))
+      (when (setq major-info (cdr (assoc major mailcap-mime-data)))
+       (when (setq viewers (mailcap-possible-viewers major-info minor))
+         (setq info (mapcar (lambda (a) (cons (symbol-name (car a))
+                                              (cdr a)))
+                            (cdr ctl)))
+         (while viewers
+           (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 viewer (car passed))))
+      (when (and (stringp (cdr (assoc "viewer" viewer)))
+                passed)
+       (setq viewer (car passed)))
+      (cond
+       ((and (null viewer) (not (equal major "default")))
+       (mailcap-mime-info "default" request))
+       ((or (null request) (equal request ""))
+       (mailcap-unescape-mime-test (cdr (assoc "viewer" viewer)) info))
+       ((stringp request)
+       (if (or (string= request "test") (string= request "viewer"))
+           (mailcap-unescape-mime-test
+            (cdr-safe (assoc request viewer)) info)))
+       (t
+       ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
+       (setq viewer (copy-tree viewer))
+       (let ((view (assoc "viewer" viewer))
+             (test (assoc "test" viewer)))
+         (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
+         (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
+       viewer)))))
+
+;;;
+;;; Experimental MIME-types parsing
+;;;
+
+(defvar mailcap-mime-extensions
+  '((""          . "text/plain")
+    (".abs"      . "audio/x-mpeg")
+    (".aif"      . "audio/aiff")
+    (".aifc"     . "audio/aiff")
+    (".aiff"     . "audio/aiff")
+    (".ano"      . "application/x-annotator")
+    (".au"       . "audio/ulaw")
+    (".avi"      . "video/x-msvideo")
+    (".bcpio"    . "application/x-bcpio")
+    (".bin"      . "application/octet-stream")
+    (".cdf"      . "application/x-netcdr")
+    (".cpio"     . "application/x-cpio")
+    (".csh"      . "application/x-csh")
+    (".dvi"      . "application/x-dvi")
+    (".el"       . "application/emacs-lisp")
+    (".eps"      . "application/postscript")
+    (".etx"      . "text/x-setext")
+    (".exe"      . "application/octet-stream")
+    (".fax"      . "image/x-fax")
+    (".gif"      . "image/gif")
+    (".hdf"      . "application/x-hdf")
+    (".hqx"      . "application/mac-binhex40")
+    (".htm"      . "text/html")
+    (".html"     . "text/html")
+    (".icon"     . "image/x-icon")
+    (".ief"      . "image/ief")
+    (".jpg"      . "image/jpeg")
+    (".macp"     . "image/x-macpaint")
+    (".man"      . "application/x-troff-man")
+    (".me"       . "application/x-troff-me")
+    (".mif"      . "application/mif")
+    (".mov"      . "video/quicktime")
+    (".movie"    . "video/x-sgi-movie")
+    (".mp2"      . "audio/x-mpeg")
+    (".mp3"      . "audio/x-mpeg")
+    (".mp2a"     . "audio/x-mpeg2")
+    (".mpa"      . "audio/x-mpeg")
+    (".mpa2"     . "audio/x-mpeg2")
+    (".mpe"      . "video/mpeg")
+    (".mpeg"     . "video/mpeg")
+    (".mpega"    . "audio/x-mpeg")
+    (".mpegv"    . "video/mpeg")
+    (".mpg"      . "video/mpeg")
+    (".mpv"      . "video/mpeg")
+    (".ms"       . "application/x-troff-ms")
+    (".nc"       . "application/x-netcdf")
+    (".nc"       . "application/x-netcdf")
+    (".oda"      . "application/oda")
+    (".pbm"      . "image/x-portable-bitmap")
+    (".pdf"      . "application/pdf")
+    (".pgm"      . "image/portable-graymap")
+    (".pict"     . "image/pict")
+    (".png"      . "image/png")
+    (".pnm"      . "image/x-portable-anymap")
+    (".ppm"      . "image/portable-pixmap")
+    (".ps"       . "application/postscript")
+    (".qt"       . "video/quicktime")
+    (".ras"      . "image/x-raster")
+    (".rgb"      . "image/x-rgb")
+    (".rtf"      . "application/rtf")
+    (".rtx"      . "text/richtext")
+    (".sh"       . "application/x-sh")
+    (".sit"      . "application/x-stuffit")
+    (".snd"      . "audio/basic")
+    (".src"      . "application/x-wais-source")
+    (".tar"      . "archive/tar")
+    (".tcl"      . "application/x-tcl")
+    (".tcl"      . "application/x-tcl")
+    (".tex"      . "application/x-tex")
+    (".texi"     . "application/texinfo")
+    (".tga"      . "image/x-targa")
+    (".tif"      . "image/tiff")
+    (".tiff"     . "image/tiff")
+    (".tr"       . "application/x-troff")
+    (".troff"    . "application/x-troff")
+    (".tsv"      . "text/tab-separated-values")
+    (".txt"      . "text/plain")
+    (".vbs"      . "video/mpeg")
+    (".vox"      . "audio/basic")
+    (".vrml"     . "x-world/x-vrml")
+    (".wav"      . "audio/x-wav")
+    (".wrl"      . "x-world/x-vrml")
+    (".xbm"      . "image/xbm")
+    (".xpm"      . "image/x-pixmap")
+    (".xwd"      . "image/windowdump")
+    (".zip"      . "application/zip")
+    (".ai"       . "application/postscript")
+    (".jpe"      . "image/jpeg")
+    (".jpeg"     . "image/jpeg"))
+  "*An assoc list of file extensions and the MIME content-types they
+correspond to.")
+
+(defun mailcap-parse-mimetypes (&optional path)
+  ;; Parse out all the mimetypes specified in a unix-style path string 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"
+                             "/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))
+                                  ";" ":"))))
+       fname)
+    (while fnames
+      (setq fname (car fnames))
+      (if (and (file-exists-p fname) (file-readable-p fname))
+         (mailcap-parse-mimetype-file (car fnames)))
+      (setq fnames (cdr fnames)))))
+
+(defun mailcap-parse-mimetype-file (fname)
+  ;; Parse out a mime-types file
+  (let (type                           ; The MIME type for this line
+       extns                           ; The extensions for this line
+       save-pos                        ; Misc. saved buffer positions
+       )
+    (with-temp-buffer
+      (insert-file-contents fname)
+      (mailcap-replace-regexp "#.*" "")
+      (mailcap-replace-regexp "\n+" "\n")
+      (mailcap-replace-regexp "[ \t]+$" "")
+      (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")
+       (setq save-pos (point))
+       (skip-chars-forward "^ \t")
+       (downcase-region save-pos (point))
+       (setq type (buffer-substring save-pos (point)))
+       (while (not (eolp))
+         (skip-chars-forward " \t")
+         (setq save-pos (point))
+         (skip-chars-forward "^ \t\n")
+         (setq extns (cons (buffer-substring save-pos (point)) extns)))
+       (while extns
+         (setq mailcap-mime-extensions
+               (cons
+                (cons (if (= (string-to-char (car extns)) ?.)
+                          (car extns)
+                        (concat "." (car extns))) type)
+                mailcap-mime-extensions)
+               extns (cdr extns)))))))
+
+(defun mailcap-extension-to-mime (extn)
+  "Return the MIME content type of the file extensions EXTN."
+  (if (and (stringp extn)
+          (not (eq (string-to-char extn) ?.)))
+      (setq extn (concat "." extn)))
+  (cdr (assoc (downcase extn) mailcap-mime-extensions)))
+
+(provide 'mailcap)
+
+;;; mailcap.el ends here
index 3fe444e..0aed40d 100644 (file)
@@ -335,7 +335,7 @@ variable."
 (defcustom gnus-show-mime t
   "*If non-nil, do mime processing of articles.
 The articles will simply be fed to the function given by
-`gnus-show-mime-method'."
+`gnus-article-display-method-for-mime'."
   :group 'gnus-article-mime
   :type 'boolean)
 
index 233960a..43facf4 100644 (file)
@@ -308,7 +308,7 @@ Cache the result as a text property stored in DATE."
         '(0 0)
        (or (get-text-property 0 'gnus-time d)
           ;; or compute the value...
-          (let ((time (date-to-time d)))
+          (let ((time (safe-date-to-time d)))
             ;; and store it back in the string.
             (put-text-property 0 1 'gnus-time time d)
             time)))))
index 8e28a46..ac5c95d 100644 (file)
@@ -476,6 +476,7 @@ call it with the value of the `gnus-data' text property."
        'gnus-xmas-mode-line-buffer-identification)
   (fset 'gnus-key-press-event-p 'key-press-event-p)
   (fset 'gnus-region-active-p 'region-active-p)
+  (fset 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p)
 
   (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
@@ -904,6 +905,9 @@ XEmacs compatibility workaround."
   (when (eq (device-type) 'x)
     (gnus-splash)))
 
+(defun gnus-xmas-annotation-in-region-p (b e)
+  (map-extents (lambda (e u) t) nil b e nil nil 'mm t))
+
 (provide 'gnus-xmas)
 
 ;;; gnus-xmas.el ends here
index 677024c..29e6152 100644 (file)
@@ -253,10 +253,10 @@ is restarted, and sometimes reloaded."
 (defconst gnus-product-name "T-gnus"
   "Product name of this version of gnus.")
 
-(defconst gnus-version-number "6.10.016"
+(defconst gnus-version-number "6.10.017"
   "Version number for this version of gnus.")
 
-(defconst gnus-original-version-number "0.24"
+(defconst gnus-original-version-number "0.25"
     "Version number for this version of Gnus.")
 
 (defconst gnus-original-product-name "Pterodactyl Gnus"
@@ -280,8 +280,6 @@ be set in `.emacs' instead."
   :group 'gnus-start
   :type 'boolean)
 
-;;; Kludges to help the transition from the old `custom.el'.
-
 (unless (featurep 'gnus-xmas)
   (defalias 'gnus-make-overlay 'make-overlay)
   (defalias 'gnus-delete-overlay 'delete-overlay)
@@ -301,7 +299,8 @@ be set in `.emacs' instead."
   (defalias 'gnus-characterp 'numberp)
   (defalias 'gnus-deactivate-mark 'deactivate-mark)
   (defalias 'gnus-window-edges 'window-edges)
-  (defalias 'gnus-key-press-event-p 'numberp))
+  (defalias 'gnus-key-press-event-p 'numberp)
+  (defalias 'gnus-annotation-in-region-p 'ignore))
 
 ;; We define these group faces here to avoid the display
 ;; update forced when creating new faces.
index 7757473..bcd48a3 100644 (file)
@@ -39,7 +39,6 @@
                     url-view-url w3-prepare-buffer
                     set-buffer-multibyte
                     find-non-ascii-charset-region char-charset
-                    mule-write-region-no-coding-system
                     find-charset-region base64-decode-string
                     find-coding-systems-region get-charset-property
                     coding-system-get))
@@ -69,8 +68,7 @@
                 pp-to-string color-name 
                 gnus-mule-get-coding-system decode-coding-string
                 mail-aliases-setup
-                url-view-url w3-prepare-buffer
-                mule-write-region-no-coding-system char-int)))
+                url-view-url w3-prepare-buffer char-int)))
 
 (setq load-path (cons "." load-path))
 (require 'custom)
index 1b208d2..0e6640b 100644 (file)
@@ -89,25 +89,28 @@ If no encoding was done, nil is returned."
 ;;; Functions for decoding
 ;;;
 
+(defun mm-decode-content-transfer-encoding (encoding)
+  (cond
+   ((eq encoding 'quoted-printable)
+    (quoted-printable-decode-region (point-min) (point-max)))
+   ((eq encoding 'base64)
+    (condition-case ()
+       (base64-decode-region (point-min) (point-max))
+      (error nil)))
+   ((memq encoding '(7bit 8bit binary))
+    )
+   ((null encoding)
+    )
+   (t
+    (error "Can't decode encoding %s" encoding))))
+
 (defun mm-decode-body (charset encoding)
   "Decode the current article that has been encoded with ENCODING.
 The characters in CHARSET should then be decoded."
   (setq charset (or charset rfc2047-default-charset))
   (save-excursion
     (when encoding
-      (cond
-       ((eq encoding 'quoted-printable)
-       (quoted-printable-decode-region (point-min) (point-max)))
-       ((eq encoding 'base64)
-       (condition-case ()
-           (base64-decode-region (point-min) (point-max))
-         (error nil)))
-       ((memq encoding '(7bit 8bit binary))
-       )
-       ((null encoding)
-       )
-       (t
-       (error "Can't decode encoding %s" encoding))))
+      (mm-decode-content-transfer-encoding encoding))
     (when (featurep 'mule)
       (let (mule-charset)
        (when (and charset
index 9d0a44b..48b0496 100644 (file)
 
 ;;; Code:
 
+(require 'drums)
+(require 'mailcap)
+(require 'mm-bodies)
+
+(defvar mm-inline-media-tests
+  '(("image/jpeg" mm-inline-image (featurep 'jpeg))
+    ("image/png" mm-inline-image (featurep 'png))
+    ("image/gif" mm-inline-image (featurep 'gif))
+    ("image/tiff" mm-inline-image (featurep 'tiff))
+    ("image/xbm" mm-inline-image (eq (device-type) 'x))
+    ("image/xpm" mm-inline-image (featurep 'xpm))
+    ("text/plain" mm-inline-text t)
+    ("text/html" mm-inline-text (featurep 'w3))
+    )
+  "Alist of media types/test that say whether the media types can be displayed inline.")
+
+(defvar mm-user-display-methods
+  '(("image/.*" . inline)
+    ("text/.*" . inline)))
+
+(defvar mm-user-automatic-display
+  '("text/plain" "image/gif"))
+
+(defvar mm-tmp-directory "/tmp/"
+  "Where mm will store its temporary files.")
+
+;;; Internal variables.
+
+(defvar mm-dissection-list nil)
+
+(defun mm-dissect-buffer (&optional no-strict-mime)
+  "Dissect the current buffer and return a list of MIME handles."
+  (save-excursion
+    (let (ct ctl type subtype cte)
+      (save-restriction
+       (drums-narrow-to-header)
+       (when (and (or no-strict-mime
+                      (mail-fetch-field "mime-version"))
+                  (setq ct (mail-fetch-field "content-type")))
+         (setq ctl (drums-parse-content-type ct))
+         (setq cte (mail-fetch-field "content-transfer-encoding"))))
+      (when ctl
+       (setq type (split-string (car ctl) "/"))
+       (setq subtype (cadr type)
+             type (pop type))
+       (cond
+        ((equal type "multipart")
+         (mm-dissect-multipart ctl))
+        (t
+         (mm-dissect-singlepart ctl (and cte (intern cte))
+                                no-strict-mime)))))))
+
+(defun mm-dissect-singlepart (ctl cte &optional force)
+  (when (or force
+           (not (equal "text/plain" (car ctl))))
+    (let ((res (list (list (mm-copy-to-buffer) ctl cte nil))))
+      (push (car res) mm-dissection-list)
+      res)))
+
+(defun mm-remove-all-parts ()
+  "Remove all MIME handles."
+  (interactive)
+  (mapcar 'mm-remove-part mm-dissection-list)
+  (setq mm-dissection-list nil))
+
+(defun mm-dissect-multipart (ctl)
+  (goto-char (point-min))
+  (let ((boundary (concat "\n--" (drums-content-type-get ctl 'boundary)))
+       start parts end)
+    (while (search-forward boundary nil t)
+      (forward-line -1)
+      (when start
+       (save-excursion
+         (save-restriction
+           (narrow-to-region start (point))
+           (setq parts (nconc (mm-dissect-buffer t) parts)))))
+      (forward-line 2)
+      (setq start (point)))
+    (nreverse parts)))
+
+(defun mm-copy-to-buffer ()
+  "Copy the contents of the current buffer to a fresh buffer."
+  (save-excursion
+    (let ((obuf (current-buffer))
+         beg)
+      (goto-char (point-min))
+      (search-forward "\n\n" nil t)
+      (setq beg (point))
+      (set-buffer (generate-new-buffer " *mm*"))
+      (insert-buffer-substring obuf beg)
+      (current-buffer))))
+
+(defun mm-display-part (handle)
+  "Display the MIME part represented by HANDLE."
+  (save-excursion
+    (mailcap-parse-mailcaps)
+    (if (nth 3 handle)
+       (mm-remove-part handle)
+      (let* ((type (caadr handle))
+            (method (mailcap-mime-info type))
+            (user-method (mm-user-method type)))
+       (if (eq user-method 'inline)
+           (progn
+             (forward-line 1)
+             (mm-display-inline handle))
+         (mm-display-external handle (or user-method method)))))))
+
+(defun mm-display-external (handle method)
+  "Display HANDLE using METHOD."
+  (mm-with-unibyte-buffer
+    (insert-buffer-substring (car handle))
+    (mm-decode-content-transfer-encoding (nth 2 handle))
+    (if (functionp method)
+       (let ((cur (current-buffer)))
+         (switch-to-buffer (generate-new-buffer "*mm*"))
+         (insert-buffer-substring cur)
+         (funcall method)
+         (setcar (nthcdr 3 handle) (current-buffer)))
+      (let* ((file (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
+            process)
+       (write-region (point-min) (point-max)
+                     file nil 'nomesg nil 'no-conversion)
+       (setq process
+             (start-process "*display*" nil shell-file-name
+                            "-c" (format method file)))
+       (setcar (nthcdr 3 handle) (cons file process))
+       (message "Displaying %s..." (format method file))))))
+
+(defun mm-remove-part (handle)
+  "Remove the displayed MIME part represented by HANDLE."
+  (let ((object (nth 3 handle)))
+    (cond
+     ;; Internally displayed part.
+     ((mm-annotationp object)
+      (delete-annotation object))
+     ((or (functionp object)
+         (and (listp object)
+              (eq (car object) 'lambda)))
+      (funcall object))
+     ;; Externally displayed part.
+     ((consp object)
+      (condition-case ()
+         (delete-file (car object))
+       (error nil))
+      (condition-case ()
+         (kill-process (cdr object))
+       (error nil)))
+     ((bufferp object)
+      (when (buffer-live-p object)
+       (kill-buffer object))))
+    (setcar (nthcdr 3 handle) nil)))
+
+(defun mm-display-inline (handle)
+  (let* ((type (caadr handle))
+        (function (cadr (assoc type mm-inline-media-tests))))
+    (funcall function handle)))
+        
+(defun mm-inlinable-p (type)
+  "Say whether TYPE can be displayed inline."
+  (let ((alist mm-inline-media-tests)
+       test)
+    (while alist
+      (when (equal type (caar alist))
+       (setq test (caddar alist)
+             alist nil)
+       (setq test (eval test)))
+      (pop alist))
+    test))
+
+(defun mm-user-method (type)
+  "Return the user-defined method for TYPE."
+  (let ((methods mm-user-display-methods)
+       method result)
+    (while (setq method (pop methods))
+      (when (string-match (car method) type)
+       (when (or (not (eq (cdr method) 'inline))
+                 (mm-inlinable-p type))
+         (setq result (cdr method)
+               methods nil))))
+    result))
+
+(defun mm-automatic-display-p (type)
+  "Return the user-defined method for TYPE."
+  (let ((methods mm-user-automatic-display)
+       method result)
+    (while (setq method (pop methods))
+      (when (string-match method type)
+       (setq result t
+             methods nil)))
+    result))
+
+(defun add-mime-display-method (type method)
+  "Make parts of TYPE be displayed with METHOD.
+This overrides entries in the mailcap file."
+  (push (cons type method) mm-user-display-methods))
+
+(defun mm-destroy-part (handle)
+  "Destroy the data structures connected to HANDLE."
+  (mm-remove-part handle)
+  (when (buffer-live-p (car handle))
+    (kill-buffer (car handle))))
+
+(defun mm-quote-arg (arg)
+  "Return a version of ARG that is safe to evaluate in a shell."
+  (let ((pos 0) new-pos accum)
+    ;; *** bug: we don't handle newline characters properly
+    (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos))
+      (push (substring arg pos new-pos) accum)
+      (push "\\" accum)
+      (push (list (aref arg new-pos)) accum)
+      (setq pos (1+ new-pos)))
+    (if (= pos 0)
+        arg
+      (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
+
+;;;
+;;; Functions for displaying various formats inline
+;;;
+
+(defun mm-inline-image (handle)
+  (let ((type (cadr (split-string (caadr handle) "/")))
+       image)
+    (mm-with-unibyte-buffer
+      (insert-buffer-substring (car handle))
+      (mm-decode-content-transfer-encoding (nth 2 handle))
+      (setq image (make-image-specifier
+                  (vector (intern type) :data (buffer-string)))))
+    (let ((annot (make-annotation image nil 'text)))
+      (set-extent-property annot 'mm t)
+      (set-extent-property annot 'duplicable t)
+      (setcar (nthcdr 3 handle) annot))))
+
+(defun mm-inline-text (handle)
+  (let ((type (cadr (split-string (caadr handle) "/")))
+       text buffer-read-only)
+    (mm-with-unibyte-buffer
+      (insert-buffer-substring (car handle))
+      (mm-decode-content-transfer-encoding (nth 2 handle))
+      (setq text (buffer-string)))
+    (cond
+     ((equal type "plain")
+      (let ((b (point)))
+       (insert text)
+       (setcar
+        (nthcdr 3 handle)
+        `(lambda ()
+           (let (buffer-read-only)
+             (delete-region ,(set-marker (make-marker) b)
+                            ,(set-marker (make-marker) (point)))))))))))
+                                   
+    
 (provide 'mm-decode)
 
 ;; mm-decode.el ends here
index d806104..01ef03c 100644 (file)
 
 
 (eval-and-compile
-  (if (fboundp 'decode-coding-string)
-      (fset 'mm-decode-coding-string 'decode-coding-string)
-    (fset 'mm-decode-coding-string (lambda (s a) s)))
-
-  (if (fboundp 'encode-coding-string)
-      (fset 'mm-encode-coding-string 'encode-coding-string)
-    (fset 'mm-encode-coding-string (lambda (s a) s)))
-
-  (if (fboundp 'encode-coding-region)
-      (fset 'mm-encode-coding-region 'encode-coding-region)
-    (fset 'mm-encode-coding-region 'ignore))
-
-  (if (fboundp 'decode-coding-region)
-      (fset 'mm-decode-coding-region 'decode-coding-region)
-    (fset 'mm-decode-coding-region 'ignore))
-
-  (if (fboundp 'coding-system-list)
-      (fset 'mm-coding-system-list 'coding-system-list)
-    (fset 'mm-coding-system-list 'ignore))
-
-  (if (fboundp 'char-int)
-      (fset 'mm-char-int 'char-int)
-    (fset 'mm-char-int 'identity))
-
-  (if (fboundp 'coding-system-equal)
-      (fset 'mm-coding-system-equal 'coding-system-equal)
-    (fset 'mm-coding-system-equal 'equal))
-
-  (if (fboundp 'read-coding-system)
-      (fset 'mm-read-coding-system 'read-coding-system)
-    (defun mm-read-coding-system (prompt)
-      "Prompt the user for a coding system."
-      (completing-read
-       prompt (mapcar (lambda (s) (list (symbol-name (car s))))
-                     mm-mime-mule-charset-alist)))))
-
+  (mapcar
+   (lambda (elem)
+     (let ((nfunc (intern (format "mm-%s" (car elem)))))
+       (if (fboundp (car elem))
+          (fset nfunc (car elem))
+        (fset nfunc (cdr elem)))))
+   '((decode-coding-string . (lambda (s a) s))
+     (encode-coding-string . (lambda (s a) s))
+     (encode-coding-region . ignore)
+     (decode-coding-region . ignore)
+     (coding-system-list . ignore)
+     (char-int . identity)
+     (device-type . ignore)
+     (coding-system-equal . equal)
+     (annotationp . ignore)
+     (make-char
+      . (lambda (charset int)
+         (int-to-char int)))
+     (read-coding-system
+      . (lambda (prompt)
+         "Prompt the user for a coding system."
+         (completing-read
+          prompt (mapcar (lambda (s) (list (symbol-name (car s))))
+                         mm-mime-mule-charset-alist)))))))
 
 (defvar mm-charset-coding-system-alist
   (let ((rest
@@ -180,12 +168,6 @@ used as the line break code type of the coding system."
   (insert "Content-Transfer-Encoding: "
          (downcase (symbol-name encoding)) "\n"))
 
-(defun mm-content-type-charset (header)
-  "Return the charset parameter from HEADER."
-  (when (string-match "charset *= *\"? *\\([-0-9a-zA-Z_]+\\)\"? *$" header)
-    (intern (downcase (match-string 1 header)))))
-
-
 (defun mm-mime-charset (charset b e)
   (if (fboundp 'coding-system-get)
       (or
@@ -201,6 +183,25 @@ used as the line break code type of the coding system."
   (and (boundp 'enable-multibyte-characters)
        enable-multibyte-characters))
 
+(defmacro mm-with-unibyte-buffer (&rest forms)
+  "Create a temporary buffer, and evaluate FORMS there like `progn'.
+See also `with-temp-file' and `with-output-to-string'."
+  (let ((temp-buffer (make-symbol "temp-buffer"))
+       (multibyte (make-symbol "multibyte")))
+    `(if (not (boundp 'enable-multibyte-characters))
+        (with-temp-buffer ,@forms)
+       (let ((,multibyte (default-value enable-multibyte-characters))
+            ,temp-buffer)
+        (setq-default enable-multibyte-characters nil)
+        (setq ,temp-buffer
+              (get-buffer-create (generate-new-buffer-name " *temp*")))
+        (unwind-protect
+            (with-current-buffer ,temp-buffer
+              ,@forms)
+          (and (buffer-name ,temp-buffer)
+               (kill-buffer ,temp-buffer))
+          (setq-default enable-multibyte-characters ,multibyte))))))
+
 (provide 'mm-util)
 
 ;;; mm-util.el ends here
index 48a0586..038541c 100644 (file)
                        (= (length elt) 4)
                        (= (aref elt 1) ?:)))
      [0 1] [2 4] ,#'(lambda () 0))
+    ((2 1 0)
+     ,#'(lambda () (and (stringp elt)
+                       (= (length elt) 7)
+                       (= (aref elt 1) ?:)))
+     [0 1] [2 4] [5 7])
     ((5) (70 99) ,#'(lambda () (+ 1900 elt))))
   "(slots predicate extractor...)")
 
index be48633..6333eb2 100644 (file)
@@ -1,7 +1,7 @@
 \input texinfo                  @c -*-texinfo-*-
 
 @setfilename gnus-ja
-@settitle Semi-gnus 6.10.016 Manual
+@settitle Semi-gnus 6.10.017 Manual
 @synindex fn cp
 @synindex vr cp
 @synindex pg cp
@@ -345,7 +345,7 @@ into another language, under the above conditions for modified versions.
 @tex
 
 @titlepage
-@title Semi-gnus 6.10.016 Manual
+@title Semi-gnus 6.10.017 Manual
 
 @author by Lars Magne Ingebrigtsen
 @author by members of Semi-gnus mailing-list
@@ -399,7 +399,7 @@ Semi-gnus \e$B$O!"Bg$-$J3($,F~$C$F$$$?$j$5$^$6$^$J7A<0$rMQ$$$?$j$7$F$$$k$A$g$C\e(B
 \e$B$J8@8l7w$r:9JL$7$^$;$s!#$"$"!"%/%j%s%4%s$NJ}$O\e(B Unicode Next Generation\e$B$r\e(B
 \e$B$*BT$A$/$@$5$$!#\e(B
 
-\e$B$3$N@bL@=q$O\e(B Semi-gnus 6.10.016 \e$B$KBP1~$7$^$9!#\e(B
+\e$B$3$N@bL@=q$O\e(B Semi-gnus 6.10.017 \e$B$KBP1~$7$^$9!#\e(B
 
 @end ifinfo
 
index ab23e52..f2e4f41 100644 (file)
@@ -1,7 +1,7 @@
 \input texinfo                  @c -*-texinfo-*-
 
 @setfilename gnus
-@settitle Semi-gnus 6.10.016 Manual
+@settitle Semi-gnus 6.10.017 Manual
 @synindex fn cp
 @synindex vr cp
 @synindex pg cp
@@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions.
 @tex
 
 @titlepage
-@title Semi-gnus 6.10.016 Manual
+@title Semi-gnus 6.10.017 Manual
 
 @author by Lars Magne Ingebrigtsen
 @page
@@ -361,7 +361,7 @@ internationalization/localization and multiscript features based on MULE
 API.  So Semi-gnus does not discriminate various language communities.
 Oh, if you are a Klingon, please wait Unicode Next Generation.
 
-This manual corresponds to Semi-gnus 6.10.016.
+This manual corresponds to Semi-gnus 6.10.017.
 
 @end ifinfo
 
index 1ff0844..ba7c0d9 100644 (file)
@@ -1,7 +1,7 @@
 \input texinfo                  @c -*-texinfo-*-
 
 @setfilename message
-@settitle Pterodactyl Message 0.24 Manual
+@settitle Pterodactyl Message 0.25 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 Pterodactyl Message 0.24 Manual
+@title Pterodactyl Message 0.25 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 Pterodactyl Message 0.24.  Message is
+This manual corresponds to Pterodactyl Message 0.25.  Message is
 distributed with the Gnus distribution bearing the same version number
 as this manual.