X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=3e2d86bc7ea72865d128cfe3a0cd7a01b6cbb241;hb=41fb7027bd9100cf7a76b88761ed42317e11cfa8;hp=d8395e877924c0c5147c23c6bb7a20ea4317c312;hpb=a5997983d79acb8e454e23bbcf9720a4059b942e;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index d8395e8..3e2d86b 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,5 @@ ;;; gnus-art.el --- article mode commands for Semi-gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -55,6 +55,11 @@ :link '(custom-manual "(gnus)The Article Buffer") :group 'gnus) +(defgroup gnus-article-treat nil + "Treating article parts." + :link '(custom-manual "(gnus)Article Hiding") + :group 'gnus-article) + (defgroup gnus-article-hiding nil "Hiding article parts." :link '(custom-manual "(gnus)Article Hiding") @@ -135,7 +140,7 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." :group 'gnus-article-hiding) (defcustom gnus-visible-headers - "From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^\\(Mail-\\)?Followup-To:\\|^\\(Mail-\\)?Reply-To:\\|^Mail-Copies-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:" + "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:" "*All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored." @@ -582,14 +587,13 @@ displayed by the first non-nil matching CONTENT face." ("\205" "...") ("\213" "<") ("\214" "OE") - ("\205" "...") ("\221" "`") ("\222" "'") ("\223" "``") ("\224" "''") ("\225" "*") ("\226" "-") - ("\227" "-") + ("\227" "-") ("\231" "(TM)") ("\233" ">") ("\234" "oe") @@ -606,26 +610,194 @@ displayed by the first non-nil matching CONTENT face." :group 'gnus-article-mime :type '(repeat regexp)) -(defcustom gnus-treat-body-highlight-signature t - "Highlight the signature." - :group 'gnus-article - :type '(choice (const :tag "Off" nil) - (const :tag "On" t) - (const :tag "Last" last) - (integer :tag "Less") - (sexp :tag "Predicate"))) - (defcustom gnus-article-mime-part-function nil - "Function called with a MIME handle as the argument." + "Function called with a MIME handle as the argument. + This is meant for people who want to do something automatic based + on parts -- for instance, adding Vcard info to a database." :group 'gnus-article-mime :type 'function) +;;; +;;; The treatment variables +;;; + +(defvar gnus-article-treat-custom + '(choice (const :tag "Off" nil) + (const :tag "On" t) + (const :tag "Header" head) + (const :tag "Last" last) + (integer :tag "Less") + (sexp :tag "Predicate"))) + +(defvar gnus-article-treat-types '("text/plain") + "Parts to treat.") + +(defvar gnus-inhibit-treatment nil + "Whether to inhibit treatment.") + +(defcustom gnus-treat-highlight-signature 'last + "Highlight the signature." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-buttonize t + "Add buttons." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-buttonize-head 'head + "Add buttons to the head." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-emphasize t + "Emphasize text." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-strip-cr nil + "Remove carriage returns." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-hide-headers 'head + "Hide headers." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-hide-boring-headers nil + "Hide boring headers." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-hide-signature nil + "Hide the signature." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-fill-article nil + "Fill the article." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-hide-citation nil + "Hide cited text." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-strip-pgp t + "Strip PGP signatures." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-strip-pem nil + "Strip PEM signatures." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-highlight-headers 'head + "Highlight the headers." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-highlight-citation t + "Highlight cited text." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-date-ut nil + "Display the Date in UT (GMT)." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-date-local nil + "Display the Date in the local timezone." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-date-lapsed nil + "Display the Date header in a way that says how much time has elapsed." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-date-original nil + "Display the date in the original timezone." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-strip-trailing-blank-lines nil + "Strip trailing blank lines." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-strip-leading-blank-lines nil + "Strip leading blank lines." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-strip-multiple-blank-lines nil + "Strip multiple blank lines." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-strip-blank-lines nil + "Strip all blank lines." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-overstrike t + "Treat overstrike highlighting." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-display-xface (if gnus-xemacs 'head nil) + "Display X-Face headers." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-display-smileys (if gnus-xemacs t nil) + "Display smileys." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-display-picons (if gnus-xemacs 'head nil) + "Display picons." + :group 'gnus-article + :type gnus-article-treat-custom) + ;;; Internal variables (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist - '((gnus-treat-body-highlight-signature gnus-article-highlight-signature nil) - )) + '((gnus-treat-highlight-signature gnus-article-highlight-signature) + (gnus-treat-buttonize gnus-article-add-buttons) + (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) + (gnus-treat-emphasize gnus-article-emphasize) + (gnus-treat-fill-article gnus-article-fill-cited-article) + (gnus-treat-strip-cr gnus-article-remove-cr) + (gnus-treat-hide-headers gnus-article-hide-headers) + (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) + (gnus-treat-hide-signature gnus-article-hide-signature) + (gnus-treat-hide-citation gnus-article-hide-citation) + (gnus-treat-strip-pgp gnus-article-hide-pgp) + (gnus-treat-strip-pem gnus-article-hide-pem) + (gnus-treat-highlight-headers gnus-article-highlight-headers) + (gnus-treat-highlight-citation gnus-article-highlight-citation) + (gnus-treat-highlight-signature gnus-article-highlight-signature) + (gnus-treat-date-ut gnus-article-date-ut) + (gnus-treat-date-local gnus-article-date-local) + (gnus-treat-date-lapsed gnus-article-date-lapsed) + (gnus-treat-date-original gnus-article-date-original) + (gnus-treat-strip-trailing-blank-lines + gnus-article-remove-trailing-blank-lines) + (gnus-treat-strip-leading-blank-lines + gnus-article-strip-leading-blank-lines) + (gnus-treat-strip-multiple-blank-lines + gnus-article-strip-multiple-blank-lines) + (gnus-treat-strip-blank-lines gnus-article-strip-blank-lines) + (gnus-treat-overstrike gnus-article-treat-overstrike) + (gnus-treat-display-xface gnus-article-display-x-face) + (gnus-treat-display-smileys gnus-smiley-display))) (defvar gnus-article-mime-handle-alist nil) (defvar article-lapsed-timer nil) @@ -912,8 +1084,41 @@ always hide." (point-max))) 'boring-headers)))) +(defvar gnus-article-normalized-header-length 40 + "Length of normalized headers.") + +(defun article-normalize-headers () + "Make all header lines 40 characters long." + (interactive) + (let ((buffer-read-only nil) + column) + (save-excursion + (save-restriction + (message-narrow-to-head) + (while (not (eobp)) + (cond + ((< (setq column (- (gnus-point-at-eol) (point))) + gnus-article-normalized-header-length) + (end-of-line) + (insert (make-string + (- gnus-article-normalized-header-length column) + ? ))) + ((> column gnus-article-normalized-header-length) + (gnus-put-text-property + (progn + (forward-char gnus-article-normalized-header-length) + (point)) + (gnus-point-at-eol) + 'invisible t)) + (t + ;; Do nothing. + )) + (forward-line 1)))))) + (defun article-treat-dumbquotes () - "Translate M******** sm*rtq**t*s into proper text." + "Translate M******** sm*rtq**t*s into proper text. +Note that this function guesses whether a character is a sm*rtq**t* or +not, so it should only be used interactively." (interactive) (article-translate-strings gnus-article-dumbquotes-map)) @@ -1075,8 +1280,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (set-buffer gnus-article-buffer) (let ((inhibit-point-motion-hooks t) buffer-read-only - (rfc2047-default-charset gnus-newsgroup-default-charset) - (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (mail-parse-charset gnus-newsgroup-charset)) (mail-decode-encoded-word-region (point-min) (point-max))))) (defun article-decode-charset (&optional prompt) @@ -1098,8 +1302,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (mm-read-coding-system "Charset to decode: ")) (ctl (mail-content-type-get ctl 'charset)))) - (rfc2047-default-charset gnus-newsgroup-default-charset) - (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced) + (mail-parse-charset gnus-newsgroup-charset) buffer-read-only) (goto-char (point-max)) (widen) @@ -1130,9 +1333,7 @@ or not." (save-excursion (let ((buffer-read-only nil) (type (gnus-fetch-field "content-transfer-encoding")) - (charset - (or gnus-newsgroup-default-charset mm-default-coding-system)) - (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (charset gnus-newsgroup-charset)) (when (or force (and type (string-match "quoted-printable" (downcase type)))) (article-goto-body) @@ -1441,7 +1642,9 @@ If TYPE is `local', convert to local time; if it is `lapsed', output how much time has lapsed since DATE." (interactive (list 'ut t)) (let* ((header (or header - (mail-header-date gnus-current-headers) + (mail-header-date (save-excursion + (set-buffer gnus-summary-buffer) + gnus-current-headers)) (message-fetch-field "date") "")) (date (if (vectorp header) (mail-header-date header) @@ -1594,7 +1797,8 @@ function and want to see what the date was before converting." (when (eq major-mode 'gnus-article-mode) (goto-char (point-min)) (when (re-search-forward "^X-Sent:" nil t) - (article-date-lapsed t))))))))) + (article-date-lapsed t)))) + nil 'visible))))) (defun gnus-start-date-timer (&optional n) "Start a timer to update the X-Sent header in the article buffers. @@ -1997,6 +2201,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-date-lapsed article-emphasize article-treat-dumbquotes + article-normalize-headers (article-show-all . gnus-article-show-all-headers)))) ;;; @@ -2030,8 +2235,28 @@ If variable `gnus-use-long-file-name' is non-nil, it is "\M-^" gnus-article-read-summary-keys "\M-g" gnus-article-read-summary-keys) -(substitute-key-definition - 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) +;; Define almost undefined keys to `gnus-article-read-summary-keys'. +(mapcar + (lambda (key) + (unless (lookup-key gnus-article-mode-map key) + (define-key gnus-article-mode-map key + 'gnus-article-read-summary-keys))) + (delq nil + (append + (mapcar + (lambda (elt) + (let ((key (car elt))) + (and (> (length key) 0) + (not (eq 'menu-bar (aref key 0))) + (symbolp (lookup-key gnus-summary-mode-map key)) + key))) + (accessible-keymaps gnus-summary-mode-map)) + (let ((c 127) + keys) + (while (>= c 32) + (push (char-to-string c) keys) + (decf c)) + keys)))) (defun gnus-article-make-menu-bar () (gnus-turn-off-edit-menu 'article) @@ -2161,12 +2386,16 @@ commands: (defun gnus-article-display-mime-message () "Article display method for MIME message." ;; called from `gnus-original-article-buffer'. - (let ((charset (with-current-buffer gnus-summary-buffer - default-mime-charset))) + (let (charset all-headers) + (with-current-buffer gnus-summary-buffer + (setq charset default-mime-charset + all-headers gnus-have-all-headers)) (make-local-variable 'default-mime-charset) (setq default-mime-charset charset) (mime-display-message mime-message-structure gnus-article-buffer nil gnus-article-mode-map) + (when all-headers + (gnus-article-hide-headers nil -1)) (make-local-variable 'default-mime-charset) (setq default-mime-charset charset) ) @@ -2325,6 +2554,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (set-window-point (get-buffer-window (current-buffer)) (point)) t)))))) +;;;###autoload (defun gnus-article-prepare-display () "Make the current buffer look like a nice article." (let ((method @@ -2338,7 +2568,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;; Display message. (funcall method) ;; Associate this article with the current summary buffer. - (setq gnus-article-current-summary (current-buffer)) + (setq gnus-article-current-summary gnus-summary-buffer) ;; Perform the article display hooks. (gnus-run-hooks 'gnus-article-display-hook))) @@ -2346,17 +2576,19 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;;; Gnus MIME viewing functions ;;; -(defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}%e\n" +(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n" "The following specs can be used: %t The MIME type +%T MIME type, along with additional info %n The `name' parameter %d The description, if any %l The length of the encoded part -%p The part identifier +%p The part identifier number %e Dots if the part isn't displayed") (defvar gnus-mime-button-line-format-alist '((?t gnus-tmp-type ?s) + (?T gnus-tmp-type-long ?s) (?n gnus-tmp-name ?s) (?d gnus-tmp-description ?s) (?p gnus-tmp-id ?s) @@ -2383,7 +2615,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (setq gnus-mime-button-map (make-sparse-keymap)) (set-keymap-parent gnus-mime-button-map gnus-article-mode-map) (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button) - (define-key gnus-mime-button-map gnus-mouse-3 'gnus-mime-button-menu) + (define-key gnus-mime-button-map gnus-down-mouse-3 'gnus-mime-button-menu) (mapcar (lambda (c) (define-key gnus-mime-button-map (cadr c) (car c))) gnus-mime-button-commands)) @@ -2391,28 +2623,29 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-button-menu (event) "Construct a context-sensitive menu of MIME commands." (interactive "e") - (gnus-article-check-buffer) - (let ((response (x-popup-menu - t `("MIME Part" - ("" ,@(mapcar (lambda (c) - (cons (caddr c) (car c))) - gnus-mime-button-commands))))) - (pos (event-start event))) - (when response + (save-excursion + (let ((pos (event-start event))) (set-buffer (window-buffer (posn-window pos))) (goto-char (posn-point pos)) - (funcall response)))) - -(defun gnus-mime-view-all-parts () + (gnus-article-check-buffer) + (let ((response (x-popup-menu + t `("MIME Part" + ("" ,@(mapcar (lambda (c) + (cons (caddr c) (car c))) + gnus-mime-button-commands)))))) + (if response + (funcall response)))))) + +(defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." (interactive) (save-current-buffer (set-buffer gnus-article-buffer) - (let ((handles gnus-article-mime-handles) - (rfc2047-default-charset gnus-newsgroup-default-charset) - (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) - (while handles - (mm-display-part (pop handles)))))) + (let ((handles (or handles gnus-article-mime-handles)) + (mail-parse-charset gnus-newsgroup-charset)) + (if (stringp (car handles)) + (gnus-mime-view-all-parts (cdr handles)) + (mapcar 'mm-display-part handles))))) (defun gnus-mime-save-part () "Save the MIME part under point." @@ -2432,8 +2665,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." "Interactively choose a view method for the MIME part under point." (interactive) (gnus-article-check-buffer) - (let ((data (get-text-property (point) 'gnus-data)) - (url-standalone-mode (not gnus-plugged))) + (let ((data (get-text-property (point) 'gnus-data))) (mm-interactively-view-part data))) (defun gnus-mime-copy-part (&optional handle) @@ -2465,7 +2697,6 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-check-buffer) (let* ((data (get-text-property (point) 'gnus-data)) contents - (url-standalone-mode (not gnus-plugged)) (b (point)) buffer-read-only) (if (mm-handle-undisplayer data) @@ -2484,11 +2715,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (url-standalone-mode (not gnus-plugged)) (mm-user-display-methods nil) (mm-all-images-fit t) - (rfc2047-default-charset gnus-newsgroup-default-charset) - (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (mail-parse-charset gnus-newsgroup-charset)) (if (mm-handle-undisplayer handle) (mm-remove-part handle) (mm-display-part handle)))) @@ -2498,10 +2727,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (url-standalone-mode (not gnus-plugged)) - (mm-user-display-methods '(".*")) - (rfc2047-default-charset gnus-newsgroup-default-charset) - (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (mm-user-display-methods '((".*" . inline))) + (mm-all-images-fit t) + (mail-parse-charset gnus-newsgroup-charset)) (if (mm-handle-undisplayer handle) (mm-remove-part handle) (mm-display-part handle)))) @@ -2563,16 +2791,24 @@ If ALL-HEADERS is non-nil, no headers are hidden." handle id (list (not (mm-handle-displayed-p handle)))) (prog1 (let ((window (selected-window)) - (rfc2047-default-charset gnus-newsgroup-default-charset) - (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (mail-parse-charset gnus-newsgroup-charset)) (save-excursion (unwind-protect - (let ((win (get-buffer-window (current-buffer) t))) - (if win - (select-window win)) + (let ((win (get-buffer-window (current-buffer) t)) + (beg (point))) + (when win + (select-window win)) (goto-char point) (forward-line) - (mm-display-part handle)) + (if (mm-handle-displayed-p handle) + (mm-display-part handle) + (save-restriction + (narrow-to-region (point) (1+ (point))) + (mm-display-part handle) + (gnus-treat-article + nil id + (1- (length gnus-article-mime-handles)) + (car (mm-handle-type handle)))))) (select-window window)))) (goto-char point)))) @@ -2583,28 +2819,30 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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)) - (filename (mail-content-type-get (mm-handle-disposition handle) - 'filename)) + (let ((gnus-tmp-name + (or (mail-content-type-get (mm-handle-type handle) + 'name) + (mail-content-type-get (mm-handle-disposition handle) + 'filename) + "")) (gnus-tmp-type (car (mm-handle-type handle))) - (gnus-tmp-description (mm-handle-description handle)) + (gnus-tmp-description + (mail-decode-encoded-word-string (or (mm-handle-description handle) + ""))) (gnus-tmp-dots (if (if displayed (car displayed) (mm-handle-displayed-p handle)) "" "...")) - (gnus-tmp-length (save-excursion - (set-buffer (mm-handle-buffer handle)) + (gnus-tmp-length (with-current-buffer (mm-handle-buffer handle) (buffer-size))) - b e) - (setq gnus-tmp-name (or gnus-tmp-name filename)) - (setq gnus-tmp-name - (if gnus-tmp-name - (concat " (" gnus-tmp-name ")") - "")) - (setq gnus-tmp-description - (if gnus-tmp-description - (concat " (" gnus-tmp-description ")") - "")) + gnus-tmp-type-long b e) + (when (string-match ".*/" gnus-tmp-name) + (setq gnus-tmp-name (replace-match "" t t gnus-tmp-name))) + (setq gnus-tmp-type-long (concat gnus-tmp-type + (and (not (equal gnus-tmp-name "")) + (concat "; " gnus-tmp-name)))) + (or (equal gnus-tmp-description "") + (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) (unless (bolp) (insert "\n")) (setq b (point)) @@ -2617,21 +2855,37 @@ If ALL-HEADERS is non-nil, no headers are hidden." article-type annotation gnus-data ,handle)) (setq e (point)) - (widget-convert-button 'link b e :action 'gnus-widget-press-button - :button-keymap gnus-mime-button-map))) + (widget-convert-button 'link b e + :mime-handle handle + :action 'gnus-widget-press-button + :button-keymap gnus-mime-button-map + :help-echo + (lambda (widget) + ;; Needed to properly clear the message + ;; due to a bug in wid-edit + (setq help-echo-owns-message t) + (format + "Click to %s the MIME part; %s for more options" + (if (mm-handle-displayed-p + (widget-get widget :mime-handle)) + "hide" "show") + (if gnus-xemacs "button3" "mouse-3")))))) (defun gnus-widget-press-button (elems el) (goto-char (widget-get elems :from)) - (let ((url-standalone-mode (not gnus-plugged))) - (gnus-article-press-button))) + (gnus-article-press-button)) (defun gnus-display-mime (&optional ihandles) - "Insert MIME buttons in the buffer." + "Display the MIME parts." (save-excursion (save-selected-window - (let ((window (get-buffer-window gnus-article-buffer))) + (let ((window (get-buffer-window gnus-article-buffer)) + (point (point))) (when window - (select-window window))) + (select-window window) + ;; We have to do this since selecting the window + ;; may change the point. So we set the window point. + (set-window-point window point))) (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) handle name type b e display) (unless ihandles @@ -2642,14 +2896,27 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;; 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. + (if (and handles + (or (not (stringp (car handles))) + (cdr handles))) + (progn + (unless ihandles + ;; Clean up for mime parts. + (article-goto-body) + (delete-region (point) (point-max))) + (gnus-mime-display-part handles)) + (save-restriction + (article-goto-body) + (narrow-to-region (point) (point-max)) + (gnus-treat-article nil 1 1))) + ;; Highlight the headers. + (save-excursion + (save-restriction (article-goto-body) - (delete-region (point) (point-max))) - (gnus-mime-display-part handles)))))) + (narrow-to-region (point-min) (point)) + (gnus-treat-article 'head))))))) + +(defvar gnus-mime-display-multipart-as-mixed nil) (defun gnus-mime-display-part (handle) (cond @@ -2657,12 +2924,14 @@ If ALL-HEADERS is non-nil, no headers are hidden." ((not (stringp (car handle))) (gnus-mime-display-single handle)) ;; multipart/alternative - ((equal (car handle) "multipart/alternative") + ((and (equal (car handle) "multipart/alternative") + (not gnus-mime-display-multipart-as-mixed)) (let ((id (1+ (length gnus-article-mime-handle-alist)))) (push (cons id handle) gnus-article-mime-handle-alist) (gnus-mime-display-alternative (cdr handle) nil nil id))) ;; multipart/related - ((equal (car handle) "multipart/related") + ((and (equal (car handle) "multipart/related") + (not gnus-mime-display-multipart-as-mixed)) ;;;!!!We should find the start part, but we just default ;;;!!!to the first part. (gnus-mime-display-part (cadr handle))) @@ -2689,13 +2958,13 @@ If ALL-HEADERS is non-nil, no headers are hidden." (while ignored (when (string-match (pop ignored) type) (throw 'ignored nil))) - (if (and (mm-automatic-display-p type) - (or (mm-inlinable-part-p type) - (mm-automatic-external-display-p type)) - (setq not-attachment + (if (and (setq not-attachment (or (not (mm-handle-disposition handle)) (equal (car (mm-handle-disposition handle)) - "inline")))) + "inline"))) + (mm-automatic-display-p type) + (or (mm-inlinable-part-p type) + (mm-automatic-external-display-p type))) (setq display t) (when (equal (car (split-string type "/")) "text") @@ -2706,26 +2975,32 @@ If ALL-HEADERS is non-nil, no headers are hidden." (not (gnus-unbuttonized-mime-type-p type))) (gnus-article-insert-newline) (gnus-insert-mime-button - handle id (list (or display - (and not-attachment text)))) + handle id (list (or display (and not-attachment text)))) (gnus-article-insert-newline) (gnus-article-insert-newline) (setq move t))) - (cond - (display - (when move - (forward-line -2)) - (let ((rfc2047-default-charset gnus-newsgroup-default-charset) - (mm-charset-iso-8859-1-forced - gnus-newsgroup-iso-8859-1-forced)) - (mm-display-part handle t)) - (goto-char (point-max))) - ((and text not-attachment) - (when move - (forward-line -2)) - (gnus-article-insert-newline) - (mm-insert-inline handle (mm-get-part handle)) - (goto-char (point-max)))))))) + (let ((beg (point))) + (cond + (display + (when move + (forward-line -2)) + (let ((mail-parse-charset gnus-newsgroup-charset)) + (mm-display-part handle t)) + (goto-char (point-max))) + ((and text not-attachment) + (when move + (forward-line -2)) + (gnus-article-insert-newline) + (mm-insert-inline handle (mm-get-part handle)) + (goto-char (point-max)))) + ;; Do highlighting. + (save-excursion + (save-restriction + (narrow-to-region beg (point)) + (gnus-treat-article + nil (length gnus-article-mime-handle-alist) + (1- (length gnus-article-mime-handles)) + (car (mm-handle-type handle)))))))))) (defun gnus-unbuttonized-mime-type-p (type) "Say whether TYPE is to be unbuttonized." @@ -2790,7 +3065,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-add-text-properties (setq from (point)) (progn - (insert (format "[%c] %-18s" + (insert (format "(%c) %-18s" (if (equal handle preferred) ?* ? ) (if (stringp (car handle)) (car handle) @@ -2817,9 +3092,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (when preferred (if (stringp (car preferred)) (gnus-display-mime preferred) - (let ((rfc2047-default-charset gnus-newsgroup-default-charset) - (mm-charset-iso-8859-1-forced - gnus-newsgroup-iso-8859-1-forced)) + (let ((mail-parse-charset gnus-newsgroup-charset)) (mm-display-part preferred))) (goto-char (point-max)) (setcdr begend (point-marker))))) @@ -2853,9 +3126,11 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-article-maybe-hide-headers () "Hide unwanted headers if `gnus-have-all-headers' is nil. Provided for backwards compatibility." - (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) - gnus-inhibit-hiding - (gnus-article-hide-headers))) + (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer)) + (not (save-excursion (set-buffer gnus-summary-buffer) + gnus-have-all-headers))) + (not gnus-inhibit-hiding)) + (gnus-article-hide-headers))) ;;; Article savers. @@ -2996,8 +3271,7 @@ Argument LINES specifies lines to be scrolled down." (defun gnus-article-describe-briefly () "Describe article mode commands briefly." (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) + (gnus-message 6 (substitute-command-keys "\\\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) (defun gnus-article-summary-command () "Execute the last keystroke in the summary buffer." @@ -3022,7 +3296,7 @@ Argument LINES specifies lines to be scrolled down." (defun gnus-article-check-buffer () "Beep if not in an article buffer." - (unless (equal major-mode 'gnus-article-mode) + (unless (eq (get-buffer gnus-article-buffer) (current-buffer)) (error "Command invoked outside of a Gnus article buffer"))) (defun gnus-article-read-summary-keys (&optional arg key not-restore-window) @@ -4064,8 +4338,8 @@ forbidden in URL encoding." (select-window win))) (defvar gnus-decode-header-methods - '(gnus-decode-with-mail-decode-encoded-word-region) - "List of methods used to decode headers + '(mail-decode-encoded-word-region) + "List of methods used to decode headers. This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a @@ -4080,10 +4354,6 @@ For example: (defvar gnus-decode-header-methods-cache nil) -(defun gnus-decode-with-mail-decode-encoded-word-region (start end) - (let ((rfc2047-default-charset gnus-default-charset)) - (mail-decode-encoded-word-region start end))) - (defun gnus-multi-decode-header (start end) "Apply the functions from `gnus-encoded-word-methods' that match." (unless (and gnus-decode-header-methods-cache @@ -4105,6 +4375,39 @@ For example: (while xlist (funcall (pop xlist) (point-min) (point-max)))))) +;;; +;;; Treatment top-level handling. +;;; + +(defun gnus-treat-article (condition &optional part-number total-parts type) + (let ((length (- (point-max) (point-min))) + (alist gnus-treatment-function-alist) + val elem) + (when (or (not type) + (catch 'found + (let ((list gnus-article-treat-types)) + (while list + (when (string-match (pop list) type) + (throw 'found t)))))) + (while (setq elem (pop alist)) + (setq val (symbol-value (car elem))) + (when (cond + (condition + (eq condition val)) + ((null val) + nil) + ((eq val t) + t) + ((eq val 'head) + nil) + ((eq val 'last) + (eq part-number total-parts)) + ((numberp val) + (< length val)) + (t + (eval val))) + (funcall (cadr elem))))))) + ;;; @ for mime-view ;;; @@ -4118,13 +4421,10 @@ For example: #'gnus-article-header-presentation-method) (defun gnus-mime-preview-quitting-method () - (if gnus-show-mime - (gnus-article-show-summary) - (mime-preview-kill-buffer) - (delete-other-windows) - (gnus-article-show-summary) - (gnus-summary-select-article nil t) - )) + (mime-preview-kill-buffer) + (delete-other-windows) + (gnus-article-show-summary) + (gnus-summary-select-article gnus-show-all-headers t)) (set-alist 'mime-preview-quitting-method-alist 'gnus-original-article-mode #'gnus-mime-preview-quitting-method) @@ -4140,6 +4440,18 @@ For example: (set-alist 'mime-preview-following-method-alist 'gnus-original-article-mode #'gnus-following-method) +(set-alist 'mime-preview-over-to-previous-method-alist + 'gnus-original-article-mode + (lambda () + (gnus-article-read-summary-keys + nil (gnus-character-to-event ?P)))) + +(set-alist 'mime-preview-over-to-next-method-alist + 'gnus-original-article-mode' + (lambda () + (gnus-article-read-summary-keys + nil (gnus-character-to-event ?N)))) + ;;; @ end ;;;