lisp/progmodes/cfengine.el

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