;; 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"))
(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
"[ \t [:alnum:]]+")))
gnus-message-max-citation-depth))
(mlist (make-list (* (1+ gnus-message-max-citation-depth) 2) nil))
- (start (line-beginning-position))
- (end (line-end-position)))
+ (start (point-at-bol))
+ (end (point-at-eol)))
(setcar mlist start)
(setcar (cdr mlist) end)
(setcar (nthcdr (* cdepth 2) mlist) start)
"Keywords for highlighting different levels of message citations.")
(eval-when-compile
- (autoload 'font-lock-compile-keywords "font-lock")
+ (defvar font-lock-defaults-computed)
(defvar font-lock-keywords)
- (unless (fboundp 'font-lock-add-keywords)
- (autoload 'font-lock-add-keywords "font-lock"))
- (unless (fboundp 'font-lock-remove-keywords)
- (autoload 'font-lock-remove-keywords "font-lock")))
-
-(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 'append)
- (font-lock-set-defaults)
- (let ((was-compiled (eq (car font-lock-keywords) t)))
- (setq font-lock-keywords (copy-sequence (if was-compiled
- (cadr font-lock-keywords)
- font-lock-keywords)))
- (dolist (keyword gnus-message-citation-keywords)
- (setq font-lock-keywords (delete keyword font-lock-keywords)))
- (let ((old (if (eq (car-safe font-lock-keywords) t)
- (cdr font-lock-keywords)
- font-lock-keywords)))
- (setq font-lock-keywords (append old gnus-message-citation-keywords)))
- (if was-compiled
- (setq font-lock-keywords
- (font-lock-compile-keywords font-lock-keywords))))))
-
-(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)
- (font-lock-set-defaults)
- (let ((was-compiled (eq (car font-lock-keywords) t)))
- (if was-compiled
- (setq font-lock-keywords (cadr font-lock-keywords)))
- (setq font-lock-keywords (copy-sequence font-lock-keywords))
- (dolist (keyword gnus-message-citation-keywords)
- (setq font-lock-keywords (delete keyword font-lock-keywords)))
- (if was-compiled
- (setq font-lock-keywords
- (font-lock-compile-keywords 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."
+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