;;; gnus-cite.el --- parse citations in articles for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Per Abhiddenware
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
(eval-when-compile (require 'cl))
+(eval-when-compile
+ (when (featurep 'xemacs)
+ (require 'easy-mmode))) ; for `define-minor-mode'
(require 'gnus)
-(require 'gnus-art)
(require 'gnus-range)
+(require 'gnus-art)
(require 'message) ; for message-cite-prefix-regexp
;;; Customization:
:link '(custom-manual "(gnus)Article Highlighting")
:group 'gnus-article)
-(defcustom gnus-cite-reply-regexp
- "^\\(Subject: Re\\|In-Reply-To\\|References\\):"
- "*If headers match this regexp it is reasonable to believe that
-article has citations."
- :group 'gnus-cite
- :type 'string)
-
-(defcustom gnus-cite-always-check nil
- "Check article always for citations. Set it t to check all articles."
- :group 'gnus-cite
- :type '(choice (const :tag "no" nil)
- (const :tag "yes" t)))
-
(defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
"Format of opened cited text buttons."
:group 'gnus-cite
:group 'gnus-cite
:type 'integer)
+;; Some Microsoft products put in a citation that extends to the
+;; remainder of the message:
+;;
+;; -----Original Message-----
+;; From: ...
+;; To: ...
+;; Sent: ... [date, in non-RFC-2822 format]
+;; Subject: ...
+;;
+;; Cited message, with no prefixes
+;;
+;; The four headers are always the same. But note they are prone to
+;; folding without additional indentation.
+;;
+;; Others use "----- Original Message -----" instead, and properly quote
+;; the body using "> ". This style is handled without special cases.
+
(defcustom gnus-cite-attribution-prefix
- "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|-----Original Message-----"
+ "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----"
"*Regexp matching the beginning of an attribution line."
:group 'gnus-cite
:type 'regexp)
(defcustom gnus-cite-attribution-suffix
- "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----Original Message-----\\)[ \t]*$"
+ "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$"
"*Regexp matching the end of an attribution line.
The text matching the first grouping will be used as a button."
:group 'gnus-cite
:type 'regexp)
-(defface gnus-cite-attribution-face '((t
- (:italic t)))
- "Face used for attribution lines.")
+(defcustom gnus-cite-unsightly-citation-regexp
+ "^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
+ "Regexp matching Microsoft-type rest-of-message citations."
+ :version "22.1"
+ :group 'gnus-cite
+ :type 'regexp)
+
+(defcustom gnus-cite-ignore-quoted-from t
+ "Non-nil means don't regard lines beginning with \">From \" as cited text.
+Those lines may have been quoted by MTAs in order not to mix up with
+the envelope From line."
+ :version "22.1"
+ :group 'gnus-cite
+ :type 'boolean)
+
+(defface gnus-cite-attribution '((t (:italic t)))
+ "Face used for attribution lines."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-attribution-face 'face-alias 'gnus-cite-attribution)
-(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
+(defcustom gnus-cite-attribution-face 'gnus-cite-attribution
"Face used for attribution lines.
It is merged with the face for the cited text belonging to the attribution."
+ :version "22.1"
:group 'gnus-cite
:type 'face)
-(defface gnus-cite-face-1 '((((class color)
- (background dark))
- (:foreground "light blue"))
- (((class color)
- (background light))
- (:foreground "MidnightBlue"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-2 '((((class color)
- (background dark))
- (:foreground "light cyan"))
- (((class color)
- (background light))
- (:foreground "firebrick"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-3 '((((class color)
- (background dark))
- (:foreground "light yellow"))
- (((class color)
- (background light))
- (:foreground "dark green"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-4 '((((class color)
- (background dark))
- (:foreground "light pink"))
- (((class color)
- (background light))
- (:foreground "OrangeRed"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-5 '((((class color)
- (background dark))
- (:foreground "pale green"))
- (((class color)
- (background light))
- (:foreground "dark khaki"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-6 '((((class color)
- (background dark))
- (:foreground "beige"))
- (((class color)
- (background light))
- (:foreground "dark violet"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-7 '((((class color)
- (background dark))
- (:foreground "orange"))
- (((class color)
- (background light))
- (:foreground "SteelBlue4"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-8 '((((class color)
- (background dark))
- (:foreground "magenta"))
- (((class color)
- (background light))
- (:foreground "magenta"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-9 '((((class color)
- (background dark))
- (:foreground "violet"))
- (((class color)
- (background light))
- (:foreground "violet"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-10 '((((class color)
- (background dark))
- (:foreground "medium purple"))
- (((class color)
- (background light))
- (:foreground "medium purple"))
- (t
- (:italic t)))
- "Citation face.")
-
-(defface gnus-cite-face-11 '((((class color)
- (background dark))
- (:foreground "turquoise"))
- (((class color)
- (background light))
- (:foreground "turquoise"))
- (t
- (:italic t)))
- "Citation face.")
+(defface gnus-cite-1 '((((class color)
+ (background dark))
+ (:foreground "light blue"))
+ (((class color)
+ (background light))
+ (:foreground "MidnightBlue"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-1 'face-alias 'gnus-cite-1)
+
+(defface gnus-cite-2 '((((class color)
+ (background dark))
+ (:foreground "light cyan"))
+ (((class color)
+ (background light))
+ (:foreground "firebrick"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-2 'face-alias 'gnus-cite-2)
+
+(defface gnus-cite-3 '((((class color)
+ (background dark))
+ (:foreground "light yellow"))
+ (((class color)
+ (background light))
+ (:foreground "dark green"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-3 'face-alias 'gnus-cite-3)
+
+(defface gnus-cite-4 '((((class color)
+ (background dark))
+ (:foreground "light pink"))
+ (((class color)
+ (background light))
+ (:foreground "OrangeRed"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-4 'face-alias 'gnus-cite-4)
+
+(defface gnus-cite-5 '((((class color)
+ (background dark))
+ (:foreground "pale green"))
+ (((class color)
+ (background light))
+ (:foreground "dark khaki"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-5 'face-alias 'gnus-cite-5)
+
+(defface gnus-cite-6 '((((class color)
+ (background dark))
+ (:foreground "beige"))
+ (((class color)
+ (background light))
+ (:foreground "dark violet"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-6 'face-alias 'gnus-cite-6)
+
+(defface gnus-cite-7 '((((class color)
+ (background dark))
+ (:foreground "orange"))
+ (((class color)
+ (background light))
+ (:foreground "SteelBlue4"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-7 'face-alias 'gnus-cite-7)
+
+(defface gnus-cite-8 '((((class color)
+ (background dark))
+ (:foreground "magenta"))
+ (((class color)
+ (background light))
+ (:foreground "magenta"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-8 'face-alias 'gnus-cite-8)
+
+(defface gnus-cite-9 '((((class color)
+ (background dark))
+ (:foreground "violet"))
+ (((class color)
+ (background light))
+ (:foreground "violet"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-9 'face-alias 'gnus-cite-9)
+
+(defface gnus-cite-10 '((((class color)
+ (background dark))
+ (:foreground "plum1"))
+ (((class color)
+ (background light))
+ (:foreground "medium purple"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-10 'face-alias 'gnus-cite-10)
+
+(defface gnus-cite-11 '((((class color)
+ (background dark))
+ (:foreground "turquoise"))
+ (((class color)
+ (background light))
+ (:foreground "turquoise"))
+ (t
+ (:italic t)))
+ "Citation face."
+ :group 'gnus-cite)
+;; backward-compatibility alias
+(put 'gnus-cite-face-11 'face-alias 'gnus-cite-11)
(defcustom gnus-cite-face-list
- '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4
- gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
- gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11)
+ '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6
+ gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11)
"*List of faces used for highlighting citations.
When there are citations from multiple articles in the same message,
Gnus will try to give each citation from each article its own face.
This should make it easier to see who wrote what."
:group 'gnus-cite
- :type '(repeat face))
+ :type '(repeat face)
+ :set (lambda (symbol value)
+ (prog1
+ (custom-set-default symbol value)
+ (if (boundp 'gnus-message-max-citation-depth)
+ (setq gnus-message-max-citation-depth (length value)))
+ (if (boundp 'gnus-message-citation-keywords)
+ (setq gnus-message-citation-keywords
+ `((gnus-message-search-citation-line
+ ,@(let ((list nil)
+ (count 1))
+ (dolist (face value (nreverse list))
+ (push (list count (list 'quote face) 'prepend t)
+ list)
+ (setq count (1+ count)))))))))))
(defcustom gnus-cite-hide-percentage 50
"Only hide excess citation if above this percentage of the body."
:group 'gnus-cite
:type 'boolean)
+;; This has to go here because its default value depends on
+;; gnus-cite-face-list.
+(defcustom gnus-article-boring-faces (cons 'gnus-signature gnus-cite-face-list)
+ "List of faces that are not worth reading.
+If an article has more pages below the one you are looking at, but
+nothing on those pages is a word of at least three letters that is not
+in a boring face, then the pages will be skipped."
+ :type '(repeat face)
+ :group 'gnus-article-hiding)
+
;;; Internal Variables:
(defvar gnus-cite-article nil)
;;; Commands:
-(defun gnus-article-highlight-citation (&optional force)
+(defun gnus-article-highlight-citation (&optional force same-buffer)
"Highlight cited text.
Each citation in the article will be highlighted with a different face.
The faces are taken from `gnus-cite-face-list'.
Attribution lines are highlighted with the same face as the
-corresponding citation merged with `gnus-cite-attribution-face'.
+corresponding citation merged with the face `gnus-cite-attribution'.
Text is considered cited if at least `gnus-cite-minimum-match-count'
lines matches `message-cite-prefix-regexp' with the same prefix.
`gnus-cite-attribution-prefix' are considered attribution lines."
(interactive (list 'force))
(save-excursion
- (set-buffer gnus-article-buffer)
+ (unless same-buffer
+ (set-buffer gnus-article-buffer))
(gnus-cite-parse-maybe force)
(let ((buffer-read-only nil)
(alist gnus-cite-prefix-alist)
(goto-char (point-min))
(forward-line (1- number))
(when (re-search-forward gnus-cite-attribution-suffix
- (save-excursion (end-of-line 1) (point))
+ (point-at-eol)
t)
(gnus-article-add-button (match-beginning 1) (match-end 1)
'gnus-cite-toggle prefix))
variables are ignored.
See also the documentation for `gnus-article-highlight-citation'."
(interactive (append (gnus-article-hidden-arg) '(force)))
- (unless (gnus-article-check-hidden-text 'cite arg)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe force)
- (article-goto-body)
- (let ((start (point))
- (atts gnus-cite-attribution-alist)
- (buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (hidden 0)
- total)
- (goto-char (point-max))
- (gnus-article-search-signature)
- (setq total (count-lines start (point)))
- (while atts
- (setq hidden (+ hidden (length (cdr (assoc (cdar atts)
- gnus-cite-prefix-alist))))
- atts (cdr atts)))
- (when (or force
- (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))
- (> hidden gnus-cite-hide-absolute)))
- (setq atts gnus-cite-attribution-alist)
+ (with-current-buffer gnus-article-buffer
+ (gnus-delete-wash-type 'cite)
+ (unless (gnus-article-check-hidden-text 'cite arg)
+ (save-excursion
+ (gnus-cite-parse-maybe force)
+ (article-goto-body)
+ (let ((start (point))
+ (atts gnus-cite-attribution-alist)
+ (buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (hidden 0)
+ total)
+ (goto-char (point-max))
+ (gnus-article-search-signature)
+ (setq total (count-lines start (point)))
(while atts
- (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
- atts (cdr atts))
- (while total
- (setq hidden (car total)
- total (cdr total))
- (goto-char (point-min))
- (forward-line (1- hidden))
- (unless (assq hidden gnus-cite-attribution-alist)
- (gnus-add-text-properties
- (point) (progn (forward-line 1) (point))
- (nconc (list 'article-type 'cite)
- gnus-hidden-properties))))))))))
+ (setq hidden (+ hidden (length (cdr (assoc (cdar atts)
+ gnus-cite-prefix-alist))))
+ atts (cdr atts)))
+ (when (or force
+ (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))
+ (> hidden gnus-cite-hide-absolute)))
+ (gnus-add-wash-type 'cite)
+ (setq atts gnus-cite-attribution-alist)
+ (while atts
+ (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
+ atts (cdr atts))
+ (while total
+ (setq hidden (car total)
+ total (cdr total))
+ (goto-char (point-min))
+ (forward-line (1- hidden))
+ (unless (assq hidden gnus-cite-attribution-alist)
+ (gnus-add-text-properties
+ (point) (progn (forward-line 1) (point))
+ (nconc (list 'article-type 'cite)
+ gnus-hidden-properties)))))))))
+ (gnus-set-mode-line 'article)))
(defun gnus-article-hide-citation-in-followups ()
"Hide cited text in non-root articles."
(defun gnus-cite-delete-overlays ()
(dolist (overlay gnus-cite-overlay-list)
- (when (or (not (gnus-overlay-end overlay))
- (and (>= (gnus-overlay-end overlay) (point-min))
- (<= (gnus-overlay-end overlay) (point-max))))
- (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
- (ignore-errors
- (gnus-delete-overlay overlay)))))
+ (ignore-errors
+ (when (or (not (gnus-overlay-end overlay))
+ (and (>= (gnus-overlay-end overlay) (point-min))
+ (<= (gnus-overlay-end overlay) (point-max))))
+ (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
+ (ignore-errors
+ (gnus-delete-overlay overlay))))))
(defun gnus-cite-parse-wrapper ()
;; Wrap chopped gnus-cite-parse.
;; Each line.
(setq begin (point)
guess-limit (progn (skip-chars-forward "^> \t\r\n") (point))
- end (progn (beginning-of-line 2) (point))
+ end (point-at-bol 2)
start end)
(goto-char begin)
;; Ignore standard Supercite attribution prefix.
;; Ignore very long prefixes.
(when (> end (+ begin gnus-cite-max-prefix))
(setq end (+ begin gnus-cite-max-prefix)))
+ ;; Ignore quoted envelope From_.
+ (when (and gnus-cite-ignore-quoted-from
+ (prog2
+ (setq case-fold-search nil)
+ (looking-at ">From ")
+ (setq case-fold-search t)))
+ (setq end (1+ begin)))
(while (re-search-forward prefix-regexp (1- end) t)
;; Each prefix.
(setq end (match-end 0)
prefix (buffer-substring begin end))
- (gnus-set-text-properties 0 (length prefix) nil prefix)
+ (set-text-properties 0 (length prefix) nil prefix)
(setq entry (assoc prefix alist))
(if entry
(setcdr entry (cons line (cdr entry)))
(goto-char begin))
(goto-char start)
(setq line (1+ line)))
+ ;; Horrible special case for some Microsoft mailers.
+ (goto-char (point-min))
+ (setq start t begin nil entry nil)
+ (while start
+ ;; Assume this search ends up at the beginning of a line.
+ (if (re-search-forward gnus-cite-unsightly-citation-regexp max t)
+ (progn
+ (when (number-or-marker-p start)
+ (setq begin (count-lines (point-min) start)
+ end (count-lines (point-min) (match-beginning 0))))
+ (setq start (match-end 0)))
+ (when (number-or-marker-p start)
+ (setq begin (count-lines (point-min) start)
+ end (count-lines (point-min) max)))
+ (setq start nil))
+ (when begin
+ (while (< begin end)
+ ;; Need to do 1+ because we're in the bol.
+ (push (setq begin (1+ begin)) entry))))
+ (when entry
+ (push (cons "" entry) alist))
;; We got all the potential prefixes. Now create
;; `gnus-cite-prefix-alist' containing the oldest prefix for each
- ;; line that appears at least gnus-cite-minimum-match-count
+ ;; line that appears at least `gnus-cite-minimum-match-count'
;; times. First sort them by length. Longer is older.
(setq alist (sort alist (lambda (a b)
(> (length (car a)) (length (car b))))))
(let ((al (buffer-substring (save-excursion (beginning-of-line 0)
(1+ (point)))
end)))
- (if (not (assoc al al-alist))
- (progn
- (push (list wrote in prefix tag)
- gnus-cite-loose-attribution-alist)
- (push (cons al t) al-alist))))))))
+ (when (not (assoc al al-alist))
+ (push (list wrote in prefix tag)
+ gnus-cite-loose-attribution-alist)
+ (push (cons al t) al-alist)))))))
(defun gnus-cite-connect-attributions ()
;; Connect attributions to citations
(when (< from to)
(push (setq overlay (gnus-make-overlay from to))
gnus-cite-overlay-list)
+ (gnus-overlay-put overlay 'evaporate t)
(gnus-overlay-put overlay 'face face))))))
(defun gnus-cite-toggle (prefix)
(while vars
(make-local-variable (pop vars)))))
+(defun gnus-cited-line-p ()
+ "Say whether the current line is a cited line."
+ (save-excursion
+ (beginning-of-line)
+ (let ((found nil))
+ (dolist (prefix (mapcar 'car gnus-cite-prefix-alist))
+ (when (string= (buffer-substring (point) (+ (length prefix) (point)))
+ prefix)
+ (setq found t)))
+ found)))
+
+
+;; Highlighting of different citation levels in message-mode.
+;; - message-cite-prefix will be overridden if this is enabled.
+
+(defvar gnus-message-max-citation-depth
+ (length gnus-cite-face-list)
+ "Maximum supported level of citation.")
+
+(defvar gnus-message-cite-prefix-regexp
+ (concat "^\\(?:" message-cite-prefix-regexp "\\)"))
+
+(defun gnus-message-search-citation-line (limit)
+ "Search for a cited line and set match data accordingly.
+Returns nil if there is no such line before LIMIT, t otherwise."
+ (when (re-search-forward gnus-message-cite-prefix-regexp limit t)
+ (let ((cdepth (min (length (apply 'concat
+ (split-string
+ (match-string-no-properties 0)
+ "[ \t [:alnum:]]+")))
+ gnus-message-max-citation-depth))
+ (mlist (make-list (* (1+ gnus-message-max-citation-depth) 2) nil))
+ (start (point-at-bol))
+ (end (point-at-eol)))
+ (setcar mlist start)
+ (setcar (cdr mlist) end)
+ (setcar (nthcdr (* cdepth 2) mlist) start)
+ (setcar (nthcdr (1+ (* cdepth 2)) mlist) end)
+ (set-match-data mlist))
+ t))
+
+(defvar gnus-message-citation-keywords
+ ;; eval-when-compile ;; This breaks in XEmacs
+ `((gnus-message-search-citation-line
+ ,@(let ((list nil)
+ (count 1))
+ ;; (require 'gnus-cite)
+ (dolist (face gnus-cite-face-list (nreverse list))
+ (push (list count (list 'quote face) 'prepend t) list)
+ (setq count (1+ count)))))) ;;
+ "Keywords for highlighting different levels of message citations.")
+
+(eval-when-compile
+ (defvar font-lock-defaults-computed)
+ (defvar font-lock-keywords)
+ (defvar font-lock-set-defaults))
+
+(eval-and-compile
+ (unless (featurep 'xemacs)
+ (autoload 'font-lock-set-defaults "font-lock")))
+
+(define-minor-mode gnus-message-citation-mode
+ "Toggle `gnus-message-citation-mode' in current buffer.
+This buffer local minor mode provides additional font-lock support for
+nested citations.
+With prefix ARG, turn `gnus-message-citation-mode' on if and only if ARG
+is positive.
+Automatically turn `font-lock-mode' on when `gnus-message-citation-mode'
+is turned on."
+ nil ;; init-value
+ "" ;; lighter
+ nil ;; keymap
+ (when (eq major-mode 'message-mode)
+ (let ((defaults (car (if (featurep 'xemacs)
+ (get 'message-mode 'font-lock-defaults)
+ font-lock-defaults)))
+ default keywords)
+ (while defaults
+ (setq default (if (consp defaults)
+ (pop defaults)
+ (prog1
+ defaults
+ (setq defaults nil))))
+ (if gnus-message-citation-mode
+ ;; `gnus-message-citation-keywords' should be the last
+ ;; elements of the keywords because the others are unlikely
+ ;; to have the OVERRIDE flags -- XEmacs applies a keyword
+ ;; having no OVERRIDE flag to matched text even if it has
+ ;; already other faces, while Emacs doesn't.
+ (set (make-local-variable default)
+ (append (default-value default)
+ gnus-message-citation-keywords))
+ (kill-local-variable default))))
+ ;; Force `font-lock-set-defaults' to update `font-lock-keywords'.
+ (if (featurep 'xemacs)
+ (progn
+ (require 'font-lock)
+ (setq font-lock-defaults-computed nil
+ font-lock-keywords nil))
+ (setq font-lock-set-defaults nil))
+ (font-lock-set-defaults)
+ (cond ((symbol-value 'font-lock-mode)
+ (font-lock-fontify-buffer))
+ (gnus-message-citation-mode
+ (font-lock-mode 1)))))
+
+(defun turn-on-gnus-message-citation-mode ()
+ "Turn on `gnus-message-citation-mode'."
+ (gnus-message-citation-mode 1))
+(defun turn-off-gnus-message-citation-mode ()
+ "Turn off `gnus-message-citation-mode'."
+ (gnus-message-citation-mode -1))
+
(gnus-ems-redefine)
(provide 'gnus-cite)
;; coding: iso-8859-1
;; End:
+;;; arch-tag: 1997b044-6067-471e-8c8f-dc903093098a
;;; gnus-cite.el ends here
projects / gnus / blobdiff