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