;; 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,
(defface gnus-cite-10 '((((class color)
(background dark))
- (:foreground "medium purple"))
+ (:foreground "plum1"))
(((class color)
(background light))
(:foreground "medium purple"))
(defcustom gnus-cite-face-list
'(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)
+ 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."
(setq line (1+ line)))
;; Horrible special case for some Microsoft mailers.
(goto-char (point-min))
- (when (re-search-forward gnus-cite-unsightly-citation-regexp max t)
- (setq begin (count-lines (point-min) (point)))
- (setq end (count-lines (point-min) max))
- (setq entry nil)
- (while (< begin end)
- (push begin entry)
- (setq begin (1+ begin)))
+ (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
;; 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.
+;; - message-cite-prefix will be overridden if this is enabled.
-(defconst gnus-message-max-citation-depth
+(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 (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))
+ (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))
(count 1))
;; (require 'gnus-cite)
(dolist (face gnus-cite-face-list (nreverse list))
- (push (list count (list 'quote face) 'prepend) list)
+ (push (list count (list 'quote face) 'prepend t) 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.")))
+(eval-when-compile
+ (defvar font-lock-defaults-computed)
+ (defvar font-lock-keywords)
+ (defvar font-lock-set-defaults))
-(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.")))
+(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."
+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
- (if gnus-message-citation-mode
- (gnus-message-add-citation-keywords)
- (gnus-message-remove-citation-keywords))
- (font-lock-fontify-buffer))
+ (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'."
projects / gnus / blobdiff