X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=4c486fbfb19d731f6f97de02d69c3f9cd4393241;hb=625b891fc07e1e5fc5f2658176b6c0e3cb244ee0;hp=eab0013dce873abd348d33e7d31e638cce1a9a4c;hpb=0bcb697113fbd45da5bc46de153b55b17ff14b00;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index eab0013..4c486fb 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -116,11 +116,18 @@ "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:" "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:" "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:" - "^Old-Received:" "^X-Pgp-Fingerprint:" "^X-Pgp-Key-Id:" - "^X-Pgp-Public-Key-Url:" "^X-Auth:" "^X-From-Line:" + "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:" "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:" - "^X-Mailing-List:" "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:" - "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:") + "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:" + "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:" + "^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:" + "^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:" + "^X-Face-Version:" "^X-Vms-To:" "^X-ML-NAME:" "^X-ML-COUNT:" + "^Mailing-List:" "^X-finfo:" "^X-md5sum:" "^X-md5sum-Origin:" + "^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:" + "^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:") "*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." @@ -571,9 +578,9 @@ displayed by the first non-nil matching CONTENT face." ("\221" "`") ("\222" "'") ("\223" "``") - ("\224" "''") + ("\224" "\"") ("\225" "*") - ("\226" "-") + ("\226" "---") ("\227" "-") ("\231" "(TM)") ("\233" ">") @@ -587,7 +594,7 @@ displayed by the first non-nil matching CONTENT face." :type '(repeat regexp)) (defcustom gnus-unbuttonized-mime-types '(".*/.*") - "List of MIME types that should not be given buttons when rendered." + "List of MIME types that should not be given buttons when rendered inline." :group 'gnus-article-mime :type '(repeat regexp)) @@ -709,6 +716,13 @@ See the manual for details." :group 'gnus-article-treat :type gnus-article-treat-custom) +(defcustom gnus-treat-strip-list-identifiers 'head + "Strip list identifiers from `gnus-list-identifiers`. +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-custom) + (defcustom gnus-treat-strip-pgp t "Strip PGP signatures. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -818,13 +832,6 @@ See the manual for details." :group 'gnus-article-treat :type gnus-article-treat-custom) -(defcustom gnus-treat-strip-blank-lines nil - "Strip all blank lines. -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-custom) - (defcustom gnus-treat-overstrike t "Treat overstrike highlighting. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -909,6 +916,7 @@ See the manual for details." (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-list-identifiers gnus-article-hide-list-identifiers) (gnus-treat-strip-pgp gnus-article-hide-pgp) (gnus-treat-strip-pem gnus-article-hide-pem) (gnus-treat-highlight-headers gnus-article-highlight-headers) @@ -926,7 +934,6 @@ See the manual for details." 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-buttonize-head gnus-article-add-buttons-to-head) (gnus-treat-display-smileys gnus-smiley-display) @@ -1408,9 +1415,13 @@ If PROMPT (the prefix), prompt for a coding system to use." (mail-content-type-get ctl 'charset)))) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) + (save-excursion (condition-case nil + (set-buffer gnus-summary-buffer) + (error)) gnus-newsgroup-ignored-charsets)) buffer-read-only) + (if (and ctl (not (string-match "/" (car ctl)))) + (setq ctl nil)) (goto-char (point-max)) (widen) (forward-line 1) @@ -1453,6 +1464,24 @@ or not." (when charset (mm-decode-body charset))))))) +(defun article-hide-list-identifiers () + "Remove any list identifiers in `gnus-list-identifiers' from Subject +header in the current article." + (interactive) + (save-excursion + (save-restriction + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (article-narrow-to-head) + (let ((regexp (if (stringp gnus-list-identifiers) gnus-list-identifiers + (mapconcat 'identity gnus-list-identifiers " *\\|")))) + (when regexp + (goto-char (point-min)) + (when (re-search-forward + (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)") + nil t) + (delete-region (match-beginning 2) (match-end 0))))))))) + (defun article-hide-pgp () "Remove any PGP headers and signatures in the current article." (interactive) @@ -1537,17 +1566,9 @@ always hide." (while (re-search-forward banner nil t) (delete-region (match-beginning 0) (match-end 0)))))))))) -(defun article-babel-prompt () - "Prompt for a babel translation." - (require 'babel) - (completing-read "Translate from: " - babel-translations nil t - (car (car babel-translations)) - babel-history)) - -(defun article-babel (translation) - "Translate article according to TRANSLATION using babelfish." - (interactive (list (article-babel-prompt))) +(defun article-babel () + "Translate article using an online translation service." + (interactive) (require 'babel) (save-excursion (set-buffer gnus-article-buffer) @@ -1555,14 +1576,12 @@ always hide." (let* ((buffer-read-only nil) (start (point)) (end (point-max)) - (msg (buffer-substring start end))) + (orig (buffer-substring start end)) + (trans (babel-as-string orig))) (save-restriction (narrow-to-region start end) (delete-region start end) - (babel-fetch msg (cdr (assoc translation babel-translations))) - (save-restriction - (narrow-to-region start (point-max)) - (babel-wash))))))) + (insert trans)))))) (defun article-hide-signature (&optional arg) "Hide the signature in the current article. @@ -1791,9 +1810,6 @@ how much time has lapsed since DATE. For `lapsed', the value of should replace the \"Date:\" one, or should be added below it." (interactive (list 'ut t)) (let* ((header (or header - (mail-header-date (save-excursion - (set-buffer gnus-summary-buffer) - gnus-current-headers)) (message-fetch-field "date") "")) (tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") @@ -1829,9 +1845,9 @@ should replace the \"Date:\" one, or should be added below it." (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (setq newline nil)) - (if (re-search-forward tdate-regexp nil t) - (forward-line 1)) - (insert (article-make-date-line date type)) + (when (re-search-forward tdate-regexp nil t) + (forward-line 1)) + (insert (article-make-date-line date (or type 'ut))) (when newline (insert "\n") (forward-line -1)) @@ -1855,8 +1871,8 @@ should replace the \"Date:\" one, or should be added below it." ;; buggy dates. ((eq type 'local) (let ((tz (car (current-time-zone)))) - (format "Date: %s %s%04d" (current-time-string time) - (if (> tz 0) "+" "-") (abs (/ tz 36))))) + (format "Date: %s %s%02d%02d" (current-time-string time) + (if (> tz 0) "+" "-") (/ tz 3600) (/ (% tz 3600) 60)))) ;; Convert to Universal Time. ((eq type 'ut) (concat "Date: " @@ -2004,7 +2020,9 @@ 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 gnus-article-emphasis-alist gnus-emphasis-alist)) + (let ((alist (or (with-current-buffer gnus-summary-buffer + gnus-article-emphasis-alist) + gnus-emphasis-alist)) (buffer-read-only nil) (props (append '(article-type emphasis) gnus-hidden-properties)) @@ -2364,6 +2382,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-display-x-face article-de-quoted-unreadable article-mime-decode-quoted-printable + article-hide-list-identifiers article-hide-pgp article-strip-banner article-babel @@ -2522,6 +2541,7 @@ commands: (if (get-buffer name) (save-excursion (set-buffer name) + (kill-all-local-variables) (buffer-disable-undo) (setq buffer-read-only t) (unless (eq major-mode 'gnus-article-mode) @@ -2696,14 +2716,15 @@ If ALL-HEADERS is non-nil, no headers are hidden." (?e gnus-tmp-dots ?s))) (defvar gnus-mime-button-commands - '((gnus-article-press-button "\r" "Toggle Display") - (gnus-mime-view-part "v" "View Interactively...") - (gnus-mime-save-part "o" "Save...") - (gnus-mime-copy-part "c" "View As Text, In Other Buffer") - (gnus-mime-inline-part "i" "View As Text, In This Buffer") - (gnus-mime-internalize-part "E" "View Internally") - (gnus-mime-externalize-part "e" "View Externally") - (gnus-mime-pipe-part "|" "Pipe To Command..."))) + '((gnus-article-press-button "\r" "Toggle Display") + (gnus-mime-view-part "v" "View Interactively...") + (gnus-mime-view-part-as-type "t" "View As Type...") + (gnus-mime-save-part "o" "Save...") + (gnus-mime-copy-part "c" "View As Text, In Other Buffer") + (gnus-mime-inline-part "i" "View As Text, In This Buffer") + (gnus-mime-internalize-part "E" "View Internally") + (gnus-mime-externalize-part "e" "View Externally") + (gnus-mime-pipe-part "|" "Pipe To Command..."))) (defun gnus-article-mime-part-status () (if gnus-article-mime-handle-alist-1 @@ -2765,12 +2786,20 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mm-pipe-part data))) (defun gnus-mime-view-part () - "Interactively choose a view method for the MIME part under point." + "Interactively choose a viewing method for the MIME part under point." (interactive) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (mm-interactively-view-part data))) +(defun gnus-mime-view-part-as-media () + "Choose a MIME media type, and view the part as such." + (interactive + (list (completing-read "View as MIME type: " mailcap-mime-types))) + (gnus-article-check-buffer) + (let ((handle (get-text-property (point) 'gnus-data))) + (gnus-mm-display-part handle))) + (defun gnus-mime-copy-part (&optional handle) "Put the the MIME part under point into a new buffer." (interactive) @@ -2815,7 +2844,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (mm-user-display-methods nil) - (mm-all-images-fit t) + (mm-inline-large-images nil) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) @@ -2830,7 +2859,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (mm-user-display-methods '((".*" . inline))) - (mm-all-images-fit t) + (mm-inline-large-images t) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) @@ -2926,7 +2955,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-treat-article nil id (1- (length gnus-article-mime-handles)) - (car (mm-handle-type handle)))))) + (mm-handle-media-type handle))))) (select-window window)))) (goto-char point) (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) @@ -2947,7 +2976,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mail-content-type-get (mm-handle-disposition handle) 'filename) "")) - (gnus-tmp-type (car (mm-handle-type handle))) + (gnus-tmp-type (mm-handle-media-type handle)) (gnus-tmp-description (mail-decode-encoded-word-string (or (mm-handle-description handle) ""))) @@ -3082,7 +3111,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mapcar 'gnus-mime-display-part handles)) (defun gnus-mime-display-single (handle) - (let ((type (car (mm-handle-type handle))) + (let ((type (mm-handle-media-type handle)) (ignored gnus-ignored-mime-types) (not-attachment t) (move nil) @@ -3096,13 +3125,12 @@ If ALL-HEADERS is non-nil, no headers are hidden." (or (not (mm-handle-disposition handle)) (equal (car (mm-handle-disposition handle)) "inline") - (mm-attachment-override-p type))) - (mm-automatic-display-p type) - (or (mm-inlinable-part-p type) + (mm-attachment-override-p handle))) + (mm-automatic-display-p handle) + (or (mm-inlined-p handle) (mm-automatic-external-display-p type))) (setq display t) - (when (equal (car (split-string type "/")) - "text") + (when (equal (mm-handle-media-supertype handle) "text") (setq text t))) (let ((id (1+ (length gnus-article-mime-handle-alist)))) (push (cons id handle) gnus-article-mime-handle-alist) @@ -3138,7 +3166,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-treat-article nil (length gnus-article-mime-handle-alist) (1- (length gnus-article-mime-handles)) - (car (mm-handle-type handle)))))))))) + (mm-handle-media-type handle))))))))) (defun gnus-unbuttonized-mime-type-p (type) "Say whether TYPE is to be unbuttonized." @@ -3205,9 +3233,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (progn (insert (format "(%c) %-18s" (if (equal handle preferred) ?* ? ) - (if (stringp (car handle)) - (car handle) - (car (mm-handle-type handle))))) + (mm-handle-media-type handle))) (point)) `(gnus-callback (lambda (handles) @@ -3234,7 +3260,15 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) - (mm-display-part preferred))) + (mm-display-part preferred) + ;; Do highlighting. + (save-excursion + (save-restriction + (narrow-to-region (car begend) (point-max)) + (gnus-treat-article + nil (length gnus-article-mime-handle-alist) + (1- (length gnus-article-mime-handles)) + (mm-handle-media-type handle)))))) (goto-char (point-max)) (setcdr begend (point-marker))))) (when ibegend @@ -3282,7 +3316,7 @@ Provided for backwards compatibility." ;; save it to file. (goto-char (point-max)) (insert "\n") - (append-to-file (point-min) (point-max) file-name) + (mm-append-to-file (point-min) (point-max) file-name) t))) (defun gnus-narrow-to-page (&optional arg) @@ -3519,6 +3553,7 @@ headers will be hidden. If given a prefix, show the hidden text instead." (interactive (append (gnus-article-hidden-arg) (list 'force))) (gnus-article-hide-headers arg) + (gnus-article-hide-list-identifiers arg) (gnus-article-hide-pgp arg) (gnus-article-hide-citation-maybe arg force) (gnus-article-hide-signature arg)) @@ -3751,8 +3786,6 @@ groups." (set-buffer gnus-article-buffer) (gnus-article-edit-mode) (funcall start-func) - ;;(gnus-article-delete-text-of-type 'annotation) - ;;(gnus-set-text-properties (point-min) (point-max) nil) (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) (setq gnus-prev-winconf winconf) @@ -4464,7 +4497,7 @@ For example: ((eq pred 'or) (apply 'gnus-or (mapcar 'gnus-treat-predicate val))) ((eq pred 'and) - (apply 'gnus-and (mapcar 'gnus-tread-predicate val))) + (apply 'gnus-and (mapcar 'gnus-treat-predicate val))) ((eq pred 'not) (not (gnus-treat-predicate val))) ((eq pred 'typep)