From b58e5c4b5c4ae22a2e1fa402658cb2b022e89214 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 18 Nov 1998 01:36:12 +0000 Subject: [PATCH] Importing Pterodactyl Gnus v0.49. --- lisp/ChangeLog | 42 +++++++++++++++ lisp/gnus-art.el | 145 +++++++++++++++++++++++++++++----------------------- lisp/gnus-setup.el | 15 ------ lisp/gnus-sum.el | 2 +- lisp/gnus.el | 2 +- lisp/message.el | 19 ++++++- lisp/mm-view.el | 1 + lisp/mml.el | 52 ++++++++++++------- texi/ChangeLog | 4 ++ texi/gnus.texi | 27 ++++++++-- texi/message.texi | 6 +-- 11 files changed, 207 insertions(+), 108 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7eaac25..b969ad0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,45 @@ +Wed Nov 18 02:22:23 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.49 is released. + +1998-11-18 00:37:43 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-text): Require w3-vars. + + * gnus-setup.el (gnus-use-tm): Removed. + + * gnus-art.el (gnus-article-goto-part): Don't beep. + (gnus-article-view-part): Check return value. + (gnus-mime-display-alternative): Don't display when there is + nothing to display. + + * mml.el (mml-generate-mime-1): Don't use a unibyte buffer. + (mml-generate-mime-1): Use unibyte for binaries. + + * gnus-art.el (gnus-display-mime): Call + gnus-article-mime-part-function. + (gnus-mime-part-function): New function. + (gnus-article-mime-part-function): New function. + + * mml.el (mml-generate-mime-1): Don't insert so many newlines. + +1998-11-16 06:44:19 Lars Magne Ingebrigtsen + + * mml.el (mml-generate-mime-1): Do it in unibyte buffers. + + * message.el (message-font-lock-keywords): Highlight MML. + (message-mml-face): New font. + +Mon Nov 16 23:34:12 1998 Shenghuo ZHU + + * gnus-art.el (gnus-display-mime): Clean up even when no handles. + (gnus-mm-display-part): Do not select-window if the article window + is not found. + +Mon Nov 16 02:26:40 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-move-article): Use no-encode for B m. + Mon Nov 16 02:00:05 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.48 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index d1d466b..18a19a5 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -582,6 +582,11 @@ displayed by the first non-nil matching CONTENT face." (integer :tag "Less") (sexp :tag "Predicate"))) +(defcustom gnus-article-mime-part-function nil + "Function called with a MIME handle as the argument." + :group 'gnus-article + :type 'function) + ;;; Internal variables (defvar gnus-treatment-function-alist @@ -2317,11 +2322,11 @@ If ALL-HEADERS is non-nil, no headers are hidden." (when (> n (length gnus-article-mime-handle-alist)) (error "No such part")) (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) - (gnus-article-goto-part n) - (if (equal (car handle) "multipart/alternative") - (gnus-article-press-button) - (when (eq (gnus-mm-display-part handle) 'internal) - (gnus-set-window-start)))))) + (when (gnus-article-goto-part n) + (if (equal (car handle) "multipart/alternative") + (gnus-article-press-button) + (when (eq (gnus-mm-display-part handle) 'internal) + (gnus-set-window-start))))))) (defun gnus-mm-display-part (handle) "Display HANDLE and fix MIME button." @@ -2335,8 +2340,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (let ((window (selected-window))) (save-excursion (unwind-protect - (progn - (select-window (get-buffer-window (current-buffer) t)) + (let ((win (get-buffer-window (current-buffer) t))) + (if win + (select-window win)) (goto-char point) (forward-line) (mm-display-part handle)) @@ -2345,7 +2351,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-article-goto-part (n) "Go to MIME part N." - (goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) + (let ((point (text-property-any (point-min) (point-max) 'gnus-part n))) + (when point + (goto-char point)))) (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name)) @@ -2391,12 +2399,19 @@ If ALL-HEADERS is non-nil, no headers are hidden." "Insert MIME buttons in the buffer." (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) handle name type b e display) - (when handles + (unless ihandles + ;; Top-level call; we clean up. + (mm-destroy-parts gnus-article-mime-handles) + (setq gnus-article-mime-handles handles + gnus-article-mime-handle-alist nil) + ;; We allow users to glean info from the handles. + (when gnus-article-mime-part-function + (gnus-mime-part-function handles))) + (when (and handles + (or (not (stringp (car handles))) + (cdr handles))) (unless ihandles - ;; Top-level call; we clean up. - (mm-destroy-parts gnus-article-mime-handles) - (setq gnus-article-mime-handles handles - gnus-article-mime-handle-alist nil) + ;; Clean up for mime parts. (goto-char (point-min)) (search-forward "\n\n" nil t) (delete-region (point) (point-max))) @@ -2408,6 +2423,11 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-mime-display-mixed (cdr handles))) (gnus-mime-display-single handles))))) +(defun gnus-mime-part-function (handles) + (if (stringp (car handles)) + (mapcar 'gnus-mime-part-function (cdr handles)) + (funcall gnus-article-mime-part-function handles))) + (defun gnus-mime-display-mixed (handles) (let (handle) (while (setq handle (pop handles)) @@ -2453,57 +2473,29 @@ If ALL-HEADERS is non-nil, no headers are hidden." (goto-char (point-max)))))))) (defun gnus-mime-display-alternative (handles &optional preferred ibegend id) - (let* ((preferred (mm-preferred-alternative handles preferred)) + (let* ((preferred (or preferred (mm-preferred-alternative handles))) (ihandles handles) (point (point)) handle buffer-read-only from props begend not-pref) - (save-restriction - (when ibegend - (narrow-to-region (car ibegend) (cdr ibegend)) - (delete-region (point-min) (point-max)) - (mm-remove-parts handles)) - (setq begend (list (point-marker))) - ;; Do the toggle. - (unless (setq not-pref (cadr (member preferred ihandles))) - (setq not-pref (car ihandles))) - (gnus-add-text-properties - (setq from (point)) - (progn - (insert (format "%d. " id)) - (point)) - `(gnus-callback - (lambda (handles) - (gnus-mime-display-alternative - ',ihandles ,(if (stringp (car not-pref)) - (car not-pref) - (car (mm-handle-type not-pref))) - ',begend ,id)) - local-map ,gnus-mime-button-map - ,gnus-mouse-face-prop ,gnus-article-mouse-face - face ,gnus-article-button-face - keymap ,gnus-mime-button-map - gnus-part ,id - gnus-data ,handle)) - (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap) - ;; Do the handles - (while (setq handle (pop handles)) + (when preferred + (save-restriction + (when ibegend + (narrow-to-region (car ibegend) (cdr ibegend)) + (delete-region (point-min) (point-max)) + (mm-remove-parts handles)) + (setq begend (list (point-marker))) + ;; Do the toggle. + (unless (setq not-pref (cadr (member preferred ihandles))) + (setq not-pref (car ihandles))) (gnus-add-text-properties (setq from (point)) (progn - (insert (format "[%c] %-18s" - (if (equal handle preferred) ?* ? ) - (if (stringp (car handle)) - (car handle) - (car (mm-handle-type handle))))) + (insert (format "%d. " id)) (point)) `(gnus-callback (lambda (handles) (gnus-mime-display-alternative - ',ihandles ,(if (stringp (car handle)) - (car handle) - (car (mm-handle-type handle))) + ',ihandles ',not-pref ',begend ,id)) local-map ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face @@ -2514,16 +2506,41 @@ If ALL-HEADERS is non-nil, no headers are hidden." (widget-convert-button 'link from (point) :action 'gnus-widget-press-button :button-keymap gnus-widget-button-keymap) - (insert " ")) - (insert "\n\n") - (when preferred - (if (stringp (car preferred)) - (gnus-display-mime preferred) - (mm-display-part preferred) - (goto-char (point-max)) - (setcdr begend (point-marker))))) - (when ibegend - (goto-char point)))) + ;; Do the handles + (while (setq handle (pop handles)) + (gnus-add-text-properties + (setq from (point)) + (progn + (insert (format "[%c] %-18s" + (if (equal handle preferred) ?* ? ) + (if (stringp (car handle)) + (car handle) + (car (mm-handle-type handle))))) + (point)) + `(gnus-callback + (lambda (handles) + (gnus-mime-display-alternative + ',ihandles ',handle + ',begend ,id)) + local-map ,gnus-mime-button-map + ,gnus-mouse-face-prop ,gnus-article-mouse-face + face ,gnus-article-button-face + keymap ,gnus-mime-button-map + gnus-part ,id + gnus-data ,handle)) + (widget-convert-button 'link from (point) + :action 'gnus-widget-press-button + :button-keymap gnus-widget-button-keymap) + (insert " ")) + (insert "\n\n") + (when preferred + (if (stringp (car preferred)) + (gnus-display-mime preferred) + (mm-display-part preferred) + (goto-char (point-max)) + (setcdr begend (point-marker))))) + (when ibegend + (goto-char point))))) (defun gnus-article-wash-status () "Return a string which display status of article washing." diff --git a/lisp/gnus-setup.el b/lisp/gnus-setup.el index ae9909b..29c2a31 100644 --- a/lisp/gnus-setup.el +++ b/lisp/gnus-setup.el @@ -65,8 +65,6 @@ "site-lisp/bbdb-1.51/") "Directory where Big Brother Database is found.") -(defvar gnus-use-tm running-xemacs - "Set this if you want MIME support for Gnus") (defvar gnus-use-mhe nil "Set this if you want to use MH-E for mail reading") (defvar gnus-use-rmail nil @@ -89,19 +87,6 @@ ;;; We can't do this until we know where Gnus is. (require 'message) -;;; Tools for MIME by -;;; UMEDA Masanobu -;;; MORIOKA Tomohiko - -(when gnus-use-tm - (when (and (not gnus-use-installed-tm) - (null (member gnus-tm-lisp-directory load-path))) - (setq load-path (cons gnus-tm-lisp-directory load-path))) - ;; tm may or may not be dumped with XEmacs. In Sunpro it is, otherwise - ;; it isn't. - (unless (featurep 'mime-setup) - (load "mime-setup"))) - ;;; Mailcrypt by ;;; Jin Choi ;;; Patrick LoPresti diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 8485f0e..89b3940 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -7072,7 +7072,7 @@ and `request-accept' functions." gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article to-newsgroup (list 'quote select-method) - (not articles)) ; Accept form + (not articles) t) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. ((eq action 'copy) diff --git a/lisp/gnus.el b/lisp/gnus.el index dc02ea8..3ad4925 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -254,7 +254,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.48" +(defconst gnus-version-number "0.49" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) diff --git a/lisp/message.el b/lisp/message.el index 0c9a0f8..f4555b5 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -789,6 +789,18 @@ Defaults to `text-mode-abbrev-table'.") "Face used for displaying cited text names." :group 'message-faces) +(defface message-mml-face + '((((class color) + (background dark)) + (:foreground "ForestGreen")) + (((class color) + (background light)) + (:foreground "ForestGreen")) + (t + (:bold t))) + "Face used for displaying MML." + :group 'message-faces) + (defvar message-font-lock-keywords (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")) @@ -819,7 +831,9 @@ Defaults to `text-mode-abbrev-table'.") (,(concat "^[ \t]*" "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[:>|}].*") - (0 'message-cited-text-face)))) + (0 'message-cited-text-face)) + ("<#/?\\(multi\\)part.*>" + (0 'message-mml-face)))) "Additional expressions to highlight in Message mode.") ;; XEmacs does it like this. For Emacs, we have to set the @@ -4116,11 +4130,12 @@ regexp varstr." (delete-region beg (point)) (insert "Mime-Version: 1.0\n") (search-forward "\n\n") + (forward-char -1) (insert line) (when (save-excursion (re-search-backward "^Content-Type: multipart/" nil t)) (insert "This is a MIME multipart message. If you are reading\n") - (insert "this, you shouldn't.\n\n")))))) + (insert "this, you shouldn't.\n")))))) (run-hooks 'message-load-hook) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 706a2a2..bea8c6f 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -84,6 +84,7 @@ (car (mm-handle-type handle))) (require 'url) (save-window-excursion + (require 'w3-vars) (let ((w3-strict-width width)) (w3-region (point-min) (point-max))) (setq text (buffer-string)))))) diff --git a/lisp/mml.el b/lisp/mml.el index 5f4d8e3..fab6be2 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -84,11 +84,16 @@ (defun mml-read-part () "Return the buffer up till the next part, multipart or closing part or multipart." (let ((beg (point))) + ;; If the tag ended at the end of the line, we go to the next line. + (when (looking-at "[ \t]*\n") + (forward-line 1)) (if (re-search-forward "<#/?\\(multi\\)?part." nil t) (prog1 (buffer-substring beg (match-beginning 0)) - (unless (equal (match-string 0) "<#/part>") - (goto-char (match-beginning 0)))) + (if (not (equal (match-string 0) "<#/part>")) + (goto-char (match-beginning 0)) + (when (looking-at "[ \t]*\n") + (forward-line 1)))) (buffer-substring beg (goto-char (point-max)))))) (defvar mml-boundary nil) @@ -110,27 +115,32 @@ ((eq (car cont) 'part) (let (coded encoding charset filename type) (setq type (or (cdr (assq 'type cont)) "text/plain")) - (with-temp-buffer - (if (setq filename (cdr (assq 'filename cont))) - (insert-file-contents-literally filename) - (save-restriction - (narrow-to-region (point) (point)) - (insert (cdr (assq 'contents cont))) - (goto-char (point-min)) - (while (re-search-forward "<#!+\\(part\\|multipart\\)" nil t) - (delete-region (+ (match-beginning 0) 2) - (+ (match-beginning 0) 3))))) - (if (equal (car (split-string type "/")) "text") + (if (equal (car (split-string type "/")) "text") + (with-temp-buffer + (if (setq filename (cdr (assq 'filename cont))) + (insert-file-contents-literally filename) + (save-restriction + (narrow-to-region (point) (point)) + (insert (cdr (assq 'contents cont))) + ;; Remove quotes from quoted tags. + (goto-char (point-min)) + (while (re-search-forward "<#!+\\(part\\|multipart\\)" nil t) + (delete-region (+ (match-beginning 0) 2) + (+ (match-beginning 0) 3))))) (setq charset (mm-encode-body) encoding (mm-body-encoding)) - (setq encoding (mm-encode-buffer type))) - (setq coded (buffer-string))) + (setq coded (buffer-string))) + (mm-with-unibyte-buffer + (if (setq filename (cdr (assq 'filename cont))) + (insert-file-contents-literally filename) + (insert (cdr (assq 'contents cont)))) + (setq coded (buffer-string)))) (when (or charset (not (equal type "text/plain"))) - (insert "Content-Type: " type)) - (when charset - (insert (format "; charset=\"%s\"" charset))) - (insert "\n") + (insert "Content-Type: " type) + (when charset + (insert (format "; charset=\"%s\"" charset))) + (insert "\n")) (unless (eq encoding '7bit) (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") @@ -143,8 +153,12 @@ (insert "\n") (setq cont (cddr cont)) (while cont + (unless (bolp) + (insert "\n")) (insert "--" mml-boundary "\n") (mml-generate-mime-1 (pop cont))) + (unless (bolp) + (insert "\n")) (insert "--" mml-boundary "--\n"))) (t (error "Invalid element: %S" cont)))) diff --git a/texi/ChangeLog b/texi/ChangeLog index ac7acc7..bdd0655 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,7 @@ +1998-11-18 00:52:46 Lars Magne Ingebrigtsen + + * gnus.texi (MIME Commands): Addition. + 1998-11-07 17:18:07 Lars Magne Ingebrigtsen * gnus.texi (Gnus Reference Guide): Renamed. diff --git a/texi/gnus.texi b/texi/gnus.texi index f6d8bfd..5134631 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.48 Manual +@settitle Pterodactyl Gnus 0.49 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.48 Manual +@title Pterodactyl Gnus 0.49 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.48. +This manual corresponds to Pterodactyl Gnus 0.49. @end ifinfo @@ -6935,6 +6935,27 @@ To have all Vcards be ignored, you'd say something like this: '("text/x-vcard")) @end lisp +@item gnus-article-mime-part-function +@vindex gnus-article-mime-part-function +For each @sc{mime} part, this function will be called with the @sc{mime} +handle as the parameter. The function is meant to be used to allow +users to gather information from the article (e. g., add Vcard info to +the bbdb database) or to do actions based on parts (e. g., automatically +save all jpegs into some directory). + +Here's an example function the does the latter: + +@lisp +(defun my-save-all-jpeg-parts (handle) + (when (equal (car (mm-handle-type handle)) "image/jpeg") + (with-temp-buffer + (insert (mm-get-part handle)) + (write-region (point-min) (point-max) + (read-file-name "Save jpeg to: "))))) +(setq gnus-article-mime-part-function + 'my-save-all-jpeg-parts) +@end lisp + @end table diff --git a/texi/message.texi b/texi/message.texi index 25d797f..6493963 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.48 Manual +@settitle Pterodactyl Message 0.49 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.48 Manual +@title Pterodactyl Message 0.49 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.48. Message is +This manual corresponds to Pterodactyl Message 0.49. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4