code.delx.au - gnu-emacs/blob - 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.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-defun-full-re (concat "^\\s-*" cfengine3-defuns-regex
 821                                             "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;type
 822                                             "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;id
 823                                             )
 824     "Regexp matching full defun declaration (excluding argument list).")
 825
 826   (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!:]+\\)::")
 827
 828   (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
 829
 830   (defconst cfengine3-vartypes '("string" "int" "real" "slist" "ilist" "rlist"
 831                                  "irange" "rrange" "counter" "data")
 832     "List of the CFEngine 3.x variable types."))
 833
 834 (defvar cfengine2-font-lock-keywords
 835   `(;; Actions.
 836     ;; List the allowed actions explicitly, so that errors are more obvious.
 837     (,(concat "^[ \t]*" (eval-when-compile
 838                           (regexp-opt cfengine2-actions t))
 839               ":")
 840      1 font-lock-keyword-face)
 841     ;; Classes.
 842     ("^[ \t]*\\([[:alnum:]_().|!]+\\)::" 1 font-lock-function-name-face)
 843     ;; Variables.
 844     ("$(\\([[:alnum:]_]+\\))" 1 font-lock-variable-name-face)
 845     ("${\\([[:alnum:]_]+\\)}" 1 font-lock-variable-name-face)
 846     ;; Variable definitions.
 847     ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
 848     ;; File, acl &c in group:   { token ... }
 849     ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face)))
 850
 851 (defvar cfengine3-font-lock-keywords
 852   `(
 853     ;; Defuns.  This happens early so they don't get caught by looser
 854     ;; patterns.
 855     (,(concat "\\_<" cfengine3-defuns-regex "\\_>"
 856               "[ \t]+\\_<\\([[:alnum:]_.:]+\\)\\_>"
 857               "[ \t]+\\_<\\([[:alnum:]_.:]+\\)"
 858               ;; Optional parentheses with variable names inside.
 859               "\\(?:(\\([^)]*\\))\\)?")
 860      (1 font-lock-builtin-face)
 861      (2 font-lock-constant-face)
 862      (3 font-lock-function-name-face)
 863      (4 font-lock-variable-name-face nil t))
 864
 865     ;; Class selectors.
 866     (,(concat "^[ \t]*" cfengine3-class-selector-regex)
 867      1 font-lock-keyword-face)
 868
 869     ;; Categories.
 870     (,(concat "^[ \t]*" cfengine3-category-regex)
 871      1 font-lock-builtin-face)
 872
 873     ;; Variables, including scope, e.g. module.var
 874     ("[@$](\\([[:alnum:]_.:]+\\))" 1 font-lock-variable-name-face)
 875     ("[@$]{\\([[:alnum:]_.:]+\\)}" 1 font-lock-variable-name-face)
 876
 877     ;; Variable definitions.
 878     ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
 879
 880     ;; Variable types.
 881     (,(concat "\\_<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\_>")
 882      1 font-lock-type-face)))
 883
 884 (defvar cfengine2-imenu-expression
 885   `((nil ,(concat "^[ \t]*" (eval-when-compile
 886                               (regexp-opt cfengine2-actions t))
 887                   ":[^:]")
 888          1)
 889     ("Variables/classes" "\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1)
 890     ("Variables/classes" "\\_<define=\\([[:alnum:]_]+\\)" 1)
 891     ("Variables/classes" "\\_<DefineClass\\>[ \t]+\\([[:alnum:]_]+\\)" 1))
 892   "`imenu-generic-expression' for CFEngine mode.")
 893
 894 (defun cfengine2-outline-level ()
 895   "`outline-level' function for CFEngine mode."
 896   (if (looking-at "[^:]+\\(?:[:]+\\)$")
 897       (length (match-string 1))))
 898
 899 (defun cfengine2-beginning-of-defun ()
 900   "`beginning-of-defun' function for CFEngine mode.
 901 Treats actions as defuns."
 902   (unless (<= (current-column) (current-indentation))
 903     (end-of-line))
 904   (if (re-search-backward "^[[:alpha:]]+: *$" nil t)
 905       (beginning-of-line)
 906     (goto-char (point-min)))
 907   t)
 908
 909 (defun cfengine2-end-of-defun ()
 910   "`end-of-defun' function for CFEngine mode.
 911 Treats actions as defuns."
 912   (end-of-line)
 913   (if (re-search-forward "^[[:alpha:]]+: *$" nil t)
 914       (beginning-of-line)
 915     (goto-char (point-max)))
 916   t)
 917
 918 ;; Fixme: Should get an extra indent step in editfiles BeginGroup...s.
 919
 920 (defun cfengine2-indent-line ()
 921   "Indent a line in Cfengine mode.
 922 Intended as the value of `indent-line-function'."
 923   (let ((pos (- (point-max) (point))))
 924     (save-restriction
 925       (narrow-to-defun)
 926       (back-to-indentation)
 927       (cond
 928        ;; Action selectors aren't indented; class selectors are
 929        ;; indented one step.
 930        ((looking-at "[[:alnum:]_().|!]+:\\(:\\)?")
 931         (if (match-string 1)
 932             (indent-line-to cfengine-indent)
 933           (indent-line-to 0)))
 934        ;; Outdent leading close brackets one step.
 935        ((or (eq ?\} (char-after))
 936             (eq ?\) (char-after)))
 937         (condition-case ()
 938             (indent-line-to (save-excursion
 939                               (forward-char)
 940                               (backward-sexp)
 941                               (current-column)))
 942           (error nil)))
 943        ;; Inside brackets/parens: indent to start column of non-comment
 944        ;; token on line following open bracket or by one step from open
 945        ;; bracket's column.
 946        ((condition-case ()
 947             (progn (indent-line-to (save-excursion
 948                                      (backward-up-list)
 949                                      (forward-char)
 950                                      (skip-chars-forward " \t")
 951                                      (if (looking-at "[^\n#]")
 952                                          (current-column)
 953                                        (skip-chars-backward " \t")
 954                                        (+ (current-column) -1
 955                                           cfengine-indent))))
 956                    t)
 957           (error nil)))
 958        ;; Indent by  two steps after a class selector.
 959        ((save-excursion
 960           (re-search-backward "^[ \t]*[[:alnum:]_().|!]+::" nil t))
 961         (indent-line-to (* 2 cfengine-indent)))
 962        ;; Indent by one step if we're after an action header.
 963        ((save-excursion
 964           (goto-char (point-min))
 965           (looking-at "[[:alpha:]]+:[ \t]*$"))
 966         (indent-line-to cfengine-indent))
 967        ;; Else don't indent.
 968        (t
 969         (indent-line-to 0))))
 970     ;; If initial point was within line's indentation,
 971     ;; position after the indentation.  Else stay at same point in text.
 972     (if (> (- (point-max) pos) (point))
 973         (goto-char (- (point-max) pos)))))
 974
 975 ;; This doesn't work too well in Emacs 21.2.  See 22.1 development
 976 ;; code.
 977 (defun cfengine-fill-paragraph (&optional justify)
 978   "Fill `paragraphs' in Cfengine code."
 979   (interactive "P")
 980   (or (if (fboundp 'fill-comment-paragraph)
 981           (fill-comment-paragraph justify) ; post Emacs 21.3
 982         ;; else do nothing in a comment
 983         (nth 4 (parse-partial-sexp (save-excursion
 984                                      (beginning-of-defun)
 985                                      (point))
 986                                    (point))))
 987       (let ((paragraph-start
 988              ;; Include start of parenthesized block.
 989              "\f\\|[ \t]*$\\|.*\(")
 990             (paragraph-separate
 991              ;; Include action and class lines, start and end of
 992              ;; bracketed blocks and end of parenthesized blocks to
 993              ;; avoid including these in fill.  This isn't ideal.
 994              "[ \t\f]*$\\|.*#\\|.*[\){}]\\|\\s-*[[:alpha:]_().|!]+:")
 995             fill-paragraph-function)
 996         (fill-paragraph justify))
 997       t))
 998
 999 (defun cfengine3-beginning-of-defun ()
1000   "`beginning-of-defun' function for Cfengine 3 mode.
1001 Treats body/bundle blocks as defuns."
1002   (unless (<= (current-column) (current-indentation))
1003     (end-of-line))
1004   (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t)
1005       (beginning-of-line)
1006     (goto-char (point-min)))
1007   t)
1008
1009 (defun cfengine3-end-of-defun ()
1010   "`end-of-defun' function for Cfengine 3 mode.
1011 Treats body/bundle blocks as defuns."
1012   (end-of-line)
1013   (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t)
1014       (beginning-of-line)
1015     (goto-char (point-max)))
1016   t)
1017
1018 (defun cfengine3-indent-line ()
1019   "Indent a line in Cfengine 3 mode.
1020 Intended as the value of `indent-line-function'."
1021   (let ((pos (- (point-max) (point)))
1022         parse)
1023     (save-restriction
1024       (narrow-to-defun)
1025       (back-to-indentation)
1026       (setq parse (parse-partial-sexp (point-min) (point)))
1027       (when cfengine-mode-debug
1028         (message "%S" parse))
1029
1030       (cond
1031        ;; Body/bundle blocks start at 0.
1032        ((looking-at (concat cfengine3-defuns-regex "\\_>"))
1033         (indent-line-to 0))
1034        ;; Categories are indented one step.
1035        ((looking-at (concat cfengine3-category-regex "[ \t]*\\(#.*\\)*$"))
1036         (indent-line-to cfengine-indent))
1037        ;; Class selectors are indented two steps.
1038        ((looking-at (concat cfengine3-class-selector-regex "[ \t]*\\(#.*\\)*$"))
1039         (indent-line-to (* 2 cfengine-indent)))
1040        ;; Outdent leading close brackets one step.
1041        ((or (eq ?\} (char-after))
1042             (eq ?\) (char-after)))
1043         (condition-case ()
1044             (indent-line-to (save-excursion
1045                               (forward-char)
1046                               (backward-sexp)
1047                               (move-beginning-of-line nil)
1048                               (skip-chars-forward " \t")
1049                               (current-column)))
1050           (error nil)))
1051        ;; Inside a string and it starts before this line: do nothing.
1052        ((and (nth 3 parse)
1053              (< (nth 8 parse) (save-excursion (beginning-of-line) (point))))
1054         )
1055
1056        ;; Inside a defun, but not a nested list (depth is 1).  This is
1057        ;; a promise, usually.
1058
1059        ;; Indent to cfengine-indent times the nested depth
1060        ;; plus 2.  That way, promises indent deeper than class
1061        ;; selectors, which in turn are one deeper than categories.
1062        ((= 1 (nth 0 parse))
1063         (let ((p-anchor (nth 0 cfengine-parameters-indent))
1064               (p-what (nth 1 cfengine-parameters-indent))
1065               (p-indent (nth 2 cfengine-parameters-indent)))
1066           ;; Do we have the parameter anchor and location and indent
1067           ;; defined, and are we looking at a promise parameter?
1068           (if (and p-anchor p-what p-indent
1069                    (looking-at  "\\([[:alnum:]_]+[ \t]*\\)=>"))
1070               (let* ((arrow-offset (* -1 (length (match-string 1))))
1071                      (extra-offset (if (eq p-what 'arrow) arrow-offset 0))
1072                      (base-offset (if (eq p-anchor 'promise)
1073                                       (* (+ 2 (nth 0 parse)) cfengine-indent)
1074                                     0)))
1075                 (indent-line-to (max 0 (+ p-indent base-offset extra-offset))))
1076             ;; Else, indent to cfengine-indent times the nested depth
1077             ;; plus 2.  That way, promises indent deeper than class
1078             ;; selectors, which in turn are one deeper than categories.
1079           (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent)))))
1080        ;; Inside brackets/parens: indent to start column of non-comment
1081        ;; token on line following open bracket or by one step from open
1082        ;; bracket's column.
1083        ((condition-case ()
1084             (progn (indent-line-to (save-excursion
1085                                      (backward-up-list)
1086                                      (forward-char)
1087                                      (skip-chars-forward " \t")
1088                                      (cond
1089                                       ((looking-at "[^\n#]")
1090                                        (current-column))
1091                                       ((looking-at "[^\n#]")
1092                                        (current-column))
1093                                       (t
1094                                        (skip-chars-backward " \t")
1095                                        (+ (current-column) -1
1096                                           cfengine-indent)))))
1097                    t)
1098           (error nil)))
1099        ;; Else don't indent.
1100        (t (indent-line-to 0))))
1101     ;; If initial point was within line's indentation,
1102     ;; position after the indentation.  Else stay at same point in text.
1103     (if (> (- (point-max) pos) (point))
1104         (goto-char (- (point-max) pos)))))
1105
1106 ;; CFEngine 3.x grammar
1107
1108 ;; specification: blocks
1109 ;; blocks: block | blocks block;
1110 ;; block:                 bundle typeid blockid bundlebody
1111 ;;                      | bundle typeid blockid usearglist bundlebody
1112 ;;                      | body typeid blockid bodybody
1113 ;;                      | body typeid blockid usearglist bodybody;
1114
1115 ;; typeid: id
1116 ;; blockid: id
1117 ;; usearglist: '(' aitems ')';
1118 ;; aitems: aitem | aitem ',' aitems |;
1119 ;; aitem: id
1120
1121 ;; bundlebody: '{' statements '}'
1122 ;; statements: statement | statements statement;
1123 ;; statement: category | classpromises;
1124
1125 ;; bodybody: '{' bodyattribs '}'
1126 ;; bodyattribs: bodyattrib | bodyattribs bodyattrib;
1127 ;; bodyattrib: class | selections;
1128 ;; selections: selection | selections selection;
1129 ;; selection: id ASSIGN rval ';' ;
1130
1131 ;; classpromises: classpromise | classpromises classpromise;
1132 ;; classpromise: class | promises;
1133 ;; promises: promise | promises promise;
1134 ;; category: CATEGORY
1135 ;; promise: promiser ARROW rval constraints ';' | promiser constraints ';';
1136 ;; constraints: constraint | constraints ',' constraint |;
1137 ;; constraint: id ASSIGN rval;
1138 ;; class: CLASS
1139 ;; id: ID
1140 ;; rval: ID | QSTRING | NAKEDVAR | list | usefunction
1141 ;; list: '{' litems '}' ;
1142 ;; litems: litem | litem ',' litems |;
1143 ;; litem: ID | QSTRING | NAKEDVAR | list | usefunction
1144
1145 ;; functionid: ID | NAKEDVAR
1146 ;; promiser: QSTRING
1147 ;; usefunction: functionid givearglist
1148 ;; givearglist: '(' gaitems ')'
1149 ;; gaitems: gaitem | gaitems ',' gaitem |;
1150 ;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction
1151
1152 ;; # from lexer:
1153
1154 ;; bundle: "bundle"
1155 ;; body: "body"
1156 ;; COMMENT    #[^\n]*
1157 ;; NAKEDVAR   [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}]
1158 ;; ID: [a-zA-Z0-9_\200-\377]+
1159 ;; ASSIGN: "=>"
1160 ;; ARROW: "->"
1161 ;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*`
1162 ;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+::
1163 ;; CATEGORY: [a-zA-Z_]+:
1164
1165 (defun cfengine3--current-function ()
1166   "Look up current CFEngine 3 function"
1167   (let* ((syntax (cfengine3-make-syntax-cache))
1168          (flist (assq 'functions syntax)))
1169     (when flist
1170       (let ((w (save-excursion
1171                  (skip-syntax-forward "w_")
1172                  (when (search-backward-regexp
1173                         cfengine-mode-syntax-functions-regex
1174                         (point-at-bol)
1175                         t)
1176                    (match-string 1)))))
1177         (and w (assq (intern w) flist))))))
1178
1179 ;; format from "cf-promises -s json", e.g. "sort" function:
1180 ;; ((category . "data")
1181 ;;  (variadic . :json-false)
1182 ;;  (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
1183 ;;                 ((range . "lex,int,real,IP,ip,MAC,mac") (type . "option"))])
1184 ;;  (returnType . "slist")
1185 ;;  (status . "normal"))
1186
1187 (defun cfengine3-format-function-docstring (fdef)
1188   (let* ((f (format "%s" (car-safe fdef)))
1189          (def (cdr fdef))
1190          (rtype (cdr (assq 'returnType def)))
1191          (plist (cdr (assq 'parameters def)))
1192          (has-some-parameters (> (length plist) 0))
1193          (variadic (eq t (cdr (assq 'variadic def)))))
1194
1195     ;; (format "[%S]%s %s(%s%s)" def
1196     (format "%s %s(%s%s)"
1197             (if rtype
1198                 (propertize rtype 'face 'font-lock-variable-name-face)
1199               "???")
1200             (propertize f 'face 'font-lock-function-name-face)
1201             (mapconcat (lambda (p)
1202                          (let ((type (cdr (assq 'type p)))
1203                                (range (cdr (assq 'range p))))
1204                            (cond
1205                             ((not (stringp type)) "???type???")
1206                             ((not (stringp range)) "???range???")
1207                             ;; options are lists of possible keywords
1208                             ((equal type "option")
1209                              (propertize (concat "[" range "]")
1210                                          'face
1211                                          'font-lock-keyword-face))
1212                             ;; anything else is a type name as a variable
1213                             (t (propertize type
1214                                            'face
1215                                            'font-lock-variable-name-face)))))
1216                        plist
1217                        ", ")
1218             (if variadic
1219                 (if has-some-parameters ", ..." "...")
1220               ""))))
1221
1222 (defun cfengine3-clear-syntax-cache ()
1223   "Clear the internal syntax cache.
1224 Should not be necessary unless you reinstall CFEngine."
1225   (interactive)
1226   (setq cfengine-mode-syntax-functions-regex nil)
1227   (setq cfengine-mode-syntax-cache nil))
1228
1229 (defun cfengine3-make-syntax-cache ()
1230   "Build the CFEngine 3 syntax cache and return the syntax.
1231 Calls `cfengine-cf-promises' with \"-s json\"."
1232   (or (cdr (assoc cfengine-cf-promises cfengine-mode-syntax-cache))
1233       (let ((syntax (or (when cfengine-cf-promises
1234                           (with-demoted-errors "cfengine3-make-syntax-cache: %S"
1235                             (with-temp-buffer
1236                               (or (zerop (process-file cfengine-cf-promises
1237                                                        nil ; no input
1238                                                        t   ; output
1239                                                        nil ; no redisplay
1240                                                        "-s" "json"))
1241                                   (error "%s" (buffer-substring
1242                                                (point-min)
1243                                                (progn (goto-char (point-min))
1244                                                       (line-end-position)))))
1245                               (goto-char (point-min))
1246                               (json-read))))
1247                         cfengine3-fallback-syntax)))
1248         (push (cons cfengine-cf-promises syntax)
1249               cfengine-mode-syntax-cache)
1250         (setq cfengine-mode-syntax-functions-regex
1251               (regexp-opt (mapcar (lambda (def)
1252                                     (format "%s" (car def)))
1253                                   (cdr (assq 'functions syntax)))
1254                           'symbols))
1255         syntax)))
1256
1257 (defun cfengine3-documentation-function ()
1258   "Document CFengine 3 functions around point.
1259 Intended as the value of `eldoc-documentation-function', which see.
1260 Use it by enabling `eldoc-mode'."
1261   (let ((fdef (cfengine3--current-function)))
1262     (when fdef
1263       (cfengine3-format-function-docstring fdef))))
1264
1265 (defun cfengine3-completion-function ()
1266   "Return completions for function name around or before point."
1267   (let* ((bounds (save-excursion
1268                    (let ((p (point)))
1269                      (skip-syntax-backward "w_" (point-at-bol))
1270                      (list (point) p))))
1271          (syntax (cfengine3-make-syntax-cache))
1272          (flist (assq 'functions syntax)))
1273     (when bounds
1274       (append bounds (list (cdr flist))))))
1275
1276 (defun cfengine-common-settings ()
1277   (set (make-local-variable 'syntax-propertize-function)
1278        ;; In the main syntax-table, \ is marked as a punctuation, because
1279        ;; of its use in DOS-style directory separators.  Here we try to
1280        ;; recognize the cases where \ is used as an escape inside strings.
1281        (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
1282   (set (make-local-variable 'parens-require-spaces) nil)
1283   (set (make-local-variable 'comment-start)  "# ")
1284   (set (make-local-variable 'comment-start-skip)
1285        "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
1286   ;; Like Lisp mode.  Without this, we lose with, say,
1287   ;; `backward-up-list' when there's an unbalanced quote in a
1288   ;; preceding comment.
1289   (set (make-local-variable 'parse-sexp-ignore-comments) t))
1290
1291 (defun cfengine-common-syntax (table)
1292   ;; The syntax defaults seem OK to give reasonable word movement.
1293   (modify-syntax-entry ?# "<" table)
1294   (modify-syntax-entry ?\n ">#" table)
1295   (modify-syntax-entry ?\" "\"" table)  ; "string"
1296   (modify-syntax-entry ?\' "\"" table)  ; 'string'
1297   ;; Variable substitution.
1298   (modify-syntax-entry ?$ "." table)
1299   ;; Doze path separators.
1300   (modify-syntax-entry ?\\ "." table))
1301
1302 (defconst cfengine3--prettify-symbols-alist
1303   '(("->"  . ?→)
1304     ("=>"  . ?⇒)
1305     ("::" . ?∷)))
1306
1307 (defun cfengine3-create-imenu-index ()
1308   "A function for `imenu-create-index-function'.
1309 Note: defun name is separated by space such as `body
1310 package_method opencsw' and imenu will replace spaces according
1311 to `imenu-space-replacement' (which see)."
1312   (goto-char (point-min))
1313   (let ((defuns ()))
1314     (while (re-search-forward cfengine3-defun-full-re nil t)
1315       (push (cons (mapconcat #'match-string '(1 2 3) " ")
1316                   (copy-marker (match-beginning 3)))
1317             defuns))
1318     (nreverse defuns)))
1319
1320 (defun cfengine3-current-defun ()
1321   "A function for `add-log-current-defun-function'."
1322   (end-of-line)
1323   (beginning-of-defun)
1324   (and (looking-at cfengine3-defun-full-re)
1325        (mapconcat #'match-string '(1 2 3) " ")))
1326
1327 ;;;###autoload
1328 (define-derived-mode cfengine3-mode prog-mode "CFE3"
1329   "Major mode for editing CFEngine3 input.
1330 There are no special keybindings by default.
1331
1332 Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
1333 to the action header."
1334   (cfengine-common-settings)
1335   (cfengine-common-syntax cfengine3-mode-syntax-table)
1336
1337   (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
1338
1339   (setq font-lock-defaults
1340         '(cfengine3-font-lock-keywords
1341           nil nil nil beginning-of-defun))
1342   (setq-local prettify-symbols-alist cfengine3--prettify-symbols-alist)
1343
1344   ;; `compile-command' is almost never a `make' call with CFEngine so
1345   ;; we override it
1346   (when cfengine-cf-promises
1347     (set (make-local-variable 'compile-command)
1348          (concat cfengine-cf-promises
1349                  " -f "
1350                  (when buffer-file-name
1351                    (shell-quote-argument buffer-file-name)))))
1352
1353   (setq-local eldoc-documentation-function #'cfengine3-documentation-function)
1354
1355   (add-hook 'completion-at-point-functions
1356             #'cfengine3-completion-function nil t)
1357
1358   ;; Use defuns as the essential syntax block.
1359   (setq-local beginning-of-defun-function #'cfengine3-beginning-of-defun)
1360   (setq-local end-of-defun-function #'cfengine3-end-of-defun)
1361
1362   (setq-local imenu-create-index-function #'cfengine3-create-imenu-index)
1363   (setq-local add-log-current-defun-function #'cfengine3-current-defun))
1364
1365 ;;;###autoload
1366 (define-derived-mode cfengine2-mode prog-mode "CFE2"
1367   "Major mode for editing CFEngine2 input.
1368 There are no special keybindings by default.
1369
1370 Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
1371 to the action header."
1372   (cfengine-common-settings)
1373   (cfengine-common-syntax cfengine2-mode-syntax-table)
1374
1375   ;; Shell commands can be quoted by single, double or back quotes.
1376   ;; It's debatable whether we should define string syntax, but it
1377   ;; should avoid potential confusion in some cases.
1378   (modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table)
1379
1380   (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line)
1381   (set (make-local-variable 'outline-regexp) "[ \t]*\\(\\sw\\|\\s_\\)+:+")
1382   (set (make-local-variable 'outline-level) #'cfengine2-outline-level)
1383   (set (make-local-variable 'fill-paragraph-function)
1384        #'cfengine-fill-paragraph)
1385   (define-abbrev-table 'cfengine2-mode-abbrev-table cfengine-mode-abbrevs)
1386   (setq font-lock-defaults
1387         '(cfengine2-font-lock-keywords nil nil nil beginning-of-line))
1388   ;; Fixme: set the args of functions in evaluated classes to string
1389   ;; syntax, and then obey syntax properties.
1390   (setq imenu-generic-expression cfengine2-imenu-expression)
1391   (set (make-local-variable 'beginning-of-defun-function)
1392        #'cfengine2-beginning-of-defun)
1393   (set (make-local-variable 'end-of-defun-function) #'cfengine2-end-of-defun))
1394
1395 ;;;###autoload
1396 (defun cfengine-auto-mode ()
1397   "Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents."
1398   (interactive)
1399   (if (save-excursion
1400         (save-restriction
1401           (widen)
1402           (goto-char (point-min))
1403           (forward-comment (point-max))
1404           (or (eobp)
1405               (re-search-forward
1406                (concat "^\\s-*" cfengine3-defuns-regex "\\_>") nil t))))
1407       (cfengine3-mode)
1408     (cfengine2-mode)))
1409
1410 (defalias 'cfengine-mode 'cfengine3-mode)
1411
1412 (provide 'cfengine3)
1413 (provide 'cfengine)
1414
1415 ;;; cfengine.el ends here