From: yamaoka Date: Mon, 14 Sep 1998 00:25:13 +0000 (+0000) Subject: * lisp/gnus-art.el (article-decode-encoded-words): Renamed from X-Git-Tag: pgnus-ichikawa-199811302358~215 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=4f25f5ea6238e4d6a15f388d9713cc323e0d5b4e;p=elisp%2Fgnus.git- * lisp/gnus-art.el (article-decode-encoded-words): Renamed from `gnus-article-decode-rfc1522'. * lisp/mail-parse.el: New file. * lisp/mm-view.el: New file. * lisp/rfc2231.el: New file. * texi/emacs-mime.texi: New file. * lisp/gnus.el (gnus-version-number): Update to 6.10.019. * Sync up with Pterodactyl Gnus 0.30. A snapshot is available from ftp://ftp.jpl.org/pub/tmp/semi-gnus-pgnus-ichikawa-19980914-1.tar.gz --- diff --git a/ChangeLog b/ChangeLog index 0f9762c..6c681e6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +1998-09-14 Katsumi Yamaoka + + * lisp/gnus-art.el (article-decode-encoded-words): Renamed from + `gnus-article-decode-rfc1522'. + + * lisp/mail-parse.el: New file. + * lisp/mm-view.el: New file. + * lisp/rfc2231.el: New file. + * texi/emacs-mime.texi: New file. + + * lisp/gnus.el (gnus-version-number): Update to 6.10.019. + + * Sync up with Pterodactyl Gnus 0.30. + 1998-09-11 Katsumi Yamaoka * lisp/gnus.el (gnus-version-number): Update to 6.10.018. @@ -264,7 +278,7 @@ 1998-08-28 Shuhei KOBAYASHI - * lisp/message.el (message-make-in-reply-to): + * lisp/message.el (message-make-in-reply-to): Use `std11-extract-address-components'. (message-use-mail-reply-to): Doc fix. @@ -317,7 +331,7 @@ 1998-08-25 Tatsuya Ichikawa * lisp/gnus-cache.el (gnus-cache-possibly-enter-article): - (gnus-cache-save-buffers): Write file in raw-text + (gnus-cache-save-buffers): Write file in raw-text coding system. * lisp/gnus-cache.el (gnus-cache-write-file-coding-system): New variable. * lisp/gnus-util.el (gnus-write-buffer): Undo change. @@ -326,10 +340,10 @@ 1998-08-24 Tatsuya Ichikawa - * lisp/gnus-offline.el (gnus-offline-setup): Bug fix and version + * lisp/gnus-offline.el (gnus-offline-setup): Bug fix and version changed to 1.53. - * lisp/gnus-util.el (gnus-write-buffer): Write file in raw-text coding + * lisp/gnus-util.el (gnus-write-buffer): Write file in raw-text coding system. * lisp/gnus-util.el (gnus-write-file-coding-system): New variable. @@ -363,7 +377,7 @@ * Sync up with Gnus 5.6.38. - * lisp/gnus-offline.el (gnus-offline-enable-fetch-mail): Enable to get + * lisp/gnus-offline.el (gnus-offline-enable-fetch-mail): Enable to get APOP server. * lisp/pop3-fma.el (pop3-fma-movemail): Enable to get from APOP server. @@ -724,7 +738,7 @@ * lisp/pop3-fma.el: Small bug fix. * lisp/pop3-fma.el: Delete variable pop3-fma-cypher-key - Use base64-encode-string , base64-decode-string instead. + Use base64-encode-string , base64-decode-string instead. Both change by Yasuo OKABE 1998-06-13 Tatsuya Ichikawa diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5c71c81..3167492 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,136 @@ +Sun Sep 13 09:37:37 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.30 is released. + +1998-09-13 08:00:41 Lars Magne Ingebrigtsen + + * gnus-art.el (article-decode-encoded-words): Use it. + (gnus-decode-header-function): New variable. + + * gnus-sum.el (gnus-nov-parse-line): Use it. + (gnus-decode-encoded-word-function): New variable. + + * gnus-msg.el (gnus-copy-article-buffer): Decode the right + buffer. + + * gnus-art.el (gnus-insert-mime-button): Use widget. + (gnus-widget-press-button): New function. + (gnus-article-prev-button): Removed. + (gnus-article-next-button): Ditto. + (gnus-article-add-button): Ditto. + + * gnus.el (gnus-article-mode-map): Inherit from widget. + (gnus-article-mode-map): No, don't. + + * mm-decode.el (mm-dissect-buffer): Store Content-ID things. + (mm-content-id-alist): New variable. + (mm-get-content-id): New function. + + * gnus-art.el (gnus-request-article-this-buffer): Only decode + articles if we are fetching to the article buffer. + +1998-09-13 07:58:59 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-move-article): Don't decode accepting + articles. + +1998-09-13 07:23:28 Lars Magne Ingebrigtsen + + * mm-util.el (mm-mime-charset): Try to use safe-charsets. + (mm-default-mime-charset): New variable. + + * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials. + + * drums.el (drums-quote-string): Reversed test. + +1998-09-12 14:29:21 Lars Magne Ingebrigtsen + + * mm-util.el (mm-insert-rfc822-headers): Possibly not quote + string. + + * drums.el (drums-quote-string): New function. + + * rfc2047.el (rfc2047-encode-message-header): Goto point-min. + (rfc2047-b-encode-region): Chop lines. + (rfc2047-q-encode-region): Ditto. + +Sat Sep 12 13:27:15 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.29 is released. + +1998-09-12 12:46:30 Istvan Marko + + * mm-decode.el (mm-save-part): Message right. + +1998-09-12 11:30:01 Lars Magne Ingebrigtsen + + * drums.el (drums-parse-address): Returned a list instead of a + string. + (drums-remove-whitespace): Skip comments. + (drums-parse-addresses): Didn't work. + +Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.28 is released. + +1998-09-12 04:57:25 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-button-map): Use the article keymap as a + starting point. + (article-decode-encoded-words): Rename. + + * message.el (message-narrow-to-headers-or-head): New function. + + * gnus-int.el (gnus-request-accept-article): Narrow to the right + region. + + * message.el (message-send-news): Encode body after checking + syntax. + + * gnus-art.el (gnus-mime-button-line-format): Allow descriptions. + + * mm-decode.el (mm-save-part): Use Content-Disposition filename. + + * gnus-art.el (gnus-display-mime): Respect disposition. + + * mm-decode.el (mm-preferred-alternative): Respect disposition. + + * gnus-art.el (article-strip-multiple-blank-lines): Don't delete + text with annotations. + + * message.el (message-make-date): Fix sign for negative time + zones. + + * mm-view.el (mm-inline-image): Insert a space at the end of the + image. + + * mail-parse.el: New file. + + * rfc2231.el: New file. + + * drums.el (drums-content-type-get): Removed. + (drums-parse-content-type): Ditto. + + * mailcap.el (mailcap-mime-data): Use symbols instead of strings. + +Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.27 is released. + +1998-09-11 12:42:07 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-alternative-precedence): New variable. + (mm-preferred-alternative): New function. + + * gnus-art.el (gnus-mime-copy-part): New command. + + * mm-decode.el (mm-get-part): New function. + + * mm-view.el: New file. + + * mm-decode.el (mm-dissect-buffer): Downcase cte. + (mm-display-part): Default to mailcap-save-binary-file. + Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.26 is released. diff --git a/lisp/drums.el b/lisp/drums.el index b13ec15..6b4a0d8 100644 --- a/lisp/drums.el +++ b/lisp/drums.el @@ -62,7 +62,9 @@ (modify-syntax-entry ?@ "w" table) (modify-syntax-entry ?/ "w" table) (modify-syntax-entry ?= " " table) + (modify-syntax-entry ?* " " table) (modify-syntax-entry ?\; " " table) + (modify-syntax-entry ?\' " " table) table)) (defun drums-token-to-list (token) @@ -120,6 +122,8 @@ (cond ((eq c ?\") (forward-sexp 1)) + ((eq c ?\() + (forward-sexp 1)) ((memq c '(? ?\t ?\n)) (delete-char 1)) (t @@ -183,7 +187,7 @@ (cons (mapconcat 'identity (nreverse display-name) "") (drums-get-comment string))) - (cons mailbox display-name))))) + (cons mailbox display-string))))) (defun drums-parse-addresses (string) "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." @@ -197,11 +201,14 @@ ((memq c '(?\" ?< ?\()) (forward-sexp 1)) ((eq c ?,) - (push (drums-parse-address (buffer-substring beg (1- (point)))) + (push (drums-parse-address (buffer-substring beg (point))) pairs) + (forward-char 1) (setq beg (point))) (t (forward-char 1)))) + (push (drums-parse-address (buffer-substring beg (point))) + pairs) (nreverse pairs)))) (defun drums-unfold-fws () @@ -215,59 +222,8 @@ "Return an Emacs time spec from STRING." (apply 'encode-time (parse-time-string string))) -(defun drums-content-type-get (ct attribute) - "Return the value of ATTRIBUTE from CT." - (cdr (assq attribute (cdr ct)))) - -(defun drums-parse-content-type (string) - "Parse STRING and return a list." - (with-temp-buffer - (let ((ttoken (drums-token-to-list drums-text-token)) - (stoken (drums-token-to-list drums-tspecials)) - display-name mailbox c display-string parameters - attribute value type subtype) - (drums-init (drums-remove-whitespace (drums-remove-comments string))) - (setq c (following-char)) - (when (and (memq c ttoken) - (not (memq c stoken))) - (setq type (downcase (buffer-substring - (point) (progn (forward-sexp 1) (point))))) - ;; Do the params - (while (not (eobp)) - (setq c (following-char)) - (unless (eq c ?\;) - (error "Invalid header: %s" string)) - (forward-char 1) - (setq c (following-char)) - (if (and (memq c ttoken) - (not (memq c stoken))) - (setq attribute - (intern - (downcase - (buffer-substring - (point) (progn (forward-sexp 1) (point)))))) - (error "Invalid header: %s" string)) - (setq c (following-char)) - (unless (eq c ?=) - (error "Invalid header: %s" string)) - (forward-char 1) - (setq c (following-char)) - (cond - ((eq c ?\") - (setq value - (buffer-substring (1+ (point)) - (progn (forward-sexp 1) (1- (point)))))) - ((and (memq c ttoken) - (not (memq c stoken))) - (setq value (buffer-substring - (point) (progn (forward-sexp 1) (point))))) - (t - (error "Invalid header: %s" string))) - (push (cons attribute value) parameters)) - `(,type ,@(nreverse parameters)))))) - (defun drums-narrow-to-header () - "Narrow to the header of the current buffer." + "Narrow to the header section in the current buffer." (narrow-to-region (goto-char (point-min)) (if (search-forward "\n\n" nil 1) @@ -275,6 +231,12 @@ (point-max))) (goto-char (point-min))) +(defun drums-quote-string (string) + "Quote string if it needs quoting to be displayed in a header." + (if (not (string-match (concat "[^" drums-atext-token "]") string)) + (concat "\"" string "\"") + string)) + (provide 'drums) ;;; drums.el ends here diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 9c527be..479f601 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -27,8 +27,9 @@ (require 'gnus-cache) (require 'nnvirtual) (require 'gnus-sum) -(eval-when-compile (require 'cl) - (require 'gnus-score)) +(eval-when-compile + (require 'cl) + (require 'gnus-score)) (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") "Where the Gnus agent will store its files." @@ -664,7 +665,7 @@ the actual number of articles toggled is returned." (let ((dir (concat (gnus-agent-directory) (gnus-agent-group-path group) "/")) - (date (time-to-day (current-time))) + (date (time-to-days (current-time))) (case-fold-search t) pos crosses id elem) (gnus-make-directory dir) @@ -792,7 +793,7 @@ the actual number of articles toggled is returned." (gnus-agent-enter-history "last-header-fetched-for-session" (list (cons group (nth (- (length articles) 1) articles))) - (time-to-day (current-time))) + (time-to-days (current-time))) articles))))) (defsubst gnus-agent-copy-nov-line (article) @@ -1311,7 +1312,7 @@ The following commands are available: "Expire all old articles." (interactive) (let ((methods gnus-agent-covered-methods) - (day (- (time-to-day (current-time)) gnus-agent-expire-days)) + (day (- (time-to-days (current-time)) gnus-agent-expire-days)) gnus-command-method sym group articles history overview file histories elem art nov-file low info unreads marked article) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index a9650d0..d440f6d 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -958,8 +958,8 @@ characters to translate to." (process-send-region "article-x-face" beg end) (process-send-eof "article-x-face")))))))))) -(defun gnus-article-decode-rfc1522 () - "Decode MIME encoded-words in header fields." +(defun article-decode-encoded-words () + "Remove encoded-word encoding from headers." (let (buffer-read-only) (let ((charset (save-excursion (set-buffer gnus-summary-buffer) @@ -1065,7 +1065,9 @@ always hide." (goto-char (point-min)) (search-forward "\n\n" nil t) (while (re-search-forward "^[ \t]+$" nil t) - (replace-match "" nil t)) + (unless (gnus-annotation-in-region-p + (match-beginning 0) (match-end 0)) + (replace-match "" nil t))) ;; Then replace multiple empty lines with a single empty line. (goto-char (point-min)) (search-forward "\n\n" nil t) @@ -2516,10 +2518,10 @@ If given a prefix, show the hidden text instead." (let (buffer-read-only) (erase-buffer) (insert-buffer-substring gnus-article-buffer)) - (setq gnus-original-article (cons group article)))) + (setq gnus-original-article (cons group article))) - ;; Decode charsets. - (run-hooks 'gnus-article-decode-hook) + ;; Decode charsets. + (run-hooks 'gnus-article-decode-hook)) ;; Update sparse articles. (when (and do-update-line diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index c8fa58b..70d51f2 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -403,7 +403,6 @@ Returns the list of articles removed." (cons group (set-buffer (gnus-get-buffer-create " *gnus-cache-overview*")))) - (buffer-disable-undo (current-buffer)) ;; Insert the contents of this group's cache overview. (erase-buffer) (let ((file (gnus-cache-file-name group ".overview"))) @@ -495,7 +494,6 @@ Returns the list of articles removed." (gnus-cache-save-buffers) (save-excursion (set-buffer cache-buf) - (buffer-disable-undo (current-buffer)) (erase-buffer) (nnheader-insert-file-contents (or file (gnus-cache-file-name group ".overview"))) (goto-char (point-min)) @@ -525,7 +523,6 @@ Returns the list of articles removed." (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))) (save-excursion (set-buffer cache-buf) - (buffer-disable-undo (current-buffer)) (erase-buffer)) (set-buffer nntp-server-buffer) (goto-char (point-min)) diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index a38bee3..44ae372 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -28,7 +28,7 @@ (eval-and-compile (require 'cl)) -(require 'drums) +(require 'mail-parse) (defvar mailcap-parse-args-syntax-table (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) @@ -40,175 +40,171 @@ "A syntax table for parsing sgml attributes.") (defvar mailcap-mime-data - '(("multipart" - (".*" - ("viewer" . mailcap-save-binary-file) - ("type" . "multipart/*"))) - ("application" + '(("application" ("x-x509-ca-cert" - ("viewer" . ssl-view-site-cert) - ("test" . (fboundp 'ssl-view-site-cert)) - ("type" . "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")) + (viewer . ssl-view-user-cert) + (test . (fboundp 'ssl-view-user-cert)) + (type . "application/x-x509-user-cert")) ("octet-stream" - ("viewer" . mailcap-save-binary-file) - ("type" ."application/octet-stream")) + (viewer . mailcap-save-binary-file) + (type ."application/octet-stream")) ("dvi" - ("viewer" . "open %s") - ("type" . "application/dvi") - ("test" . (eq (mm-device-type) 'ns))) + (viewer . "open %s") + (type . "application/dvi") + (test . (eq (mm-device-type) 'ns))) ("dvi" - ("viewer" . "xdvi %s") - ("test" . (eq (mm-device-type) 'x)) + (viewer . "xdvi %s") + (test . (eq (mm-device-type) 'x)) ("needsx11") - ("type" . "application/dvi")) + (type . "application/dvi")) ("dvi" - ("viewer" . "dvitty %s") - ("test" . (not (getenv "DISPLAY"))) - ("type" . "application/dvi")) + (viewer . "dvitty %s") + (test . (not (getenv "DISPLAY"))) + (type . "application/dvi")) ("emacs-lisp" - ("viewer" . mailcap-maybe-eval) - ("type" . "application/emacs-lisp")) + (viewer . mailcap-maybe-eval) + (type . "application/emacs-lisp")) ("x-tar" - ("viewer" . mailcap-save-binary-file) - ("type" . "application/x-tar")) + (viewer . mailcap-save-binary-file) + (type . "application/x-tar")) ("x-latex" - ("viewer" . tex-mode) - ("test" . (fboundp 'tex-mode)) - ("type" . "application/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")) + (viewer . tex-mode) + (test . (fboundp 'tex-mode)) + (type . "application/x-tex")) ("latex" - ("viewer" . tex-mode) - ("test" . (fboundp 'tex-mode)) - ("type" . "application/latex")) + (viewer . tex-mode) + (test . (fboundp 'tex-mode)) + (type . "application/latex")) ("tex" - ("viewer" . tex-mode) - ("test" . (fboundp 'tex-mode)) - ("type" . "application/tex")) + (viewer . tex-mode) + (test . (fboundp 'tex-mode)) + (type . "application/tex")) ("texinfo" - ("viewer" . texinfo-mode) - ("test" . (fboundp 'texinfo-mode)) - ("type" . "application/tex")) + (viewer . texinfo-mode) + (test . (fboundp 'texinfo-mode)) + (type . "application/tex")) ("zip" - ("viewer" . mailcap-save-binary-file) - ("type" . "application/zip") + (viewer . mailcap-save-binary-file) + (type . "application/zip") ("copiousoutput")) ("pdf" - ("viewer" . "acroread %s") - ("type" . "application/pdf")) + (viewer . "acroread %s") + (type . "application/pdf")) ("postscript" - ("viewer" . "open %s") - ("type" . "application/postscript") - ("test" . (eq (mm-device-type) 'ns))) + (viewer . "open %s") + (type . "application/postscript") + (test . (eq (mm-device-type) 'ns))) ("postscript" - ("viewer" . "ghostview %s") - ("type" . "application/postscript") - ("test" . (eq (mm-device-type) 'x)) + (viewer . "ghostview %s") + (type . "application/postscript") + (test . (eq (mm-device-type) 'x)) ("needsx11")) ("postscript" - ("viewer" . "ps2ascii %s") - ("type" . "application/postscript") - ("test" . (not (getenv "DISPLAY"))) + (viewer . "ps2ascii %s") + (type . "application/postscript") + (test . (not (getenv "DISPLAY"))) ("copiousoutput"))) ("audio" ("x-mpeg" - ("viewer" . "maplay %s") - ("type" . "audio/x-mpeg")) + (viewer . "maplay %s") + (type . "audio/x-mpeg")) (".*" - ("viewer" . mailcap-play-sound-file) - ("test" . (or (featurep 'nas-sound) + (viewer . mm-view-sound-file) + (test . (or (featurep 'nas-sound) (featurep 'native-sound))) - ("type" . "audio/*")) + (type . "audio/*")) (".*" - ("viewer" . "showaudio") - ("type" . "audio/*"))) + (viewer . "showaudio") + (type . "audio/*"))) ("message" ("rfc-*822" - ("viewer" . vm-mode) - ("test" . (fboundp 'vm-mode)) - ("type" . "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")) + (viewer . w3-mode) + (test . (fboundp 'w3-mode)) + (type . "message/rfc-822")) ("rfc-*822" - ("viewer" . view-mode) - ("test" . (fboundp 'view-mode)) - ("type" . "message/rfc-822")) + (viewer . view-mode) + (test . (fboundp 'view-mode)) + (type . "message/rfc-822")) ("rfc-*822" - ("viewer" . fundamental-mode) - ("type" . "message/rfc-822"))) + (viewer . fundamental-mode) + (type . "message/rfc-822"))) ("image" ("x-xwd" - ("viewer" . "xwud -in %s") - ("type" . "image/x-xwd") + (viewer . "xwud -in %s") + (type . "image/x-xwd") ("compose" . "xwd -frame > %s") - ("test" . (eq (mm-device-type) 'x)) + (test . (eq (mm-device-type) 'x)) ("needsx11")) ("x11-dump" - ("viewer" . "xwud -in %s") - ("type" . "image/x-xwd") + (viewer . "xwud -in %s") + (type . "image/x-xwd") ("compose" . "xwd -frame > %s") - ("test" . (eq (mm-device-type) 'x)) + (test . (eq (mm-device-type) 'x)) ("needsx11")) ("windowdump" - ("viewer" . "xwud -in %s") - ("type" . "image/x-xwd") + (viewer . "xwud -in %s") + (type . "image/x-xwd") ("compose" . "xwd -frame > %s") - ("test" . (eq (mm-device-type) 'x)) + (test . (eq (mm-device-type) 'x)) ("needsx11")) (".*" - ("viewer" . "aopen %s") - ("type" . "image/*") - ("test" . (eq (mm-device-type) 'ns))) + (viewer . "aopen %s") + (type . "image/*") + (test . (eq (mm-device-type) 'ns))) (".*" - ("viewer" . "xv -perfect %s") - ("type" . "image/*") - ("test" . (eq (mm-device-type) 'x)) + (viewer . "xv -perfect %s") + (type . "image/*") + (test . (eq (mm-device-type) 'x)) ("needsx11"))) ("text" ("plain" - ("viewer" . w3-mode) - ("test" . (fboundp 'w3-mode)) - ("type" . "text/plain")) + (viewer . w3-mode) + (test . (fboundp 'w3-mode)) + (type . "text/plain")) ("plain" - ("viewer" . view-mode) - ("test" . (fboundp 'view-mode)) - ("type" . "text/plain")) + (viewer . view-mode) + (test . (fboundp 'view-mode)) + (type . "text/plain")) ("plain" - ("viewer" . fundamental-mode) - ("type" . "text/plain")) + (viewer . fundamental-mode) + (type . "text/plain")) ("enriched" - ("viewer" . enriched-decode-region) - ("test" . (fboundp 'enriched-decode-region)) - ("type" . "text/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"))) + (viewer . mm-w3-prepare-buffer) + (test . (fboundp 'w3-prepare-buffer)) + (type . "text/html"))) ("video" ("mpeg" - ("viewer" . "mpeg_play %s") - ("type" . "video/mpeg") - ("test" . (eq (mm-device-type) 'x)) + (viewer . "mpeg_play %s") + (type . "video/mpeg") + (test . (eq (mm-device-type) 'x)) ("needsx11"))) ("x-world" ("x-vrml" - ("viewer" . "webspace -remote %s -URL %u") - ("type" . "x-world/x-vrml") + (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))))) + (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) @@ -223,9 +219,9 @@ Which looks like: 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\")) + ((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 @@ -270,20 +266,11 @@ not.") (expand-file-name fname mailcap-temporary-directory)))) (defun mailcap-save-binary-file () - ;; Ok, this is truly fucked. In XEmacs, if you use the mouse to select - ;; a URL that gets saved via this function, read-file-name will pop up a - ;; dialog box for file selection. For some reason which buffer we are in - ;; gets royally screwed (even with save-excursions and the whole nine - ;; yards). SO, we just keep the old buffer name around and away we go. - (let ((old-buff (current-buffer)) - (file (read-file-name "Filename to save as: " - (or mailcap-download-directory "~/") - (file-name-nondirectory (url-view-url t)) - nil - (file-name-nondirectory (url-view-url t)))) + (let ((file (read-file-name + "Filename to save as: " + (or mailcap-download-directory "~/"))) (require-final-newline nil)) - (set-buffer old-buff) - (mule-write-region-no-coding-system (point-min) (point-max) file) + (write-region (point-min) (point-max) file) (kill-buffer (current-buffer)))) (defun mailcap-maybe-eval () @@ -307,6 +294,7 @@ not.") (defun mailcap-parse-mailcaps (&optional path force) "Parse out all the mailcaps specified in a unix-style path string PATH. If FORCE, re-parse even if already parsed." + (interactive) (when (or (not mailcap-parsed-p) force) (cond @@ -386,10 +374,10 @@ If FORCE, re-parse even if already parsed." (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)))) + (setq info (nconc (list (cons 'viewer viewer) + (cons 'type (concat major "/" + (if (string= minor ".*") + "*" minor)))) (mailcap-parse-mailcap-extras save-pos (point)))) (mailcap-mailcap-entry-passes-test info) (mailcap-add-mailcap-entry major minor info))))) @@ -443,7 +431,7 @@ If FORCE, re-parse even if already parsed." ;; 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 + (test (assq 'test info)) ; The test clause ) (setq status (and test (split-string (cdr test) " "))) (if (and (assoc "needsx11" info) (not (getenv "DISPLAY"))) @@ -507,7 +495,7 @@ If FORCE, re-parse even if already parsed." ((null save-chr) nil) ((= save-chr ?t) (delete-region save-pos (progn (forward-char 1) (point))) - (insert (or (cdr (assoc "type" type-info)) "\"\""))) + (insert (or (cdr (assq 'type type-info)) "\"\""))) ((= save-chr ?M) (delete-region save-pos (progn (forward-char 1) (point))) (insert "\"\"")) @@ -533,10 +521,10 @@ If FORCE, re-parse even if already parsed." (defun mailcap-viewer-passes-test (viewer-info type-info) ;; Return non-nil iff the viewer specified by VIEWER-INFO passes its ;; test clause (if any). - (let* ((test-info (assoc "test" viewer-info)) + (let* ((test-info (assq 'test viewer-info)) (test (cdr test-info)) (otest test) - (viewer (cdr (assoc "viewer" viewer-info))) + (viewer (cdr (assoc 'viewer viewer-info))) (default-directory (expand-file-name "~/")) status parsed-test cache result) (if (setq cache (assoc test mailcap-viewer-test-cache)) @@ -574,10 +562,10 @@ If FORCE, re-parse even if already parsed." (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 + (assq '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))) + ((and (not (assq 'test info)) ; No test info, replace completely + (not (assq 'test cur-minor))) (setcdr cur-minor info)) (t (setcdr old-major (cons (cons minor info) (cdr old-major))))))))) @@ -588,10 +576,10 @@ If FORCE, re-parse even if already parsed." (defun mailcap-viewer-lessp (x y) ;; Return t iff viewer X is more desirable than viewer Y - (let ((x-wild (string-match "[*?]" (or (cdr-safe (assoc "type" x)) ""))) - (y-wild (string-match "[*?]" (or (cdr-safe (assoc "type" y)) ""))) - (x-lisp (not (stringp (or (cdr-safe (assoc "viewer" x)) "")))) - (y-lisp (not (stringp (or (cdr-safe (assoc "viewer" y)) ""))))) + (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) ""))) + (y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) ""))) + (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) "")))) + (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) ""))))) (cond ((and x-lisp (not y-lisp)) t) @@ -625,7 +613,7 @@ this type is returned." viewer ; The one and only viewer ctl) (save-excursion - (setq ctl (drums-parse-content-type (or string "text/plain"))) + (setq ctl (mail-header-parse-content-type (or string "text/plain"))) (setq major (split-string (car ctl) "/")) (setq minor (cadr major) major (car major)) @@ -640,16 +628,16 @@ this type is returned." (setq viewers (cdr viewers))) (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp)) (setq viewer (car passed)))) - (when (and (stringp (cdr (assoc "viewer" viewer))) + (when (and (stringp (cdr (assq 'viewer viewer))) passed) (setq viewer (car passed))) (cond - ((and (null viewer) (not (equal major "default"))) + ((and (null viewer) (not (equal major "default")) request) (mailcap-mime-info "default" request)) ((or (null request) (equal request "")) - (mailcap-unescape-mime-test (cdr (assoc "viewer" viewer)) info)) + (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) ((stringp request) - (if (or (string= request "test") (string= request "viewer")) + (if (or (eq request 'test) (eq request 'viewer)) (mailcap-unescape-mime-test (cdr-safe (assoc request viewer)) info))) ((eq request 'all) @@ -657,8 +645,8 @@ this type is returned." (t ;; MUST make a copy *sigh*, else we modify mailcap-mime-data (setq viewer (copy-tree viewer)) - (let ((view (assoc "viewer" viewer)) - (test (assoc "test" viewer))) + (let ((view (assq 'viewer viewer)) + (test (assq 'test viewer))) (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info))) (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info)))) viewer))))) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index e9dd5fc..a594c28 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -384,7 +384,6 @@ header line with the old Message-ID." ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used ;; this buffer should be passed to all mail/news reply/post routines. (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*")) - (buffer-disable-undo gnus-article-copy) (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg) (if (not (and (get-buffer article-buffer) @@ -418,7 +417,7 @@ header line with the old Message-ID." (or (search-forward "\n\n" nil t) (point))) ;; Insert the original article headers. (insert-buffer-substring gnus-original-article-buffer beg end) - (gnus-article-decode-rfc1522))) + (article-decode-encoded-words))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject @@ -855,7 +854,6 @@ The source file has to be in the Emacs load path." ;; Go through all the files looking for non-default values for variables. (save-excursion (set-buffer (gnus-get-buffer-create " *gnus bug info*")) - (buffer-disable-undo (current-buffer)) (while files (erase-buffer) (when (and (setq file (locate-library (pop files))) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index d3813f5..23c041c 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1122,7 +1122,7 @@ SCORE is the score to add." (or (not decay) (gnus-decay-scores alist decay))) (gnus-score-set 'touched '(t) alist) - (gnus-score-set 'decay (list (time-to-day (current-time))) alist)) + (gnus-score-set 'decay (list (time-to-days (current-time))) alist)) ;; We do not respect eval and files atoms from global score ;; files. (when (and files (not global)) @@ -2839,7 +2839,7 @@ If ADAPT, return the home adaptive file instead." (defun gnus-decay-scores (alist day) "Decay non-permanent scores in ALIST." - (let ((times (- (time-to-day (current-time)) day)) + (let ((times (- (time-to-days (current-time)) day)) kill entry updated score n) (unless (zerop times) ;Done decays today already? (while (setq entry (pop alist)) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index fb18171..3d21773 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2422,7 +2422,6 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 7 "Reading slave newsrcs...") (save-excursion (set-buffer (gnus-get-buffer-create " *gnus slave*")) - (buffer-disable-undo (current-buffer)) (setq slave-files (sort (mapcar (lambda (file) (list (nth 5 (file-attributes file)) file)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index d74e249..6061845 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -6994,7 +6994,7 @@ and `request-accept' functions." (set-buffer copy-buf) (when (gnus-request-article-this-buffer article gnus-newsgroup-name) (gnus-request-accept-article - to-newsgroup select-method (not articles))))) + to-newsgroup select-method (not articles) t)))) ;; Crosspost the article. ((eq action 'crosspost) (let ((xref (message-tokenize-header @@ -7202,7 +7202,6 @@ latter case, they will be copied into the relevant groups." (error "Can't read %s" file)) (save-excursion (set-buffer (gnus-get-buffer-create " *import file*")) - (buffer-disable-undo (current-buffer)) (erase-buffer) (nnheader-insert-file-contents file) (goto-char (point-min)) diff --git a/lisp/gnus.el b/lisp/gnus.el index 0b7f0d7..51c0b3e 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -253,10 +253,10 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.018" +(defconst gnus-version-number "6.10.019" "Version number for this version of gnus.") -(defconst gnus-original-version-number "0.26" +(defconst gnus-original-version-number "0.30" "Version number for this version of Gnus.") (defconst gnus-original-product-name "Pterodactyl Gnus" @@ -793,7 +793,6 @@ used to 899, you would say something along these lines: (and (file-readable-p gnus-nntpserver-file) (save-excursion (set-buffer (gnus-get-buffer-create " *gnus nntp*")) - (buffer-disable-undo (current-buffer)) (insert-file-contents gnus-nntpserver-file) (let ((name (buffer-string))) (prog1 @@ -1704,7 +1703,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-next-page gnus-article-prev-page gnus-request-article-this-buffer gnus-article-mode gnus-article-setup-buffer gnus-narrow-to-page - gnus-article-delete-invisible-text gnus-hack-decode-rfc1522) + gnus-article-delete-invisible-text) ("gnus-art" :interactive t gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-word-wrap @@ -1716,7 +1715,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-date-original gnus-article-date-lapsed gnus-article-show-all-headers gnus-article-edit-mode gnus-article-edit-article - gnus-article-edit-done + gnus-article-edit-done article-decode-encoded-words gnus-start-date-timer gnus-stop-date-timer) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 diff --git a/lisp/message.el b/lisp/message.el index 2efbd56..f6b7146 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1248,6 +1248,21 @@ Point is left at the beginning of the narrowed-to region." (point-max))) (goto-char (point-min))) +(defun message-narrow-to-headers-or-head () + "Narrow the buffer to the head of the message." + (widen) + (narrow-to-region + (goto-char (point-min)) + (cond + ((re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t) + (match-beginning 0)) + ((search-forward "\n\n" nil t) + (1- (point))) + (t + (point-max)))) + (goto-char (point-min))) + (defun message-news-p () "Say whether the current buffer contains a news message." (and (not message-this-is-mail) @@ -2757,7 +2772,6 @@ to find out how to use this." list file) (save-excursion (set-buffer (get-buffer-create " *message temp*")) - (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-buffer-substring message-encoding-buffer) (save-restriction @@ -2836,6 +2850,8 @@ If NOW, use that time instead." (let* ((now (or now (current-time))) (zone (nth 8 (decode-time now))) (sign "+")) + (when (< zone 0) + (setq sign "")) ;; We do all of this because XEmacs doesn't have the %z spec. (concat (format-time-string "%d %b %Y %H:%M:%S " (or now (current-time))) (format "%s%02d%02d" @@ -3951,7 +3967,6 @@ that further discussion should take place only in " (error "This article is not yours")) ;; Make control message. (setq buf (set-buffer (get-buffer-create " *message cancel*"))) - (buffer-disable-undo (current-buffer)) (erase-buffer) (insert "Newsgroups: " newsgroups "\n" "From: " (message-make-from) "\n" @@ -4146,7 +4161,6 @@ Optional NEWS will use news to forward instead of mail." beg) ;; We first set up a normal mail buffer. (set-buffer (get-buffer-create " *message resend*")) - (buffer-disable-undo (current-buffer)) (erase-buffer) ;; avoid to turn-on-mime-edit (let (message-setup-hook) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 0e6640b..2cc3dbb 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -28,6 +28,7 @@ (if (not (fboundp 'base64-encode-string)) (require 'base64))) (require 'mm-util) +(require 'rfc2047) (require 'qp) (defun mm-encode-body () diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 4c4d23f..3f0055f 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -24,7 +24,7 @@ ;;; Code: -(require 'drums) +(require 'mail-parse) (require 'mailcap) (require 'mm-bodies) @@ -51,7 +51,10 @@ ("text/.*" . inline))) (defvar mm-user-automatic-display - '("text/plain" "image/gif")) + '("text/plain" "text/html" "image/gif")) + +(defvar mm-alternative-precedence '("text/plain" "text/html") + "List that describes the precedence of alternative parts.") (defvar mm-tmp-directory "/tmp/" "Where mm will store its temporary files.") @@ -60,33 +63,66 @@ (defvar mm-dissection-list nil) (defvar mm-last-shell-command "") +(defvar mm-content-id-alist nil) + +;;; Convenience macros. + +(defmacro mm-handle-buffer (handle) + `(nth 0 ,handle)) +(defmacro mm-handle-type (handle) + `(nth 1 ,handle)) +(defmacro mm-handle-encoding (handle) + `(nth 2 ,handle)) +(defmacro mm-handle-undisplayer (handle) + `(nth 3 ,handle)) +(defmacro mm-handle-set-undisplayer (handle function) + `(setcar (nthcdr 3 ,handle) ,function)) +(defmacro mm-handle-disposition (handle) + `(nth 4 ,handle)) +(defmacro mm-handle-description (handle) + `(nth 5 ,handle)) + +;;; The functions. (defun mm-dissect-buffer (&optional no-strict-mime) "Dissect the current buffer and return a list of MIME handles." (save-excursion - (let (ct ctl type subtype cte) + (let (ct ctl type subtype cte cd description id result) (save-restriction - (drums-narrow-to-header) + (mail-narrow-to-head) (when (and (or no-strict-mime (mail-fetch-field "mime-version")) (setq ct (mail-fetch-field "content-type"))) - (setq ctl (drums-parse-content-type ct)) - (setq cte (mail-fetch-field "content-transfer-encoding")))) + (setq ctl (mail-header-parse-content-type ct) + cte (mail-fetch-field "content-transfer-encoding") + cd (mail-fetch-field "content-disposition") + description (mail-fetch-field "content-description") + id (mail-fetch-field "content-id")))) (when ctl (setq type (split-string (car ctl) "/")) (setq subtype (cadr type) type (pop type)) - (cond - ((equal type "multipart") - (mm-dissect-multipart ctl)) - (t - (mm-dissect-singlepart ctl (and cte (intern cte)) - no-strict-mime))))))) - -(defun mm-dissect-singlepart (ctl cte &optional force) + (setq + result + (cond + ((equal type "multipart") + (mm-dissect-multipart ctl)) + (t + (mm-dissect-singlepart + ctl + (and cte (intern (downcase (mail-header-remove-whitespace + (mail-header-remove-comments + cte))))) + no-strict-mime + (and cd (mail-header-parse-content-disposition cd)))))) + (when id + (push (cons id result) mm-content-id-alist)) + result)))) + +(defun mm-dissect-singlepart (ctl cte &optional force cdl description) (when (or force (not (equal "text/plain" (car ctl)))) - (let ((res (list (list (mm-copy-to-buffer) ctl cte nil)))) + (let ((res (list (list (mm-copy-to-buffer) ctl cte nil cdl description)))) (push (car res) mm-dissection-list) res))) @@ -98,7 +134,7 @@ (defun mm-dissect-multipart (ctl) (goto-char (point-min)) - (let ((boundary (concat "\n--" (drums-content-type-get ctl 'boundary))) + (let ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) start parts end) (while (search-forward boundary nil t) (forward-line -1) @@ -127,28 +163,29 @@ "Display the MIME part represented by HANDLE." (save-excursion (mailcap-parse-mailcaps) - (if (nth 3 handle) + (if (mm-handle-undisplayer handle) (mm-remove-part handle) - (let* ((type (caadr handle)) + (let* ((type (car (mm-handle-type handle))) (method (mailcap-mime-info type)) (user-method (mm-user-method type))) (if (eq user-method 'inline) (progn (forward-line 1) (mm-display-inline handle)) - (mm-display-external handle (or user-method method))))))) + (mm-display-external + handle (or user-method method 'mailcap-save-binary-file))))))) (defun mm-display-external (handle method) "Display HANDLE using METHOD." (mm-with-unibyte-buffer - (insert-buffer-substring (car handle)) - (mm-decode-content-transfer-encoding (nth 2 handle)) + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding (mm-handle-encoding handle)) (if (functionp method) (let ((cur (current-buffer))) (switch-to-buffer (generate-new-buffer "*mm*")) (insert-buffer-substring cur) (funcall method) - (setcar (nthcdr 3 handle) (current-buffer))) + (mm-handle-set-undisplayer handle (current-buffer))) (let* ((file (make-temp-name (expand-file-name "emm." mm-tmp-directory))) process) (write-region (point-min) (point-max) @@ -156,35 +193,37 @@ (setq process (start-process "*display*" nil shell-file-name "-c" (format method file))) - (setcar (nthcdr 3 handle) (cons file process)) + (mm-handle-set-undisplayer handle (cons file process)) (message "Displaying %s..." (format method file)))))) (defun mm-remove-part (handle) "Remove the displayed MIME part represented by HANDLE." - (let ((object (nth 3 handle))) - (cond - ;; Internally displayed part. - ((mm-annotationp object) - (delete-annotation object)) - ((or (functionp object) - (and (listp object) - (eq (car object) 'lambda))) - (funcall object)) - ;; Externally displayed part. - ((consp object) - (condition-case () - (delete-file (car object)) - (error nil)) - (condition-case () - (kill-process (cdr object)) - (error nil))) - ((bufferp object) - (when (buffer-live-p object) - (kill-buffer object)))) - (setcar (nthcdr 3 handle) nil))) + (let ((object (mm-handle-undisplayer handle))) + (condition-case () + (cond + ;; Internally displayed part. + ((mm-annotationp object) + (delete-annotation object)) + ((or (functionp object) + (and (listp object) + (eq (car object) 'lambda))) + (funcall object)) + ;; Externally displayed part. + ((consp object) + (condition-case () + (delete-file (car object)) + (error nil)) + (condition-case () + (kill-process (cdr object)) + (error nil))) + ((bufferp object) + (when (buffer-live-p object) + (kill-buffer object)))) + (error nil)) + (mm-handle-set-undisplayer handle nil))) (defun mm-display-inline (handle) - (let* ((type (caadr handle)) + (let* ((type (car (mm-handle-type handle))) (function (cadr (assoc type mm-inline-media-tests)))) (funcall function handle))) @@ -230,8 +269,8 @@ This overrides entries in the mailcap file." (defun mm-destroy-part (handle) "Destroy the data structures connected to HANDLE." (mm-remove-part handle) - (when (buffer-live-p (car handle)) - (kill-buffer (car handle)))) + (when (buffer-live-p (mm-handle-buffer handle)) + (kill-buffer (mm-handle-buffer handle)))) (defun mm-quote-arg (arg) "Return a version of ARG that is safe to evaluate in a shell." @@ -247,85 +286,78 @@ This overrides entries in the mailcap file." (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))) ;;; -;;; Functions for displaying various formats inline -;;; - -(defun mm-inline-image (handle) - (let ((type (cadr (split-string (caadr handle) "/"))) - image) - (mm-with-unibyte-buffer - (insert-buffer-substring (car handle)) - (mm-decode-content-transfer-encoding (nth 2 handle)) - (setq image (make-image-specifier - (vector (intern type) :data (buffer-string))))) - (let ((annot (make-annotation image nil 'text))) - (set-extent-property annot 'mm t) - (set-extent-property annot 'duplicable t) - (setcar (nthcdr 3 handle) annot)))) - -(defun mm-inline-text (handle) - (let ((type (cadr (split-string (caadr handle) "/"))) - text buffer-read-only) - (mm-with-unibyte-buffer - (insert-buffer-substring (car handle)) - (mm-decode-content-transfer-encoding (nth 2 handle)) - (setq text (buffer-string))) - (cond - ((equal type "plain") - (let ((b (point))) - (insert text) - (save-restriction - (narrow-to-region b (point)) - (let ((charset (drums-content-type-get (nth 1 handle) 'charset))) - (when charset - (mm-decode-body charset nil))) - (setcar - (nthcdr 3 handle) - `(lambda () - (let (buffer-read-only) - (delete-region ,(set-marker (make-marker) (point-min)) - ,(set-marker (make-marker) (point-max))))))))) - ))) - -(defun mm-inline-audio (handle) - (message "Not implemented")) - -;;; ;;; Functions for outputting parts ;;; +(defun mm-get-part (handle) + "Return the contents of HANDLE as a string." + (mm-with-unibyte-buffer + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding (mm-handle-encoding handle)) + (buffer-string))) + (defun mm-save-part (handle) "Write HANDLE to a file." - (let* ((name (drums-content-type-get (cadr handle) 'name)) - (file (read-file-name "Save MIME part to: " - (expand-file-name - (or name "") default-directory)))) + (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) + (filename (mail-content-type-get + (mm-handle-disposition handle) 'filename)) + file) + (when filename + (setq filename (file-name-nondirectory filename))) + (setq file + (read-file-name "Save MIME part to: " + (expand-file-name + (or filename name "") default-directory))) (mm-with-unibyte-buffer - (insert-buffer-substring (car handle)) - (mm-decode-content-transfer-encoding (nth 2 handle)) + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding (mm-handle-encoding handle)) (when (or (not (file-exists-p file)) - (yes-or-no-p (format "File %s already exists; overwrite? "))) + (yes-or-no-p (format "File %s already exists; overwrite? " + file))) (write-region (point-min) (point-max) file))))) (defun mm-pipe-part (handle) "Pipe HANDLE to a process." - (let* ((name (drums-content-type-get (cadr handle) 'name)) + (let* ((name (mail-content-type-get (car (mm-handle-type handle)) 'name)) (command (read-string "Shell command on MIME part: " mm-last-shell-command))) (mm-with-unibyte-buffer - (insert-buffer-substring (car handle)) - (mm-decode-content-transfer-encoding (nth 2 handle)) + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding (mm-handle-encoding handle)) (shell-command-on-region (point-min) (point-max) command nil)))) (defun mm-interactively-view-part (handle) "Display HANDLE using METHOD." - (let* ((type (caadr handle)) + (let* ((type (car (mm-handle-type handle))) (methods (mapcar (lambda (i) (list (cdr (assoc "viewer" i)))) (mailcap-mime-info type 'all))) (method (completing-read "Viewer: " methods))) (mm-display-external (copy-sequence handle) method))) +(defun mm-preferred-alternative (handles &optional preferred) + "Say which of HANDLES are preferred." + (let ((prec (if preferred (list preferred) mm-alternative-precedence)) + p h result type) + (while (setq p (pop prec)) + (setq h handles) + (while h + (setq type (car (mm-handle-type (car h)))) + (when (and (equal p type) + (mm-automatic-display-p type) + (or (not (mm-handle-disposition (car h))) + (equal (car (mm-handle-disposition (car h))) + "inline"))) + (setq result (car h) + h nil + prec nil)) + (pop h))) + result)) + +(defun mm-get-content-id (id) + "Return the handle(s) referred to by ID." + (cdr (assoc id mm-content-id-alist))) + (provide 'mm-decode) ;; mm-decode.el ends here diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 38cd97a..44ab492 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -24,6 +24,16 @@ ;;; Code: +(require 'mail-parse) + +(defun mm-insert-rfc822-headers (charset encoding) + "Insert text/plain headers with CHARSET and ENCODING." + (insert "MIME-Version: 1.0\n") + (insert "Content-Type: text/plain; charset=" + (mail-quote-string (downcase (symbol-name charset))) "\n") + (insert "Content-Transfer-Encoding: " + (downcase (symbol-name encoding)) "\n")) + (provide 'mm-encode) ;;; mm-encode.el ends here diff --git a/lisp/mm-util.el b/lisp/mm-util.el index bcba15b..c8e21b3 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -24,6 +24,9 @@ ;;; Code: +(defvar mm-default-coding-system nil + "The default coding system to use.") + (defvar mm-known-charsets '(iso-8859-1) "List of known charsets.") @@ -160,17 +163,15 @@ used as the line break code type of the coding system." (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte t))) -(defun mm-insert-rfc822-headers (charset encoding) - "Insert text/plain headers with CHARSET and ENCODING." - (insert "MIME-Version: 1.0\n") - (insert "Content-Type: text/plain; charset=\"" - (downcase (symbol-name charset)) "\"\n") - (insert "Content-Transfer-Encoding: " - (downcase (symbol-name encoding)) "\n")) - (defun mm-mime-charset (charset b e) (if (fboundp 'coding-system-get) (or + (and + mm-default-coding-system + (let ((safe (coding-system-get mm-default-coding-system + 'safe-charsets))) + (or (eq safe t) (memq charset safe))) + (coding-system-get mm-default-coding-system 'mime-charset)) (coding-system-get (get-charset-property charset 'prefered-coding-system) 'mime-charset) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 932b196..f885c46 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -289,7 +289,6 @@ from the document.") (setq nndoc-dissection-alist nil) (save-excursion (set-buffer nndoc-current-buffer) - (buffer-disable-undo (current-buffer)) (erase-buffer) (if (stringp nndoc-address) (nnheader-insert-file-contents nndoc-address) diff --git a/lisp/nndraft.el b/lisp/nndraft.el index d2489ee..c2736a7 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -80,7 +80,6 @@ (let* ((buf (get-buffer-create " *draft headers*")) article) (set-buffer buf) - (buffer-disable-undo (current-buffer)) (erase-buffer) ;; We don't support fetching by Message-ID. (if (stringp (car articles)) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 8f9b57b..6613193 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -328,7 +328,6 @@ time saver for large mailboxes.") (nnfolder-request-article article group server) (save-excursion (set-buffer buf) - (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index c247f7a..978893f 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -775,8 +775,6 @@ find-file-hooks, etc. `(let ((new (generate-new-buffer " *nnheader replace*")) (cur (current-buffer)) (start (point-min))) - (set-buffer new) - (buffer-disable-undo (current-buffer)) (set-buffer cur) (goto-char (point-min)) (while (,(if regexp 're-search-forward 'search-forward) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 5b9dd8f..a75cd3d 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -986,7 +986,6 @@ FUNC will be called with the buffer narrowed to each mail." (save-excursion ;; Insert the incoming file. (set-buffer (get-buffer-create " *nnmail incoming*")) - (buffer-disable-undo (current-buffer)) (erase-buffer) (nnheader-insert-file-contents incoming) (unless (zerop (buffer-size)) @@ -1441,7 +1440,6 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (set-buffer (setq nnmail-cache-buffer (get-buffer-create " *nnmail message-id cache*"))) - (buffer-disable-undo (current-buffer)) (when (file-exists-p nnmail-message-id-cache-file) (nnheader-insert-file-contents nnmail-message-id-cache-file)) (set-buffer-modified-p nil) diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 1f05d1d..b0f3c21 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -265,7 +265,6 @@ (nnmbox-request-article article group server) (save-excursion (set-buffer buf) - (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) diff --git a/lisp/nnml.el b/lisp/nnml.el index 42581c0..a8f1e48 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -502,7 +502,6 @@ all. This may very well take some time.") (defun nnml-find-group-number (id) (save-excursion (set-buffer (get-buffer-create " *nnml id*")) - (buffer-disable-undo (current-buffer)) (let ((alist nnml-group-alist) number) ;; We want to look through all .overview files, but we want to diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index 4ccb28c..253557e 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -752,7 +752,6 @@ backend for the messages.") (string-to-int (match-string 1 f2))))))) active group lines ident elem min) (set-buffer (get-buffer-create " *nnsoup work*")) - (buffer-disable-undo (current-buffer)) (while files (nnheader-message 5 "Doing %s..." (car files)) (erase-buffer) diff --git a/lisp/nnspool.el b/lisp/nnspool.el index b2075be..dd3d89c 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -419,7 +419,6 @@ there.") (defun nnspool-find-id (id) (save-excursion (set-buffer (get-buffer-create " *nnspool work*")) - (buffer-disable-undo (current-buffer)) (erase-buffer) (ignore-errors (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file)) diff --git a/lisp/qp.el b/lisp/qp.el index ea88dbd..e26f927 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -1,4 +1,4 @@ -;;; qp.el --- Quoted-printable functions +;;; qp.el --- Quoted-Printable functions ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 8d36466..fdeb989 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -30,6 +30,7 @@ (require 'base64)))) (require 'qp) (require 'mm-util) +(require 'drums) (defvar rfc2047-default-charset 'iso-8859-1 "Default MIME charset -- does not need encoding.") @@ -101,13 +102,13 @@ Valid encodings are nil, `Q' and `B'.") (point-max)))) (goto-char (point-min))) -;;;###autoload (defun rfc2047-encode-message-header () "Encode the message header according to `rfc2047-header-encoding-alist'. Should be called narrowed to the head of the message." (interactive "*") (when (featurep 'mule) (save-excursion + (goto-char (point-min)) (let ((alist rfc2047-header-encoding-alist) elem method) (while (not (eobp)) @@ -147,7 +148,7 @@ Should be called narrowed to the head of the message." (save-restriction (narrow-to-region b e) (goto-char (point-min)) - (while (re-search-forward "[^ \t\n]+" nil t) + (while (re-search-forward (concat "[^" drums-tspecials " \t\n]+") nil t) (push (list (match-beginning 0) (match-end 0) (car @@ -188,28 +189,31 @@ Should be called narrowed to the head of the message." 'B)) (start (concat "=?" (downcase (symbol-name mime-charset)) "?" - (downcase (symbol-name encoding)) "?"))) + (downcase (symbol-name encoding)) "?")) + (first t)) (save-restriction (narrow-to-region b e) (mm-encode-coding-region b e mime-charset) (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) (point-min) (point-max)) (goto-char (point-min)) - (insert start) - (goto-char (point-max)) - (insert "?=") - ;; Encoded words can't be more than 75 chars long, so we have to - ;; split the long ones up. - (end-of-line) - (while (> (current-column) 74) - (beginning-of-line) - (forward-char 73) - (insert "?=\n " start) - (end-of-line))))) + (while (not (eobp)) + (unless first + (insert " ")) + (setq first nil) + (insert start) + (end-of-line) + (insert "?=") + (forward-line 1))))) (defun rfc2047-b-encode-region (b e) "Encode the header contained in REGION with the B encoding." - (base64-encode-region b e t)) + (base64-encode-region b e t) + (goto-char (point-min)) + (while (not (eobp)) + (goto-char (min (point-max) (+ 64 (point)))) + (unless (eobp) + (insert "\n")))) (defun rfc2047-q-encode-region (b e) "Encode the header contained in REGION with the Q encoding." @@ -220,17 +224,23 @@ Should be called narrowed to the head of the message." (while alist (when (looking-at (caar alist)) (quoted-printable-encode-region b e nil (cdar alist)) - (subst-char-in-region (point-min) (point-max) ? ?_)) - (pop alist)))))) + (subst-char-in-region (point-min) (point-max) ? ?_) + (setq alist nil)) + (pop alist)) + (goto-char (point-min)) + (while (not (eobp)) + (forward-char 64) + (search-backward "=" nil (- (point) 2)) + (unless (eobp) + (insert "\n"))))))) ;;; ;;; Functions for decoding RFC2047 messages ;;; (defvar rfc2047-encoded-word-regexp - "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ ]+\\)\\?=") + "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=") -;;;###autoload (defun rfc2047-decode-region (start end) "Decode MIME-encoded words in region between START and END." (interactive "r") @@ -261,7 +271,6 @@ Should be called narrowed to the head of the message." (when (mm-multibyte-p) (mm-decode-coding-region b (point-max) rfc2047-default-charset)))))) -;;;###autoload (defun rfc2047-decode-string (string) "Decode the quoted-printable-encoded STRING and return the results." (let ((m (mm-multibyte-p))) diff --git a/lisp/score-mode.el b/lisp/score-mode.el index c1c7158..d625940 100644 --- a/lisp/score-mode.el +++ b/lisp/score-mode.el @@ -82,7 +82,7 @@ This mode is an extended emacs-lisp mode. (defun gnus-score-edit-insert-date () "Insert date in numerical format." (interactive) - (princ (time-to-day (current-time)) (current-buffer))) + (princ (time-to-days (current-time)) (current-buffer))) (defun gnus-score-pretty-print () "Format the current score file." diff --git a/lisp/time-date.el b/lisp/time-date.el index b3a50f1..db7a35e 100644 --- a/lisp/time-date.el +++ b/lisp/time-date.el @@ -78,7 +78,7 @@ (defun date-to-day (date) "Return the number of days between year 1 and DATE." - (time-to-day (date-to-time date))) + (time-to-days (date-to-time date))) (defun days-between (date1 date2) "Return the number of days between DATE1 and DATE2." @@ -103,7 +103,7 @@ (setq day-of-year (1+ day-of-year)))) day-of-year)) -(defun time-to-day (time) +(defun time-to-days (time) "The number of days between the Gregorian date 0001-12-31bce and TIME. The Gregorian date Sunday, December 31, 1bce is imaginary." (let* ((tim (decode-time time)) diff --git a/texi/ChangeLog b/texi/ChangeLog index 11bcbde..2ff934b 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,8 +1,19 @@ +1998-09-13 08:58:56 Lars Magne Ingebrigtsen + + * dir (File): Updated. + +1998-09-12 08:53:05 Lars Magne Ingebrigtsen + + * emacs-mime.texi: New file. + + * gnus.texi (Misc Article): Addition. + 1998-09-11 08:52:50 Lars Magne Ingebrigtsen * gnus.texi (Group Score Commands): Fix. (Saving Articles): Fix. (Agent Expiry): Fix. + (Using MIME): Change. 1998-09-10 03:19:14 Lars Magne Ingebrigtsen diff --git a/texi/Makefile.in b/texi/Makefile.in index eb05e11..107434a 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -18,7 +18,7 @@ INSTALL_DATA = @INSTALL_DATA@ SHELL = /bin/sh PAPERTYPE=a4 -all: gnus message +all: gnus message emacs-mime most: texi2latex.elc latex latexps @@ -31,7 +31,7 @@ most: texi2latex.elc latex latexps makeinfo -o $* $<; \ fi -dvi: gnus.dvi message.dvi refcard.dvi +dvi: gnus.dvi message.dvi refcard.dvi emacs-mime.dvi .texi.dvi : $(PERL) -n -e 'print unless (/\@iflatex/ .. /\@end iflatex/)' $< > gnustmp.texi @@ -115,7 +115,7 @@ distclean: install: $(SHELL) $(top_srcdir)/mkinstalldirs $(infodir) - @for file in gnus message; do \ + @for file in gnus message emacs-info; do \ for ifile in `echo $$file $$file-[0-9] $$file-[0-9][0-9]`; do \ if test -f $$ifile; then \ echo " $(INSTALL_DATA) $$ifile $(infodir)/$$ifile"; \ diff --git a/texi/dir b/texi/dir index a169da0..08eb94d 100644 --- a/texi/dir +++ b/texi/dir @@ -5,5 +5,6 @@ File: dir Node: Top This is the Gnus Info tree * Menu: -* Gnus: (gnus). The news reader Gnus. -* Message: (message). The Message sending thingamabob. +* Gnus: (gnus). The news reader Gnus. +* Message: (message). The Message sending thingamabob. +* Emacs MIME: (emacs-mime). Libraries for handling MIME. diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 7fffd95..f98699f 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus-ja -@settitle Semi-gnus 6.10.018 Manual +@settitle Semi-gnus 6.10.019 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -345,7 +345,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Semi-gnus 6.10.018 Manual +@title Semi-gnus 6.10.019 Manual @author by Lars Magne Ingebrigtsen @author by members of Semi-gnus mailing-list @@ -399,7 +399,7 @@ Semi-gnus は、大きな絵が入っていたりさまざまな形式を用いたりしているちょっ な言語圏を差別しません。ああ、クリンゴンの方は Unicode Next Generationを お待ちください。 -この説明書は Semi-gnus 6.10.018 に対応します。 +この説明書は Semi-gnus 6.10.019 に対応します。 @end ifinfo diff --git a/texi/gnus.texi b/texi/gnus.texi index 1ebbabf..d1af82a 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Semi-gnus 6.10.018 Manual +@settitle Semi-gnus 6.10.019 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -270,7 +270,7 @@ \thispagestyle{empty} -Copyright \copyright{} 1995,96,97 Free Software Foundation, Inc. +Copyright \copyright{} 1995,96,97,98 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Semi-gnus 6.10.018 Manual +@title Semi-gnus 6.10.019 Manual @author by Lars Magne Ingebrigtsen @page @@ -361,7 +361,7 @@ internationalization/localization and multiscript features based on MULE API. So Semi-gnus does not discriminate various language communities. Oh, if you are a Klingon, please wait Unicode Next Generation. -This manual corresponds to Semi-gnus 6.10.018. +This manual corresponds to Semi-gnus 6.10.019. @end ifinfo @@ -8073,6 +8073,12 @@ If non-@code{nil}, use the same article buffer for all the groups. (This is the default.) If @code{nil}, each group will have its own article buffer. +@vindex gnus-article-decode-hook +@item gnus-article-decode-hook +@cindex MIME +Hook used to decode @sc{mime} articles. The default value is +@code{(article-decode-charset article-decode-encoded-words)} + @vindex gnus-article-prepare-hook @item gnus-article-prepare-hook This hook is called right after the article has been inserted into the @@ -9628,14 +9634,16 @@ used for, well, anything, really. @vindex nnmail-split-hook @item nnmail-split-hook -@findex article-decode-rfc1522 +@findex article-decode-encoded-words @findex RFC1522 decoding +@findex RFC2047 decoding Hook run in the buffer where the mail headers of each message is kept just before the splitting based on these headers is done. The hook is free to modify the buffer contents in any way it sees fit---the buffer is discarded after the splitting has been done, and no changes performed -in the buffer will show up in any files. @code{gnus-article-decode-rfc1522} -is one likely function to add to this hook. +in the buffer will show up in any files. +@code{gnus-article-decode-encoded-words} is one likely function to add +to this hook. @vindex nnmail-pre-get-new-mail-hook @vindex nnmail-post-get-new-mail-hook diff --git a/texi/message.texi b/texi/message.texi index a6a5188..c9d2568 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.26 Manual +@settitle Pterodactyl Message 0.30 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -17,7 +17,7 @@ This file documents Message, the Emacs message composition mode. -Copyright (C) 1996 Free Software Foundation, Inc. +Copyright (C) 1996,97,98 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.26 Manual +@title Pterodactyl Message 0.30 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.26. Message is +This manual corresponds to Pterodactyl Message 0.30. Message is distributed with the Gnus distribution bearing the same version number as this manual.