Commit 055f4923 authored by Ted Zlatanov's avatar Ted Zlatanov
Browse files

* progmodes/cfengine3.el: New file to support CFEngine 3.x.

parent 6a2fb145
2011-07-01 Teodor Zlatanov <tzz@lifelogs.com>
* progmodes/cfengine3.el: New file to support CFEngine 3.x.
2011-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/find-func.el (find-library--load-name): New fun.
......
;;; 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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment