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