;;; gnus-cite.el --- parse citations in articles for Gnus
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005 Free Software Foundation, Inc.
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Per Abhiddenware
;;; Code:
(eval-when-compile (require 'cl))
+(eval-when-compile
+ (when (featurep 'xemacs)
+ (require 'easy-mmode))) ; for `define-minor-mode'
(require 'gnus)
(require 'gnus-range)
;;; 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'.
`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)
(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)