lisp/progmodes/cfengine.el

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