;;; Code:
+(require 'custom)
(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.
-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.")
+(defgroup article nil
+ "Article display."
+ :group 'gnus)
-(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.
+(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 `gnus-visible-headers' is non-nil, this variable will be ignored."
+ :type '(choice :custom-show nil
+ regexp
+ (repeat regexp))
+ :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.")
-
-(defvar gnus-sorted-header-list
+If this variable is non-nil, `gnus-ignored-headers' will be ignored."
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp)
+ :group 'article)
+
+(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 regexp)
+ :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 '("^-- $" "^-- *$")
+`reply-to', and `date'."
+ :type '(set (const :tag "Headers with no content." empty)
+ (const :tag "Newsgroups with only one group." newsgroups)
+ (const :tag "Followup-to identical to newsgroups." followup-to)
+ (const :tag "Reply-to identical to from." reply-to)
+ (const :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.")
+the end of the buffer."
+ :type '(repeat string)
+ :group 'article)
-(defvar gnus-signature-limit nil
- "Provide a limit to what is considered a signature.
+(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 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.")
+regexp. If it matches, the text in question is not a signature."
+ :type '(choice integer number function regexp)
+ :group 'article)
-(defvar gnus-hidden-properties '(invisible t intangible t)
- "Property list to use for hiding text.")
+(defcustom gnus-hidden-properties '(invisible t intangible t)
+ "Property list to use for hiding text."
+ :type 'sexp
+ :group 'article)
-(defvar gnus-article-x-face-command
+(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
+ (let ((format
+ "\\(\\s-\\|^\\|[\"\(]\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*\\)%s\\)\\(\\s-\\|[?!.,;:\"\)]\\)")
+ (types
+ '(("_" "_" underline)
+ ("/" "/" italic)
+ ("\\*" "\\*" bold)
+ ("_/" "/_" underline-italic)
+ ("_\\*" "\\*_" underline-bold)
+ ("\\*/" "/\\*" bold-italic)
+ ("_\\*/" "/\\*_" underline-bold-italic))))
+ `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+ 2 3 gnus-emphasis-underline)
+ ,@(mapcar
+ (lambda (spec)
+ (list
+ (format format (car spec) (cadr spec))
+ 2 3 (intern (format "gnus-emphasis-%s" (caddr spec)))))
+ types)))
"Alist that says how to fontify certain phrases.
Each item looks like this:
- (\"_\\\\([[\\w+\\\\)_\" 0 1 'underline)
+ (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
The first element is a regular expression to be matched. The second
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)
+
+(defface gnus-emphasis-bold '((t (:bold t)))
+ "Face used for displaying strong emphasized text (*word*)."
+ :group 'article)
+
+(defface gnus-emphasis-italic '((t (:italic t)))
+ "Face used for displaying italic emphasized text (/word/)."
+ :group 'article)
+
+(defface gnus-emphasis-underline '((t (:underline t)))
+ "Face used for displaying underlined emphasized text (_word_)."
+ :group 'article)
+
+(defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
+ "Face used for displaying underlined bold emphasized text (_*word*_)."
+ :group 'article)
+
+(defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
+ "Face used for displaying underlined italic emphasized text (_*word*_)."
+ :group 'article)
+
+(defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
+ "Face used for displaying bold italic emphasized text (/*word*/)."
+ :group 'article)
+
+(defface gnus-emphasis-underline-bold-italic
+ '((t (:bold t :italic t :underline t)))
+ "Face used for displaying underlined bold italic emphasized text (_/*word*/_)."
+ :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)
;; Then treat the rest of the header lines.
(narrow-to-region
(point)
- (progn (search-forward "\n\n" nil t) (forward-line -1) (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
((eq elem 'date)
(let ((date (message-fetch-field "date")))
(when (and date
- (< (gnus-days-between date (current-time-string))
+ (< (gnus-days-between (current-time-string) date)
4))
(article-hide-header "date")))))))))))
(delete-region
(point)
(progn
- (while (looking-at "^[ \t]*$")
+ (while (and (not (bobp))
+ (looking-at "^[ \t]*$"))
(forward-line -1))
(forward-line 1)
(point))))))
(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)))
+ (when (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")
"Remove all blank lines from the beginning of the article."
(interactive)
(save-excursion
- (let (buffer-read-only)
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
(goto-char (point-min))
(when (search-forward "\n\n" nil t)
- (while (looking-at "[ \t]$")
+ (while (and (not (eobp))
+ (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."
+ "Narrow to the signature; return t if a signature is found, else nil."
(widen)
(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))))
+ (ignore-errors
+ (narrow-to-region
+ (funcall (intern "mime::preview-content-info/point-min") pcinfo)
+ (point-max)))))
(when (article-search-signature)
(forward-line 1)
;; 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)))
+ (list gnus-signature-limit)))
limit limited)
(while (setq limit (pop limits))
(if (or (and (integerp limit)
(funcall limit))
(and (stringp limit)
(not (re-search-forward limit nil t))))
- () ; This limit did not succeed.
+ () ; This limit did not succeed.
(setq limited t
limits nil)))
(unless limited
(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))
(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 "")))
(concat "Date: " date "\n"))
;; Do an X-Sent lapsed format.
((eq type 'lapsed)
- ;; If the date is seriously mangled, the timezone
- ;; functions are liable to bug out, so we condition-case
- ;; the entire thing.
+ ;; If the date is seriously mangled, the timezone functions are
+ ;; liable to bug out, so we ignore all errors.
(let* ((now (current-time))
(real-time
- (condition-case ()
- (gnus-time-minus
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- (current-time-string now)
- (current-time-zone now) "UT"))
- (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))
+ (ignore-errors
+ (gnus-time-minus
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ (current-time-string now)
+ (current-time-zone now) "UT"))
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT")))))
+ (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
visible (nth 2 elem)
face (nth 3 elem))
(while (re-search-forward regexp nil t)
- (article-hide-text
- (match-beginning invisible) (match-end invisible) props)
- (article-unhide-text-type
- (match-beginning visible) (match-end visible) 'emphasis)
- (put-text-property
- (match-beginning visible) (match-end visible)
- 'face face)))))))
+ (when (and (match-beginning visible) (match-beginning invisible))
+ (article-hide-text
+ (match-beginning invisible) (match-end invisible) props)
+ (article-unhide-text-type
+ (match-beginning visible) (match-end visible) 'emphasis)
+ (put-text-property
+ (match-beginning visible) (match-end visible) 'face face)
+ (goto-char (match-end invisible)))))))))
(provide 'article)
projects / gnus / blobdiff