X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-art.el;h=8798aa58c866ae8b112c7b91d5d5a48c68b8e040;hb=4c6769d9da96b949627f7518279fc8a85141cb0a;hp=289d910eb6e897c8d95f3b8e256087ae1aae5500;hpb=9a3b6b92b8813b40f097c7758dcfd5a28338bb79;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 289d910..8798aa5 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -611,8 +611,8 @@ displayed by the first non-nil matching CONTENT face." (defcustom gnus-article-mime-part-function nil "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." +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) @@ -697,6 +697,12 @@ displayed by the first non-nil matching CONTENT face." :group 'gnus-article-treat :type gnus-article-treat-custom) +(defcustom gnus-treat-strip-banner t + "Strip banners from articles. +The banner to be stripped is specified in the `banner' group parameter." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + (defcustom gnus-treat-highlight-headers 'head "Highlight the headers." :group 'gnus-article-treat @@ -727,6 +733,17 @@ displayed by the first non-nil matching CONTENT face." :group 'gnus-article-treat :type gnus-article-treat-custom) +(defcustom gnus-treat-date-iso8601 nil + "Display the date in the ISO8601 format." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-date-user-defined nil + "Display the date in a user-defined format. +The format is defined by the `gnus-article-time-format' variable." + :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 @@ -769,17 +786,34 @@ displayed by the first non-nil matching CONTENT face." "Display picons." :group 'gnus-article-treat :type gnus-article-treat-custom) - + +(defcustom gnus-treat-capitalize-sentences nil + "Capitalize sentence-starting words." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-fill-long-lines nil + "Fill long lines." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-play-sounds nil + "Fill long lines." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + ;;; Internal variables (defvar article-goto-body-goes-to-point-min-p nil) +(defvar gnus-article-wash-types nil) (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist - '((gnus-treat-highlight-signature gnus-article-highlight-signature) + '((gnus-treat-strip-banner gnus-article-strip-banner) + (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-fill-article gnus-article-fill-cited-article) + (gnus-treat-fill-long-lines gnus-article-fill-long-lines) (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) @@ -795,6 +829,8 @@ displayed by the first non-nil matching CONTENT face." (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 @@ -803,9 +839,11 @@ displayed by the first non-nil matching CONTENT face." 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-xface gnus-article-display-x-face) (gnus-treat-display-smileys gnus-smiley-display) - (gnus-treat-display-picons gnus-article-display-picons))) + (gnus-treat-display-picons gnus-article-display-picons) + (gnus-treat-play-sounds gnus-earcon-display))) (defvar gnus-article-mime-handle-alist nil) (defvar article-lapsed-timer nil) @@ -875,11 +913,14 @@ Then replace the article with the result." (defun gnus-article-hide-text-type (b e type) "Hide text of TYPE between B and E." + (push type gnus-article-wash-types) (gnus-article-hide-text b e (cons 'article-type (cons type gnus-hidden-properties)))) (defun gnus-article-unhide-text-type (b e type) "Unhide text of TYPE between B and E." + (setq gnus-article-wash-types + (delq type gnus-article-wash-types)) (remove-text-properties b e (cons 'article-type (cons type gnus-hidden-properties))) (when (memq 'intangible gnus-hidden-properties) @@ -935,7 +976,10 @@ always hide." (current-buffer) (if (gnus-article-check-hidden-text 'headers arg) ;; Show boring headers as well. - (gnus-article-show-hidden-text 'boring-headers) + (progn + (gnus-article-show-hidden-text 'boring-headers) + (when (eq 1 (point-min)) + (set-window-start (get-buffer-window (current-buffer)) 1))) ;; This function might be inhibited. (unless gnus-inhibit-hiding (save-excursion @@ -1204,6 +1248,17 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (widen)) (forward-line 1))))))) +(defun article-capitalize-sentences () + "Capitalize the first word in each sentence." + (interactive) + (save-excursion + (let ((buffer-read-only nil) + (paragraph-start "^[\n\^L]")) + (article-goto-body) + (while (not (eobp)) + (capitalize-word 1) + (forward-sentence))))) + (defun article-remove-cr () "Translate CRLF pairs into LF, and then CR into LF.." (interactive) @@ -1244,7 +1299,8 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (case-fold-search t) from last) (save-restriction - (nnheader-narrow-to-headers) + (message-narrow-to-head) + (goto-char (point-min)) (setq from (message-fetch-field "from")) (goto-char (point-min)) (while (and gnus-article-x-face-command @@ -1304,9 +1360,8 @@ If PROMPT (the prefix), prompt for a coding system to use." (case-fold-search t) (ct (message-fetch-field "Content-Type" t)) (cte (message-fetch-field "Content-Transfer-Encoding" t)) - (ctl (and ct (condition-case () - (mail-header-parse-content-type ct) - (error nil)))) + (ctl (and ct (ignore-errors + (mail-header-parse-content-type ct)))) (charset (cond (prompt (mm-read-coding-system "Charset to decode: ")) @@ -1314,6 +1369,8 @@ If PROMPT (the prefix), prompt for a coding system to use." (mail-content-type-get ctl 'charset)))) (mail-parse-charset gnus-newsgroup-charset) buffer-read-only) + (when (memq charset gnus-newsgroup-ignored-charsets) + (setq charset nil)) (goto-char (point-max)) (widen) (forward-line 1) @@ -1353,43 +1410,41 @@ or not." (when charset (mm-decode-body charset))))))) -(defun article-hide-pgp (&optional arg) - "Toggle hiding of any PGP headers and signatures in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'pgp arg) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only beg end) - (widen) - (goto-char (point-min)) - ;; Hide the "header". - (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (delete-region (1+ (match-beginning 0)) (match-end 0)) - ;; PGP 5 and GNU PG add a `Hash: <>' comment, hide that too - (when (looking-at "Hash:.*$") - (delete-region (point) (1+ (gnus-point-at-eol)))) - (setq beg (point)) - ;; Hide the actual signature. - (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) - (setq end (1+ (match-beginning 0))) - (delete-region - end - (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) - (match-end 0) - ;; Perhaps we shouldn't hide to the end of the buffer - ;; if there is no end to the signature? - (point-max)))) - ;; Hide "- " PGP quotation markers. - (when (and beg end) - (narrow-to-region beg end) - (goto-char (point-min)) - (while (re-search-forward "^- " nil t) - (delete-region - (match-beginning 0) (match-end 0))) - (widen)) - (gnus-run-hooks 'gnus-article-hide-pgp-hook)))))) +(defun article-hide-pgp () + "Remove any PGP headers and signatures in the current article." + (interactive) + (save-excursion + (let ((inhibit-point-motion-hooks t) + buffer-read-only beg end) + (widen) + (goto-char (point-min)) + ;; Hide the "header". + (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) + (push 'pgp gnus-article-wash-types) + (delete-region (1+ (match-beginning 0)) (match-end 0)) + ;; PGP 5 and GNU PG add a `Hash: <>' comment, hide that too + (when (looking-at "Hash:.*$") + (delete-region (point) (1+ (gnus-point-at-eol)))) + (setq beg (point)) + ;; Hide the actual signature. + (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) + (setq end (1+ (match-beginning 0))) + (delete-region + end + (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) + (match-end 0) + ;; Perhaps we shouldn't hide to the end of the buffer + ;; if there is no end to the signature? + (point-max)))) + ;; Hide "- " PGP quotation markers. + (when (and beg end) + (narrow-to-region beg end) + (goto-char (point-min)) + (while (re-search-forward "^- " nil t) + (delete-region + (match-beginning 0) (match-end 0))) + (widen)) + (gnus-run-hooks 'gnus-article-hide-pgp-hook))))) (defun article-hide-pem (&optional arg) "Toggle hiding of any PEM headers and signatures in the current article. @@ -1401,23 +1456,44 @@ always hide." (let (buffer-read-only end) (widen) (goto-char (point-min)) - ;; hide the horrendously ugly "header". - (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (setq end (1+ (match-beginning 0))) - (gnus-article-hide-text-type - end - (if (search-forward "\n\n" nil t) - (match-end 0) - (point-max)) - 'pem)) - ;; hide the trailer as well - (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pem)))))) + ;; Hide the horrendously ugly "header". + (when (and (search-forward + "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" + nil t) + (setq end (1+ (match-beginning 0)))) + (push 'pem gnus-article-wash-types) + (gnus-article-hide-text-type + end + (if (search-forward "\n\n" nil t) + (match-end 0) + (point-max)) + 'pem) + ;; Hide the trailer as well + (when (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" + nil t) + (gnus-article-hide-text-type + (match-beginning 0) (match-end 0) 'pem))))))) + +(defun article-strip-banner () + "Strip the banner specified by the `banner' group parameter." + (interactive) + (save-excursion + (save-restriction + (let ((inhibit-point-motion-hooks t) + (banner (gnus-group-get-parameter gnus-newsgroup-name 'banner)) + (gnus-signature-limit nil) + buffer-read-only beg end) + (when banner + (article-goto-body) + (cond + ((eq banner 'signature) + (when (gnus-article-narrow-to-signature) + (widen) + (forward-line -1) + (delete-region (point) (point-max)))) + ((stringp banner) + (while (re-search-forward banner nil t) + (delete-region (match-beginning 0) (match-end 0)))))))))) (defun article-hide-signature (&optional arg) "Hide the signature in the current article. @@ -1447,6 +1523,8 @@ always hide." "Place point at the start of the body." (goto-char (point-min)) (cond + ;; This variable is only bound when dealing with separate + ;; MIME body parts. (article-goto-body-goes-to-point-min-p t) ((search-forward "\n\n" nil t) @@ -2190,11 +2268,13 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-hide-boring-headers article-treat-overstrike article-fill-long-lines + article-capitalize-sentences article-remove-cr article-display-x-face article-de-quoted-unreadable article-mime-decode-quoted-printable article-hide-pgp + article-strip-banner article-hide-pem article-hide-signature article-remove-trailing-blank-lines @@ -2336,6 +2416,7 @@ commands: (make-local-variable 'gnus-article-mime-handles) (make-local-variable 'gnus-article-decoded-p) (make-local-variable 'gnus-article-mime-handle-alist) + (make-local-variable 'gnus-article-washed-types) (gnus-set-default-directory) (buffer-disable-undo) (setq buffer-read-only t) @@ -2564,9 +2645,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) (gnus-set-mode-line 'article)) - (gnus-configure-windows 'article) (article-goto-body) (set-window-point (get-buffer-window (current-buffer)) (point)) + (gnus-configure-windows 'article) t)))))) ;;;###autoload @@ -2768,20 +2849,25 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-part-wrapper n 'mm-save-part)) (defun gnus-article-interactively-view-part (n) - "Pipe MIME part N, which is the numerical prefix." + "View MIME part N interactively, which is the numerical prefix." (interactive "p") (gnus-article-part-wrapper n 'mm-interactively-view-part)) (defun gnus-article-copy-part (n) - "Pipe MIME part N, which is the numerical prefix." + "Copy MIME part N, which is the numerical prefix." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-copy-part)) (defun gnus-article-externalize-part (n) - "Pipe MIME part N, which is the numerical prefix." + "View MIME part N externally, which is the numerical prefix." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-externalize-part)) +(defun gnus-article-inline-part (n) + "Inline MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'gnus-mime-inline-part)) + (defun gnus-article-view-part (n) "View MIME part N, which is the numerical prefix." (interactive "p") @@ -2905,7 +2991,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;; 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) + buffer-read-only handle name type b e display) (unless ihandles ;; Top-level call; we clean up. (mm-destroy-parts gnus-article-mime-handles) @@ -3123,13 +3209,13 @@ If ALL-HEADERS is non-nil, no headers are hidden." (save-excursion (set-buffer gnus-article-buffer) (let ((cite (gnus-article-hidden-text-p 'cite)) - (headers (gnus-article-hidden-text-p 'headers)) - (boring (gnus-article-hidden-text-p 'boring-headers)) - (pgp (gnus-article-hidden-text-p 'pgp)) - (pem (gnus-article-hidden-text-p 'pem)) - (signature (gnus-article-hidden-text-p 'signature)) - (overstrike (gnus-article-hidden-text-p 'overstrike)) - (emphasis (gnus-article-hidden-text-p 'emphasis)) + (headers (gnus-article-hidden-text-p 'headers)) + (boring (gnus-article-hidden-text-p 'boring-headers)) + (pgp (gnus-article-hidden-text-p 'pgp)) + (pem (gnus-article-hidden-text-p 'pem)) + (signature (gnus-article-hidden-text-p 'signature)) + (overstrike (gnus-article-hidden-text-p 'overstrike)) + (emphasis (gnus-article-hidden-text-p 'emphasis)) (mime gnus-show-mime)) (format "%c%c%c%c%c%c%c" (if cite ?c ? ) @@ -3379,9 +3465,12 @@ Argument LINES specifies lines to be scrolled down." (set-buffer obuf) (unless not-restore-window (set-window-configuration owin)) - (unless (or (not (eq selected 'old)) (member keys up-to-top)) + (when (eq selected 'old) + (article-goto-body) + (set-window-start (get-buffer-window (current-buffer)) + 1) (set-window-point (get-buffer-window (current-buffer)) - opoint)) + (point))) (let ((win (get-buffer-window gnus-article-current-summary))) (when win (set-window-point win new-sum-point)))))))) @@ -3609,18 +3698,21 @@ groups." (error "The current newsgroup does not support article editing")) (gnus-article-date-original) (gnus-article-edit-article + 'ignore `(lambda (no-highlight) + 'ignore (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))) -(defun gnus-article-edit-article (exit-func) +(defun gnus-article-edit-article (start-func exit-func) "Start editing the contents of the current article buffer." (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) (gnus-article-edit-mode) - (gnus-article-delete-text-of-type 'annotation) - (gnus-set-text-properties (point-min) (point-max) nil) + (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)