(require 'nnheader)
(require 'gnus-util)
(require 'message)
-
-(defvar gnus-ignored-headers
- "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:"
- "*All headers that match this regexp will be hidden.
+(require 'custom)
+
+(defgroup article nil
+ "Article display."
+ :group 'gnus)
+
+(defcustom gnus-ignored-headers
+ '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:"
+ "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:"
+ "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:"
+ "^Approved:" "^Sender:" "^Received:" "^Mail-from:")
+ "All headers that match this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
-If `article-visible-headers' is non-nil, this variable will be ignored.")
-
-(defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
- "*All headers that do not match this regexp will be hidden.
+If `article-visible-headers' is non-nil, this variable will be ignored."
+ :type '(repeat string) ;Leave monster regexp to lisp.
+ :group 'article)
+
+(defcustom gnus-visible-headers
+ '("^From:" "^Newsgroups:" "^Subject:" "^Date:" "^Followup-To:"
+ "^Reply-To:" "^Organization:" "^Summary:" "^Keywords:" "^To:"
+ "^Cc:" "^Posted-To:" "^Mail-Copies-To:" "^Apparently-To:"
+ "^Gnus-Warning:" "^Resent-")
+ "All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
-If this variable is non-nil, `article-ignored-headers' will be ignored.")
+If this variable is non-nil, `gnus-article-ignored-headers' will be ignored."
+ :type '(repeat string) ;Leave monster regexp to lisp.
+ :group 'article)
-(defvar gnus-sorted-header-list
+(defcustom gnus-sorted-header-list
'("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
"^Cc:" "^Date:" "^Organization:")
- "*This variable is a list of regular expressions.
+ "This variable is a list of regular expressions.
If it is non-nil, headers that match the regular expressions will
be placed first in the article buffer in the sequence specified by
-this list.")
+this list."
+ :type '(repeat string)
+ :group 'article)
-(defvar gnus-boring-article-headers
- '(empty followup-to reply-to)
- "*Headers that are only to be displayed if they have interesting data.
+(defcustom gnus-boring-article-headers '(empty followup-to reply-to)
+ "Headers that are only to be displayed if they have interesting data.
Possible values in this list are `empty', `newsgroups', `followup-to',
-`reply-to', and `date'.")
-
-(defvar gnus-signature-separator "^-- *$"
- "Regexp matching signature separator.")
-
-(defvar gnus-signature-limit nil
- "Provide a limit to what is considered a signature.
+`reply-to', and `date'."
+ :type '(set (item :tag "Headers with no content." empty)
+ (item :tag "Newsgroups with only one group." newsgroups)
+ (item :tag "Followup-to identical to newsgroups." followup-to)
+ (item :tag "Reply-to identical to from." reply-to)
+ (item :tag "Date less than four days old." date))
+ :group 'article)
+
+(defcustom gnus-signature-separator '("^-- $" "^-- *$")
+ "Regexp matching signature separator.
+This can also be a list of regexps. In that case, it will be checked
+from head to tail looking for a separator. Searches will be done from
+the end of the buffer."
+ :type '(repeat string)
+ :group 'article)
+
+(defcustom gnus-signature-limit nil
+ "Provide a limit to what is considered a signature.
If it is a number, no signature may not be longer (in characters) than
-that number. If it is a function, the function will be called without
-any parameters, and if it returns nil, there is no signature in the
-buffer. If it is a string, it will be used as a regexp. If it
-matches, the text in question is not a signature.")
-
-(defvar gnus-hidden-properties '(invisible t intangible t)
- "Property list to use for hiding text.")
-
-(defvar gnus-article-x-face-command
+that number. If it is a floating point number, no signature may be
+longer (in lines) than that number. If it is a function, the function
+will be called without any parameters, and if it returns nil, there is
+no signature in the buffer. If it is a string, it will be used as a
+regexp. If it matches, the text in question is not a signature."
+ :type '(choice integer number function string)
+ :group 'article)
+
+(defcustom gnus-hidden-properties '(invisible t intangible t)
+ "Property list to use for hiding text."
+ :type 'sexp
+ :group 'article)
+
+(defcustom gnus-article-x-face-command
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
"String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
-asynchronously. The compressed face will be piped to this command.")
-
-(defvar gnus-article-x-face-too-ugly nil
- "Regexp matching posters whose face shouldn't be shown automatically.")
-
-(defvar gnus-emphasis-alist
- '(("_\\(\\w+\\)_" 0 1 'underline)
- ("\\W\\(/\\(\\w+\\)/\\)\\W" 1 2 'italic)
- ("\\(_\\*\\|\\*_\\)\\(\\w+\\)\\(_\\*\\|\\*_\\)" 0 2 'bold-underline)
- ("\\*\\(\\w+\\)\\*" 0 1 'bold))
+asynchronously. The compressed face will be piped to this command."
+ :type 'string ;Leave function case to Lisp.
+ :group 'article)
+
+(defcustom gnus-article-x-face-too-ugly nil
+ "Regexp matching posters whose face shouldn't be shown automatically."
+ :type 'regexp
+ :group 'article)
+
+(defcustom gnus-emphasis-alist
+ '(("_\\(\\w+\\)_" 0 1 underline)
+ ("\\W\\(/\\(\\w+\\)/\\)\\W" 1 2 italic)
+ ("\\(_\\*\\|\\*_\\)\\(\\w+\\)\\(_\\*\\|\\*_\\)" 0 2 bold-underline)
+ ("\\*\\(\\w+\\)\\*" 0 1 bold))
"Alist that says how to fontify certain phrases.
Each item looks like this:
is a number that says what regular expression grouping used to find
the entire emphasized word. The third is a number that says what
regexp grouping should be displayed and highlighted. The fourth
-is the face used for highlighting.")
+is the face used for highlighting."
+ :type '(repeat (list :value ("" 0 0 default)
+ regexp
+ (integer :tag "Match group")
+ (integer :tag "Emphasize group")
+ face))
+ :group 'article)
(eval-and-compile
(autoload 'hexl-hex-string-to-integer "hexl")
(remove-text-properties b e gnus-hidden-properties)
(when (memq 'intangible gnus-hidden-properties)
(put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ b 'intangible nil)))
(defun article-hide-text-type (b e type)
"Hide text of TYPE between B and E."
b e (cons 'article-type (cons type gnus-hidden-properties)))
(when (memq 'intangible gnus-hidden-properties)
(put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ b 'intangible nil)))
+
+(defun article-hide-text-of-type (type)
+ "Hide text of TYPE in the current buffer."
+ (save-excursion
+ (let ((b (point-min))
+ (e (point-max)))
+ (while (setq b (text-property-any b e 'article-type type))
+ (add-text-properties b (incf b) gnus-hidden-properties)))))
+
+(defun article-delete-text-of-type (type)
+ "Delete text of TYPE in the current buffer."
+ (save-excursion
+ (let ((b (point-min))
+ (e (point-max)))
+ (while (setq b (text-property-any b e 'article-type type))
+ (delete-region b (incf b))))))
+
+(defun article-text-type-exists-p (type)
+ "Say whether any text of type TYPE exists in the buffer."
+ (text-property-any (point-min) (point-max) 'article-type type))
(defsubst article-header-rank ()
"Give the rank of the string HEADER as given by `article-sorted-header-list'."
(props (nconc (list 'article-type 'headers)
gnus-hidden-properties))
(max (1+ (length gnus-sorted-header-list)))
- (ignored (when (not (stringp gnus-visible-headers))
+ (ignored (when (not gnus-visible-headers)
(cond ((stringp gnus-ignored-headers)
gnus-ignored-headers)
((listp gnus-ignored-headers)
(narrow-to-region
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (point-max)))
-
(goto-char (point-min))
(while (re-search-forward
"=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
(setq string (match-string 1))
- (narrow-to-region (match-beginning 0) (match-end 0))
- (delete-region (point-min) (point-max))
- (insert string)
- (article-mime-decode-quoted-printable
- (goto-char (point-min)) (point-max))
- (subst-char-in-region (point-min) (point-max) ?_ ? )
- (widen)
+ (save-restriction
+ (narrow-to-region (match-beginning 0) (match-end 0))
+ (delete-region (point-min) (point-max))
+ (insert string)
+ (article-mime-decode-quoted-printable (goto-char (point-min))
+ (point-max))
+ (subst-char-in-region (point-min) (point-max) ?_ ? )
+ (goto-char (point-max)))
+ (if (looking-at "\\([ \t\n]+\\)=\\?")
+ (replace-match "" t t nil 1))
(goto-char (point-min))))))
(defun article-de-quoted-unreadable (&optional force)
(search-forward "\n\n" nil 'move)
(article-mime-decode-quoted-printable (point) (point-max))))))
+(defun article-mime-decode-quoted-printable-buffer ()
+ "Decode Quoted-Printable in the current buffer."
+ (article-mime-decode-quoted-printable (point-min) (point-max)))
+
(defun article-mime-decode-quoted-printable (from to)
"Decode Quoted-Printable in the region between FROM and TO."
(interactive "r")
(while (looking-at "[ \t]$")
(gnus-delete-line))))))
+(defun article-strip-multiple-blank-lines ()
+ "Replace consecutive blank lines with one empty line."
+ (interactive)
+ (save-excursion
+ (let (buffer-read-only)
+ ;; First make all blank lines empty.
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]+$" nil t)
+ (replace-match "" nil t))
+ ;; Then replace multiple empty lines with a single empty line.
+ (goto-char (point-min))
+ (while (re-search-forward "\n\n\n+" nil t)
+ (replace-match "\n\n" t t)))))
+
+(defun article-strip-blank-lines ()
+ "Strip leading, trailing and multiple blank lines."
+ (interactive)
+ (article-strip-leading-blank-lines)
+ (article-remove-trailing-blank-lines)
+ (article-strip-multiple-blank-lines))
+
(defvar mime::preview/content-list)
(defvar mime::preview-content-info/point-min)
(defun article-narrow-to-signature ()
"Narrow to the signature."
(widen)
- (if (and (boundp 'mime::preview/content-list)
- mime::preview/content-list)
- (let ((pcinfo (car (last mime::preview/content-list))))
- (condition-case ()
- (narrow-to-region
- (funcall (intern "mime::preview-content-info/point-min") pcinfo)
- (point-max))
- (error nil))))
- (goto-char (point-max))
- (when (re-search-backward gnus-signature-separator nil t)
+ (when (and (boundp 'mime::preview/content-list)
+ mime::preview/content-list)
+ ;; We have a MIMEish article, so we use the MIME data to narrow.
+ (let ((pcinfo (car (last mime::preview/content-list))))
+ (condition-case ()
+ (narrow-to-region
+ (funcall (intern "mime::preview-content-info/point-min") pcinfo)
+ (point-max))
+ (error nil))))
+
+ (when (article-search-signature)
(forward-line 1)
- (when (or (null gnus-signature-limit)
- (and (numberp gnus-signature-limit)
- (< (- (point-max) (point)) gnus-signature-limit))
- (and (gnus-functionp gnus-signature-limit)
- (funcall gnus-signature-limit))
- (and (stringp gnus-signature-limit)
- (not (re-search-forward gnus-signature-limit nil t))))
- (narrow-to-region (point) (point-max))
- t)))
+ ;; Check whether we have some limits to what we consider
+ ;; to be a signature.
+ (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
+ (list gnus-signature-limit)))
+ limit limited)
+ (while (setq limit (pop limits))
+ (if (or (and (integerp limit)
+ (< (- (point-max) (point)) limit))
+ (and (floatp limit)
+ (< (count-lines (point) (point-max)) limit))
+ (and (gnus-functionp limit)
+ (funcall limit))
+ (and (stringp limit)
+ (not (re-search-forward limit nil t))))
+ () ; This limit did not succeed.
+ (setq limited t
+ limits nil)))
+ (unless limited
+ (narrow-to-region (point) (point-max))
+ t))))
+
+(defun article-search-signature ()
+ "Search the current buffer for the signature separator.
+Put point at the beginning of the signature separator."
+ (let ((cur (point)))
+ (goto-char (point-max))
+ (if (if (stringp gnus-signature-separator)
+ (re-search-backward gnus-signature-separator nil t)
+ (let ((seps gnus-signature-separator))
+ (while (and seps
+ (not (re-search-backward (car seps) nil t)))
+ (pop seps))
+ seps))
+ t
+ (goto-char cur)
+ nil)))
(defun article-hidden-arg ()
"Return the current prefix arg as a number, or 0 if no prefix."
(setq beg (point)))
t)))
-(defvar article-time-units
+(defconst article-time-units
`((year . ,(* 365.25 24 60 60))
(week . ,(* 7 24 60 60))
(day . ,(* 24 60 60))
how much time has lapsed since DATE."
(interactive (list 'ut t))
(let* ((header (or header (message-fetch-field "date") ""))
- (date (and (vectorp header) (mail-header-date header)))
+ (date (if (vectorp header) (mail-header-date header)
+ header))
(date-regexp "^Date: \\|^X-Sent: ")
- (now (current-time))
(inhibit-point-motion-hooks t)
bface eface)
(when (and date (not (string= date "")))
(gnus-encode-date
(timezone-make-date-arpa-standard
date nil "UT")))
- (error '(0 0))))
- (real-sec (+ (* (float (car real-time)) 65536)
- (cadr real-time)))
- (sec (abs real-sec))
+ (error nil)))
+ (real-sec (and real-time
+ (+ (* (float (car real-time)) 65536)
+ (cadr real-time))))
+ (sec (and real-time (abs real-sec)))
num prev)
(cond
- ((equal real-time '(0 0))
+ ((null real-time)
"X-Sent: Unknown\n")
((zerop sec)
"X-Sent: Now\n")
(article-unhide-text (point-min) (point-max)))))
(defun article-emphasize (&optional arg)
- "Empasize text according to `gnus-emphasis-alist'."
+ "Emphasize text according to `gnus-emphasis-alist'."
(interactive (article-hidden-arg))
(unless (article-check-hidden-text 'emphasis arg)
(save-excursion
projects / gnus / blobdiff