lisp/net/sieve-mode.el

   1 ;;; sieve-mode.el --- Sieve code editing commands for Emacs
   2
   3 ;; Copyright (C) 2001-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Simon Josefsson <simon@josefsson.org>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; This file contain editing mode functions and font-lock support for
  25 ;; editing Sieve scripts.  It sets up C-mode with support for
  26 ;; sieve-style #-comments and a lightly hacked syntax table.  It was
  27 ;; strongly influenced by awk-mode.el.
  28 ;;
  29 ;; Put something similar to the following in your .emacs to use this file:
  30 ;;
  31 ;; (load "~/lisp/sieve")
  32 ;; (setq auto-mode-alist (cons '("\\.siv\\'" . sieve-mode) auto-mode-alist))
  33 ;;
  34 ;; References:
  35 ;;
  36 ;; RFC 3028,
  37 ;; "Sieve: A Mail Filtering Language",
  38 ;; by Tim Showalter.
  39 ;;
  40 ;; Release history:
  41 ;;
  42 ;; 2001-03-02 version 1.0 posted to gnu.emacs.sources
  43 ;;            version 1.1 change file extension into ".siv" (official one)
  44 ;;                        added keymap and menubar to hook into sieve-manage
  45 ;; 2001-10-31 version 1.2 committed to Oort Gnus
  46
  47 ;;; Code:
  48
  49 (autoload 'sieve-manage "sieve")
  50 (autoload 'sieve-upload "sieve")
  51 (eval-when-compile
  52   (require 'font-lock))
  53
  54 (defgroup sieve nil
  55   "Sieve."
  56   :group 'languages)
  57
  58 (defcustom sieve-mode-hook nil
  59   "Hook run in sieve mode buffers."
  60   :type 'hook)
  61
  62 ;; Font-lock
  63
  64 (defface sieve-control-commands
  65   '((((type tty) (class color)) (:foreground "blue" :weight light))
  66     (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
  67     (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
  68     (((class color) (background light)) (:foreground "Orchid"))
  69     (((class color) (background dark)) (:foreground "LightSteelBlue"))
  70     (t (:bold t)))
  71   "Face used for Sieve Control Commands.")
  72
  73 (defface sieve-action-commands
  74   '((((type tty) (class color)) (:foreground "blue" :weight bold))
  75     (((class color) (background light)) (:foreground "Blue"))
  76     (((class color) (background dark)) (:foreground "LightSkyBlue"))
  77     (t (:inverse-video t :bold t)))
  78   "Face used for Sieve Action Commands.")
  79
  80 (defface sieve-test-commands
  81   '((((type tty) (class color)) (:foreground "magenta"))
  82     (((class grayscale) (background light))
  83      (:foreground "LightGray" :bold t :underline t))
  84     (((class grayscale) (background dark))
  85      (:foreground "Gray50" :bold t :underline t))
  86     (((class color) (background light)) (:foreground "CadetBlue"))
  87     (((class color) (background dark)) (:foreground "Aquamarine"))
  88     (t (:bold t :underline t)))
  89   "Face used for Sieve Test Commands.")
  90
  91 (defface sieve-tagged-arguments
  92   '((((type tty) (class color)) (:foreground "cyan" :weight bold))
  93     (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
  94     (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
  95     (((class color) (background light)) (:foreground "Purple"))
  96     (((class color) (background dark)) (:foreground "Cyan"))
  97     (t (:bold t)))
  98   "Face used for Sieve Tagged Arguments.")
  99
 100
 101 (defconst sieve-font-lock-keywords
 102   (eval-when-compile
 103     (list
 104      ;; control commands
 105      (cons (regexp-opt '("require" "if" "else" "elsif" "stop")
 106                        'words)
 107            'sieve-control-commands)
 108      ;; action commands
 109      (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard")
 110                        'words)
 111            'sieve-action-commands)
 112      ;; test commands
 113      (cons (regexp-opt '("address" "allof" "anyof" "exists" "false"
 114                          "true" "header" "not" "size" "envelope"
 115                          "body")
 116                        'words)
 117            'sieve-test-commands)
 118      (cons "\\Sw+:\\sw+"
 119            'sieve-tagged-arguments))))
 120
 121 ;; Syntax table
 122
 123 (defvar sieve-mode-syntax-table
 124   (let ((st (make-syntax-table)))
 125     (modify-syntax-entry ?\\ "\\" st)
 126     (modify-syntax-entry ?\n ">   " st)
 127     (modify-syntax-entry ?\f ">   " st)
 128     (modify-syntax-entry ?\# "<   " st)
 129     (modify-syntax-entry ?/ ". 14" st)
 130     (modify-syntax-entry ?* ". 23b" st)
 131     (modify-syntax-entry ?+ "." st)
 132     (modify-syntax-entry ?- "." st)
 133     (modify-syntax-entry ?= "." st)
 134     (modify-syntax-entry ?% "." st)
 135     (modify-syntax-entry ?< "." st)
 136     (modify-syntax-entry ?> "." st)
 137     (modify-syntax-entry ?& "." st)
 138     (modify-syntax-entry ?| "." st)
 139     (modify-syntax-entry ?_ "_" st)
 140     (modify-syntax-entry ?\' "\"" st)
 141     st)
 142   "Syntax table in use in sieve-mode buffers.")
 143
 144
 145 ;; Key map definition
 146
 147 (defvar sieve-mode-map
 148   (let ((map (make-sparse-keymap)))
 149     (define-key map "\C-c\C-l" 'sieve-upload)
 150     (define-key map "\C-c\C-c" 'sieve-upload-and-kill)
 151     (define-key map "\C-c\C-m" 'sieve-manage)
 152     map)
 153   "Key map used in sieve mode.")
 154
 155 ;; Menu
 156
 157 (easy-menu-define sieve-mode-menu sieve-mode-map
 158   "Sieve Menu."
 159   '("Sieve"
 160     ["Upload script" sieve-upload t]
 161     ["Manage scripts on server" sieve-manage t]))
 162
 163 ;; Code for Sieve editing mode.
 164
 165
 166 (defun sieve-syntax-propertize (beg end)
 167   (goto-char beg)
 168   (sieve-syntax-propertize-text end)
 169   (funcall
 170    (syntax-propertize-rules
 171     ;; FIXME: When there's a "text:" with a # comment, the \n plays dual role:
 172     ;; it closes the comment and starts the string.  This is problematic for us
 173     ;; since syntax-table entries can either close a comment or
 174     ;; delimit a string, but not both.
 175     ("\\_<text:[ \t]*\\(?:#.*\\(.\\)\\)?\\(\n\\)"
 176      (1 ">")
 177      (2 (prog1 (unless (save-excursion
 178                          (nth 8 (syntax-ppss (match-beginning 0))))
 179                  (string-to-syntax "|"))
 180           (sieve-syntax-propertize-text end)))))
 181    beg end))
 182
 183 (defun sieve-syntax-propertize-text (end)
 184   (let ((ppss (syntax-ppss)))
 185     (when (and (eq t (nth 3 ppss))
 186                (re-search-forward "^\\.\\(\n\\)" end 'move))
 187       (put-text-property (match-beginning 1) (match-end 1)
 188                          'syntax-table (string-to-syntax "|")))))
 189
 190 ;;;###autoload
 191 (define-derived-mode sieve-mode c-mode "Sieve"
 192   "Major mode for editing Sieve code.
 193 This is much like C mode except for the syntax of comments.  Its keymap
 194 inherits from C mode's and it has the same variables for customizing
 195 indentation.  It has its own abbrev table and its own syntax table.
 196
 197 Turning on Sieve mode runs `sieve-mode-hook'."
 198   (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
 199   (set (make-local-variable 'paragraph-separate) paragraph-start)
 200   (set (make-local-variable 'comment-start) "#")
 201   (set (make-local-variable 'comment-end) "")
 202   ;;(set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *")
 203   (set (make-local-variable 'comment-start-skip) "#+ *")
 204   (set (make-local-variable 'syntax-propertize-function)
 205        #'sieve-syntax-propertize)
 206   (set (make-local-variable 'font-lock-defaults)
 207        '(sieve-font-lock-keywords nil nil ((?_ . "w"))))
 208   (easy-menu-add-item nil nil sieve-mode-menu))
 209
 210 (provide 'sieve-mode)
 211
 212 ;; sieve-mode.el ends here