lisp/progmodes/cfengine3.el

   1 ;;; cfengine3.el --- mode for editing Cfengine 3 files
   2
   3 ;; Copyright (C) 2001-2011  Free Software Foundation, Inc.
   4
   5 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
   6 ;; Keywords: languages
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Supports only cfengine 3, unlike the older cfengine.el which
  26 ;; supports 1.x and 2.x.
  27
  28 ;; Possible customization for auto-mode selection:
  29
  30 ;; (push '(("^cfagent.conf\\'" . cfengine3-mode)) auto-mode-alist)
  31 ;; (push '(("^cf\\." . cfengine3-mode)) auto-mode-alist)
  32 ;; (push '(("\\.cf\\'" . cfengine3-mode)) auto-mode-alist)
  33
  34 ;;; Code:
  35
  36 (defgroup cfengine3 ()
  37   "Editing CFEngine 3 files."
  38   :group 'languages)
  39
  40 (defcustom cfengine3-indent 2
  41   "*Size of a CFEngine 3 indentation step in columns."
  42   :group 'cfengine3
  43   :type 'integer)
  44
  45 (eval-and-compile
  46   (defconst cfengine3-defuns
  47     (mapcar
  48      'symbol-name
  49      '(bundle body))
  50     "List of the CFEngine 3.x defun headings.")
  51
  52   (defconst cfengine3-defuns-regex
  53     (regexp-opt cfengine3-defuns t)
  54     "Regex to match the CFEngine 3.x defuns.")
  55
  56   (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!]+\\)::")
  57
  58   (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
  59
  60   (defconst cfengine3-vartypes
  61     (mapcar
  62      'symbol-name
  63      '(string int real slist ilist rlist irange rrange counter))
  64     "List of the CFEngine 3.x variable types."))
  65
  66 (defvar cfengine3-font-lock-keywords
  67   `(
  68     (,(concat "^[ \t]*" cfengine3-class-selector-regex)
  69      1 font-lock-keyword-face)
  70     (,(concat "^[ \t]*" cfengine3-category-regex)
  71      1 font-lock-builtin-face)
  72     ;; Variables, including scope, e.g. module.var
  73     ("[@$](\\([[:alnum:]_.]+\\))" 1 font-lock-variable-name-face)
  74     ("[@$]{\\([[:alnum:]_.]+\\)}" 1 font-lock-variable-name-face)
  75     ;; Variable definitions.
  76     ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
  77
  78     ;; CFEngine 3.x faces
  79     ;; defuns
  80     (,(concat "\\<" cfengine3-defuns-regex "\\>"
  81               "[ \t]+\\<\\([[:alnum:]_]+\\)\\>"
  82               "[ \t]+\\<\\([[:alnum:]_]+\\)\\((\\([^)]*\\))\\)?")
  83     (1 font-lock-builtin-face)
  84     (2 font-lock-constant-name-face)
  85     (3 font-lock-function-name-face)
  86     (5 font-lock-variable-name-face))
  87     ;; variable types
  88     (,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>")
  89      1 font-lock-type-face)))
  90
  91 (defun cfengine3-beginning-of-defun ()
  92   "`beginning-of-defun' function for Cfengine 3 mode.
  93 Treats body/bundle blocks as defuns."
  94   (unless (<= (current-column) (current-indentation))
  95     (end-of-line))
  96   (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
  97       (beginning-of-line)
  98     (goto-char (point-min)))
  99   t)
 100
 101 (defun cfengine3-end-of-defun ()
 102   "`end-of-defun' function for Cfengine 3 mode.
 103 Treats body/bundle blocks as defuns."
 104   (end-of-line)
 105   (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
 106       (beginning-of-line)
 107     (goto-char (point-max)))
 108   t)
 109
 110 (defun cfengine3-indent-line ()
 111   "Indent a line in Cfengine mode.
 112 Intended as the value of `indent-line-function'."
 113   (let ((pos (- (point-max) (point)))
 114         parse)
 115     (save-restriction
 116       (narrow-to-defun)
 117       (back-to-indentation)
 118       (setq parse (parse-partial-sexp (point-min) (point)))
 119       (message "%S" parse)
 120       (cond
 121        ;; body/bundle blocks start at 0
 122        ((looking-at (concat cfengine3-defuns-regex "\\>"))
 123         (indent-line-to 0))
 124        ;; categories are indented one step
 125        ((looking-at (concat cfengine3-category-regex "[ \t]*$"))
 126         (indent-line-to cfengine3-indent))
 127        ;; class selectors are indented two steps
 128        ((looking-at (concat cfengine3-class-selector-regex "[ \t]*$"))
 129         (indent-line-to (* 2 cfengine3-indent)))
 130        ;; Outdent leading close brackets one step.
 131        ((or (eq ?\} (char-after))
 132             (eq ?\) (char-after)))
 133         (condition-case ()
 134             (indent-line-to (save-excursion
 135                               (forward-char)
 136                               (backward-sexp)
 137                               (current-column)))
 138           (error nil)))
 139        ;; inside a string and it starts before this line
 140        ((and (nth 3 parse)
 141              (< (nth 8 parse) (save-excursion (beginning-of-line) (point))))
 142         (indent-line-to 0))
 143        ;; inside a defun, but not a nested list (depth is 1)
 144        ((= 1 (nth 0 parse))
 145         (indent-line-to (* (+ 2 (nth 0 parse)) cfengine3-indent)))
 146        ;; Inside brackets/parens: indent to start column of non-comment
 147        ;; token on line following open bracket or by one step from open
 148        ;; bracket's column.
 149        ((condition-case ()
 150             (progn (indent-line-to (save-excursion
 151                                      (backward-up-list)
 152                                      (forward-char)
 153                                      (skip-chars-forward " \t")
 154                                      (cond
 155                                       ((looking-at "[^\n#]")
 156                                        (current-column))
 157                                       ((looking-at "[^\n#]")
 158                                        (current-column))
 159                                       (t
 160                                        (skip-chars-backward " \t")
 161                                        (+ (current-column) -1
 162                                           cfengine3-indent)))))
 163                    t)
 164           (error nil)))
 165        ;; Else don't indent.
 166        (t (indent-line-to 0))))
 167     ;; If initial point was within line's indentation,
 168     ;; position after the indentation.  Else stay at same point in text.
 169     (if (> (- (point-max) pos) (point))
 170         (goto-char (- (point-max) pos)))))
 171
 172 ;; (defvar cfengine3-smie-grammar
 173 ;;   (smie-prec2->grammar
 174 ;;    (smie-merge-prec2s
 175 ;;    (smie-bnf->prec2
 176 ;;     '((token)
 177 ;;       (decls (decls "body" decls)
 178 ;;              (decls "bundle" decls))
 179 ;;       (insts (token ":" insts)))
 180 ;;     '((assoc "body" "bundle")))
 181 ;;    (smie-precs->prec2
 182 ;;     '((right ":")
 183 ;;       (right "::")
 184 ;;       (assoc ";")
 185 ;;       (assoc ",")
 186 ;;       (right "=>"))))))
 187
 188 ;; (defun cfengine3-smie-rules (kind token)
 189 ;;   (pcase (cons kind token)
 190 ;;     (`(:elem . basic) 2)
 191 ;;     (`(:list-intro . ,(or `"body" `"bundle")) t)
 192 ;;     (`(:after . ":") 2)
 193 ;;     (`(:after . "::") 2)))
 194
 195 ;; (defun cfengine3-show-all-tokens ()
 196 ;;   (interactive)
 197 ;;   (goto-char (point-min))
 198 ;;   (while (not (eobp))
 199 ;;     (let* ((p (point))
 200 ;;            (token (funcall smie-forward-token-function)))
 201 ;;       (delete-region p (point))
 202 ;;       (insert-before-markers token)
 203 ;;       (forward-char))))
 204
 205 ;; (defun cfengine3-line-classes ()
 206 ;;   (interactive)
 207 ;;   (save-excursion
 208 ;;     (beginning-of-line)
 209 ;;     (let* ((todo (buffer-substring (point)
 210 ;;                                    (save-excursion (end-of-line) (point))))
 211 ;;            (original (concat (loop for c across todo
 212 ;;                                    collect (char-syntax c)))))
 213 ;;       (format "%s\n%s" original todo))))
 214
 215 ;; (defun cfengine3-show-all-classes ()
 216 ;;   (interactive)
 217 ;;   (goto-char (point-min))
 218 ;;   (while (not (eobp))
 219 ;;     (let ((repl (cfengine3-line-classes)))
 220 ;;       (kill-line)
 221 ;;       (insert repl)
 222 ;;       (insert "\n"))))
 223
 224 ;; specification: blocks
 225 ;; blocks: block | blocks block;
 226 ;; block:                 bundle typeid blockid bundlebody
 227 ;;                      | bundle typeid blockid usearglist bundlebody
 228 ;;                      | body typeid blockid bodybody
 229 ;;                      | body typeid blockid usearglist bodybody;
 230
 231 ;; typeid: id
 232 ;; blockid: id
 233 ;; usearglist: '(' aitems ')';
 234 ;; aitems: aitem | aitem ',' aitems |;
 235 ;; aitem: id
 236
 237 ;; bundlebody: '{' statements '}'
 238 ;; statements: statement | statements statement;
 239 ;; statement: category | classpromises;
 240
 241 ;; bodybody: '{' bodyattribs '}'
 242 ;; bodyattribs: bodyattrib | bodyattribs bodyattrib;
 243 ;; bodyattrib: class | selections;
 244 ;; selections: selection | selections selection;
 245 ;; selection: id ASSIGN rval ';' ;
 246
 247 ;; classpromises: classpromise | classpromises classpromise;
 248 ;; classpromise: class | promises;
 249 ;; promises: promise | promises promise;
 250 ;; category: CATEGORY
 251 ;; promise: promiser ARROW rval constraints ';' | promiser constraints ';';
 252 ;; constraints: constraint | constraints ',' constraint |;
 253 ;; constraint: id ASSIGN rval;
 254 ;; class: CLASS
 255 ;; id: ID
 256 ;; rval: ID | QSTRING | NAKEDVAR | list | usefunction
 257 ;; list: '{' litems '}' ;
 258 ;; litems: litem | litem ',' litems |;
 259 ;; litem: ID | QSTRING | NAKEDVAR | list | usefunction
 260
 261 ;; functionid: ID | NAKEDVAR
 262 ;; promiser: QSTRING
 263 ;; usefunction: functionid givearglist
 264 ;; givearglist: '(' gaitems ')'
 265 ;; gaitems: gaitem | gaitems ',' gaitem |;
 266 ;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction
 267
 268 ;; # from lexer:
 269
 270 ;; bundle: "bundle"
 271 ;; body: "body"
 272 ;; COMMENT    #[^\n]*
 273 ;; NAKEDVAR   [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}]
 274 ;; ID: [a-zA-Z0-9_\200-\377]+
 275 ;; ASSIGN: "=>"
 276 ;; ARROW: "->"
 277 ;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*`
 278 ;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+::
 279 ;; CATEGORY: [a-zA-Z_]+:
 280
 281 ;;;###autoload
 282 (define-derived-mode cfengine3-mode prog-mode "CFEngine3"
 283   "Major mode for editing cfengine input.
 284 There are no special keybindings by default.
 285
 286 Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
 287 to the action header."
 288   (modify-syntax-entry ?# "<" cfengine3-mode-syntax-table)
 289   (modify-syntax-entry ?\n ">#" cfengine3-mode-syntax-table)
 290   (modify-syntax-entry ?\" "\"" cfengine3-mode-syntax-table)
 291   ;; variable substitution:
 292   (modify-syntax-entry ?$ "." cfengine3-mode-syntax-table)
 293   ;; Doze path separators:
 294   (modify-syntax-entry ?\\ "." cfengine3-mode-syntax-table)
 295   ;; Otherwise, syntax defaults seem OK to give reasonable word
 296   ;; movement.
 297
 298   ;; (smie-setup cfengine3-smie-grammar #'cfengine3-smie-rules)
 299   ;;             ;; :forward-token  #'cfengine3-smie-forward-token
 300   ;;             ;; :backward-token #'cfengine3-smie-backward-token)
 301   ;; (set (make-local-variable 'smie-indent-basic) 'cfengine3-indent)
 302
 303   (set (make-local-variable 'parens-require-spaces) nil)
 304   (set (make-local-variable 'comment-start)  "# ")
 305   (set (make-local-variable 'comment-start-skip)
 306        "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
 307   (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
 308   (setq font-lock-defaults
 309         '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun))
 310   ;; Fixme: set the args of functions in evaluated classes to string
 311   ;; syntax, and then obey syntax properties.
 312   (set (make-local-variable 'syntax-propertize-function)
 313        ;; In the main syntax-table, \ is marked as a punctuation, because
 314        ;; of its use in DOS-style directory separators.  Here we try to
 315        ;; recognize the cases where \ is used as an escape inside strings.
 316        (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
 317
 318   ;; use defuns as the essential syntax block
 319   (set (make-local-variable 'beginning-of-defun-function)
 320        #'cfengine3-beginning-of-defun)
 321   (set (make-local-variable 'end-of-defun-function)
 322        #'cfengine3-end-of-defun)
 323
 324   ;; Like Lisp mode.  Without this, we lose with, say,
 325   ;; `backward-up-list' when there's an unbalanced quote in a
 326   ;; preceding comment.
 327   (set (make-local-variable 'parse-sexp-ignore-comments) t))
 328
 329 (provide 'cfengine3)
 330
 331 ;;; cfengine3.el ends here