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