From: Hong Xu Date: Mon, 23 Sep 2019 11:09:36 +0000 (+0200) Subject: Add different faces for different citation levels in Message mode X-Git-Tag: emacs-27.0.90~1474 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4c1edb0228721c54dff4db6a1df303be3b39aa39;p=emacs.git 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). --- diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c211bcc2654..35baae01f97 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -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