*** pub/pgnus/lisp/base64.el Sat Aug 29 22:25:22 1998 --- pgnus/lisp/base64.el Sat Aug 29 22:25:14 1998 *************** *** 0 **** --- 1,274 ---- + ;;; base64.el,v --- Base64 encoding functions + ;; Author: Kyle E. Jones + ;; Created: 1997/03/12 14:37:09 + ;; Version: 1.6 + ;; Keywords: extensions + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Copyright (C) 1997 Kyle E. Jones + ;;; + ;;; This file is not part of GNU Emacs, but the same permissions apply. + ;;; + ;;; 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. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;; For non-MULE + (if (not (fboundp 'char-int)) + (fset 'char-int 'identity)) + + (defvar base64-alphabet + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + + (defvar base64-decoder-program nil + "*Non-nil value should be a string that names a MIME base64 decoder. + The program should expect to read base64 data on its standard + input and write the converted data to its standard output.") + + (defvar base64-decoder-switches nil + "*List of command line flags passed to the command named by + base64-decoder-program.") + + (defvar base64-encoder-program nil + "*Non-nil value should be a string that names a MIME base64 encoder. + The program should expect arbitrary data on its standard + input and write base64 data to its standard output.") + + (defvar base64-encoder-switches nil + "*List of command line flags passed to the command named by + base64-encoder-program.") + + (defconst base64-alphabet-decoding-alist + '( + ( ?A . 00) ( ?B . 01) ( ?C . 02) ( ?D . 03) ( ?E . 04) ( ?F . 05) + ( ?G . 06) ( ?H . 07) ( ?I . 08) ( ?J . 09) ( ?K . 10) ( ?L . 11) + ( ?M . 12) ( ?N . 13) ( ?O . 14) ( ?P . 15) ( ?Q . 16) ( ?R . 17) + ( ?S . 18) ( ?T . 19) ( ?U . 20) ( ?V . 21) ( ?W . 22) ( ?X . 23) + ( ?Y . 24) ( ?Z . 25) ( ?a . 26) ( ?b . 27) ( ?c . 28) ( ?d . 29) + ( ?e . 30) ( ?f . 31) ( ?g . 32) ( ?h . 33) ( ?i . 34) ( ?j . 35) + ( ?k . 36) ( ?l . 37) ( ?m . 38) ( ?n . 39) ( ?o . 40) ( ?p . 41) + ( ?q . 42) ( ?r . 43) ( ?s . 44) ( ?t . 45) ( ?u . 46) ( ?v . 47) + ( ?w . 48) ( ?x . 49) ( ?y . 50) ( ?z . 51) ( ?0 . 52) ( ?1 . 53) + ( ?2 . 54) ( ?3 . 55) ( ?4 . 56) ( ?5 . 57) ( ?6 . 58) ( ?7 . 59) + ( ?8 . 60) ( ?9 . 61) ( ?+ . 62) ( ?/ . 63) + )) + + (defvar base64-alphabet-decoding-vector + (let ((v (make-vector 123 nil)) + (p base64-alphabet-decoding-alist)) + (while p + (aset v (car (car p)) (cdr (car p))) + (setq p (cdr p))) + v)) + + (defun base64-run-command-on-region (start end output-buffer command + &rest arg-list) + (let ((tempfile nil) status errstring) + (unwind-protect + (progn + (setq tempfile (make-temp-name "base64")) + (setq status + (apply 'call-process-region + start end command nil + (list output-buffer tempfile) + nil arg-list)) + (cond ((equal status 0) t) + ((zerop (save-excursion + (set-buffer (find-file-noselect tempfile)) + (buffer-size))) + t) + (t (save-excursion + (set-buffer (find-file-noselect tempfile)) + (setq errstring (buffer-string)) + (kill-buffer nil) + (cons status errstring))))) + (condition-case () + (delete-file tempfile) + (error nil))))) + + (defun base64-insert-char (char &optional count ignored buffer) + (condition-case nil + (progn + (insert-char char count ignored buffer) + (fset 'base64-insert-char 'insert-char)) + (wrong-number-of-arguments + (fset 'base64-insert-char 'base64-xemacs-insert-char) + (base64-insert-char char count ignored buffer)))) + + (defun base64-xemacs-insert-char (char &optional count ignored buffer) + (if (and buffer (eq buffer (current-buffer))) + (insert-char char count) + (save-excursion + (set-buffer buffer) + (insert-char char count)))) + + (defun base64-decode-region (start end) + (interactive "r") + (message "Decoding base64...") + (let ((work-buffer nil) + (done nil) + (counter 0) + (bits 0) + (lim 0) inputpos + (non-data-chars (concat "^=" base64-alphabet))) + (unwind-protect + (save-excursion + (setq work-buffer (generate-new-buffer " *base64-work*")) + (buffer-disable-undo work-buffer) + (if base64-decoder-program + (let* ((binary-process-output t) ; any text already has CRLFs + (status (apply 'base64-run-command-on-region + start end work-buffer + base64-decoder-program + base64-decoder-switches))) + (if (not (eq status t)) + (error "%s" (cdr status)))) + (goto-char start) + (skip-chars-forward non-data-chars end) + (while (not done) + (setq inputpos (point)) + (cond + ((> (skip-chars-forward base64-alphabet end) 0) + (setq lim (point)) + (while (< inputpos lim) + (setq bits (+ bits + (aref base64-alphabet-decoding-vector + (char-int (char-after inputpos))))) + (setq counter (1+ counter) + inputpos (1+ inputpos)) + (cond ((= counter 4) + (base64-insert-char (lsh bits -16) 1 nil work-buffer) + (base64-insert-char (logand (lsh bits -8) 255) 1 nil + work-buffer) + (base64-insert-char (logand bits 255) 1 nil + work-buffer) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 6))))))) + (cond + ((= (point) end) + (if (not (zerop counter)) + (error "at least %d bits missing at end of base64 encoding" + (* (- 4 counter) 6))) + (setq done t)) + ((= (char-after (point)) ?=) + (setq done t) + (cond ((= counter 1) + (error "at least 2 bits missing at end of base64 encoding")) + ((= counter 2) + (base64-insert-char (lsh bits -10) 1 nil work-buffer)) + ((= counter 3) + (base64-insert-char (lsh bits -16) 1 nil work-buffer) + (base64-insert-char (logand (lsh bits -8) 255) + 1 nil work-buffer)) + ((= counter 0) t))) + (t (skip-chars-forward non-data-chars end))))) + (or (markerp end) (setq end (set-marker (make-marker) end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)))) + (message "Decoding base64... done")) + + (defun base64-encode-region (start end) + (interactive "r") + (message "Encoding base64...") + (let ((work-buffer nil) + (counter 0) + (cols 0) + (bits 0) + (alphabet base64-alphabet) + inputpos) + (unwind-protect + (save-excursion + (setq work-buffer (generate-new-buffer " *base64-work*")) + (buffer-disable-undo work-buffer) + (if base64-encoder-program + (let ((status (apply 'base64-run-command-on-region + start end work-buffer + base64-encoder-program + base64-encoder-switches))) + (if (not (eq status t)) + (error "%s" (cdr status)))) + (setq inputpos start) + (while (< inputpos end) + (setq bits (+ bits (char-int (char-after inputpos)))) + (setq counter (1+ counter)) + (cond ((= counter 3) + (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil + work-buffer) + (base64-insert-char + (aref alphabet (logand (lsh bits -12) 63)) + 1 nil work-buffer) + (base64-insert-char + (aref alphabet (logand (lsh bits -6) 63)) + 1 nil work-buffer) + (base64-insert-char + (aref alphabet (logand bits 63)) + 1 nil work-buffer) + (setq cols (+ cols 4)) + (cond ((= cols 72) + (base64-insert-char ?\n 1 nil work-buffer) + (setq cols 0))) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 8)))) + (setq inputpos (1+ inputpos))) + ;; write out any remaining bits with appropriate padding + (if (= counter 0) + nil + (setq bits (lsh bits (- 16 (* 8 counter)))) + (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil + work-buffer) + (base64-insert-char (aref alphabet (logand (lsh bits -12) 63)) + 1 nil work-buffer) + (if (= counter 1) + (base64-insert-char ?= 2 nil work-buffer) + (base64-insert-char (aref alphabet (logand (lsh bits -6) 63)) + 1 nil work-buffer) + (base64-insert-char ?= 1 nil work-buffer))) + (if (> cols 0) + (base64-insert-char ?\n 1 nil work-buffer))) + (or (markerp end) (setq end (set-marker (make-marker) end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)))) + (message "Encoding base64... done")) + + (defun base64-encode (string) + (save-excursion + (set-buffer (get-buffer-create " *base64-encode*")) + (erase-buffer) + (insert string) + (base64-encode-region (point-min) (point-max)) + (skip-chars-backward " \t\r\n") + (delete-region (point-max) (point)) + (prog1 + (buffer-string) + (kill-buffer (current-buffer))))) + + (defun base64-decode (string) + (save-excursion + (set-buffer (get-buffer-create " *base64-decode*")) + (erase-buffer) + (insert string) + (base64-decode-region (point-min) (point-max)) + (goto-char (point-max)) + (skip-chars-backward " \t\r\n") + (delete-region (point-max) (point)) + (prog1 + (buffer-string) + (kill-buffer (current-buffer))))) + + (provide 'base64) *** pub/pgnus/lisp/gnus-agent.el Sat Aug 29 19:54:12 1998 --- pgnus/lisp/gnus-agent.el Sat Aug 29 22:25:14 1998 *************** *** 127,133 **** (defun gnus-agent-read-file (file) "Load FILE and do a `read' there." ! (nnheader-temp-write nil (ignore-errors (nnheader-insert-file-contents file) (goto-char (point-min)) --- 127,133 ---- (defun gnus-agent-read-file (file) "Load FILE and do a `read' there." ! (with-temp-buffer (ignore-errors (nnheader-insert-file-contents file) (goto-char (point-min)) *************** *** 427,433 **** (defun gnus-agent-write-servers () "Write the alist of covered servers." ! (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/servers") (prin1 gnus-agent-covered-methods (current-buffer)))) ;;; --- 427,433 ---- (defun gnus-agent-write-servers () "Write the alist of covered servers." ! (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") (prin1 gnus-agent-covered-methods (current-buffer)))) ;;; *************** *** 537,543 **** (gnus-agent-lib-file "active") (gnus-agent-lib-file "groups")))) (gnus-make-directory (file-name-directory file)) ! (nnheader-temp-write file (when (file-exists-p file) (nnheader-insert-file-contents file)) (goto-char (point-min)) --- 537,543 ---- (gnus-agent-lib-file "active") (gnus-agent-lib-file "groups")))) (gnus-make-directory (file-name-directory file)) ! (with-temp-file file (when (file-exists-p file) (nnheader-insert-file-contents file)) (goto-char (point-min)) *************** *** 662,668 **** ;; Fetch the articles from the backend. (if (gnus-check-backend-function 'retrieve-articles group) (setq pos (gnus-retrieve-articles articles group)) ! (nnheader-temp-write nil (let (article) (while (setq article (pop articles)) (when (gnus-request-article article group) --- 662,668 ---- ;; Fetch the articles from the backend. (if (gnus-check-backend-function 'retrieve-articles group) (setq pos (gnus-retrieve-articles articles group)) ! (with-temp-file nil (let (article) (while (setq article (pop articles)) (when (gnus-request-article article group) *************** *** 745,751 **** nil 'silent) (pop gnus-agent-buffer-alist)) (while gnus-agent-group-alist ! (nnheader-temp-write (caar gnus-agent-group-alist) (princ (cdar gnus-agent-group-alist)) (insert "\n")) (pop gnus-agent-group-alist)))) --- 745,751 ---- nil 'silent) (pop gnus-agent-buffer-alist)) (while gnus-agent-group-alist ! (with-temp-file (caar gnus-agent-group-alist) (princ (cdar gnus-agent-group-alist)) (insert "\n")) (pop gnus-agent-group-alist)))) *************** *** 837,845 **** (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." ! (nnheader-temp-write (if dir ! (concat dir ".agentview") ! (gnus-agent-article-name ".agentview" group)) (princ (setq gnus-agent-article-alist (nconc gnus-agent-article-alist (mapcar (lambda (article) (cons article state)) --- 837,845 ---- (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." ! (with-temp-file (if dir ! (concat dir ".agentview") ! (gnus-agent-article-name ".agentview" group)) (princ (setq gnus-agent-article-alist (nconc gnus-agent-article-alist (mapcar (lambda (article) (cons article state)) *************** *** 1084,1090 **** "Write the category alist." (setq gnus-category-predicate-cache nil gnus-category-group-cache nil) ! (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/categories") (prin1 gnus-category-alist (current-buffer)))) (defun gnus-category-edit-predicate (category) --- 1084,1090 ---- "Write the category alist." (setq gnus-category-predicate-cache nil gnus-category-group-cache nil) ! (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories") (prin1 gnus-category-alist (current-buffer)))) (defun gnus-category-edit-predicate (category) *** pub/pgnus/lisp/gnus-art.el Sat Aug 29 19:53:56 1998 --- pgnus/lisp/gnus-art.el Sat Aug 29 22:25:15 1998 *************** *** 272,278 **** :group 'gnus-article-washing) (eval-and-compile - (autoload 'hexl-hex-string-to-integer "hexl") (autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'mail-extract-address-components "mail-extr")) --- 272,277 ---- *************** *** 958,1029 **** (while (search-forward "=10" nil t) (replace-match " " t t)))) (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) (defun article-decode-rfc1522 () ! "Hack to remove QP encoding from headers." ! (let ((case-fold-search t) ! (inhibit-point-motion-hooks t) ! (buffer-read-only nil) ! string) (save-restriction ! (narrow-to-region ! (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) (point-max))) ! (goto-char (point-min)) ! (while (re-search-forward ! "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) ! (setq string (match-string 1)) ! (save-restriction ! (narrow-to-region (match-beginning 0) (match-end 0)) ! (delete-region (point-min) (point-max)) ! (insert string) ! (article-mime-decode-quoted-printable ! (goto-char (point-min)) (point-max)) ! (subst-char-in-region (point-min) (point-max) ?_ ? ) ! (goto-char (point-max))) ! (goto-char (point-min)))))) (defun article-de-quoted-unreadable (&optional force) ! "Do a naive translation of a quoted-printable-encoded article. ! This is in no way, shape or form meant as a replacement for real MIME ! processing, but is simply a stop-gap measure until MIME support is ! written. If FORCE, decode the article whether it is marked as quoted-printable or not." (interactive (list 'force)) (save-excursion ! (let ((case-fold-search t) ! (buffer-read-only nil) (type (gnus-fetch-field "content-transfer-encoding"))) (gnus-article-decode-rfc1522) (when (or force (and type (string-match "quoted-printable" (downcase type)))) (goto-char (point-min)) (search-forward "\n\n" nil 'move) ! (article-mime-decode-quoted-printable (point) (point-max)))))) (defun article-mime-decode-quoted-printable-buffer () "Decode Quoted-Printable in the current buffer." ! (article-mime-decode-quoted-printable (point-min) (point-max))) ! ! (defun article-mime-decode-quoted-printable (from to) ! "Decode Quoted-Printable in the region between FROM and TO." ! (interactive "r") ! (goto-char from) ! (while (search-forward "=" to t) ! (cond ((eq (following-char) ?\n) ! (delete-char -1) ! (delete-char 1)) ! ((looking-at "[0-9A-F][0-9A-F]") ! (subst-char-in-region ! (1- (point)) (point) ?= ! (hexl-hex-string-to-integer ! (buffer-substring (point) (+ 2 (point))))) ! (delete-char 2)) ! ((looking-at "=") ! (delete-char 1)) ! ((gnus-message 3 "Malformed MIME quoted-printable message"))))) (defun article-hide-pgp (&optional arg) "Toggle hiding of any PGP headers and signatures in the current article. --- 957,997 ---- (while (search-forward "=10" nil t) (replace-match " " t t)))) + (defun gnus-article-decode-mime-words () + "Decode all MIME-encoded words in the article." + (interactive) + (save-excursion + (let (buffer-read-only) + (mm-decode-words-region (point-min) (point-max))))) + (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) (defun article-decode-rfc1522 () ! "Remove QP encoding from headers." ! (let ((inhibit-point-motion-hooks t) ! (buffer-read-only nil)) (save-restriction ! (message-narrow-to-head) ! (mm-decode-words-region (point-min) (point-max))))) (defun article-de-quoted-unreadable (&optional force) ! "Translation a quoted-printable-encoded article. If FORCE, decode the article whether it is marked as quoted-printable or not." (interactive (list 'force)) (save-excursion ! (let ((buffer-read-only nil) (type (gnus-fetch-field "content-transfer-encoding"))) (gnus-article-decode-rfc1522) (when (or force (and type (string-match "quoted-printable" (downcase type)))) (goto-char (point-min)) (search-forward "\n\n" nil 'move) ! (quoted-printable-decode-region (point) (point-max)))))) (defun article-mime-decode-quoted-printable-buffer () "Decode Quoted-Printable in the current buffer." ! (quoted-printable-decode-region (point-min) (point-max))) (defun article-hide-pgp (&optional arg) "Toggle hiding of any PGP headers and signatures in the current article. *************** *** 1231,1237 **** (setq b (point)) (point-max)) (setq e (point-max))) ! (nnheader-temp-write nil (insert-buffer-substring gnus-article-buffer b e) (require 'url) (save-window-excursion --- 1199,1205 ---- (setq b (point)) (point-max)) (setq e (point-max))) ! (with-temp-buffer (insert-buffer-substring gnus-article-buffer b e) (require 'url) (save-window-excursion *************** *** 2189,2195 **** (defun gnus-output-to-file (file-name) "Append the current article to a file named FILE-NAME." (let ((artbuf (current-buffer))) ! (nnheader-temp-write nil (insert-buffer-substring artbuf) ;; Append newline at end of the buffer as separator, and then ;; save it to file. --- 2157,2163 ---- (defun gnus-output-to-file (file-name) "Append the current article to a file named FILE-NAME." (let ((artbuf (current-buffer))) ! (with-temp-buffer (insert-buffer-substring artbuf) ;; Append newline at end of the buffer as separator, and then ;; save it to file. *************** *** 3135,3141 **** (defun gnus-url-parse-query-string (query &optional downcase) (let (retval pairs cur key val) ! (setq pairs (gnus-split-string query "&")) (while pairs (setq cur (car pairs) pairs (cdr pairs)) --- 3103,3109 ---- (defun gnus-url-parse-query-string (query &optional downcase) (let (retval pairs cur key val) ! (setq pairs (split-string query "&")) (while pairs (setq cur (car pairs) pairs (cdr pairs)) *** pub/pgnus/lisp/gnus-cache.el Sat Aug 29 19:53:56 1998 --- pgnus/lisp/gnus-cache.el Sat Aug 29 22:25:15 1998 *************** *** 595,601 **** (when (or force (and gnus-cache-active-hashtb gnus-cache-active-altered)) ! (nnheader-temp-write gnus-cache-active-file (mapatoms (lambda (sym) (when (and sym (boundp sym)) --- 595,601 ---- (when (or force (and gnus-cache-active-hashtb gnus-cache-active-altered)) ! (with-temp-file gnus-cache-active-file (mapatoms (lambda (sym) (when (and sym (boundp sym)) *** pub/pgnus/lisp/gnus-dup.el Sat Aug 29 19:54:04 1998 --- pgnus/lisp/gnus-dup.el Sat Aug 29 22:25:15 1998 *************** *** 98,104 **** "Save the duplicate suppression list." (when (and gnus-save-duplicate-list gnus-dup-list-dirty) ! (nnheader-temp-write gnus-duplicate-file (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list)))) (setq gnus-dup-list-dirty nil)) --- 98,104 ---- "Save the duplicate suppression list." (when (and gnus-save-duplicate-list gnus-dup-list-dirty) ! (with-temp-file gnus-duplicate-file (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list)))) (setq gnus-dup-list-dirty nil)) *** pub/pgnus/lisp/gnus-ems.el Sat Aug 29 19:53:56 1998 --- pgnus/lisp/gnus-ems.el Sat Aug 29 22:25:15 1998 *************** *** 45,53 **** (autoload 'gnus-xmas-redefine "gnus-xmas") (autoload 'appt-select-lowest-window "appt")) - (or (fboundp 'mail-file-babyl-p) - (fset 'mail-file-babyl-p 'rmail-file-p)) - ;;; Mule functions. (defun gnus-mule-cite-add-face (number prefix face) --- 45,50 ---- *************** *** 78,89 **** (truncate-string valstr (, max-width)) valstr)))) - (defun gnus-encode-coding-string (string system) - string) - - (defun gnus-decode-coding-string (string system) - string) - (eval-and-compile (if (string-match "XEmacs\\|Lucid" emacs-version) nil --- 75,80 ---- *************** *** 95,114 **** ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-define)) - ((or (not (boundp 'emacs-minor-version)) - (and (< emacs-major-version 20) - (< emacs-minor-version 30))) - ;; Remove the `intangible' prop. - (let ((props (and (boundp 'gnus-hidden-properties) - gnus-hidden-properties))) - (while (and props (not (eq (car (cdr props)) 'intangible))) - (setq props (cdr props))) - (when props - (setcdr props (cdr (cdr (cdr props)))))) - (unless (fboundp 'buffer-substring-no-properties) - (defun buffer-substring-no-properties (beg end) - (format "%s" (buffer-substring beg end))))) - ((boundp 'MULE) (provide 'gnusutil)))) --- 86,91 ---- *************** *** 180,187 **** (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) (fset 'gnus-max-width-function 'gnus-mule-max-width-function) (fset 'gnus-summary-set-display-table (lambda ())) - (fset 'gnus-encode-coding-string 'encode-coding-string) - (fset 'gnus-decode-coding-string 'decode-coding-string) (when (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting --- 157,162 ---- *************** *** 234,240 **** (erase-buffer) (when (and dir (file-exists-p (setq file (concat dir "x-splash")))) ! (nnheader-temp-write nil (insert-file-contents file) (goto-char (point-min)) (ignore-errors --- 209,215 ---- (erase-buffer) (when (and dir (file-exists-p (setq file (concat dir "x-splash")))) ! (with-temp-buffer (insert-file-contents file) (goto-char (point-min)) (ignore-errors *************** *** 245,251 **** (make-face 'gnus-splash)) (setq height (/ (car pixmap) (frame-char-height)) width (/ (cadr pixmap) (frame-char-width))) ! (set-face-foreground 'gnus-splash "ForestGreen") (set-face-stipple 'gnus-splash pixmap) (insert-char ?\n (* (/ (window-height) 2 height) height)) (setq i height) --- 220,226 ---- (make-face 'gnus-splash)) (setq height (/ (car pixmap) (frame-char-height)) width (/ (cadr pixmap) (frame-char-width))) ! (set-face-foreground 'gnus-splash "Brown") (set-face-stipple 'gnus-splash pixmap) (insert-char ?\n (* (/ (window-height) 2 height) height)) (setq i height) *************** *** 258,273 **** (decf i)) (goto-char (point-min)) (sit-for 0)))))) - - (if (fboundp 'split-string) - (fset 'gnus-split-string 'split-string) - (defun gnus-split-string (string pattern) - "Return a list of substrings of STRING which are separated by PATTERN." - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts))))) (provide 'gnus-ems) --- 233,238 ---- *** pub/pgnus/lisp/gnus-group.el Sat Aug 29 19:53:57 1998 --- pgnus/lisp/gnus-group.el Sat Aug 29 22:25:16 1998 *************** *** 2155,2161 **** (push (cons header regexps) scores)) scores))) (gnus-group-make-group group "nnkiboze" address) ! (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) (let (emacs-lisp-mode-hook) (pp scores (current-buffer))))) --- 2155,2161 ---- (push (cons header regexps) scores)) scores))) (gnus-group-make-group group "nnkiboze" address) ! (with-temp-file (gnus-score-file-name (concat "nnkiboze:" group)) (let (emacs-lisp-mode-hook) (pp scores (current-buffer))))) *** pub/pgnus/lisp/gnus-nocem.el Sat Aug 29 19:53:57 1998 --- pgnus/lisp/gnus-nocem.el Sat Aug 29 22:25:16 1998 *************** *** 146,152 **** (save-excursion (let ((dependencies (make-vector 10 nil)) headers header) ! (nnheader-temp-write nil (setq headers (if (eq 'nov (gnus-retrieve-headers --- 146,152 ---- (save-excursion (let ((dependencies (make-vector 10 nil)) headers header) ! (with-temp-buffer (setq headers (if (eq 'nov (gnus-retrieve-headers *************** *** 302,314 **** "Save the NoCeM cache." (when (and gnus-nocem-alist gnus-nocem-touched-alist) ! (nnheader-temp-write (gnus-nocem-cache-file) (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist))) (setq gnus-nocem-touched-alist nil))) (defun gnus-nocem-save-active () "Save the NoCeM active file." ! (nnheader-temp-write (gnus-nocem-active-file) (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active)))) (defun gnus-nocem-alist-to-hashtb () --- 302,314 ---- "Save the NoCeM cache." (when (and gnus-nocem-alist gnus-nocem-touched-alist) ! (with-temp-file (gnus-nocem-cache-file) (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist))) (setq gnus-nocem-touched-alist nil))) (defun gnus-nocem-save-active () "Save the NoCeM active file." ! (with-temp-file (gnus-nocem-active-file) (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active)))) (defun gnus-nocem-alist-to-hashtb () *** pub/pgnus/lisp/gnus-score.el Sat Aug 29 19:53:58 1998 --- pgnus/lisp/gnus-score.el Sat Aug 29 22:25:16 1998 *************** *** 2209,2215 **** ;; Perform adaptive word scoring. (when (and (listp gnus-newsgroup-adaptive) (memq 'word gnus-newsgroup-adaptive)) ! (nnheader-temp-write nil (let* ((hashtb (gnus-make-hashtable 1000)) (date (gnus-day-number (current-time-string))) (data gnus-newsgroup-data) --- 2209,2215 ---- ;; Perform adaptive word scoring. (when (and (listp gnus-newsgroup-adaptive) (memq 'word gnus-newsgroup-adaptive)) ! (with-temp-buffer (let* ((hashtb (gnus-make-hashtable 1000)) (date (gnus-day-number (current-time-string))) (data gnus-newsgroup-data) *************** *** 2625,2631 **** (defun gnus-sort-score-files (files) "Sort FILES so that the most general files come first." ! (nnheader-temp-write nil (let ((alist (mapcar (lambda (file) --- 2625,2631 ---- (defun gnus-sort-score-files (files) "Sort FILES so that the most general files come first." ! (with-temp-buffer (let ((alist (mapcar (lambda (file) *** pub/pgnus/lisp/gnus-soup.el Sat Aug 29 19:53:58 1998 --- pgnus/lisp/gnus-soup.el Sat Aug 29 22:25:16 1998 *************** *** 422,428 **** "Write the AREAS file." (interactive) (when gnus-soup-areas ! (nnheader-temp-write (concat gnus-soup-directory "AREAS") (let ((areas gnus-soup-areas) area) (while (setq area (pop areas)) --- 422,428 ---- "Write the AREAS file." (interactive) (when gnus-soup-areas ! (with-temp-file (concat gnus-soup-directory "AREAS") (let ((areas gnus-soup-areas) area) (while (setq area (pop areas)) *************** *** 443,449 **** (defun gnus-soup-write-replies (dir areas) "Write a REPLIES file in DIR containing AREAS." ! (nnheader-temp-write (concat dir "REPLIES") (let (area) (while (setq area (pop areas)) (insert (format "%s\t%s\t%s\n" --- 443,449 ---- (defun gnus-soup-write-replies (dir areas) "Write a REPLIES file in DIR containing AREAS." ! (with-temp-file (concat dir "REPLIES") (let (area) (while (setq area (pop areas)) (insert (format "%s\t%s\t%s\n" *** pub/pgnus/lisp/gnus-start.el Sat Aug 29 19:53:59 1998 --- pgnus/lisp/gnus-start.el Sat Aug 29 22:25:16 1998 *************** *** 2531,2537 **** (fboundp 'gnus-mule-get-coding-system) (gnus-mule-get-coding-system (symbol-name group))))) (if coding ! (setq str (gnus-decode-coding-string str (car coding)))) (set group str))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") --- 2531,2537 ---- (fboundp 'gnus-mule-get-coding-system) (gnus-mule-get-coding-system (symbol-name group))))) (if coding ! (setq str (decode-coding-string str (car coding)))) (set group str))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") *** pub/pgnus/lisp/gnus-sum.el Sat Aug 29 19:53:59 1998 --- pgnus/lisp/gnus-sum.el Sat Aug 29 22:25:17 1998 *************** *** 663,680 **** :group 'gnus-summary-visual :type 'hook) ! (defcustom gnus-structured-field-decoder 'identity ! "Function to decode non-ASCII characters in structured field for summary." ! :group 'gnus-various ! :type 'function) ! ! (defcustom gnus-unstructured-field-decoder 'identity ! "Function to decode non-ASCII characters in unstructured field for summary." ! :group 'gnus-various ! :type 'function) ! ! (defcustom gnus-parse-headers-hook ! (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) --- 663,669 ---- :group 'gnus-summary-visual :type 'hook) ! (defcustom gnus-parse-headers-hook nil "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) *************** *** 1395,1400 **** --- 1384,1392 ---- "c" gnus-article-highlight-citation "s" gnus-article-highlight-signature) + (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) + "w" gnus-article-decode-mime-words) + (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) "z" gnus-article-date-ut "u" gnus-article-date-ut *************** *** 1494,1499 **** --- 1486,1494 ---- ["Headers" gnus-article-highlight-headers t] ["Signature" gnus-article-highlight-signature t] ["Citation" gnus-article-highlight-citation t]) + ("MIME" + ["Words" gnus-article-decode-mime-words t] + ["QP" gnus-article-de-quoted-unreadable t]) ("Date" ["Local" gnus-article-date-local t] ["ISO8601" gnus-article-date-iso8601 t] *************** *** 3062,3071 **** (setq header (make-full-mail-header number ; number ! (funcall ! gnus-unstructured-field-decoder (gnus-nov-field)) ; subject ! (funcall ! gnus-structured-field-decoder (gnus-nov-field)) ; from (gnus-nov-field) ; date (or (gnus-nov-field) (nnheader-generate-fake-message-id)) ; id --- 3057,3064 ---- (setq header (make-full-mail-header number ; number ! (mm-decode-words-string (gnus-nov-field)) ; subject ! (mm-decode-words-string (gnus-nov-field)) ; from (gnus-nov-field) ; date (or (gnus-nov-field) (nnheader-generate-fake-message-id)) ; id *************** *** 4407,4421 **** (progn (goto-char p) (if (search-forward "\nsubject: " nil t) ! (funcall ! gnus-unstructured-field-decoder (nnheader-header-value)) "(none)")) ;; From. (progn (goto-char p) (if (search-forward "\nfrom: " nil t) ! (funcall ! gnus-structured-field-decoder (nnheader-header-value)) "(nobody)")) ;; Date. (progn --- 4400,4412 ---- (progn (goto-char p) (if (search-forward "\nsubject: " nil t) ! (mm-decode-words-string (nnheader-header-value)) "(none)")) ;; From. (progn (goto-char p) (if (search-forward "\nfrom: " nil t) ! (mm-decode-words-string (nnheader-header-value)) "(nobody)")) ;; Date. (progn *************** *** 4535,4543 **** number dependencies force-new)))) (push header headers)) (forward-line 1)) ! (error ! (gnus-error 4 "Strange nov line (%d)" ! (count-lines (point-min) (point))))) (forward-line 1)) ;; A common bug in inn is that if you have posted an article and ;; then retrieves the active file, it will answer correctly -- --- 4526,4535 ---- number dependencies force-new)))) (push header headers)) (forward-line 1)) ! ;(error ! ; (gnus-error 4 "Strange nov line (%d)" ! ; (count-lines (point-min) (point)))) ! ) (forward-line 1)) ;; A common bug in inn is that if you have posted an article and ;; then retrieves the active file, it will answer correctly -- *************** *** 6513,6519 **** (gnus-summary-remove-process-mark article) (when (gnus-summary-display-article article) (save-excursion ! (nnheader-temp-write nil (insert-buffer-substring gnus-original-article-buffer) ;; Remove some headers that may lead nndoc to make ;; the wrong guess. --- 6505,6511 ---- (gnus-summary-remove-process-mark article) (when (gnus-summary-display-article article) (save-excursion ! (with-temp-buffer (insert-buffer-substring gnus-original-article-buffer) ;; Remove some headers that may lead nndoc to make ;; the wrong guess. *************** *** 7318,7324 **** (interactive) ;; Replace the article. (let ((buf (current-buffer))) ! (nnheader-temp-write nil (insert-buffer buf) (if (and (not read-only) (not (gnus-request-replace-article --- 7310,7316 ---- (interactive) ;; Replace the article. (let ((buf (current-buffer))) ! (with-temp-buffer (insert-buffer buf) (if (and (not read-only) (not (gnus-request-replace-article *************** *** 7336,7342 **** (message-narrow-to-head) (let ((head (buffer-string)) header) ! (nnheader-temp-write nil (insert (format "211 %d Article retrieved.\n" (cdr gnus-article-current))) (insert head) --- 7328,7334 ---- (message-narrow-to-head) (let ((head (buffer-string)) header) ! (with-temp-buffer (insert (format "211 %d Article retrieved.\n" (cdr gnus-article-current))) (insert head) *************** *** 8150,8156 **** (gnus-summary-select-article t t nil current-article)) (set-buffer gnus-original-article-buffer) (let ((buf (format "%s" (buffer-string)))) ! (nnheader-temp-write nil (insert buf) (goto-char (point-min)) (if (re-search-forward "^References: " nil t) --- 8142,8148 ---- (gnus-summary-select-article t t nil current-article)) (set-buffer gnus-original-article-buffer) (let ((buf (format "%s" (buffer-string)))) ! (with-temp-buffer (insert buf) (goto-char (point-min)) (if (re-search-forward "^References: " nil t) *** pub/pgnus/lisp/gnus-util.el Sat Aug 29 19:53:59 1998 --- pgnus/lisp/gnus-util.el Sat Aug 29 22:25:17 1998 *************** *** 106,130 **** (when (gnus-buffer-exists-p buf) (kill-buffer buf)))) ! (if (fboundp 'point-at-bol) ! (fset 'gnus-point-at-bol 'point-at-bol) (defun gnus-point-at-bol () "Return point at the beginning of the line." (let ((p (point))) (beginning-of-line) (prog1 (point) ! (goto-char p))))) ! (if (fboundp 'point-at-eol) ! (fset 'gnus-point-at-eol 'point-at-eol) (defun gnus-point-at-eol () "Return point at the end of the line." (let ((p (point))) (end-of-line) (prog1 (point) ! (goto-char p))))) (defun gnus-delete-first (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." --- 106,138 ---- (when (gnus-buffer-exists-p buf) (kill-buffer buf)))) ! (cond ! ((fboundp 'point-at-bol) ! (fset 'gnus-point-at-bol 'point-at-bol)) ! ((fboundp 'line-beginning-position) ! (fset 'gnus-point-at-bol 'line-beginning-position)) ! (t (defun gnus-point-at-bol () "Return point at the beginning of the line." (let ((p (point))) (beginning-of-line) (prog1 (point) ! (goto-char p)))))) ! (cond ! ((fboundp 'point-at-eol) ! (fset 'gnus-point-at-eol 'point-at-eol)) ! ((fboundp 'line-end-position) ! (fset 'gnus-point-at-eol 'line-end-position)) ! (t (defun gnus-point-at-eol () "Return point at the end of the line." (let ((p (point))) (end-of-line) (prog1 (point) ! (goto-char p)))))) (defun gnus-delete-first (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." *** pub/pgnus/lisp/gnus-xmas.el Sat Aug 29 19:54:00 1998 --- pgnus/lisp/gnus-xmas.el Sat Aug 29 22:25:17 1998 *************** *** 52,62 **** (grape "#b264cc" "#cf7df") (labia "#cc64c2" "#fd7dff") (berry "#cc6485" "#ff7db5") (neutral "#b4b4b4" "#878787") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") ! (defcustom gnus-xmas-logo-color-style 'moss "*Color styles used for the Gnus logo." :type '(choice (const flame) (const pine) (const moss) (const irish) (const sky) (const tin) --- 52,63 ---- (grape "#b264cc" "#cf7df") (labia "#cc64c2" "#fd7dff") (berry "#cc6485" "#ff7db5") + (dino "#cc6485" "#ff7db5") (neutral "#b4b4b4" "#878787") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") ! (defcustom gnus-xmas-logo-color-style 'dino "*Color styles used for the Gnus logo." :type '(choice (const flame) (const pine) (const moss) (const irish) (const sky) (const tin) *** pub/pgnus/lisp/gnus.el Sat Aug 29 20:35:02 1998 --- pgnus/lisp/gnus.el Sat Aug 29 22:25:17 1998 *************** *** 250,256 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.3" "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.4" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) *************** *** 637,649 **** (defface gnus-splash-face '((((class color) (background dark)) ! (:foreground "ForestGreen")) (((class color) (background light)) ! (:foreground "ForestGreen")) (t ())) ! "Level 1 newsgroup face.") (defun gnus-splash () (save-excursion --- 637,649 ---- (defface gnus-splash-face '((((class color) (background dark)) ! (:foreground "Brown")) (((class color) (background light)) ! (:foreground "Brown")) (t ())) ! "Face of the splash screen.") (defun gnus-splash () (save-excursion *************** *** 1569,1576 **** (cdr package))))) '(("metamail" metamail-buffer) ("info" Info-goto-node) - ("hexl" hexl-hex-string-to-integer) ("pp" pp pp-to-string pp-eval-expression) ("ps-print" ps-print-preprint) ("mail-extr" mail-extract-address-components) ("browse-url" browse-url) --- 1569,1577 ---- (cdr package))))) '(("metamail" metamail-buffer) ("info" Info-goto-node) ("pp" pp pp-to-string pp-eval-expression) + ("qp" quoted-printable-decode-region quoted-printable-decode-string) + ("mm-decode" mm-decode-words-region mm-decode-words-string) ("ps-print" ps-print-preprint) ("mail-extr" mail-extract-address-components) ("browse-url" browse-url) *** pub/pgnus/lisp/lpath.el Sat Aug 29 19:54:13 1998 --- pgnus/lisp/lpath.el Sat Aug 29 22:25:17 1998 *************** *** 29,45 **** make-char-table set-char-table-range font-create-object x-color-values widget-make-intangible error-message-string w3-form-encode-xwfu gnus-mule-get-coding-system ! decode-coding-string mail-aliases-setup)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table font-lock-defaults user-full-name user-login-name gnus-newsgroup-name gnus-article-x-face-too-ugly mail-mode-hook enable-multibyte-characters ! adaptive-fill-first-line-regexp adaptive-fill-regexp))) (maybe-bind '(mail-mode-hook enable-multibyte-characters browse-url-browser-function ! adaptive-fill-first-line-regexp adaptive-fill-regexp)) (maybe-fbind '(color-instance-rgb-components make-color-instance color-instance-name specifier-instance device-type device-class get-popup-menu-response event-object --- 29,48 ---- make-char-table set-char-table-range font-create-object x-color-values widget-make-intangible error-message-string w3-form-encode-xwfu gnus-mule-get-coding-system ! decode-coding-string mail-aliases-setup ! mm-copy-tree url-view-url w3-prepare-buffer)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table font-lock-defaults user-full-name user-login-name gnus-newsgroup-name gnus-article-x-face-too-ugly mail-mode-hook enable-multibyte-characters ! adaptive-fill-first-line-regexp adaptive-fill-regexp ! url-current-mime-headers))) (maybe-bind '(mail-mode-hook enable-multibyte-characters browse-url-browser-function ! adaptive-fill-first-line-regexp adaptive-fill-regexp ! url-current-mime-headers)) (maybe-fbind '(color-instance-rgb-components make-color-instance color-instance-name specifier-instance device-type device-class get-popup-menu-response event-object *************** *** 53,59 **** device-on-window-system-p make-gui-button Info-goto-node pp-to-string color-name gnus-mule-get-coding-system decode-coding-string ! mail-aliases-setup))) (setq load-path (cons "." load-path)) (require 'custom) --- 56,64 ---- device-on-window-system-p make-gui-button Info-goto-node pp-to-string color-name gnus-mule-get-coding-system decode-coding-string ! mail-aliases-setup ! mm-copy-tree url-view-url w3-prepare-buffer ! char-int mule-write-region-no-coding-system))) (setq load-path (cons "." load-path)) (require 'custom) *** pub/pgnus/lisp/message.el Sat Aug 29 19:54:00 1998 --- pgnus/lisp/message.el Sat Aug 29 22:25:18 1998 *************** *** 1011,1017 **** (when (and (file-exists-p file) (file-readable-p file) (file-regular-p file)) ! (nnheader-temp-write nil (nnheader-insert-file-contents file) (goto-char (point-min)) (looking-at message-unix-mail-delimiter)))) --- 1011,1017 ---- (when (and (file-exists-p file) (file-readable-p file) (file-regular-p file)) ! (with-temp-buffer (nnheader-insert-file-contents file) (goto-char (point-min)) (looking-at message-unix-mail-delimiter)))) *************** *** 1111,1117 **** (goto-char (point-min))) (defun message-narrow-to-head () ! "Narrow the buffer to the head of the message." (widen) (narrow-to-region (goto-char (point-min)) --- 1111,1118 ---- (goto-char (point-min))) (defun message-narrow-to-head () ! "Narrow the buffer to the head of the message. ! Point is left at the beginning of the narrowed-to region." (widen) (narrow-to-region (goto-char (point-min)) *************** *** 3055,3061 **** (let ((max 988) (cut 4) refs) ! (nnheader-temp-write nil (insert references) (goto-char (point-min)) (while (re-search-forward "<[^>]+>" nil t) --- 3056,3062 ---- (let ((max 988) (cut 4) refs) ! (with-temp-buffer (insert references) (goto-char (point-min)) (while (re-search-forward "<[^>]+>" nil t) *************** *** 3583,3589 **** (defun message-wash-subject (subject) "Remove junk like \"Re:\", \"(fwd)\", etc. that was added to the subject by previous forwarders, replyers, etc." ! (nnheader-temp-write nil (insert-string subject) (goto-char (point-min)) ;; strip Re/Fwd stuff off the beginning --- 3584,3590 ---- (defun message-wash-subject (subject) "Remove junk like \"Re:\", \"(fwd)\", etc. that was added to the subject by previous forwarders, replyers, etc." ! (with-temp-buffer (insert-string subject) (goto-char (point-min)) ;; strip Re/Fwd stuff off the beginning *** pub/pgnus/lisp/mm-decode.el Sat Aug 29 22:25:23 1998 --- pgnus/lisp/mm-decode.el Sat Aug 29 22:25:18 1998 *************** *** 0 **** --- 1,128 ---- + ;;; mm-decode.el --- Function for decoding MIME things + ;; Copyright (C) 1998 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; This file is not yet 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: + + (require 'base64) + (require 'qp) + (require 'nnheader) + + (defvar mm-charset-regexp (concat "[^" "][\000-\040()<>@,\;:\\\"/?.=" "]+")) + + (defvar mm-encoded-word-regexp + (concat "=\\?\\(" mm-charset-regexp "\\)\\?\\(B\\|Q\\)\\?" + "\\([!->@-~]+\\)\\?=")) + + (defun mm-decode-words-region (start end) + "Decode MIME-encoded words in region between START and END." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + ;; Remove whitespace between encoded words. + (while (re-search-forward + (concat "\\(" mm-encoded-word-regexp "\\)" + "\\(\n?[ \t]\\)+" + "\\(" mm-encoded-word-regexp "\\)") + nil t) + (delete-region (goto-char (match-end 1)) (match-beginning 6))) + ;; Decode the encoded words. + (goto-char (point-min)) + (while (re-search-forward mm-encoded-word-regexp nil t) + (insert (mm-decode-word + (prog1 + (match-string 0) + (delete-region (match-beginning 0) (match-end 0))))))))) + + (defun mm-decode-words-string (string) + "Decode the quoted-printable-encoded STRING and return the results." + (with-temp-buffer + (insert string) + (inline + (mm-decode-words-region (point-min) (point-max))) + (buffer-string))) + + (defun mm-decode-word (word) + "Decode WORD and return it if it is an encoded word. + Return WORD if not." + (if (not (string-match mm-encoded-word-regexp word)) + word + (or + (condition-case nil + (mm-decode-text + (match-string 1 word) + (upcase (match-string 2 word)) + (match-string 3 word)) + (error word)) + word))) + + (defun mm-decode-text (charset encoding string) + "Decode STRING as an encoded text. + Valid ENCODINGs are \"B\" and \"Q\". + If your Emacs implementation can't decode CHARSET, it returns nil." + (let ((cs (mm-charset-to-coding-system charset))) + (when cs + (decode-coding-string + (cond + ((equal "B" encoding) + (base64-decode string)) + ((equal "Q" encoding) + (quoted-printable-decode-string + (nnheader-replace-chars-in-string string ?_ ? ))) + (t (error "Invalid encoding: %s" encoding))) + cs)))) + + (defvar mm-charset-coding-system-alist + (let ((rest + '((us-ascii . iso-8859-1) + (gb2312 . cn-gb-2312) + (iso-2022-jp-2 . iso-2022-7bit-ss2) + (x-ctext . ctext))) + dest) + (while rest + (let ((pair (car rest))) + (unless (coding-system-p (car pair)) + (setq dest (cons pair dest)))) + (setq rest (cdr rest))) + dest) + "Charset/coding system alist.") + + (defun mm-charset-to-coding-system (charset &optional lbt) + "Return coding-system corresponding to CHARSET. + CHARSET is a symbol naming a MIME charset. + If optional argument LBT (`unix', `dos' or `mac') is specified, it is + used as the line break code type of the coding system." + (when (stringp charset) + (setq charset (intern (downcase charset)))) + (setq charset + (or (cdr (assq charset mm-charset-coding-system-alist)) + charset)) + (when lbt + (setq charset (intern (format "%s-%s" charset lbt)))) + (when (memq charset (coding-system-list)) + charset)) + + (provide 'mm-decode) + + ;; qp.el ends here *** pub/pgnus/lisp/mm.el Sat Aug 29 22:25:24 1998 --- pgnus/lisp/mm.el Sat Aug 29 22:25:18 1998 *************** *** 0 **** --- 1,1283 ---- + ;;; mm.el,v --- Mailcap parsing routines, and MIME handling + ;; Author: wmperry + ;; Created: 1996/05/28 02:46:51 + ;; Version: 1.96 + ;; Keywords: mail, news, hypermedia + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Copyright (c) 1994, 1995, 1996 by William M. Perry + ;;; Copyright (c) 1996 - 1998 Free Software Foundation, Inc. + ;;; + ;;; This file is not part of GNU Emacs, but the same permissions apply. + ;;; + ;;; 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. + ;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Generalized mailcap parsing and access routines + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; + ;;; Data structures + ;;; --------------- + ;;; 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. + ;;; + ;;; The main interface to this code is: + ;;; + ;;; To set everything up: + ;;; + ;;; (mm-parse-mailcaps [path]) + ;;; + ;;; Where PATH is a unix-style path specification (: separated list + ;;; of strings). If PATH is nil, the environment variable MAILCAPS + ;;; will be consulted. If there is no environment variable, then a + ;;; default list of paths is used. + ;;; + ;;; To retrieve the information: + ;;; (mm-mime-info st [nd] [request]) + ;;; + ;;; Where st and nd are positions in a buffer that contain the + ;;; content-type header information of a mail/news/whatever message. + ;;; st can optionally be a string that contains the content-type + ;;; information. + ;;; + ;;; Third 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. + ;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Variables, etc + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (eval-and-compile + (require 'cl) + ;LMI was here + ;;(require 'devices) + ) + + (defconst mm-version (let ((x "1.96")) + (if (string-match "Revision: \\([^ \t\n]+\\)" x) + (substring x (match-beginning 1) (match-end 1)) + x)) + "Version # of MM package") + + (defvar mm-parse-args-syntax-table + (copy-syntax-table emacs-lisp-mode-syntax-table) + "A syntax table for parsing sgml attributes.") + + (modify-syntax-entry ?' "\"" mm-parse-args-syntax-table) + (modify-syntax-entry ?` "\"" mm-parse-args-syntax-table) + (modify-syntax-entry ?{ "(" mm-parse-args-syntax-table) + (modify-syntax-entry ?} ")" mm-parse-args-syntax-table) + + (defvar mm-mime-data + '( + ("multipart" . ( + ("alternative". (("viewer" . mm-multipart-viewer) + ("type" . "multipart/alternative"))) + ("mixed" . (("viewer" . mm-multipart-viewer) + ("type" . "multipart/mixed"))) + (".*" . (("viewer" . mm-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" . mm-save-binary-file) + ("type" ."application/octet-stream"))) + ("dvi" . (("viewer" . "open %s") + ("type" . "application/dvi") + ("test" . (eq (device-type) 'ns)))) + ("dvi" . (("viewer" . "xdvi %s") + ("test" . (eq (device-type) 'x)) + ("needsx11") + ("type" . "application/dvi"))) + ("dvi" . (("viewer" . "dvitty %s") + ("test" . (not (getenv "DISPLAY"))) + ("type" . "application/dvi"))) + ("emacs-lisp" . (("viewer" . mm-maybe-eval) + ("type" . "application/emacs-lisp"))) + ; ("x-tar" . (("viewer" . tar-mode) + ; ("test" . (fboundp 'tar-mode)) + ; ("type" . "application/x-tar"))) + ("x-tar" . (("viewer" . mm-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" . mm-save-binary-file) + ("type" . "application/zip") + ("copiousoutput"))) + ("pdf" . (("viewer" . "acroread %s") + ("type" . "application/pdf"))) + ("postscript" . (("viewer" . "open %s") + ("type" . "application/postscript") + ("test" . (eq (device-type) 'ns)))) + ("postscript" . (("viewer" . "ghostview %s") + ("type" . "application/postscript") + ("test" . (eq (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" . mm-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 (device-type) 'x)) + ("needsx11"))) + ("x11-dump" . (("viewer" . "xwud -in %s") + ("type" . "image/x-xwd") + ("compose" . "xwd -frame > %s") + ("test" . (eq (device-type) 'x)) + ("needsx11"))) + ("windowdump" . (("viewer" . "xwud -in %s") + ("type" . "image/x-xwd") + ("compose" . "xwd -frame > %s") + ("test" . (eq (device-type) 'x)) + ("needsx11"))) + (".*" . (("viewer" . "open %s") + ("type" . "image/*") + ("test" . (eq (device-type) 'ns)))) + (".*" . (("viewer" . "xv -perfect %s") + ("type" . "image/*") + ("test" . (eq (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 (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 mm-content-transfer-encodings + '(("base64" . base64-decode-region) + ("7bit" . ignore) + ("8bit" . ignore) + ("binary" . ignore) + ("x-compress" . ("uncompress" "-c")) + ("x-gzip" . ("gzip" "-dc")) + ("compress" . ("uncompress" "-c")) + ("gzip" . ("gzip" "-dc")) + ("x-hqx" . ("mcvert" "-P" "-s" "-S")) + ("quoted-printable" . mm-decode-quoted-printable) + ) + "*An assoc list of content-transfer-encodings and how to decode them.") + + (defvar mm-download-directory nil + "*Where downloaded files should go by default.") + + (defvar mm-temporary-directory (or (getenv "TMPDIR") "/tmp") + "*Where temporary files go.") + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; A few things from w3 and url, just in case this is used without them + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defun mm-generate-unique-filename (&optional fmt) + "Generate a unique filename in mm-temporary-directory" + (if (not fmt) + (let ((base (format "mm-tmp.%d" (user-real-uid))) + (fname "") + (x 0)) + (setq fname (format "%s%d" base x)) + (while (file-exists-p + (expand-file-name fname mm-temporary-directory)) + (setq x (1+ x) + fname (concat base (int-to-string x)))) + (expand-file-name fname mm-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 mm-temporary-directory)) + (setq x (1+ x) + fname (format fmt (concat base (int-to-string x))))) + (expand-file-name fname mm-temporary-directory)))) + + (if (and (fboundp 'copy-tree) + (subrp (symbol-function 'copy-tree))) + (fset 'mm-copy-tree 'copy-tree) + (defun mm-copy-tree (tree) + (if (consp tree) + (cons (mm-copy-tree (car tree)) + (mm-copy-tree (cdr tree))) + (if (vectorp tree) + (let* ((new (copy-sequence tree)) + (i (1- (length new)))) + (while (>= i 0) + (aset new i (mm-copy-tree (aref new i))) + (setq i (1- i))) + new) + tree)))) + + ;LMI was here + ;(require 'mule-sysdp) + + (if (not (fboundp 'w3-save-binary-file)) + (defun mm-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 mm-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)))) + (fset 'mm-save-binary-file 'w3-save-binary-file)) + + (defun mm-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 mm-viewer-unescape (format &optional filename url) + (save-excursion + (set-buffer (get-buffer-create " *mm-parse*")) + (erase-buffer) + (insert format) + (goto-char (point-min)) + (while (re-search-forward "%\\(.\\)" nil t) + (let ((escape (aref (match-string 1) 0))) + (replace-match "" t t) + (case escape + (?% (insert "%")) + (?s (insert (or filename "\"\""))) + (?u (insert (or url "\"\"")))))) + (buffer-string))) + + (defun mm-in-assoc (elt list) + ;; Check to see if ELT matches any of the regexps in the car elements of LIST + (let (rslt) + (while (and list (not rslt)) + (and (car (car list)) + (string-match (car (car list)) elt) + (setq rslt (car list))) + (setq list (cdr list))) + rslt)) + + (defun mm-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))) + + (defun mm-parse-mailcaps (&optional path) + ;; Parse out all the mailcaps specified in a unix-style path string PATH + (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 + (mm-string-to-tokens 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)) + (mm-parse-mailcap (car fnames))) + (setq fnames (cdr fnames))))) + + (defun mm-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 + ) + (save-excursion + (set-buffer (get-buffer-create " *mailcap*")) + (erase-buffer) + (insert-file-contents fname) + (set-syntax-table mm-parse-args-syntax-table) + (mm-replace-regexp "#.*" "") ; Remove all comments + (mm-replace-regexp "\n+" "\n") ; And blank lines + (mm-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces + (mm-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)))) + (mm-parse-mailcap-extras save-pos (point)))) + (mm-mailcap-entry-passes-test info) + (mm-add-mailcap-entry major minor info))))) + + (defun mm-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 mm-string-to-tokens (str &optional delim) + "Return a list of words from the string STR" + (setq delim (or delim ? )) + (let (results y) + (mapcar + (function + (lambda (x) + (cond + ((and (= x delim) y) (setq results (cons y results) y nil)) + ((/= x delim) (setq y (concat y (char-to-string x)))) + (t nil)))) str) + (nreverse (cons y results)))) + + (defun mm-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 (mm-string-to-tokens (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)))) + + (defun mm-parse-args (st &optional nd nodowncase) + ;; Return an assoc list of attribute/value pairs from an RFC822-type string + (let ( + name ; From name= + value ; its value + results ; Assoc list of results + name-pos ; Start of XXXX= position + val-pos ; Start of value position + ) + (save-excursion + (if (stringp st) + (progn + (set-buffer (get-buffer-create " *mm-temp*")) + (set-syntax-table mm-parse-args-syntax-table) + (erase-buffer) + (insert st) + (setq st (point-min) + nd (point-max))) + (set-syntax-table mm-parse-args-syntax-table)) + (save-restriction + (narrow-to-region st nd) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward "; \n\t") + (setq name-pos (point)) + (skip-chars-forward "^ \n\t=;") + (if (not nodowncase) + (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) + value + (cond + ((or (= (or (char-after val-pos) 0) ?\") + (= (or (char-after val-pos) 0) ?')) + (buffer-substring (1+ val-pos) + (condition-case () + (prog2 + (forward-sexp 1) + (1- (point)) + (skip-chars-forward "\"")) + (error + (skip-chars-forward "^ \t\n") + (point))))) + (t + (buffer-substring val-pos + (progn + (skip-chars-forward "^;") + (skip-chars-backward " \t") + (point))))))) + (setq results (cons (cons name value) results)) + (skip-chars-forward "; \n\t")) + results)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; The action routines. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun mm-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 mm-unescape-mime-test (test type-info) + (let ((buff (get-buffer-create " *unescape*")) + 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 " ")))) + (save-excursion + (set-buffer buff) + (erase-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 mm-unescape-mime-test. %s" test))))) + + (defun mm-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)) + (viewer (cdr (assoc "viewer" viewer-info))) + (default-directory (expand-file-name "~/")) + status + parsed-test + ) + (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 (mm-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))))) + + (defun mm-add-mailcap-entry (major minor info) + (let ((old-major (assoc major mm-mime-data))) + (if (null old-major) ; New major area + (setq mm-mime-data + (cons (cons major (list (cons minor info))) + mm-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 mm-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 mm-mime-info (st &optional nd 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 + + Third 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 mm-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 + ) + (save-excursion + (cond + ((null st) + (set-buffer (get-buffer-create " *mimeparse*")) + (erase-buffer) + (insert "text/plain") + (setq st (point-min))) + ((stringp st) + (set-buffer (get-buffer-create " *mimeparse*")) + (erase-buffer) + (insert st) + (setq st (point-min))) + ((null nd) + (narrow-to-region st (progn (goto-char st) (end-of-line) (point)))) + (t (narrow-to-region st nd))) + (goto-char st) + (skip-chars-forward ": \t\n") + (buffer-enable-undo) + (setq viewer + (catch 'mm-exit + (setq save-pos (point)) + (skip-chars-forward "^/") + (downcase-region save-pos (point)) + (setq major (buffer-substring save-pos (point))) + (if (not (setq major-info (cdr (assoc major mm-mime-data)))) + (throw 'mm-exit nil)) + (skip-chars-forward "/ \t\n") + (setq save-pos (point)) + (skip-chars-forward "^ \t\n;") + (downcase-region save-pos (point)) + (setq minor (buffer-substring save-pos (point))) + (if (not + (setq viewers (mm-possible-viewers major-info minor))) + (throw 'mm-exit nil)) + (skip-chars-forward "; \t") + (if (eolp) + nil ; No qualifiers + (setq save-pos (point)) + (end-of-line) + (setq info (mm-parse-args save-pos (point))) + ) + (while viewers + (if (mm-viewer-passes-test (car viewers) info) + (setq passed (cons (car viewers) passed))) + (setq viewers (cdr viewers))) + (setq passed (sort (nreverse passed) 'mm-viewer-lessp)) + (car passed))) + (if (and (stringp (cdr (assoc "viewer" viewer))) + passed) + (setq viewer (car passed))) + (widen) + (cond + ((and (null viewer) (not (equal major "default"))) + (mm-mime-info "default" nil request)) + ((or (null request) (equal request "")) + (mm-unescape-mime-test (cdr (assoc "viewer" viewer)) info)) + ((stringp request) + (if (or (string= request "test") (string= request "viewer")) + (mm-unescape-mime-test (cdr-safe (assoc request viewer)) info))) + (t + ;; MUST make a copy *sigh*, else we modify mm-mime-data + (setq viewer (mm-copy-tree viewer)) + (let ((view (assoc "viewer" viewer)) + (test (assoc "test" viewer))) + (if view (setcdr view (mm-unescape-mime-test (cdr view) info))) + (if test (setcdr test (mm-unescape-mime-test (cdr test) info)))) + viewer))))) + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Experimental MIME-types parsing + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defvar mm-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") + (".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 mm-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 + (mm-string-to-tokens 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)) + (mm-parse-mimetype-file (car fnames))) + (setq fnames (cdr fnames))))) + + (defun mm-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 + ) + (save-excursion + (set-buffer (get-buffer-create " *mime-types*")) + (erase-buffer) + (insert-file-contents fname) + (mm-replace-regexp "#.*" "") + (mm-replace-regexp "\n+" "\n") + (mm-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 mm-mime-extensions + (cons + (cons (if (= (string-to-char (car extns)) ?.) + (car extns) + (concat "." (car extns))) type) mm-mime-extensions) + extns (cdr extns))))))) + + (defun mm-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) mm-mime-extensions))) + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Editing/Composition of body parts + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun mm-compose-type (type) + ;; Compose a body section of MIME-type TYPE. + (let* ((info (mm-mime-info type nil 5)) + (fnam (mm-generate-unique-filename)) + (comp (or (cdr (assoc "compose" info)))) + (ctyp (cdr (assoc "composetyped" info))) + (buff (get-buffer-create " *mimecompose*")) + (typeit (not ctyp)) + (retval "") + (usef nil)) + (setq comp (mm-unescape-mime-test (or comp ctyp) info)) + (while (string-match "\\([^\\\\]\\)%s" comp) + (setq comp (concat (substring comp 0 (match-end 1)) fnam + (substring comp (match-end 0) nil)) + usef t)) + (call-process shell-file-name nil + (if usef nil buff) + nil shell-command-switch comp) + (setq retval + (concat + (if typeit (concat "Content-type: " type "\r\n\r\n") "") + (if usef + (save-excursion + (set-buffer buff) + (erase-buffer) + (insert-file-contents fnam) + (buffer-string)) + (save-excursion + (set-buffer buff) + (buffer-string))) + "\r\n")) + retval)) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Misc. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun mm-type-to-file (type) + "Return the file extension for content-type TYPE" + (rassoc type mm-mime-extensions)) + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Miscellaneous MIME viewers written in elisp + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun mm-play-sound-file (&optional buff) + "Play a sound file in buffer BUFF (defaults to current buffer)" + (setq buff (or buff (current-buffer))) + (let ((fname (mm-generate-unique-filename "%s.au")) + (synchronous-sounds t)) ; Play synchronously + (mule-write-region-no-coding-system (point-min) (point-max) fname) + (kill-buffer (current-buffer)) + (play-sound-file fname) + (condition-case () + (delete-file fname) + (error nil)))) + + (defun mm-parse-mime-headers (&optional no-delete) + "Return a list of the MIME headers at the top of this buffer. If + optional argument NO-DELETE is non-nil, don't delete the headers." + (let* ((st (point-min)) + (nd (progn + (goto-char (point-min)) + (skip-chars-forward " \t\n") + (if (re-search-forward "^\r*$" nil t) + (1+ (point)) + (point-max)))) + save-pos + status + hname + hvalu + result + search + ) + (narrow-to-region st (min nd (point-max))) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n\r") + (setq save-pos (point)) + (skip-chars-forward "^:\n\r") + (downcase-region save-pos (point)) + (setq hname (buffer-substring save-pos (point))) + (skip-chars-forward ": \t ") + (setq save-pos (point)) + (skip-chars-forward "^\n\r") + (setq search t) + (while search + (skip-chars-forward "^\n\r") + (save-excursion + (skip-chars-forward "\n\r") + + (setq search + (string-match "[ \t]" + (char-to-string + (or (char-after (point)) ?a))))) + (if search + (skip-chars-forward "\n\r"))) + (setq hvalu (buffer-substring save-pos (point)) + result (cons (cons hname hvalu) result))) + (or no-delete (delete-region st nd)) + result)) + + (defun mm-find-available-multiparts (separator &optional buf) + "Return a list of mime-headers for the various body parts of a + multipart message in buffer BUF with separator SEPARATOR. + The different multipart specs are put in `mm-temporary-directory'." + (let ((sep (concat "^--" separator "\r*$")) + headers + fname + results) + (save-excursion + (and buf (set-buffer buf)) + (goto-char (point-min)) + (while (re-search-forward sep nil t) + (let ((st (set-marker (make-marker) + (progn + (forward-line 1) + (beginning-of-line) + (point)))) + (nd (set-marker (make-marker) + (if (re-search-forward sep nil t) + (1- (match-beginning 0)) + (point-max))))) + (narrow-to-region st nd) + (goto-char st) + (if (looking-at "^\r*$") + (insert "Content-type: text/plain\n" + "Content-length: " (int-to-string (- nd st)) "\n")) + (setq headers (mm-parse-mime-headers) + fname (mm-generate-unique-filename)) + (let ((x (or (cdr (assoc "content-type" headers)) "text/plain"))) + (if (string-match "name=\"*\\([^ \"]+\\)\"*" x) + (setq fname (expand-file-name + (substring x (match-beginning 1) + (match-end 1)) + mm-temporary-directory)))) + (widen) + (if (assoc "content-transfer-encoding" headers) + (let ((coding (cdr + (assoc "content-transfer-encoding" headers))) + (cmd nil)) + (setq coding (and coding (downcase coding)) + cmd (or (cdr (assoc coding + mm-content-transfer-encodings)) + (read-string + (concat "How shall I decode " coding "? ") + "cat"))) + (if (string= cmd "") (setq cmd "cat")) + (if (stringp cmd) + (shell-command-on-region st nd cmd t) + (funcall cmd st nd)) + (or (eq cmd 'ignore) (set-marker nd (point))))) + (write-region st nd fname nil 5) + (delete-region st nd) + (setq results (cons + (cons + (cons "mm-filename" fname) headers) results))))) + results)) + + (defun mm-format-multipart-as-html (&optional buf type) + (if buf (set-buffer buf)) + (let* ((boundary (if (string-match + "boundary[ \t]*=[ \t\"]*\\([^ \"\t\n]+\\)" + type) + (regexp-quote + (substring type (match-beginning 1) (match-end 1))))) + (parts (mm-find-available-multiparts boundary))) + (erase-buffer) + (insert "\n" + " \n" + " Multipart Message\n" + " \n" + " \n" + "

Multipart message encountered

\n" + "

I have encountered a multipart MIME message.\n" + " The following parts have been detected. Please\n" + " select which one you want to view.\n" + "

\n" + " \n" + " \n" + "\n" + "\n"))) + + (defun mm-multipart-viewer () + (mm-format-multipart-as-html + (current-buffer) + (cdr (assoc "content-type" url-current-mime-headers))) + (let ((w3-working-buffer (current-buffer))) + (w3-prepare-buffer))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Transfer encodings we can decrypt automatically + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun mm-decode-quoted-printable (&optional st nd) + (interactive) + (setq st (or st (point-min)) + nd (or nd (point-max))) + (save-restriction + (narrow-to-region st nd) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (while (re-search-forward "=[0-9A-F][0-9A-F]" nil t) + (replace-match + (char-to-string + (+ + (* 16 (mm-hex-char-to-integer + (char-after (1+ (match-beginning 0))))) + (mm-hex-char-to-integer + (char-after (1- (match-end 0)))))))))) + (goto-char (point-max)))) + + ;; Taken from hexl.el. + (defun mm-hex-char-to-integer (character) + "Take a char and return its value as if it was a hex digit." + (if (and (>= character ?0) (<= character ?9)) + (- character ?0) + (let ((ch (logior character 32))) + (if (and (>= ch ?a) (<= ch ?f)) + (- ch (- ?a 10)) + (error (format "Invalid hex digit `%c'." ch)))))) + + + + (require 'base64) + (provide 'mm) *** pub/pgnus/lisp/nndraft.el Sat Aug 29 19:54:01 1998 --- pgnus/lisp/nndraft.el Sat Aug 29 22:25:18 1998 *************** *** 156,162 **** (let ((gnus-verbose-backends nil) (buf (current-buffer)) article file) ! (nnheader-temp-write nil (insert-buffer buf) (setq article (nndraft-request-accept-article group (nnoo-current-server 'nndraft) t 'noinsert)) --- 156,162 ---- (let ((gnus-verbose-backends nil) (buf (current-buffer)) article file) ! (with-temp-buffer (insert-buffer buf) (setq article (nndraft-request-accept-article group (nnoo-current-server 'nndraft) t 'noinsert)) *** pub/pgnus/lisp/nneething.el Sat Aug 29 19:53:58 1998 --- pgnus/lisp/nneething.el Sat Aug 29 22:25:18 1998 *************** *** 68,75 **** - (autoload 'gnus-encode-coding-string "gnus-ems") - ;;; Interface functions. (nnoo-define-basics nneething) --- 68,73 ---- *************** *** 243,249 **** (setq files (cdr files))) (when (and touched (not nneething-read-only)) ! (nnheader-temp-write map-file (insert "(setq nneething-map '") (gnus-prin1 nneething-map) (insert ")\n(setq nneething-active '") --- 241,247 ---- (setq files (cdr files))) (when (and touched (not nneething-read-only)) ! (with-temp-file map-file (insert "(setq nneething-map '") (gnus-prin1 nneething-map) (insert ")\n(setq nneething-active '") *** pub/pgnus/lisp/nnfolder.el Sat Aug 29 19:54:01 1998 --- pgnus/lisp/nnfolder.el Sat Aug 29 22:25:18 1998 *************** *** 797,803 **** (defun nnfolder-group-pathname (group) "Make pathname for GROUP." ! (setq group (gnus-encode-coding-string group nnmail-pathname-coding-system)) (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) ;; If this file exists, we use it directly. (if (or nnmail-use-long-file-names --- 797,803 ---- (defun nnfolder-group-pathname (group) "Make pathname for GROUP." ! (setq group (encode-coding-string group nnmail-pathname-coding-system)) (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) ;; If this file exists, we use it directly. (if (or nnmail-use-long-file-names *** pub/pgnus/lisp/nngateway.el Sat Aug 29 19:54:13 1998 --- pgnus/lisp/nngateway.el Sat Aug 29 22:25:18 1998 *************** *** 54,60 **** (nngateway-open-server server)) ;; Rewrite the header. (let ((buf (current-buffer))) ! (nnheader-temp-write nil (insert-buffer-substring buf) (message-narrow-to-head) (funcall nngateway-header-transformation nngateway-address) --- 54,60 ---- (nngateway-open-server server)) ;; Rewrite the header. (let ((buf (current-buffer))) ! (with-temp-buffer (insert-buffer-substring buf) (message-narrow-to-head) (funcall nngateway-header-transformation nngateway-address) *** pub/pgnus/lisp/nnheader.el Sat Aug 29 19:54:01 1998 --- pgnus/lisp/nnheader.el Sat Aug 29 22:25:19 1998 *************** *** 61,68 **** (autoload 'cancel-function-timers "timers") (autoload 'gnus-point-at-eol "gnus-util") (autoload 'gnus-delete-line "gnus-util") ! (autoload 'gnus-buffer-live-p "gnus-util") ! (autoload 'gnus-encode-coding-string "gnus-ems")) ;;; Header access macros. --- 61,67 ---- (autoload 'cancel-function-timers "timers") (autoload 'gnus-point-at-eol "gnus-util") (autoload 'gnus-delete-line "gnus-util") ! (autoload 'gnus-buffer-live-p "gnus-util")) ;;; Header access macros. *************** *** 499,550 **** (erase-buffer)) (current-buffer)) - (defmacro nnheader-temp-write (file &rest forms) - "Create a new buffer, evaluate FORMS there, and write the buffer to FILE. - Return the value of FORMS. - If FILE is nil, just evaluate FORMS and don't save anything. - If FILE is t, return the buffer contents as a string." - (let ((temp-file (make-symbol "temp-file")) - (temp-buffer (make-symbol "temp-buffer")) - (temp-results (make-symbol "temp-results"))) - `(save-excursion - (let* ((,temp-file ,file) - (default-major-mode 'fundamental-mode) - (,temp-buffer - (set-buffer - (get-buffer-create - (generate-new-buffer-name " *nnheader temp*")))) - ,temp-results) - (unwind-protect - (progn - (setq ,temp-results (progn ,@forms)) - (cond - ;; Don't save anything. - ((null ,temp-file) - ,temp-results) - ;; Return the buffer contents. - ((eq ,temp-file t) - (set-buffer ,temp-buffer) - (buffer-string)) - ;; Save a file. - (t - (set-buffer ,temp-buffer) - ;; Make sure the directory where this file is - ;; to be saved exists. - (when (not (file-directory-p - (file-name-directory ,temp-file))) - (make-directory (file-name-directory ,temp-file) t)) - ;; Save the file. - (write-region (point-min) (point-max) - ,temp-file nil 'nomesg) - ,temp-results))) - ;; Kill the buffer. - (when (buffer-name ,temp-buffer) - (kill-buffer ,temp-buffer))))))) - - (put 'nnheader-temp-write 'lisp-indent-function 1) - (put 'nnheader-temp-write 'edebug-form-spec '(form body)) - (defvar jka-compr-compression-info-list) (defvar nnheader-numerical-files (if (boundp 'jka-compr-compression-info-list) --- 498,503 ---- *************** *** 701,707 **** (concat dir group "/") ;; If not, we translate dots into slashes. (concat dir ! (gnus-encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnheader-pathname-coding-system) "/"))) --- 654,660 ---- (concat dir group "/") ;; If not, we translate dots into slashes. (concat dir ! (encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnheader-pathname-coding-system) "/"))) *** pub/pgnus/lisp/nnkiboze.el Sat Aug 29 19:54:01 1998 --- pgnus/lisp/nnkiboze.el Sat Aug 29 22:25:19 1998 *************** *** 136,142 **** ;; Remove NOV lines of articles that are marked as read. (when (and (file-exists-p (nnkiboze-nov-file-name)) nnkiboze-remove-read-articles) ! (nnheader-temp-write (nnkiboze-nov-file-name) (let ((cur (current-buffer))) (nnheader-insert-file-contents (nnkiboze-nov-file-name)) (goto-char (point-min)) --- 136,142 ---- ;; Remove NOV lines of articles that are marked as read. (when (and (file-exists-p (nnkiboze-nov-file-name)) nnkiboze-remove-read-articles) ! (with-temp-file (nnkiboze-nov-file-name) (let ((cur (current-buffer))) (nnheader-insert-file-contents (nnkiboze-nov-file-name)) (goto-char (point-min)) *************** *** 230,236 **** ;; Load the kiboze newsrc file for this group. (when (file-exists-p newsrc-file) (load newsrc-file)) ! (nnheader-temp-write nov-file (when (file-exists-p nov-file) (insert-file-contents nov-file)) (setq nov-buffer (current-buffer)) --- 230,236 ---- ;; Load the kiboze newsrc file for this group. (when (file-exists-p newsrc-file) (load newsrc-file)) ! (with-temp-file nov-file (when (file-exists-p nov-file) (insert-file-contents nov-file)) (setq nov-buffer (current-buffer)) *************** *** 318,324 **** (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) (setq newsrc (cdr newsrc)))) ;; We save the kiboze newsrc for this group. ! (nnheader-temp-write newsrc-file (insert "(setq nnkiboze-newsrc '") (gnus-prin1 nnkiboze-newsrc) (insert ")\n"))) --- 318,324 ---- (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) (setq newsrc (cdr newsrc)))) ;; We save the kiboze newsrc for this group. ! (with-temp-file newsrc-file (insert "(setq nnkiboze-newsrc '") (gnus-prin1 nnkiboze-newsrc) (insert ")\n"))) *** pub/pgnus/lisp/nnmail.el Sat Aug 29 19:54:02 1998 --- pgnus/lisp/nnmail.el Sat Aug 29 22:25:19 1998 *************** *** 35,42 **** (eval-and-compile (autoload 'gnus-error "gnus-util") ! (autoload 'gnus-buffer-live-p "gnus-util") ! (autoload 'gnus-encode-coding-string "gnus-ems")) (defgroup nnmail nil "Reading mail with Gnus." --- 35,41 ---- (eval-and-compile (autoload 'gnus-error "gnus-util") ! (autoload 'gnus-buffer-live-p "gnus-util")) (defgroup nnmail nil "Reading mail with Gnus." *************** *** 514,520 **** (concat dir group "/") ;; If not, we translate dots into slashes. (concat dir ! (gnus-encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnmail-pathname-coding-system) "/"))) --- 513,519 ---- (concat dir group "/") ;; If not, we translate dots into slashes. (concat dir ! (encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnmail-pathname-coding-system) "/"))) *************** *** 705,711 **** "Save GROUP-ASSOC in ACTIVE-FILE." (let ((coding-system-for-write nnmail-active-file-coding-system)) (when file-name ! (nnheader-temp-write file-name (nnmail-generate-active group-assoc))))) (defun nnmail-generate-active (alist) --- 704,710 ---- "Save GROUP-ASSOC in ACTIVE-FILE." (let ((coding-system-for-write nnmail-active-file-coding-system)) (when file-name ! (with-temp-file file-name (nnmail-generate-active group-assoc))))) (defun nnmail-generate-active (alist) *************** *** 1202,1208 **** (insert (format "Xref: %s" (system-name))) (while group-alist (insert (format " %s:%d" ! (gnus-encode-coding-string (caar group-alist) nnmail-pathname-coding-system) (cdar group-alist))) (setq group-alist (cdr group-alist))) --- 1201,1207 ---- (insert (format "Xref: %s" (system-name))) (while group-alist (insert (format " %s:%d" ! (encode-coding-string (caar group-alist) nnmail-pathname-coding-system) (cdar group-alist))) (setq group-alist (cdr group-alist))) *** pub/pgnus/lisp/nnmh.el Sat Aug 29 19:54:02 1998 --- pgnus/lisp/nnmh.el Sat Aug 29 22:25:19 1998 *************** *** 229,236 **** (expand-file-name nnmh-toplev)))) dir) (nnheader-replace-chars-in-string ! (gnus-decode-coding-string (substring dir (match-end 0)) ! nnmail-pathname-coding-system) ?/ ?.)) (apply 'max files) (apply 'min files))))))) --- 229,236 ---- (expand-file-name nnmh-toplev)))) dir) (nnheader-replace-chars-in-string ! (decode-coding-string (substring dir (match-end 0)) ! nnmail-pathname-coding-system) ?/ ?.)) (apply 'max files) (apply 'min files))))))) *************** *** 533,539 **** (setq articles (sort articles (lambda (art1 art2) (> (car art1) (car art2))))) ;; Finally write this list back to the .nnmh-articles file. ! (nnheader-temp-write nnmh-file (insert ";; Gnus article active file for " group "\n\n") (insert "(setq nnmh-newsgroup-articles '") (gnus-prin1 articles) --- 533,539 ---- (setq articles (sort articles (lambda (art1 art2) (> (car art1) (car art2))))) ;; Finally write this list back to the .nnmh-articles file. ! (with-temp-file nnmh-file (insert ";; Gnus article active file for " group "\n\n") (insert "(setq nnmh-newsgroup-articles '") (gnus-prin1 articles) *** pub/pgnus/lisp/nnml.el Sat Aug 29 19:54:02 1998 --- pgnus/lisp/nnml.el Sat Aug 29 22:25:19 1998 *************** *** 469,475 **** ((not (file-exists-p file)) (nnheader-report 'nnml "File %s does not exist" file)) (t ! (nnheader-temp-write file (nnheader-insert-file-contents file) (nnmail-replace-status name value)) t)))) --- 469,475 ---- ((not (file-exists-p file)) (nnheader-report 'nnml "File %s does not exist" file)) (t ! (with-temp-file file (nnheader-insert-file-contents file) (nnmail-replace-status name value)) t)))) *** pub/pgnus/lisp/nnsoup.el Sat Aug 29 19:54:02 1998 --- pgnus/lisp/nnsoup.el Sat Aug 29 22:25:19 1998 *************** *** 376,382 **** (or force nnsoup-group-alist-touched)) (setq nnsoup-group-alist-touched nil) ! (nnheader-temp-write nnsoup-active-file (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist)) (insert "\n") (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix)) --- 376,382 ---- (or force nnsoup-group-alist-touched)) (setq nnsoup-group-alist-touched nil) ! (with-temp-file nnsoup-active-file (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist)) (insert "\n") (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix)) *** pub/pgnus/lisp/nntp.el Sat Aug 29 19:54:02 1998 --- pgnus/lisp/nntp.el Sat Aug 29 22:25:19 1998 *************** *** 796,802 **** The authinfo login name is taken from the user's login name and the password contained in '~/.nntp-authinfo'." (when (file-exists-p "~/.nntp-authinfo") ! (nnheader-temp-write nil (insert-file-contents "~/.nntp-authinfo") (goto-char (point-min)) (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name)) --- 796,802 ---- The authinfo login name is taken from the user's login name and the password contained in '~/.nntp-authinfo'." (when (file-exists-p "~/.nntp-authinfo") ! (with-temp-buffer (insert-file-contents "~/.nntp-authinfo") (goto-char (point-min)) (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name)) *** pub/pgnus/lisp/nnweb.el Sat Aug 29 19:54:05 1998 --- pgnus/lisp/nnweb.el Sat Aug 29 22:25:20 1998 *************** *** 219,225 **** (defun nnweb-read-overview (group) "Read the overview of GROUP and build the map." (when (file-exists-p (nnweb-overview-file group)) ! (nnheader-temp-write nil (nnheader-insert-file-contents (nnweb-overview-file group)) (goto-char (point-min)) (let (header) --- 219,225 ---- (defun nnweb-read-overview (group) "Read the overview of GROUP and build the map." (when (file-exists-p (nnweb-overview-file group)) ! (with-temp-buffer (nnheader-insert-file-contents (nnweb-overview-file group)) (goto-char (point-min)) (let (header) *************** *** 233,239 **** (defun nnweb-write-overview (group) "Write the overview file for GROUP." ! (nnheader-temp-write (nnweb-overview-file group) (let ((articles nnweb-articles)) (while articles (nnheader-insert-nov (cadr (pop articles))))))) --- 233,239 ---- (defun nnweb-write-overview (group) "Write the overview file for GROUP." ! (with-temp-file (nnweb-overview-file group) (let ((articles nnweb-articles)) (while articles (nnheader-insert-nov (cadr (pop articles))))))) *************** *** 254,260 **** (defun nnweb-write-active () "Save the active file." ! (nnheader-temp-write (nnheader-concat nnweb-directory "active") (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer)))) (defun nnweb-read-active () --- 254,260 ---- (defun nnweb-write-active () "Save the active file." ! (with-temp-file (nnheader-concat nnweb-directory "active") (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer)))) (defun nnweb-read-active () *** pub/pgnus/lisp/qp.el Sat Aug 29 22:25:24 1998 --- pgnus/lisp/qp.el Sat Aug 29 22:25:20 1998 *************** *** 0 **** --- 1,90 ---- + ;;; qp.el --- Quoted-printable functions + ;; Copyright (C) 1998 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; 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: + + (defvar quoted-printable-encoding-characters + (mapcar 'identity "0123456789ABCDEF")) + + (defun quoted-printable-decode-region (from to) + "Decode quoted-printable in the region between FROM and TO." + (interactive "r") + (save-excursion + (goto-char from) + (while (search-forward "=" to t) + (cond ((eq (following-char) ?\n) + (delete-char -1) + (delete-char 1)) + ((and + (memq (following-char) quoted-printable-encoding-characters) + (memq (char-after (1+ (point))) + quoted-printable-encoding-characters)) + (subst-char-in-region + (1- (point)) (point) ?= + (string-to-number + (buffer-substring (point) (+ 2 (point))) + 16)) + (delete-char 2)) + ((looking-at "=") + (delete-char 1)) + ((message "Malformed MIME quoted-printable message")))))) + + (defun quoted-printable-decode-string (string) + "Decode the quoted-printable-encoded STRING and return the results." + (with-temp-buffer + (insert string) + (quoted-printable-decode-region (point-min) (point-max)) + (buffer-string))) + + (defun quoted-printable-encode-region (from to) + "QP-encode the region between FROM and TO." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region from to) + (goto-char (point-min)) + (while (re-search-forward "[\000-\007\013\015-\037\200-\237=]" nil t) + (insert + (prog1 + (format "=%x" (char-after (1- (point)))) + (delete-char -1)))) + ;; Fold long lines. + (goto-char (point-min)) + (end-of-line) + (while (> (current-column) 72) + (beginning-of-line) + (forward-char 72) + (search-backward "=" (- (point) 2) t) + (insert "=\n") + (end-of-line))))) + + (defun quoted-printable-encode-string (string) + "QP-encode STRING and return the results." + (with-temp-buffer + (insert string) + (quoted-printable-encode-region (point-min) (point-max)) + (buffer-string))) + + (provide 'qp) + + ;; qp.el ends here *** pub/pgnus/lisp/ChangeLog Sat Aug 29 20:35:02 1998 --- pgnus/lisp/ChangeLog Sat Aug 29 22:25:14 1998 *************** *** 1,3 **** --- 1,37 ---- + Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v0.4 is released. + + 1998-08-29 20:53:29 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-decode-mime-words): New command and + keystroke. + + * qp.el (quoted-printable-decode-region): Don't use hexl. + + * gnus-xmas.el (gnus-xmas-logo-color-style): Changed to dino. + + * gnus-sum.el (gnus-parse-headers-hook): Default to nil. + (gnus-structured-field-decoder): Removed. + (gnus-unstructured-field-decoder): Ditto. + + * mm-decode.el: New file. + + * qp.el: New file. + + * gnus-art.el (article-mime-decode-quoted-printable): Removed. + + * gnus-ems.el (fboundp): Removed gnus-split-string. + + * gnus.el (gnus-splash-face): Doc fix. + + * gnus-ems.el (fboundp): Don't bind mail-file-babyl-p. + + * gnus-art.el (article-mime-decode-quoted-printable): Don't use + hexl. + + * nnheader.el (nnheader-temp-write): Removed. + Sat Aug 29 20:34:17 1998 Lars Magne Ingebrigtsen * gnus.el: Gnus v0.3 is released. *** pub/pgnus/Makefile.in Sat Aug 29 19:55:03 1998 --- pgnus/Makefile.in Sat Aug 29 22:25:20 1998 *************** *** 5,11 **** @SET_MAKE@ EMACS = @EMACS@ ! XEMACS = xemacs all: lick info --- 5,11 ---- @SET_MAKE@ EMACS = @EMACS@ ! XEMACS = xemacs21 all: lick info *************** *** 35,41 **** rm lisp/*.elc x: ! make EMACS=xemacs distclean: make clean --- 35,41 ---- rm lisp/*.elc x: ! make EMACS=xemacs21 distclean: make clean *************** *** 44,50 **** rm -f config.log config.status Makefile osome: ! make EMACS=emacs-19.34 some config.status: $(srcdir)/configure $(SHELL) ./config.status --recheck --- 44,50 ---- rm -f config.log config.status Makefile osome: ! make EMACS=xemacs21 some config.status: $(srcdir)/configure $(SHELL) ./config.status --recheck *** pub/pgnus/texi/gnus.texi Sat Aug 29 20:35:03 1998 --- pgnus/texi/gnus.texi Sat Aug 29 22:25:21 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.3 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.4 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 318,324 **** @tex @titlepage ! @title Pterodactyl Gnus 0.3 Manual @author by Lars Magne Ingebrigtsen @page --- 318,324 ---- @tex @titlepage ! @title Pterodactyl Gnus 0.4 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.3. @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.4. @end ifinfo *** pub/pgnus/texi/message.texi Sat Aug 29 20:35:03 1998 --- pgnus/texi/message.texi Sat Aug 29 22:25:21 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.3 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.4 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Pterodactyl Message 0.3 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Pterodactyl Message 0.4 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.3. Message is distributed with the Gnus distribution bearing the same version number as this manual has. --- 83,89 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.4. Message is distributed with the Gnus distribution bearing the same version number as this manual has.