331 lines
12 KiB
EmacsLisp
331 lines
12 KiB
EmacsLisp
;;; cfengine3.el --- mode for editing Cfengine 3 files
|
|
|
|
;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
|
|
|
|
;; Author: Ted Zlatanov <tzz@lifelogs.com>
|
|
;; Keywords: languages
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Supports only cfengine 3, unlike the older cfengine.el which
|
|
;; supports 1.x and 2.x.
|
|
|
|
;; Possible customization for auto-mode selection:
|
|
|
|
;; (push '(("^cfagent.conf\\'" . cfengine3-mode)) auto-mode-alist)
|
|
;; (push '(("^cf\\." . cfengine3-mode)) auto-mode-alist)
|
|
;; (push '(("\\.cf\\'" . cfengine3-mode)) auto-mode-alist)
|
|
|
|
;;; Code:
|
|
|
|
(defgroup cfengine3 ()
|
|
"Editing CFEngine 3 files."
|
|
:group 'languages)
|
|
|
|
(defcustom cfengine3-indent 2
|
|
"*Size of a CFEngine 3 indentation step in columns."
|
|
:group 'cfengine3
|
|
:type 'integer)
|
|
|
|
(eval-and-compile
|
|
(defconst cfengine3-defuns
|
|
(mapcar
|
|
'symbol-name
|
|
'(bundle body))
|
|
"List of the CFEngine 3.x defun headings.")
|
|
|
|
(defconst cfengine3-defuns-regex
|
|
(regexp-opt cfengine3-defuns t)
|
|
"Regex to match the CFEngine 3.x defuns.")
|
|
|
|
(defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!]+\\)::")
|
|
|
|
(defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
|
|
|
|
(defconst cfengine3-vartypes
|
|
(mapcar
|
|
'symbol-name
|
|
'(string int real slist ilist rlist irange rrange counter))
|
|
"List of the CFEngine 3.x variable types."))
|
|
|
|
(defvar cfengine3-font-lock-keywords
|
|
`(
|
|
(,(concat "^[ \t]*" cfengine3-class-selector-regex)
|
|
1 font-lock-keyword-face)
|
|
(,(concat "^[ \t]*" cfengine3-category-regex)
|
|
1 font-lock-builtin-face)
|
|
;; Variables, including scope, e.g. module.var
|
|
("[@$](\\([[:alnum:]_.]+\\))" 1 font-lock-variable-name-face)
|
|
("[@$]{\\([[:alnum:]_.]+\\)}" 1 font-lock-variable-name-face)
|
|
;; Variable definitions.
|
|
("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
|
|
|
|
;; CFEngine 3.x faces
|
|
;; defuns
|
|
(,(concat "\\<" cfengine3-defuns-regex "\\>"
|
|
"[ \t]+\\<\\([[:alnum:]_]+\\)\\>"
|
|
"[ \t]+\\<\\([[:alnum:]_]+\\)\\((\\([^)]*\\))\\)?")
|
|
(1 font-lock-builtin-face)
|
|
(2 font-lock-constant-name-face)
|
|
(3 font-lock-function-name-face)
|
|
(5 font-lock-variable-name-face))
|
|
;; variable types
|
|
(,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>")
|
|
1 font-lock-type-face)))
|
|
|
|
(defun cfengine3-beginning-of-defun ()
|
|
"`beginning-of-defun' function for Cfengine 3 mode.
|
|
Treats body/bundle blocks as defuns."
|
|
(unless (<= (current-column) (current-indentation))
|
|
(end-of-line))
|
|
(if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
|
|
(beginning-of-line)
|
|
(goto-char (point-min)))
|
|
t)
|
|
|
|
(defun cfengine3-end-of-defun ()
|
|
"`end-of-defun' function for Cfengine 3 mode.
|
|
Treats body/bundle blocks as defuns."
|
|
(end-of-line)
|
|
(if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
|
|
(beginning-of-line)
|
|
(goto-char (point-max)))
|
|
t)
|
|
|
|
(defun cfengine3-indent-line ()
|
|
"Indent a line in Cfengine mode.
|
|
Intended as the value of `indent-line-function'."
|
|
(let ((pos (- (point-max) (point)))
|
|
parse)
|
|
(save-restriction
|
|
(narrow-to-defun)
|
|
(back-to-indentation)
|
|
(setq parse (parse-partial-sexp (point-min) (point)))
|
|
(message "%S" parse)
|
|
(cond
|
|
;; body/bundle blocks start at 0
|
|
((looking-at (concat cfengine3-defuns-regex "\\>"))
|
|
(indent-line-to 0))
|
|
;; categories are indented one step
|
|
((looking-at (concat cfengine3-category-regex "[ \t]*$"))
|
|
(indent-line-to cfengine3-indent))
|
|
;; class selectors are indented two steps
|
|
((looking-at (concat cfengine3-class-selector-regex "[ \t]*$"))
|
|
(indent-line-to (* 2 cfengine3-indent)))
|
|
;; Outdent leading close brackets one step.
|
|
((or (eq ?\} (char-after))
|
|
(eq ?\) (char-after)))
|
|
(condition-case ()
|
|
(indent-line-to (save-excursion
|
|
(forward-char)
|
|
(backward-sexp)
|
|
(current-column)))
|
|
(error nil)))
|
|
;; inside a string and it starts before this line
|
|
((and (nth 3 parse)
|
|
(< (nth 8 parse) (save-excursion (beginning-of-line) (point))))
|
|
(indent-line-to 0))
|
|
;; inside a defun, but not a nested list (depth is 1)
|
|
((= 1 (nth 0 parse))
|
|
(indent-line-to (* (+ 2 (nth 0 parse)) cfengine3-indent)))
|
|
;; Inside brackets/parens: indent to start column of non-comment
|
|
;; token on line following open bracket or by one step from open
|
|
;; bracket's column.
|
|
((condition-case ()
|
|
(progn (indent-line-to (save-excursion
|
|
(backward-up-list)
|
|
(forward-char)
|
|
(skip-chars-forward " \t")
|
|
(cond
|
|
((looking-at "[^\n#]")
|
|
(current-column))
|
|
((looking-at "[^\n#]")
|
|
(current-column))
|
|
(t
|
|
(skip-chars-backward " \t")
|
|
(+ (current-column) -1
|
|
cfengine3-indent)))))
|
|
t)
|
|
(error nil)))
|
|
;; Else don't indent.
|
|
(t (indent-line-to 0))))
|
|
;; If initial point was within line's indentation,
|
|
;; position after the indentation. Else stay at same point in text.
|
|
(if (> (- (point-max) pos) (point))
|
|
(goto-char (- (point-max) pos)))))
|
|
|
|
;; (defvar cfengine3-smie-grammar
|
|
;; (smie-prec2->grammar
|
|
;; (smie-merge-prec2s
|
|
;; (smie-bnf->prec2
|
|
;; '((token)
|
|
;; (decls (decls "body" decls)
|
|
;; (decls "bundle" decls))
|
|
;; (insts (token ":" insts)))
|
|
;; '((assoc "body" "bundle")))
|
|
;; (smie-precs->prec2
|
|
;; '((right ":")
|
|
;; (right "::")
|
|
;; (assoc ";")
|
|
;; (assoc ",")
|
|
;; (right "=>"))))))
|
|
|
|
;; (defun cfengine3-smie-rules (kind token)
|
|
;; (pcase (cons kind token)
|
|
;; (`(:elem . basic) 2)
|
|
;; (`(:list-intro . ,(or `"body" `"bundle")) t)
|
|
;; (`(:after . ":") 2)
|
|
;; (`(:after . "::") 2)))
|
|
|
|
;; (defun cfengine3-show-all-tokens ()
|
|
;; (interactive)
|
|
;; (goto-char (point-min))
|
|
;; (while (not (eobp))
|
|
;; (let* ((p (point))
|
|
;; (token (funcall smie-forward-token-function)))
|
|
;; (delete-region p (point))
|
|
;; (insert-before-markers token)
|
|
;; (forward-char))))
|
|
|
|
;; (defun cfengine3-line-classes ()
|
|
;; (interactive)
|
|
;; (save-excursion
|
|
;; (beginning-of-line)
|
|
;; (let* ((todo (buffer-substring (point)
|
|
;; (save-excursion (end-of-line) (point))))
|
|
;; (original (concat (loop for c across todo
|
|
;; collect (char-syntax c)))))
|
|
;; (format "%s\n%s" original todo))))
|
|
|
|
;; (defun cfengine3-show-all-classes ()
|
|
;; (interactive)
|
|
;; (goto-char (point-min))
|
|
;; (while (not (eobp))
|
|
;; (let ((repl (cfengine3-line-classes)))
|
|
;; (kill-line)
|
|
;; (insert repl)
|
|
;; (insert "\n"))))
|
|
|
|
;; specification: blocks
|
|
;; blocks: block | blocks block;
|
|
;; block: bundle typeid blockid bundlebody
|
|
;; | bundle typeid blockid usearglist bundlebody
|
|
;; | body typeid blockid bodybody
|
|
;; | body typeid blockid usearglist bodybody;
|
|
|
|
;; typeid: id
|
|
;; blockid: id
|
|
;; usearglist: '(' aitems ')';
|
|
;; aitems: aitem | aitem ',' aitems |;
|
|
;; aitem: id
|
|
|
|
;; bundlebody: '{' statements '}'
|
|
;; statements: statement | statements statement;
|
|
;; statement: category | classpromises;
|
|
|
|
;; bodybody: '{' bodyattribs '}'
|
|
;; bodyattribs: bodyattrib | bodyattribs bodyattrib;
|
|
;; bodyattrib: class | selections;
|
|
;; selections: selection | selections selection;
|
|
;; selection: id ASSIGN rval ';' ;
|
|
|
|
;; classpromises: classpromise | classpromises classpromise;
|
|
;; classpromise: class | promises;
|
|
;; promises: promise | promises promise;
|
|
;; category: CATEGORY
|
|
;; promise: promiser ARROW rval constraints ';' | promiser constraints ';';
|
|
;; constraints: constraint | constraints ',' constraint |;
|
|
;; constraint: id ASSIGN rval;
|
|
;; class: CLASS
|
|
;; id: ID
|
|
;; rval: ID | QSTRING | NAKEDVAR | list | usefunction
|
|
;; list: '{' litems '}' ;
|
|
;; litems: litem | litem ',' litems |;
|
|
;; litem: ID | QSTRING | NAKEDVAR | list | usefunction
|
|
|
|
;; functionid: ID | NAKEDVAR
|
|
;; promiser: QSTRING
|
|
;; usefunction: functionid givearglist
|
|
;; givearglist: '(' gaitems ')'
|
|
;; gaitems: gaitem | gaitems ',' gaitem |;
|
|
;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction
|
|
|
|
;; # from lexer:
|
|
|
|
;; bundle: "bundle"
|
|
;; body: "body"
|
|
;; COMMENT #[^\n]*
|
|
;; NAKEDVAR [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}]
|
|
;; ID: [a-zA-Z0-9_\200-\377]+
|
|
;; ASSIGN: "=>"
|
|
;; ARROW: "->"
|
|
;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*`
|
|
;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+::
|
|
;; CATEGORY: [a-zA-Z_]+:
|
|
|
|
;;;###autoload
|
|
(define-derived-mode cfengine3-mode prog-mode "CFEngine3"
|
|
"Major mode for editing cfengine input.
|
|
There are no special keybindings by default.
|
|
|
|
Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
|
|
to the action header."
|
|
(modify-syntax-entry ?# "<" cfengine3-mode-syntax-table)
|
|
(modify-syntax-entry ?\n ">#" cfengine3-mode-syntax-table)
|
|
(modify-syntax-entry ?\" "\"" cfengine3-mode-syntax-table)
|
|
;; variable substitution:
|
|
(modify-syntax-entry ?$ "." cfengine3-mode-syntax-table)
|
|
;; Doze path separators:
|
|
(modify-syntax-entry ?\\ "." cfengine3-mode-syntax-table)
|
|
;; Otherwise, syntax defaults seem OK to give reasonable word
|
|
;; movement.
|
|
|
|
;; (smie-setup cfengine3-smie-grammar #'cfengine3-smie-rules)
|
|
;; ;; :forward-token #'cfengine3-smie-forward-token
|
|
;; ;; :backward-token #'cfengine3-smie-backward-token)
|
|
;; (set (make-local-variable 'smie-indent-basic) 'cfengine3-indent)
|
|
|
|
(set (make-local-variable 'parens-require-spaces) nil)
|
|
(set (make-local-variable 'comment-start) "# ")
|
|
(set (make-local-variable 'comment-start-skip)
|
|
"\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
|
|
(set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
|
|
(setq font-lock-defaults
|
|
'(cfengine3-font-lock-keywords nil nil nil beginning-of-defun))
|
|
;; Fixme: set the args of functions in evaluated classes to string
|
|
;; syntax, and then obey syntax properties.
|
|
(set (make-local-variable 'syntax-propertize-function)
|
|
;; In the main syntax-table, \ is marked as a punctuation, because
|
|
;; of its use in DOS-style directory separators. Here we try to
|
|
;; recognize the cases where \ is used as an escape inside strings.
|
|
(syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
|
|
|
|
;; use defuns as the essential syntax block
|
|
(set (make-local-variable 'beginning-of-defun-function)
|
|
#'cfengine3-beginning-of-defun)
|
|
(set (make-local-variable 'end-of-defun-function)
|
|
#'cfengine3-end-of-defun)
|
|
|
|
;; Like Lisp mode. Without this, we lose with, say,
|
|
;; `backward-up-list' when there's an unbalanced quote in a
|
|
;; preceding comment.
|
|
(set (make-local-variable 'parse-sexp-ignore-comments) t))
|
|
|
|
(provide 'cfengine3)
|
|
|
|
;;; cfengine3.el ends here
|