diff options
| author | João Távora | 2015-04-12 13:12:27 +0100 |
|---|---|---|
| committer | João Távora | 2015-04-12 13:29:05 +0100 |
| commit | 25449e7296fe6e5cd9bca49ae1bc52d1552d5324 (patch) | |
| tree | e0983372a3998c226b9d7d53d105a02f1600582e | |
| parent | 303797134fa05d2e0d156a5bd912f8baab418489 (diff) | |
| download | emacs-25449e7296fe6e5cd9bca49ae1bc52d1552d5324.tar.gz emacs-25449e7296fe6e5cd9bca49ae1bc52d1552d5324.zip | |
Summary: Improve sexp-based movement in message-mode
Works by giving citations and smileys a different syntax. This helps
modes like `show-paren-mode', `electric-pair-mode', and C-M-*
sexp-based movement.
* lisp/gnus/message.el (message--syntax-propertize): New function.
(message-mode): Set syntax-related vars.
(message-smileys): New variable.
* test/automated/message-mode-tests.el: New file
| -rw-r--r-- | lisp/gnus/message.el | 32 | ||||
| -rw-r--r-- | test/automated/message-mode-tests.el | 55 |
2 files changed, 86 insertions, 1 deletions
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 04145ded107..b1bee65b7fe 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -2961,6 +2961,30 @@ See also `message-forbidden-properties'." | |||
| 2961 | 2961 | ||
| 2962 | (autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23. | 2962 | (autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23. |
| 2963 | 2963 | ||
| 2964 | (defvar message-smileys '(":-)" ":)" | ||
| 2965 | ":-(" ":(" | ||
| 2966 | ";-)" ";)") | ||
| 2967 | "A list of recognized smiley faces in `message-mode'.") | ||
| 2968 | |||
| 2969 | (defun message--syntax-propertize (beg end) | ||
| 2970 | "Syntax-propertize certain message text specially." | ||
| 2971 | (let ((citation-regexp (concat "^" message-cite-prefix-regexp ".*$")) | ||
| 2972 | (smiley-regexp (regexp-opt message-smileys))) | ||
| 2973 | (goto-char beg) | ||
| 2974 | (while (search-forward-regexp citation-regexp | ||
| 2975 | end 'noerror) | ||
| 2976 | (let ((start (match-beginning 0)) | ||
| 2977 | (end (match-end 0))) | ||
| 2978 | (add-text-properties start (1+ start) | ||
| 2979 | `(syntax-table ,(string-to-syntax "<"))) | ||
| 2980 | (add-text-properties end (min (1+ end) (point-max)) | ||
| 2981 | `(syntax-table ,(string-to-syntax ">"))))) | ||
| 2982 | (goto-char beg) | ||
| 2983 | (while (search-forward-regexp smiley-regexp | ||
| 2984 | end 'noerror) | ||
| 2985 | (add-text-properties (match-beginning 0) (match-end 0) | ||
| 2986 | `(syntax-table ,(string-to-syntax ".")))))) | ||
| 2987 | |||
| 2964 | ;;;###autoload | 2988 | ;;;###autoload |
| 2965 | (define-derived-mode message-mode text-mode "Message" | 2989 | (define-derived-mode message-mode text-mode "Message" |
| 2966 | "Major mode for editing mail and news to be sent. | 2990 | "Major mode for editing mail and news to be sent. |
| @@ -3063,7 +3087,13 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." | |||
| 3063 | ;; multibyte is not necessary at all. -- zsh | 3087 | ;; multibyte is not necessary at all. -- zsh |
| 3064 | (mm-enable-multibyte)) | 3088 | (mm-enable-multibyte)) |
| 3065 | (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation. | 3089 | (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation. |
| 3066 | (mml-mode)) | 3090 | (mml-mode) |
| 3091 | ;; Syntactic fontification. Helps `show-paren-mode', | ||
| 3092 | ;; `electric-pair-mode', and C-M-* navigation by syntactically | ||
| 3093 | ;; excluding citations and other artifacts. | ||
| 3094 | ;; | ||
| 3095 | (setq-local syntax-propertize-function 'message--syntax-propertize) | ||
| 3096 | (setq-local parse-sexp-ignore-comments t)) | ||
| 3067 | 3097 | ||
| 3068 | (defun message-setup-fill-variables () | 3098 | (defun message-setup-fill-variables () |
| 3069 | "Setup message fill variables." | 3099 | "Setup message fill variables." |
diff --git a/test/automated/message-mode-tests.el b/test/automated/message-mode-tests.el new file mode 100644 index 00000000000..12ecefeb94d --- /dev/null +++ b/test/automated/message-mode-tests.el | |||
| @@ -0,0 +1,55 @@ | |||
| 1 | ;;; message-mode-tests.el --- Tests for message-mdoe -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2015 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: João Távora <joaotavora@gmail.com> | ||
| 6 | |||
| 7 | ;; This program is free software; you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; This program is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;; This file contains tests for message-mode. | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | (require 'ert) | ||
| 26 | (require 'ert-x) | ||
| 27 | |||
| 28 | (ert-deftest message-mode-propertize () | ||
| 29 | (with-temp-buffer | ||
| 30 | (unwind-protect | ||
| 31 | (progn | ||
| 32 | (message-mode) | ||
| 33 | (insert "here's an opener (\n" | ||
| 34 | "here's a sad face :-(\n" | ||
| 35 | "> here's citing someone with an opener (\n" | ||
| 36 | "and here's a closer ") | ||
| 37 | (let ((last-command-event ?\))) | ||
| 38 | (ert-simulate-command '(self-insert-command 1))) | ||
| 39 | ;; Syntax propertization doesn't kick in batch mode | ||
| 40 | (when noninteractive | ||
| 41 | (syntax-propertize (point-max))) | ||
| 42 | (backward-sexp) | ||
| 43 | (should (string= "here's an opener " | ||
| 44 | (buffer-substring-no-properties | ||
| 45 | (line-beginning-position) | ||
| 46 | (point)))) | ||
| 47 | (forward-sexp) | ||
| 48 | (should (string= "and here's a closer )" | ||
| 49 | (buffer-substring-no-properties | ||
| 50 | (line-beginning-position) | ||
| 51 | (point))))) | ||
| 52 | (set-buffer-modified-p nil)))) | ||
| 53 | |||
| 54 | (provide 'message-mode-tests) | ||
| 55 | ;;; message-mode-tests.el ends here | ||