Package: emacs;
Reported by: Hong Xu <hong <at> topbug.net>
Date: Thu, 24 Nov 2016 23:23:02 UTC
Severity: minor
Tags: fixed, patch
Merged with 25124
Found in version 25.1.50
Fixed in version 27.1
Done: Lars Ingebrigtsen <larsi <at> gnus.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Hong Xu <hong <at> topbug.net> To: 25022 <at> debbugs.gnu.org Subject: bug#25022: 25.1.50; Different highlighting for different citation level in message-mode Date: Mon, 05 Dec 2016 22:08:46 -0800
[message-cited-text-color.png (image/png, attachment)]
[Message part 2 (text/plain, inline)]
On 2016-11-24 Thu 15:22 GMT-0800, Hong Xu <hong <at> topbug.net> wrote: > Currently in message-mode all cited texts are highlighted in the same > way. It would be nicer if the highlighting of different citation levels > can be easily customized. > Here is a patch and a screenshot. The default colors I chose may not be optimal -- but I guess I'll leave that part to professionals. Add support for different faces for different citation levels in message-mode. * message.el (message-font-lock-keywords) (message-font-lock-make-cited-text-matcher): Add support for different faces for different citation levels. The faces are defined in the faces named `message-cited-text-N': N of the Mth citation level will be M mod 4. (message-cited-text-1, message-cited-text-2) (message-cited-text-3, message-cited-text-4): Add customization for the faces of 4 different citation level. In the future, the number of faces may increase, as the code is flexible enough to automatically deal with that. (message-cite-level-function): Add a function to customize the determination of cite levels given the prefix of the cited text.
[message.patch (text/x-diff, inline)]
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 448ba7b99718..a61ced374aaf 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -649,6 +649,11 @@ message-cite-prefix-regexp
(setq gnus-message-cite-prefix-regexp
(concat "^\\(?:" value "\\)"))))))
+(defcustom message-cite-level-function
+ (lambda (s) (cl-count ?> s))
+ "A function to determine the level of cited text. The function
+ accepts 1 parameter which is the matched prefix.")
+
(defcustom message-cancel-message "I am canceling my own article.\n"
"Message to be inserted in the cancel message."
:group 'message-interface
@@ -1548,18 +1553,57 @@ message-separator
(put 'message-separator-face 'face-alias 'message-separator)
(put 'message-separator-face 'obsolete-face "22.1")
-(defface message-cited-text
+(defface message-cited-text-1
'((((class color)
(background dark))
(:foreground "LightPink1"))
(((class color)
(background light))
- (:foreground "red"))
+ (:foreground "red1"))
+ (t
+ (:bold t)))
+ "Face used for displaying 1st-level cited text."
+ :group 'message-faces)
+
+(defface message-cited-text-2
+ '((((class color)
+ (background dark))
+ (:foreground "forest green"))
+ (((class color)
+ (background light))
+ (:foreground "red4"))
(t
(:bold t)))
- "Face used for displaying cited text names."
+ "Face used for displaying 2nd-level cited text."
:group 'message-faces)
+
+(defface message-cited-text-3
+ '((((class color)
+ (background dark))
+ (:foreground "goldenrod3"))
+ (((class color)
+ (background light))
+ (:foreground "OliveDrab4"))
+ (t
+ (:bold t)))
+ "Face used for displaying 3rd-level cited text."
+ :group 'message-faces)
+
+(defface message-cited-text-4
+ '((((class color)
+ (background dark))
+ (:foreground "chocolate3"))
+ (((class color)
+ (background light))
+ (:foreground "SteelBlue4"))
+ (t
+ (:bold t)))
+ "Face used for displaying 4th-level cited text."
+ :group 'message-faces)
+
;; backward-compatibility alias
+(put 'message-cited-text 'face-alias 'message-cited-text-1)
+(put 'message-cited-text 'obsolete-face "26.1")
(put 'message-cited-text-face 'face-alias 'message-cited-text)
(put 'message-cited-text-face 'obsolete-face "22.1")
@@ -1596,45 +1640,83 @@ message-font-lock-make-header-matcher
(byte-compile form)
form)))
+(defun message-font-lock-make-cited-text-matcher (level maxlevel)
+ "Generate the matcher for cited text. LEVEL is the citation
+level to be matched and MAXLEVEL is the number of levels
+specified in the faces `message-cited-text-*'."
+ (byte-compile
+ `(lambda (limit)
+ (let (matched)
+ ;; Keep search until `message-cite-level-function' returns the level
+ ;; we want to match.
+ (while
+ (and (re-search-forward (concat "^\\("
+ message-cite-prefix-regexp
+ "\\).*")
+ limit t)
+ (not (setq matched
+ (save-match-data
+ (= ,(1- level)
+ (mod
+ (1- (funcall message-cite-level-function
+ (match-string 1)))
+ ,maxlevel)))))))
+ matched))))
+
(defvar message-font-lock-keywords
- (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
- `((,(message-font-lock-make-header-matcher
- (concat "^\\([Tt]o:\\)" content))
- (1 'message-header-name)
- (2 'message-header-to nil t))
- (,(message-font-lock-make-header-matcher
- (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content))
- (1 'message-header-name)
- (2 'message-header-cc nil t))
- (,(message-font-lock-make-header-matcher
- (concat "^\\([Ss]ubject:\\)" content))
- (1 'message-header-name)
- (2 'message-header-subject nil t))
- (,(message-font-lock-make-header-matcher
- (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
- (1 'message-header-name)
- (2 'message-header-newsgroups nil t))
- (,(message-font-lock-make-header-matcher
- (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
- (1 'message-header-name)
- (2 'message-header-xheader))
- (,(message-font-lock-make-header-matcher
- (concat "^\\([A-Z][^: \n\t]+:\\)" content))
- (1 'message-header-name)
- (2 'message-header-other nil t))
- ,@(if (and mail-header-separator
- (not (equal mail-header-separator "")))
- `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
- 1 'message-separator))
- nil)
- ((lambda (limit)
- (re-search-forward (concat "^\\("
- message-cite-prefix-regexp
- "\\).*")
- limit t))
- (0 'message-cited-text))
- ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
- (0 'message-mml))))
+ (nconc
+ (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
+ `((,(message-font-lock-make-header-matcher
+ (concat "^\\([Tt]o:\\)" content))
+ (1 'message-header-name)
+ (2 'message-header-to nil t))
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content))
+ (1 'message-header-name)
+ (2 'message-header-cc nil t))
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\([Ss]ubject:\\)" content))
+ (1 'message-header-name)
+ (2 'message-header-subject nil t))
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
+ (1 'message-header-name)
+ (2 'message-header-newsgroups nil t))
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
+ (1 'message-header-name)
+ (2 'message-header-xheader))
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\([A-Z][^: \n\t]+:\\)" content))
+ (1 'message-header-name)
+ (2 'message-header-other nil t))
+ ,@(if (and mail-header-separator
+ (not (equal mail-header-separator "")))
+ `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
+ 1 'message-separator))
+ nil)
+ ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
+ (0 'message-mml))))
+ ;; Additional font locks to highlight different levels of cited text
+ (let ((maxlevel 1)
+ (level 1)
+ cited-text-face
+ keywords)
+ ;; Compute the max level.
+ (while (setq cited-text-face
+ (intern-soft (format "message-cited-text-%d" maxlevel)))
+ (setq maxlevel (1+ maxlevel)))
+ (setq maxlevel (1- maxlevel))
+ ;; Generate the keywords.
+ (while (setq cited-text-face
+ (intern-soft (format "message-cited-text-%d" level)))
+ (setq keywords
+ (cons
+ `(,(message-font-lock-make-cited-text-matcher level maxlevel)
+ (0 ',cited-text-face))
+ keywords))
+ (setq level (1+ level)))
+ keywords))
"Additional expressions to highlight in Message mode.")
(defvar message-face-alist
[signature.asc (application/pgp-signature, inline)]
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.