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

   1 ;;; antlr-mode.el --- Major mode for ANTLR grammar files
   2
   3 ;; Copyright (C) 1999 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Christoph.Wedler@sap.com
   6 ;; Version: $Id: antlr-mode.el,v 1.2 1999/12/16 19:30:34 wedler Exp $
   7 ;; X-URL: http://www.fmi.uni-passau.de/~wedler/antlr-mode/
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Major mode for editing ANTLR grammar files, i.e., files ending with `.g'.
  29 ;; ANTLR is ANother Tool for Language Recognition (an excellent alternative to
  30 ;; lex/yacc), see <http://www.ANTLR.org> and <news:comp.compilers.tools.pccts>.
  31
  32 ;; Variable `antlr-language' is set according to the language in actions and
  33 ;; semantic predicates of the grammar (see ANTLR's file option "language").
  34 ;; The supported languages are "Java" (java-mode) and "Cpp" (c++-mode).  This
  35 ;; package uses features of the Emacs package cc-mode.
  36
  37 ;; This package provides the following features:
  38 ;;  * Indentation for the current line (TAB) and selected region (C-M-\).
  39 ;;  * Syntax coloring (via font-lock) with language dependent coloring.
  40 ;;  * Support for imenu/speedbar: menu "Index" (Parser, Lexer, TreeParser).
  41 ;;  * Direct move to previous/next rule, beginning/end of rule body etc.
  42
  43 ;; INDENTATION.  This package supports ANTLR's (intended) indentation style
  44 ;; which is based on a simple paren/brace/bracket depth-level calculation, see
  45 ;; `antlr-indent-line'.  The indentation engine of cc-mode is only used inside
  46 ;; block comments (it is not easy to use it for actions, esp if they come early
  47 ;; in the rule body).  By default, this package uses TABs for a basic offset of
  48 ;; 4 to be consistent to both ANTLR's conventions (TABs usage) and the
  49 ;; `c-indentation-style' "java" which sets `c-basic-offset' to 4, see
  50 ;; `antlr-tab-offset-alist'.
  51
  52 ;; SYNTAX COLORING comes in three phases.  First, comments and strings are
  53 ;; highlighted.  Second, the grammar code is highlighted according to
  54 ;; `antlr-font-lock-additional-keywords' (rule refs: blue, token refs: brown,
  55 ;; definition: ditto+bold).  Third, actions, semantic predicates and arguments
  56 ;; are highlighted according to the usual font-lock keywords of
  57 ;; `antlr-language', see also `antlr-font-lock-maximum-decoration'.  We define
  58 ;; special font-lock faces for the grammar code to allow you to distinguish
  59 ;; ANTLR keywords from Java/C++ keywords.
  60
  61 ;; Bug fixes, bug reports, improvements, and suggestions are strongly
  62 ;; appreciated.  Please check the newest version first:
  63 ;;   http://www.fmi.uni-passau.de/~wedler/antlr-mode/changes.html
  64
  65 ;;; Installation:
  66
  67 ;; This file requires Emacs-20.3, XEmacs-20.4 or higher.
  68
  69 ;; If antlr-mode is not part of your distribution, put this file into your
  70 ;; load-path and the following into your ~/.emacs:
  71 ;;   (autoload 'antlr-mode "antlr-mode" nil t)
  72 ;;   (setq auto-mode-alist (cons '("\\.g\\'" . antlr-mode) auto-mode-alist))
  73 ;;   (add-hook 'speedbar-load-hook  ; would be too late in antlr-mode.el
  74 ;;             (lambda () (speedbar-add-supported-extension ".g")))
  75
  76 ;; If you edit ANTLR's source files, you might also want to use
  77 ;;   (autoload 'antlr-set-tabs "antlr-mode")
  78 ;;   (add-hook 'java-mode-hook 'antlr-set-tabs)
  79
  80 ;; To customize, use `M-x customize-group RET antlr RET' or the custom browser
  81 ;; (Emacs->Programming->Languages->Antlr).
  82
  83 ;;; Code:
  84
  85 (provide 'antlr-mode)
  86 (eval-when-compile (require 'cl))
  87 (require 'easymenu)                     ; Emacs
  88 (eval-when-compile (require 'cc-mode))  ; shut up most warnings
  89
  90 (eval-and-compile
  91   (if (string-match "XEmacs" emacs-version)
  92       (defalias 'antlr-scan-sexps 'scan-sexps)
  93     (defalias 'antlr-scan-sexps 'antlr-scan-sexps-internal))
  94   (if (and (fboundp 'buffer-syntactic-context)
  95            (fboundp 'buffer-syntactic-context-depth))
  96       (progn
  97         (defalias 'antlr-invalidate-context-cache 'antlr-xemacs-bug-workaround)
  98         (defalias 'antlr-syntactic-context 'antlr-fast-syntactic-context))
  99     (defalias 'antlr-invalidate-context-cache 'ignore)
 100     (defalias 'antlr-syntactic-context 'antlr-slow-syntactic-context)))
 101
 102
 103
 104 ;;;;##########################################################################
 105 ;;;;  Variables
 106 ;;;;##########################################################################
 107
 108
 109 (defgroup antlr nil
 110   "Major mode for ANTLR grammar files."
 111   :group 'languages
 112   :link '(emacs-commentary-link "antlr-mode.el")
 113   :link '(url-link "http://www.fmi.uni-passau.de/~wedler/antlr-mode/")
 114   :prefix "antlr-")
 115
 116 (defconst antlr-version "1.2"
 117   "ANTLR major mode version number.")
 118
 119
 120 ;;;===========================================================================
 121 ;;;  Controlling ANTLR's code generator (language option)
 122 ;;;===========================================================================
 123
 124 (defvar antlr-language nil
 125   "Major mode corresponding to ANTLR's \"language\" option.
 126 Set via `antlr-language-alist'.  The only useful place to change this
 127 buffer-local variable yourself is in `antlr-mode-hook' or in the \"local
 128 variable list\" near the end of the file, see
 129 `enable-local-variables'.")
 130
 131 (defcustom antlr-language-alist
 132   '((java-mode "Java" nil "Java")
 133     (c++-mode "C++" "Cpp"))
 134   "List of ANTLR's supported languages.
 135 Each element in this list looks like
 136   (MAJOR-MODE MODELINE-STRING OPTION-VALUE...)
 137
 138 MAJOR-MODE, the major mode of the code in the grammar's actions, is the
 139 value of `antlr-language' if the first regexp group matched by REGEXP in
 140 `antlr-language-limit-n-regexp' is one of the OPTION-VALUEs.  An
 141 OPTION-VALUE of nil denotes the fallback element.  MODELINE-STRING is
 142 also displayed in the modeline next to \"Antlr\"."
 143   :group 'antlr
 144   :type '(repeat (group :value (java-mode "")
 145                         (function :tag "Major mode")
 146                         (string :tag "Modeline string")
 147                         (repeat :tag "ANTLR language option" :inline t
 148                                 (choice (const :tag "Default" nil)
 149                                         string )))))
 150
 151 (defcustom antlr-language-limit-n-regexp
 152   '(3000 . "language[ \t]*=[ \t]*\"\\([A-Z][A-Za-z_]*\\)\"")
 153   "Used to set a reasonable value for `antlr-language'.
 154 Looks like (LIMIT . REGEXP).  Search for REGEXP from the beginning of
 155 the buffer to LIMIT to set the language according to
 156 `antlr-language-alist'."
 157   :group 'antlr
 158   :type '(cons (choice :tag "Limit" (const :tag "No" nil) (integer :value 0))
 159                regexp))
 160
 161
 162 ;;;===========================================================================
 163 ;;;  Indent/Tabs
 164 ;;;===========================================================================
 165
 166 (defcustom antlr-indent-comment 'tab
 167   "*Non-nil, if the indentation should touch lines in block comments.
 168 If nil, no continuation line of a block comment is changed.  If t, they
 169 are changed according to `c-indentation-line'.  When not nil and not t,
 170 they are only changed by \\[antlr-indent-command]."
 171   :group 'antlr
 172   :type '(radio (const :tag "No" nil)
 173                 (const :tag "Always" t)
 174                 (sexp :tag "With TAB" :format "%t" :value tab)))
 175
 176 (defcustom antlr-tab-offset-alist
 177   '((antlr-mode nil 4 t)
 178     (java-mode "antlr" 4 t))
 179   "Alist to determine whether to use ANTLR's convention for TABs.
 180 Each element looks like (MAJOR-MODE REGEXP TAB-WIDTH INDENT-TABS-MODE).
 181 The first element whose MAJOR-MODE is nil or equal to `major-mode' and
 182 whose REGEXP is nil or matches `buffer-file-name' is used to set
 183 `tab-width' and `indent-tabs-mode'.  This is useful to support both
 184 ANTLR's and Java's indentation styles.  Used by `antlr-set-tabs'."
 185   :group 'antlr
 186   :type '(repeat (group :value (antlr-mode nil 8 nil)
 187                         (choice (const :tag "All" nil)
 188                                 (function :tag "Major mode"))
 189                         (choice (const :tag "All" nil) regexp)
 190                         (integer :tag "Tab width")
 191                         (boolean :tag "Indent-tabs-mode"))))
 192
 193 (defvar antlr-indent-item-regexp
 194   "[]}):;|&]\\|default[ \t]*:\\|case[ \t]+\\('\\\\?.'\\|[0-9]+\\|[A-Za-z_][A-Za-z_0-9]*\\)[ \t]*:" ; & is local ANTLR extension
 195   "Regexp matching lines which should be indented by one TAB less.
 196 See command \\[antlr-indent-command].")
 197
 198
 199 ;;;===========================================================================
 200 ;;;  Menu
 201 ;;;===========================================================================
 202
 203 (defcustom antlr-imenu-name t
 204   "*Non-nil, if a \"Index\" menu should be added to the menubar.
 205 If it is a string, it is used instead \"Index\".  Requires package
 206 imenu."
 207   :group 'antlr
 208   :type '(choice (const :tag "No menu" nil)
 209                  (const :tag "Index menu" t)
 210                  (string :tag "Other menu name")))
 211
 212 (defvar antlr-mode-map
 213   (let ((map (make-sparse-keymap)))
 214     (define-key map "\t" 'antlr-indent-command)
 215     (define-key map "\e\C-a" 'antlr-beginning-of-rule)
 216     (define-key map "\e\C-e" 'antlr-end-of-rule)
 217     (define-key map "\C-c\C-a" 'antlr-beginning-of-body)
 218     (define-key map "\C-c\C-e" 'antlr-end-of-body)
 219     (define-key map "\C-c\C-f" 'c-forward-into-nomenclature)
 220     (define-key map "\C-c\C-b" 'c-backward-into-nomenclature)
 221     (define-key map "\C-c\C-c" 'comment-region)
 222     ;; I'm too lazy to define my own:
 223     (define-key map "\ea" 'c-beginning-of-statement)
 224     (define-key map "\ee" 'c-end-of-statement)
 225     map)
 226   "Keymap used in `antlr-mode' buffers.")
 227
 228 (easy-menu-define antlr-mode-menu
 229                   antlr-mode-map
 230                   "Major mode menu."
 231                   '("Antlr"
 232                     ["Indent Line" antlr-indent-command
 233                      :active (not buffer-read-only)]
 234                     ["Indent for Comment" indent-for-comment
 235                      :active (not buffer-read-only)]
 236                     ["Comment Out Region" comment-region
 237                      :active (and (not buffer-read-only)
 238                                   (c-region-is-active-p))]
 239                     ["Uncomment Region"
 240                      (comment-region (region-beginning) (region-end) '(4))
 241                      :active (and (not buffer-read-only)
 242                                   (c-region-is-active-p))]
 243                     "---"
 244                     ["Backward Rule" antlr-beginning-of-rule t]
 245                     ["Forward Rule" antlr-end-of-rule t]
 246                     ["Start of Rule Body" antlr-beginning-of-body
 247                      :active (antlr-inside-rule-p)]
 248                     ["End of Rule Body" antlr-end-of-body
 249                      :active (antlr-inside-rule-p)]
 250                     "---"
 251                     ["Backward Statement" c-beginning-of-statement t]
 252                     ["Forward Statement" c-end-of-statement t]
 253                     ["Backward Into Nomencl." c-backward-into-nomenclature t]
 254                     ["Forward Into Nomencl." c-forward-into-nomenclature t]))
 255
 256
 257 ;;;===========================================================================
 258 ;;;  font-lock
 259 ;;;===========================================================================
 260
 261 (defcustom antlr-font-lock-maximum-decoration 'inherit
 262   "*The maximum decoration level for fontifying actions.
 263 Value `none' means, do not fontify actions, just normal grammar code
 264 according to `antlr-font-lock-additional-keywords'.  Value `inherit'
 265 means, use value of `font-lock-maximum-decoration'.  Any other value is
 266 interpreted as in `font-lock-maximum-decoration' with no level-0
 267 fontification, see `antlr-font-lock-keywords-alist'.
 268
 269 While calculating the decoration level for actions, `major-mode' is
 270 bound to `antlr-language'.  For example, with value
 271   ((java-mode . 2) (c++-mode . 0))
 272 Java actions are fontified with level 2 and C++ actions are not
 273 fontified at all."
 274   :type '(choice (const :tag "none" none)
 275                  (const :tag "inherit" inherit)
 276                  (const :tag "default" nil)
 277                  (const :tag "maximum" t)
 278                  (integer :tag "level" 1)
 279                  (repeat :menu-tag "mode specific" :tag "mode specific"
 280                          :value ((t . t))
 281                          (cons :tag "Instance"
 282                                (radio :tag "Mode"
 283                                       (const :tag "all" t)
 284                                       (symbol :tag "name"))
 285                                (radio :tag "Decoration"
 286                                       (const :tag "default" nil)
 287                                       (const :tag "maximum" t)
 288                                       (integer :tag "level" 1))))))
 289
 290 (defvar antlr-font-lock-keywords-alist
 291   '((java-mode
 292      (list)                             ; nil won't work (would use level-3)
 293      java-font-lock-keywords-1 java-font-lock-keywords-2
 294      java-font-lock-keywords-3)
 295     (c++-mode
 296      (list)                             ; nil won't work (would use level-3)
 297      c++-font-lock-keywords-1 c++-font-lock-keywords-2
 298      c++-font-lock-keywords-3))
 299   "List of font-lock keywords for actions in the grammar.
 300 Each element in this list looks like
 301   (MAJOR-MODE KEYWORD...)
 302
 303 If `antlr-language' is equal to MAJOR-MODE, the KEYWORDs are the
 304 font-lock keywords according to `font-lock-defaults' used for the code
 305 in the grammar's actions and semantic predicates, see
 306 `antlr-font-lock-maximum-decoration'.")
 307
 308 (defvar antlr-font-lock-keyword-face 'antlr-font-lock-keyword-face)
 309 (defface antlr-font-lock-keyword-face
 310   '((((class color) (background light)) (:foreground "black" :bold t)))
 311   "ANTLR keywords."
 312   :group 'antlr)
 313
 314 (defvar antlr-font-lock-ruledef-face 'antlr-font-lock-ruledef-face)
 315 (defface antlr-font-lock-ruledef-face
 316   '((((class color) (background light)) (:foreground "blue" :bold t)))
 317   "ANTLR rule references (definition)."
 318   :group 'antlr)
 319
 320 (defvar antlr-font-lock-tokendef-face 'antlr-font-lock-tokendef-face)
 321 (defface antlr-font-lock-tokendef-face
 322   '((((class color) (background light)) (:foreground "brown3" :bold t)))
 323   "ANTLR token references (definition)."
 324   :group 'antlr)
 325
 326 (defvar antlr-font-lock-ruleref-face 'antlr-font-lock-ruleref-face)
 327 (defface antlr-font-lock-ruleref-face
 328   '((((class color) (background light)) (:foreground "blue4")))
 329   "ANTLR rule references (usage)."
 330   :group 'antlr)
 331
 332 (defvar antlr-font-lock-tokenref-face 'antlr-font-lock-tokenref-face)
 333 (defface antlr-font-lock-tokenref-face
 334   '((((class color) (background light)) (:foreground "brown4")))
 335   "ANTLR token references (usage)."
 336   :group 'antlr)
 337
 338 (defvar antlr-font-lock-literal-face 'antlr-font-lock-literal-face)
 339 (defface antlr-font-lock-literal-face
 340   '((((class color) (background light)) (:foreground "brown4" :bold t)))
 341   "ANTLR literal tokens consisting merely of letter-like characters."
 342   :group 'antlr)
 343
 344 (defvar antlr-font-lock-additional-keywords
 345   `((antlr-invalidate-context-cache)
 346     ("\\$setType[ \t]*(\\([A-Z\300-\326\330-\337]\\sw*\\))"
 347      (1 antlr-font-lock-tokendef-face))
 348     ("\\$\\sw+" (0 font-lock-keyword-face))
 349     ;; the tokens are already fontified as string/docstrings:
 350     (,(lambda (limit)
 351         (antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" limit))
 352      (1 antlr-font-lock-literal-face t))
 353     (,(lambda (limit)
 354         (antlr-re-search-forward
 355          "^\\(class\\)[ \t]+\\([A-Z\300-\326\330-\337]\\sw*\\)[ \t]+\\(extends\\)[ \t]+\\([A-Z\300-\326\330-\337]\\sw*\\)[ \t]*;" limit))
 356      (1 antlr-font-lock-keyword-face)
 357      (2 antlr-font-lock-ruledef-face)
 358      (3 antlr-font-lock-keyword-face)
 359      (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
 360             'antlr-font-lock-keyword-face
 361           'font-lock-type-face)))
 362     (,(lambda (limit)
 363         (antlr-re-search-forward
 364          "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
 365          limit))
 366      (1 antlr-font-lock-keyword-face))
 367     (,(lambda (limit)
 368         (antlr-re-search-forward
 369          "^\\(private\\|public\\|protected\\)\\>\\([ \t]+\\(\\sw+\\)\\)?"
 370          limit))
 371      (1 font-lock-type-face)            ; not XEmacs' java level-3 fruit salad
 372      (3 (if (antlr-upcase-p (char-after (match-beginning 3)))
 373             'antlr-font-lock-tokendef-face
 374           'antlr-font-lock-ruledef-face) nil t))
 375     (,(lambda (limit)
 376         (antlr-re-search-forward "^\\sw+" limit))
 377      (0 (if (antlr-upcase-p (char-after (match-beginning 0)))
 378             'antlr-font-lock-tokendef-face
 379           'antlr-font-lock-ruledef-face) nil t))
 380     (,(lambda (limit)
 381         ;; not only before a rule ref, also before a literal
 382         (antlr-re-search-forward "\\<\\(\\sw+\\)[ \t]*:" limit))
 383      (1 font-lock-variable-name-face))
 384     (,(lambda (limit)
 385         (antlr-re-search-forward "\\<\\(\\sw+[ \t]*=[ \t]*\\)?\\(\\sw+[ \t]*:[ \t]*\\)?\\(\\sw+\\)" limit))
 386      ;;(1 antlr-font-lock-default-face nil t) ; fool java-font-lock-keywords
 387      (3 (if (antlr-upcase-p (char-after (match-beginning 3)))
 388             'antlr-font-lock-tokenref-face
 389           'antlr-font-lock-ruleref-face))))
 390   "Font-lock keywords for ANTLR's normal grammar code.
 391 See `antlr-font-lock-keywords-alist' for the keywords of actions.")
 392
 393 (defvar antlr-font-lock-defaults
 394   '(antlr-font-lock-keywords
 395     nil nil ((?_ . "w") (?\( . ".") (?\) . ".")) beginning-of-defun)
 396   "Font-lock defaults used for ANTLR syntax coloring.
 397 The SYNTAX-ALIST element is also used to initialize
 398 `antlr-action-syntax-table'.")
 399
 400
 401 ;;;===========================================================================
 402 ;;;  Internal variables
 403 ;;;===========================================================================
 404
 405 (defvar antlr-mode-hook nil
 406   "Hook called by `antlr-mode'.")
 407
 408 ;; used for "in Java/C++ code" = syntactic-depth>0
 409 (defvar antlr-action-syntax-table nil
 410   "Syntax table used for ANTLR action parsing.
 411 Initialized by `java-mode-syntax-table', i.e., the syntax table used for
 412 grammar files, changed by SYNTAX-ALIST in `antlr-font-lock-defaults'.
 413 This table should be selected if you use `buffer-syntactic-context' and
 414 `buffer-syntactic-context-depth' in order not to confuse their
 415 context_cache.")
 416
 417 (defvar antlr-mode-abbrev-table nil
 418   "Abbreviation table used in `antlr-mode' buffers.")
 419 (define-abbrev-table 'antlr-mode-abbrev-table ())
 420
 421
 422
 423 ;;;;##########################################################################
 424 ;;;;  The Code
 425 ;;;;##########################################################################
 426
 427
 428 ;;;===========================================================================
 429 ;;;  Syntax functions -- Emacs vs XEmacs dependent
 430 ;;;===========================================================================
 431
 432 ;; From help.el (XEmacs-21.1)
 433 (defmacro antlr-with-syntax-table (syntab &rest body)
 434   `(let ((stab (syntax-table)))
 435      (unwind-protect
 436          (progn (set-syntax-table (copy-syntax-table ,syntab)) ,@body)
 437        (set-syntax-table stab))))
 438 (put 'antlr-with-syntax-table 'lisp-indent-function 1)
 439 (put 'antlr-with-syntax-table 'edebug-form-spec '(form body))
 440
 441 (defun antlr-scan-sexps-internal (from count &optional dummy no-error)
 442 ;; checkdoc-params: (from count dummy)
 443   "Like `scan-sexps' but with additional arguments.
 444 When optional arg NO-ERROR is non-nil, `scan-sexps' will return nil
 445 instead of signaling an error."
 446   (if no-error
 447       (condition-case nil
 448           (scan-sexps from count)
 449         (t nil))
 450     (scan-sexps from count)))
 451
 452 (defun antlr-xemacs-bug-workaround (&rest dummies)
 453 ;; checkdoc-params: (dummies)
 454   "Invalidate context_cache for syntactical context information."
 455   ;; XEmacs bug workaround
 456   (save-excursion
 457     (set-buffer (get-buffer-create " ANTLR XEmacs bug workaround"))
 458     (buffer-syntactic-context-depth))
 459   nil)
 460
 461 (defun antlr-fast-syntactic-context ()
 462   "Return some syntactic context information.
 463 Return `string' if point is within a string, `block-comment' or
 464 `comment' is point is within a comment or the depth within all
 465 parenthesis-syntax delimiters at point otherwise.
 466 WARNING: this may alter `match-data'."
 467   (or (buffer-syntactic-context) (buffer-syntactic-context-depth)))
 468
 469 (defun antlr-slow-syntactic-context ()
 470   "Return some syntactic context information.
 471 Return `string' if point is within a string, `block-comment' or
 472 `comment' is point is within a comment or the depth within all
 473 parenthesis-syntax delimiters at point otherwise.
 474 WARNING: this may alter `match-data'."
 475   (let ((orig (point)))
 476     (beginning-of-defun)
 477     (let ((state (parse-partial-sexp (point) orig)))
 478       (goto-char orig)
 479       (cond ((nth 3 state) 'string)
 480             ((nth 4 state) 'comment)    ; block-comment? -- we don't care
 481             (t (car state))))))
 482
 483
 484 ;;;===========================================================================
 485 ;;;  Misc functions
 486 ;;;===========================================================================
 487
 488 (defun antlr-upcase-p (char)
 489   "Non-nil, if CHAR is an uppercase character (if CHAR was a char)."
 490   ;; in XEmacs, upcase only works for ASCII
 491   (or (and (<= ?A char) (<= char ?Z))
 492       (and (<= ?\300 char) (<= char ?\337)))) ; ?\327 is no letter
 493
 494 (defun antlr-re-search-forward (regexp bound)
 495   "Search forward from point for regular expression REGEXP.
 496 Set point to the end of the occurrence found, and return point.  Return
 497 nil if no occurrence was found.  Do not search within comments, strings
 498 and actions/semantic predicates.  BOUND bounds the search; it is a
 499 buffer position.  See also the functions `match-beginning', `match-end'
 500 and `replace-match'."
 501   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
 502   (let ((continue t))
 503     (while (and (re-search-forward regexp bound 'limit)
 504                 (save-match-data
 505                   (if (eq (antlr-syntactic-context) 0) (setq continue nil) t))))
 506     (if continue nil (point))))
 507
 508 (defun antlr-search-forward (string)
 509   "Search forward from point for STRING.
 510 Set point to the end of the occurrence found, and return point.  Return
 511 nil if no occurrence was found.  Do not search within comments, strings
 512 and actions/semantic predicates."
 513   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
 514   (let ((continue t))
 515     (while (and (search-forward string nil 'limit)
 516                 (if (eq (antlr-syntactic-context) 0) (setq continue nil) t)))
 517     (if continue nil (point))))
 518
 519 (defun antlr-search-backward (string)
 520   "Search backward from point for STRING.
 521 Set point to the beginning of the occurrence found, and return point.
 522 Return nil if no occurrence was found.  Do not search within comments,
 523 strings and actions/semantic predicates."
 524   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
 525   (let ((continue t))
 526     (while (and (search-backward string nil 'limit)
 527                 (if (eq (antlr-syntactic-context) 0) (setq continue nil) t)))
 528     (if continue nil (point))))
 529
 530 (defsubst antlr-skip-sexps (count)
 531   "Skip the next COUNT balanced expressions and the comments after it.
 532 Return position before the comments after the last expression."
 533   (goto-char (or (antlr-scan-sexps (point) count nil t) (point-max)))
 534   (prog1 (point)
 535     (c-forward-syntactic-ws)))
 536
 537
 538 ;;;===========================================================================
 539 ;;;  font-lock
 540 ;;;===========================================================================
 541
 542 (defun antlr-font-lock-keywords ()
 543   "Return font-lock keywords for current buffer.
 544 See `antlr-font-lock-additional-keywords', `antlr-language' and
 545 `antlr-font-lock-maximum-decoration'."
 546   (if (eq antlr-font-lock-maximum-decoration 'none)
 547       antlr-font-lock-additional-keywords
 548     (append antlr-font-lock-additional-keywords
 549             (eval (let ((major-mode antlr-language)) ; dynamic
 550                         (font-lock-choose-keywords
 551                          (cdr (assq antlr-language
 552                                     antlr-font-lock-keywords-alist))
 553                          (if (eq antlr-font-lock-maximum-decoration 'inherit)
 554                              font-lock-maximum-decoration
 555                            antlr-font-lock-maximum-decoration)))))))
 556
 557
 558 ;;;===========================================================================
 559 ;;;  imenu support
 560 ;;;===========================================================================
 561
 562 (defun antlr-imenu-create-index-function ()
 563   "Return imenu index-alist for ANTLR grammar files."
 564   (let ((items nil)
 565         (lexer nil)
 566         (parser nil)
 567         (treeparser nil)
 568         (misc nil)
 569         (classes nil)
 570         (semi (point-max)))
 571     ;; Using `imenu-progress-message' would require imenu for compilation --
 572     ;; nobody is missing these messages...
 573     (antlr-with-syntax-table antlr-action-syntax-table
 574       ;; We stick to the imenu standard and search backwards, although I don't
 575       ;; think this is right.  It is slower and more likely not to work during
 576       ;; editing (you are more likely to add functions to the end of the file).
 577       (while semi
 578         (goto-char semi)
 579         (if (setq semi (antlr-search-backward ";"))
 580             (progn (forward-char) (antlr-skip-exception-part t))
 581           (antlr-skip-file-prelude t))
 582         (if (looking-at "{") (antlr-skip-sexps 1))
 583         (if (looking-at "class[ \t]+\\([A-Z\300-\326\330-\337]\\sw*\\)[ \t]+extends[ \t]+\\([A-Z\300-\326\330-\337]\\sw*\\)[ \t]*;")
 584             (progn
 585               (push (cons (match-string 1)
 586                           (if imenu-use-markers
 587                               (copy-marker (match-beginning 1))
 588                             (match-beginning 1)))
 589                     classes)
 590               (if items
 591                   (let ((super (match-string 2)))
 592                     (cond ((string-equal super "Parser")
 593                            (setq parser (nconc items parser)))
 594                           ((string-equal super "Lexer")
 595                            (setq lexer (nconc items lexer)))
 596                           ((string-equal super "TreeParser")
 597                            (setq treeparser (nconc items treeparser)))
 598                           (t
 599                            (setq misc (nconc items misc))))
 600                     (setq items nil))))
 601           (if (looking-at "p\\(ublic\\|rotected\\|rivate\\)")
 602               (antlr-skip-sexps 1))
 603           (when (looking-at "\\sw+")
 604             (push (cons (match-string 0)
 605                         (if imenu-use-markers
 606                             (copy-marker (match-beginning 0))
 607                           (match-beginning 0)))
 608                   items)))))
 609     (or items                           ; outside any class
 610         (prog1 (setq items misc) (setq misc nil))
 611         (prog1 (setq items parser) (setq parser nil))
 612         (prog1 (setq items lexer) (setq lexer nil))
 613         (prog1 (setq items treeparser) (setq treeparser nil)))
 614     (if misc (push (cons "Miscellaneous" misc) items))
 615     (if treeparser (push (cons "TreeParser" treeparser) items))
 616     (if lexer (push (cons "Lexer" lexer) items))
 617     (if parser (push (cons "Parser" parser) items))
 618     (if classes (cons (cons "Classes" classes) items) items)))
 619
 620
 621 ;;;===========================================================================
 622 ;;;  Parse grammar files (internal functions)
 623 ;;;===========================================================================
 624
 625 (defun antlr-skip-exception-part (skip-comment)
 626   "Skip exception part of current rule, i.e., everything after `;'.
 627 This also includes the options and tokens part of a grammar class
 628 header.  If SKIP-COMMENT is non-nil, also skip the comment after that
 629 part."
 630   (let ((pos (point))
 631         (class nil))
 632     (c-forward-syntactic-ws)
 633     (while (looking-at "options\\>\\|tokens\\>")
 634       (setq class t)
 635       (setq pos (antlr-skip-sexps 2)))
 636     (if class
 637         ;; Problem: an action only belongs to a class def, not a normal rule.
 638         ;; But checking the current rule type is too expensive => only expect
 639         ;; an action if we have found an option or tokens part.
 640         (if (looking-at "{") (setq pos (antlr-skip-sexps 1)))
 641       (while (looking-at "exception\\>")
 642         (setq pos (antlr-skip-sexps 1))
 643         (if (looking-at "\\[") (setq pos (antlr-skip-sexps 1)))
 644         (while (looking-at "catch\\>")
 645           (setq pos (antlr-skip-sexps 3)))))
 646     (or skip-comment (goto-char pos))))
 647
 648 (defun antlr-skip-file-prelude (skip-comment)
 649   "Skip the file prelude: the header and file options.
 650 If SKIP-COMMENT is non-nil, also skip the comment after that part."
 651   (let* ((pos (point))
 652          (pos0 pos))
 653     (c-forward-syntactic-ws)
 654     (if skip-comment (setq pos0 (point)))
 655     (if (looking-at "header\\>") (setq pos (antlr-skip-sexps 2)))
 656     (if (looking-at "options\\>") (setq pos (antlr-skip-sexps 2)))
 657     (or skip-comment (goto-char pos))
 658     pos0))
 659
 660 (defun antlr-next-rule (arg skip-comment)
 661   "Move forward to next end of rule.  Do it ARG many times.
 662 A grammar class header and the file prelude are also considered as a
 663 rule.  Negative argument ARG means move back to ARGth preceding end of
 664 rule.  The behavior is not defined when ARG is zero.  If SKIP-COMMENT
 665 is non-nil, move to beginning of the rule."
 666   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
 667   ;; PRE: ARG<>0
 668   (let ((pos (point))
 669         (beg (point)))
 670     ;; first look whether point is in exception part
 671     (if (antlr-search-backward ";")
 672         (progn
 673           (setq beg (point))
 674           (forward-char)
 675           (antlr-skip-exception-part skip-comment))
 676       (antlr-skip-file-prelude skip-comment))
 677     (if (< arg 0)
 678         (unless (and (< (point) pos) (zerop (incf arg)))
 679           ;; if we have moved backward, we already moved one defun backward
 680           (goto-char beg)               ; rewind (to ";" / point)
 681           (while (and arg (<= (incf arg) 0))
 682             (if (antlr-search-backward ";")
 683                 (setq beg (point))
 684               (when (>= arg -1)
 685                 ;; try file prelude:
 686                 (setq pos (antlr-skip-file-prelude skip-comment))
 687                 (if (zerop arg)
 688                     (if (>= (point) beg)
 689                         (goto-char (if (>= pos beg) (point-min) pos)))
 690                   (goto-char (if (or (>= (point) beg) (= (point) pos))
 691                                  (point-min) pos))))
 692               (setq arg nil)))
 693           (when arg                     ; always found a ";"
 694             (forward-char)
 695             (antlr-skip-exception-part skip-comment)))
 696       (if (<= (point) pos)              ; moved backward?
 697           (goto-char pos)               ; rewind
 698         (decf arg))                     ; already moved one defun forward
 699       (unless (zerop arg)
 700         (while (>= (decf arg) 0)
 701           (antlr-search-forward ";"))
 702         (antlr-skip-exception-part skip-comment)))))
 703
 704 (defun antlr-outside-rule-p ()
 705   "Non-nil if point is outside a grammar rule.
 706 Move to the beginning of the current rule if point is inside a rule."
 707   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
 708   (let ((pos (point)))
 709     (antlr-next-rule -1 nil)
 710     (let ((between (or (bobp) (< (point) pos))))
 711       (c-forward-syntactic-ws)
 712       (and between (> (point) pos) (goto-char pos)))))
 713
 714
 715 ;;;===========================================================================
 716 ;;;  Parse grammar files (commands)
 717 ;;;===========================================================================
 718 ;; No (interactive "_") in Emacs... use `zmacs-region-stays'.
 719
 720 (defun antlr-inside-rule-p ()
 721   "Non-nil if point is inside a grammar rule.
 722 A grammar class header and the file prelude are also considered as a
 723 rule."
 724   (save-excursion
 725     (antlr-with-syntax-table antlr-action-syntax-table
 726       (not (antlr-outside-rule-p)))))
 727
 728 (defun antlr-end-of-rule (&optional arg)
 729   "Move forward to next end of rule.  Do it ARG [default: 1] many times.
 730 A grammar class header and the file prelude are also considered as a
 731 rule.  Negative argument ARG means move back to ARGth preceding end of
 732 rule.  If ARG is zero, run `antlr-end-of-body'."
 733   (interactive "p")
 734   (if (zerop arg)
 735       (antlr-end-of-body)
 736     (antlr-with-syntax-table antlr-action-syntax-table
 737       (antlr-next-rule arg nil))
 738     (setq zmacs-region-stays t)))
 739
 740 (defun antlr-beginning-of-rule (&optional arg)
 741   "Move backward to preceding beginning of rule.  Do it ARG many times.
 742 A grammar class header and the file prelude are also considered as a
 743 rule.  Negative argument ARG means move forward to ARGth next beginning
 744 of rule.  If ARG is zero, run `antlr-beginning-of-body'."
 745   (interactive "p")
 746   (if (zerop arg)
 747       (antlr-beginning-of-body)
 748     (antlr-with-syntax-table antlr-action-syntax-table
 749       (antlr-next-rule (- arg) t))
 750     (setq zmacs-region-stays t)))
 751
 752 (defun antlr-end-of-body (&optional msg)
 753   "Move to position after the `;' of the current rule.
 754 A grammar class header is also considered as a rule.  With optional
 755 prefix arg MSG, move to `:'."
 756   (interactive)
 757   (antlr-with-syntax-table antlr-action-syntax-table
 758     (let ((orig (point)))
 759       (if (antlr-outside-rule-p)
 760           (error "Outside an ANTLR rule"))
 761       (let ((bor (point)))
 762         (when (< (antlr-skip-file-prelude t) (point))
 763           ;; Yes, we are in the file prelude
 764           (goto-char orig)
 765           (error (or msg "The file prelude is without `;'")))
 766         (antlr-search-forward ";")
 767         (when msg
 768           (when (< (point)
 769                    (progn (goto-char bor)
 770                           (or (antlr-search-forward ":") (point-max))))
 771             (goto-char orig)
 772             (error msg))
 773           (c-forward-syntactic-ws)))))
 774   (setq zmacs-region-stays t))
 775
 776 (defun antlr-beginning-of-body ()
 777   "Move to the first element after the `:' of the current rule."
 778   (interactive)
 779   (antlr-end-of-body "Class headers and the file prelude are without `:'"))
 780
 781
 782 ;;;===========================================================================
 783 ;;;  Indentation
 784 ;;;===========================================================================
 785
 786 (defun antlr-indent-line ()
 787   "Indent the current line as ANTLR grammar code.
 788 The indentation of non-comment lines are calculated by `c-basic-offset',
 789 multiplied by:
 790  - the level of the paren/brace/bracket depth,
 791  - plus 0/2/1, depending on the position inside the rule: header, body,
 792    exception part,
 793  - minus 1 if `antlr-indent-item-regexp' matches the beginning of the
 794    line starting from the first non-blank.
 795
 796 Lines inside block comments are not changed or indented by
 797 `c-indent-line', see `antlr-indent-comment'."
 798   (let ((orig (point)) bol boi indent syntax)
 799     (beginning-of-line)
 800     (setq bol (point))
 801     (skip-chars-forward " \t")
 802     (setq boi (point))
 803     ;; check syntax at beginning of indentation ------------------------------
 804     (antlr-with-syntax-table antlr-action-syntax-table
 805       (antlr-invalidate-context-cache)
 806       (cond ((symbolp (setq syntax (antlr-syntactic-context)))
 807              (setq indent nil))         ; block-comments, strings, (comments)
 808             ((progn
 809                (antlr-next-rule -1 t)
 810                (if (antlr-search-forward ":") (< boi (1- (point))) t))
 811              (setq indent 0))           ; in rule header
 812             ((if (antlr-search-forward ";") (< boi (point)) t)
 813              (setq indent 2))           ; in rule body
 814             (t
 815              (forward-char)
 816              (antlr-skip-exception-part nil)
 817              (setq indent (if (> (point) boi) 1 0))))) ; in exception part?
 818     ;; compute the corresponding indentation and indent ----------------------
 819     (if (null indent)
 820         (progn
 821           (goto-char orig)
 822           (and (eq antlr-indent-comment t)
 823                (not (eq syntax 'string))
 824                (c-indent-line)))
 825       ;; do it ourselves
 826       (goto-char boi)
 827       (antlr-invalidate-context-cache)
 828       (incf indent (antlr-syntactic-context))
 829       (and (> indent 0) (looking-at antlr-indent-item-regexp) (decf indent))
 830       (setq indent (* indent c-basic-offset))
 831       ;; the usual major-mode indent stuff:
 832       (setq orig (- (point-max) orig))
 833       (unless (= (current-column) indent)
 834         (delete-region bol boi)
 835         (beginning-of-line)
 836         (indent-to indent))
 837       ;; If initial point was within line's indentation,
 838       ;; position after the indentation.  Else stay at same point in text.
 839       (if (> (- (point-max) orig) (point))
 840           (goto-char (- (point-max) orig))))))
 841
 842 (defun antlr-indent-command (&optional arg)
 843   "Indent the current line or insert tabs/spaces.
 844 With optional prefix argument ARG or if the previous command was this
 845 command, insert ARG tabs or spaces according to `indent-tabs-mode'.
 846 Otherwise, indent the current line with `antlr-indent-line'."
 847   (interactive "P")
 848   (if (or arg (eq last-command 'antlr-indent-command))
 849       (insert-tab arg)
 850     (let ((antlr-indent-comment (and antlr-indent-comment t))) ; dynamic
 851       (antlr-indent-line))))
 852
 853
 854 ;;;===========================================================================
 855 ;;;  Mode entry
 856 ;;;===========================================================================
 857
 858 (defun antlr-c-common-init ()
 859   "Like `c-common-init' except menu, auto-hungry and c-style stuff."
 860   ;; X/Emacs 20 only
 861   (make-local-variable 'paragraph-start)
 862   (make-local-variable 'paragraph-separate)
 863   (make-local-variable 'paragraph-ignore-fill-prefix)
 864   (make-local-variable 'require-final-newline)
 865   (make-local-variable 'parse-sexp-ignore-comments)
 866   (make-local-variable 'indent-line-function)
 867   (make-local-variable 'indent-region-function)
 868   (make-local-variable 'comment-start)
 869   (make-local-variable 'comment-end)
 870   (make-local-variable 'comment-column)
 871   (make-local-variable 'comment-start-skip)
 872   (make-local-variable 'comment-multi-line)
 873   (make-local-variable 'outline-regexp)
 874   (make-local-variable 'outline-level)
 875   (make-local-variable 'adaptive-fill-regexp)
 876   (make-local-variable 'adaptive-fill-mode)
 877   (make-local-variable 'imenu-generic-expression) ;set in the mode functions
 878   (and (boundp 'comment-line-break-function)
 879        (make-local-variable 'comment-line-break-function))
 880   ;; Emacs 19.30 and beyond only, AFAIK
 881   (if (boundp 'fill-paragraph-function)
 882       (progn
 883         (make-local-variable 'fill-paragraph-function)
 884         (setq fill-paragraph-function 'c-fill-paragraph)))
 885   ;; now set their values
 886   (setq paragraph-start (concat page-delimiter "\\|$")
 887         paragraph-separate paragraph-start
 888         paragraph-ignore-fill-prefix t
 889         require-final-newline t
 890         parse-sexp-ignore-comments t
 891         indent-line-function 'c-indent-line
 892         indent-region-function 'c-indent-region
 893         outline-regexp "[^#\n\^M]"
 894         outline-level 'c-outline-level
 895         comment-column 32
 896         comment-start-skip "/\\*+ *\\|// *"
 897         comment-multi-line nil
 898         comment-line-break-function 'c-comment-line-break-function
 899         adaptive-fill-regexp nil
 900         adaptive-fill-mode nil)
 901   ;; we have to do something special for c-offsets-alist so that the
 902   ;; buffer local value has its own alist structure.
 903   (setq c-offsets-alist (copy-alist c-offsets-alist))
 904   ;; setup the comment indent variable in a Emacs version portable way
 905   ;; ignore any byte compiler warnings you might get here
 906   (make-local-variable 'comment-indent-function)
 907   (setq comment-indent-function 'c-comment-indent))
 908
 909 (defun antlr-language-for-option (option-value)
 910   "Find element in `antlr-language-alist' for OPTION-VALUE."
 911   ;; Like (find OPTION-VALUE antlr-language-alist :key 'cddr :test 'member)
 912   (let ((seq antlr-language-alist)
 913         r)
 914     (while seq
 915       (setq r (pop seq))
 916       (if (member option-value (cddr r))
 917           (setq seq nil)                ; stop
 918         (setq r nil)))                  ; no result yet
 919     r))
 920
 921 ;;;###autoload
 922 (defun antlr-mode ()
 923   "Major mode for editing ANTLR grammar files.
 924 \\{antlr-mode-map}"
 925   (interactive)
 926   (c-initialize-cc-mode)                ; for java syntax table
 927   (kill-all-local-variables)
 928   ;; ANTLR specific ----------------------------------------------------------
 929   (setq major-mode 'antlr-mode
 930         mode-name "Antlr")
 931   (setq local-abbrev-table antlr-mode-abbrev-table)
 932   (set-syntax-table java-mode-syntax-table)
 933   (unless antlr-action-syntax-table
 934     (let ((slist (nth 3 antlr-font-lock-defaults)))
 935       (setq antlr-action-syntax-table
 936             (copy-syntax-table java-mode-syntax-table))
 937       (while slist
 938         (modify-syntax-entry (caar slist) (cdar slist)
 939                              antlr-action-syntax-table)
 940         (setq slist (cdr slist)))))
 941   (use-local-map antlr-mode-map)
 942   (make-local-variable 'antlr-language)
 943   (unless antlr-language
 944     (save-excursion
 945       (goto-char (point-min))
 946       (setq antlr-language
 947             (car (or (and (re-search-forward (cdr antlr-language-limit-n-regexp)
 948                                         (car antlr-language-limit-n-regexp)
 949                                         t)
 950                           (antlr-language-for-option (match-string 1)))
 951                      (antlr-language-for-option nil))))))
 952   (if (stringp (cadr (assq antlr-language antlr-language-alist)))
 953       (setq mode-name
 954             (concat "Antlr/"
 955                     (cadr (assq antlr-language antlr-language-alist)))))
 956   ;; indentation, for the C engine -------------------------------------------
 957   (antlr-c-common-init)
 958   (setq indent-line-function 'antlr-indent-line
 959         indent-region-function nil)     ; too lazy
 960   (setq comment-start "// "
 961         comment-end "")
 962   (c-set-style "java")
 963   (if (eq antlr-language 'c++-mode)
 964       (setq c-conditional-key c-C++-conditional-key
 965             c-comment-start-regexp c-C++-comment-start-regexp
 966             c-class-key c-C++-class-key
 967             c-extra-toplevel-key c-C++-extra-toplevel-key
 968             c-access-key c-C++-access-key
 969             c-recognize-knr-p nil)
 970     (setq c-conditional-key c-Java-conditional-key
 971           c-comment-start-regexp c-Java-comment-start-regexp
 972           c-class-key c-Java-class-key
 973           c-method-key nil
 974           c-baseclass-key nil
 975           c-recognize-knr-p nil
 976           c-access-key c-Java-access-key)
 977     (and (boundp 'c-inexpr-class-key) (boundp 'c-Java-inexpr-class-key)
 978          (setq c-inexpr-class-key c-Java-inexpr-class-key)))
 979   ;; various -----------------------------------------------------------------
 980   (make-local-variable 'font-lock-defaults)
 981   (setq font-lock-defaults antlr-font-lock-defaults)
 982   (easy-menu-add antlr-mode-menu)
 983   (make-local-variable 'imenu-create-index-function)
 984   (setq imenu-create-index-function 'antlr-imenu-create-index-function)
 985   (make-local-variable 'imenu-generic-expression)
 986   (setq imenu-generic-expression t)     ; fool stupid test
 987   (and antlr-imenu-name                 ; there should be a global variable...
 988        (fboundp 'imenu-add-to-menubar)
 989        (imenu-add-to-menubar
 990         (if (stringp antlr-imenu-name) antlr-imenu-name "Index")))
 991   (antlr-set-tabs)
 992   (run-hooks 'antlr-mode-hook))
 993
 994 ;;;###autoload
 995 (defun antlr-set-tabs ()
 996   "Use ANTLR's convention for TABs according to `antlr-tab-offset-alist'.
 997 Used in `antlr-mode'.  Also a useful function in `java-mode-hook'."
 998   (if buffer-file-name
 999       (let ((alist antlr-tab-offset-alist) elem)
1000         (while alist
1001           (setq elem (pop alist))
1002           (and (or (null (car elem)) (eq (car elem) major-mode))
1003                (or (null (cadr elem))
1004                    (string-match (cadr elem) buffer-file-name))
1005                (setq tab-width (caddr elem)
1006                      indent-tabs-mode (cadddr elem)
1007                      alist nil))))))
1008
1009 ;;; antlr-mode.el ends here
1010
1011 ; LocalWords:  antlr ANother ANTLR's Cpp Lexer TreeParser esp refs VALUEs ea ee
1012 ; LocalWords:  Java's Nomencl ruledef tokendef ruleref tokenref setType ader
1013 ; LocalWords:  ivate syntab lexer treeparser lic rotected rivate bor boi AFAIK
1014 ; LocalWords:  slist knr inexpr