lisp/progmodes/cfengine.el

   1 ;;; cfengine.el --- mode for editing Cfengine files
   2
   3 ;; Copyright (C) 2001-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Dave Love <fx@gnu.org>
   6 ;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
   7 ;; Keywords: languages
   8 ;; Version: 1.3
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Provides support for editing GNU Cfengine files, including
  28 ;; font-locking, Imenu and indentation, but with no special keybindings.
  29
  30 ;; The CFEngine 3.x support doesn't have Imenu support but patches are
  31 ;; welcome.
  32
  33 ;; By default, CFEngine 3.x syntax is used.
  34
  35 ;; You can set it up so either `cfengine2-mode' (2.x and earlier) or
  36 ;; `cfengine3-mode' (3.x) will be picked, depending on the buffer
  37 ;; contents:
  38
  39 ;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-auto-mode))
  40
  41 ;; OR you can choose to always use a specific version, if you prefer
  42 ;; it:
  43
  44 ;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine3-mode))
  45 ;; (add-to-list 'auto-mode-alist '("^cf\\." . cfengine2-mode))
  46 ;; (add-to-list 'auto-mode-alist '("^cfagent.conf\\'" . cfengine2-mode))
  47
  48 ;; It's *highly* recommended that you enable the eldoc minor mode:
  49
  50 ;; (add-hook 'cfengine3-mode-hook 'eldoc-mode)
  51
  52 ;; This is not the same as the mode written by Rolf Ebert
  53 ;; <ebert@waporo.muc.de>, distributed with cfengine-2.0.5.  It does
  54 ;; better fontification and indentation, inter alia.
  55
  56 ;;; Code:
  57
  58 (autoload 'json-read "json")
  59 (autoload 'regexp-opt "regexp-opt")
  60
  61 (defgroup cfengine ()
  62   "Editing CFEngine files."
  63   :group 'languages)
  64
  65 (defcustom cfengine-indent 2
  66   "Size of a CFEngine indentation step in columns."
  67   :group 'cfengine
  68   :type 'integer)
  69
  70 (defcustom cfengine-cf-promises
  71   (or (executable-find "cf-promises")
  72       (executable-find "/var/cfengine/bin/cf-promises")
  73       (executable-find "/usr/bin/cf-promises")
  74       (executable-find "/usr/sbin/cf-promises")
  75       (executable-find "/usr/local/bin/cf-promises")
  76       (executable-find "/usr/local/sbin/cf-promises")
  77       (executable-find "~/bin/cf-promises")
  78       (executable-find "~/sbin/cf-promises"))
  79   "The location of the cf-promises executable.
  80 Used for syntax discovery and checking.  Set to nil to disable
  81 the `compile-command' override.  In that case, the ElDoc support
  82 will use a fallback syntax definition."
  83   :version "24.4"
  84   :group 'cfengine
  85   :type '(choice file (const nil)))
  86
  87 (defcustom cfengine-parameters-indent '(promise pname 0)
  88   "Indentation of CFEngine3 promise parameters (hanging indent).
  89
  90 For example, say you have this code:
  91
  92 bundle x y
  93 {
  94   section:
  95     class::
  96       promise ...
  97       promiseparameter => ...
  98 }
  99
 100 You can choose to indent promiseparameter from the beginning of
 101 the line (absolutely) or from the word \"promise\" (relatively).
 102
 103 You can also choose to indent the start of the word
 104 \"promiseparameter\" or the arrow that follows it.
 105
 106 Finally, you can choose the amount of the indent.
 107
 108 The default is to anchor at promise, indent parameter name, and offset 0:
 109
 110 bundle agent rcfiles
 111 {
 112   files:
 113     any::
 114       \"/tmp/netrc\"
 115       comment => \"my netrc\",
 116       perms => mog(\"600\", \"tzz\", \"tzz\");
 117 }
 118
 119 Here we anchor at beginning of line, indent arrow, and offset 10:
 120
 121 bundle agent rcfiles
 122 {
 123   files:
 124     any::
 125       \"/tmp/netrc\"
 126   comment => \"my netrc\",
 127     perms => mog(\"600\", \"tzz\", \"tzz\");
 128 }
 129
 130 Some, including cfengine_stdlib.cf, like to anchor at promise, indent
 131 arrow, and offset 16 or so:
 132
 133 bundle agent rcfiles
 134 {
 135   files:
 136     any::
 137       \"/tmp/netrc\"
 138               comment => \"my netrc\",
 139                 perms => mog(\"600\", \"tzz\", \"tzz\");
 140 }
 141 "
 142   :version "24.4"
 143   :group 'cfengine
 144   :type '(list
 145           (choice (const :tag "Anchor at beginning of promise" promise)
 146                   (const :tag "Anchor at beginning of line" bol))
 147           (choice (const :tag "Indent parameter name" pname)
 148                   (const :tag "Indent arrow" arrow))
 149           (integer :tag "Indentation amount from anchor")))
 150
 151 (defvar cfengine-mode-debug nil
 152   "Whether `cfengine-mode' should print debugging info.")
 153
 154 (defvar cfengine-mode-syntax-cache nil
 155   "Cache for `cfengine-mode' syntax trees obtained from 'cf-promises -s json'.")
 156
 157 (defconst cfengine3-fallback-syntax
 158   '((functions
 159      (userexists
 160       (category . "system") (variadic . :json-false)
 161       (parameters . [((range . ".*") (type . "string"))])
 162       (returnType . "context") (status . "normal"))
 163      (usemodule
 164       (category . "utils") (variadic . :json-false)
 165       (parameters . [((range . ".*") (type . "string"))
 166                      ((range . ".*") (type . "string"))])
 167       (returnType . "context") (status . "normal"))
 168      (unique
 169       (category . "data") (variadic . :json-false)
 170       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 171       (returnType . "slist") (status . "normal"))
 172      (translatepath
 173       (category . "files") (variadic . :json-false)
 174       (parameters . [((range . "\"?(/.*)") (type . "string"))])
 175       (returnType . "string") (status . "normal"))
 176      (sum
 177       (category . "data") (variadic . :json-false)
 178       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 179       (returnType . "real") (status . "normal"))
 180      (sublist
 181       (category . "data") (variadic . :json-false)
 182       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 183                      ((range . "head,tail") (type . "option"))
 184                      ((range . "0,99999999999") (type . "int"))])
 185       (returnType . "slist") (status . "normal"))
 186      (strftime
 187       (category . "data") (variadic . :json-false)
 188       (parameters . [((range . "gmtime,localtime") (type . "option"))
 189                      ((range . ".*") (type . "string"))
 190                      ((range . "0,99999999999") (type . "int"))])
 191       (returnType . "string") (status . "normal"))
 192      (strcmp
 193       (category . "data") (variadic . :json-false)
 194       (parameters . [((range . ".*") (type . "string"))
 195                      ((range . ".*") (type . "string"))])
 196       (returnType . "context") (status . "normal"))
 197      (splitstring
 198       (category . "data") (variadic . :json-false)
 199       (parameters . [((range . ".*") (type . "string"))
 200                      ((range . ".*") (type . "string"))
 201                      ((range . "0,99999999999") (type . "int"))])
 202       (returnType . "slist") (status . "normal"))
 203      (splayclass
 204       (category . "utils") (variadic . :json-false)
 205       (parameters . [((range . ".*") (type . "string"))
 206                      ((range . "daily,hourly") (type . "option"))])
 207       (returnType . "context") (status . "normal"))
 208      (sort
 209       (category . "data") (variadic . :json-false)
 210       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 211                      ((range . "lex") (type . "string"))])
 212       (returnType . "slist") (status . "normal"))
 213      (some
 214       (category . "data") (variadic . :json-false)
 215       (parameters . [((range . ".*") (type . "string"))
 216                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 217       (returnType . "context") (status . "normal"))
 218      (shuffle
 219       (category . "data") (variadic . :json-false)
 220       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 221                      ((range . ".*") (type . "string"))])
 222       (returnType . "slist") (status . "normal"))
 223      (selectservers
 224       (category . "communication") (variadic . :json-false)
 225       (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))
 226                      ((range . "0,99999999999") (type . "int"))
 227                      ((range . ".*") (type . "string"))
 228                      ((range . ".*") (type . "string"))
 229                      ((range . "0,99999999999") (type . "int"))
 230                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 231       (returnType . "int") (status . "normal"))
 232      (reverse
 233       (category . "data") (variadic . :json-false)
 234       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 235       (returnType . "slist") (status . "normal"))
 236      (rrange
 237       (category . "data") (variadic . :json-false)
 238       (parameters . [((range . "-9.99999E100,9.99999E100") (type . "real"))
 239                      ((range . "-9.99999E100,9.99999E100") (type . "real"))])
 240       (returnType . "rrange") (status . "normal"))
 241      (returnszero
 242       (category . "utils") (variadic . :json-false)
 243       (parameters . [((range . "\"?(/.*)") (type . "string"))
 244                      ((range . "useshell,noshell,powershell") (type . "option"))])
 245       (returnType . "context") (status . "normal"))
 246      (remoteclassesmatching
 247       (category . "communication") (variadic . :json-false)
 248       (parameters . [((range . ".*") (type . "string"))
 249                      ((range . ".*") (type . "string"))
 250                      ((range . "true,false,yes,no,on,off") (type . "option"))
 251                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 252       (returnType . "context") (status . "normal"))
 253      (remotescalar
 254       (category . "communication") (variadic . :json-false)
 255       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 256                      ((range . ".*") (type . "string"))
 257                      ((range . "true,false,yes,no,on,off") (type . "option"))])
 258       (returnType . "string") (status . "normal"))
 259      (regldap
 260       (category . "communication") (variadic . :json-false)
 261       (parameters . [((range . ".*") (type . "string"))
 262                      ((range . ".*") (type . "string"))
 263                      ((range . ".*") (type . "string"))
 264                      ((range . ".*") (type . "string"))
 265                      ((range . "subtree,onelevel,base") (type . "option"))
 266                      ((range . ".*") (type . "string"))
 267                      ((range . "none,ssl,sasl") (type . "option"))])
 268       (returnType . "context") (status . "normal"))
 269      (reglist
 270       (category . "data") (variadic . :json-false)
 271       (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))
 272                      ((range . ".*") (type . "string"))])
 273       (returnType . "context") (status . "normal"))
 274      (regline
 275       (category . "io") (variadic . :json-false)
 276       (parameters . [((range . ".*") (type . "string"))
 277                      ((range . ".*") (type . "string"))])
 278       (returnType . "context") (status . "normal"))
 279      (registryvalue
 280       (category . "system") (variadic . :json-false)
 281       (parameters . [((range . ".*") (type . "string"))
 282                      ((range . ".*") (type . "string"))])
 283       (returnType . "string") (status . "normal"))
 284      (regextract
 285       (category . "data") (variadic . :json-false)
 286       (parameters . [((range . ".*") (type . "string"))
 287                      ((range . ".*") (type . "string"))
 288                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 289       (returnType . "context") (status . "normal"))
 290      (regcmp
 291       (category . "data") (variadic . :json-false)
 292       (parameters . [((range . ".*") (type . "string"))
 293                      ((range . ".*") (type . "string"))])
 294       (returnType . "context") (status . "normal"))
 295      (regarray
 296       (category . "data") (variadic . :json-false)
 297       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 298                      ((range . ".*") (type . "string"))])
 299       (returnType . "context") (status . "normal"))
 300      (readtcp
 301       (category . "communication") (variadic . :json-false)
 302       (parameters . [((range . ".*") (type . "string"))
 303                      ((range . "0,99999999999") (type . "int"))
 304                      ((range . ".*") (type . "string"))
 305                      ((range . "0,99999999999") (type . "int"))])
 306       (returnType . "string") (status . "normal"))
 307      (readstringlist
 308       (category . "io") (variadic . :json-false)
 309       (parameters . [((range . "\"?(/.*)") (type . "string"))
 310                      ((range . ".*") (type . "string"))
 311                      ((range . ".*") (type . "string"))
 312                      ((range . "0,99999999999") (type . "int"))
 313                      ((range . "0,99999999999") (type . "int"))])
 314       (returnType . "slist") (status . "normal"))
 315      (readstringarrayidx
 316       (category . "io") (variadic . :json-false)
 317       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 318                      ((range . "\"?(/.*)") (type . "string"))
 319                      ((range . ".*") (type . "string"))
 320                      ((range . ".*") (type . "string"))
 321                      ((range . "0,99999999999") (type . "int"))
 322                      ((range . "0,99999999999") (type . "int"))])
 323       (returnType . "int") (status . "normal"))
 324      (readstringarray
 325       (category . "io") (variadic . :json-false)
 326       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 327                      ((range . "\"?(/.*)") (type . "string"))
 328                      ((range . ".*") (type . "string"))
 329                      ((range . ".*") (type . "string"))
 330                      ((range . "0,99999999999") (type . "int"))
 331                      ((range . "0,99999999999") (type . "int"))])
 332       (returnType . "int") (status . "normal"))
 333      (readreallist
 334       (category . "io") (variadic . :json-false)
 335       (parameters . [((range . "\"?(/.*)") (type . "string"))
 336                      ((range . ".*") (type . "string"))
 337                      ((range . ".*") (type . "string"))
 338                      ((range . "0,99999999999") (type . "int"))
 339                      ((range . "0,99999999999") (type . "int"))])
 340       (returnType . "rlist") (status . "normal"))
 341      (readrealarray
 342       (category . "io") (variadic . :json-false)
 343       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 344                      ((range . "\"?(/.*)") (type . "string"))
 345                      ((range . ".*") (type . "string"))
 346                      ((range . ".*") (type . "string"))
 347                      ((range . "0,99999999999") (type . "int"))
 348                      ((range . "0,99999999999") (type . "int"))])
 349       (returnType . "int") (status . "normal"))
 350      (readintlist
 351       (category . "io") (variadic . :json-false)
 352       (parameters . [((range . "\"?(/.*)") (type . "string"))
 353                      ((range . ".*") (type . "string"))
 354                      ((range . ".*") (type . "string"))
 355                      ((range . "0,99999999999") (type . "int"))
 356                      ((range . "0,99999999999") (type . "int"))])
 357       (returnType . "ilist") (status . "normal"))
 358      (readintarray
 359       (category . "io") (variadic . :json-false)
 360       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 361                      ((range . "\"?(/.*)") (type . "string"))
 362                      ((range . ".*") (type . "string"))
 363                      ((range . ".*") (type . "string"))
 364                      ((range . "0,99999999999") (type . "int"))
 365                      ((range . "0,99999999999") (type . "int"))])
 366       (returnType . "int") (status . "normal"))
 367      (readfile
 368       (category . "io") (variadic . :json-false)
 369       (parameters . [((range . "\"?(/.*)") (type . "string"))
 370                      ((range . "0,99999999999") (type . "int"))])
 371       (returnType . "string") (status . "normal"))
 372      (randomint
 373       (category . "data") (variadic . :json-false)
 374       (parameters . [((range . "-99999999999,9999999999") (type . "int"))
 375                      ((range . "-99999999999,9999999999") (type . "int"))])
 376       (returnType . "int") (status . "normal"))
 377      (product
 378       (category . "data") (variadic . :json-false)
 379       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 380       (returnType . "real") (status . "normal"))
 381      (peerleaders
 382       (category . "communication") (variadic . :json-false)
 383       (parameters . [((range . "\"?(/.*)") (type . "string"))
 384                      ((range . ".*") (type . "string"))
 385                      ((range . "0,99999999999") (type . "int"))])
 386       (returnType . "slist") (status . "normal"))
 387      (peerleader
 388       (category . "communication") (variadic . :json-false)
 389       (parameters . [((range . "\"?(/.*)") (type . "string"))
 390                      ((range . ".*") (type . "string"))
 391                      ((range . "0,99999999999") (type . "int"))])
 392       (returnType . "string") (status . "normal"))
 393      (peers
 394       (category . "communication") (variadic . :json-false)
 395       (parameters . [((range . "\"?(/.*)") (type . "string"))
 396                      ((range . ".*") (type . "string"))
 397                      ((range . "0,99999999999") (type . "int"))])
 398       (returnType . "slist") (status . "normal"))
 399      (parsestringarrayidx
 400       (category . "io") (variadic . :json-false)
 401       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 402                      ((range . "\"?(/.*)") (type . "string"))
 403                      ((range . ".*") (type . "string"))
 404                      ((range . ".*") (type . "string"))
 405                      ((range . "0,99999999999") (type . "int"))
 406                      ((range . "0,99999999999") (type . "int"))])
 407       (returnType . "int") (status . "normal"))
 408      (parsestringarray
 409       (category . "io") (variadic . :json-false)
 410       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 411                      ((range . "\"?(/.*)") (type . "string"))
 412                      ((range . ".*") (type . "string"))
 413                      ((range . ".*") (type . "string"))
 414                      ((range . "0,99999999999") (type . "int"))
 415                      ((range . "0,99999999999") (type . "int"))])
 416       (returnType . "int") (status . "normal"))
 417      (parserealarray
 418       (category . "io") (variadic . :json-false)
 419       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 420                      ((range . "\"?(/.*)") (type . "string"))
 421                      ((range . ".*") (type . "string"))
 422                      ((range . ".*") (type . "string"))
 423                      ((range . "0,99999999999") (type . "int"))
 424                      ((range . "0,99999999999") (type . "int"))])
 425       (returnType . "int") (status . "normal"))
 426      (parseintarray
 427       (category . "io") (variadic . :json-false)
 428       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 429                      ((range . "\"?(/.*)") (type . "string"))
 430                      ((range . ".*") (type . "string"))
 431                      ((range . ".*") (type . "string"))
 432                      ((range . "0,99999999999") (type . "int"))
 433                      ((range . "0,99999999999") (type . "int"))])
 434       (returnType . "int") (status . "normal"))
 435      (or
 436       (category . "data") (variadic . t)
 437       (parameters . [])
 438       (returnType . "string") (status . "normal"))
 439      (on
 440       (category . "data") (variadic . :json-false)
 441       (parameters . [((range . "1970,3000") (type . "int"))
 442                      ((range . "1,12") (type . "int"))
 443                      ((range . "1,31") (type . "int"))
 444                      ((range . "0,23") (type . "int"))
 445                      ((range . "0,59") (type . "int"))
 446                      ((range . "0,59") (type . "int"))])
 447       (returnType . "int") (status . "normal"))
 448      (nth
 449       (category . "data") (variadic . :json-false)
 450       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 451                      ((range . "0,99999999999") (type . "int"))])
 452       (returnType . "string") (status . "normal"))
 453      (now
 454       (category . "system") (variadic . :json-false)
 455       (parameters . [])
 456       (returnType . "int") (status . "normal"))
 457      (not
 458       (category . "data") (variadic . :json-false)
 459       (parameters . [((range . ".*") (type . "string"))])
 460       (returnType . "string") (status . "normal"))
 461      (none
 462       (category . "data") (variadic . :json-false)
 463       (parameters . [((range . ".*") (type . "string"))
 464                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 465       (returnType . "context") (status . "normal"))
 466      (maplist
 467       (category . "data") (variadic . :json-false)
 468       (parameters . [((range . ".*") (type . "string"))
 469                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 470       (returnType . "slist") (status . "normal"))
 471      (maparray
 472       (category . "data") (variadic . :json-false)
 473       (parameters . [((range . ".*") (type . "string"))
 474                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 475       (returnType . "slist") (status . "normal"))
 476      (lsdir
 477       (category . "files") (variadic . :json-false)
 478       (parameters . [((range . ".+") (type . "string"))
 479                      ((range . ".*") (type . "string"))
 480                      ((range . "true,false,yes,no,on,off") (type . "option"))])
 481       (returnType . "slist") (status . "normal"))
 482      (length
 483       (category . "data") (variadic . :json-false)
 484       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 485       (returnType . "int") (status . "normal"))
 486      (ldapvalue
 487       (category . "communication") (variadic . :json-false)
 488       (parameters . [((range . ".*") (type . "string"))
 489                      ((range . ".*") (type . "string"))
 490                      ((range . ".*") (type . "string"))
 491                      ((range . ".*") (type . "string"))
 492                      ((range . "subtree,onelevel,base") (type . "option"))
 493                      ((range . "none,ssl,sasl") (type . "option"))])
 494       (returnType . "string") (status . "normal"))
 495      (ldaplist
 496       (category . "communication") (variadic . :json-false)
 497       (parameters . [((range . ".*") (type . "string"))
 498                      ((range . ".*") (type . "string"))
 499                      ((range . ".*") (type . "string"))
 500                      ((range . ".*") (type . "string"))
 501                      ((range . "subtree,onelevel,base") (type . "option"))
 502                      ((range . "none,ssl,sasl") (type . "option"))])
 503       (returnType . "slist") (status . "normal"))
 504      (ldaparray
 505       (category . "communication") (variadic . :json-false)
 506       (parameters . [((range . ".*") (type . "string"))
 507                      ((range . ".*") (type . "string"))
 508                      ((range . ".*") (type . "string"))
 509                      ((range . ".*") (type . "string"))
 510                      ((range . "subtree,onelevel,base") (type . "option"))
 511                      ((range . "none,ssl,sasl") (type . "option"))])
 512       (returnType . "context") (status . "normal"))
 513      (laterthan
 514       (category . "files") (variadic . :json-false)
 515       (parameters . [((range . "0,1000") (type . "int"))
 516                      ((range . "0,1000") (type . "int"))
 517                      ((range . "0,1000") (type . "int"))
 518                      ((range . "0,1000") (type . "int"))
 519                      ((range . "0,1000") (type . "int"))
 520                      ((range . "0,40000") (type . "int"))])
 521       (returnType . "context") (status . "normal"))
 522      (lastnode
 523       (category . "data") (variadic . :json-false)
 524       (parameters . [((range . ".*") (type . "string"))
 525                      ((range . ".*") (type . "string"))])
 526       (returnType . "string") (status . "normal"))
 527      (join
 528       (category . "data") (variadic . :json-false)
 529       (parameters . [((range . ".*") (type . "string"))
 530                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 531       (returnType . "string") (status . "normal"))
 532      (isvariable
 533       (category . "utils") (variadic . :json-false)
 534       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 535       (returnType . "context") (status . "normal"))
 536      (isplain
 537       (category . "files") (variadic . :json-false)
 538       (parameters . [((range . "\"?(/.*)") (type . "string"))])
 539       (returnType . "context") (status . "normal"))
 540      (isnewerthan
 541       (category . "files") (variadic . :json-false)
 542       (parameters . [((range . "\"?(/.*)") (type . "string"))
 543                      ((range . "\"?(/.*)") (type . "string"))])
 544       (returnType . "context") (status . "normal"))
 545      (islink
 546       (category . "files") (variadic . :json-false)
 547       (parameters . [((range . "\"?(/.*)") (type . "string"))])
 548       (returnType . "context") (status . "normal"))
 549      (islessthan
 550       (category . "data") (variadic . :json-false)
 551       (parameters . [((range . ".*") (type . "string"))
 552                      ((range . ".*") (type . "string"))])
 553       (returnType . "context") (status . "normal"))
 554      (isgreaterthan
 555       (category . "data") (variadic . :json-false)
 556       (parameters . [((range . ".*") (type . "string"))
 557                      ((range . ".*") (type . "string"))])
 558       (returnType . "context") (status . "normal"))
 559      (isexecutable
 560       (category . "files") (variadic . :json-false)
 561       (parameters . [((range . "\"?(/.*)") (type . "string"))])
 562       (returnType . "context") (status . "normal"))
 563      (isdir
 564       (category . "files") (variadic . :json-false)
 565       (parameters . [((range . "\"?(/.*)") (type . "string"))])
 566       (returnType . "context") (status . "normal"))
 567      (irange
 568       (category . "data") (variadic . :json-false)
 569       (parameters . [((range . "-99999999999,9999999999") (type . "int"))
 570                      ((range . "-99999999999,9999999999") (type . "int"))])
 571       (returnType . "irange") (status . "normal"))
 572      (iprange
 573       (category . "communication") (variadic . :json-false)
 574       (parameters . [((range . ".*") (type . "string"))])
 575       (returnType . "context") (status . "normal"))
 576      (intersection
 577       (category . "data") (variadic . :json-false)
 578       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 579                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 580       (returnType . "slist") (status . "normal"))
 581      (ifelse
 582       (category . "data") (variadic . t)
 583       (parameters . [])
 584       (returnType . "string") (status . "normal"))
 585      (hubknowledge
 586       (category . "communication") (variadic . :json-false)
 587       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 588       (returnType . "string") (status . "normal"))
 589      (hostswithclass
 590       (category . "communication") (variadic . :json-false)
 591       (parameters . [((range . "[a-zA-Z0-9_]+") (type . "string"))
 592                      ((range . "name,address") (type . "option"))])
 593       (returnType . "slist") (status . "normal"))
 594      (hostsseen
 595       (category . "communication") (variadic . :json-false)
 596       (parameters . [((range . "0,99999999999") (type . "int"))
 597                      ((range . "lastseen,notseen") (type . "option"))
 598                      ((range . "name,address") (type . "option"))])
 599       (returnType . "slist") (status . "normal"))
 600      (hostrange
 601       (category . "communication") (variadic . :json-false)
 602       (parameters . [((range . ".*") (type . "string"))
 603                      ((range . ".*") (type . "string"))])
 604       (returnType . "context") (status . "normal"))
 605      (hostinnetgroup
 606       (category . "system") (variadic . :json-false)
 607       (parameters . [((range . ".*") (type . "string"))])
 608       (returnType . "context") (status . "normal"))
 609      (ip2host
 610       (category . "communication") (variadic . :json-false)
 611       (parameters . [((range . ".*") (type . "string"))])
 612       (returnType . "string") (status . "normal"))
 613      (host2ip
 614       (category . "communication") (variadic . :json-false)
 615       (parameters . [((range . ".*") (type . "string"))])
 616       (returnType . "string") (status . "normal"))
 617      (hashmatch
 618       (category . "data") (variadic . :json-false)
 619       (parameters . [((range . "\"?(/.*)") (type . "string"))
 620                      ((range . "md5,sha1,crypt,cf_sha224,cf_sha256,cf_sha384,cf_sha512") (type . "option"))
 621                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 622       (returnType . "context") (status . "normal"))
 623      (hash
 624       (category . "data") (variadic . :json-false)
 625       (parameters . [((range . ".*") (type . "string"))
 626                      ((range . "md5,sha1,sha256,sha512,sha384,crypt") (type . "option"))])
 627       (returnType . "string") (status . "normal"))
 628      (groupexists
 629       (category . "system") (variadic . :json-false)
 630       (parameters . [((range . ".*") (type . "string"))])
 631       (returnType . "context") (status . "normal"))
 632      (grep
 633       (category . "data") (variadic . :json-false)
 634       (parameters . [((range . ".*") (type . "string"))
 635                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 636       (returnType . "slist") (status . "normal"))
 637      (getvalues
 638       (category . "data") (variadic . :json-false)
 639       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 640       (returnType . "slist") (status . "normal"))
 641      (getusers
 642       (category . "system") (variadic . :json-false)
 643       (parameters . [((range . ".*") (type . "string"))
 644                      ((range . ".*") (type . "string"))])
 645       (returnType . "slist") (status . "normal"))
 646      (getuid
 647       (category . "system") (variadic . :json-false)
 648       (parameters . [((range . ".*") (type . "string"))])
 649       (returnType . "int") (status . "normal"))
 650      (getindices
 651       (category . "data") (variadic . :json-false)
 652       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 653       (returnType . "slist") (status . "normal"))
 654      (getgid
 655       (category . "data") (variadic . :json-false)
 656       (parameters . [((range . ".*") (type . "string"))])
 657       (returnType . "int") (status . "normal"))
 658      (getfields
 659       (category . "data") (variadic . :json-false)
 660       (parameters . [((range . ".*") (type . "string"))
 661                      ((range . "\"?(/.*)") (type . "string"))
 662                      ((range . ".*") (type . "string"))
 663                      ((range . ".*") (type . "string"))])
 664       (returnType . "int") (status . "normal"))
 665      (getenv
 666       (category . "system") (variadic . :json-false)
 667       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 668                      ((range . "0,99999999999") (type . "int"))])
 669       (returnType . "string") (status . "normal"))
 670      (format
 671       (category . "data") (variadic . t)
 672       (parameters . [((range . ".*") (type . "string"))])
 673       (returnType . "string") (status . "normal"))
 674      (filter
 675       (category . "data") (variadic . :json-false)
 676       (parameters . [((range . ".*") (type . "string"))
 677                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 678                      ((range . "true,false,yes,no,on,off") (type . "option"))
 679                      ((range . "true,false,yes,no,on,off") (type . "option"))
 680                      ((range . "0,99999999999") (type . "int"))])
 681       (returnType . "slist") (status . "normal"))
 682      (filestat
 683       (category . "files") (variadic . :json-false)
 684       (parameters . [((range . "\"?(/.*)") (type . "string"))
 685                      ((range . "size,gid,uid,ino,nlink,ctime,atime,mtime,mode,modeoct,permstr,permoct,type,devno,dev_minor,dev_major,basename,dirname") (type . "option"))])
 686       (returnType . "string") (status . "normal"))
 687      (filesize
 688       (category . "files") (variadic . :json-false)
 689       (parameters . [((range . "\"?(/.*)") (type . "string"))])
 690       (returnType . "int") (status . "normal"))
 691      (filesexist
 692       (category . "files") (variadic . :json-false)
 693       (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))])
 694       (returnType . "context") (status . "normal"))
 695      (fileexists
 696       (category . "files") (variadic . :json-false)
 697       (parameters . [((range . "\"?(/.*)") (type . "string"))])
 698       (returnType . "context") (status . "normal"))
 699      (execresult
 700       (category . "utils") (variadic . :json-false)
 701       (parameters . [((range . ".+") (type . "string"))
 702                      ((range . "useshell,noshell,powershell") (type . "option"))])
 703       (returnType . "string") (status . "normal"))
 704      (every
 705       (category . "data") (variadic . :json-false)
 706       (parameters . [((range . ".*") (type . "string"))
 707                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 708       (returnType . "context") (status . "normal"))
 709      (escape
 710       (category . "data") (variadic . :json-false)
 711       (parameters . [((range . ".*") (type . "string"))])
 712       (returnType . "string") (status . "normal"))
 713      (diskfree
 714       (category . "files") (variadic . :json-false)
 715       (parameters . [((range . "\"?(/.*)") (type . "string"))])
 716       (returnType . "int") (status . "normal"))
 717      (dirname
 718       (category . "files") (variadic . :json-false)
 719       (parameters . [((range . ".*") (type . "string"))])
 720       (returnType . "string") (status . "normal"))
 721      (difference
 722       (category . "data") (variadic . :json-false)
 723       (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
 724                      ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
 725       (returnType . "slist") (status . "normal"))
 726      (countlinesmatching
 727       (category . "io") (variadic . :json-false)
 728       (parameters . [((range . ".*") (type . "string"))
 729                      ((range . "\"?(/.*)") (type . "string"))])
 730       (returnType . "int") (status . "normal"))
 731      (countclassesmatching
 732       (category . "utils") (variadic . :json-false)
 733       (parameters . [((range . ".*") (type . "string"))])
 734       (returnType . "int") (status . "normal"))
 735      (classesmatching
 736       (category . "utils") (variadic . :json-false)
 737       (parameters . [((range . ".*") (type . "string"))])
 738       (returnType . "slist") (status . "normal"))
 739      (classmatch
 740       (category . "utils") (variadic . :json-false)
 741       (parameters . [((range . ".*") (type . "string"))])
 742       (returnType . "context") (status . "normal"))
 743      (classify
 744       (category . "data") (variadic . :json-false)
 745       (parameters . [((range . ".*") (type . "string"))])
 746       (returnType . "context") (status . "normal"))
 747      (changedbefore
 748       (category . "files") (variadic . :json-false)
 749       (parameters . [((range . "\"?(/.*)") (type . "string"))
 750                      ((range . "\"?(/.*)") (type . "string"))])
 751       (returnType . "context") (status . "normal"))
 752      (concat
 753       (category . "data") (variadic . t)
 754       (parameters . [])
 755       (returnType . "string") (status . "normal"))
 756      (canonify
 757       (category . "data") (variadic . :json-false)
 758       (parameters . [((range . ".*") (type . "string"))])
 759       (returnType . "string") (status . "normal"))
 760      (and
 761       (category . "data") (variadic . t)
 762       (parameters . [])
 763       (returnType . "string") (status . "normal"))
 764      (ago
 765       (category . "data") (variadic . :json-false)
 766       (parameters . [((range . "0,1000") (type . "int"))
 767                      ((range . "0,1000") (type . "int"))
 768                      ((range . "0,1000") (type . "int"))
 769                      ((range . "0,1000") (type . "int"))
 770                      ((range . "0,1000") (type . "int"))
 771                      ((range . "0,40000") (type . "int"))])
 772       (returnType . "int") (status . "normal"))
 773      (accumulated
 774       (category . "data") (variadic . :json-false)
 775       (parameters . [((range . "0,1000") (type . "int"))
 776                      ((range . "0,1000") (type . "int"))
 777                      ((range . "0,1000") (type . "int"))
 778                      ((range . "0,1000") (type . "int"))
 779                      ((range . "0,1000") (type . "int"))
 780                      ((range . "0,40000") (type . "int"))])
 781       (returnType . "int") (status . "normal"))
 782      (accessedbefore
 783       (category . "files") (variadic . :json-false)
 784       (parameters . [((range . "\"?(/.*)") (type . "string"))
 785                      ((range . "\"?(/.*)") (type . "string"))])
 786       (returnType . "context") (status . "normal"))))
 787   "Fallback CFEngine syntax, containing just function definitions.")
 788
 789 (defvar cfengine-mode-syntax-functions-regex
 790   (regexp-opt (mapcar (lambda (def)
 791                         (format "%s" (car def)))
 792                       (cdr (assq 'functions cfengine3-fallback-syntax)))
 793               'symbols))
 794
 795 (defcustom cfengine-mode-abbrevs nil
 796   "Abbrevs for CFEngine2 mode."
 797   :group 'cfengine
 798   :type '(repeat (list (string :tag "Name")
 799                        (string :tag "Expansion")
 800                        (choice  :tag "Hook" (const nil) function))))
 801
 802 (make-obsolete-variable 'cfengine-mode-abbrevs 'edit-abbrevs "24.1")
 803
 804 ;; Taken from the doc for pre-release 2.1.
 805 (eval-and-compile
 806   (defconst cfengine2-actions
 807     '("acl" "alerts" "binservers" "broadcast" "control" "classes" "copy"
 808       "defaultroute" "disks" "directories" "disable" "editfiles" "files"
 809       "filters" "groups" "homeservers" "ignore" "import" "interfaces"
 810       "links" "mailserver" "methods" "miscmounts" "mountables"
 811       "processes" "packages" "rename" "required" "resolve"
 812       "shellcommands" "tidy" "unmount"
 813       ;; Keywords for cfservd.
 814       "admit" "grant" "deny")
 815     "List of the action keywords supported by Cfengine.
 816 This includes those for cfservd as well as cfagent.")
 817
 818   (defconst cfengine3-defuns
 819     (mapcar
 820      'symbol-name
 821      '(bundle body))
 822     "List of the CFEngine 3.x defun headings.")
 823
 824   (defconst cfengine3-defuns-regex
 825     (regexp-opt cfengine3-defuns t)
 826     "Regex to match the CFEngine 3.x defuns.")
 827
 828   (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!:]+\\)::")
 829
 830   (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
 831
 832   (defconst cfengine3-vartypes
 833     (mapcar
 834      'symbol-name
 835      '(string int real slist ilist rlist irange rrange counter data))
 836     "List of the CFEngine 3.x variable types."))
 837
 838 (defvar cfengine2-font-lock-keywords
 839   `(;; Actions.
 840     ;; List the allowed actions explicitly, so that errors are more obvious.
 841     (,(concat "^[ \t]*" (eval-when-compile
 842                           (regexp-opt cfengine2-actions t))
 843               ":")
 844      1 font-lock-keyword-face)
 845     ;; Classes.
 846     ("^[ \t]*\\([[:alnum:]_().|!]+\\)::" 1 font-lock-function-name-face)
 847     ;; Variables.
 848     ("$(\\([[:alnum:]_]+\\))" 1 font-lock-variable-name-face)
 849     ("${\\([[:alnum:]_]+\\)}" 1 font-lock-variable-name-face)
 850     ;; Variable definitions.
 851     ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
 852     ;; File, acl &c in group:   { token ... }
 853     ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face)))
 854
 855 (defvar cfengine3-font-lock-keywords
 856   `(
 857     ;; Defuns.  This happens early so they don't get caught by looser
 858     ;; patterns.
 859     (,(concat "\\_<" cfengine3-defuns-regex "\\_>"
 860               "[ \t]+\\_<\\([[:alnum:]_.:]+\\)\\_>"
 861               "[ \t]+\\_<\\([[:alnum:]_.:]+\\)"
 862               ;; Optional parentheses with variable names inside.
 863               "\\(?:(\\([^)]*\\))\\)?")
 864      (1 font-lock-builtin-face)
 865      (2 font-lock-constant-face)
 866      (3 font-lock-function-name-face)
 867      (4 font-lock-variable-name-face nil t))
 868
 869     ;; Class selectors.
 870     (,(concat "^[ \t]*" cfengine3-class-selector-regex)
 871      1 font-lock-keyword-face)
 872
 873     ;; Categories.
 874     (,(concat "^[ \t]*" cfengine3-category-regex)
 875      1 font-lock-builtin-face)
 876
 877     ;; Variables, including scope, e.g. module.var
 878     ("[@$](\\([[:alnum:]_.:]+\\))" 1 font-lock-variable-name-face)
 879     ("[@$]{\\([[:alnum:]_.:]+\\)}" 1 font-lock-variable-name-face)
 880
 881     ;; Variable definitions.
 882     ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
 883
 884     ;; Variable types.
 885     (,(concat "\\_<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\_>")
 886      1 font-lock-type-face)))
 887
 888 (defvar cfengine2-imenu-expression
 889   `((nil ,(concat "^[ \t]*" (eval-when-compile
 890                               (regexp-opt cfengine2-actions t))
 891                   ":[^:]")
 892          1)
 893     ("Variables/classes" "\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1)
 894     ("Variables/classes" "\\_<define=\\([[:alnum:]_]+\\)" 1)
 895     ("Variables/classes" "\\_<DefineClass\\>[ \t]+\\([[:alnum:]_]+\\)" 1))
 896   "`imenu-generic-expression' for CFEngine mode.")
 897
 898 (defun cfengine2-outline-level ()
 899   "`outline-level' function for CFEngine mode."
 900   (if (looking-at "[^:]+\\(?:[:]+\\)$")
 901       (length (match-string 1))))
 902
 903 (defun cfengine2-beginning-of-defun ()
 904   "`beginning-of-defun' function for CFEngine mode.
 905 Treats actions as defuns."
 906   (unless (<= (current-column) (current-indentation))
 907     (end-of-line))
 908   (if (re-search-backward "^[[:alpha:]]+: *$" nil t)
 909       (beginning-of-line)
 910     (goto-char (point-min)))
 911   t)
 912
 913 (defun cfengine2-end-of-defun ()
 914   "`end-of-defun' function for CFEngine mode.
 915 Treats actions as defuns."
 916   (end-of-line)
 917   (if (re-search-forward "^[[:alpha:]]+: *$" nil t)
 918       (beginning-of-line)
 919     (goto-char (point-max)))
 920   t)
 921
 922 ;; Fixme: Should get an extra indent step in editfiles BeginGroup...s.
 923
 924 (defun cfengine2-indent-line ()
 925   "Indent a line in Cfengine mode.
 926 Intended as the value of `indent-line-function'."
 927   (let ((pos (- (point-max) (point))))
 928     (save-restriction
 929       (narrow-to-defun)
 930       (back-to-indentation)
 931       (cond
 932        ;; Action selectors aren't indented; class selectors are
 933        ;; indented one step.
 934        ((looking-at "[[:alnum:]_().|!]+:\\(:\\)?")
 935         (if (match-string 1)
 936             (indent-line-to cfengine-indent)
 937           (indent-line-to 0)))
 938        ;; Outdent leading close brackets one step.
 939        ((or (eq ?\} (char-after))
 940             (eq ?\) (char-after)))
 941         (condition-case ()
 942             (indent-line-to (save-excursion
 943                               (forward-char)
 944                               (backward-sexp)
 945                               (current-column)))
 946           (error nil)))
 947        ;; Inside brackets/parens: indent to start column of non-comment
 948        ;; token on line following open bracket or by one step from open
 949        ;; bracket's column.
 950        ((condition-case ()
 951             (progn (indent-line-to (save-excursion
 952                                      (backward-up-list)
 953                                      (forward-char)
 954                                      (skip-chars-forward " \t")
 955                                      (if (looking-at "[^\n#]")
 956                                          (current-column)
 957                                        (skip-chars-backward " \t")
 958                                        (+ (current-column) -1
 959                                           cfengine-indent))))
 960                    t)
 961           (error nil)))
 962        ;; Indent by  two steps after a class selector.
 963        ((save-excursion
 964           (re-search-backward "^[ \t]*[[:alnum:]_().|!]+::" nil t))
 965         (indent-line-to (* 2 cfengine-indent)))
 966        ;; Indent by one step if we're after an action header.
 967        ((save-excursion
 968           (goto-char (point-min))
 969           (looking-at "[[:alpha:]]+:[ \t]*$"))
 970         (indent-line-to cfengine-indent))
 971        ;; Else don't indent.
 972        (t
 973         (indent-line-to 0))))
 974     ;; If initial point was within line's indentation,
 975     ;; position after the indentation.  Else stay at same point in text.
 976     (if (> (- (point-max) pos) (point))
 977         (goto-char (- (point-max) pos)))))
 978
 979 ;; This doesn't work too well in Emacs 21.2.  See 22.1 development
 980 ;; code.
 981 (defun cfengine-fill-paragraph (&optional justify)
 982   "Fill `paragraphs' in Cfengine code."
 983   (interactive "P")
 984   (or (if (fboundp 'fill-comment-paragraph)
 985           (fill-comment-paragraph justify) ; post Emacs 21.3
 986         ;; else do nothing in a comment
 987         (nth 4 (parse-partial-sexp (save-excursion
 988                                      (beginning-of-defun)
 989                                      (point))
 990                                    (point))))
 991       (let ((paragraph-start
 992              ;; Include start of parenthesized block.
 993              "\f\\|[ \t]*$\\|.*\(")
 994             (paragraph-separate
 995              ;; Include action and class lines, start and end of
 996              ;; bracketed blocks and end of parenthesized blocks to
 997              ;; avoid including these in fill.  This isn't ideal.
 998              "[ \t\f]*$\\|.*#\\|.*[\){}]\\|\\s-*[[:alpha:]_().|!]+:")
 999             fill-paragraph-function)
1000         (fill-paragraph justify))
1001       t))
1002
1003 (defun cfengine3-beginning-of-defun ()
1004   "`beginning-of-defun' function for Cfengine 3 mode.
1005 Treats body/bundle blocks as defuns."
1006   (unless (<= (current-column) (current-indentation))
1007     (end-of-line))
1008   (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t)
1009       (beginning-of-line)
1010     (goto-char (point-min)))
1011   t)
1012
1013 (defun cfengine3-end-of-defun ()
1014   "`end-of-defun' function for Cfengine 3 mode.
1015 Treats body/bundle blocks as defuns."
1016   (end-of-line)
1017   (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t)
1018       (beginning-of-line)
1019     (goto-char (point-max)))
1020   t)
1021
1022 (defun cfengine3-indent-line ()
1023   "Indent a line in Cfengine 3 mode.
1024 Intended as the value of `indent-line-function'."
1025   (let ((pos (- (point-max) (point)))
1026         parse)
1027     (save-restriction
1028       (narrow-to-defun)
1029       (back-to-indentation)
1030       (setq parse (parse-partial-sexp (point-min) (point)))
1031       (when cfengine-mode-debug
1032         (message "%S" parse))
1033
1034       (cond
1035        ;; Body/bundle blocks start at 0.
1036        ((looking-at (concat cfengine3-defuns-regex "\\_>"))
1037         (indent-line-to 0))
1038        ;; Categories are indented one step.
1039        ((looking-at (concat cfengine3-category-regex "[ \t]*\\(#.*\\)*$"))
1040         (indent-line-to cfengine-indent))
1041        ;; Class selectors are indented two steps.
1042        ((looking-at (concat cfengine3-class-selector-regex "[ \t]*\\(#.*\\)*$"))
1043         (indent-line-to (* 2 cfengine-indent)))
1044        ;; Outdent leading close brackets one step.
1045        ((or (eq ?\} (char-after))
1046             (eq ?\) (char-after)))
1047         (condition-case ()
1048             (indent-line-to (save-excursion
1049                               (forward-char)
1050                               (backward-sexp)
1051                               (move-beginning-of-line nil)
1052                               (skip-chars-forward " \t")
1053                               (current-column)))
1054           (error nil)))
1055        ;; Inside a string and it starts before this line: do nothing.
1056        ((and (nth 3 parse)
1057              (< (nth 8 parse) (save-excursion (beginning-of-line) (point))))
1058         )
1059
1060        ;; Inside a defun, but not a nested list (depth is 1).  This is
1061        ;; a promise, usually.
1062
1063        ;; Indent to cfengine-indent times the nested depth
1064        ;; plus 2.  That way, promises indent deeper than class
1065        ;; selectors, which in turn are one deeper than categories.
1066        ((= 1 (nth 0 parse))
1067         (let ((p-anchor (nth 0 cfengine-parameters-indent))
1068               (p-what (nth 1 cfengine-parameters-indent))
1069               (p-indent (nth 2 cfengine-parameters-indent)))
1070           ;; Do we have the parameter anchor and location and indent
1071           ;; defined, and are we looking at a promise parameter?
1072           (if (and p-anchor p-what p-indent
1073                    (looking-at  "\\([[:alnum:]_]+[ \t]*\\)=>"))
1074               (let* ((arrow-offset (* -1 (length (match-string 1))))
1075                      (extra-offset (if (eq p-what 'arrow) arrow-offset 0))
1076                      (base-offset (if (eq p-anchor 'promise)
1077                                       (* (+ 2 (nth 0 parse)) cfengine-indent)
1078                                     0)))
1079                 (indent-line-to (max 0 (+ p-indent base-offset extra-offset))))
1080             ;; Else, indent to cfengine-indent times the nested depth
1081             ;; plus 2.  That way, promises indent deeper than class
1082             ;; selectors, which in turn are one deeper than categories.
1083           (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent)))))
1084        ;; Inside brackets/parens: indent to start column of non-comment
1085        ;; token on line following open bracket or by one step from open
1086        ;; bracket's column.
1087        ((condition-case ()
1088             (progn (indent-line-to (save-excursion
1089                                      (backward-up-list)
1090                                      (forward-char)
1091                                      (skip-chars-forward " \t")
1092                                      (cond
1093                                       ((looking-at "[^\n#]")
1094                                        (current-column))
1095                                       ((looking-at "[^\n#]")
1096                                        (current-column))
1097                                       (t
1098                                        (skip-chars-backward " \t")
1099                                        (+ (current-column) -1
1100                                           cfengine-indent)))))
1101                    t)
1102           (error nil)))
1103        ;; Else don't indent.
1104        (t (indent-line-to 0))))
1105     ;; If initial point was within line's indentation,
1106     ;; position after the indentation.  Else stay at same point in text.
1107     (if (> (- (point-max) pos) (point))
1108         (goto-char (- (point-max) pos)))))
1109
1110 ;; CFEngine 3.x grammar
1111
1112 ;; specification: blocks
1113 ;; blocks: block | blocks block;
1114 ;; block:                 bundle typeid blockid bundlebody
1115 ;;                      | bundle typeid blockid usearglist bundlebody
1116 ;;                      | body typeid blockid bodybody
1117 ;;                      | body typeid blockid usearglist bodybody;
1118
1119 ;; typeid: id
1120 ;; blockid: id
1121 ;; usearglist: '(' aitems ')';
1122 ;; aitems: aitem | aitem ',' aitems |;
1123 ;; aitem: id
1124
1125 ;; bundlebody: '{' statements '}'
1126 ;; statements: statement | statements statement;
1127 ;; statement: category | classpromises;
1128
1129 ;; bodybody: '{' bodyattribs '}'
1130 ;; bodyattribs: bodyattrib | bodyattribs bodyattrib;
1131 ;; bodyattrib: class | selections;
1132 ;; selections: selection | selections selection;
1133 ;; selection: id ASSIGN rval ';' ;
1134
1135 ;; classpromises: classpromise | classpromises classpromise;
1136 ;; classpromise: class | promises;
1137 ;; promises: promise | promises promise;
1138 ;; category: CATEGORY
1139 ;; promise: promiser ARROW rval constraints ';' | promiser constraints ';';
1140 ;; constraints: constraint | constraints ',' constraint |;
1141 ;; constraint: id ASSIGN rval;
1142 ;; class: CLASS
1143 ;; id: ID
1144 ;; rval: ID | QSTRING | NAKEDVAR | list | usefunction
1145 ;; list: '{' litems '}' ;
1146 ;; litems: litem | litem ',' litems |;
1147 ;; litem: ID | QSTRING | NAKEDVAR | list | usefunction
1148
1149 ;; functionid: ID | NAKEDVAR
1150 ;; promiser: QSTRING
1151 ;; usefunction: functionid givearglist
1152 ;; givearglist: '(' gaitems ')'
1153 ;; gaitems: gaitem | gaitems ',' gaitem |;
1154 ;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction
1155
1156 ;; # from lexer:
1157
1158 ;; bundle: "bundle"
1159 ;; body: "body"
1160 ;; COMMENT    #[^\n]*
1161 ;; NAKEDVAR   [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}]
1162 ;; ID: [a-zA-Z0-9_\200-\377]+
1163 ;; ASSIGN: "=>"
1164 ;; ARROW: "->"
1165 ;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*`
1166 ;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+::
1167 ;; CATEGORY: [a-zA-Z_]+:
1168
1169 (defun cfengine3--current-function ()
1170   "Look up current CFEngine 3 function"
1171   (let* ((syntax (cfengine3-make-syntax-cache))
1172          (flist (assq 'functions syntax)))
1173     (when flist
1174       (let ((w (save-excursion
1175                  (skip-syntax-forward "w_")
1176                  (when (search-backward-regexp
1177                         cfengine-mode-syntax-functions-regex
1178                         (point-at-bol)
1179                         t)
1180                    (match-string 1)))))
1181         (and w (assq (intern w) flist))))))
1182
1183 ;; format from "cf-promises -s json", e.g. "sort" function:
1184 ;; ((category . "data")
1185 ;;  (variadic . :json-false)
1186 ;;  (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
1187 ;;                 ((range . "lex,int,real,IP,ip,MAC,mac") (type . "option"))])
1188 ;;  (returnType . "slist")
1189 ;;  (status . "normal"))
1190
1191 (defun cfengine3-format-function-docstring (fdef)
1192   (let* ((f (format "%s" (car-safe fdef)))
1193          (def (cdr fdef))
1194          (rtype (cdr (assq 'returnType def)))
1195          (plist (cdr (assq 'parameters def)))
1196          (has-some-parameters (> (length plist) 0))
1197          (variadic (eq t (cdr (assq 'variadic def)))))
1198
1199     ;; (format "[%S]%s %s(%s%s)" def
1200     (format "%s %s(%s%s)"
1201             (if rtype
1202                 (propertize rtype 'face 'font-lock-variable-name-face)
1203               "???")
1204             (propertize f 'face 'font-lock-function-name-face)
1205             (mapconcat (lambda (p)
1206                          (let ((type (cdr (assq 'type p)))
1207                                (range (cdr (assq 'range p))))
1208                            (cond
1209                             ((not (stringp type)) "???type???")
1210                             ((not (stringp range)) "???range???")
1211                             ;; options are lists of possible keywords
1212                             ((equal type "option")
1213                              (propertize (concat "[" range "]")
1214                                          'face
1215                                          'font-lock-keyword-face))
1216                             ;; anything else is a type name as a variable
1217                             (t (propertize type
1218                                            'face
1219                                            'font-lock-variable-name-face)))))
1220                        plist
1221                        ", ")
1222             (if variadic
1223                 (if has-some-parameters ", ..." "...")
1224               ""))))
1225
1226 (defun cfengine3-clear-syntax-cache ()
1227   "Clear the internal syntax cache.
1228 Should not be necessary unless you reinstall CFEngine."
1229   (interactive)
1230   (setq cfengine-mode-syntax-functions-regex nil)
1231   (setq cfengine-mode-syntax-cache nil))
1232
1233 (defun cfengine3-make-syntax-cache ()
1234   "Build the CFEngine 3 syntax cache.
1235 Calls `cfengine-cf-promises' with \"-s json\""
1236   (let ((syntax (cddr (assoc cfengine-cf-promises cfengine-mode-syntax-cache))))
1237     (if cfengine-cf-promises
1238         (or syntax
1239             (with-demoted-errors
1240                 (with-temp-buffer
1241                   (call-process-shell-command cfengine-cf-promises
1242                                               nil   ; no input
1243                                               t     ; current buffer
1244                                               nil   ; no redisplay
1245                                               "-s" "json")
1246                   (goto-char (point-min))
1247                   (setq syntax (json-read))
1248                   (setq cfengine-mode-syntax-cache
1249                         (cons (cons cfengine-cf-promises syntax)
1250                               cfengine-mode-syntax-cache))
1251                   (setq cfengine-mode-syntax-functions-regex
1252                         (regexp-opt (mapcar (lambda (def)
1253                                               (format "%s" (car def)))
1254                                             (cdr (assq 'functions syntax)))
1255                                     'symbols))))))
1256     cfengine3-fallback-syntax))
1257
1258 (defun cfengine3-documentation-function ()
1259   "Document CFengine 3 functions around point.
1260 Intended as the value of `eldoc-documentation-function', which see.
1261 Use it by enabling `eldoc-mode'."
1262   (let ((fdef (cfengine3--current-function)))
1263     (when fdef
1264       (cfengine3-format-function-docstring fdef))))
1265
1266 (defun cfengine3-completion-function ()
1267   "Return completions for function name around or before point."
1268   (cfengine3-make-syntax-cache)
1269   (let* ((bounds (save-excursion
1270                    (let ((p (point)))
1271                      (skip-syntax-backward "w_" (point-at-bol))
1272                      (list (point) p))))
1273          (syntax (cfengine3-make-syntax-cache))
1274          (flist (assq 'functions syntax)))
1275     (when bounds
1276       (append bounds (list (cdr flist))))))
1277
1278 (defun cfengine-common-settings ()
1279   (set (make-local-variable 'syntax-propertize-function)
1280        ;; In the main syntax-table, \ is marked as a punctuation, because
1281        ;; of its use in DOS-style directory separators.  Here we try to
1282        ;; recognize the cases where \ is used as an escape inside strings.
1283        (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
1284   (set (make-local-variable 'parens-require-spaces) nil)
1285   (set (make-local-variable 'comment-start)  "# ")
1286   (set (make-local-variable 'comment-start-skip)
1287        "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
1288   ;; Like Lisp mode.  Without this, we lose with, say,
1289   ;; `backward-up-list' when there's an unbalanced quote in a
1290   ;; preceding comment.
1291   (set (make-local-variable 'parse-sexp-ignore-comments) t))
1292
1293 (defun cfengine-common-syntax (table)
1294   ;; The syntax defaults seem OK to give reasonable word movement.
1295   (modify-syntax-entry ?# "<" table)
1296   (modify-syntax-entry ?\n ">#" table)
1297   (modify-syntax-entry ?\" "\"" table)  ; "string"
1298   (modify-syntax-entry ?\' "\"" table)  ; 'string'
1299   ;; Variable substitution.
1300   (modify-syntax-entry ?$ "." table)
1301   ;; Doze path separators.
1302   (modify-syntax-entry ?\\ "." table))
1303
1304 (defconst cfengine3--prettify-symbols-alist
1305   '(("->"  . ?→)
1306     ("=>"  . ?⇒)
1307     ("::" . ?∷)))
1308
1309 ;;;###autoload
1310 (define-derived-mode cfengine3-mode prog-mode "CFE3"
1311   "Major mode for editing CFEngine3 input.
1312 There are no special keybindings by default.
1313
1314 Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
1315 to the action header."
1316   (cfengine-common-settings)
1317   (cfengine-common-syntax cfengine3-mode-syntax-table)
1318
1319   (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
1320
1321   (setq font-lock-defaults
1322         '(cfengine3-font-lock-keywords
1323           nil nil nil beginning-of-defun))
1324   (setq-local prettify-symbols-alist cfengine3--prettify-symbols-alist)
1325
1326   ;; `compile-command' is almost never a `make' call with CFEngine so
1327   ;; we override it
1328   (when cfengine-cf-promises
1329     (set (make-local-variable 'compile-command)
1330          (concat cfengine-cf-promises
1331                  " -f "
1332                  (when buffer-file-name
1333                    (shell-quote-argument buffer-file-name)))))
1334
1335   (set (make-local-variable 'eldoc-documentation-function)
1336        #'cfengine3-documentation-function)
1337
1338   (add-hook 'completion-at-point-functions
1339             #'cfengine3-completion-function nil t)
1340
1341   ;; Use defuns as the essential syntax block.
1342   (set (make-local-variable 'beginning-of-defun-function)
1343        #'cfengine3-beginning-of-defun)
1344   (set (make-local-variable 'end-of-defun-function)
1345        #'cfengine3-end-of-defun))
1346
1347 ;;;###autoload
1348 (define-derived-mode cfengine2-mode prog-mode "CFE2"
1349   "Major mode for editing CFEngine2 input.
1350 There are no special keybindings by default.
1351
1352 Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
1353 to the action header."
1354   (cfengine-common-settings)
1355   (cfengine-common-syntax cfengine2-mode-syntax-table)
1356
1357   ;; Shell commands can be quoted by single, double or back quotes.
1358   ;; It's debatable whether we should define string syntax, but it
1359   ;; should avoid potential confusion in some cases.
1360   (modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table)
1361
1362   (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line)
1363   (set (make-local-variable 'outline-regexp) "[ \t]*\\(\\sw\\|\\s_\\)+:+")
1364   (set (make-local-variable 'outline-level) #'cfengine2-outline-level)
1365   (set (make-local-variable 'fill-paragraph-function)
1366        #'cfengine-fill-paragraph)
1367   (define-abbrev-table 'cfengine2-mode-abbrev-table cfengine-mode-abbrevs)
1368   (setq font-lock-defaults
1369         '(cfengine2-font-lock-keywords nil nil nil beginning-of-line))
1370   ;; Fixme: set the args of functions in evaluated classes to string
1371   ;; syntax, and then obey syntax properties.
1372   (setq imenu-generic-expression cfengine2-imenu-expression)
1373   (set (make-local-variable 'beginning-of-defun-function)
1374        #'cfengine2-beginning-of-defun)
1375   (set (make-local-variable 'end-of-defun-function) #'cfengine2-end-of-defun))
1376
1377 ;;;###autoload
1378 (defun cfengine-auto-mode ()
1379   "Choose between `cfengine2-mode' and `cfengine3-mode' depending
1380 on the buffer contents"
1381   (let ((v3 nil))
1382     (save-restriction
1383       (goto-char (point-min))
1384       (while (not (or (eobp) v3))
1385         (setq v3 (looking-at (concat cfengine3-defuns-regex "\\_>")))
1386         (forward-line)))
1387     (if v3 (cfengine3-mode) (cfengine2-mode))))
1388
1389 (defalias 'cfengine-mode 'cfengine3-mode)
1390
1391 (provide 'cfengine3)
1392 (provide 'cfengine)
1393
1394 ;;; cfengine.el ends here