+(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.")
+
+(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
+ "Minor mode providing more font-lock support for nested citations.
+When enabled, it automatically turns on `font-lock-mode'."
+ 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))
+