mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
* lisp/gnus/message.el: Tweak header font-lock and ecomplete completion
(message-font-lock-make-header-matcher): Delete. (message-match-to-eoh): New function to replace it. (message-font-lock-keywords): Use it. (message-strip-forbidden-properties): Remove redundant binding. (message-goto-body): Avoid called-interactively-p, only use push-mark when called interactively. (message-goto-body-1): Merge into message-goto-body. Redefine as alias. (message-goto-eoh): Call message-goto-body interactively. (message--in-tocc-p): New function, extracted from message-display-abbrev. (message-ecomplete-capf): New function.
This commit is contained in:
Stefan Monnier
parent
f2918640bf
commit
5ed5f548aa
1 changed files with 82 additions and 66 deletions
|
|
@ -1544,50 +1544,49 @@ starting with `not' and followed by regexps."
|
|||
"Face used for displaying MML."
|
||||
:group 'message-faces)
|
||||
|
||||
(defun message-font-lock-make-header-matcher (regexp)
|
||||
(let ((form
|
||||
`(lambda (limit)
|
||||
(let ((start (point)))
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward
|
||||
(concat "^" (regexp-quote mail-header-separator) "$")
|
||||
nil t)
|
||||
(setq limit (min limit (match-beginning 0))))
|
||||
(goto-char start))
|
||||
(and (< start limit)
|
||||
(re-search-forward ,regexp limit t))))))
|
||||
(if (featurep 'bytecomp)
|
||||
(byte-compile form)
|
||||
form)))
|
||||
(defun message-match-to-eoh (_limit)
|
||||
(let ((start (point)))
|
||||
(rfc822-goto-eoh)
|
||||
;; Typical situation: some temporary change causes the header to be
|
||||
;; incorrect, so EOH comes earlier than intended: the last lines of the
|
||||
;; intended headers are now not considered part of the header any more,
|
||||
;; so they don't have the multiline property set. When the change is
|
||||
;; completed and the header has its correct shape again, the lack of the
|
||||
;; multiline property means we won't rehighlight the last lines of
|
||||
;; the header.
|
||||
(if (< (point) start)
|
||||
nil ;No header within start..limit.
|
||||
;; Here we disregard LIMIT so that we may extend the area again.
|
||||
(set-match-data (list start (point)))
|
||||
(point))))
|
||||
|
||||
(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))
|
||||
`((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)))
|
||||
,@(if (and mail-header-separator
|
||||
(not (equal mail-header-separator "")))
|
||||
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
|
||||
|
|
@ -2821,8 +2820,7 @@ See also `message-forbidden-properties'."
|
|||
(message-display-abbrev))
|
||||
(when (and message-strip-special-text-properties
|
||||
(message-tamago-not-in-use-p begin))
|
||||
(let ((buffer-read-only nil)
|
||||
(inhibit-read-only t))
|
||||
(let ((inhibit-read-only t))
|
||||
(remove-text-properties begin end message-forbidden-properties))))
|
||||
|
||||
(defvar message-smileys '(":-)" ":)"
|
||||
|
|
@ -2929,7 +2927,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
|
|||
(easy-menu-add message-mode-menu message-mode-map)
|
||||
(easy-menu-add message-mode-field-menu message-mode-map)
|
||||
;; Mmmm... Forbidden properties...
|
||||
(add-hook 'after-change-functions 'message-strip-forbidden-properties
|
||||
(add-hook 'after-change-functions #'message-strip-forbidden-properties
|
||||
nil 'local)
|
||||
;; Allow mail alias things.
|
||||
(cond
|
||||
|
|
@ -2937,7 +2935,9 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
|
|||
(mail-abbrevs-setup))
|
||||
((message-mail-alias-type-p 'ecomplete)
|
||||
(ecomplete-setup)))
|
||||
(add-hook 'completion-at-point-functions 'message-completion-function nil t)
|
||||
;; FIXME: merge the completion tables from ecomplete/bbdb/...?
|
||||
;;(add-hook 'completion-at-point-functions #'message-ecomplete-capf nil t)
|
||||
(add-hook 'completion-at-point-functions #'message-completion-function nil t)
|
||||
(unless buffer-file-name
|
||||
(message-set-auto-save-file-name))
|
||||
(unless (buffer-base-buffer)
|
||||
|
|
@ -3071,17 +3071,15 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
|
|||
(push-mark)
|
||||
(message-position-on-field "Summary" "Subject"))
|
||||
|
||||
(defun message-goto-body ()
|
||||
"Move point to the beginning of the message body."
|
||||
(interactive)
|
||||
(when (and (called-interactively-p 'any)
|
||||
(looking-at "[ \t]*\n"))
|
||||
(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1")
|
||||
(defun message-goto-body (&optional interactive)
|
||||
"Move point to the beginning of the message body.
|
||||
Returns point."
|
||||
(interactive "p")
|
||||
(when interactive
|
||||
(when (looking-at "[ \t]*\n")
|
||||
(expand-abbrev))
|
||||
(push-mark)
|
||||
(message-goto-body-1))
|
||||
|
||||
(defun message-goto-body-1 ()
|
||||
"Go to the body and return point."
|
||||
(push-mark))
|
||||
(goto-char (point-min))
|
||||
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
|
||||
;; If the message is mangled, find the end of the headers the
|
||||
|
|
@ -3100,12 +3098,12 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
|
|||
"Return t if point is in the message body."
|
||||
(>= (point)
|
||||
(save-excursion
|
||||
(message-goto-body-1))))
|
||||
(message-goto-body))))
|
||||
|
||||
(defun message-goto-eoh ()
|
||||
(defun message-goto-eoh (&optional interactive)
|
||||
"Move point to the end of the headers."
|
||||
(interactive)
|
||||
(message-goto-body)
|
||||
(interactive "p")
|
||||
(message-goto-body interactive)
|
||||
(forward-line -1))
|
||||
|
||||
(defun message-goto-signature ()
|
||||
|
|
@ -7882,6 +7880,7 @@ When FORCE, rebuild the tool bar."
|
|||
:type 'regexp)
|
||||
|
||||
(defcustom message-completion-alist
|
||||
;; FIXME: Make it possible to use the standard completion UI.
|
||||
(list (cons message-newgroups-header-regexp 'message-expand-group)
|
||||
'("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)
|
||||
'("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
|
||||
|
|
@ -8206,16 +8205,19 @@ From headers in the original article."
|
|||
|
||||
(autoload 'ecomplete-display-matches "ecomplete")
|
||||
|
||||
(defun message--in-tocc-p ()
|
||||
(and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? ))
|
||||
(message-point-in-header-p)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(while (and (memq (char-after) '(?\t ? ))
|
||||
(zerop (forward-line -1))))
|
||||
(looking-at "To:\\|Cc:"))))
|
||||
|
||||
(defun message-display-abbrev (&optional choose)
|
||||
"Display the next possible abbrev for the text before point."
|
||||
(interactive (list t))
|
||||
(when (and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? ))
|
||||
(message-point-in-header-p)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(while (and (memq (char-after) '(?\t ? ))
|
||||
(zerop (forward-line -1))))
|
||||
(looking-at "To:\\|Cc:")))
|
||||
(when (message--in-tocc-p)
|
||||
(let* ((end (point))
|
||||
(start (save-excursion
|
||||
(and (re-search-backward "[\n\t ]" nil t)
|
||||
|
|
@ -8228,6 +8230,20 @@ From headers in the original article."
|
|||
(delete-region start end)
|
||||
(insert match)))))
|
||||
|
||||
(defun message-ecomplete-capf ()
|
||||
"Return completion data for email addresses in Ecomplete.
|
||||
Meant for use on `completion-at-point-functions'."
|
||||
(when (and (bound-and-true-p ecomplete-database)
|
||||
(fboundp 'ecomplete-completion-table)
|
||||
(message--in-tocc-p))
|
||||
(let ((end (save-excursion
|
||||
(skip-chars-forward "^, \t\n")
|
||||
(point)))
|
||||
(start (save-excursion
|
||||
(skip-chars-backward "^, \t\n")
|
||||
(point))))
|
||||
`(,start ,end ,(apply-partially #'ecomplete-completion-table 'mail)))))
|
||||
|
||||
;; To send pre-formatted letters like the example below, you can use
|
||||
;; `message-send-form-letter':
|
||||
;; --8<---------------cut here---------------start------------->8---
|
||||
|
|
|
|||
Loading…
Reference in a new issue