lisp/progmodes/cfengine.el

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