Add 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 (bug#25022).
This commit is contained in:
Hong Xu
Lars Ingebrigtsen
parent
a877e2217a
commit
4c1edb0228
1 changed files with 128 additions and 46 deletions
|
|
@ -660,6 +660,12 @@ variable should be a regexp or a list of regexps."
|
|||
(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."
|
||||
:type 'function
|
||||
:version "27.1")
|
||||
|
||||
(defcustom message-cancel-message "I am canceling my own article.\n"
|
||||
"Message to be inserted in the cancel message."
|
||||
:group 'message-interface
|
||||
|
|
@ -1540,18 +1546,58 @@ starting with `not' and followed by regexps."
|
|||
"Face used for displaying the separator."
|
||||
:group 'message-faces)
|
||||
|
||||
(defface message-cited-text
|
||||
(defface message-cited-text-1
|
||||
'((((class color)
|
||||
(background dark))
|
||||
:foreground "LightPink1")
|
||||
(:foreground "LightPink1"))
|
||||
(((class color)
|
||||
(background light))
|
||||
:foreground "red")
|
||||
(:foreground "red1"))
|
||||
(t
|
||||
:bold t))
|
||||
"Face used for displaying cited text names."
|
||||
(: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 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")
|
||||
|
||||
(defface message-mml
|
||||
'((((class color)
|
||||
(background dark))
|
||||
|
|
@ -1580,48 +1626,84 @@ starting with `not' and followed by regexps."
|
|||
(set-match-data (list start (point)))
|
||||
(point))))
|
||||
|
||||
(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-*'."
|
||||
(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-match-to-eoh
|
||||
(,(concat "^\\([Tt]o:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-to nil t))
|
||||
(,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-cc nil t))
|
||||
(,(concat "^\\([Ss]ubject:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-subject nil t))
|
||||
(,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-newsgroups nil t))
|
||||
(,(concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-xheader))
|
||||
(,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-other nil t)))
|
||||
(,(lambda (limit)
|
||||
(and mail-header-separator
|
||||
(not (equal mail-header-separator ""))
|
||||
(re-search-forward
|
||||
(concat "^" (regexp-quote mail-header-separator) "$")
|
||||
limit t)))
|
||||
0 'message-separator)
|
||||
(,(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-match-to-eoh
|
||||
(,(concat "^\\([Tt]o:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-to nil t))
|
||||
(,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-cc nil t))
|
||||
(,(concat "^\\([Ss]ubject:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-subject nil t))
|
||||
(,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-newsgroups nil t))
|
||||
(,(concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-xheader))
|
||||
(,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
|
||||
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
|
||||
(1 'message-header-name)
|
||||
(2 'message-header-other nil t)))
|
||||
(,(lambda (limit)
|
||||
(and mail-header-separator
|
||||
(not (equal mail-header-separator ""))
|
||||
(re-search-forward
|
||||
(concat "^" (regexp-quote mail-header-separator) "$")
|
||||
limit t)))
|
||||
0 'message-separator)
|
||||
("<#/?\\(?: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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue