X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c3ed7cea0a43ab86c9d3b1627878055844bc8656..08974112ae68aefba658a8516c8faa3374edc924:/lisp/net/sieve-mode.el

diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index 7575ba67c5..6aa1b207ee 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -57,14 +57,10 @@
 
 (defcustom sieve-mode-hook nil
   "Hook run in sieve mode buffers."
-  :group 'sieve
   :type 'hook)
 
 ;; Font-lock
 
-(defvar sieve-control-commands-face 'sieve-control-commands
-  "Face name used for Sieve Control Commands.")
-
 (defface sieve-control-commands
   '((((type tty) (class color)) (:foreground "blue" :weight light))
     (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
@@ -72,28 +68,14 @@
     (((class color) (background light)) (:foreground "Orchid"))
     (((class color) (background dark)) (:foreground "LightSteelBlue"))
     (t (:bold t)))
-  "Face used for Sieve Control Commands."
-  :group 'sieve)
-;; backward-compatibility alias
-(put 'sieve-control-commands-face 'face-alias 'sieve-control-commands)
-(put 'sieve-control-commands-face 'obsolete-face "22.1")
-
-(defvar sieve-action-commands-face 'sieve-action-commands
-  "Face name used for Sieve Action Commands.")
+  "Face used for Sieve Control Commands.")
 
 (defface sieve-action-commands
   '((((type tty) (class color)) (:foreground "blue" :weight bold))
     (((class color) (background light)) (:foreground "Blue"))
     (((class color) (background dark)) (:foreground "LightSkyBlue"))
     (t (:inverse-video t :bold t)))
-  "Face used for Sieve Action Commands."
-  :group 'sieve)
-;; backward-compatibility alias
-(put 'sieve-action-commands-face 'face-alias 'sieve-action-commands)
-(put 'sieve-action-commands-face 'obsolete-face "22.1")
-
-(defvar sieve-test-commands-face 'sieve-test-commands
-  "Face name used for Sieve Test Commands.")
+  "Face used for Sieve Action Commands.")
 
 (defface sieve-test-commands
   '((((type tty) (class color)) (:foreground "magenta"))
@@ -104,14 +86,7 @@
     (((class color) (background light)) (:foreground "CadetBlue"))
     (((class color) (background dark)) (:foreground "Aquamarine"))
     (t (:bold t :underline t)))
-  "Face used for Sieve Test Commands."
-  :group 'sieve)
-;; backward-compatibility alias
-(put 'sieve-test-commands-face 'face-alias 'sieve-test-commands)
-(put 'sieve-test-commands-face 'obsolete-face "22.1")
-
-(defvar sieve-tagged-arguments-face 'sieve-tagged-arguments
-  "Face name used for Sieve Tagged Arguments.")
+  "Face used for Sieve Test Commands.")
 
 (defface sieve-tagged-arguments
   '((((type tty) (class color)) (:foreground "cyan" :weight bold))
@@ -120,11 +95,7 @@
     (((class color) (background light)) (:foreground "Purple"))
     (((class color) (background dark)) (:foreground "Cyan"))
     (t (:bold t)))
-  "Face used for Sieve Tagged Arguments."
-  :group 'sieve)
-;; backward-compatibility alias
-(put 'sieve-tagged-arguments-face 'face-alias 'sieve-tagged-arguments)
-(put 'sieve-tagged-arguments-face 'obsolete-face "22.1")
+  "Face used for Sieve Tagged Arguments.")
 
 
 (defconst sieve-font-lock-keywords
@@ -133,44 +104,43 @@
      ;; control commands
      (cons (regexp-opt '("require" "if" "else" "elsif" "stop")
                        'words)
-	   'sieve-control-commands-face)
+	   'sieve-control-commands)
      ;; action commands
      (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard")
                        'words)
-	   'sieve-action-commands-face)
+	   'sieve-action-commands)
      ;; test commands
      (cons (regexp-opt '("address" "allof" "anyof" "exists" "false"
 			 "true" "header" "not" "size" "envelope"
                          "body")
                        'words)
-	   'sieve-test-commands-face)
+	   'sieve-test-commands)
      (cons "\\Sw+:\\sw+"
-	   'sieve-tagged-arguments-face))))
+	   'sieve-tagged-arguments))))
 
 ;; Syntax table
 
-(defvar sieve-mode-syntax-table nil
+(defvar sieve-mode-syntax-table
+  (let ((st (make-syntax-table)))
+    (modify-syntax-entry ?\\ "\\" st)
+    (modify-syntax-entry ?\n ">   " st)
+    (modify-syntax-entry ?\f ">   " st)
+    (modify-syntax-entry ?\# "<   " st)
+    (modify-syntax-entry ?/ ". 14" st)
+    (modify-syntax-entry ?* ". 23b" st)
+    (modify-syntax-entry ?+ "." st)
+    (modify-syntax-entry ?- "." st)
+    (modify-syntax-entry ?= "." st)
+    (modify-syntax-entry ?% "." st)
+    (modify-syntax-entry ?< "." st)
+    (modify-syntax-entry ?> "." st)
+    (modify-syntax-entry ?& "." st)
+    (modify-syntax-entry ?| "." st)
+    (modify-syntax-entry ?_ "_" st)
+    (modify-syntax-entry ?\' "\"" st)
+    st)
   "Syntax table in use in sieve-mode buffers.")
 
-(if sieve-mode-syntax-table
-    ()
-  (setq sieve-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" sieve-mode-syntax-table)
-  (modify-syntax-entry ?\n ">   " sieve-mode-syntax-table)
-  (modify-syntax-entry ?\f ">   " sieve-mode-syntax-table)
-  (modify-syntax-entry ?\# "<   " sieve-mode-syntax-table)
-  (modify-syntax-entry ?/ "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?* "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?+ "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?- "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?= "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?% "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?< "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?> "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?& "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?| "." sieve-mode-syntax-table)
-  (modify-syntax-entry ?_ "_" sieve-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" sieve-mode-syntax-table))
 
 ;; Key map definition
 
@@ -182,13 +152,40 @@
     map)
   "Key map used in sieve mode.")
 
-;; Menu definition
+;; Menu
 
-(defvar sieve-mode-menu nil
-  "Menubar used in sieve mode.")
+(easy-menu-define sieve-mode-menu sieve-mode-map
+  "Sieve Menu."
+  '("Sieve"
+    ["Upload script" sieve-upload t]
+    ["Manage scripts on server" sieve-manage t]))
 
 ;; Code for Sieve editing mode.
-(autoload 'easy-menu-add-item "easymenu")
+
+
+(defun sieve-syntax-propertize (beg end)
+  (goto-char beg)
+  (sieve-syntax-propertize-text end)
+  (funcall
+   (syntax-propertize-rules
+    ;; FIXME: When there's a "text:" with a # comment, the \n plays dual role:
+    ;; it closes the comment and starts the string.  This is problematic for us
+    ;; since syntax-table entries can either close a comment or
+    ;; delimit a string, but not both.
+    ("\\_<text:[ \t]*\\(?:#.*\\(.\\)\\)?\\(\n\\)"
+     (1 ">")
+     (2 (prog1 (unless (save-excursion
+                         (nth 8 (syntax-ppss (match-beginning 0))))
+                 (string-to-syntax "|"))
+          (sieve-syntax-propertize-text end)))))
+   beg end))
+
+(defun sieve-syntax-propertize-text (end)
+  (let ((ppss (syntax-ppss)))
+    (when (and (eq t (nth 3 ppss))
+               (re-search-forward "^\\.\\(\n\\)" end 'move))
+      (put-text-property (match-beginning 1) (match-end 1)
+                         'syntax-table (string-to-syntax "|")))))
 
 ;;;###autoload
 (define-derived-mode sieve-mode c-mode "Sieve"
@@ -204,18 +201,12 @@ Turning on Sieve mode runs `sieve-mode-hook'."
   (set (make-local-variable 'comment-end) "")
   ;;(set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *")
   (set (make-local-variable 'comment-start-skip) "#+ *")
+  (set (make-local-variable 'syntax-propertize-function)
+       #'sieve-syntax-propertize)
   (set (make-local-variable 'font-lock-defaults)
        '(sieve-font-lock-keywords nil nil ((?_ . "w"))))
   (easy-menu-add-item nil nil sieve-mode-menu))
 
-;; Menu
-
-(easy-menu-define sieve-mode-menu sieve-mode-map
-  "Sieve Menu."
-  '("Sieve"
-    ["Upload script" sieve-upload t]
-    ["Manage scripts on server" sieve-manage t]))
-
 (provide 'sieve-mode)
 
 ;; sieve-mode.el ends here