emacs_el/vcl-mode.el

   1 ;;; vcl-mode.el --- Major mode for Varnish Configuration Language  -*- lexical-binding:t -*-
   2
   3 ;; Author: Sergey Poznyakoff <gray@gnu.org.ua>
   4 ;; Version: 1.1
   5 ;; Keywords: Varnish, VCL
   6
   7 ;; Copyright (C) 2015-2018 Free Software Foundation, Inc.
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; Emacs support for Varnish's configuration language:
  25 ;; https://varnish-cache.org/docs/trunk/users-guide/vcl.html
  26 ;; This version of vcl-mode supports VCL-4.0.
  27
  28 ;; The features provided are auto-indentation (based on CC-mode's
  29 ;; engine), keyword highlighting, and matching of {"..."} multi-line
  30 ;; string delimiters.
  31
  32 ;; If you need support for VCL-2.0, you might have more luck with the older
  33 ;; package: https://github.com/ssm/elisp/blob/master/vcl-mode.el
  34
  35 ;;; Code:
  36
  37 (require 'cc-mode)
  38 (require 'cc-langs)
  39
  40 (defvar vcl-mode-map
  41   (let ((map (make-sparse-keymap)))
  42     (set-keymap-parent map c-mode-base-map)
  43     (define-key map "\C-c%" 'vcl-match-paren)
  44     map)
  45   "Keymap used in vcl-mode buffers.")
  46
  47 (defvar vcl-mode-syntax-table
  48   (let ((st (make-syntax-table)))
  49     (modify-syntax-entry ?\n "> b" st)
  50     ;; Use comment style `b' to match the style used for \n!
  51     (modify-syntax-entry ?\# "< b" st)
  52     (modify-syntax-entry ?/ ". 124b" st)
  53     (modify-syntax-entry ?* ". 23" st)
  54     (modify-syntax-entry ?+ "." st)
  55     (modify-syntax-entry ?- "." st)
  56     (modify-syntax-entry ?~ "." st)
  57     (modify-syntax-entry ?= "." st)
  58     (modify-syntax-entry ?% "." st)
  59     (modify-syntax-entry ?< "." st)
  60     (modify-syntax-entry ?> "." st)
  61     (modify-syntax-entry ?& "." st)
  62     (modify-syntax-entry ?| "." st)
  63     (modify-syntax-entry ?_ "_" st)
  64     (modify-syntax-entry ?\' "." st)
  65     (modify-syntax-entry ?\" "\"" st)
  66     st)
  67   "Syntax table in use in VCL Mode buffers.")
  68
  69 (define-abbrev-table 'vcl-mode-abbrev-table
  70   '(("else" "else" c-electric-continued-statement :system t))
  71   "Abbreviation table used in vcl-mode buffers.")
  72
  73 ;; Font locking
  74 (defconst vcl-font-lock-keywords-1
  75   (eval-when-compile
  76     (list
  77      ;; Version declaration
  78      '("^[ \t]*\\(vcl\\)\\>[ \t]*\\([[:digit:]]+\\.[[:digit:]]+\\)"
  79        (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
  80      ;; Built-ins
  81      (cons
  82       (concat "\\<"
  83               (regexp-opt
  84                '("vcl_init"
  85                  "vcl_recv"
  86                  "vcl_pipe"
  87                  "vcl_pass"
  88                  "vcl_hash"
  89                  "vcl_hit"
  90                  "vcl_miss"
  91                  "vcl_fetch"
  92                  "vcl_deliver"
  93                  "vcl_error"
  94                  "vcl_fini"
  95                  "vcl_synth"
  96                  "vcl_backend_fetch"
  97                  "vcl_backend_response"
  98                  "vcl_backend_error") t)
  99               "\\>")
 100         'font-lock-builtin-face)
 101      ;; Keywords
 102      (cons
 103       (concat "\\<"
 104               (regexp-opt
 105                '("sub"
 106                  "import"
 107                  "include"
 108                  "backend"))
 109               "\\>")
 110       'font-lock-keyword-face)
 111      ))
 112   "Subdued level highlighting for VCL buffers.")
 113
 114 (defconst vcl-font-lock-keywords-2
 115   (append vcl-font-lock-keywords-1
 116           (eval-when-compile
 117             (list
 118              ;; Keywords
 119              (cons
 120               (concat "\\<"
 121                       (regexp-opt
 122                        '("acl"
 123                          "if"
 124                          "else"
 125                          "return"
 126                          "call"
 127                          "set"
 128                          "remove"
 129                          "unset"
 130                          "director"
 131                          "probe"))
 132                       "\\>")
 133               'font-lock-keyword-face)
 134              ;; Return values
 135              (cons
 136               (concat "\\<"
 137                       (regexp-opt
 138                        '("error"
 139                          "fetch"
 140                          "hash"
 141                          "hit_for_pass"
 142                          "lookup"
 143                          "ok"
 144                          "pass"
 145                          "pipe"
 146                          "deliver"
 147                          "restart"
 148                          "true"
 149                          "false"))
 150                       "\\>")
 151               'font-lock-constant-face)
 152              ;; Functions
 153              (cons
 154               (concat "\\<"
 155                       (regexp-opt
 156                        '("ban"
 157                          "call"
 158                          "hash_data"
 159                          "new"
 160                          "synth"
 161                          "synthetic"
 162                          "regsub"
 163                          "regsuball"))
 164                       "\\>")
 165               'font-lock-function-name-face)
 166
 167              ;; Objects and variables
 168              ;; See https://www.varnish-cache.org/docs/4.0/reference/vcl.html#variables
 169              (list (concat "\\<"
 170                       (regexp-opt
 171                        '("req"
 172                          "resp"
 173                          "bereq"
 174                          "beresp"
 175                          "obj")
 176                        t)
 177                       "\\.\\(http\\)\\(\\.\\([a-zA-Z_-][a-zA-Z_0-9-]*\\)\\)?")
 178                '(1 font-lock-builtin-face)
 179                '(2 font-lock-builtin-face)
 180                '(4 font-lock-string-face nil t))
 181              (list (concat "\\<\\(bereq\\)\\."
 182                            (regexp-opt
 183                             '("backend"
 184                               "between_bytes_timeout"
 185                               "connect_timeout"
 186                               "first_byte_timeout"
 187                               "method"
 188                               "proto"
 189                               "retries"
 190                               "uncacheable"
 191                               "url"
 192                               "xid")
 193                             t))
 194                '(1 font-lock-builtin-face)
 195                '(2 font-lock-builtin-face))
 196              (list (concat "\\<\\(beresp\\)\\.\\(backend\\)\\."
 197                            (regexp-opt
 198                             '("name"
 199                               "ip")
 200                             t))
 201                '(1 font-lock-builtin-face)
 202                '(2 font-lock-builtin-face)
 203                '(3 font-lock-builtin-face))
 204              (list (concat "\\<\\(beresp\\)\\."
 205                            (regexp-opt
 206                             '("do_esi"
 207                               "do_gunzip"
 208                               "do_gzip"
 209                               "do_stream"
 210                               "grace"
 211                               "keep"
 212                               "proto"
 213                               "reason"
 214                               "status"
 215                               "storage_hint"
 216                               "ttl"
 217                               "uncacheable")
 218                             t))
 219                '(1 font-lock-builtin-face)
 220                '(2 font-lock-builtin-face))
 221              (list (concat "\\<\\(client\\)\\."
 222                            (regexp-opt
 223                             '("identity"
 224                               "ip")
 225                             t))
 226                '(1 font-lock-builtin-face)
 227                '(2 font-lock-builtin-face))
 228              (list (concat "\\<\\(obj\\)\\."
 229                            (regexp-opt
 230                             '("grace"
 231                               "hits"
 232                               "keep"
 233                               "proto"
 234                               "reason"
 235                               "status"
 236                               "ttl"
 237                               "uncacheable")
 238                             t))
 239                '(1 font-lock-builtin-face)
 240                '(2 font-lock-builtin-face))
 241              (list (concat "\\<\\(req\\)\\."
 242                            (regexp-opt
 243                             '("backend_hint"
 244                               "can_gzip"
 245                               "esi"
 246                               "esi_level"
 247                               "hash_always_miss"
 248                               "hash_ignore_busy"
 249                               "method"
 250                               "proto"
 251                               "restarts"
 252                               "ttl"
 253                               "url"
 254                               "xid")
 255                             t))
 256                '(1 font-lock-builtin-face)
 257                '(2 font-lock-builtin-face))
 258              (list (concat "\\<\\(resp\\)\\."
 259                            (regexp-opt
 260                             '("proto"
 261                               "reason"
 262                               "status")
 263                             t))
 264                '(1 font-lock-builtin-face)
 265                '(2 font-lock-builtin-face))
 266              (list (concat "\\<\\(server\\)\\."
 267                            (regexp-opt
 268                             '("hostname"
 269                               "identity"
 270                               "ip")
 271                             t))
 272                '(1 font-lock-builtin-face)
 273                '(2 font-lock-builtin-face))
 274              (list (concat "\\<\\(storage\\)\\.\\(\\sw+\\)\\."
 275                            (regexp-opt
 276                             '("free_space"
 277                               "used_space"
 278                               "happy")
 279                             t))
 280                '(1 font-lock-builtin-face)
 281                '(2 font-lock-variahle-name-face)
 282                '(3 font-lock-builtin-face))
 283
 284              (cons
 285               (concat "\\<"
 286                       (regexp-opt
 287                        '("req"
 288                          "resp"
 289                          "bereq"
 290                          "beresp"
 291                          "client"
 292                          "server"
 293                          "obj"
 294                          "now"))
 295                       "\\>")
 296               'font-lock-builtin-face)
 297
 298              ;; Function calls
 299              '("\\<\\(\\(\\sw+\\)\\.\\)*\\(\\sw+\\)[ \t]*("
 300                (2 font-lock-variable-name-face nil t)
 301                (3 font-lock-function-name-face))
 302
 303              ;; Constants
 304              '("\\<\\([[:digit:]]+\\(\\.[[:digit:]]+\\)?\\)[ \t]*\\(ms\\|[smhdwy]\\)?\\>"
 305                (1 font-lock-constant-face) (3 font-lock-builtin-face nil t)))))
 306   "Medium level highlighting for VCL buffers.")
 307
 308 (defconst vcl-font-lock-keywords-3
 309   (append vcl-font-lock-keywords-2
 310           (eval-when-compile
 311             (list
 312              ;; User function names.
 313              '("^[ \t]*\\(sub\\)\\>[ \t]*\\(\\sw+\\)?"
 314                (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)))))
 315   "Gaudy level highlighting for VCL buffers.")
 316
 317 (defvar vcl-font-lock-keywords vcl-font-lock-keywords-3)
 318
 319 (put 'vcl-mode 'c-mode-prefix "vcl-")
 320
 321 (defconst vcl-syntax-propertize-function
 322   (syntax-propertize-rules
 323    ("\\({\\)\""
 324     (1 (when (null (nth 8 (save-excursion
 325                             (syntax-ppss (match-beginning 0)))))
 326          (string-to-syntax "|"))))
 327    ("\"\\(}\\)"
 328     (1 (when (eq t (nth 3 (save-excursion
 329                             (syntax-ppss (match-beginning 0)))))
 330          (string-to-syntax "|"))))))
 331
 332 (defun vcl-match-paren (&optional arg)
 333   ;; FIXME: Assuming syntax-propertize works correctly, forward-sexp and
 334   ;; backward-sexp should do the trick!
 335   "If point is on a parenthesis (including VCL multi-line string delimiter),
 336 find the matching one and move point to it.
 337 With ARG, do it that many times."
 338  (interactive "p")
 339  (let ((n (or arg 1))
 340        (matcher (cond
 341                  ((looking-at "\\s(")
 342                   (cons
 343                    (let ((s (match-string 0)))
 344                      (lambda ()
 345                        (search-forward s)
 346                        (backward-char)))
 347                    (lambda ()
 348                      (forward-list)
 349                      (backward-char))))
 350                  ((looking-at "\\s)")
 351                   (cons
 352                    (let ((s (match-string 0)))
 353                      (lambda ()
 354                        (search-backward s)))
 355                    (lambda ()
 356                      (forward-char)
 357                      (backward-list))))
 358                  ((or (looking-at "{\"")
 359                       (save-excursion
 360                         (backward-char)
 361                         (looking-at "{\"")))
 362                   (cons
 363                    (lambda ()
 364                      (search-forward "{\""))
 365                    (lambda ()
 366                      (search-forward-regexp "\"}")
 367                      (backward-char))))
 368                  ((or (looking-at "\"}")
 369                       (save-excursion
 370                         (backward-char)
 371                         (looking-at "\"}")))
 372                   (cons
 373                    (lambda ()
 374                      (search-backward "\"}"))
 375                    (lambda ()
 376                      (search-backward-regexp "{\"")))))))
 377    (if (not matcher)
 378        (message "Point not at parenthesis")
 379      (condition-case err
 380          (let ((fx (car matcher))
 381                (fn (cdr matcher)))
 382            (catch 'stop
 383              (while t
 384                (funcall fn)
 385                (setq n (1- n))
 386                (if (= n 0)
 387                    (throw 'stop t)
 388                  (condition-case nil
 389                      (funcall fx)
 390                    (search-failed
 391                     (message "Not enough groups to satisfy the request")
 392                     (throw 'stop t)))))))
 393
 394        (scan-error (goto-char (nth 2 err))
 395                    (message "%s" (nth 1 err)))
 396        (search-failed (message "Unbalanced %s" (cdr err)))))))
 397
 398 ;;;###autoload
 399 (add-to-list 'auto-mode-alist (cons (purecopy "\\.vcl\\'")  'vcl-mode))
 400
 401 ;;;###autoload
 402 (define-derived-mode vcl-mode prog-mode "VCL"
 403   "Major mode for editing Varnish Configuration Language code.
 404
 405 Key bindings:
 406 \\{vcl-mode-map}"
 407   :abbrev-table vcl-mode-abbrev-table
 408   (set (make-local-variable 'syntax-propertize-function)
 409        vcl-syntax-propertize-function)
 410   (set (make-local-variable 'parse-sexp-lookup-properties) t)
 411
 412   (c-initialize-cc-mode t)
 413   (c-lang-setvar comment-start "# ")
 414   (setq c-opt-cpp-prefix nil)
 415   (setq abbrev-mode t)
 416   (c-init-language-vars vcl-mode)
 417   (c-common-init 'vcl-mode)
 418
 419   (run-mode-hooks 'c-mode-common-hook 'vcl-mode-hook)
 420   (c-update-modeline))
 421
 422 ;;;; ChangeLog:
 423
 424 ;; 2018-11-30  Stefan Monnier  <monnier@iro.umontreal.ca>
 425 ;;
 426 ;;      * vcl-mode/vcl-mode.el: Simplify syntax handling; plus cosmetics
 427 ;;
 428 ;;      Use lexical-binding.  Don't require `cl`.
 429 ;;      (vcl-mode-map): Move initialization into declaration.  Don't rely on
 430 ;;      CC-mode's c-make-inherited-keymap.
 431 ;;      (vcl-mode-syntax-table): Use comment style b for `#` and mark `"` as a
 432 ;;      string delimiter.
 433 ;;      (vcl-mode-abbrev-table): Simplify definition.
 434 ;;      (vcl-font-lock-keywords-2): Don't request explicit subgroups if not
 435 ;;      used.
 436 ;;      (vcl-sharp-comment-syntax): Remove function.
 437 ;;      (vcl-syntax-propertize-function): Remove special cases for `#` and `"`.
 438 ;;      Refine `{"` and `"}` to filter out false positives.
 439 ;;      (vcl-match-paren): Use match-string.
 440 ;;      (vcl-mode): Let define-derived-mode set syntax-table, local-map, and
 441 ;;      abbrev-table.  Use run-mode-hooks.
 442 ;;
 443 ;; 2018-11-29  Stefan Monnier  <monnier@iro.umontreal.ca>
 444 ;;
 445 ;;      * vcl-mode.el: Update header and fix last line; improve commentary
 446 ;;
 447 ;; 2018-11-29  Stefan Monnier  <monnier@iro.umontreal.ca>
 448 ;;
 449 ;;      Add 'packages/vcl-mode/' from commit
 450 ;;      'd6bba7c13e0d72936001f5adea155256151339ac'
 451 ;;
 452 ;;      git-subtree-dir: packages/vcl-mode git-subtree-mainline:
 453 ;;      c0c44c3c0ded215e5bc60da74e2aaa090a35617b git-subtree-split:
 454 ;;      d6bba7c13e0d72936001f5adea155256151339ac
 455 ;;
 456
 457
 458 (provide 'vcl-mode)
 459 ;;; vcl-mode.el ends here