X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=291d32db8e1342e09b43bb040d62266888a8e331;hb=7743919c94113c668a09e272a91b309b9ba5d5a9;hp=b6824711bb6b2e62098b94b1765b7c3f85b063af;hpb=358ba5811d0c584129c4bc03f23a6391d35c2a0f;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index b6824711b..291d32db8 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -139,7 +139,9 @@ "^X-BeenThere:" "^X-Mailman-Version:" "^List-Help:" "^List-Post:" "^List-Subscribe:" "^List-Id:" "^List-Unsubscribe:" "^List-Archive:" "^X-Content-length:" "^X-Posting-Agent:" "^Original-Received:" - "^X-Request-PGP:" "^X-Fingerprint:" "^X-WRIEnvto:" "^X-WRIEnvfrom:"g) + "^X-Request-PGP:" "^X-Fingerprint:" "^X-WRIEnvto:" "^X-WRIEnvfrom:" + "^X-Virus-Scanned:" "^X-Delivery-Agent:" "^Posted-Date:" "^X-Gateway:" + "^X-Local-Origin:" "^X-Local-Destination:") "*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,12 +226,11 @@ regexp. If it matches, the text in question is not a signature." ;; non-graphical frames in a session. (defcustom gnus-article-x-face-command (if (featurep 'xemacs) - (if (or (featurep 'xface) - (featurep 'xpm)) + (if (or (gnus-image-type-available-p 'xface) + (gnus-image-type-available-p 'xpm)) 'gnus-xmas-article-display-xface "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -") - (if (and (fboundp 'image-type-available-p) - (image-type-available-p 'xbm)) + (if (gnus-image-type-available-p 'xbm) 'gnus-article-display-xface (if gnus-article-compface-xbm "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -" @@ -361,6 +362,19 @@ Esample: (_/*word*/_)." "Face used for displaying highlighted words." :group 'gnus-article-emphasis) +(defface gnus-body-boundary-face + '((((class color) + (background dark)) + (:background "white") + (:foreground "black")) + (((class color) + (background light)) + (:background "black") + (:foreground "white")) + (t + ())) + "Face for the body separator.") + (defcustom gnus-article-time-format "%a, %b %d %Y %T %Z" "Format for display of Date headers in article bodies. See `format-time-string' for the possible values. @@ -1013,6 +1027,13 @@ See the manual for details." :group 'gnus-article-treat :type gnus-article-treat-custom) +(defcustom gnus-treat-unfold-headers 'head + "Unfold folded header 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. @@ -1049,13 +1070,47 @@ See the manual for details." :type gnus-article-treat-custom) (put 'gnus-treat-display-smileys 'highlight t) -(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil) - "Display picons. +(defcustom gnus-treat-from-picon + (if (gnus-image-type-available-p 'xpm) + 'head nil) + "Display picons in the From header. +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) +(put 'gnus-treat-from-picon 'highlight t) + +(defcustom gnus-treat-mail-picon + (if (gnus-image-type-available-p 'xpm) + 'head nil) + "Display picons in To and Cc headers. +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) +(put 'gnus-treat-mail-picon 'highlight t) + +(defcustom gnus-treat-newsgroups-picon + (if (gnus-image-type-available-p 'xpm) + 'head nil) + "Display picons in the Newsgroups and Followup-To headers. 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) -(put 'gnus-treat-display-picons 'highlight t) +(put 'gnus-treat-newsgroups-picon 'highlight t) + +(defcustom gnus-treat-body-boundary + (if (or gnus-treat-newsgroups-picon + gnus-treat-mail-picon + gnus-treat-from-picon) + 'head nil) + "Draw a boundary at the end of the headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See the manual for details." + :version "21.1" + :group 'gnus-article-treat + :type gnus-article-treat-custom) (defcustom gnus-treat-capitalize-sentences nil "Capitalize sentence-starting words. @@ -1145,6 +1200,9 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace) (gnus-treat-strip-pgp gnus-article-hide-pgp) (gnus-treat-strip-pem gnus-article-hide-pem) + (gnus-treat-from-picon gnus-treat-from-picon) + (gnus-treat-mail-picon gnus-treat-mail-picon) + (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon) (gnus-treat-highlight-headers gnus-article-highlight-headers) (gnus-treat-highlight-citation gnus-article-highlight-citation) (gnus-treat-highlight-signature gnus-article-highlight-signature) @@ -1155,11 +1213,12 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-strip-multiple-blank-lines gnus-article-strip-multiple-blank-lines) (gnus-treat-overstrike gnus-article-treat-overstrike) + (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) (gnus-treat-display-smileys gnus-smiley-display) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) - (gnus-treat-display-picons gnus-article-display-picons) (gnus-treat-emphasize gnus-article-emphasize) + (gnus-treat-body-boundary gnus-article-treat-body-boundary) (gnus-treat-play-sounds gnus-earcon-display))) (defvar gnus-article-mime-handle-alist nil) @@ -1187,6 +1246,21 @@ Initialized from `text-mode-syntax-table.") (defvar gnus-inhibit-hiding nil) +;;; Macros for dealing with the article buffer. + +(defmacro gnus-with-article-headers (&rest forms) + `(save-excursion + (set-buffer gnus-article-buffer) + (save-restriction + (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t) + (case-fold-search t)) + (article-narrow-to-head) + ,@forms)))) + +(put 'gnus-with-article-headers 'lisp-indent-function 0) +(put 'gnus-with-article-headers 'edebug-form-spec '(body)) + (defsubst gnus-article-hide-text (b e props) "Set text PROPS on the B to E region, extending `intangible' 1 past B." (gnus-add-text-properties-when 'article-type nil b e props) @@ -1534,6 +1608,42 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (put-text-property (point) (1+ (point)) 'face 'underline))))))))) +(defun gnus-article-treat-unfold-headers () + "Unfold folded message headers. +Only the headers that fit into the current window width will be +unfolded." + (interactive) + (gnus-with-article-headers + (let (length) + (while (not (eobp)) + (save-restriction + (mail-header-narrow-to-field) + (let ((header (buffer-substring (point-min) (point-max)))) + (with-temp-buffer + (insert header) + (goto-char (point-min)) + (while (re-search-forward "[\t ]*\n[\t ]+" nil t) + (replace-match " " t t))) + (setq length (- (point-max) (point-min) 1))) + (when (< length (window-width)) + (while (re-search-forward "[\t ]*\n[\t ]+" nil t) + (replace-match " " t t))) + (goto-char (point-max))))))) + +(defun gnus-article-treat-body-boundary () + "Place a boundary line at the end of the headers." + (interactive) + (gnus-with-article-headers + (goto-char (point-max)) + (let ((start (point))) + (insert "X-Boundary: ") + (gnus-add-text-properties start (point) '(invisible t intangible t)) + (insert (make-string (1- (window-width)) ?-) + "\n") + ;;(put-text-property (point) (progn (forward-line -1) (point)) + ;; 'face 'gnus-body-bondary-face) + ))) + (defun article-fill-long-lines () "Fill lines that are wider than the window width." (interactive) @@ -5699,6 +5809,9 @@ For example: (cons (set-marker (make-marker) (point-min)) (set-marker (make-marker) (point-max)))))) +(defun gnus-article-goto-header (header) + (re-search-forward (concat "^" header ":") nil t)) + (gnus-ems-redefine) (provide 'gnus-art)