*** pub/pgnus/lisp/drums.el Tue Sep 8 04:28:42 1998 --- pgnus/lisp/drums.el Fri Sep 11 08:08:31 1998 *************** *** 29,34 **** --- 29,35 ---- ;;; 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.") *************** *** 50,65 **** (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-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) table)) (defsubst drums-init (string) (set-syntax-table drums-syntax-table) (insert string) --- 51,93 ---- (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 ?@ "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) *************** *** 92,98 **** (cond ((eq c ?\") (forward-sexp 1)) ! ((memq c '(? ?\t)) (delete-char 1)) (t (forward-char 1)))) --- 120,126 ---- (cond ((eq c ?\") (forward-sexp 1)) ! ((memq c '(? ?\t ?\n)) (delete-char 1)) (t (forward-char 1)))) *************** *** 186,192 **** (defun drums-parse-date (string) "Return an Emacs time spec from STRING." (apply 'encode-time (parse-time-string string))) ! (provide 'drums) ;;; drums.el ends here --- 214,280 ---- (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 *** pub/pgnus/lisp/earcon.el Sat Aug 29 19:53:55 1998 --- pgnus/lisp/earcon.el Fri Sep 11 08:08:31 1998 *************** *** 74,81 **** (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. --- 74,79 ---- *************** *** 155,161 **** (setq alist nil) (setq entry nil))) entry)) - (defun earcon-button-push (marker) ;; Push button starting at MARKER. --- 153,158 ---- *** pub/pgnus/lisp/gnus-art.el Thu Sep 10 04:01:51 1998 --- pgnus/lisp/gnus-art.el Fri Sep 11 08:08:32 1998 *************** *** 34,39 **** --- 34,41 ---- (require 'gnus-int) (require 'browse-url) (require 'mm-bodies) + (require 'drums) + (require 'mm-decode) (defgroup gnus-article nil "Article display." *************** *** 374,396 **** (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-show-mime-method 'metamail-buffer - "Function to process a MIME message. - The function is called from the article buffer." - :group 'gnus-article-mime - :type 'function) - - (defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable - "*Function to decode MIME encoded words. - The function is called from the article buffer." - :group 'gnus-article-mime - :type 'function) - (defcustom gnus-page-delimiter "^\^L" "*Regexp describing what to use as article page delimiters. The default value is \"^\^L\", which is a form linefeed at the --- 376,381 ---- *************** *** 547,556 **** (defcustom gnus-article-decode-hook '(article-decode-charset article-decode-rfc1522) ! "*Hook run to decode charsets in articles.") ;;; Internal variables (defvar article-lapsed-timer nil) (defvar gnus-article-current-summary nil) --- 532,549 ---- (defcustom gnus-article-decode-hook '(article-decode-charset article-decode-rfc1522) ! "*Hook run to decode charsets in articles." ! :group 'gnus-article-headers ! :type 'hook) ! ! (defcustom gnus-display-mime-function 'gnus-display-mime ! "Function to display MIME articles." ! :group 'gnus-article-headers ! :type 'function) ;;; Internal variables + (defvar gnus-article-mime-handles nil) (defvar article-lapsed-timer nil) (defvar gnus-article-current-summary nil) *************** *** 894,900 **** (point) (progn (while (and (not (bobp)) ! (looking-at "^[ \t]*$")) (forward-line -1)) (forward-line 1) (point)))))) --- 887,895 ---- (point) (progn (while (and (not (bobp)) ! (looking-at "^[ \t]*$") ! (not (gnus-annotation-in-region-p ! (point) (gnus-point-at-eol)))) (forward-line -1)) (forward-line 1) (point)))))) *************** *** 968,978 **** (let* ((inhibit-point-motion-hooks t) (ct (message-fetch-field "Content-Type" t)) (cte (message-fetch-field "Content-Transfer-Encoding" t)) (charset (cond (prompt (mm-read-coding-system "Charset to decode: ")) (ct ! (mm-content-type-charset ct)) (gnus-newsgroup-name (gnus-group-find-parameter gnus-newsgroup-name 'charset)))) --- 963,974 ---- (let* ((inhibit-point-motion-hooks t) (ct (message-fetch-field "Content-Type" t)) (cte (message-fetch-field "Content-Transfer-Encoding" t)) + (ctl (and ct (drums-parse-content-type ct))) (charset (cond (prompt (mm-read-coding-system "Charset to decode: ")) (ct ! (drums-content-type-get ctl 'charset)) (gnus-newsgroup-name (gnus-group-find-parameter gnus-newsgroup-name 'charset)))) *************** *** 981,987 **** (widen) (narrow-to-region (point) (point-max)) (when (or (not ct) ! (string-match "text/plain" ct)) (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte)))))))))) --- 977,983 ---- (widen) (narrow-to-region (point) (point-max)) (when (or (not ct) ! (equal (car ctl) "text/plain")) (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte)))))))))) *************** *** 1118,1124 **** (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))))) (defun article-strip-leading-space () "Remove all white space from the beginning of the lines in the article." --- 1114,1122 ---- (goto-char (point-min)) (search-forward "\n\n" nil t) (while (re-search-forward "\n\n\n+" nil 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." *************** *** 1937,1950 **** (setq mode-name "Article") (setq major-mode 'gnus-article-mode) (make-local-variable 'minor-mode-alist) - (unless (assq 'gnus-show-mime minor-mode-alist) - (push (list 'gnus-show-mime " MIME") minor-mode-alist)) (use-local-map gnus-article-mode-map) (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) (make-local-variable 'gnus-page-broken) (make-local-variable 'gnus-button-marker-list) (make-local-variable 'gnus-article-current-summary) (gnus-set-default-directory) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) --- 1935,1947 ---- (setq mode-name "Article") (setq major-mode 'gnus-article-mode) (make-local-variable 'minor-mode-alist) (use-local-map gnus-article-mode-map) (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) (make-local-variable 'gnus-page-broken) (make-local-variable 'gnus-button-marker-list) (make-local-variable 'gnus-article-current-summary) + (make-local-variable 'gnus-article-mime-handles) (gnus-set-default-directory) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) *************** *** 2102,2115 **** (let (buffer-read-only) (gnus-run-hooks 'gnus-tmp-internal-hook) (gnus-run-hooks 'gnus-article-prepare-hook) ! ;; Decode MIME message. ! (when gnus-show-mime ! (if (or (not gnus-strict-mime) ! (gnus-fetch-field "Mime-Version")) ! (let ((coding-system-for-write 'binary) ! (coding-system-for-read 'binary)) ! (funcall gnus-show-mime-method)) ! (funcall gnus-decode-encoded-word-method))) ;; Perform the article display hooks. (gnus-run-hooks 'gnus-article-display-hook)) ;; Do page break. --- 2099,2106 ---- (let (buffer-read-only) (gnus-run-hooks 'gnus-tmp-internal-hook) (gnus-run-hooks 'gnus-article-prepare-hook) ! (when gnus-display-mime-function ! (funcall gnus-display-mime-function)) ;; Perform the article display hooks. (gnus-run-hooks 'gnus-article-display-hook)) ;; Do page break. *************** *** 2125,2130 **** --- 2116,2147 ---- (set-window-point (get-buffer-window (current-buffer)) (point)) t)))))) + (defun gnus-display-mime () + (let ((handles (mm-dissect-buffer)) + handle name type) + (mapcar 'mm-destroy-part gnus-article-mime-handles) + (setq gnus-article-mime-handles nil) + (setq gnus-article-mime-handles (nconc gnus-article-mime-handles handles)) + (when handles + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (delete-region (point) (point-max)) + (while (setq handle (pop handles)) + (setq name (drums-content-type-get (cadr handle) 'name) + type (caadr handle)) + (gnus-article-add-button + (point) + (progn + (insert + (format "[%s%s]" type (if name (concat " (" name ")") ""))) + (point)) + 'mm-display-part handle) + (insert "\n\n\n") + (when (mm-automatic-display-p type) + (forward-line -2) + (mm-display-part handle) + (goto-char (point-max))))))) + (defun gnus-article-wash-status () "Return a string which display status of article washing." (save-excursion *************** *** 2136,2150 **** (pem (gnus-article-hidden-text-p 'pem)) (signature (gnus-article-hidden-text-p 'signature)) (overstrike (gnus-article-hidden-text-p 'overstrike)) ! (emphasis (gnus-article-hidden-text-p 'emphasis)) ! (mime gnus-show-mime)) (format "%c%c%c%c%c%c%c" (if cite ?c ? ) (if (or headers boring) ?h ? ) (if (or pgp pem) ?p ? ) (if signature ?s ? ) (if overstrike ?o ? ) - (if mime ?m ? ) (if emphasis ?e ? ))))) (fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) --- 2153,2165 ---- (pem (gnus-article-hidden-text-p 'pem)) (signature (gnus-article-hidden-text-p 'signature)) (overstrike (gnus-article-hidden-text-p 'overstrike)) ! (emphasis (gnus-article-hidden-text-p 'emphasis))) (format "%c%c%c%c%c%c%c" (if cite ?c ? ) (if (or headers boring) ?h ? ) (if (or pgp pem) ?p ? ) (if signature ?s ? ) (if overstrike ?o ? ) (if emphasis ?e ? ))))) (fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) *** pub/pgnus/lisp/gnus-sum.el Thu Sep 10 04:01:52 1998 --- pgnus/lisp/gnus-sum.el Fri Sep 11 08:08:33 1998 *************** *** 328,340 **** :group 'gnus-article-various :type 'boolean) - (defcustom gnus-show-mime nil - "*If non-nil, do mime processing of articles. - The articles will simply be fed to the function given by - `gnus-show-mime-method'." - :group 'gnus-article-mime - :type 'boolean) - (defcustom gnus-move-split-methods nil "*Variable used to suggest where articles are to be moved to. It uses the same syntax as the `gnus-split-methods' variable." --- 328,333 ---- *************** *** 1188,1194 **** "\M-g" gnus-summary-rescan-group "w" gnus-summary-stop-page-breaking "\C-c\C-r" gnus-summary-caesar-message - "\M-t" gnus-summary-toggle-mime "f" gnus-summary-followup "F" gnus-summary-followup-with-original "C" gnus-summary-cancel-article --- 1181,1186 ---- *************** *** 1363,1369 **** "r" gnus-summary-caesar-message "t" gnus-article-hide-headers "v" gnus-summary-verbose-headers - "m" gnus-summary-toggle-mime "h" gnus-article-treat-html "d" gnus-article-treat-dumbquotes) --- 1355,1360 ---- *************** *** 1519,1525 **** ["Add buttons" gnus-article-add-buttons t] ["Add buttons to head" gnus-article-add-buttons-to-head t] ["Stop page breaking" gnus-summary-stop-page-breaking t] - ["Toggle MIME" gnus-summary-toggle-mime t] ["Verbose header" gnus-summary-verbose-headers t] ["Toggle header" gnus-summary-toggle-header t]) ("Output" --- 1510,1515 ---- *************** *** 5089,5094 **** --- 5079,5087 ---- nil ;Nothing to do. ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer + (save-excursion + (set-buffer gnus-article-buffer) + (mapcar 'mm-destroy-part gnus-article-mime-handles)) (gnus-kill-buffer gnus-article-buffer) (gnus-kill-buffer gnus-original-article-buffer) (setq gnus-article-current nil)) *************** *** 6598,6604 **** (gnus-use-trees nil) ;Inhibit updating tree buffer. (sum (current-buffer)) (found nil) ! point) (gnus-save-hidden-threads (gnus-summary-select-article) (set-buffer gnus-article-buffer) --- 6591,6597 ---- (gnus-use-trees nil) ;Inhibit updating tree buffer. (sum (current-buffer)) (found nil) ! point gnus-display-mime-function) (gnus-save-hidden-threads (gnus-summary-select-article) (set-buffer gnus-article-buffer) *************** *** 6772,6779 **** gnus-article-display-hook gnus-article-prepare-hook gnus-article-decode-hook gnus-break-pages - gnus-show-mime gnus-visual) (gnus-summary-select-article nil 'force))) (gnus-summary-goto-subject gnus-current-article) --- 6765,6772 ---- gnus-article-display-hook gnus-article-prepare-hook gnus-article-decode-hook + gnus-display-mime-function gnus-break-pages gnus-visual) (gnus-summary-select-article nil 'force))) (gnus-summary-goto-subject gnus-current-article) *************** *** 6823,6837 **** "Make all header lines visible." (interactive) (gnus-article-show-all-headers)) - - (defun gnus-summary-toggle-mime (&optional arg) - "Toggle MIME processing. - If ARG is a positive number, turn MIME processing on." - (interactive "P") - (setq gnus-show-mime - (if (null arg) (not gnus-show-mime) - (> (prefix-numeric-value arg) 0))) - (gnus-summary-select-article t 'force)) (defun gnus-summary-caesar-message (&optional arg) "Caesar rotate the current article by 13. --- 6816,6821 ---- *** pub/pgnus/lisp/gnus-util.el Wed Sep 9 12:23:57 1998 --- pgnus/lisp/gnus-util.el Fri Sep 11 08:08:33 1998 *************** *** 302,308 **** '(0 0) (or (get-text-property 0 'gnus-time d) ;; or compute the value... ! (let ((time (date-to-time d))) ;; and store it back in the string. (put-text-property 0 1 'gnus-time time d) time))))) --- 302,308 ---- '(0 0) (or (get-text-property 0 'gnus-time d) ;; or compute the value... ! (let ((time (safe-date-to-time d))) ;; and store it back in the string. (put-text-property 0 1 'gnus-time time d) time))))) *** pub/pgnus/lisp/gnus-uu.el Sat Aug 29 20:35:02 1998 --- pgnus/lisp/gnus-uu.el Fri Sep 11 08:08:33 1998 *************** *** 32,37 **** --- 32,38 ---- (require 'gnus-art) (require 'message) (require 'gnus-msg) + (require 'mm-decode) (defgroup gnus-extract nil "Extracting encoded files." *************** *** 1694,1716 **** (when (setq buf (get-buffer gnus-uu-output-buffer-name)) (kill-buffer buf)))) - (defun gnus-quote-arg-for-sh-or-csh (arg) - (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))))))) - ;; Inputs an action and a filename and returns a full command, making sure ;; that the filename will be treated as a single argument when the shell ;; executes the command. (defun gnus-uu-command (action file) ! (let ((quoted-file (gnus-quote-arg-for-sh-or-csh file))) (if (string-match "%s" action) (format action quoted-file) (concat action " " quoted-file)))) --- 1695,1705 ---- (when (setq buf (get-buffer gnus-uu-output-buffer-name)) (kill-buffer buf)))) ;; Inputs an action and a filename and returns a full command, making sure ;; that the filename will be treated as a single argument when the shell ;; executes the command. (defun gnus-uu-command (action file) ! (let ((quoted-file (mm-quote-arg file))) (if (string-match "%s" action) (format action quoted-file) (concat action " " quoted-file)))) *** pub/pgnus/lisp/gnus-xmas.el Sun Sep 6 21:34:45 1998 --- pgnus/lisp/gnus-xmas.el Fri Sep 11 08:08:33 1998 *************** *** 476,481 **** --- 476,482 ---- '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) *************** *** 801,806 **** --- 802,810 ---- (defun gnus-xmas-splash () (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) *** pub/pgnus/lisp/gnus.el Thu Sep 10 04:01:52 1998 --- pgnus/lisp/gnus.el Fri Sep 11 08:08:34 1998 *************** *** 250,256 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.24" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) --- 250,256 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.25" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) *************** *** 268,275 **** :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) --- 268,273 ---- *************** *** 289,295 **** (defalias 'gnus-characterp 'numberp) (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) ! (defalias 'gnus-key-press-event-p 'numberp)) ;; We define these group faces here to avoid the display ;; update forced when creating new faces. --- 287,294 ---- (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-annotation-in-region-p 'ignore)) ;; We define these group faces here to avoid the display ;; update forced when creating new faces. *************** *** 1373,1379 **** gnus-summary-stop-page-breaking ;; gnus-summary-caesar-message ;; gnus-summary-verbose-headers - gnus-summary-toggle-mime gnus-article-hide gnus-article-hide-headers gnus-article-hide-boring-headers --- 1372,1377 ---- *** pub/pgnus/lisp/lpath.el Tue Sep 8 22:37:45 1998 --- pgnus/lisp/lpath.el Fri Sep 11 08:08:34 1998 *************** *** 64,70 **** gnus-mule-get-coding-system decode-coding-string mail-aliases-setup mm-copy-tree url-view-url w3-prepare-buffer ! mule-write-region-no-coding-system char-int))) (setq load-path (cons "." load-path)) (require 'custom) --- 64,72 ---- gnus-mule-get-coding-system decode-coding-string mail-aliases-setup mm-copy-tree url-view-url w3-prepare-buffer ! mule-write-region-no-coding-system char-int ! annotationp delete-annotation make-image-specifier ! make-annotation))) (setq load-path (cons "." load-path)) (require 'custom) *** pub/pgnus/lisp/mailcap.el Fri Sep 11 08:08:42 1998 --- pgnus/lisp/mailcap.el Fri Sep 11 08:08:34 1998 *************** *** 0 **** --- 1,830 ---- + ;;; mailcap.el --- Functions for displaying MIME parts + ;; Copyright (C) 1998 Free Software Foundation, Inc. + + ;; Author: William M. Perry + ;; Lars Magne Ingebrigtsen + ;; 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\" . )) + (\"text\" + (\"plain\" . ))) + + Where 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 *** pub/pgnus/lisp/mm-bodies.el Tue Sep 8 07:07:55 1998 --- pgnus/lisp/mm-bodies.el Fri Sep 11 08:08:34 1998 *************** *** 89,113 **** ;;; Functions for decoding ;;; (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)))) (when (featurep 'mule) (let (mule-charset) (when (and charset --- 89,116 ---- ;;; 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 ! (mm-decode-content-transfer-encoding encoding)) (when (featurep 'mule) (let (mule-charset) (when (and charset *** pub/pgnus/lisp/mm-decode.el Sun Aug 30 17:48:01 1998 --- pgnus/lisp/mm-decode.el Fri Sep 11 08:08:34 1998 *************** *** 24,29 **** --- 24,280 ---- ;;; 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 *** pub/pgnus/lisp/mm-util.el Wed Sep 9 12:23:58 1998 --- pgnus/lisp/mm-util.el Fri Sep 11 08:08:34 1998 *************** *** 66,107 **** (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))))) ! (defvar mm-charset-coding-system-alist (let ((rest --- 66,95 ---- (eval-and-compile ! (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,191 **** (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 --- 168,173 ---- *************** *** 200,205 **** --- 182,206 ---- "Say whether multibyte is enabled." (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) *** pub/pgnus/lisp/parse-time.el Thu Sep 10 04:01:53 1998 --- pgnus/lisp/parse-time.el Fri Sep 11 08:08:34 1998 *************** *** 162,167 **** --- 162,172 ---- (= (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...)") *** pub/pgnus/lisp/ChangeLog Thu Sep 10 04:01:50 1998 --- pgnus/lisp/ChangeLog Fri Sep 11 08:08:31 1998 *************** *** 1,3 **** --- 1,51 ---- + Fri Sep 11 08:09:40 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.25 is released. + + 1998-09-11 07:38:14 Lars Magne Ingebrigtsen + + * 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 + + * 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 * gnus.el: Pterodactyl Gnus v0.24 is released. *** pub/pgnus/texi/gnus.texi Thu Sep 10 04:01:54 1998 --- pgnus/texi/gnus.texi Fri Sep 11 08:08:35 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.24 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.25 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 318,324 **** @tex @titlepage ! @title Pterodactyl Gnus 0.24 Manual @author by Lars Magne Ingebrigtsen @page --- 318,324 ---- @tex @titlepage ! @title Pterodactyl Gnus 0.25 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 354,360 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.24. @end ifinfo --- 354,360 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.25. @end ifinfo *** pub/pgnus/texi/message.texi Thu Sep 10 04:01:54 1998 --- pgnus/texi/message.texi Fri Sep 11 08:08:36 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.24 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.25 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Pterodactyl Message 0.24 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Pterodactyl Message 0.25 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 83,89 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.24. Message is distributed with the Gnus distribution bearing the same version number as this manual. --- 83,89 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.25. Message is distributed with the Gnus distribution bearing the same version number as this manual.