(gnus-article-highlight-citation): Add KEEP-BUFFER arg.

[gnus] / lisp / gnus-cite.el

diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el
index 7c60d76..00f815a 100644 (file)
--- a/lisp/gnus-cite.el
+++ b/lisp/gnus-cite.el
@@ -27,6 +27,9 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+(eval-when-compile
+  (when (featurep 'xemacs)
+    (require 'easy-mmode))) ; for `define-minor-mode'
 
 (require 'gnus)
 (require 'gnus-range)
@@ -367,7 +370,7 @@ in a boring face, then the pages will be skipped."
 
 ;;; Commands:
 
-(defun gnus-article-highlight-citation (&optional force)
+(defun gnus-article-highlight-citation (&optional force keep-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'.
@@ -381,7 +384,8 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
 `gnus-cite-attribution-prefix' are considered attribution lines."
   (interactive (list 'force))
   (save-excursion
-    (set-buffer gnus-article-buffer)
+    (unless keep-buffer
+      (set-buffer gnus-article-buffer))
     (gnus-cite-parse-maybe force)
     (let ((buffer-read-only nil)
          (alist gnus-cite-prefix-alist)
@@ -1100,6 +1104,86 @@ See also the documentation for `gnus-article-highlight-citation'."
          (setq found t)))
       found)))
 
+
+;; Highlighting of different citation levels in message-mode.
+;;
+;; Known bugs:
+;;
+;; - XEmacs compatibility: `font-lock-add-keywords' is missing in XEmacs.
+;;
+;; - message-cite-prefix should not be fontified.
+
+(defconst gnus-message-max-citation-depth
+  (length gnus-cite-face-list)
+  "Maximum supported level of citation.")
+
+(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 (eval-when-compile
+                            (concat "^\\(?:"
+                                    message-cite-prefix-regexp
+                                    "\\)"))
+                          limit t)
+    (let ((cdepth
+          (length (apply 'concat
+                         (split-string
+                          (match-string-no-properties 0)
+                          "[ \t [:alnum:]]+"))))
+         (mlist (make-list (* (1+ gnus-message-max-citation-depth)
+                              2)
+                           0)))
+      (setcar (nthcdr (* cdepth 2) mlist)
+             (line-beginning-position))
+      (setcar (nthcdr (1+ (* cdepth 2)) mlist)
+             (line-end-position))
+      (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) list)
+          (setq count (1+ count)))))) ;;
+  "Keywords for highlighting different levels of message citations.")
+
+(defun gnus-message-add-citation-keywords ()
+  "Add font-lock for nested citations to current buffer."
+  (if (fboundp 'font-lock-add-keywords)
+      (font-lock-add-keywords nil gnus-message-citation-keywords)
+    (gnus-message 1 "`font-lock-add-keywords' not supported.")))
+
+(defun gnus-message-remove-citation-keywords ()
+  "Remove font-lock for nested citations from current buffer."
+  (if (fboundp 'font-lock-remove-keywords)
+      (font-lock-remove-keywords nil gnus-message-citation-keywords)
+    (gnus-message 1 "`font-lock-remove-keywords' not supported.")))
+
+(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."
+  nil ;; init-value
+  "" ;; lighter
+  nil ;; keymap
+  (if gnus-message-citation-mode
+      (gnus-message-add-citation-keywords)
+    (gnus-message-remove-citation-keywords))
+  (font-lock-fontify-buffer))
+
+(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)