*** pub/pgnus/lisp/gnus-art.el Sun Nov 15 01:11:49 1998 --- pgnus/lisp/gnus-art.el Wed Nov 18 02:20:15 1998 *************** *** 582,587 **** --- 582,592 ---- (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,2327 **** (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)))))) (defun gnus-mm-display-part (handle) "Display HANDLE and fix MIME button." --- 2322,2332 ---- (when (> n (length gnus-article-mime-handle-alist)) (error "No such part")) (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) ! (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,2342 **** (let ((window (selected-window))) (save-excursion (unwind-protect ! (progn ! (select-window (get-buffer-window (current-buffer) t)) (goto-char point) (forward-line) (mm-display-part handle)) --- 2340,2348 ---- (let ((window (selected-window))) (save-excursion (unwind-protect ! (let ((win (get-buffer-window (current-buffer) t))) ! (if win ! (select-window win)) (goto-char point) (forward-line) (mm-display-part handle)) *************** *** 2345,2351 **** (defun gnus-article-goto-part (n) "Go to MIME part N." ! (goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name)) --- 2351,2359 ---- (defun gnus-article-goto-part (n) "Go to MIME 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,2402 **** "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) (goto-char (point-min)) (search-forward "\n\n" nil t) (delete-region (point) (point-max))) --- 2399,2417 ---- "Insert MIME buttons in the buffer." (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) handle name type b e display) ! (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 ! ;; Clean up for mime parts. (goto-char (point-min)) (search-forward "\n\n" nil t) (delete-region (point) (point-max))) *************** *** 2408,2413 **** --- 2423,2433 ---- (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,2509 **** (goto-char (point-max)))))))) (defun gnus-mime-display-alternative (handles &optional preferred ibegend id) ! (let* ((preferred (mm-preferred-alternative handles preferred)) (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)) (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 ,(if (stringp (car handle)) ! (car handle) ! (car (mm-handle-type handle))) ',begend ,id)) local-map ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face --- 2473,2501 ---- (goto-char (point-max)))))))) (defun gnus-mime-display-alternative (handles &optional preferred ibegend id) ! (let* ((preferred (or preferred (mm-preferred-alternative handles))) (ihandles handles) (point (point)) handle buffer-read-only from props begend not-pref) ! (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 "%d. " id)) (point)) `(gnus-callback (lambda (handles) (gnus-mime-display-alternative ! ',ihandles ',not-pref ',begend ,id)) local-map ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face *************** *** 2514,2529 **** (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." --- 2506,2546 ---- (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)) ! (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." *** pub/pgnus/lisp/gnus-setup.el Sat Aug 29 19:53:58 1998 --- pgnus/lisp/gnus-setup.el Wed Nov 18 02:20:15 1998 *************** *** 65,72 **** "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 --- 65,70 ---- *************** *** 88,106 **** ;;; 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 --- 86,91 ---- *** pub/pgnus/lisp/gnus-sum.el Sun Nov 15 01:11:50 1998 --- pgnus/lisp/gnus-sum.el Wed Nov 18 02:20:16 1998 *************** *** 7072,7078 **** gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article to-newsgroup (list 'quote select-method) ! (not articles)) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. ((eq action 'copy) --- 7072,7078 ---- gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article to-newsgroup (list 'quote select-method) ! (not articles) t) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. ((eq action 'copy) *** pub/pgnus/lisp/gnus.el Mon Nov 16 01:56:41 1998 --- pgnus/lisp/gnus.el Wed Nov 18 02:20:16 1998 *************** *** 254,260 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.48" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) --- 254,260 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.49" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) *** pub/pgnus/lisp/message.el Mon Nov 16 01:56:41 1998 --- pgnus/lisp/message.el Wed Nov 18 02:20:17 1998 *************** *** 789,794 **** --- 789,806 ---- "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,825 **** (,(concat "^[ \t]*" "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[:>|}].*") ! (0 'message-cited-text-face)))) "Additional expressions to highlight in Message mode.") ;; XEmacs does it like this. For Emacs, we have to set the --- 831,839 ---- (,(concat "^[ \t]*" "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[:>|}].*") ! (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,4126 **** (delete-region beg (point)) (insert "Mime-Version: 1.0\n") (search-forward "\n\n") (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")))))) (run-hooks 'message-load-hook) --- 4130,4141 ---- (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")))))) (run-hooks 'message-load-hook) *** pub/pgnus/lisp/mm-view.el Sun Nov 15 01:11:51 1998 --- pgnus/lisp/mm-view.el Wed Nov 18 02:20:17 1998 *************** *** 84,89 **** --- 84,90 ---- (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)))))) *** pub/pgnus/lisp/mml.el Sun Nov 15 21:59:17 1998 --- pgnus/lisp/mml.el Wed Nov 18 02:20:17 1998 *************** *** 84,94 **** (defun mml-read-part () "Return the buffer up till the next part, multipart or closing part or multipart." (let ((beg (point))) (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)))) (buffer-substring beg (goto-char (point-max)))))) (defvar mml-boundary nil) --- 84,99 ---- (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)) ! (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,136 **** ((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") (setq charset (mm-encode-body) encoding (mm-body-encoding)) ! (setq encoding (mm-encode-buffer type))) ! (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") (unless (eq encoding '7bit) (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") --- 115,146 ---- ((eq (car cont) 'part) (let (coded encoding charset filename type) (setq type (or (cdr (assq 'type cont)) "text/plain")) ! (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 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")) (unless (eq encoding '7bit) (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") *************** *** 143,150 **** --- 153,164 ---- (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)))) *** pub/pgnus/lisp/ChangeLog Mon Nov 16 01:56:41 1998 --- pgnus/lisp/ChangeLog Wed Nov 18 02:20:15 1998 *************** *** 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. *** pub/pgnus/texi/gnus.texi Mon Nov 16 01:56:43 1998 --- pgnus/texi/gnus.texi Wed Nov 18 02:20:19 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.48 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.49 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 318,324 **** @tex @titlepage ! @title Pterodactyl Gnus 0.48 Manual @author by Lars Magne Ingebrigtsen @page --- 318,324 ---- @tex @titlepage ! @title Pterodactyl Gnus 0.49 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 354,360 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.48. @end ifinfo --- 354,360 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.49. @end ifinfo *************** *** 6933,6938 **** --- 6933,6959 ---- @lisp (setq gnus-ignored-mime-types '("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 *** pub/pgnus/texi/message.texi Mon Nov 16 01:56:43 1998 --- pgnus/texi/message.texi Wed Nov 18 02:20:19 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.48 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.49 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Pterodactyl Message 0.48 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Pterodactyl Message 0.49 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 83,89 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.48. Message is distributed with the Gnus distribution bearing the same version number as this manual. --- 83,89 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.49. Message is distributed with the Gnus distribution bearing the same version number as this manual. *** pub/pgnus/texi/ChangeLog Sun Nov 8 01:04:41 1998 --- pgnus/texi/ChangeLog Wed Nov 18 02:20:19 1998 *************** *** 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.