From: yamaoka Date: Wed, 18 Nov 1998 02:34:29 +0000 (+0000) Subject: Sync up with Pterodactyl Gnus 0.49. X-Git-Tag: pgnus-ichikawa-199811302358~36 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=938778412935db3dad9285d576085810024a2e4a;p=elisp%2Fgnus.git- Sync up with Pterodactyl Gnus 0.49. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8cfa5c2..65aa8db 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 e8370c6..8c9a2dc 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -605,6 +605,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 @@ -2393,11 +2398,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." @@ -2411,8 +2416,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)) @@ -2421,7 +2427,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)) @@ -2467,12 +2475,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))) @@ -2484,6 +2499,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)) @@ -2529,57 +2549,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 @@ -2590,16 +2582,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 87538fc..cbbbea5 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -7054,7 +7054,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 4e78d94..6b0cfc4 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -259,10 +259,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.034" +(defconst gnus-version-number "6.10.035" "Version number for this version of gnus.") -(defconst gnus-original-version-number "0.48" +(defconst gnus-original-version-number "0.49" "Version number for this version of Gnus.") (defconst gnus-original-product-name "Pterodactyl Gnus" diff --git a/lisp/message.el b/lisp/message.el index 7fd27bc..192bce3 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -920,6 +920,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_.@-")) @@ -953,7 +965,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 @@ -4727,11 +4741,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")))))) (defvar message-save-buffer " *encoding") (defun message-save-drafts () 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))))