code.delx.au - gnu-emacs/blob - lisp/progmodes/cfengine.el

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