emacs_el/vcl-mode.el

   1 ;;; vcl-mode.el - Syntax highlighting for Varnish Command Language
   2 ;;;
   3 ;;; Copyright (c) 2008-2009 Linpro AS
   4 ;;; All rights reserved.
   5 ;;;
   6 ;;; Author: Stig Sandbeck Mathisen <ssm@linpro.no>
   7 ;;;
   8 ;;; Redistribution and use in source and binary forms, with or without
   9 ;;; modification, are permitted provided that the following conditions
  10 ;;; are met:
  11 ;;; 1. Redistributions of source code must retain the above copyright
  12 ;;;    notice, this list of conditions and the following disclaimer.
  13 ;;; 2. Redistributions in binary form must reproduce the above
  14 ;;;    copyright notice, this list of conditions and the following
  15 ;;;    disclaimer in the documentation and/or other materials provided
  16 ;;;    with the distribution.
  17 ;;;
  18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''
  19 ;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
  20 ;;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
  21 ;;; PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL AUTHOR OR
  22 ;;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  23 ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  24 ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
  25 ;;; USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
  26 ;;; AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  27 ;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  28 ;;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  29 ;;; POSSIBILITY OF SUCH DAMAGE.
  30 ;;;
  31 ;;; $Id$
  32 ;;;
  33
  34 (defgroup vcl nil
  35   "Customizations for vcl-mode")
  36
  37 (defcustom vcl-indent-level 8
  38   "*The level of indentation (number of space characters) in VCL-mode."
  39   :type 'integer  :group 'vcl)
  40
  41 (defcustom vcl-indent-tabs-mode nil
  42   "*Allow tabs when indentation in vcl-mode if non-nil"
  43   :type 'boolean :group 'vcl)
  44
  45 ;; I just love standards, there are so many to choose from
  46 (if (string-match "XEmacs\\|Lucid" emacs-version)
  47     (require 'generic-mode)
  48   (require 'generic))
  49
  50 ;; Add a VCL major mode called "vcl-mode", based on generic-mode
  51
  52 (define-generic-mode 'vcl-mode
  53   ;; comments (defined in "vcl-mode-setup-function"
  54   nil
  55   ;; keywords (defined under "others" instead)
  56   nil
  57   ;; others
  58   (list
  59    ;; Logic
  60    (generic-make-keywords-list
  61     (list
  62      "else"
  63      "elsif"
  64      "if"
  65      "remove"
  66      "set"
  67      )
  68     'font-lock-keyword-face)
  69
  70    ;; Types
  71    (generic-make-keywords-list
  72     (list
  73      "purge_url"
  74      "regsub"
  75      )
  76     'font-lock-builtin-face)
  77
  78    ;; VCL Functions
  79    (generic-make-keywords-list
  80     (list
  81      "acl"
  82      "backend"
  83      "sub"
  84      "vcl_deliver"
  85      "vcl_discard"
  86      "vcl_fetch"
  87      "vcl_hash"
  88      "vcl_hit"
  89      "vcl_miss"
  90      "vcl_pass"
  91      "vcl_pipe"
  92      "vcl_recv"
  93      "vcl_timeout"
  94      )
  95     'font-lock-function-name-face)
  96
  97    ;; Actions
  98    (generic-make-keywords-list
  99     (list
 100      "deliver"
 101      "discard"
 102      "error"
 103      "fetch"
 104      "hash"
 105      "keep"
 106      "lookup"
 107      "pass"
 108      "pipe"
 109      )
 110     'font-lock-function-name-face)
 111
 112    ;; Variables
 113    (generic-make-keywords-list
 114     (list
 115      "backend.host"
 116      "backend.port"
 117      "bereq.proto"
 118      "bereq.request"
 119      "bereq.url"
 120      "client.ip"
 121      "now"
 122      "obj.cacheable"
 123      "obj.lastuse"
 124      "obj.proto"
 125      "obj.response"
 126      "obj.status"
 127      "obj.ttl"
 128      "obj.valid"
 129      "req.backend"
 130      "req.hash"
 131      "req.proto"
 132      "req.request"
 133      "req.url"
 134      "resp.proto"
 135      "resp.response"
 136      "resp.status"
 137      "server.ip"
 138      )
 139     'font-lock-variable-name-face)
 140
 141    ;; More variables
 142    '("\\(\\(be\\)?req\\|resp\\|obj\\)\.http\.[A-Za-z-]+" .
 143      font-lock-variable-name-face))
 144
 145   ;; Filenames to highlight
 146   '("\\.vcl\\'")
 147   (list 'vcl-mode-setup-function)
 148   "Mode for Varnish Command Language")
 149
 150
 151 ;; A function to modify syntax, add a hook if needed, and setup
 152 ;; indentation.
 153
 154 (defun vcl-mode-setup-function ()
 155   ;; These are "part of words"
 156   (modify-syntax-entry ?_ "w")
 157   (modify-syntax-entry ?. "w")
 158
 159   ;; C++-style comments
 160   (modify-syntax-entry ?/ ". 124")
 161   (modify-syntax-entry ?* ". 23b")
 162
 163   ;; Perl-style comments
 164   (modify-syntax-entry ?# "<")
 165   (modify-syntax-entry ?\n ">")
 166
 167   (run-hooks 'vcl-mode-hook)
 168   (set (make-local-variable 'indent-line-function) 'vcl-indent-line)
 169   (setq indent-tabs-mode vcl-indent-tabs-mode)
 170   )
 171
 172 (defvar vcl-mode-hook nil)
 173
 174 (defun vcl-indent-line ()
 175   "Indent the current VCL line according to syntax."
 176   (interactive)
 177   (indent-line-to
 178    (max (vcl-calculate-indentation) 0)))
 179
 180
 181 ;; The function to calculate indentation level.  This is a really
 182 ;; simple and naive function, and does not perform anything like a
 183 ;; syntax check.
 184 (defun vcl-calculate-indentation ()
 185   "Return the column to which the current line should be indented."
 186   (interactive)
 187   (save-excursion
 188                                         ; Do not indent the first line.
 189     (if (vcl-first-line-p) 0
 190                                         ; Reduce indent level if we
 191                                         ; close a block on this line
 192       (if (vcl-closing-tag-on-this-line-p)
 193           (- (vcl-previous-line-indentation)
 194              vcl-indent-level)
 195                                         ; Increase indent level if a
 196                                         ; block opened on the previous
 197                                         ; line
 198         (if (vcl-opening-tag-on-previous-line-p)
 199             (+ (vcl-previous-line-indentation)
 200                vcl-indent-level)
 201                                         ; By default, indent to the
 202                                         ; level of the previous
 203                                         ; non-empty line
 204           (vcl-previous-line-indentation))))))
 205
 206 (defun vcl-opening-tag-on-previous-line-p ()
 207   "Checks if we have an opening tag on the previous line."
 208   (interactive)
 209   (save-excursion
 210     (beginning-of-line)
 211     (skip-chars-backward " \t\n")
 212     (beginning-of-line)
 213     (if (and (looking-at ".*{[ \t]*$")
 214              (not (vcl-comment-p)))
 215         t)))
 216
 217 (defun vcl-closing-tag-on-this-line-p ()
 218   "Checks if we have a closing tag on this line."
 219   (interactive)
 220   (save-excursion
 221     (back-to-indentation)
 222     (looking-at "}")))
 223
 224 (defun vcl-previous-line-indentation ()
 225   "Return the indent level of the previous line."
 226   (interactive)
 227   (save-excursion
 228     (beginning-of-line)
 229     (skip-chars-backward " \t\n")
 230     (back-to-indentation)
 231     (current-column)))
 232
 233 (defun vcl-comment-p ()
 234   "Checks if we have a commented line."
 235   (interactive)
 236   (save-excursion
 237     (beginning-of-line)
 238     (looking-at "^[ \t]*#")))
 239
 240 (defun vcl-first-line-p ()
 241   "Checks if we are on the first line."
 242   (interactive)
 243   (save-excursion
 244     (beginning-of-line)
 245     (eq (point) 1)))
 246
 247 (provide 'vcl-mode)