X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=43c03ec1d9d56717c3ea19c4af518dc2ce7d8649;hb=277cfbcdf4d715e60e84f17f3f1c70c55d26b47a;hp=1ca24008bc4660ca3ffb5f6910a8e0672efc8b5a;hpb=3266dac7539fae767b75efacc04152c496c92185;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 1ca24008b..43c03ec1d 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -126,7 +126,10 @@ "^List-[A-Za-z]+:" "^X-Listprocessor-Version:" "^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:" "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:" - "^X-Received:" "^Content-length:" "X-precedence:") + "^X-Received:" "^Content-length:" "X-precedence:" + "^X-Authenticated-User:" "^X-Comment" "^X-Report:" "^X-Abuse-Info:" + "^X-HTTP-Proxy:" "^X-Mydeja-Info:" "^X-Copyright" "^X-No-Markup:" + "^X-Abuse-Info:") "*All headers that start with this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." @@ -224,19 +227,32 @@ asynchronously. The compressed face will be piped to this command." (defcustom gnus-article-banner-alist nil "Banner alist for stripping. -For example, +For example, ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" :version "21.1" :type '(repeat (cons symbol regexp)) :group 'gnus-article-washing) -(defcustom gnus-article-banner-alist nil - "Banner alist for stripping. -For example, - ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" - :version "21.1" - :type '(repeat (cons symbol regexp)) - :group 'gnus-article-washing) +(gnus-define-group-parameter + banner + :variable-document + "Alist of regexps (to match group names) and banner." + :variable-group gnus-article-washing + :parameter-type + '(choice :tag "Banner" + :value nil + (const :tag "Remove signature" signature) + (symbol :tag "Item in `gnus-article-banner-alist'" none) + regexp + (const :tag "None" nil)) + :parameter-document + "If non-nil, specify how to remove `banners' from articles. + +Symbol `signature' means to remove signatures delimited by +`gnus-signature-separator'. Any other symbol is used to look up a +regular expression to match the banner in `gnus-article-banner-alist'. +A string is used as a regular expression to match the banner +directly.") (defcustom gnus-emphasis-alist (let ((format @@ -454,6 +470,13 @@ The following additional specs are available: :type 'hook :group 'gnus-article-various) +(when (featurep 'xemacs) + ;; Extracted from gnus-xmas-define in order to preserve user settings + (when (fboundp 'turn-off-scroll-in-place) + (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) + ;; Extracted from gnus-xmas-redefine in order to preserve user settings + (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)) + (defcustom gnus-article-menu-hook nil "*Hook run after the creation of the article mode menu." :type 'hook @@ -661,17 +684,17 @@ be added below it (otherwise)." (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative "Function called with a MIME handle as the argument. This is meant for people who want to view first matched part. -For `undisplayed-alternative' (default), the first undisplayed -part or alternative part is used. For `undisplayed', the first -undisplayed part is used. For a function, the first part which +For `undisplayed-alternative' (default), the first undisplayed +part or alternative part is used. For `undisplayed', the first +undisplayed part is used. For a function, the first part which the function return `t' is used. For `nil', the first part is used." :version "21.1" :group 'gnus-article-mime - :type '(choice + :type '(choice (item :tag "first" :value nil) (item :tag "undisplayed" :value undisplayed) - (item :tag "undisplayed or alternative" + (item :tag "undisplayed or alternative" :value undisplayed-alternative) (function))) @@ -756,7 +779,11 @@ See the manual for details." :type gnus-article-treat-head-custom) (put 'gnus-treat-buttonize-head 'highlight t) -(defcustom gnus-treat-emphasize 50000 +(defcustom gnus-treat-emphasize + (and (or window-system + (featurep 'xemacs) + (>= (string-to-number emacs-version) 21)) + 50000) "Emphasize text. Valid values are nil, t, `head', `last', an integer or a predicate. See the manual for details." @@ -880,6 +907,13 @@ See the manual for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) +(defcustom gnus-treat-date-english nil + "Display the Date in a format that can be read aloud in English. +Valid values are nil, t, `head', `last', an integer or a predicate. +See the manual for details." + :group 'gnus-article-treat + :type gnus-article-treat-head-custom) + (defcustom gnus-treat-date-lapsed nil "Display the Date header in a way that says how much time has elapsed. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -947,7 +981,7 @@ See the manual for details." :type gnus-article-treat-custom) (put 'gnus-treat-overstrike 'highlight t) -(defcustom gnus-treat-display-xface +(defcustom gnus-treat-display-xface (and (or (and (fboundp 'image-type-available-p) (image-type-available-p 'xbm) (string-match "^0x" (shell-command-to-string "uncompface"))) @@ -960,7 +994,7 @@ See the manual for details." :type gnus-article-treat-head-custom) (put 'gnus-treat-display-xface 'highlight t) -(defcustom gnus-treat-display-smileys +(defcustom gnus-treat-display-smileys (if (or (and (featurep 'xemacs) (featurep 'xpm)) (and (fboundp 'image-type-available-p) @@ -1034,6 +1068,10 @@ It is a string, such as \"PGP\". If nil, ask user." ;;; Internal variables +(defvar gnus-english-month-names + '("January" "February" "March" "April" "May" "June" "July" "August" + "September" "October" "November" "December")) + (defvar article-goto-body-goes-to-point-min-p nil) (defvar gnus-article-wash-types nil) (defvar gnus-article-emphasis-alist nil) @@ -1050,6 +1088,13 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-strip-cr gnus-article-remove-cr) (gnus-treat-emphasize gnus-article-emphasize) (gnus-treat-display-xface gnus-article-display-x-face) + (gnus-treat-date-ut gnus-article-date-ut) + (gnus-treat-date-local gnus-article-date-local) + (gnus-treat-date-english gnus-article-date-english) + (gnus-treat-date-lapsed gnus-article-date-lapsed) + (gnus-treat-date-original gnus-article-date-original) + (gnus-treat-date-user-defined gnus-article-date-user) + (gnus-treat-date-iso8601 gnus-article-date-iso8601) (gnus-treat-hide-headers gnus-article-maybe-hide-headers) (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) (gnus-treat-hide-signature gnus-article-hide-signature) @@ -1061,12 +1106,6 @@ It is a string, such as \"PGP\". If nil, ask user." (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-date-user-defined gnus-article-date-user) - (gnus-treat-date-iso8601 gnus-article-date-iso8601) (gnus-treat-strip-trailing-blank-lines gnus-article-remove-trailing-blank-lines) (gnus-treat-strip-leading-blank-lines @@ -1087,7 +1126,7 @@ It is a string, such as \"PGP\". If nil, ask user." (defvar gnus-article-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) ;; This causes the citation match run O(2^n). - ;; (modify-syntax-entry ?- "w" table) + ;; (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?> ")" table) (modify-syntax-entry ?< "(" table) table) @@ -1377,7 +1416,7 @@ not, so it should only be used interactively. Sm*rtq**t*s are M****s***'s unilateral extension to the character map in an attempt to provide more quoting characters. If you see -something like \222 or \264 where you're expecting some kind of +something like \\222 or \\264 where you're expecting some kind of apostrophe or quotation mark, then try this wash." (interactive) (article-translate-strings gnus-article-dumbquotes-map)) @@ -1504,11 +1543,26 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (delete-process "article-x-face")) (let ((inhibit-point-motion-hooks t) (case-fold-search t) + (x-faces "") from last) + (when (gnus-buffer-live-p gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer + (save-restriction + (article-narrow-to-head) + (while (re-search-forward "^X-Face:" nil t) + (setq x-faces + (concat + x-faces + (buffer-substring (match-beginning 0) + (1- (re-search-forward + "^\\($\\|[^ \t]\\)" nil t))))))))) (save-restriction (article-narrow-to-head) - (goto-char (point-min)) (setq from (message-fetch-field "from")) + (when (gnus-buffer-live-p gnus-original-article-buffer) + (message-remove-header "X-Face") + (goto-char (point-min)) + (insert x-faces)) (goto-char (point-min)) (while (and gnus-article-x-face-command (not last) @@ -1519,7 +1573,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (not (string-match gnus-article-x-face-too-ugly from)))) ;; Has to be present. - (re-search-forward "^X-Face: " nil t)) + (re-search-forward "^X-Face:[\t ]*" nil t)) ;; This used to try to do multiple faces (`while' instead of ;; `when' above), but (a) sending multiple EOFs to xv doesn't ;; work (b) it can crash some versions of Emacs (c) are @@ -1554,7 +1608,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (let ((inhibit-point-motion-hooks t) buffer-read-only (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (mail-decode-encoded-word-region (point-min) (point-max))))) @@ -1566,7 +1620,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (let ((inhibit-point-motion-hooks t) (case-fold-search t) buffer-read-only (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (condition-case nil (set-buffer gnus-summary-buffer) (error)) @@ -1587,7 +1641,7 @@ If PROMPT (the prefix), prompt for a coding system to use." format (and ctl (mail-content-type-get ctl 'format))) (when cte (setq cte (mail-header-strip cte))) - (if (and ctl (not (string-match "/" (car ctl)))) + (if (and ctl (not (string-match "/" (car ctl)))) (setq ctl nil)) (goto-char (point-max))) (forward-line 1) @@ -1609,7 +1663,7 @@ If PROMPT (the prefix), prompt for a coding system to use." "Remove encoded-word encoding from headers." (let ((inhibit-point-motion-hooks t) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (condition-case nil (set-buffer gnus-summary-buffer) (error)) @@ -1631,14 +1685,14 @@ or not." (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct + (ctl (and ct (ignore-errors (mail-header-parse-content-type ct))))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) (setq charset (intern (downcase charset))))))) - (unless charset + (unless charset (setq charset gnus-newsgroup-charset)) (when (or force (and type (let ((case-fold-search t)) @@ -1658,14 +1712,14 @@ If FORCE, decode the article whether it is marked as base64 not." (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct + (ctl (and ct (ignore-errors (mail-header-parse-content-type ct))))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) (setq charset (intern (downcase charset))))))) - (unless charset + (unless charset (setq charset gnus-newsgroup-charset)) (when (or force (and type (let ((case-fold-search t)) @@ -1697,14 +1751,14 @@ If FORCE, decode the article whether it is marked as base64 not." (if (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct + (ctl (and ct (ignore-errors (mail-header-parse-content-type ct))))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) (setq charset (intern (downcase charset))))))) - (unless charset + (unless charset (setq charset gnus-newsgroup-charset)) (article-goto-body) (save-window-excursion @@ -1731,7 +1785,7 @@ The `gnus-list-identifiers' variable specifies what to do." (when regexp (goto-char (point-min)) (when (re-search-forward - (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp + (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp " *\\)\\)+\\(Re: +\\)?\\)") nil t) (let ((s (or (match-string 3) (match-string 5)))) @@ -1809,7 +1863,7 @@ always hide." (save-excursion (save-restriction (let ((inhibit-point-motion-hooks t) - (banner (gnus-group-find-parameter gnus-newsgroup-name 'banner)) + (banner (gnus-parameter-banner gnus-newsgroup-name)) (gnus-signature-limit nil) buffer-read-only beg end) (when banner @@ -2018,10 +2072,13 @@ means show, 0 means toggle." (> arg 0)) nil) ((< arg 0) - (gnus-article-show-hidden-text type)) + (gnus-article-show-hidden-text type) + t) (t (if (eq hide 'hidden) - (gnus-article-show-hidden-text type) + (progn + (gnus-article-show-hidden-text type) + t) nil))))))) (defun gnus-article-hidden-text-p (type) @@ -2041,9 +2098,9 @@ means show, 0 means toggle." Originally it is hide instead of DUMMY." (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) - (gnus-remove-text-properties-when + (gnus-remove-text-properties-when 'article-type type - (point-min) (point-max) + (point-min) (point-max) (cons 'article-type (cons type gnus-hidden-properties))))) @@ -2131,7 +2188,7 @@ should replace the \"Date:\" one, or should be added below it." ((eq type 'local) (let ((tz (car (current-time-zone time)))) (format "Date: %s %s%02d%02d" (current-time-string time) - (if (> tz 0) "+" "-") (/ (abs tz) 3600) + (if (> tz 0) "+" "-") (/ (abs tz) 3600) (/ (% (abs tz) 3600) 60)))) ;; Convert to Universal Time. ((eq type 'ut) @@ -2164,7 +2221,7 @@ should replace the \"Date:\" one, or should be added below it." "Date: " (format-time-string "%Y%m%dT%H%M%S" time) (format "%s%02d%02d" - (if (> tz 0) "+" "-") (/ (abs tz) 3600) + (if (> tz 0) "+" "-") (/ (abs tz) 3600) (/ (% (abs tz) 3600) 60))))) ;; Do an X-Sent lapsed format. ((eq type 'lapsed) @@ -2209,6 +2266,27 @@ should replace the \"Date:\" one, or should be added below it." (if (> real-sec 0) " ago" " in the future")))))) + ;; Display the date in proper English + ((eq type 'english) + (let ((dtime (decode-time time))) + (concat + "Date: the " + (number-to-string (nth 3 dtime)) + (let ((digit (% (nth 3 dtime) 10))) + (cond + ((memq (nth 3 dtime) '(11 12 13)) "th") + ((= digit 1) "st") + ((= digit 2) "nd") + ((= digit 3) "rd") + (t "th"))) + " of " + (nth (1- (nth 4 dtime)) gnus-english-month-names) + " " + (number-to-string (nth 5 dtime)) + " at " + (format "%02d" (nth 2 dtime)) + ":" + (format "%02d" (nth 1 dtime))))) (t (error "Unknown conversion type: %s" type))))) @@ -2217,6 +2295,11 @@ should replace the \"Date:\" one, or should be added below it." (interactive (list t)) (article-date-ut 'local highlight)) +(defun article-date-english (&optional highlight) + "Convert the current article date to something that is proper English." + (interactive (list t)) + (article-date-ut 'english highlight)) + (defun article-date-original (&optional highlight) "Convert the current article date to what it was originally. This is only useful if you have used some other date conversion @@ -2284,10 +2367,10 @@ This format is defined by the `gnus-article-time-format' variable." (interactive (gnus-article-hidden-arg)) (unless (gnus-article-check-hidden-text 'emphasis arg) (save-excursion - (let ((alist (or + (let ((alist (or (condition-case nil - (with-current-buffer gnus-summary-buffer - gnus-article-emphasis-alist) + (with-current-buffer gnus-summary-buffer + gnus-article-emphasis-alist) (error)) gnus-emphasis-alist)) (buffer-read-only nil) @@ -2319,8 +2402,8 @@ This format is defined by the `gnus-article-time-format' variable." (let ((name (and gnus-newsgroup-name (gnus-group-real-name gnus-newsgroup-name)))) (make-local-variable 'gnus-article-emphasis-alist) - (setq gnus-article-emphasis-alist - (nconc + (setq gnus-article-emphasis-alist + (nconc (let ((alist gnus-group-highlight-words-alist) elem highlight) (while (setq elem (pop alist)) (when (and name (string-match (car elem) name)) @@ -2329,7 +2412,7 @@ This format is defined by the `gnus-article-time-format' variable." highlight) (copy-sequence highlight-words) (if gnus-newsgroup-name - (copy-sequence (gnus-group-find-parameter + (copy-sequence (gnus-group-find-parameter gnus-newsgroup-name 'highlight-words t))) gnus-emphasis-alist))))) @@ -2619,7 +2702,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (let ((sig (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "X-PGP-Sig"))) items info headers) - (when (and sig + (when (and sig mml2015-use (mml2015-clear-verify-function)) (with-temp-buffer @@ -2630,7 +2713,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (case-fold-search t)) ;; Don't verify multiple headers. (setq headers (mapconcat (lambda (header) - (concat header ": " + (concat header ": " (mail-fetch-field header) "\n")) (split-string (nth 1 items) ",") ""))) (delete-region (point-min) (point-max)) @@ -2652,10 +2735,10 @@ If variable `gnus-use-long-file-name' is non-nil, it is (let ((coding-system-for-write (or gnus-newsgroup-charset 'iso-8859-1))) (funcall (mml2015-clear-verify-function))) - (setq info - (or (mm-handle-multipart-ctl-parameter + (setq info + (or (mm-handle-multipart-ctl-parameter mm-security-handle 'gnus-details) - (mm-handle-multipart-ctl-parameter + (mm-handle-multipart-ctl-parameter mm-security-handle 'gnus-info))))) (when info (let (buffer-read-only bface eface) @@ -2731,6 +2814,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-strip-blank-lines article-strip-all-blank-lines article-date-local + article-date-english article-date-iso8601 article-date-original article-date-ut @@ -2779,7 +2863,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (substitute-key-definition 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) -(eval-when-compile +(eval-when-compile (defvar gnus-article-commands-menu)) (defun gnus-article-make-menu-bar () @@ -2898,7 +2982,7 @@ commands: (mm-destroy-parts gnus-article-mime-handles) (setq gnus-article-mime-handles nil)) ;; Set it to nil in article-buffer! - (setq gnus-article-mime-handle-alist nil) + (setq gnus-article-mime-handle-alist nil) (buffer-disable-undo) (setq buffer-read-only t) (unless (eq major-mode 'gnus-article-mode) @@ -3095,8 +3179,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) - ;; Not for Emacs 21: fixme better. - ;; (set-keymap-parent map gnus-article-mode-map) + (unless (>= (string-to-number emacs-version) 21) + ;; XEmacs doesn't care. + (set-keymap-parent map gnus-article-mode-map)) (define-key map gnus-mouse-2 'gnus-article-push-button) (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) (dolist (c gnus-mime-button-commands) @@ -3126,7 +3211,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (set-buffer gnus-article-buffer) (let ((handles (or handles gnus-article-mime-handles)) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets))) (when handles @@ -3141,7 +3226,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." "Save the MIME part under point then replace it with an external body." (interactive) (gnus-article-check-buffer) - (let* ((data (get-text-property (point) 'gnus-data)) + (let* ((data (get-text-property (point) 'gnus-data)) (file (and data (mm-save-part data))) param) (when file @@ -3155,17 +3240,17 @@ If ALL-HEADERS is non-nil, no headers are hidden." (insert "Content-Transfer-Encoding: binary\n") (insert "\n")) (setcdr data - (cdr (mm-make-handle nil + (cdr (mm-make-handle nil `("message/external-body" (access-type . "LOCAL-FILE") (name . ,file))))) (set-buffer gnus-summary-buffer) (gnus-article-edit-article - `(lambda () + `(lambda () (erase-buffer) - (let ((mail-parse-charset (or gnus-article-charset + (let ((mail-parse-charset (or gnus-article-charset ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (or gnus-article-ignored-charsets ',gnus-newsgroup-ignored-charsets)) (mbl mml-buffer-list)) @@ -3183,17 +3268,17 @@ If ALL-HEADERS is non-nil, no headers are hidden." ',gnus-newsgroup-charset)) (message-options message-options) (message-options-set-recipient) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (or gnus-article-ignored-charsets ',gnus-newsgroup-ignored-charsets))) (mml-to-mime) (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook + (remove-hook 'kill-buffer-hook 'mml-destroy-buffers t) (kill-local-variable 'mml-buffer-list)) (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) + ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))) (defun gnus-mime-save-part () @@ -3218,6 +3303,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (when data + (push (setq data (copy-sequence data)) gnus-article-mime-handles) (mm-interactively-view-part data)))) (defun gnus-mime-view-part-as-type-internal () @@ -3228,34 +3314,37 @@ If ALL-HEADERS is non-nil, no headers are hidden." (def-type (and name (mm-default-file-encoding name)))) (and def-type (cons def-type 0)))) -(defun gnus-mime-view-part-as-type (mime-type) +(defun gnus-mime-view-part-as-type (&optional mime-type) "Choose a MIME media type, and view the part as such." - (interactive - (list (completing-read - "View as MIME type: " - (mapcar #'list (mailcap-mime-types)) - nil nil - (gnus-mime-view-part-as-type-internal)))) + (interactive) + (unless mime-type + (setq mime-type (completing-read + "View as MIME type: " + (mapcar #'list (mailcap-mime-types)) + nil nil + (gnus-mime-view-part-as-type-internal)))) (gnus-article-check-buffer) (let ((handle (get-text-property (point) 'gnus-data))) (when handle - (gnus-mm-display-part - (mm-make-handle (mm-handle-buffer handle) - (cons mime-type (cdr (mm-handle-type handle))) - (mm-handle-encoding handle) - (mm-handle-undisplayer handle) - (mm-handle-disposition handle) - (mm-handle-description handle) - (mm-handle-cache handle) - (mm-handle-id handle)))))) - + (setq handle + (mm-make-handle (mm-handle-buffer handle) + (cons mime-type (cdr (mm-handle-type handle))) + (mm-handle-encoding handle) + (mm-handle-undisplayer handle) + (mm-handle-disposition handle) + (mm-handle-description handle) + (mm-handle-cache handle) + (mm-handle-id handle))) + (push handle gnus-article-mime-handles) + (gnus-mm-display-part handle)))) + (defun gnus-mime-copy-part (&optional handle) "Put the the MIME part under point into a new buffer." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (and handle (mm-get-part handle))) - (base (and handle + (base (and handle (file-name-nondirectory (or (mail-content-type-get (mm-handle-type handle) 'name) @@ -3295,13 +3384,13 @@ If ALL-HEADERS is non-nil, no headers are hidden." (if (mm-handle-undisplayer handle) (mm-remove-part handle)) (setq charset - (or (cdr (assq arg + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (read-coding-system "Charset: "))))) (forward-line 2) (mm-insert-inline handle - (if (and charset - (setq charset (mm-charset-to-coding-system + (if (and charset + (setq charset (mm-charset-to-coding-system charset)) (not (eq charset 'ascii))) (mm-decode-coding-string contents charset) @@ -3320,7 +3409,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (if (mm-handle-undisplayer handle) (mm-remove-part handle)) (let ((gnus-newsgroup-charset - (or (cdr (assq arg + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (read-coding-system "Charset: "))) (gnus-newsgroup-ignored-charsets 'gnus-all)) @@ -3334,7 +3423,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mm-user-display-methods nil) (mm-inlined-types nil) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (when handle @@ -3351,7 +3440,7 @@ In no internal viewer is available, use an external viewer." (mm-inlined-types '(".*")) (mm-inline-large-images t) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (when handle @@ -3416,10 +3505,10 @@ In no internal viewer is available, use an external viewer." (if condition (let ((alist gnus-article-mime-handle-alist) ihandle n) (while (setq ihandle (pop alist)) - (if (and (cond + (if (and (cond ((functionp condition) (funcall condition (cdr ihandle))) - ((eq condition 'undisplayed) + ((eq condition 'undisplayed) (not (or (mm-handle-undisplayer (cdr ihandle)) (equal (mm-handle-media-type (cdr ihandle)) "multipart/alternative")))) @@ -3437,7 +3526,7 @@ In no internal viewer is available, use an external viewer." (interactive "P") (save-current-buffer (set-buffer gnus-article-buffer) - (or (numberp n) (setq n (gnus-article-mime-match-handle-first + (or (numberp n) (setq n (gnus-article-mime-match-handle-first gnus-article-mime-match-handle-function))) (when (> n (length gnus-article-mime-handle-alist)) (error "No such part")) @@ -3462,7 +3551,7 @@ In no internal viewer is available, use an external viewer." (prog1 (let ((window (selected-window)) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (save-excursion @@ -3535,7 +3624,7 @@ In no internal viewer is available, use an external viewer." gnus-mime-button-line-format gnus-mime-button-line-format-alist `(keymap ,gnus-mime-button-map ,@(if (>= (string-to-number emacs-version) 21) - nil + nil (list 'local-map gnus-mime-button-map)) gnus-callback gnus-mm-display-part gnus-part ,gnus-tmp-id @@ -3644,9 +3733,11 @@ In no internal viewer is available, use an external viewer." ;;;!!!to the first part. ;;(gnus-mime-display-part (cadr handle)) ;;;!!! Most multipart/related is an HTML message plus images. - ;;;!!! Unfortunately we are unable to let W3 display those + ;;;!!! Unfortunately we are unable to let W3 display those ;;;!!! included images, so we just display it as a mixed multipart. - (gnus-mime-display-mixed (cdr handle))) + ;;(gnus-mime-display-mixed (cdr handle)) + ;;;!!! No, w3 can display everything just fine. + (gnus-mime-display-part (cadr handle))) ((equal (car handle) "multipart/signed") (or (memq 'signed gnus-article-wash-types) (push 'signed gnus-article-wash-types)) @@ -3698,8 +3789,8 @@ In no internal viewer is available, use an external viewer." ;(gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display (and not-attachment text)))) - (gnus-article-insert-newline) - ;(gnus-article-insert-newline) + (gnus-article-insert-newline) + ;(gnus-article-insert-newline) ;; Remember modify the number of forward lines. (setq move t)) (setq beg (point)) @@ -3709,7 +3800,7 @@ In no internal viewer is available, use an external viewer." (forward-line -1) (setq beg (point))) (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (condition-case () (set-buffer gnus-summary-buffer) (error)) @@ -3728,7 +3819,7 @@ In no internal viewer is available, use an external viewer." (save-restriction (narrow-to-region beg (point)) (gnus-treat-article - nil id + nil id (gnus-article-mime-total-parts) (mm-handle-media-type handle))))))))) @@ -3826,7 +3917,7 @@ In no internal viewer is available, use an external viewer." (if (stringp (car preferred)) (gnus-display-mime preferred) (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (mm-display-part preferred) @@ -4065,7 +4156,7 @@ Argument LINES specifies lines to be scrolled down." (setq keys (if (featurep 'xemacs) (events-to-keys (read-key-sequence nil)) (read-key-sequence nil))))) - + (message "") (if (or (member keys nosaves) @@ -4271,7 +4362,7 @@ If given a prefix, show the hidden text instead." ((or (stringp article) (numberp article)) (let ((gnus-override-method gnus-override-method) - (methods (and (stringp article) + (methods (and (stringp article) gnus-refer-article-method)) result (buffer-read-only nil)) @@ -4291,7 +4382,7 @@ If given a prefix, show the hidden text instead." (gnus-check-group-server)) (when (gnus-request-article article group (current-buffer)) (when (numberp article) - (gnus-async-prefetch-next group article + (gnus-async-prefetch-next group article gnus-summary-buffer) (when gnus-keep-backlog (gnus-backlog-enter-article @@ -5113,11 +5204,11 @@ For example: (defun gnus-article-encrypt-body (protocol &optional n) "Encrypt the article body." - (interactive + (interactive (list (or gnus-article-encrypt-protocol (completing-read "Encrypt protocol: " - gnus-article-encrypt-protocol-alist + gnus-article-encrypt-protocol-alist nil t)) current-prefix-arg)) (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist)))) @@ -5144,7 +5235,7 @@ For example: (let* ((buffer-read-only nil) (headers (mapcar (lambda (field) - (and (save-restriction + (and (save-restriction (message-narrow-to-head) (goto-char (point-min)) (search-forward field nil t)) @@ -5205,8 +5296,8 @@ For example: (defvar gnus-mime-security-button-map (let ((map (make-sparse-keymap))) - ;; Not for Emacs 21: fixme better. - ;;(set-keymap-parent map gnus-article-mode-map) + (unless (>= (string-to-number emacs-version) 21) + (set-keymap-parent map gnus-article-mode-map)) (define-key map gnus-mouse-2 'gnus-article-push-button) (define-key map "\r" 'gnus-article-press-button) map)) @@ -5222,7 +5313,7 @@ For example: (mm-remove-parts (cdr handle)) (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region)) buffer-read-only) - (when region + (when region (delete-region (car region) (cdr region)) (set-marker (car region) nil) (set-marker (cdr region) nil))) @@ -5243,7 +5334,7 @@ For example: (if details (if gnus-mime-security-show-details-inline (let ((gnus-mime-security-button-pressed t) - (gnus-mime-security-button-line-format + (gnus-mime-security-button-line-format (get-text-property (point) 'gnus-line-format)) buffer-read-only) (forward-char -1) @@ -5252,9 +5343,9 @@ For example: (forward-char -1)) (forward-char) (delete-region (point) - (or (text-property-not-all + (or (text-property-not-all (point) (point-max) - 'gnus-line-format + 'gnus-line-format gnus-mime-security-button-line-format) (point-max))) (gnus-insert-mime-security-button handle)) @@ -5278,7 +5369,7 @@ For example: (defun gnus-insert-mime-security-button (handle &optional displayed) (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) (gnus-tmp-type - (concat + (concat (or (nth 2 (assoc protocol mm-verify-function-alist)) (nth 2 (assoc protocol mm-decrypt-function-alist)) "Unknown") @@ -5295,20 +5386,20 @@ For example: (setq gnus-tmp-details (if gnus-tmp-details (concat "\n" gnus-tmp-details) "")) - (setq gnus-tmp-pressed-details + (setq gnus-tmp-pressed-details (if gnus-mime-security-button-pressed gnus-tmp-details "")) (unless (bolp) (insert "\n")) (setq b (point)) (gnus-eval-format - gnus-mime-security-button-line-format + gnus-mime-security-button-line-format gnus-mime-security-button-line-format-alist `(keymap ,gnus-mime-security-button-map ,@(if (>= (string-to-number emacs-version) 21) nil ;; XEmacs doesn't care (list 'local-map gnus-mime-security-button-map)) gnus-callback gnus-mime-security-press-button - gnus-line-format ,gnus-mime-security-button-line-format + gnus-line-format ,gnus-mime-security-button-line-format article-type annotation gnus-data ,handle)) (setq e (point)) @@ -5334,14 +5425,13 @@ For example: (gnus-mime-display-mixed (cdr handle)) (unless (bolp) (insert "\n")) - (let ((gnus-mime-security-button-line-format + (let ((gnus-mime-security-button-line-format gnus-mime-security-button-end-line-format)) (gnus-insert-mime-security-button handle)) - (mm-set-handle-multipart-parameter handle 'gnus-region - (cons (set-marker (make-marker) - (point-min)) - (set-marker (make-marker) - (point-max)))))) + (mm-set-handle-multipart-parameter + handle 'gnus-region + (cons (set-marker (make-marker) (point-min)) + (set-marker (make-marker) (point-max)))))) (gnus-ems-redefine)