lisp/progmodes/cfengine.el

   1 ;;; cfengine.el --- mode for editing Cfengine files
   2
   3 ;; Copyright (C) 2001-2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Dave Love <fx@gnu.org>
   6 ;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
   7 ;; Keywords: languages
   8 ;; Version: 1.1
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Provides support for editing GNU Cfengine files, including
  28 ;; font-locking, Imenu and indentation, but with no special keybindings.
  29
  30 ;; The CFEngine 3.x support doesn't have Imenu support but patches are
  31 ;; welcome.
  32
  33 ;; You can set it up so either `cfengine2-mode' (2.x and earlier) or
  34 ;; `cfengine3-mode' (3.x) will be picked, depending on the buffer
  35 ;; contents:
  36
  37 ;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-mode))
  38
  39 ;; OR you can choose to always use a specific version, if you prefer
  40 ;; it:
  41
  42 ;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine3-mode))
  43 ;; (add-to-list 'auto-mode-alist '("^cf\\." . cfengine2-mode))
  44 ;; (add-to-list 'auto-mode-alist '("^cfagent.conf\\'" . cfengine2-mode))
  45
  46 ;; This is not the same as the mode written by Rolf Ebert
  47 ;; <ebert@waporo.muc.de>, distributed with cfengine-2.0.5.  It does
  48 ;; better fontification and indentation, inter alia.
  49
  50 ;;; Code:
  51
  52 (defgroup cfengine ()
  53   "Editing CFEngine files."
  54   :group 'languages)
  55
  56 (defcustom cfengine-indent 2
  57   "Size of a CFEngine indentation step in columns."
  58   :group 'cfengine
  59   :type 'integer)
  60
  61 (defvar cfengine-mode-debug nil
  62   "Whether `cfengine-mode' should print debugging info.")
  63
  64 (defcustom cfengine-mode-abbrevs nil
  65   "Abbrevs for CFEngine2 mode."
  66   :group 'cfengine
  67   :type '(repeat (list (string :tag "Name")
  68                        (string :tag "Expansion")
  69                        (choice  :tag "Hook" (const nil) function))))
  70
  71 (make-obsolete-variable 'cfengine-mode-abbrevs 'edit-abbrevs "24.1")
  72
  73 ;; Taken from the doc for pre-release 2.1.
  74 (eval-and-compile
  75   (defconst cfengine2-actions
  76     '("acl" "alerts" "binservers" "broadcast" "control" "classes" "copy"
  77       "defaultroute" "disks" "directories" "disable" "editfiles" "files"
  78       "filters" "groups" "homeservers" "ignore" "import" "interfaces"
  79       "links" "mailserver" "methods" "miscmounts" "mountables"
  80       "processes" "packages" "rename" "required" "resolve"
  81       "shellcommands" "tidy" "unmount"
  82       ;; Keywords for cfservd.
  83       "admit" "grant" "deny")
  84     "List of the action keywords supported by Cfengine.
  85 This includes those for cfservd as well as cfagent.")
  86
  87   (defconst cfengine3-defuns
  88     (mapcar
  89      'symbol-name
  90      '(bundle body))
  91     "List of the CFEngine 3.x defun headings.")
  92
  93   (defconst cfengine3-defuns-regex
  94     (regexp-opt cfengine3-defuns t)
  95     "Regex to match the CFEngine 3.x defuns.")
  96
  97   (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!]+\\)::")
  98
  99   (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
 100
 101   (defconst cfengine3-vartypes
 102     (mapcar
 103      'symbol-name
 104      '(string int real slist ilist rlist irange rrange counter))
 105     "List of the CFEngine 3.x variable types."))
 106
 107 (defvar cfengine2-font-lock-keywords
 108   `(;; Actions.
 109     ;; List the allowed actions explicitly, so that errors are more obvious.
 110     (,(concat "^[ \t]*" (eval-when-compile
 111                           (regexp-opt cfengine2-actions t))
 112               ":")
 113      1 font-lock-keyword-face)
 114     ;; Classes.
 115     ("^[ \t]*\\([[:alnum:]_().|!]+\\)::" 1 font-lock-function-name-face)
 116     ;; Variables.
 117     ("$(\\([[:alnum:]_]+\\))" 1 font-lock-variable-name-face)
 118     ("${\\([[:alnum:]_]+\\)}" 1 font-lock-variable-name-face)
 119     ;; Variable definitions.
 120     ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
 121     ;; File, acl &c in group:   { token ... }
 122     ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face)))
 123
 124 (defvar cfengine3-font-lock-keywords
 125   `(
 126     ;; Defuns.  This happens early so they don't get caught by looser
 127     ;; patterns.
 128     (,(concat "\\<" cfengine3-defuns-regex "\\>"
 129               "[ \t]+\\<\\([[:alnum:]_]+\\)\\>"
 130               "[ \t]+\\<\\([[:alnum:]_]+\\)"
 131               ;; Optional parentheses with variable names inside.
 132               "\\(?:(\\([^)]*\\))\\)?")
 133      (1 font-lock-builtin-face)
 134      (2 font-lock-constant-face)
 135      (3 font-lock-function-name-face)
 136      (4 font-lock-variable-name-face nil t))
 137
 138     ;; Class selectors.
 139     (,(concat "^[ \t]*" cfengine3-class-selector-regex)
 140      1 font-lock-keyword-face)
 141
 142     ;; Categories.
 143     (,(concat "^[ \t]*" cfengine3-category-regex)
 144      1 font-lock-builtin-face)
 145
 146     ;; Variables, including scope, e.g. module.var
 147     ("[@$](\\([[:alnum:]_.]+\\))" 1 font-lock-variable-name-face)
 148     ("[@$]{\\([[:alnum:]_.]+\\)}" 1 font-lock-variable-name-face)
 149
 150     ;; Variable definitions.
 151     ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
 152
 153     ;; Variable types.
 154     (,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>")
 155      1 font-lock-type-face)))
 156
 157 (defvar cfengine2-imenu-expression
 158   `((nil ,(concat "^[ \t]*" (eval-when-compile
 159                               (regexp-opt cfengine2-actions t))
 160                   ":[^:]")
 161          1)
 162     ("Variables/classes" "\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1)
 163     ("Variables/classes" "\\<define=\\([[:alnum:]_]+\\)" 1)
 164     ("Variables/classes" "\\<DefineClass\\>[ \t]+\\([[:alnum:]_]+\\)" 1))
 165   "`imenu-generic-expression' for CFEngine mode.")
 166
 167 (defun cfengine2-outline-level ()
 168   "`outline-level' function for CFEngine mode."
 169   (if (looking-at "[^:]+\\(?:[:]+\\)$")
 170       (length (match-string 1))))
 171
 172 (defun cfengine2-beginning-of-defun ()
 173   "`beginning-of-defun' function for CFEngine mode.
 174 Treats actions as defuns."
 175   (unless (<= (current-column) (current-indentation))
 176     (end-of-line))
 177   (if (re-search-backward "^[[:alpha:]]+: *$" nil t)
 178       (beginning-of-line)
 179     (goto-char (point-min)))
 180   t)
 181
 182 (defun cfengine2-end-of-defun ()
 183   "`end-of-defun' function for CFEngine mode.
 184 Treats actions as defuns."
 185   (end-of-line)
 186   (if (re-search-forward "^[[:alpha:]]+: *$" nil t)
 187       (beginning-of-line)
 188     (goto-char (point-max)))
 189   t)
 190
 191 ;; Fixme: Should get an extra indent step in editfiles BeginGroup...s.
 192
 193 (defun cfengine2-indent-line ()
 194   "Indent a line in Cfengine mode.
 195 Intended as the value of `indent-line-function'."
 196   (let ((pos (- (point-max) (point))))
 197     (save-restriction
 198       (narrow-to-defun)
 199       (back-to-indentation)
 200       (cond
 201        ;; Action selectors aren't indented; class selectors are
 202        ;; indented one step.
 203        ((looking-at "[[:alnum:]_().|!]+:\\(:\\)?")
 204         (if (match-string 1)
 205             (indent-line-to cfengine-indent)
 206           (indent-line-to 0)))
 207        ;; Outdent leading close brackets one step.
 208        ((or (eq ?\} (char-after))
 209             (eq ?\) (char-after)))
 210         (condition-case ()
 211             (indent-line-to (save-excursion
 212                               (forward-char)
 213                               (backward-sexp)
 214                               (current-column)))
 215           (error nil)))
 216        ;; Inside brackets/parens: indent to start column of non-comment
 217        ;; token on line following open bracket or by one step from open
 218        ;; bracket's column.
 219        ((condition-case ()
 220             (progn (indent-line-to (save-excursion
 221                                      (backward-up-list)
 222                                      (forward-char)
 223                                      (skip-chars-forward " \t")
 224                                      (if (looking-at "[^\n#]")
 225                                          (current-column)
 226                                        (skip-chars-backward " \t")
 227                                        (+ (current-column) -1
 228                                           cfengine-indent))))
 229                    t)
 230           (error nil)))
 231        ;; Indent by  two steps after a class selector.
 232        ((save-excursion
 233           (re-search-backward "^[ \t]*[[:alnum:]_().|!]+::" nil t))
 234         (indent-line-to (* 2 cfengine-indent)))
 235        ;; Indent by one step if we're after an action header.
 236        ((save-excursion
 237           (goto-char (point-min))
 238           (looking-at "[[:alpha:]]+:[ \t]*$"))
 239         (indent-line-to cfengine-indent))
 240        ;; Else don't indent.
 241        (t
 242         (indent-line-to 0))))
 243     ;; If initial point was within line's indentation,
 244     ;; position after the indentation.  Else stay at same point in text.
 245     (if (> (- (point-max) pos) (point))
 246         (goto-char (- (point-max) pos)))))
 247
 248 ;; This doesn't work too well in Emacs 21.2.  See 22.1 development
 249 ;; code.
 250 (defun cfengine-fill-paragraph (&optional justify)
 251   "Fill `paragraphs' in Cfengine code."
 252   (interactive "P")
 253   (or (if (fboundp 'fill-comment-paragraph)
 254           (fill-comment-paragraph justify) ; post Emacs 21.3
 255         ;; else do nothing in a comment
 256         (nth 4 (parse-partial-sexp (save-excursion
 257                                      (beginning-of-defun)
 258                                      (point))
 259                                    (point))))
 260       (let ((paragraph-start
 261              ;; Include start of parenthesized block.
 262              "\f\\|[ \t]*$\\|.*\(")
 263             (paragraph-separate
 264              ;; Include action and class lines, start and end of
 265              ;; bracketed blocks and end of parenthesized blocks to
 266              ;; avoid including these in fill.  This isn't ideal.
 267              "[ \t\f]*$\\|.*#\\|.*[\){}]\\|\\s-*[[:alpha:]_().|!]+:")
 268             fill-paragraph-function)
 269         (fill-paragraph justify))
 270       t))
 271
 272 (defun cfengine3-beginning-of-defun ()
 273   "`beginning-of-defun' function for Cfengine 3 mode.
 274 Treats body/bundle blocks as defuns."
 275   (unless (<= (current-column) (current-indentation))
 276     (end-of-line))
 277   (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
 278       (beginning-of-line)
 279     (goto-char (point-min)))
 280   t)
 281
 282 (defun cfengine3-end-of-defun ()
 283   "`end-of-defun' function for Cfengine 3 mode.
 284 Treats body/bundle blocks as defuns."
 285   (end-of-line)
 286   (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
 287       (beginning-of-line)
 288     (goto-char (point-max)))
 289   t)
 290
 291 (defun cfengine3-indent-line ()
 292   "Indent a line in Cfengine 3 mode.
 293 Intended as the value of `indent-line-function'."
 294   (let ((pos (- (point-max) (point)))
 295         parse)
 296     (save-restriction
 297       (narrow-to-defun)
 298       (back-to-indentation)
 299       (setq parse (parse-partial-sexp (point-min) (point)))
 300       (when cfengine-mode-debug
 301         (message "%S" parse))
 302
 303       (cond
 304        ;; Body/bundle blocks start at 0.
 305        ((looking-at (concat cfengine3-defuns-regex "\\>"))
 306         (indent-line-to 0))
 307        ;; Categories are indented one step.
 308        ((looking-at (concat cfengine3-category-regex "[ \t]*$"))
 309         (indent-line-to cfengine-indent))
 310        ;; Class selectors are indented two steps.
 311        ((looking-at (concat cfengine3-class-selector-regex "[ \t]*$"))
 312         (indent-line-to (* 2 cfengine-indent)))
 313        ;; Outdent leading close brackets one step.
 314        ((or (eq ?\} (char-after))
 315             (eq ?\) (char-after)))
 316         (condition-case ()
 317             (indent-line-to (save-excursion
 318                               (forward-char)
 319                               (backward-sexp)
 320                               (current-column)))
 321           (error nil)))
 322        ;; Inside a string and it starts before this line.
 323        ((and (nth 3 parse)
 324              (< (nth 8 parse) (save-excursion (beginning-of-line) (point))))
 325         (indent-line-to 0))
 326
 327        ;; Inside a defun, but not a nested list (depth is 1).  This is
 328        ;; a promise, usually.
 329
 330        ;; Indent to cfengine-indent times the nested depth
 331        ;; plus 2.  That way, promises indent deeper than class
 332        ;; selectors, which in turn are one deeper than categories.
 333        ((= 1 (nth 0 parse))
 334         (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent)))
 335        ;; Inside brackets/parens: indent to start column of non-comment
 336        ;; token on line following open bracket or by one step from open
 337        ;; bracket's column.
 338        ((condition-case ()
 339             (progn (indent-line-to (save-excursion
 340                                      (backward-up-list)
 341                                      (forward-char)
 342                                      (skip-chars-forward " \t")
 343                                      (cond
 344                                       ((looking-at "[^\n#]")
 345                                        (current-column))
 346                                       ((looking-at "[^\n#]")
 347                                        (current-column))
 348                                       (t
 349                                        (skip-chars-backward " \t")
 350                                        (+ (current-column) -1
 351                                           cfengine-indent)))))
 352                    t)
 353           (error nil)))
 354        ;; Else don't indent.
 355        (t (indent-line-to 0))))
 356     ;; If initial point was within line's indentation,
 357     ;; position after the indentation.  Else stay at same point in text.
 358     (if (> (- (point-max) pos) (point))
 359         (goto-char (- (point-max) pos)))))
 360
 361 ;; CFEngine 3.x grammar
 362
 363 ;; specification: blocks
 364 ;; blocks: block | blocks block;
 365 ;; block:                 bundle typeid blockid bundlebody
 366 ;;                      | bundle typeid blockid usearglist bundlebody
 367 ;;                      | body typeid blockid bodybody
 368 ;;                      | body typeid blockid usearglist bodybody;
 369
 370 ;; typeid: id
 371 ;; blockid: id
 372 ;; usearglist: '(' aitems ')';
 373 ;; aitems: aitem | aitem ',' aitems |;
 374 ;; aitem: id
 375
 376 ;; bundlebody: '{' statements '}'
 377 ;; statements: statement | statements statement;
 378 ;; statement: category | classpromises;
 379
 380 ;; bodybody: '{' bodyattribs '}'
 381 ;; bodyattribs: bodyattrib | bodyattribs bodyattrib;
 382 ;; bodyattrib: class | selections;
 383 ;; selections: selection | selections selection;
 384 ;; selection: id ASSIGN rval ';' ;
 385
 386 ;; classpromises: classpromise | classpromises classpromise;
 387 ;; classpromise: class | promises;
 388 ;; promises: promise | promises promise;
 389 ;; category: CATEGORY
 390 ;; promise: promiser ARROW rval constraints ';' | promiser constraints ';';
 391 ;; constraints: constraint | constraints ',' constraint |;
 392 ;; constraint: id ASSIGN rval;
 393 ;; class: CLASS
 394 ;; id: ID
 395 ;; rval: ID | QSTRING | NAKEDVAR | list | usefunction
 396 ;; list: '{' litems '}' ;
 397 ;; litems: litem | litem ',' litems |;
 398 ;; litem: ID | QSTRING | NAKEDVAR | list | usefunction
 399
 400 ;; functionid: ID | NAKEDVAR
 401 ;; promiser: QSTRING
 402 ;; usefunction: functionid givearglist
 403 ;; givearglist: '(' gaitems ')'
 404 ;; gaitems: gaitem | gaitems ',' gaitem |;
 405 ;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction
 406
 407 ;; # from lexer:
 408
 409 ;; bundle: "bundle"
 410 ;; body: "body"
 411 ;; COMMENT    #[^\n]*
 412 ;; NAKEDVAR   [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}]
 413 ;; ID: [a-zA-Z0-9_\200-\377]+
 414 ;; ASSIGN: "=>"
 415 ;; ARROW: "->"
 416 ;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*`
 417 ;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+::
 418 ;; CATEGORY: [a-zA-Z_]+:
 419
 420 (defun cfengine-common-settings ()
 421   (set (make-local-variable 'syntax-propertize-function)
 422        ;; In the main syntax-table, \ is marked as a punctuation, because
 423        ;; of its use in DOS-style directory separators.  Here we try to
 424        ;; recognize the cases where \ is used as an escape inside strings.
 425        (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
 426   (set (make-local-variable 'parens-require-spaces) nil)
 427   (set (make-local-variable 'comment-start)  "# ")
 428   (set (make-local-variable 'comment-start-skip)
 429        "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
 430   ;; Like Lisp mode.  Without this, we lose with, say,
 431   ;; `backward-up-list' when there's an unbalanced quote in a
 432   ;; preceding comment.
 433   (set (make-local-variable 'parse-sexp-ignore-comments) t))
 434
 435 (defun cfengine-common-syntax (table)
 436   ;; The syntax defaults seem OK to give reasonable word movement.
 437   (modify-syntax-entry ?# "<" table)
 438   (modify-syntax-entry ?\n ">#" table)
 439   (modify-syntax-entry ?\" "\"" table)
 440   ;; Variable substitution.
 441   (modify-syntax-entry ?$ "." table)
 442   ;; Doze path separators.
 443   (modify-syntax-entry ?\\ "." table))
 444
 445 ;;;###autoload
 446 (define-derived-mode cfengine3-mode prog-mode "CFE3"
 447   "Major mode for editing CFEngine3 input.
 448 There are no special keybindings by default.
 449
 450 Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
 451 to the action header."
 452   (cfengine-common-settings)
 453   (cfengine-common-syntax cfengine3-mode-syntax-table)
 454
 455   (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
 456   (setq font-lock-defaults
 457         '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun))
 458
 459   ;; Use defuns as the essential syntax block.
 460   (set (make-local-variable 'beginning-of-defun-function)
 461        #'cfengine3-beginning-of-defun)
 462   (set (make-local-variable 'end-of-defun-function)
 463        #'cfengine3-end-of-defun))
 464
 465 ;;;###autoload
 466 (define-derived-mode cfengine2-mode prog-mode "CFE2"
 467   "Major mode for editing CFEngine2 input.
 468 There are no special keybindings by default.
 469
 470 Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
 471 to the action header."
 472   (cfengine-common-settings)
 473   (cfengine-common-syntax cfengine2-mode-syntax-table)
 474
 475   ;; Shell commands can be quoted by single, double or back quotes.
 476   ;; It's debatable whether we should define string syntax, but it
 477   ;; should avoid potential confusion in some cases.
 478   (modify-syntax-entry ?\' "\"" cfengine2-mode-syntax-table)
 479   (modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table)
 480
 481   (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line)
 482   (set (make-local-variable 'outline-regexp) "[ \t]*\\(\\sw\\|\\s_\\)+:+")
 483   (set (make-local-variable 'outline-level) #'cfengine2-outline-level)
 484   (set (make-local-variable 'fill-paragraph-function)
 485        #'cfengine-fill-paragraph)
 486   (define-abbrev-table 'cfengine2-mode-abbrev-table cfengine-mode-abbrevs)
 487   (setq font-lock-defaults
 488         '(cfengine2-font-lock-keywords nil nil nil beginning-of-line))
 489   ;; Fixme: set the args of functions in evaluated classes to string
 490   ;; syntax, and then obey syntax properties.
 491   (setq imenu-generic-expression cfengine2-imenu-expression)
 492   (set (make-local-variable 'beginning-of-defun-function)
 493        #'cfengine2-beginning-of-defun)
 494   (set (make-local-variable 'end-of-defun-function) #'cfengine2-end-of-defun))
 495
 496 ;;;###autoload
 497 (defun cfengine-auto-mode ()
 498   "Choose between `cfengine2-mode' and `cfengine3-mode' depending
 499 on the buffer contents"
 500   (let ((v3 nil))
 501     (save-restriction
 502       (goto-char (point-min))
 503       (while (not (or (eobp) v3))
 504         (setq v3 (looking-at (concat cfengine3-defuns-regex "\\>")))
 505         (forward-line)))
 506     (if v3 (cfengine3-mode) (cfengine2-mode))))
 507
 508 (defalias 'cfengine-mode 'cfengine-auto-mode)
 509
 510 (provide 'cfengine3)
 511 (provide 'cfengine)
 512
 513 ;;; cfengine.el ends here