"^X-Pgp-Public-Key-Url:" "^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:")
+ "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:")
"*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."
:group 'gnus-article-mime
:type 'function)
+(defcustom gnus-mime-multipart-functions nil
+ "An alist of MIME types to functions to display them.")
+
+(defcustom gnus-article-date-lapsed-new-header nil
+ "Whether the X-Sent and Date headers can coexist.
+When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
+either replace the old \"Date:\" header (if this variable is nil), or
+be added below it (otherwise)."
+ :group 'gnus-article-headers
+ :type 'boolean)
+
;;;
;;; The treatment variables
;;;
"Whether to inhibit treatment.")
(defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard"))
- "Highlight the signature."
+ "Highlight the signature.
+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)
+(put 'gnus-treat-highlight-signature 'highlight t)
(defcustom gnus-treat-buttonize t
- "Add buttons."
+ "Add buttons.
+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)
+(put 'gnus-treat-buttonize 'highlight t)
(defcustom gnus-treat-buttonize-head 'head
- "Add buttons to the head."
+ "Add buttons to the head.
+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-buttonize-head 'highlight t)
(defcustom gnus-treat-emphasize t
- "Emphasize text."
+ "Emphasize text.
+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)
+(put 'gnus-treat-emphasize 'highlight t)
(defcustom gnus-treat-strip-cr nil
- "Remove carriage returns."
+ "Remove carriage returns.
+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-hide-headers 'head
- "Hide headers."
+ "Hide 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)
(defcustom gnus-treat-hide-boring-headers nil
- "Hide boring headers."
+ "Hide boring 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)
(defcustom gnus-treat-hide-signature nil
- "Hide the signature."
+ "Hide the signature.
+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-fill-article nil
- "Fill the article."
+ "Fill the article.
+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-hide-citation nil
- "Hide cited text."
+ "Hide cited text.
+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."
+ "Strip PGP signatures.
+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-pem nil
- "Strip PEM signatures."
+ "Strip PEM signatures.
+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-banner t
"Strip banners from articles.
-The banner to be stripped is specified in the `banner' group parameter."
+The banner to be stripped is specified in the `banner' group parameter.
+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-highlight-headers 'head
- "Highlight the headers."
+ "Highlight the 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-highlight-headers 'highlight t)
(defcustom gnus-treat-highlight-citation t
- "Highlight cited text."
+ "Highlight cited text.
+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)
+(put 'gnus-treat-highlight-citation 'highlight t)
(defcustom gnus-treat-date-ut nil
- "Display the Date in UT (GMT)."
+ "Display the Date in UT (GMT).
+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-local nil
- "Display the Date in the local timezone."
+ "Display the Date in the local timezone.
+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."
+ "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.
+See the manual for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-original nil
- "Display the date in the original timezone."
+ "Display the date in the original timezone.
+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-iso8601 nil
- "Display the date in the ISO8601 format."
+ "Display the date in the ISO8601 format.
+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-user-defined nil
"Display the date in a user-defined format.
-The format is defined by the `gnus-article-time-format' variable."
+The format is defined by the `gnus-article-time-format' variable.
+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-strip-headers-in-body t
+ "Strip the X-No-Archive header line from the beginning of the body.
+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-trailing-blank-lines nil
- "Strip trailing blank lines."
+ "Strip trailing 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-strip-leading-blank-lines nil
- "Strip leading blank lines."
+ "Strip leading 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-strip-multiple-blank-lines nil
- "Strip multiple blank lines."
+ "Strip multiple 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-strip-blank-lines nil
- "Strip all blank lines."
+ "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."
+ "Treat overstrike highlighting.
+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)
+(put 'gnus-treat-overstrike 'highlight t)
(defcustom gnus-treat-display-xface (if (and gnus-xemacs (featurep 'xface))
'head nil)
- "Display X-Face headers."
+ "Display X-Face 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-xface 'highlight t)
(defcustom gnus-treat-display-smileys (if (and gnus-xemacs
(featurep 'xpm))
t nil)
- "Display smileys."
+ "Display smileys.
+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)
+(put 'gnus-treat-display-smileys 'highlight t)
(defcustom gnus-treat-display-picons (if gnus-xemacs 'head nil)
- "Display picons."
+ "Display picons.
+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)
(defcustom gnus-treat-capitalize-sentences nil
- "Capitalize sentence-starting words."
+ "Capitalize sentence-starting words.
+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-fill-long-lines nil
- "Fill long lines."
+ "Fill long 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-play-sounds nil
- "Fill long lines."
+ "Play sounds.
+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-decode-article-as-default-mime-charset nil
+ "Decode an article as `default-mime-charset'. For instance, if you want to
+attempt to decode an article even if the value of `gnus-show-mime' is nil,
+you could set this variable to something like: nil for don't decode, t for
+decode the body, '(or header t) for the whole article, etc."
+ :group 'gnus-article-treat
+ :type '(radio (const :tag "Off" nil)
+ (const :tag "Decode body" t)
+ (const :tag "Decode all" (or head t))))
+
;;; Internal variables
(defvar article-goto-body-goes-to-point-min-p nil)
(defvar gnus-article-mime-handle-alist-1 nil)
(defvar gnus-treatment-function-alist
'((gnus-treat-strip-banner gnus-article-strip-banner)
- (gnus-treat-highlight-signature gnus-article-highlight-signature)
+ (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
(gnus-treat-buttonize gnus-article-add-buttons)
(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-emphasize gnus-article-emphasize)
+ (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)
(gnus-treat-hide-citation gnus-article-hide-citation)
(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-emphasize gnus-article-emphasize)
(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-display-xface gnus-article-display-x-face)
(gnus-treat-display-smileys gnus-smiley-display)
(gnus-treat-display-picons gnus-article-display-picons)
- (gnus-treat-play-sounds gnus-earcon-display)))
+ (gnus-treat-play-sounds gnus-earcon-display)
+ (gnus-treat-decode-article-as-default-mime-charset
+ gnus-article-decode-article-as-default-mime-charset)))
(defvar gnus-article-mime-handle-alist nil)
(defvar article-lapsed-timer nil)
(put-text-property
(max (1- b) (point-min))
b 'intangible (cddr (memq 'intangible props)))))
-
-(defmacro gnus-with-article (article &rest forms)
- "Select ARTICLE and perform FORMS in the original article buffer.
-Then replace the article with the result."
- `(progn
- ;; We don't want the article to be marked as read.
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article t t nil ,article))
- (set-buffer gnus-original-article-buffer)
- ,@forms
- (if (not (gnus-check-backend-function
- 'request-replace-article (car gnus-article-current)))
- (gnus-message 5 "Read-only group; not replacing")
- (unless (gnus-request-replace-article
- ,article (car gnus-article-current)
- (current-buffer) t)
- (error "Couldn't replace article")))
- ;; The cache and backlog have to be flushed somewhat.
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current)))))
-
-(put 'gnus-with-article 'lisp-indent-function 1)
-(put 'gnus-with-article 'edebug-form-spec '(form body))
-
(defsubst gnus-article-unhide-text (b e)
"Remove hidden text properties from region between B and E."
(remove-text-properties b e gnus-hidden-properties)
i))
(defun article-hide-headers (&optional arg delete)
- "Toggle whether to hide unwanted headers and possibly sort them as well.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
+ "Hide unwanted headers and possibly sort them as well."
(interactive (gnus-article-hidden-arg))
- (current-buffer)
+ ;; Lars said that this function might be inhibited.
(if (gnus-article-check-hidden-text 'headers arg)
- ;; Show boring headers as well.
(progn
+ ;; Show boring headers as well.
(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
- (save-restriction
- (let ((buffer-read-only nil)
- (case-fold-search t)
- (props (nconc (list 'article-type 'headers)
- gnus-hidden-properties))
- (max (1+ (length gnus-sorted-header-list)))
- (ignored (when (not gnus-visible-headers)
- (cond ((stringp gnus-ignored-headers)
- gnus-ignored-headers)
- ((listp gnus-ignored-headers)
- (mapconcat 'identity gnus-ignored-headers
- "\\|")))))
- (visible
- (cond ((stringp gnus-visible-headers)
- gnus-visible-headers)
- ((and gnus-visible-headers
- (listp gnus-visible-headers))
- (mapconcat 'identity gnus-visible-headers "\\|"))))
- (inhibit-point-motion-hooks t)
- beg)
- ;; First we narrow to just the headers.
- (goto-char (point-min))
- ;; Hide any "From " lines at the beginning of (mail) articles.
- (while (looking-at "From ")
- (forward-line 1))
- (unless (bobp)
- (if delete
- (delete-region (point-min) (point))
- (gnus-article-hide-text (point-min) (point) props)))
- ;; Then treat the rest of the header lines.
- (narrow-to-region
- (point)
- (if (search-forward "\n\n" nil t) ; if there's a body
- (progn (forward-line -1) (point))
- (point-max)))
- ;; Then we use the two regular expressions
- ;; `gnus-ignored-headers' and `gnus-visible-headers' to
- ;; select which header lines is to remain visible in the
- ;; article buffer.
- (goto-char (point-min))
- (while (re-search-forward "^[^ \t]*:" nil t)
- (beginning-of-line)
- ;; Mark the rank of the header.
- (put-text-property
- (point) (1+ (point)) 'message-rank
- (if (or (and visible (looking-at visible))
- (and ignored
- (not (looking-at ignored))))
- (gnus-article-header-rank)
- (+ 2 max)))
- (forward-line 1))
- (message-sort-headers-1)
- (when (setq beg (text-property-any
- (point-min) (point-max) 'message-rank (+ 2 max)))
- ;; We make the unwanted headers invisible.
- (if delete
- (delete-region beg (point-max))
- ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (gnus-article-hide-text-type beg (point-max) 'headers))
- ;; Work around XEmacs lossage.
- (put-text-property (point-min) beg 'invisible nil))))))))
+ (unless gnus-inhibit-hiding
+ (save-excursion
+ (save-restriction
+ (let ((buffer-read-only nil)
+ (inhibit-read-only t)
+ (case-fold-search t)
+ (max (1+ (length gnus-sorted-header-list)))
+ (ignored (when (not gnus-visible-headers)
+ (cond ((stringp gnus-ignored-headers)
+ gnus-ignored-headers)
+ ((listp gnus-ignored-headers)
+ (mapconcat 'identity gnus-ignored-headers
+ "\\|")))))
+ (visible
+ (cond ((stringp gnus-visible-headers)
+ gnus-visible-headers)
+ ((and gnus-visible-headers
+ (listp gnus-visible-headers))
+ (mapconcat 'identity gnus-visible-headers "\\|"))))
+ (inhibit-point-motion-hooks t)
+ beg)
+ ;; First we narrow to just the headers.
+ (article-narrow-to-head)
+ ;; Hide any "From " lines at the beginning of (mail) articles.
+ (while (looking-at "From ")
+ (forward-line 1))
+ (unless (bobp)
+ (if delete
+ (delete-region (point-min) (point))
+ (gnus-article-hide-text (point-min) (point)
+ (nconc (list 'article-type 'headers)
+ gnus-hidden-properties))))
+ ;; Then treat the rest of the header lines.
+ ;; Then we use the two regular expressions
+ ;; `gnus-ignored-headers' and `gnus-visible-headers' to
+ ;; select which header lines is to remain visible in the
+ ;; article buffer.
+ (while (re-search-forward "^[^ \t]*:" nil t)
+ (beginning-of-line)
+ ;; Mark the rank of the header.
+ (put-text-property
+ (point) (1+ (point)) 'message-rank
+ (if (or (and visible (looking-at visible))
+ (and ignored
+ (not (looking-at ignored))))
+ (gnus-article-header-rank)
+ (+ 2 max)))
+ (forward-line 1))
+ (message-sort-headers-1)
+ (when (setq beg (text-property-any
+ (point-min) (point-max) 'message-rank (+ 2 max)))
+ ;; We delete or make invisible the unwanted headers.
+ (if delete
+ (progn
+ (add-text-properties
+ (point-min) (+ 5 (point-min))
+ '(article-type headers dummy-invisible t))
+ (delete-region beg (point-max)))
+ (gnus-article-hide-text-type beg (point-max) 'headers))))))))
+ )
(defun article-hide-boring-headers (&optional arg)
"Toggle hiding of headers that aren't very interesting.
(cond
;; Hide empty headers.
((eq elem 'empty)
- (while (re-search-forward "^[^:]+:[ \t]*\n[^ \t]" nil t)
+ (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
(forward-line -1)
(gnus-article-hide-text-type
(progn (beginning-of-line) (point))
(point-max)))
'boring-headers))))
+(defun article-toggle-headers (&optional arg)
+ "Toggle hiding of headers. If given a negative prefix, always show;
+if given a positive prefix, always hide."
+ (interactive (gnus-article-hidden-arg))
+ (let ((force (when (numberp arg)
+ (cond ((> arg 0) 'always-hide)
+ ((< arg 0) 'always-show))))
+ (window (get-buffer-window gnus-article-buffer))
+ (header-end (point-min))
+ header-start field-end field-start
+ (inhibit-point-motion-hooks t)
+ (inhibit-read-only t)
+ buffer-read-only)
+ (save-restriction
+ (widen)
+ (while (and (setq header-start
+ (text-property-any header-end (point-max)
+ 'article-treated-header t))
+ (setq header-end
+ (text-property-not-all header-start (point-max)
+ 'article-treated-header t)))
+ (setq field-end header-start)
+ (cond
+ (;; Hide exposed invisible fields.
+ (and (not (eq 'always-show force))
+ (setq field-start
+ (text-property-any field-end header-end
+ 'exposed-invisible-field t)))
+ (while (and field-start
+ (setq field-end (text-property-not-all
+ field-start header-end
+ 'exposed-invisible-field t)))
+ (add-text-properties field-start field-end gnus-hidden-properties)
+ (setq field-start (text-property-any field-end header-end
+ 'exposed-invisible-field t)))
+ (put-text-property header-start header-end
+ 'exposed-invisible-field nil))
+ (;; Expose invisible fields.
+ (and (not (eq 'always-hide force))
+ (setq field-start
+ (text-property-any field-end header-end 'invisible t)))
+ (while (and field-start
+ (setq field-end (text-property-not-all
+ field-start header-end
+ 'invisible t)))
+ ;; If the invisible text is not terminated with newline, we
+ ;; won't expose it. Because it may be created by x-face-mule.
+ ;; BTW, XEmacs sometimes fail in putting a invisible text
+ ;; property with `gnus-article-hide-text' (really?). In that
+ ;; case, the invisible text might be started from the middle of
+ ;; a line so we will expose the sort of thing.
+ (when (or (not (or (eq header-start field-start)
+ (eq ?\n (char-before field-start))))
+ (eq ?\n (char-before field-end)))
+ (remove-text-properties field-start field-end
+ gnus-hidden-properties)
+ (put-text-property field-start field-end
+ 'exposed-invisible-field t))
+ (setq field-start (text-property-any field-end header-end
+ 'invisible t))))
+ (;; Hide fields.
+ (not (eq 'always-show force))
+ (narrow-to-region header-start header-end)
+ (article-hide-headers)
+ ;; Re-display X-Face image under XEmacs.
+ (when (and (featurep 'xemacs)
+ (gnus-functionp gnus-article-x-face-command))
+ (let ((func (cadr (assq 'gnus-treat-display-xface
+ gnus-treatment-function-alist)))
+ (condition 'head))
+ (when (and func
+ (gnus-treat-predicate gnus-treat-display-xface))
+ (funcall func)
+ (put-text-property header-start header-end 'read-only nil))))
+ (widen))
+ ))
+ (goto-char (point-min))
+ (when window
+ (set-window-start window (point-min))))))
+
(defvar gnus-article-normalized-header-length 40
"Length of normalized headers.")
(forward-sentence)))))
(defun article-remove-cr ()
- "Translate CRLF pairs into LF, and then CR into LF.."
+ "Remove trailing CRs and then translate remaining CRs into LFs."
(interactive)
(save-excursion
(let ((buffer-read-only nil))
(goto-char (point-min))
- (while (search-forward "\r$" nil t)
+ (while (re-search-forward "\r+$" nil t)
(replace-match "" t t))
(goto-char (point-min))
(while (search-forward "\r" nil t)
(gnus-article-hide-text-type
(point-min) (point-max) 'signature)))))))
+(defun article-strip-headers-in-body ()
+ "Strip offensive headers from bodies."
+ (interactive)
+ (save-excursion
+ (article-goto-body)
+ (let ((case-fold-search t))
+ (when (looking-at "x-no-archive:")
+ (gnus-delete-line)))))
+
(defun article-strip-leading-blank-lines ()
"Remove all blank lines from the beginning of the article."
(interactive)
"Say whether the current buffer contains hidden text of type TYPE."
(let ((pos (text-property-any (point-min) (point-max) 'article-type type)))
(while (and pos
- (not (get-text-property pos 'invisible)))
+ (not (get-text-property pos 'invisible))
+ (not (get-text-property pos 'dummy-invisible)))
(setq pos
(text-property-any (1+ pos) (point-max) 'article-type type)))
(if pos
(defun article-date-ut (&optional type highlight header)
"Convert DATE date to universal time in the current article.
If TYPE is `local', convert to local time; if it is `lapsed', output
-how much time has lapsed since DATE."
+how much time has lapsed since DATE. For `lapsed', the value of
+`gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
+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))
+ (and (eq 1 (point-min))
+ (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)
header))
- (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
(inhibit-point-motion-hooks t)
- bface eface newline)
+ bface eface date-pos)
(when (and date (not (string= date "")))
(save-excursion
(save-restriction
(article-narrow-to-head)
+ (when (or (and (eq type 'lapsed)
+ gnus-article-date-lapsed-new-header
+ ;; Attempt to get the face of X-Sent first.
+ (re-search-forward "^X-Sent:[ \t]" nil t))
+ (re-search-forward "^Date:[ \t]" nil t)
+ ;; If Date is missing, try again for X-Sent.
+ (re-search-forward "^X-Sent:[ \t]" nil t))
+ (setq bface (get-text-property (gnus-point-at-bol) 'face)
+ eface (get-text-property (1- (gnus-point-at-eol))
+ 'face)))
(let ((buffer-read-only nil))
+ ;; Delete any old X-Sent headers.
+ (when (setq date-pos
+ (text-property-any (point-min) (point-max)
+ 'article-date-lapsed t))
+ (goto-char (setq date-pos (set-marker (make-marker) date-pos)))
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ (goto-char (point-min))
;; Delete any old Date headers.
- (if (re-search-forward date-regexp nil t)
+ (while (re-search-forward "^Date:[ \t]" nil t)
+ (unless date-pos
+ (setq date-pos (match-beginning 0)))
+ (unless (and (eq type 'lapsed)
+ gnus-article-date-lapsed-new-header)
+ (delete-region (match-beginning 0)
+ (progn (message-next-header) (point)))))
+ (if date-pos
(progn
- (setq bface (get-text-property (gnus-point-at-bol) 'face)
- eface (get-text-property (1- (gnus-point-at-eol))
- 'face))
- (delete-region (progn (beginning-of-line) (point))
- (progn (end-of-line) (point)))
- (beginning-of-line))
- (goto-char (point-max))
- (setq newline t))
+ (goto-char date-pos)
+ (unless (bolp)
+ ;; Possibly, Date has been deleted.
+ (insert "\n"))
+ (when (and (eq type 'lapsed)
+ gnus-article-date-lapsed-new-header
+ (looking-at "Date:"))
+ (forward-line 1)))
+ (goto-char (point-min)))
(insert (article-make-date-line date type))
+ (when (eq type 'lapsed)
+ (put-text-property (gnus-point-at-bol) (point)
+ 'article-date-lapsed t))
+ (insert "\n")
+ (forward-line -1)
;; Do highlighting.
- (beginning-of-line)
(when (looking-at "\\([^:]+\\): *\\(.*\\)$")
(put-text-property (match-beginning 1) (1+ (match-end 1))
'face bface)
(put-text-property (match-beginning 2) (match-end 2)
- 'face eface))
- (when newline
- (end-of-line)
- (insert "\n"))))))))
+ 'face eface))))))))
(defun article-make-date-line (date type)
"Return a DATE line of TYPE."
(apply ',afunc args))))))))
'(article-hide-headers
article-hide-boring-headers
+ article-toggle-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-strip-headers-in-body
article-remove-trailing-blank-lines
article-strip-leading-blank-lines
article-strip-multiple-blank-lines
(easy-menu-define
gnus-article-treatment-menu gnus-article-mode-map ""
'("Treatment"
- ["Hide headers" gnus-article-hide-headers t]
+ ["Hide headers" gnus-article-toggle-headers t]
["Hide signature" gnus-article-hide-signature t]
["Hide citation" gnus-article-hide-citation t]
["Treat overstrike" gnus-article-treat-overstrike t]
all-headers gnus-have-all-headers))
(make-local-variable 'default-mime-charset)
(setq default-mime-charset charset)
+ (with-current-buffer (get-buffer-create gnus-article-buffer)
+ (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)
)
;; `mime-display-message' changes current buffer to `gnus-article-buffer'.
(make-local-variable 'mime-button-mother-dispatcher)
(when (gnus-visual-p 'article-highlight 'highlight)
(gnus-run-hooks 'gnus-visual-mark-article-hook))
;; Set the global newsgroup variables here.
- ;; Suggested by Jim Sisolak
- ;; <sisolak@trans4.neep.wisc.edu>.
(gnus-set-global-variables)
(setq gnus-have-all-headers
(or all-headers gnus-show-all-headers))))
(gnus-configure-windows 'article)
t))))))
+(defun gnus-article-prepare-mime-display (&optional number)
+ (goto-char (point-min))
+ (when (re-search-forward "^[^\t ]+:" nil t)
+ (goto-char (match-beginning 0)))
+ (let* ((entity (if (eq 1 (point-min))
+ (get-text-property 1 'mime-view-entity)
+ (get-text-property (point) 'mime-view-entity)))
+ (number (or number 0))
+ next type ids)
+ (save-restriction
+ (narrow-to-region (point)
+ (if (search-forward "\n\n" nil t)
+ (point)
+ (point-max)))
+ (gnus-treat-article 'head)
+ (put-text-property (point-min) (point-max) 'article-treated-header t)
+ (goto-char (point-max)))
+ (while (and (not (eobp))
+ entity
+ (setq next (next-single-property-change (point)
+ 'mime-view-entity)))
+ (setq type (mime-entity-content-type entity)
+ type (format "%s/%s"
+ (mime-content-type-primary-type type)
+ (mime-content-type-subtype type)))
+ (if (string-equal type "message/rfc822")
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (gnus-article-prepare-mime-display number)
+ (goto-char (point-max)))
+ (setq ids (length (mime-entity-node-id entity))
+ entity (get-text-property next 'mime-view-entity)
+ number (1+ number))
+ (save-restriction
+ (narrow-to-region (point) next)
+ (if (or (null entity)
+ (< (length (mime-entity-node-id entity)) ids))
+ (gnus-treat-article 'last number number type)
+ (gnus-treat-article t number nil type))
+ (goto-char (point-max)))))
+ (unless (eobp)
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (if entity
+ (progn
+ (setq type (mime-entity-content-type entity)
+ type (format "%s/%s"
+ (mime-content-type-primary-type type)
+ (mime-content-type-subtype type)))
+ (if (string-equal type "message/rfc822")
+ (gnus-article-prepare-mime-display number)
+ (incf number)
+ (gnus-treat-article 'last number number type)))
+ (gnus-treat-article t))))))
+
;;;###autoload
(defun gnus-article-prepare-display ()
"Make the current buffer look like a nice article."
- (let ((method
- (if gnus-show-mime
- (progn
- (setq mime-message-structure gnus-current-headers)
- gnus-article-display-method-for-mime)
- gnus-article-display-method-for-traditional)))
- (gnus-run-hooks 'gnus-tmp-internal-hook)
- (gnus-run-hooks 'gnus-article-prepare-hook)
- ;; Display message.
- (funcall method)
- ;; Associate this article with the current summary buffer.
- (setq gnus-article-current-summary gnus-summary-buffer)
- ;; Perform the article display hooks.
- (gnus-run-hooks 'gnus-article-display-hook)))
+ (gnus-run-hooks 'gnus-tmp-internal-hook)
+ (gnus-run-hooks 'gnus-article-prepare-hook)
+ ;; Display message.
+ (let (mime-display-header-hook)
+ (funcall (if gnus-show-mime
+ (progn
+ (setq mime-message-structure gnus-current-headers)
+ (mime-buffer-entity-set-buffer-internal
+ mime-message-structure
+ gnus-original-article-buffer)
+ (mime-entity-set-representation-type-internal
+ mime-message-structure 'mime-buffer-entity)
+ (luna-send mime-message-structure
+ 'initialize-instance
+ mime-message-structure)
+ gnus-article-display-method-for-mime)
+ gnus-article-display-method-for-traditional)))
+ ;; Associate this article with the current summary buffer.
+ (setq gnus-article-current-summary gnus-summary-buffer)
+ ;; Call the treatment functions.
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (save-restriction
+ (widen)
+ (if gnus-show-mime
+ (gnus-article-prepare-mime-display)
+ (narrow-to-region (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (point)
+ (point-max)))
+ (gnus-treat-article 'head)
+ (put-text-property (point-min) (point-max) 'article-treated-header t)
+ (goto-char (point-max))
+ (widen)
+ (narrow-to-region (point) (point-max))
+ (gnus-treat-article t))
+ (put-text-property (point-min) (point-max) 'read-only nil)))
+ ;; Perform the article display hooks. Incidentally, this hook is
+ ;; an obsolete variable by now.
+ (gnus-run-hooks 'gnus-article-display-hook))
+
+(defun gnus-article-decode-article-as-default-mime-charset ()
+ "Decode an article as `default-mime-charset'. It won't work if the
+value of the variable `gnus-show-mime' is non-nil."
+ (unless gnus-show-mime
+ (decode-mime-charset-region (point-min) (point-max)
+ (with-current-buffer gnus-summary-buffer
+ default-mime-charset))))
+
+(autoload 'x-face-mule-x-face-decode-message-header "x-face-mule")
+
+(defun gnus-article-display-x-face-with-x-face-mule (&rest args)
+ "Decode and show X-Face with the function
+`x-face-mule-x-face-decode-message-header'. The buffer is expected to be
+narrowed to just the headers of the article."
+ (when (featurep 'xemacs)
+ (error "`%s' won't work under XEmacs."
+ 'gnus-article-display-x-face-with-x-face-mule))
+ (when window-system
+ (condition-case err
+ (x-face-mule-x-face-decode-message-header)
+ (error (error "%s"
+ (if (featurep 'x-face-mule)
+ "Please install x-face-mule 0.24 or later."
+ err))))))
;;;
;;; Gnus MIME viewing functions
(setq buffer-file-name nil))
(goto-char (point-min))))
-(defun gnus-mime-inline-part (&optional charset)
+(defun gnus-mime-inline-part (&optional handle)
"Insert the MIME part under point into the current buffer."
- (interactive "P") ; For compatibility reasons we are not using "z".
+ (interactive)
(gnus-article-check-buffer)
- (let* ((data (get-text-property (point) 'gnus-data))
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
contents
(b (point))
buffer-read-only)
- (if (mm-handle-undisplayer data)
- (mm-remove-part data)
- (setq contents (mm-get-part data))
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (setq contents (mm-get-part handle))
(forward-line 2)
- (when charset
- (unless (symbolp charset)
- (setq charset (mm-read-coding-system "Charset: ")))
- (setq contents (mm-decode-coding-string contents charset)))
- (mm-insert-inline data contents)
+ (mm-insert-inline handle contents)
(goto-char b))))
(defun gnus-mime-externalize-part (&optional handle)
(save-restriction
(narrow-to-region (point) (1+ (point)))
(mm-display-part handle)
+ ;; We narrow to the part itself and
+ ;; then call the treatment functions.
+ (goto-char (point-min))
+ (forward-line 1)
+ (narrow-to-region (point) (point-max))
(gnus-treat-article
nil id
(1- (length gnus-article-mime-handles))
;; Single part.
((not (stringp (car handle)))
(gnus-mime-display-single handle))
+ ;; User-defined multipart
+ ((cdr (assoc (car handle) gnus-mime-multipart-functions))
+ (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions))
+ handle))
;; multipart/alternative
((and (equal (car handle) "multipart/alternative")
(not gnus-mime-display-multipart-as-mixed))
(while list
(when (string-match (pop list) type)
(throw 'found t)))))))
+ (highlightp (gnus-visual-p 'article-highlight 'highlight))
val elem)
- (when (gnus-visual-p 'article-highlight 'highlight)
- (gnus-run-hooks 'gnus-part-display-hook)
- (while (setq elem (pop alist))
- (setq val (symbol-value (car elem)))
- (when (and (or (consp val)
- treated-type)
- (gnus-treat-predicate val))
- (save-restriction
- (funcall (cadr elem))))))))
+ (gnus-run-hooks 'gnus-part-display-hook)
+ (while (setq elem (pop alist))
+ (setq val (symbol-value (car elem)))
+ (when (and (or (consp val)
+ treated-type)
+ (gnus-treat-predicate val)
+ (or (not (get (car elem) 'highlight))
+ highlightp))
+ (save-restriction
+ (funcall (cadr elem)))))))
;; Dynamic variables.
(defvar part-number)
(defvar length)
(defun gnus-treat-predicate (val)
(cond
- (condition
- (eq condition val))
+ ((eq val 'mime)
+ (not (not gnus-show-mime)))
((null val)
nil)
- ((eq val t)
- t)
- ((eq val 'head)
- nil)
- ((eq val 'last)
- (eq part-number total-parts))
- ((numberp val)
- (< length val))
((listp val)
(let ((pred (pop val)))
(cond
((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)
(equal (cadr val) type))
(t
- (error "%S is not a valid predicate" pred)))))
+ (gnus-treat-predicate pred)))))
+ (condition
+ (eq condition val))
+ ((eq val t)
+ t)
+ ((eq val 'head)
+ nil)
+ ((eq val 'last)
+ (eq part-number total-parts))
+ ((numberp val)
+ (< length val))
(t
(error "%S is not a valid value" val))))
projects / elisp / gnus.git- / blobdiff