Function: article-hide-boring-headers

article-hide-boring-headers is an interactive and byte-compiled function defined in gnus-art.el.gz.

Signature

(article-hide-boring-headers &optional ARG)

Documentation

Toggle hiding of headers that aren't very interesting.

If given a negative prefix, always show; if given a positive prefix, always hide.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-art.el.gz
(defun article-hide-boring-headers (&optional arg)
  "Toggle hiding of headers that aren't very interesting.
If given a negative prefix, always show; if given a positive prefix,
always hide."
  (interactive (gnus-article-hidden-arg) gnus-article-mode)
  (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
	     (not gnus-show-all-headers))
    (save-excursion
      (save-restriction
	(let ((inhibit-read-only t))
	  (article-narrow-to-head)
	  (dolist (elem gnus-boring-article-headers)
	    (goto-char (point-min))
	    (cond
	     ;; Hide empty headers.
	     ((eq elem 'empty)
	      (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
		(forward-line -1)
		(gnus-article-hide-text-type
                 (line-beginning-position)
		 (progn
		   (end-of-line)
		   (if (re-search-forward "^[^ \t]" nil t)
		       (match-beginning 0)
		     (point-max)))
		 'boring-headers)))
	     ;; Hide boring Newsgroups header.
	     ((eq elem 'newsgroups)
	      (when (string-equal-ignore-case
		     (or (gnus-fetch-field "newsgroups") "")
		     (gnus-group-real-name
		      (if (boundp 'gnus-newsgroup-name)
			  gnus-newsgroup-name
			"")))
		(gnus-article-hide-header "newsgroups")))
	     ((eq elem 'to-address)
	      (let ((to (message-fetch-field "to"))
		    (to-address
		     (gnus-parameter-to-address
		      (if (boundp 'gnus-newsgroup-name)
			  gnus-newsgroup-name ""))))
		(when (and to to-address
			   (ignore-errors
			     (string-equal-ignore-case
			      ;; only one address in To
			      (nth 1 (mail-extract-address-components to))
			      to-address)))
		  (gnus-article-hide-header "to"))))
	     ((eq elem 'to-list)
	      (let ((to (message-fetch-field "to"))
		    (to-list
		     (gnus-parameter-to-list
		      (if (boundp 'gnus-newsgroup-name)
			  gnus-newsgroup-name ""))))
		(when (and to to-list
			   (ignore-errors
			     (string-equal-ignore-case
			      ;; only one address in To
			      (nth 1 (mail-extract-address-components to))
			      to-list)))
		  (gnus-article-hide-header "to"))))
	     ((eq elem 'cc-list)
	      (let ((cc (message-fetch-field "cc"))
		    (to-list
		     (gnus-parameter-to-list
		      (if (boundp 'gnus-newsgroup-name)
			  gnus-newsgroup-name ""))))
		(when (and cc to-list
			   (ignore-errors
			     (string-equal-ignore-case
			      ;; only one address in Cc
			      (nth 1 (mail-extract-address-components cc))
			      to-list)))
		  (gnus-article-hide-header "cc"))))
	     ((eq elem 'followup-to)
	      (when (string-equal-ignore-case
		     (or (message-fetch-field "followup-to") "")
		     (or (message-fetch-field "newsgroups") ""))
		(gnus-article-hide-header "followup-to")))
	     ((eq elem 'reply-to)
	      (if (gnus-group-find-parameter
		   gnus-newsgroup-name 'broken-reply-to)
		  (gnus-article-hide-header "reply-to")
		(let ((from (message-fetch-field "from"))
		      (reply-to (message-fetch-field "reply-to")))
		  (when
		      (and
		       from reply-to
		       (ignore-errors
			 (equal
			  (sort (mapcar
				 (lambda (x) (downcase (cadr x)))
				 (mail-extract-address-components from t))
				#'string<)
			  (sort (mapcar
				 (lambda (x) (downcase (cadr x)))
				 (mail-extract-address-components reply-to t))
				#'string<))))
		    (gnus-article-hide-header "reply-to")))))
	     ((eq elem 'date)
	      (let ((date (with-current-buffer gnus-original-article-buffer
                            ;; If date in `gnus-article-buffer' is localized
                            ;; (`gnus-article-date-headers'),
                            ;; `days-between' might fail.
			    (message-fetch-field "date"))))
		(when (and date
			   (< (days-between (current-time-string) date)
			      4))
		  (gnus-article-hide-header "date"))))
	     ((eq elem 'long-to)
	      (let ((to (message-fetch-field "to"))
		    (cc (message-fetch-field "cc")))
		(when (> (length to) 1024)
		  (gnus-article-hide-header "to"))
		(when (> (length cc) 1024)
		  (gnus-article-hide-header "cc"))))
	     ((eq elem 'many-to)
	      (let ((to-count 0)
		    (cc-count 0))
		(goto-char (point-min))
		(while (re-search-forward "^to:" nil t)
		  (setq to-count (1+ to-count)))
		(when (> to-count 1)
		  (while (> to-count 0)
		    (goto-char (point-min))
		    (save-restriction
		      (re-search-forward "^to:" nil nil to-count)
		      (forward-line -1)
		      (narrow-to-region (point) (point-max))
		      (gnus-article-hide-header "to"))
		    (setq to-count (1- to-count))))
		(goto-char (point-min))
		(while (re-search-forward "^cc:" nil t)
		  (setq cc-count (1+ cc-count)))
		(when (> cc-count 1)
		  (while (> cc-count 0)
		    (goto-char (point-min))
		    (save-restriction
		      (re-search-forward "^cc:" nil nil cc-count)
		      (forward-line -1)
		      (narrow-to-region (point) (point-max))
		      (gnus-article-hide-header "cc"))
		    (setq cc-count (1- cc-count)))))))))))))