X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e61d39cddfd015032a6419ce75c36ecdf1e9fe9f..6dc0bafd5915b01a341cc0efbc744abd73163872:/lisp/progmodes/cfengine.el diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 64e99fb1f3..0830214720 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -1,11 +1,11 @@ ;;; cfengine.el --- mode for editing Cfengine files -;; Copyright (C) 2001-2012 Free Software Foundation, Inc. +;; Copyright (C) 2001-2016 Free Software Foundation, Inc. ;; Author: Dave Love ;; Maintainer: Ted Zlatanov ;; Keywords: languages -;; Version: 1.1 +;; Version: 1.4 ;; This file is part of GNU Emacs. @@ -24,17 +24,16 @@ ;;; Commentary: -;; Provides support for editing GNU Cfengine files, including +;; Provides support for editing GNU CFEngine files, including ;; font-locking, Imenu and indentation, but with no special keybindings. -;; The CFEngine 3.x support doesn't have Imenu support but patches are -;; welcome. +;; By default, CFEngine 3.x syntax is used. ;; You can set it up so either `cfengine2-mode' (2.x and earlier) or ;; `cfengine3-mode' (3.x) will be picked, depending on the buffer ;; contents: -;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-mode)) +;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-auto-mode)) ;; OR you can choose to always use a specific version, if you prefer ;; it: @@ -43,12 +42,27 @@ ;; (add-to-list 'auto-mode-alist '("^cf\\." . cfengine2-mode)) ;; (add-to-list 'auto-mode-alist '("^cfagent.conf\\'" . cfengine2-mode)) +;; It's *highly* recommended that you enable the eldoc minor mode: + +;; (add-hook 'cfengine3-mode-hook 'eldoc-mode) + +;; You may also find the command `cfengine3-reformat-json-string' +;; useful, just bind it to a key you prefer. It will take the current +;; string and reformat it as JSON. So if you're editing JSON inside +;; the policy, it's a quick way to make it more legible without +;; manually reindenting it. For instance: + +;; (global-set-key [(control f4)] 'cfengine3-reformat-json-string) + ;; This is not the same as the mode written by Rolf Ebert ;; , distributed with cfengine-2.0.5. It does ;; better fontification and indentation, inter alia. ;;; Code: +(autoload 'json-read "json") +(autoload 'json-pretty-print "json") + (defgroup cfengine () "Editing CFEngine files." :group 'languages) @@ -58,9 +72,731 @@ :group 'cfengine :type 'integer) +(defcustom cfengine-cf-promises + (or (executable-find "cf-promises") + (executable-find "/var/cfengine/bin/cf-promises") + (executable-find "/usr/bin/cf-promises") + (executable-find "/usr/sbin/cf-promises") + (executable-find "/usr/local/bin/cf-promises") + (executable-find "/usr/local/sbin/cf-promises") + (executable-find "~/bin/cf-promises") + (executable-find "~/sbin/cf-promises")) + "The location of the cf-promises executable. +Used for syntax discovery and checking. Set to nil to disable +the `compile-command' override. In that case, the ElDoc support +will use a fallback syntax definition." + :version "24.4" + :group 'cfengine + :type '(choice file (const nil))) + +(defcustom cfengine-parameters-indent '(promise pname 2) + "Indentation of CFEngine3 promise parameters (hanging indent). + +For example, say you have this code: + +bundle x y +{ + section: + class:: + promise ... + promiseparameter => ... +} + +You can choose to indent promiseparameter from the beginning of +the line (absolutely) or from the word \"promise\" (relatively). + +You can also choose to indent the start of the word +\"promiseparameter\" or the arrow that follows it. + +Finally, you can choose the amount of the indent. + +The default is to anchor at promise, indent parameter name, and offset 2: + +bundle agent rcfiles +{ + files: + any:: + \"/tmp/netrc\" + comment => \"my netrc\", + perms => mog(\"600\", \"tzz\", \"tzz\"); +} + +Here we anchor at beginning of line, indent arrow, and offset 10: + +bundle agent rcfiles +{ + files: + any:: + \"/tmp/netrc\" + comment => \"my netrc\", + perms => mog(\"600\", \"tzz\", \"tzz\"); +} + +Some, including cfengine_stdlib.cf, like to anchor at promise, indent +arrow, and offset 16 or so: + +bundle agent rcfiles +{ + files: + any:: + \"/tmp/netrc\" + comment => \"my netrc\", + perms => mog(\"600\", \"tzz\", \"tzz\"); +} +" + :version "24.4" + :group 'cfengine + :type '(list + (choice (const :tag "Anchor at beginning of promise" promise) + (const :tag "Anchor at beginning of line" bol)) + (choice (const :tag "Indent parameter name" pname) + (const :tag "Indent arrow" arrow)) + (integer :tag "Indentation amount from anchor"))) + (defvar cfengine-mode-debug nil "Whether `cfengine-mode' should print debugging info.") +(defvar cfengine-mode-syntax-cache nil + "Cache for `cfengine-mode' syntax trees obtained from `cf-promises -s json'.") + +(defconst cfengine3-fallback-syntax + '((functions + (userexists + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (usemodule + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (unique + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (translatepath + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "string") (status . "normal")) + (sum + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "real") (status . "normal")) + (sublist + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "head,tail") (type . "option")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (strftime + (category . "data") (variadic . :json-false) + (parameters . [((range . "gmtime,localtime") (type . "option")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (strcmp + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (splitstring + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (splayclass + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "daily,hourly") (type . "option"))]) + (returnType . "context") (status . "normal")) + (sort + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "lex") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (some + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (shuffle + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (selectservers + (category . "communication") (variadic . :json-false) + (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "int") (status . "normal")) + (reverse + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (rrange + (category . "data") (variadic . :json-false) + (parameters . [((range . "-9.99999E100,9.99999E100") (type . "real")) + ((range . "-9.99999E100,9.99999E100") (type . "real"))]) + (returnType . "rrange") (status . "normal")) + (returnszero + (category . "utils") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "useshell,noshell,powershell") (type . "option"))]) + (returnType . "context") (status . "normal")) + (remoteclassesmatching + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "true,false,yes,no,on,off") (type . "option")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (remotescalar + (category . "communication") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "true,false,yes,no,on,off") (type . "option"))]) + (returnType . "string") (status . "normal")) + (regldap + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "subtree,onelevel,base") (type . "option")) + ((range . ".*") (type . "string")) + ((range . "none,ssl,sasl") (type . "option"))]) + (returnType . "context") (status . "normal")) + (reglist + (category . "data") (variadic . :json-false) + (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (regline + (category . "io") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (registryvalue + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (regextract + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (regcmp + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (regarray + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (readtcp + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (readstringlist + (category . "io") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (readstringarrayidx + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (readstringarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (readreallist + (category . "io") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "rlist") (status . "normal")) + (readrealarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (readintlist + (category . "io") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "ilist") (status . "normal")) + (readintarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (readfile + (category . "io") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (randomint + (category . "data") (variadic . :json-false) + (parameters . [((range . "-99999999999,9999999999") (type . "int")) + ((range . "-99999999999,9999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (product + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "real") (status . "normal")) + (peerleaders + (category . "communication") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (peerleader + (category . "communication") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (peers + (category . "communication") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (parsestringarrayidx + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (parsestringarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (parserealarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (parseintarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (or + (category . "data") (variadic . t) + (parameters . []) + (returnType . "string") (status . "normal")) + (on + (category . "data") (variadic . :json-false) + (parameters . [((range . "1970,3000") (type . "int")) + ((range . "1,12") (type . "int")) + ((range . "1,31") (type . "int")) + ((range . "0,23") (type . "int")) + ((range . "0,59") (type . "int")) + ((range . "0,59") (type . "int"))]) + (returnType . "int") (status . "normal")) + (nth + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (now + (category . "system") (variadic . :json-false) + (parameters . []) + (returnType . "int") (status . "normal")) + (not + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (none + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (maplist + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (maparray + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (lsdir + (category . "files") (variadic . :json-false) + (parameters . [((range . ".+") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "true,false,yes,no,on,off") (type . "option"))]) + (returnType . "slist") (status . "normal")) + (length + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "int") (status . "normal")) + (ldapvalue + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "subtree,onelevel,base") (type . "option")) + ((range . "none,ssl,sasl") (type . "option"))]) + (returnType . "string") (status . "normal")) + (ldaplist + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "subtree,onelevel,base") (type . "option")) + ((range . "none,ssl,sasl") (type . "option"))]) + (returnType . "slist") (status . "normal")) + (ldaparray + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "subtree,onelevel,base") (type . "option")) + ((range . "none,ssl,sasl") (type . "option"))]) + (returnType . "context") (status . "normal")) + (laterthan + (category . "files") (variadic . :json-false) + (parameters . [((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,40000") (type . "int"))]) + (returnType . "context") (status . "normal")) + (lastnode + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (join + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "string") (status . "normal")) + (isvariable + (category . "utils") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isplain + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isnewerthan + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (islink + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (islessthan + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isgreaterthan + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isexecutable + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isdir + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (irange + (category . "data") (variadic . :json-false) + (parameters . [((range . "-99999999999,9999999999") (type . "int")) + ((range . "-99999999999,9999999999") (type . "int"))]) + (returnType . "irange") (status . "normal")) + (iprange + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (intersection + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (ifelse + (category . "data") (variadic . t) + (parameters . []) + (returnType . "string") (status . "normal")) + (hubknowledge + (category . "communication") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "string") (status . "normal")) + (hostswithclass + (category . "communication") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_]+") (type . "string")) + ((range . "name,address") (type . "option"))]) + (returnType . "slist") (status . "normal")) + (hostsseen + (category . "communication") (variadic . :json-false) + (parameters . [((range . "0,99999999999") (type . "int")) + ((range . "lastseen,notseen") (type . "option")) + ((range . "name,address") (type . "option"))]) + (returnType . "slist") (status . "normal")) + (hostrange + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (hostinnetgroup + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (ip2host + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (host2ip + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (hashmatch + (category . "data") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "md5,sha1,crypt,cf_sha224,cf_sha256,cf_sha384,cf_sha512") (type . "option")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (hash + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "md5,sha1,sha256,sha512,sha384,crypt") (type . "option"))]) + (returnType . "string") (status . "normal")) + (groupexists + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (grep + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (getvalues + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (getusers + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (getuid + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "int") (status . "normal")) + (getindices + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (getgid + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "int") (status . "normal")) + (getfields + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "int") (status . "normal")) + (getenv + (category . "system") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (format + (category . "data") (variadic . t) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (filter + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "true,false,yes,no,on,off") (type . "option")) + ((range . "true,false,yes,no,on,off") (type . "option")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (filestat + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "size,gid,uid,ino,nlink,ctime,atime,mtime,mode,modeoct,permstr,permoct,type,devno,dev_minor,dev_major,basename,dirname") (type . "option"))]) + (returnType . "string") (status . "normal")) + (filesize + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "int") (status . "normal")) + (filesexist + (category . "files") (variadic . :json-false) + (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))]) + (returnType . "context") (status . "normal")) + (fileexists + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (execresult + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".+") (type . "string")) + ((range . "useshell,noshell,powershell") (type . "option"))]) + (returnType . "string") (status . "normal")) + (every + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (escape + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (diskfree + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "int") (status . "normal")) + (dirname + (category . "files") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (difference + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (countlinesmatching + (category . "io") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "\"?(/.*)") (type . "string"))]) + (returnType . "int") (status . "normal")) + (countclassesmatching + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "int") (status . "normal")) + (classesmatching + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (classmatch + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (classify + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (changedbefore + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (concat + (category . "data") (variadic . t) + (parameters . []) + (returnType . "string") (status . "normal")) + (canonify + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (and + (category . "data") (variadic . t) + (parameters . []) + (returnType . "string") (status . "normal")) + (ago + (category . "data") (variadic . :json-false) + (parameters . [((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,40000") (type . "int"))]) + (returnType . "int") (status . "normal")) + (accumulated + (category . "data") (variadic . :json-false) + (parameters . [((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,40000") (type . "int"))]) + (returnType . "int") (status . "normal")) + (accessedbefore + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")))) + "Fallback CFEngine syntax, containing just function definitions.") + +(defvar cfengine-mode-syntax-functions-regex + (regexp-opt (mapcar (lambda (def) + (format "%s" (car def))) + (cdr (assq 'functions cfengine3-fallback-syntax))) + 'symbols)) + (defcustom cfengine-mode-abbrevs nil "Abbrevs for CFEngine2 mode." :group 'cfengine @@ -84,24 +820,26 @@ "List of the action keywords supported by Cfengine. This includes those for cfservd as well as cfagent.") - (defconst cfengine3-defuns - (mapcar - 'symbol-name - '(bundle body)) + (defconst cfengine3-defuns '("bundle" "body") "List of the CFEngine 3.x defun headings.") - (defconst cfengine3-defuns-regex - (regexp-opt cfengine3-defuns t) + (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-defun-full-re (concat "^\\s-*" cfengine3-defuns-regex + "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;type + "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;id + ) + "Regexp matching full defun declaration (excluding argument list).") + + (defconst cfengine3-macro-regex "\\(@[a-zA-Z].+\\)") + + (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)) + (defconst cfengine3-vartypes '("string" "int" "real" "slist" "ilist" "rlist" + "irange" "rrange" "counter" "data") "List of the CFEngine 3.x variable types.")) (defvar cfengine2-font-lock-keywords @@ -117,17 +855,25 @@ This includes those for cfservd as well as cfagent.") ("$(\\([[: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) + ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) ;; File, acl &c in group: { token ... } ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) (defvar cfengine3-font-lock-keywords `( + ;; Macros + (,(concat "^" cfengine3-macro-regex) + 1 font-lock-error-face) + + ;; invalid macros + (,(concat "^[ \t]*" cfengine3-macro-regex) + 1 font-lock-warning-face) + ;; Defuns. This happens early so they don't get caught by looser ;; patterns. - (,(concat "\\<" cfengine3-defuns-regex "\\>" - "[ \t]+\\<\\([[:alnum:]_]+\\)\\>" - "[ \t]+\\<\\([[:alnum:]_]+\\)" + (,(concat "\\_<" cfengine3-defuns-regex "\\_>" + "[ \t]+\\_<\\([[:alnum:]_.:]+\\)\\_>" + "[ \t]+\\_<\\([[:alnum:]_.:]+\\)" ;; Optional parentheses with variable names inside. "\\(?:(\\([^)]*\\))\\)?") (1 font-lock-builtin-face) @@ -144,14 +890,14 @@ This includes those for cfservd as well as cfagent.") 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) + ("[@$](\\([[: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) + ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) ;; Variable types. - (,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>") + (,(concat "\\_<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\_>") 1 font-lock-type-face))) (defvar cfengine2-imenu-expression @@ -159,9 +905,9 @@ This includes those for cfservd as well as cfagent.") (regexp-opt cfengine2-actions t)) ":[^:]") 1) - ("Variables/classes" "\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1) - ("Variables/classes" "\\[ \t]+\\([[:alnum:]_]+\\)" 1)) + ("Variables/classes" "\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1) + ("Variables/classes" "\\_[ \t]+\\([[:alnum:]_]+\\)" 1)) "`imenu-generic-expression' for CFEngine mode.") (defun cfengine2-outline-level () @@ -259,12 +1005,12 @@ Intended as the value of `indent-line-function'." (point)))) (let ((paragraph-start ;; Include start of parenthesized block. - "\f\\|[ \t]*$\\|.*\(") + "\f\\|[ \t]*$\\|.*(") (paragraph-separate ;; Include action and class lines, start and end of ;; bracketed blocks and end of parenthesized blocks to ;; avoid including these in fill. This isn't ideal. - "[ \t\f]*$\\|.*#\\|.*[\){}]\\|\\s-*[[:alpha:]_().|!]+:") + "[ \t\f]*$\\|.*#\\|.*[){}]\\|\\s-*[[:alpha:]_().|!]+:") fill-paragraph-function) (fill-paragraph justify)) t)) @@ -274,7 +1020,7 @@ Intended as the value of `indent-line-function'." 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) + (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t) (beginning-of-line) (goto-char (point-min))) t) @@ -283,13 +1029,13 @@ Treats body/bundle blocks as defuns." "`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) + (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 3 mode. + "Indent a line in CFEngine 3 mode. Intended as the value of `indent-line-function'." (let ((pos (- (point-max) (point))) parse) @@ -301,14 +1047,18 @@ Intended as the value of `indent-line-function'." (message "%S" parse)) (cond + ;; Macros start at 0. But make sure we're not inside a string. + ((and (not (nth 3 parse)) + (looking-at (concat cfengine3-macro-regex))) + (indent-line-to 0)) ;; Body/bundle blocks start at 0. - ((looking-at (concat cfengine3-defuns-regex "\\>")) + ((looking-at (concat cfengine3-defuns-regex "\\_>")) (indent-line-to 0)) ;; Categories are indented one step. - ((looking-at (concat cfengine3-category-regex "[ \t]*$")) + ((looking-at (concat cfengine3-category-regex "[ \t]*\\(#.*\\)*$")) (indent-line-to cfengine-indent)) ;; Class selectors are indented two steps. - ((looking-at (concat cfengine3-class-selector-regex "[ \t]*$")) + ((looking-at (concat cfengine3-class-selector-regex "[ \t]*\\(#.*\\)*$")) (indent-line-to (* 2 cfengine-indent))) ;; Outdent leading close brackets one step. ((or (eq ?\} (char-after)) @@ -317,12 +1067,14 @@ Intended as the value of `indent-line-function'." (indent-line-to (save-excursion (forward-char) (backward-sexp) + (move-beginning-of-line nil) + (skip-chars-forward " \t") (current-column))) (error nil))) - ;; Inside a string and it starts before this line. + ;; Inside a string and it starts before this line: do nothing. ((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). This is ;; a promise, usually. @@ -331,7 +1083,23 @@ Intended as the value of `indent-line-function'." ;; plus 2. That way, promises indent deeper than class ;; selectors, which in turn are one deeper than categories. ((= 1 (nth 0 parse)) - (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent))) + (let ((p-anchor (nth 0 cfengine-parameters-indent)) + (p-what (nth 1 cfengine-parameters-indent)) + (p-indent (nth 2 cfengine-parameters-indent))) + ;; Do we have the parameter anchor and location and indent + ;; defined, and are we looking at a promise parameter? + (if (and p-anchor p-what p-indent + (looking-at "\\([[:alnum:]_]+[ \t]*\\)=>")) + (let* ((arrow-offset (* -1 (length (match-string 1)))) + (extra-offset (if (eq p-what 'arrow) arrow-offset 0)) + (base-offset (if (eq p-anchor 'promise) + (* (+ 2 (nth 0 parse)) cfengine-indent) + 0))) + (indent-line-to (max 0 (+ p-indent base-offset extra-offset)))) + ;; Else, indent to cfengine-indent times the nested depth + ;; plus 2. That way, promises indent deeper than class + ;; selectors, which in turn are one deeper than categories. + (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-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. @@ -358,6 +1126,19 @@ Intended as the value of `indent-line-function'." (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))))) +(defun cfengine3-reformat-json-string () + "Reformat the current string as JSON using `json-pretty-print'." + (interactive) + (let ((ppss (syntax-ppss))) + (when (nth 3 ppss) ;inside a string + (save-excursion + (goto-char (nth 8 ppss)) + (forward-char 1) + (let ((start (point))) + (forward-sexp 1) + (json-pretty-print start + (point))))))) + ;; CFEngine 3.x grammar ;; specification: blocks @@ -417,6 +1198,121 @@ Intended as the value of `indent-line-function'." ;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+:: ;; CATEGORY: [a-zA-Z_]+: +(defun cfengine3--current-function () + "Look up current CFEngine 3 function" + (let* ((syntax (cfengine3-make-syntax-cache)) + (flist (assq 'functions syntax))) + (when flist + (let ((w (save-excursion + (skip-syntax-forward "w_") + (when (search-backward-regexp + cfengine-mode-syntax-functions-regex + (point-at-bol) + t) + (match-string 1))))) + (and w (assq (intern w) flist)))))) + +;; format from "cf-promises -s json", e.g. "sort" function: +;; ((category . "data") +;; (variadic . :json-false) +;; (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) +;; ((range . "lex,int,real,IP,ip,MAC,mac") (type . "option"))]) +;; (returnType . "slist") +;; (status . "normal")) + +(defun cfengine3-format-function-docstring (fdef) + (let* ((f (format "%s" (car-safe fdef))) + (def (cdr fdef)) + (rtype (cdr (assq 'returnType def))) + (plist (cdr (assq 'parameters def))) + (has-some-parameters (> (length plist) 0)) + (variadic (eq t (cdr (assq 'variadic def))))) + + ;; (format "[%S]%s %s(%s%s)" def + (format "%s %s(%s%s)" + (if rtype + (propertize rtype 'face 'font-lock-variable-name-face) + "???") + (propertize f 'face 'font-lock-function-name-face) + (mapconcat (lambda (p) + (let* ((type (cdr (assq 'type p))) + (description (cdr (assq 'description p))) + (desc-string (if (stringp description) + (concat " /" description "/") + "")) + (range (cdr (assq 'range p)))) + (cond + ((not (stringp type)) "???type???") + ((not (stringp range)) "???range???") + ;; options are lists of possible keywords + ((equal type "option") + (propertize (concat "[" range "]" desc-string) + 'face + 'font-lock-keyword-face)) + ;; anything else is a type name as a variable + (t (propertize (concat type desc-string) + 'face + 'font-lock-variable-name-face))))) + plist + ", ") + (if variadic + (if has-some-parameters ", ..." "...") + "")))) + +(defun cfengine3-clear-syntax-cache () + "Clear the internal syntax cache. +Should not be necessary unless you reinstall CFEngine." + (interactive) + (setq cfengine-mode-syntax-functions-regex nil) + (setq cfengine-mode-syntax-cache nil)) + +(defun cfengine3-make-syntax-cache () + "Build the CFEngine 3 syntax cache and return the syntax. +Calls `cfengine-cf-promises' with \"-s json\"." + (or (cdr (assoc cfengine-cf-promises cfengine-mode-syntax-cache)) + (let ((syntax (or (when cfengine-cf-promises + (with-demoted-errors "cfengine3-make-syntax-cache: %S" + (with-temp-buffer + (or (zerop (process-file cfengine-cf-promises + nil ; no input + t ; output + nil ; no redisplay + "-s" "json")) + (error "%s" (buffer-substring + (point-min) + (progn (goto-char (point-min)) + (line-end-position))))) + (goto-char (point-min)) + (json-read)))) + cfengine3-fallback-syntax))) + (push (cons cfengine-cf-promises syntax) + cfengine-mode-syntax-cache) + (setq cfengine-mode-syntax-functions-regex + (regexp-opt (mapcar (lambda (def) + (format "%s" (car def))) + (cdr (assq 'functions syntax))) + 'symbols)) + syntax))) + +(defun cfengine3-documentation-function () + "Document CFengine 3 functions around point. +Intended as the value of `eldoc-documentation-function', which see. +Use it by enabling `eldoc-mode'." + (let ((fdef (cfengine3--current-function))) + (when fdef + (cfengine3-format-function-docstring fdef)))) + +(defun cfengine3-completion-function () + "Return completions for function name around or before point." + (let* ((bounds (save-excursion + (let ((p (point))) + (skip-syntax-backward "w_" (point-at-bol)) + (list (point) p)))) + (syntax (cfengine3-make-syntax-cache)) + (flist (assq 'functions syntax))) + (when bounds + (append bounds (list (cdr flist)))))) + (defun cfengine-common-settings () (set (make-local-variable 'syntax-propertize-function) ;; In the main syntax-table, \ is marked as a punctuation, because @@ -436,12 +1332,38 @@ Intended as the value of `indent-line-function'." ;; The syntax defaults seem OK to give reasonable word movement. (modify-syntax-entry ?# "<" table) (modify-syntax-entry ?\n ">#" table) - (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\" "\"" table) ; "string" + (modify-syntax-entry ?\' "\"" table) ; 'string' ;; Variable substitution. (modify-syntax-entry ?$ "." table) ;; Doze path separators. (modify-syntax-entry ?\\ "." table)) +(defconst cfengine3--prettify-symbols-alist + '(("->" . ?→) + ("=>" . ?⇒) + ("::" . ?∷))) + +(defun cfengine3-create-imenu-index () + "A function for `imenu-create-index-function'. +Note: defun name is separated by space such as `body +package_method opencsw' and imenu will replace spaces according +to `imenu-space-replacement' (which see)." + (goto-char (point-min)) + (let ((defuns ())) + (while (re-search-forward cfengine3-defun-full-re nil t) + (push (cons (mapconcat #'match-string '(1 2 3) " ") + (copy-marker (match-beginning 3))) + defuns)) + (nreverse defuns))) + +(defun cfengine3-current-defun () + "A function for `add-log-current-defun-function'." + (end-of-line) + (beginning-of-defun) + (and (looking-at cfengine3-defun-full-re) + (mapconcat #'match-string '(1 2 3) " "))) + ;;;###autoload (define-derived-mode cfengine3-mode prog-mode "CFE3" "Major mode for editing CFEngine3 input. @@ -453,14 +1375,37 @@ to the action header." (cfengine-common-syntax cfengine3-mode-syntax-table) (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line) + (setq font-lock-defaults - '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun)) + '(cfengine3-font-lock-keywords + nil nil nil beginning-of-defun)) + (setq-local prettify-symbols-alist cfengine3--prettify-symbols-alist) + + ;; `compile-command' is almost never a `make' call with CFEngine so + ;; we override it + (when cfengine-cf-promises + (set (make-local-variable 'compile-command) + (concat cfengine-cf-promises + " -f " + (when buffer-file-name + (shell-quote-argument buffer-file-name))))) + + ;; For emacs < 25.1 where `eldoc-documentation-function' defaults to + ;; nil. + (or eldoc-documentation-function + (setq-local eldoc-documentation-function #'ignore)) + (add-function :before-until (local 'eldoc-documentation-function) + #'cfengine3-documentation-function) + + (add-hook 'completion-at-point-functions + #'cfengine3-completion-function nil t) ;; 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)) + (setq-local beginning-of-defun-function #'cfengine3-beginning-of-defun) + (setq-local end-of-defun-function #'cfengine3-end-of-defun) + + (setq-local imenu-create-index-function #'cfengine3-create-imenu-index) + (setq-local add-log-current-defun-function #'cfengine3-current-defun)) ;;;###autoload (define-derived-mode cfengine2-mode prog-mode "CFE2" @@ -475,7 +1420,6 @@ to the action header." ;; Shell commands can be quoted by single, double or back quotes. ;; It's debatable whether we should define string syntax, but it ;; should avoid potential confusion in some cases. - (modify-syntax-entry ?\' "\"" cfengine2-mode-syntax-table) (modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table) (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line) @@ -495,17 +1439,20 @@ to the action header." ;;;###autoload (defun cfengine-auto-mode () - "Choose between `cfengine2-mode' and `cfengine3-mode' depending -on the buffer contents" - (let ((v3 nil)) - (save-restriction - (goto-char (point-min)) - (while (not (or (eobp) v3)) - (setq v3 (looking-at (concat cfengine3-defuns-regex "\\>"))) - (forward-line))) - (if v3 (cfengine3-mode) (cfengine2-mode)))) - -(defalias 'cfengine-mode 'cfengine-auto-mode) + "Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents." + (interactive) + (if (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (forward-comment (point-max)) + (or (eobp) + (re-search-forward + (concat "^\\s-*" cfengine3-defuns-regex "\\_>") nil t)))) + (cfengine3-mode) + (cfengine2-mode))) + +(defalias 'cfengine-mode 'cfengine3-mode) (provide 'cfengine3) (provide 'cfengine)