From: Ted Zlatanov Date: Fri, 1 Jul 2011 03:29:50 +0000 (-0500) Subject: * progmodes/cfengine3.el: New file to support CFEngine 3.x. X-Git-Tag: emacs-pretest-24.0.90~104^2~152^2~287^2~4 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=055f492351fb96556e344af8fbf097f5367ab683;p=emacs.git * progmodes/cfengine3.el: New file to support CFEngine 3.x. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 68a492311fb..8a4e095bc4f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-07-01 Teodor Zlatanov + + * progmodes/cfengine3.el: New file to support CFEngine 3.x. + 2011-07-01 Stefan Monnier * emacs-lisp/find-func.el (find-library--load-name): New fun. diff --git a/lisp/progmodes/cfengine3.el b/lisp/progmodes/cfengine3.el new file mode 100644 index 00000000000..68a4286657c --- /dev/null +++ b/lisp/progmodes/cfengine3.el @@ -0,0 +1,331 @@ +;;; cfengine3.el --- mode for editing Cfengine 3 files + +;; Copyright (C) 2001-2011 Free Software Foundation, Inc. + +;; Author: Ted Zlatanov +;; 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 . + +;;; 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