From 29d88dc82d12421f6616ab1dcd11a3035a0875ee Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Sun, 13 Sep 1998 07:38:15 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 56 +++++++++++++++++++++++++++++++++++ lisp/drums.el | 6 ++++ lisp/gnus-agent.el | 5 ++-- lisp/gnus-art.el | 69 +++++++++++++++----------------------------- lisp/gnus-cache.el | 3 -- lisp/gnus-msg.el | 4 +-- lisp/gnus-start.el | 1 - lisp/gnus-sum.el | 18 ++++++++---- lisp/gnus.el | 3 +- lisp/mail-parse.el | 1 + lisp/mailcap.el | 1 + lisp/message.el | 4 +-- lisp/mm-decode.el | 37 +++++++++++++++--------- lisp/mm-encode.el | 10 +++++++ lisp/mm-util.el | 17 ++++++----- lisp/mm-view.el | 35 +++++++++++----------- lisp/nndoc.el | 1 - lisp/nndraft.el | 1 - lisp/nnfolder.el | 1 - lisp/nnheader.el | 2 -- lisp/nnmail.el | 2 -- lisp/nnmbox.el | 1 - lisp/nnml.el | 1 - lisp/nnsoup.el | 1 - lisp/nnspool.el | 1 - lisp/rfc2047.el | 46 ++++++++++++++++++----------- texi/ChangeLog | 4 +++ texi/Makefile.in | 4 +-- texi/dir | 5 ++-- texi/emacs-mime.texi | 65 +++++++++++++++++++++++++++++++++-------- texi/gnus.texi | 6 ++-- texi/message.texi | 6 ++-- 32 files changed, 263 insertions(+), 154 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5351aa3e9..316749253 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,59 @@ +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. diff --git a/lisp/drums.el b/lisp/drums.el index 7e74b4faa..6b4a0d849 100644 --- a/lisp/drums.el +++ b/lisp/drums.el @@ -231,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 ac6059176..013f57eb5 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." diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 50d781ffe..e36f60e1e 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -37,6 +37,7 @@ (require 'mail-parse) (require 'mm-decode) (require 'mm-view) +(require 'wid-edit) (defgroup gnus-article nil "Article display." @@ -542,6 +543,9 @@ displayed by the first non-nil matching CONTENT face." :group 'gnus-article-headers :type 'function) +(defvar gnus-decode-header-function 'mail-decode-encoded-word-region + "Function used to decode headers.") + ;;; Internal variables (defvar article-lapsed-timer nil) @@ -990,7 +994,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (buffer-read-only nil)) (save-restriction (message-narrow-to-head) - (mail-decode-encoded-word-region (point-min) (point-max))))) + (funcall gnus-decode-header-function (point-min) (point-max))))) (defun article-de-quoted-unreadable (&optional force) "Translate a quoted-printable-encoded article. @@ -1866,19 +1870,18 @@ If variable `gnus-use-long-file-name' is non-nil, it is (put 'gnus-article-mode 'mode-class 'special) +(set-keymap-parent gnus-article-mode-map widget-keymap) + (gnus-define-keys gnus-article-mode-map " " gnus-article-goto-next-page "\177" gnus-article-goto-prev-page [delete] gnus-article-goto-prev-page + "\r" widget-button-press "\C-c^" gnus-article-refer-article "h" gnus-article-show-summary "s" gnus-article-show-summary "\C-c\C-m" gnus-article-mail "?" gnus-article-describe-briefly - gnus-mouse-2 gnus-article-push-button - "\r" gnus-article-press-button - "\t" gnus-article-next-button - "\M-\t" gnus-article-prev-button "e" gnus-article-edit "<" beginning-of-buffer ">" end-of-buffer @@ -2179,7 +2182,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-insert-mime-button (handle) (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name)) (gnus-tmp-type (car (mm-handle-type handle))) - (gnus-tmp-description (mm-handle-description handle))) + (gnus-tmp-description (mm-handle-description handle)) + b e) (setq gnus-tmp-name (if gnus-tmp-name (concat " (" gnus-tmp-name ")") @@ -2188,12 +2192,19 @@ If ALL-HEADERS is non-nil, no headers are hidden." (if gnus-tmp-description (concat " (" gnus-tmp-description ")") "")) + (setq b (point)) (gnus-eval-format gnus-mime-button-line-format gnus-mime-button-line-format-alist `(local-map ,gnus-mime-button-map keymap ,gnus-mime-button-map gnus-callback mm-display-part - gnus-data ,handle)))) + gnus-data ,handle)) + (setq e (point)) + (widget-convert-text 'link b e b e :action 'gnus-widget-press-button))) + +(defun gnus-widget-press-button (elems el) + (goto-char (widget-get elems :from)) + (gnus-article-press-button)) (defun gnus-display-mime () "Insert MIME buttons in the buffer." @@ -2666,10 +2677,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 @@ -2943,40 +2954,6 @@ call it with the value of the `gnus-data' text property." (when fun (funcall fun data)))) -(defun gnus-article-prev-button (n) - "Move point to N buttons backward. -If N is negative, move forward instead." - (interactive "p") - (gnus-article-next-button (- n))) - -(defun gnus-article-next-button (n) - "Move point to N buttons forward. -If N is negative, move backward instead." - (interactive "p") - (let ((function (if (< n 0) 'previous-single-property-change - 'next-single-property-change)) - (inhibit-point-motion-hooks t) - (backward (< n 0)) - (limit (if (< n 0) (point-min) (point-max)))) - (setq n (abs n)) - (while (and (not (= limit (point))) - (> n 0)) - ;; Skip past the current button. - (when (get-text-property (point) 'gnus-callback) - (goto-char (funcall function (point) 'gnus-callback nil limit))) - ;; Go to the next (or previous) button. - (gnus-goto-char (funcall function (point) 'gnus-callback nil limit)) - ;; Put point at the start of the button. - (when (and backward (not (get-text-property (point) 'gnus-callback))) - (goto-char (funcall function (point) 'gnus-callback nil limit))) - ;; Skip past intangible buttons. - (when (get-text-property (point) 'intangible) - (incf n)) - (decf n)) - (unless (zerop n) - (gnus-message 5 "No more buttons")) - n)) - (defun gnus-article-highlight (&optional force) "Highlight current article. This function calls `gnus-article-highlight-headers', @@ -3159,7 +3136,9 @@ specified by `gnus-button-alist'." (nconc (and gnus-article-mouse-face (list gnus-mouse-face-prop gnus-article-mouse-face)) (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) + (and data (list 'gnus-data data)))) + (widget-convert-text 'link from to from to + :action 'gnus-widget-press-button)) ;;; Internal functions: diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index c73de868d..333c2b768 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -396,7 +396,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"))) @@ -488,7 +487,6 @@ Returns the list of articles removed." (gnus-cache-save-buffers) (save-excursion (set-buffer cache-buf) - (buffer-disable-undo (current-buffer)) (erase-buffer) (insert-file-contents (or file (gnus-cache-file-name group ".overview"))) (goto-char (point-min)) @@ -518,7 +516,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-msg.el b/lisp/gnus-msg.el index 24352d30c..9077b9036 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -362,7 +362,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) (save-excursion (set-buffer gnus-article-copy) (mm-enable-multibyte)) @@ -399,7 +398,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-encoded-words))) + (article-decode-encoded-words))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject @@ -832,7 +831,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-start.el b/lisp/gnus-start.el index d9553532a..cfe4f428c 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2424,7 +2424,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 97ba1f9a4..deb2bdc3b 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -761,6 +761,9 @@ mark: The articles mark." The function is called with one parameter, the article header vector, which it may alter in any way.") +(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string + "Variable that says which function should be used to decode a string with encoded words.") + ;;; Internal variables (defvar gnus-article-mime-handles nil) @@ -3052,8 +3055,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header (make-full-mail-header number ; number - (mail-decode-encoded-word-string (gnus-nov-field)) ; subject - (mail-decode-encoded-word-string (gnus-nov-field)) ; from + (funcall gnus-decode-encoded-word-function + (gnus-nov-field)) ; subject + (funcall gnus-decode-encoded-word-function + (gnus-nov-field)) ; from (gnus-nov-field) ; date (or (gnus-nov-field) (nnheader-generate-fake-message-id)) ; id @@ -4396,13 +4401,15 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - (mail-decode-encoded-word-string (nnheader-header-value)) + (funcall gnus-decode-encoded-word-function + (nnheader-header-value)) "(none)")) ;; From. (progn (goto-char p) (if (search-forward "\nfrom: " nil t) - (mail-decode-encoded-word-string (nnheader-header-value)) + (funcall gnus-decode-encoded-word-function + (nnheader-header-value)) "(nobody)")) ;; Date. (progn @@ -6928,7 +6935,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 @@ -7136,7 +7143,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) (insert-file-contents file) (goto-char (point-min)) diff --git a/lisp/gnus.el b/lisp/gnus.el index b856df2ef..7d8992d8b 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -250,7 +250,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.29" +(defconst gnus-version-number "0.30" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -781,7 +781,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 diff --git a/lisp/mail-parse.el b/lisp/mail-parse.el index 56a803247..095e11476 100644 --- a/lisp/mail-parse.el +++ b/lisp/mail-parse.el @@ -51,6 +51,7 @@ (defalias 'mail-header-parse-addresses 'drums-parse-addresses) (defalias 'mail-header-parse-date 'drums-parse-date) (defalias 'mail-narrow-to-head 'drums-narrow-to-header) +(defalias 'mail-quote-string 'drums-quote-string) (defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field) (defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region) diff --git a/lisp/mailcap.el b/lisp/mailcap.el index de5624c61..44ae372e8 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -294,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 diff --git a/lisp/message.el b/lisp/message.el index 7f073e5e8..0d7134124 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -40,6 +40,7 @@ (require 'mailabbrev)) (require 'mail-parse) (require 'mm-bodies) +(require 'mm-encode) (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -2556,7 +2557,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 buf) (save-restriction @@ -3548,7 +3548,6 @@ responses here are directed to other newsgroups.")) (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" @@ -3739,7 +3738,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) (message-setup `((To . ,address))) ;; Insert our usual headers. diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 02679e113..3f0055fcb 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -63,6 +63,7 @@ (defvar mm-dissection-list nil) (defvar mm-last-shell-command "") +(defvar mm-content-id-alist nil) ;;; Convenience macros. @@ -86,7 +87,7 @@ (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 cd description) + (let (ct ctl type subtype cte cd description id result) (save-restriction (mail-narrow-to-head) (when (and (or no-strict-mime @@ -95,22 +96,28 @@ (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")))) + 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 (downcase (mail-header-remove-whitespace - (mail-header-remove-comments - cte))))) - no-strict-mime - (and cd (mail-header-parse-content-disposition cd))))))))) + (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 @@ -347,6 +354,10 @@ This overrides entries in the mailcap file." (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 38cd97aa9..44ab492fb 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 bcba15ba6..c8e21b3e3 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/mm-view.el b/lisp/mm-view.el index 516a9f4d4..b9756e959 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -70,24 +70,23 @@ ,(set-marker (make-marker) (point-min)) ,(set-marker (make-marker) (point-max))))))))) ((equal type "html") - (save-window-excursion - (save-excursion - (w3-do-setup) - (mm-with-unibyte-buffer - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-decode-content-transfer-encoding (mm-handle-encoding handle)) - (require 'url) - (save-window-excursion - (w3-region (point-min) (point-max)) - (setq text (buffer-string)))) - (let ((b (point))) - (insert text) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (delete-region ,(set-marker (make-marker) b) - ,(set-marker (make-marker) (point)))))))))) + (save-excursion + (w3-do-setup) + (mm-with-unibyte-buffer + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding (mm-handle-encoding handle)) + (require 'url) + (save-window-excursion + (w3-region (point-min) (point-max)) + (setq text (buffer-string)))) + (let ((b (point))) + (insert text) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (delete-region ,(set-marker (make-marker) b) + ,(set-marker (make-marker) (point))))))))) ))) (defun mm-inline-audio (handle) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 0da245a7c..d3de06b73 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 d2489eeb1..c2736a7fb 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 7bf7d3a70..3c5852928 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 9064be7c4..b8f739e5b 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -777,8 +777,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 adeb6057a..1c109c2d1 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 1f05d1d16..b0f3c216a 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 42581c013..a8f1e48a4 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 4ccb28c2b..253557ea5 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 b2075be79..dd3d89cca 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/rfc2047.el b/lisp/rfc2047.el index b04bff54e..fdeb989fe 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.") @@ -107,6 +108,7 @@ 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)) @@ -146,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 @@ -187,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." @@ -219,15 +224,22 @@ 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\\)\\?\\([!->@-~ +]+\\)\\?=") (defun rfc2047-decode-region (start end) "Decode MIME-encoded words in region between START and END." diff --git a/texi/ChangeLog b/texi/ChangeLog index 5b57b30cd..d6388cc05 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,7 @@ +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. diff --git a/texi/Makefile.in b/texi/Makefile.in index 264263f42..107434ad5 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -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 a169da00d..08eb94d99 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/emacs-mime.texi b/texi/emacs-mime.texi index 8781acb15..f333fa5e7 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -6,7 +6,7 @@ @synindex vr cp @synindex pg cp @c @direntry -@c * Emacs Mime: (emacs-mime). The MIME de/composition library. +@c * Emacs MIME: (emacs-mime). The MIME de/composition library. @c @end direntry @iftex @finalout @@ -68,7 +68,7 @@ into another language, under the above conditions for modified versions. @end tex @node Top -@top Emacs Mime +@top Emacs MIME This manual documents the libraries used to compose and display @sc{mime} messages. @@ -98,8 +98,8 @@ read at least RFC2045 and RFC2047. This chapter describes the basic, ground-level functions for parsing and handling. Covered here is parsing @code{From} lines, removing comments from header lines, decoding encoded words, parsing date headers and so -on. High-level functionality is dealt with in the @pxref{Decoding and -Viewing} chapter. +on. High-level functionality is dealt with in the next chapter +(@pxref{Decoding and Viewing}). @menu * mail-parse:: The generalized @sc{mime} and mail interface. @@ -109,6 +109,7 @@ Viewing} chapter. * time-date:: Functions for parsing dates and manipulating time. * qp:: Quoted-Printable en/decoding. * base64:: Base64 en/decoding. +* mailcap:: How parts are displayed is specified by the @file{.mailcap} file @end menu @@ -164,7 +165,6 @@ Here's an example: @example (mail-header-parse-content-type "image/gif; name=\"b980912.gif\"") - => ("image/gif" (name . "b980912.gif")) @end example @@ -181,7 +181,6 @@ Returns the value of the attribute. @example (mail-content-type-get '("image/gif" (name . "b980912.gif")) 'name) - => "b980912.gif" @end example @@ -192,7 +191,6 @@ Return a comment-free version of a header. @example (mail-header-remove-comments "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)") - => "Gnus/5.070027 " @end example @@ -236,7 +234,7 @@ the one described above. @example (mail-header-parse-addresses "Hrvoje Niksic , Steinar Bang ") - => (("hniksic@@srce.hr" . "Hrvoje Niksic") +=> (("hniksic@@srce.hr" . "Hrvoje Niksic") ("sb@@metis.no" . "Steinar Bang")) @end example @@ -593,6 +591,45 @@ decoded, @code{nil} is returned. @end table +@node mailcap +@section mailcap + +The @file{~/.mailcap} file is parsed by most @sc{mime}-aware message +handlers and describes how elements are supposed to be displayed. +Here's an example file: + +@example +image/*; xv -8 %s +audio/x-pn-realaudio; rvplayer %s +@end example + +This says that all image files should be displayed with @samp{xv}, and +that realaudio files should be played by @samp{rvplayer}. + +The @code{mailcap} library parses this file, and provides functions for +matching types. + +@table @code +@item mailcap-mime-data +@vindex mailcap-mime-data +This variable is an alist of alists containing backup viewing rules. + +@end table + +Interface functions: + +@table @code +@item mailcap-parse-mailcaps +@findex mailcap-parse-mailcaps +Parse the @code{~/.mailcap} file. + +@item mailcap-mime-info +Takes a @sc{mime} type as its argument and returns the matching viewer. + +@end table + + + @node Decoding and Viewing @chapter Decoding and Viewing @@ -602,12 +639,12 @@ higher level. The main idea is to first analyze a @sc{mime} article, and then allow other programs to do things based on the list of @dfn{handles} that are -returned as a result of this analyze. +returned as a result of this analyzation. @menu -* Dissection:: Analyzing a @sc{mime} message. -* Handles:: Handle manipulations. -* Display:: Displaying handles. +* Dissection:: Analyzing a @sc{mime} message. +* Handles:: Handle manipulations. +* Display:: Displaying handles. @end menu @@ -659,6 +696,9 @@ Return the parsed @code{Content-Disposition} of the part. @findex mm-handle-disposition Return the description of the part. +@item mm-get-content-id +Returns the handle(s) referred to by @code{Content-ID}. + @end table @@ -703,6 +743,7 @@ Prompt for a mailcap method to use to view the part. @end table + @node Index @chapter Index @printindex cp diff --git a/texi/gnus.texi b/texi/gnus.texi index 560d404fa..8af0dcb94 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.29 Manual +@settitle Pterodactyl Gnus 0.30 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.29 Manual +@title Pterodactyl Gnus 0.30 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Pterodactyl Gnus 0.29. +This manual corresponds to Pterodactyl Gnus 0.30. @end ifinfo diff --git a/texi/message.texi b/texi/message.texi index 9bdde9a65..28e0d2952 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.29 Manual +@settitle Pterodactyl Message 0.30 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.29 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.29. 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. -- 2.34.1