lisp/progmodes/antlr-mode.el

   1 ;;; antlr-mode.el --- major mode for ANTLR grammar files
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Christoph.Wedler@sap.com
   6 ;; Keywords: languages
   7 ;; Version: (see `antlr-version' below)
   8 ;; X-URL: http://antlr-mode.sourceforge.net/
   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 2, or (at your option)
  15 ;; 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; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; The Emacs package ANTLR-Mode provides: syntax highlighting for ANTLR grammar
  30 ;; files, automatic indentation, menus containing rule/token definitions and
  31 ;; supported options and various other things like running ANTLR from within
  32 ;; Emacs.
  33
  34 ;; For details, check <http://antlr-mode.sourceforge.net/> or, if you prefer
  35 ;; the manual style, follow all commands mentioned in the documentation of
  36 ;; `antlr-mode'.  ANTLR is a LL(k)-based recognition tool which generates
  37 ;; lexers, parsers and tree transformers in Java, C++ or Sather and can be
  38 ;; found at <http://www.antlr.org/>.
  39
  40 ;; Bug fixes, bug reports, improvements, and suggestions for the newest version
  41 ;; are strongly appreciated.
  42
  43 ;; To-do/Wish-list:
  44 ;;
  45 ;;  * Next Version [C-c C-w].  Produce HTML document with syntax highlighted
  46 ;;    and hyper-links (using htmlize).
  47 ;;  * Next Version [C-c C-u].  Insert/update special comments: each rule lists
  48 ;;    all rules which use the current rule.  With font-lock update.
  49 ;;  * Next Version.  Make hiding much more customizable.
  50 ;;  * Planned [C-c C-j].  Jump to generated coding.
  51 ;;  * Planned.  Further support for imenu, i.e., include entries for method
  52 ;;    definitions at beginning of grammar class.
  53 ;;  * Planned [C-c C-p].  Pack/unpack rule/subrule & options (one/multi-line).
  54 ;;
  55 ;;  * Probably.  Show rules/dependencies for ANT like for Makefile (does ANT
  56 ;;    support vocabularies and grammar inheritance?), I have to look at
  57 ;;    jde-ant.el: http://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html
  58 ;;  * Unlikely.  Sather as generated language with syntax highlighting etc/.
  59 ;;    Questions/problems: is sather-mode.el the standard mode for sather, is it
  60 ;;    still supported, what is its relationship to eiffel3.el?  Requirement:
  61 ;;    this mode must not depend on a Sather mode.
  62 ;;  * Unlikely.  Faster syntax highlighting: sectionize the buffer into Antlr
  63 ;;    and action code and run special highlighting functions on these regions.
  64 ;;    Problems: code size, this mode would depend on font-lock internals.
  65
  66 ;;; Installation:
  67
  68 ;; This file requires Emacs-20.3, XEmacs-20.4 or higher and package cc-mode.
  69
  70 ;; If antlr-mode is not part of your distribution, put this file into your
  71 ;; load-path and the following into your ~/.emacs:
  72 ;;   (autoload 'antlr-mode "antlr-mode" nil t)
  73 ;;   (setq auto-mode-alist (cons '("\\.g\\'" . antlr-mode) auto-mode-alist))
  74 ;;   (add-hook 'speedbar-load-hook  ; would be too late in antlr-mode.el
  75 ;;             (lambda () (speedbar-add-supported-extension ".g")))
  76
  77 ;; I strongly recommend to use font-lock with a support mode like fast-lock,
  78 ;; lazy-lock or better jit-lock (Emacs-21.1+) / lazy-shot (XEmacs).
  79
  80 ;; To customize, use menu item "Antlr" -> "Customize Antlr".
  81
  82 ;;; Code:
  83
  84 (provide 'antlr-mode)
  85 (require 'easymenu)
  86
  87 ;; General Emacs/XEmacs-compatibility compile-time macros
  88 (eval-when-compile
  89   (require 'cl)
  90   (defmacro cond-emacs-xemacs (&rest args)
  91     (cond-emacs-xemacs-macfn
  92      args "`cond-emacs-xemacs' must return exactly one element"))
  93   (defun cond-emacs-xemacs-macfn (args &optional msg)
  94     (if (atom args) args
  95       (and (eq (car args) :@) (null msg) ; (:@ ...spliced...)
  96            (setq args (cdr args)
  97                  msg "(:@ ....) must return exactly one element"))
  98       (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS))
  99             (mode :BOTH) code)
 100         (while (consp args)
 101           (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args)))
 102           (if (atom args)
 103               (or args (error "Used selector %s without elements" mode))
 104             (or (eq ignore mode)
 105                 (push (cond-emacs-xemacs-macfn (car args)) code))
 106             (pop args)))
 107         (cond (msg (if (or args (cdr code)) (error msg) (car code)))
 108               ((or (null args) (eq ignore mode)) (nreverse code))
 109               (t (nconc (nreverse code) args))))))
 110   ;; Emacs/XEmacs-compatibility `defun': remove interactive "_" for Emacs, use
 111   ;; existing functions when they are `fboundp', provide shortcuts if they are
 112   ;; known to be defined in a specific Emacs branch (for short .elc)
 113   (defmacro defunx (name arglist &rest definition)
 114     (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses)
 115       (while (memq (car definition)
 116                    '(:try :emacs-and-try :xemacs-and-try))
 117         (if (eq (pop definition) (if xemacsp :xemacs-and-try :emacs-and-try))
 118             (setq reuses (car definition)
 119                   definition nil)
 120           (push (pop definition) reuses)))
 121       (if (and reuses (symbolp reuses))
 122           `(defalias ',name ',reuses)
 123         (let* ((docstring (if (stringp (car definition)) (pop definition)))
 124                (spec (and (not xemacsp)
 125                           (eq (car-safe (car definition)) 'interactive)
 126                           (null (cddar definition))
 127                           (cadar definition))))
 128           (if (and (stringp spec)
 129                    (not (string-equal spec ""))
 130                    (eq (aref spec 0) ?_))
 131               (setq definition
 132                     (cons (if (string-equal spec "_")
 133                               '(interactive)
 134                             `(interactive ,(substring spec 1)))
 135                           (cdr definition))))
 136           (if (null reuses)
 137               `(defun ,name ,arglist ,docstring
 138                  ,@(cond-emacs-xemacs-macfn definition))
 139             ;; no dynamic docstring in this case
 140             `(eval-and-compile          ; no warnings in Emacs
 141                (defalias ',name
 142                  (cond ,@(mapcar (lambda (func) `((fboundp ',func) ',func))
 143                                  (nreverse reuses))
 144                        (t ,(if definition
 145                                `(lambda ,arglist ,docstring
 146                                   ,@(cond-emacs-xemacs-macfn definition))
 147                              'ignore))))))))))
 148   (defmacro ignore-errors-x (&rest body)
 149     (let ((specials '((scan-sexps . 4) (scan-lists . 5)))
 150           spec nils)
 151       (if (and (string-match "XEmacs" emacs-version)
 152                (null (cdr body)) (consp (car body))
 153                (setq spec (assq (caar body) specials))
 154                (>= (setq nils (- (cdr spec) (length (car body)))) 0))
 155           `(,@(car body) ,@(make-list nils nil) t)
 156         `(ignore-errors ,@body)))))
 157
 158 ;; More compile-time-macros
 159 (eval-when-compile
 160   (defmacro save-buffer-state-x (&rest body) ; similar to EMACS/lazy-lock.el
 161     (let ((modified (gensym "save-buffer-state-x-modified-")))
 162       `(let ((,modified (buffer-modified-p)))
 163          (unwind-protect
 164              (let ((buffer-undo-list t) (inhibit-read-only t)
 165                    ,@(unless (string-match "XEmacs" emacs-version)
 166                        '((inhibit-point-motion-hooks t) deactivate-mark))
 167                    before-change-functions after-change-functions
 168                    buffer-file-name buffer-file-truename)
 169                ,@body)
 170            (and (not ,modified) (buffer-modified-p)
 171                 (set-buffer-modified-p nil)))))))
 172 (put 'save-buffer-state-x 'lisp-indent-function 0)
 173
 174 ;; get rid of byte-compile warnings
 175 (eval-when-compile                      ; required and optional libraries
 176   (ignore-errors (require 'cc-mode))
 177   (ignore-errors (require 'font-lock))
 178   (ignore-errors (require 'compile))
 179   (defvar outline-level) (defvar imenu-use-markers)
 180   (defvar imenu-create-index-function)
 181   (ignore-errors (defun c-init-language-vars)))
 182
 183
 184 ;;;;##########################################################################
 185 ;;;;  Variables
 186 ;;;;##########################################################################
 187
 188
 189 (defgroup antlr nil
 190   "Major mode for ANTLR grammar files."
 191   :group 'languages
 192   :link '(emacs-commentary-link "antlr-mode.el")
 193   :link '(url-link "http://antlr-mode.sourceforge.net/")
 194   :prefix "antlr-")
 195
 196 (defconst antlr-version "2.2b"
 197   "ANTLR major mode version number.
 198 Check <http://antlr-mode.sourceforge.net/> for the newest.")
 199
 200
 201 ;;;===========================================================================
 202 ;;;  Controlling ANTLR's code generator (language option)
 203 ;;;===========================================================================
 204
 205 (defvar antlr-language nil
 206   "Major mode corresponding to ANTLR's \"language\" option.
 207 Set via `antlr-language-alist'.  The only useful place to change this
 208 buffer-local variable yourself is in `antlr-mode-hook' or in the \"local
 209 variable list\" near the end of the file, see
 210 `enable-local-variables'.")
 211
 212 (defcustom antlr-language-alist
 213   '((java-mode "Java" nil "\"Java\"" "Java")
 214     (c++-mode "C++" "\"Cpp\"" "Cpp"))
 215   "List of ANTLR's supported languages.
 216 Each element in this list looks like
 217   \(MAJOR-MODE MODELINE-STRING OPTION-VALUE...)
 218
 219 MAJOR-MODE, the major mode of the code in the grammar's actions, is the
 220 value of `antlr-language' if the first group in the string matched by
 221 REGEXP in `antlr-language-limit-n-regexp' is one of the OPTION-VALUEs.
 222 An OPTION-VALUE of nil denotes the fallback element.  MODELINE-STRING is
 223 also displayed in the modeline next to \"Antlr\"."
 224   :group 'antlr
 225   :type '(repeat (group :value (java-mode "")
 226                         (function :tag "Major mode")
 227                         (string :tag "Modeline string")
 228                         (repeat :tag "ANTLR language option" :inline t
 229                                 (choice (const :tag "Default" nil)
 230                                         string )))))
 231
 232 (defcustom antlr-language-limit-n-regexp
 233   '(8192 . "language[ \t]*=[ \t]*\\(\"?[A-Z][A-Za-z_]*\"?\\)")
 234   "Used to set a reasonable value for `antlr-language'.
 235 Looks like \(LIMIT \. REGEXP).  Search for REGEXP from the beginning of
 236 the buffer to LIMIT and use the first group in the matched string to set
 237 the language according to `antlr-language-alist'."
 238   :group 'antlr
 239   :type '(cons (choice :tag "Limit" (const :tag "No" nil) (integer :value 0))
 240                regexp))
 241
 242
 243 ;;;===========================================================================
 244 ;;;  Hide/Unhide, Indent/Tabs
 245 ;;;===========================================================================
 246
 247 (defcustom antlr-action-visibility 3
 248   "Visibility of actions when command `antlr-hide-actions' is used.
 249 If nil, the actions with their surrounding braces are hidden.  If a
 250 number, do not hide the braces, only hide the contents if its length is
 251 greater than this number."
 252   :group 'antlr
 253   :type '(choice (const :tag "Completely hidden" nil)
 254                  (integer :tag "Hidden if longer than" :value 3)))
 255
 256 (defcustom antlr-indent-comment 'tab
 257   "*Non-nil, if the indentation should touch lines in block comments.
 258 If nil, no continuation line of a block comment is changed.  If t, they
 259 are changed according to `c-indentation-line'.  When not nil and not t,
 260 they are only changed by \\[antlr-indent-command]."
 261   :group 'antlr
 262   :type '(radio (const :tag "No" nil)
 263                 (const :tag "Always" t)
 264                 (sexp :tag "With TAB" :format "%t" :value tab)))
 265
 266 (defcustom antlr-tab-offset-alist
 267   '((antlr-mode nil 4 nil)
 268     (java-mode "antlr" 4 nil))
 269   "Alist to determine whether to use ANTLR's convention for TABs.
 270 Each element looks like \(MAJOR-MODE REGEXP TAB-WIDTH INDENT-TABS-MODE).
 271 The first element whose MAJOR-MODE is nil or equal to `major-mode' and
 272 whose REGEXP is nil or matches variable `buffer-file-name' is used to
 273 set `tab-width' and `indent-tabs-mode'.  This is useful to support both
 274 ANTLR's and Java's indentation styles.  Used by `antlr-set-tabs'."
 275   :group 'antlr
 276   :type '(repeat (group :value (antlr-mode nil 8 nil)
 277                         (choice (const :tag "All" nil)
 278                                 (function :tag "Major mode"))
 279                         (choice (const :tag "All" nil) regexp)
 280                         (integer :tag "Tab width")
 281                         (boolean :tag "Indent-tabs-mode"))))
 282
 283 (defcustom antlr-indent-style "java"
 284   "*If non-nil, cc-mode indentation style used for `antlr-mode'.
 285 See `c-set-style' and for details, where the most interesting part in
 286 `c-style-alist' is the value of `c-basic-offset'."
 287   :group 'antlr
 288   :type '(choice (const nil) regexp))
 289
 290 (defcustom antlr-indent-item-regexp
 291   "[]}):;|&]" ; & is local ANTLR extension (SGML's and-connector)
 292   "Regexp matching lines which should be indented by one TAB less.
 293 See `antlr-indent-line' and command \\[antlr-indent-command]."
 294   :group 'antlr
 295   :type 'regexp)
 296
 297 (defcustom antlr-indent-at-bol-alist
 298   ;; eval-when-compile not usable with defcustom...
 299   '((java-mode . "\\(package\\|import\\)\\>")
 300     (c++-mode . "#\\(assert\\|cpu\\|define\\|endif\\|el\\(if\\|se\\)\\|i\\(dent\\|f\\(def\\|ndef\\)?\\|mport\\|nclude\\(_next\\)?\\)\\|line\\|machine\\|pragma\\|system\\|un\\(assert\\|def\\)\\|warning\\)\\>"))
 301   "Alist of regexps matching lines are indented at column 0.
 302 Each element in this list looks like (MODE . REGEXP) where MODE is a
 303 function and REGEXP is a regular expression.
 304
 305 If `antlr-language' equals to a MODE, the line starting at the first
 306 non-whitespace is matched by the corresponding REGEXP, and the line is
 307 part of an header action, indent the line at column 0 instead according
 308 to the normal rules of `antlr-indent-line'."
 309   :group 'antlr
 310   :type '(repeat (cons (function :tag "Major mode") regexp)))
 311
 312 ;; adopt indentation to cc-engine
 313 (defvar antlr-disabling-cc-syntactic-symbols
 314   '(statement-block-intro
 315     defun-block-intro topmost-intro statement-case-intro member-init-intro
 316     arglist-intro brace-list-intro knr-argdecl-intro inher-intro
 317     objc-method-intro
 318     block-close defun-close class-close brace-list-close arglist-close
 319     inline-close extern-lang-close namespace-close))
 320
 321
 322 ;;;===========================================================================
 323 ;;;  Options: customization
 324 ;;;===========================================================================
 325
 326 (defcustom antlr-options-use-submenus t
 327   "*Non-nil, if the major mode menu should include option submenus.
 328 If nil, the menu just includes a command to insert options.  Otherwise,
 329 it includes four submenus to insert file/grammar/rule/subrule options."
 330   :group 'antlr
 331   :type 'boolean)
 332
 333 (defcustom antlr-tool-version 20701
 334   "*The version number of the Antlr tool.
 335 The value is an integer of the form XYYZZ which stands for vX.YY.ZZ.
 336 This variable is used to warn about non-supported options and to supply
 337 version correct option values when using \\[antlr-insert-option].
 338
 339 Don't use a number smaller than 20600 since the stored history of
 340 Antlr's options starts with v2.06.00, see `antlr-options-alists'.  You
 341 can make this variable buffer-local."
 342   :group 'antlr
 343   :type 'integer)
 344
 345 (defcustom antlr-options-auto-colon t
 346   "*Non-nil, if `:' is inserted with a rule or subrule options section.
 347 A `:' is only inserted if this value is non-nil, if a rule or subrule
 348 option is inserted with \\[antlr-insert-option], if there was no rule or
 349 subrule options section before, and if a `:' is not already present
 350 after the section, ignoring whitespace, comments and the init action."
 351   :group 'antlr
 352   :type 'boolean)
 353
 354 (defcustom antlr-options-style nil
 355   "List of symbols which determine the style of option values.
 356 If a style symbol is present, the corresponding option value is put into
 357 quotes, i.e., represented as a string, otherwise it is represented as an
 358 identifier.
 359
 360 The only style symbol used in the default value of `antlr-options-alist'
 361 is `language-as-string'.  See also `antlr-read-value'."
 362   :group 'antlr
 363   :type '(repeat (symbol :tag "Style symbol")))
 364
 365 (defcustom antlr-options-push-mark t
 366   "*Non-nil, if inserting an option should set & push mark.
 367 If nil, never set mark when inserting an option with command
 368 \\[antlr-insert-option].  If t, always set mark via `push-mark'.  If a
 369 number, only set mark if point was outside the options area before and
 370 the number of lines between point and the insert position is greater
 371 than this value.  Otherwise, only set mark if point was outside the
 372 options area before."
 373   :group 'antlr
 374   :type '(radio (const :tag "No" nil)
 375                 (const :tag "Always" t)
 376                 (integer :tag "Lines between" :value 10)
 377                 (sexp :tag "If outside options" :format "%t" :value outside)))
 378
 379 (defcustom antlr-options-assign-string " = "
 380   "*String containing `=' to use between option name and value.
 381 This string is only used if the option to insert did not exist before
 382 or if there was no `=' after it.  In other words, the spacing around an
 383 existing `=' won't be changed when changing an option value."
 384   :group 'antlr
 385   :type 'string)
 386
 387
 388 ;;;===========================================================================
 389 ;;;  Options: definitions
 390 ;;;===========================================================================
 391
 392 (defvar antlr-options-headings '("file" "grammar" "rule" "subrule")
 393   "Headings for the four different option kinds.
 394 The standard value is (\"file\" \"grammar\" \"rule\" \"subrule\").  See
 395 `antlr-options-alists'")
 396
 397 (defvar antlr-options-alists
 398   '(;; file options ----------------------------------------------------------
 399     (("language" antlr-language-option-extra
 400       (20600 antlr-read-value
 401              "Generated language: " language-as-string
 402              (("Java") ("Cpp") ("HTML") ("Diagnostic")))
 403       (20700 antlr-read-value
 404              "Generated language: " language-as-string
 405              (("Java") ("Cpp") ("HTML") ("Diagnostic") ("Sather"))))
 406      ("mangleLiteralPrefix" nil
 407       (20600 antlr-read-value
 408              "Prefix for literals (default LITERAL_): " t))
 409      ("namespace" antlr-c++-mode-extra
 410       (20700 antlr-read-value
 411              "Wrap generated C++ code in namespace: " t))
 412      ("namespaceStd" antlr-c++-mode-extra
 413       (20701 antlr-read-value
 414              "Replace ANTLR_USE_NAMESPACE(std) by: " t))
 415      ("namespaceAntlr" antlr-c++-mode-extra
 416       (20701 antlr-read-value
 417              "Replace ANTLR_USE_NAMESPACE(antlr) by: " t))
 418      ("genHashLines" antlr-c++-mode-extra
 419       (20701 antlr-read-boolean
 420              "Include #line in generated C++ code? "))
 421      )
 422     ;; grammar options --------------------------------------------------------
 423     (("k" nil
 424       (20600 antlr-read-value
 425              "Lookahead depth: "))
 426      ("importVocab" nil
 427       (20600 antlr-read-value
 428              "Import vocabulary: "))
 429      ("exportVocab" nil
 430       (20600 antlr-read-value
 431              "Export vocabulary: "))
 432      ("testLiterals" nil                ; lexer only
 433       (20600 antlr-read-boolean
 434              "Test each token against literals table? "))
 435      ("defaultErrorHandler" nil         ; not for lexer
 436       (20600 antlr-read-boolean
 437              "Generate default exception handler for each rule? "))
 438      ("codeGenMakeSwitchThreshold" nil
 439       (20600 antlr-read-value
 440              "Min number of alternatives for 'switch': "))
 441      ("codeGenBitsetTestThreshold" nil
 442       (20600 antlr-read-value
 443              "Min size of lookahead set for bitset test: "))
 444      ("analyzerDebug" nil
 445       (20600 antlr-read-boolean
 446              "Display debugging info during grammar analysis? "))
 447      ("codeGenDebug" nil
 448       (20600 antlr-read-boolean
 449              "Display debugging info during code generation? "))
 450      ("buildAST" nil                    ; not for lexer
 451       (20600 antlr-read-boolean
 452              "Use automatic AST construction/transformation? "))
 453      ("ASTLabelType" nil                ; not for lexer
 454       (20600 antlr-read-value
 455              "Class of user-defined AST node: " t))
 456      ("charVocabulary" nil              ; lexer only
 457       (20600 nil
 458              "Insert character vocabulary"))
 459      ("interactive" nil
 460       (20600 antlr-read-boolean
 461              "Generate interactive lexer/parser? "))
 462      ("caseSensitive" nil               ; lexer only
 463       (20600 antlr-read-boolean
 464              "Case significant when matching characters? "))
 465      ("caseSensitiveLiterals" nil       ; lexer only
 466       (20600 antlr-read-boolean
 467              "Case significant when testing literals table? "))
 468      ("classHeaderSuffix" nil
 469       (20600 nil
 470              "Additional string for grammar class definition"))
 471      ("filter" nil                      ; lexer only
 472       (20600 antlr-read-boolean
 473              "Skip rule (the name, true or false): "
 474              antlr-grammar-tokens))
 475      ("namespace" antlr-c++-mode-extra
 476       (20700 antlr-read-value
 477              "Wrap generated C++ code for grammar in namespace: " t))
 478      ("namespaceStd" antlr-c++-mode-extra
 479       (20701 antlr-read-value
 480              "Replace ANTLR_USE_NAMESPACE(std) by: " t))
 481      ("namespaceAntlr" antlr-c++-mode-extra
 482       (20701 antlr-read-value
 483              "Replace ANTLR_USE_NAMESPACE(antlr) by: " t))
 484      ("genHashLines" antlr-c++-mode-extra
 485       (20701 antlr-read-boolean
 486              "Include #line in generated C++ code? "))
 487 ;;;     ("autoTokenDef" nil             ; parser only
 488 ;;;      (80000 antlr-read-boolean              ; default: true
 489 ;;;          "Automatically define referenced token? "))
 490 ;;;     ("keywordsMeltTo" nil           ; parser only
 491 ;;;      (80000 antlr-read-value
 492 ;;;          "Change non-matching keywords to token type: "))
 493      )
 494     ;; rule options ----------------------------------------------------------
 495     (("testLiterals" nil                ; lexer only
 496       (20600 antlr-read-boolean
 497              "Test this token against literals table? "))
 498      ("defaultErrorHandler" nil         ; not for lexer
 499       (20600 antlr-read-boolean
 500              "Generate default exception handler for this rule? "))
 501      ("ignore" nil                      ; lexer only
 502       (20600 antlr-read-value
 503              "In this rule, ignore tokens of type: " nil
 504              antlr-grammar-tokens))
 505      ("paraphrase" nil                  ; lexer only
 506       (20600 antlr-read-value
 507              "In messages, replace name of this token by: " t))
 508      )
 509     ;; subrule options -------------------------------------------------------
 510     (("warnWhenFollowAmbig" nil
 511       (20600 antlr-read-boolean
 512              "Display warnings for ambiguities with FOLLOW? "))
 513      ("generateAmbigWarnings" nil
 514       (20600 antlr-read-boolean
 515              "Display warnings for ambiguities? "))
 516      ("greedy" nil
 517       (20700 antlr-read-boolean
 518              "Make this optional/loop subrule greedy? "))
 519      ))
 520   "Definitions for Antlr's options of all four different kinds.
 521
 522 The value looks like \(FILE GRAMMAR RULE SUBRULE) where each FILE,
 523 GRAMMAR, RULE, and SUBRULE is a list of option definitions of the
 524 corresponding kind, i.e., looks like \(OPTION-DEF...).
 525
 526 Each OPTION-DEF looks like \(OPTION-NAME EXTRA-FN VALUE-SPEC...) which
 527 defines a file/grammar/rule/subrule option with name OPTION-NAME.  The
 528 OPTION-NAMEs are used for the creation of the \"Insert XXX Option\"
 529 submenus, see `antlr-options-use-submenus', and to allow to insert the
 530 option name with completion when using \\[antlr-insert-option].
 531
 532 If EXTRA-FN is a function, it is called at different phases of the
 533 insertion with arguments \(PHASE OPTION-NAME).  PHASE can have the
 534 values `before-input' or `after-insertion', additional phases might be
 535 defined in future versions of this mode.  The phase `before-input'
 536 occurs before the user is asked to insert a value.  The phase
 537 `after-insertion' occurs after the option value has been inserted.
 538 EXTRA-FN might be called with additional arguments in future versions of
 539 this mode.
 540
 541 Each specification VALUE-SPEC looks like \(VERSION READ-FN ARG...).  The
 542 last VALUE-SPEC in an OPTION-DEF whose VERSION is smaller or equal to
 543 `antlr-tool-version' specifies how the user is asked for the value of
 544 the option.
 545
 546 If READ-FN is nil, the only ARG is a string which is printed at the echo
 547 area to guide the user what to insert at point.  Otherwise, READ-FN is
 548 called with arguments \(INIT-VALUE ARG...) to get the new value of the
 549 option.  INIT-VALUE is the old value of the option or nil.
 550
 551 The standard value contains the following functions as READ-FN:
 552 `antlr-read-value' with ARGs = \(PROMPT AS-STRING TABLE) which reads a
 553 general value, or `antlr-read-boolean' with ARGs = \(PROMPT TABLE) which
 554 reads a boolean value or a member of TABLE.  PROMPT is the prompt when
 555 asking for a new value.  If non-nil, TABLE is a table for completion or
 556 a function evaluating to such a table.  The return value is quoted iff
 557 AS-STRING is non-nil and is either t or a symbol which is a member of
 558 `antlr-options-style'.")
 559
 560
 561 ;;;===========================================================================
 562 ;;;  Run tool, create Makefile dependencies
 563 ;;;===========================================================================
 564
 565 (defcustom antlr-tool-command "java antlr.Tool"
 566   "*Command used in \\[antlr-run-tool] to run the Antlr tool.
 567 This variable should include all options passed to Antlr except the
 568 option \"-glib\" which is automatically suggested if necessary."
 569   :group 'antlr
 570   :type 'string)
 571
 572 (defcustom antlr-ask-about-save t
 573   "*If not nil, \\[antlr-run-tool] asks which buffers to save.
 574 Otherwise, it saves all modified buffers before running without asking."
 575   :group 'antlr
 576   :type 'boolean)
 577
 578 (defcustom antlr-makefile-specification
 579   '("\n" ("GENS" "GENS%d" " \\\n\t") "$(ANTLR)")
 580   "*Variable to specify the appearance of the generated makefile rules.
 581 This variable influences the output of \\[antlr-show-makefile-rules].
 582 It looks like \(RULE-SEP GEN-VAR-SPEC COMMAND).
 583
 584 RULE-SEP is the string to separate different makefile rules.  COMMAND is
 585 a string with the command which runs the Antlr tool, it should include
 586 all options except the option \"-glib\" which is automatically added
 587 if necessary.
 588
 589 If GEN-VAR-SPEC is nil, each target directly consists of a list of
 590 files.  If GEN-VAR-SPEC looks like \(GEN-VAR GEN-VAR-FORMAT GEN-SEP), a
 591 Makefile variable is created for each rule target.
 592
 593 Then, GEN-VAR is a string with the name of the variable which contains
 594 the file names of all makefile rules.  GEN-VAR-FORMAT is a format string
 595 producing the variable of each target with substitution COUNT/%d where
 596 COUNT starts with 1.  GEN-SEP is used to separate long variable values."
 597   :group 'antlr
 598   :type '(list (string :tag "Rule separator")
 599                (choice
 600                 (const :tag "Direct targets" nil)
 601                 (list :tag "Variables for targets"
 602                       (string :tag "Variable for all targets")
 603                       (string :tag "Format for each target variable")
 604                       (string :tag "Variable separator")))
 605                (string :tag "ANTLR command")))
 606
 607 (defvar antlr-file-formats-alist
 608   '((java-mode ("%sTokenTypes.java") ("%s.java"))
 609     (c++-mode ("%sTokenTypes.hpp") ("%s.cpp" "%s.hpp")))
 610   "Language dependent formats which specify generated files.
 611 Each element in this list looks looks like
 612   \(MAJOR-MODE (VOCAB-FILE-FORMAT...) (CLASS-FILE-FORMAT...)).
 613
 614 The element whose MAJOR-MODE is equal to `antlr-language' is used to
 615 specify the generated files which are language dependent.  See variable
 616 `antlr-special-file-formats' for language independent files.
 617
 618 VOCAB-FILE-FORMAT is a format string, it specifies with substitution
 619 VOCAB/%s the generated file for each export vocabulary VOCAB.
 620 CLASS-FILE-FORMAT is a format string, it specifies with substitution
 621 CLASS/%s the generated file for each grammar class CLASS.")
 622
 623 (defvar antlr-special-file-formats '("%sTokenTypes.txt" "expanded%s.g")
 624   "Language independent formats which specify generated files.
 625 The value looks like \(VOCAB-FILE-FORMAT EXPANDED-GRAMMAR-FORMAT).
 626
 627 VOCAB-FILE-FORMAT is a format string, it specifies with substitution
 628 VOCAB/%s the generated or input file for each export or import
 629 vocabulary VOCAB, respectively.  EXPANDED-GRAMMAR-FORMAT is a format
 630 string, it specifies with substitution GRAMMAR/%s the constructed
 631 grammar file if the file GRAMMAR.g contains a grammar class which
 632 extends a class other than \"Lexer\", \"Parser\" or \"TreeParser\".
 633
 634 See variable `antlr-file-formats-alist' for language dependent
 635 formats.")
 636
 637 (defvar antlr-unknown-file-formats '("?%s?.g" "?%s?")
 638   "*Formats which specify the names of unknown files.
 639 The value looks like \(SUPER-GRAMMAR-FILE-FORMAT SUPER-EVOCAB-FORMAT).
 640
 641 SUPER-GRAMMAR-FORMAT is a format string, it specifies with substitution
 642 SUPER/%s the name of a grammar file for Antlr's option \"-glib\" if no
 643 grammar file in the current directory defines the class SUPER or if it
 644 is defined more than once.  SUPER-EVOCAB-FORMAT is a format string, it
 645 specifies with substitution SUPER/%s the name for the export vocabulary
 646 of above mentioned class SUPER.")
 647
 648 (defvar antlr-help-unknown-file-text
 649   "## The following rules contain filenames of the form
 650 ##  \"?SUPERCLASS?.g\" (and \"?SUPERCLASS?TokenTypes.txt\")
 651 ## where SUPERCLASS is not found to be defined in any grammar file of
 652 ## the current directory or is defined more than once.  Please replace
 653 ## these filenames by the grammar files (and their exportVocab).\n\n"
 654   "String indicating the existence of unknown files in the Makefile.
 655 See \\[antlr-show-makefile-rules] and `antlr-unknown-file-formats'.")
 656
 657 (defvar antlr-help-rules-intro
 658   "The following Makefile rules define the dependencies for all (non-
 659 expanded) grammars in directory \"%s\".\n
 660 They are stored in the kill-ring, i.e., you can insert them with C-y
 661 into your Makefile.  You can also invoke M-x antlr-show-makefile-rules
 662 from within a Makefile to insert them directly.\n\n\n"
 663   "Introduction to use with \\[antlr-show-makefile-rules].
 664 It is a format string and used with substitution DIRECTORY/%s where
 665 DIRECTORY is the name of the current directory.")
 666
 667
 668 ;;;===========================================================================
 669 ;;;  Menu
 670 ;;;===========================================================================
 671
 672 (defcustom antlr-imenu-name t ; (featurep 'xemacs) ; TODO: Emacs-21 bug?
 673   "*Non-nil, if a \"Index\" menu should be added to the menubar.
 674 If it is a string, it is used instead \"Index\".  Requires package
 675 imenu."
 676   :group 'antlr
 677   :type '(choice (const :tag "No menu" nil)
 678                  (const :tag "Index menu" t)
 679                  (string :tag "Other menu name")))
 680
 681 (defvar antlr-mode-map
 682   (let ((map (make-sparse-keymap)))
 683     (define-key map "\t" 'antlr-indent-command)
 684     (define-key map "\e\C-a" 'antlr-beginning-of-rule)
 685     (define-key map "\e\C-e" 'antlr-end-of-rule)
 686     (define-key map "\C-c\C-a" 'antlr-beginning-of-body)
 687     (define-key map "\C-c\C-e" 'antlr-end-of-body)
 688     (define-key map "\C-c\C-f" 'c-forward-into-nomenclature)
 689     (define-key map "\C-c\C-b" 'c-backward-into-nomenclature)
 690     (define-key map "\C-c\C-c" 'comment-region)
 691     (define-key map "\C-c\C-v" 'antlr-hide-actions)
 692     (define-key map "\C-c\C-r" 'antlr-run-tool)
 693     (define-key map "\C-c\C-o" 'antlr-insert-option)
 694     ;; I'm too lazy to define my own:
 695     (define-key map "\ea" 'c-beginning-of-statement)
 696     (define-key map "\ee" 'c-end-of-statement)
 697     ;; electric keys:
 698     (define-key map ":" 'antlr-electric-character)
 699     (define-key map ";" 'antlr-electric-character)
 700     (define-key map "|" 'antlr-electric-character)
 701     (define-key map "&" 'antlr-electric-character)
 702     (define-key map "(" 'antlr-electric-character)
 703     (define-key map ")" 'antlr-electric-character)
 704     (define-key map "{" 'antlr-electric-character)
 705     (define-key map "}" 'antlr-electric-character)
 706     map)
 707   "Keymap used in `antlr-mode' buffers.")
 708
 709 (easy-menu-define antlr-mode-menu antlr-mode-map
 710   "Major mode menu."
 711   `("Antlr"
 712     ,@(if (cond-emacs-xemacs
 713            :EMACS (and antlr-options-use-submenus
 714                        (>= emacs-major-version 21))
 715            :XEMACS antlr-options-use-submenus)
 716           `(("Insert File Option"
 717              :filter ,(lambda (x) (antlr-options-menu-filter 1 x)))
 718             ("Insert Grammar Option"
 719              :filter ,(lambda (x) (antlr-options-menu-filter 2 x)))
 720             ("Insert Rule Option"
 721              :filter ,(lambda (x) (antlr-options-menu-filter 3 x)))
 722             ("Insert Subrule Option"
 723              :filter ,(lambda (x) (antlr-options-menu-filter 4 x)))
 724             "---")
 725         '(["Insert Option" antlr-insert-option
 726            :active (not buffer-read-only)]))
 727     ("Forward/Backward"
 728      ["Backward Rule" antlr-beginning-of-rule t]
 729      ["Forward Rule" antlr-end-of-rule t]
 730      ["Start of Rule Body" antlr-beginning-of-body
 731       :active (antlr-inside-rule-p)]
 732      ["End of Rule Body" antlr-end-of-body
 733       :active (antlr-inside-rule-p)]
 734      "---"
 735      ["Backward Statement" c-beginning-of-statement t]
 736      ["Forward Statement" c-end-of-statement t]
 737      ["Backward Into Nomencl." c-backward-into-nomenclature t]
 738      ["Forward Into Nomencl." c-forward-into-nomenclature t])
 739     ["Indent Region" indent-region
 740      :active (and (not buffer-read-only) (c-region-is-active-p))]
 741     ["Comment Out Region" comment-region
 742      :active (and (not buffer-read-only) (c-region-is-active-p))]
 743     ["Uncomment Region"
 744      (comment-region (region-beginning) (region-end) '(4))
 745      :active (and (not buffer-read-only) (c-region-is-active-p))]
 746     "---"
 747     ["Hide Actions (incl. Args)" antlr-hide-actions t]
 748     ["Hide Actions (excl. Args)" (antlr-hide-actions 2) t]
 749     ["Unhide All Actions" (antlr-hide-actions 0) t]
 750     "---"
 751     ["Run Tool on Grammar" antlr-run-tool t]
 752     ["Show Makefile Rules" antlr-show-makefile-rules t]
 753     "---"
 754     ["Customize Antlr" (customize-group 'antlr) t]))
 755
 756
 757 ;;;===========================================================================
 758 ;;;  font-lock
 759 ;;;===========================================================================
 760
 761 (defcustom antlr-font-lock-maximum-decoration 'inherit
 762   "*The maximum decoration level for fontifying actions.
 763 Value `none' means, do not fontify actions, just normal grammar code
 764 according to `antlr-font-lock-additional-keywords'.  Value `inherit'
 765 means, use value of `font-lock-maximum-decoration'.  Any other value is
 766 interpreted as in `font-lock-maximum-decoration' with no level-0
 767 fontification, see `antlr-font-lock-keywords-alist'.
 768
 769 While calculating the decoration level for actions, `major-mode' is
 770 bound to `antlr-language'.  For example, with value
 771   \((java-mode \. 2) (c++-mode \. 0))
 772 Java actions are fontified with level 2 and C++ actions are not
 773 fontified at all."
 774   :type '(choice (const :tag "None" none)
 775                  (const :tag "Inherit" inherit)
 776                  (const :tag "Default" nil)
 777                  (const :tag "Maximum" t)
 778                  (integer :tag "Level" 1)
 779                  (repeat :menu-tag "Mode specific" :tag "Mode specific"
 780                          :value ((t . t))
 781                          (cons :tag "Instance"
 782                                (radio :tag "Mode"
 783                                       (const :tag "All" t)
 784                                       (symbol :tag "Name"))
 785                                (radio :tag "Decoration"
 786                                       (const :tag "Default" nil)
 787                                       (const :tag "Maximum" t)
 788                                       (integer :tag "Level" 1))))))
 789
 790 (defconst antlr-no-action-keywords nil
 791   ;; Using nil directly won't work (would use highest level, see
 792   ;; `font-lock-choose-keywords'), but a non-symbol, i.e., (list), at `car'
 793   ;; would break Emacs-21.0:
 794   "Empty font-lock keywords for actions.
 795 Do not change the value of this constant.")
 796
 797 (defvar antlr-font-lock-keywords-alist
 798   '((java-mode
 799      antlr-no-action-keywords
 800      java-font-lock-keywords-1 java-font-lock-keywords-2
 801      java-font-lock-keywords-3)
 802     (c++-mode
 803      antlr-no-action-keywords
 804      c++-font-lock-keywords-1 c++-font-lock-keywords-2
 805      c++-font-lock-keywords-3))
 806   "List of font-lock keywords for actions in the grammar.
 807 Each element in this list looks like
 808   \(MAJOR-MODE KEYWORD...)
 809
 810 If `antlr-language' is equal to MAJOR-MODE, the KEYWORDs are the
 811 font-lock keywords according to `font-lock-defaults' used for the code
 812 in the grammar's actions and semantic predicates, see
 813 `antlr-font-lock-maximum-decoration'.")
 814
 815 (defvar antlr-font-lock-default-face 'antlr-font-lock-default-face)
 816 (defface antlr-font-lock-default-face nil
 817   "Face to prevent strings from language dependent highlighting.
 818 Do not change."
 819   :group 'antlr)
 820
 821 (defvar antlr-font-lock-keyword-face 'antlr-font-lock-keyword-face)
 822 (defface antlr-font-lock-keyword-face
 823   (cond-emacs-xemacs
 824    '((((class color) (background light))
 825       (:foreground "black" :EMACS :weight bold :XEMACS :bold t))))
 826   "ANTLR keywords."
 827   :group 'antlr)
 828
 829 (defvar antlr-font-lock-syntax-face 'antlr-font-lock-keyword-face)
 830 (defface antlr-font-lock-syntax-face
 831   (cond-emacs-xemacs
 832    '((((class color) (background light))
 833       (:foreground "black" :EMACS :weight bold :XEMACS :bold t))))
 834   "ANTLR syntax symbols like :, |, (, ), ...."
 835   :group 'antlr)
 836
 837 (defvar antlr-font-lock-ruledef-face 'antlr-font-lock-ruledef-face)
 838 (defface antlr-font-lock-ruledef-face
 839   (cond-emacs-xemacs
 840    '((((class color) (background light))
 841       (:foreground "blue" :EMACS :weight bold :XEMACS :bold t))))
 842   "ANTLR rule references (definition)."
 843   :group 'antlr)
 844
 845 (defvar antlr-font-lock-tokendef-face 'antlr-font-lock-tokendef-face)
 846 (defface antlr-font-lock-tokendef-face
 847   (cond-emacs-xemacs
 848    '((((class color) (background light))
 849       (:foreground "blue" :EMACS :weight bold :XEMACS :bold t))))
 850   "ANTLR token references (definition)."
 851   :group 'antlr)
 852
 853 (defvar antlr-font-lock-ruleref-face 'antlr-font-lock-ruleref-face)
 854 (defface antlr-font-lock-ruleref-face
 855   '((((class color) (background light)) (:foreground "blue4")))
 856   "ANTLR rule references (usage)."
 857   :group 'antlr)
 858
 859 (defvar antlr-font-lock-tokenref-face 'antlr-font-lock-tokenref-face)
 860 (defface antlr-font-lock-tokenref-face
 861   '((((class color) (background light)) (:foreground "orange4")))
 862   "ANTLR token references (usage)."
 863   :group 'antlr)
 864
 865 (defvar antlr-font-lock-literal-face 'antlr-font-lock-literal-face)
 866 (defface antlr-font-lock-literal-face
 867   (cond-emacs-xemacs
 868    '((((class color) (background light))
 869       (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t))))
 870   "ANTLR special literal tokens.
 871 It is used to highlight strings matched by the first regexp group of
 872 `antlr-font-lock-literal-regexp'."
 873   :group 'antlr)
 874
 875 (defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\""
 876   "Regexp matching literals with special syntax highlighting, or nil.
 877 If nil, there is no special syntax highlighting for some literals.
 878 Otherwise, it should be a regular expression which must contain a regexp
 879 group.  The string matched by the first group is highlighted with
 880 `antlr-font-lock-literal-face'."
 881   :group 'antlr
 882   :type '(choice (const :tag "None" nil) regexp))
 883
 884 (defvar antlr-class-header-regexp
 885   "\\(class\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]+\\(extends\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]*;"
 886   "Regexp matching class headers.")
 887
 888 (defvar antlr-font-lock-additional-keywords
 889   (cond-emacs-xemacs
 890    `((antlr-invalidate-context-cache)
 891      ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))"
 892       (1 antlr-font-lock-tokendef-face))
 893      ("\\$\\sw+" (0 font-lock-keyword-face))
 894      ;; the tokens are already fontified as string/docstrings:
 895      (,(lambda (limit)
 896          (if antlr-font-lock-literal-regexp
 897              (antlr-re-search-forward antlr-font-lock-literal-regexp limit)))
 898       (1 antlr-font-lock-literal-face t)
 899       :XEMACS (0 nil))                  ; XEmacs bug workaround
 900      (,(lambda (limit)
 901          (antlr-re-search-forward antlr-class-header-regexp limit))
 902       (1 antlr-font-lock-keyword-face)
 903       (2 antlr-font-lock-ruledef-face)
 904       (3 antlr-font-lock-keyword-face)
 905       (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
 906              'antlr-font-lock-keyword-face
 907            'font-lock-type-face)))
 908      (,(lambda (limit)
 909          (antlr-re-search-forward
 910           "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
 911           limit))
 912      (1 antlr-font-lock-keyword-face))
 913      (,(lambda (limit)
 914          (antlr-re-search-forward
 915           "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?"
 916           limit))
 917      (1 font-lock-type-face)            ; not XEmacs' java level-3 fruit salad
 918      (3 (if (antlr-upcase-p (char-after (match-beginning 3)))
 919             'antlr-font-lock-tokendef-face
 920           'antlr-font-lock-ruledef-face) nil t)
 921      (4 antlr-font-lock-syntax-face nil t))
 922      (,(lambda (limit)
 923          (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit))
 924      (1 (if (antlr-upcase-p (char-after (match-beginning 0)))
 925             'antlr-font-lock-tokendef-face
 926           'antlr-font-lock-ruledef-face) nil t)
 927      (2 antlr-font-lock-syntax-face nil t))
 928      (,(lambda (limit)
 929          ;; v:ruleref and v:"literal" is allowed...
 930          (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit))
 931      (1 (if (match-beginning 2)
 932             (if (eq (char-after (match-beginning 2)) ?=)
 933                 'antlr-font-lock-default-face
 934               'font-lock-variable-name-face)
 935           (if (antlr-upcase-p (char-after (match-beginning 1)))
 936               'antlr-font-lock-tokenref-face
 937             'antlr-font-lock-ruleref-face)))
 938      (2 antlr-font-lock-default-face nil t))
 939      (,(lambda (limit)
 940          (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit))
 941      (0 'antlr-font-lock-syntax-face))))
 942   "Font-lock keywords for ANTLR's normal grammar code.
 943 See `antlr-font-lock-keywords-alist' for the keywords of actions.")
 944
 945 (defvar antlr-font-lock-defaults
 946   '(antlr-font-lock-keywords
 947     nil nil ((?_ . "w") (?\( . ".") (?\) . ".")) beginning-of-defun)
 948   "Font-lock defaults used for ANTLR syntax highlighting.
 949 The SYNTAX-ALIST element is also used to initialize
 950 `antlr-action-syntax-table'.")
 951
 952
 953 ;;;===========================================================================
 954 ;;;  Internal variables
 955 ;;;===========================================================================
 956
 957 (defvar antlr-mode-hook nil
 958   "Hook called by `antlr-mode'.")
 959
 960 (defvar antlr-mode-syntax-table nil
 961   "Syntax table used in `antlr-mode' buffers.
 962 If non-nil, it will be initialized in `antlr-mode'.")
 963
 964 ;; used for "in Java/C++ code" = syntactic-depth>0
 965 (defvar antlr-action-syntax-table nil
 966   "Syntax table used for ANTLR action parsing.
 967 Initialized by `antlr-mode-syntax-table', changed by SYNTAX-ALIST in
 968 `antlr-font-lock-defaults'.  This table should be selected if you use
 969 `buffer-syntactic-context' and `buffer-syntactic-context-depth' in order
 970 not to confuse their context_cache.")
 971
 972 (defvar antlr-mode-abbrev-table nil
 973   "Abbreviation table used in `antlr-mode' buffers.")
 974 (define-abbrev-table 'antlr-mode-abbrev-table ())
 975
 976 (defvar antlr-slow-cache-enabling-symbol 'loudly
 977 ;; Emacs' font-lock changes buffer's tick counter, therefore this value should
 978 ;; be a parameter of a font-lock function, but not any other variable of
 979 ;; functions which call `antlr-slow-syntactic-context'.
 980   "If value is a bound symbol, cache will be used even with text changes.
 981 This is no user option.  Used for `antlr-slow-syntactic-context'.")
 982
 983 (defvar antlr-slow-cache-diff-threshold 5000
 984   "Maximum distance between `point' and cache position for cache use.
 985 Used for `antlr-slow-syntactic-context'.")
 986
 987
 988 ;;;;##########################################################################
 989 ;;;;  The Code
 990 ;;;;##########################################################################
 991
 992
 993
 994 ;;;===========================================================================
 995 ;;;  Syntax functions -- Emacs vs XEmacs dependent, part 1
 996 ;;;===========================================================================
 997
 998 ;; From help.el (XEmacs-21.1), without `copy-syntax-table'
 999 (defmacro antlr-with-syntax-table (syntab &rest body)
1000   "Evaluate BODY with the syntax table SYNTAB."
1001   `(let ((stab (syntax-table)))
1002      (unwind-protect
1003          (progn (set-syntax-table ,syntab) ,@body)
1004        (set-syntax-table stab))))
1005 (put 'antlr-with-syntax-table 'lisp-indent-function 1)
1006 (put 'antlr-with-syntax-table 'edebug-form-spec '(form body))
1007
1008 (defunx antlr-default-directory ()
1009   :xemacs-and-try default-directory
1010   "Return `default-directory'."
1011   default-directory)
1012
1013 ;; Check Emacs-21.1 simple.el, `shell-command'.
1014 (defunx antlr-read-shell-command (prompt &optional initial-input history)
1015   :xemacs-and-try read-shell-command
1016   "Read a string from the minibuffer, using `shell-command-history'."
1017   (read-from-minibuffer prompt initial-input nil nil
1018                         (or history 'shell-command-history)))
1019
1020 (defunx antlr-with-displaying-help-buffer (thunk &optional name)
1021   :xemacs-and-try with-displaying-help-buffer
1022   "Make a help buffer and call `thunk' there."
1023   (with-output-to-temp-buffer "*Help*"
1024     (save-excursion (funcall thunk))))
1025
1026
1027 ;;;===========================================================================
1028 ;;;  Context cache
1029 ;;;===========================================================================
1030
1031 (defvar antlr-slow-context-cache nil "Internal.")
1032
1033 ;;;(defvar antlr-statistics-full-neg 0)
1034 ;;;(defvar antlr-statistics-full-diff 0)
1035 ;;;(defvar antlr-statistics-full-other 0)
1036 ;;;(defvar antlr-statistics-cache 0)
1037 ;;;(defvar antlr-statistics-inval 0)
1038
1039 (defunx antlr-invalidate-context-cache (&rest dummies)
1040 ;; checkdoc-params: (dummies)
1041   "Invalidate context cache for syntactical context information."
1042   :XEMACS                               ; XEmacs bug workaround
1043   (save-excursion
1044     (set-buffer (get-buffer-create " ANTLR XEmacs bug workaround"))
1045     (buffer-syntactic-context-depth)
1046     nil)
1047   :EMACS
1048 ;;;  (incf antlr-statistics-inval)
1049   (setq antlr-slow-context-cache nil))
1050
1051 (defunx antlr-syntactic-context ()
1052   "Return some syntactic context information.
1053 Return `string' if point is within a string, `block-comment' or
1054 `comment' is point is within a comment or the depth within all
1055 parenthesis-syntax delimiters at point otherwise.
1056 WARNING: this may alter `match-data'."
1057   :XEMACS
1058   (or (buffer-syntactic-context) (buffer-syntactic-context-depth))
1059   :EMACS
1060   (let ((orig (point)) diff state
1061         ;; Arg, Emacs' (buffer-modified-tick) changes with font-lock.  Use
1062         ;; hack that `loudly' is bound during font-locking => cache use will
1063         ;; increase from 7% to 99.99% during font-locking.
1064         (tick (or (boundp antlr-slow-cache-enabling-symbol)
1065                   (buffer-modified-tick))))
1066     (if (and (cdr antlr-slow-context-cache)
1067              (>= (setq diff (- orig (cadr antlr-slow-context-cache))) 0)
1068              (< diff antlr-slow-cache-diff-threshold)
1069              (eq (current-buffer) (caar antlr-slow-context-cache))
1070              (eq tick (cdar antlr-slow-context-cache)))
1071         ;; (setq antlr-statistics-cache (1+ antlr-statistics-cache) ...)
1072         (setq state (parse-partial-sexp (cadr antlr-slow-context-cache) orig
1073                                         nil nil
1074                                         (cddr antlr-slow-context-cache)))
1075       (if (>= orig antlr-slow-cache-diff-threshold)
1076           (beginning-of-defun)
1077         (goto-char (point-min)))
1078 ;;;      (cond ((and diff (< diff 0)) (incf antlr-statistics-full-neg))
1079 ;;;         ((and diff (>= diff 3000)) (incf antlr-statistics-full-diff))
1080 ;;;         (t (incf antlr-statistics-full-other)))
1081       (setq state (parse-partial-sexp (point) orig)))
1082     (goto-char orig)
1083     (if antlr-slow-context-cache
1084         (setcdr antlr-slow-context-cache (cons orig state))
1085       (setq antlr-slow-context-cache
1086             (cons (cons (current-buffer) tick)
1087                   (cons orig state))))
1088     (cond ((nth 3 state) 'string)
1089           ((nth 4 state) 'comment)      ; block-comment? -- we don't care
1090           (t (car state)))))
1091
1092 ;;;  (incf (aref antlr-statistics 2))
1093 ;;;  (unless (and (eq (current-buffer)
1094 ;;;                (caar antlr-slow-context-cache))
1095 ;;;            (eq (buffer-modified-tick)
1096 ;;;                (cdar antlr-slow-context-cache)))
1097 ;;;    (incf (aref antlr-statistics 1))
1098 ;;;    (setq antlr-slow-context-cache nil))
1099 ;;;  (let* ((orig (point))
1100 ;;;      (base (cadr antlr-slow-context-cache))
1101 ;;;      (curr (cddr antlr-slow-context-cache))
1102 ;;;      (state (cond ((eq orig (car curr)) (cdr curr))
1103 ;;;                   ((eq orig (car base)) (cdr base))))
1104 ;;;      diff diff2)
1105 ;;;    (unless state
1106 ;;;      (incf (aref antlr-statistics 3))
1107 ;;;      (when curr
1108 ;;;     (if (< (setq diff  (abs (- orig (car curr))))
1109 ;;;            (setq diff2 (abs (- orig (car base)))))
1110 ;;;         (setq state curr)
1111 ;;;       (setq state base
1112 ;;;             diff  diff2))
1113 ;;;     (if (or (>= (1+ diff) (point)) (>= diff 3000))
1114 ;;;         (setq state nil)))          ; start from bod/bob
1115 ;;;      (if state
1116 ;;;       (setq state
1117 ;;;             (parse-partial-sexp (car state) orig nil nil (cdr state)))
1118 ;;;     (if (>= orig 3000) (beginning-of-defun) (goto-char (point-min)))
1119 ;;;     (incf (aref antlr-statistics 4))
1120 ;;;     (setq cw (list orig (point) base curr))
1121 ;;;     (setq state (parse-partial-sexp (point) orig)))
1122 ;;;      (goto-char orig)
1123 ;;;      (if antlr-slow-context-cache
1124 ;;;       (setcdr (cdr antlr-slow-context-cache) (cons orig state))
1125 ;;;     (setq antlr-slow-context-cache
1126 ;;;           (cons (cons (current-buffer) (buffer-modified-tick))
1127 ;;;                 (cons (cons orig state) (cons orig state))))))
1128 ;;;    (cond ((nth 3 state) 'string)
1129 ;;;       ((nth 4 state) 'comment)      ; block-comment? -- we don't care
1130 ;;;       (t (car state)))))
1131
1132 ;;;    (beginning-of-defun)
1133 ;;;    (let ((state (parse-partial-sexp (point) orig)))
1134 ;;;      (goto-char orig)
1135 ;;;      (cond ((nth 3 state) 'string)
1136 ;;;         ((nth 4 state) 'comment)    ; block-comment? -- we don't care
1137 ;;;         (t (car state))))))
1138
1139
1140 ;;;===========================================================================
1141 ;;;  Miscellaneous functions
1142 ;;;===========================================================================
1143
1144 (defun antlr-upcase-p (char)
1145   "Non-nil, if CHAR is an uppercase character (if CHAR was a char)."
1146   ;; in XEmacs, upcase only works for ASCII
1147   (or (and (<= ?A char) (<= char ?Z))
1148       (and (<= ?\300 char) (<= char ?\337)))) ; ?\327 is no letter
1149
1150 (defun antlr-re-search-forward (regexp bound)
1151   "Search forward from point for regular expression REGEXP.
1152 Set point to the end of the occurrence found, and return point.  Return
1153 nil if no occurrence was found.  Do not search within comments, strings
1154 and actions/semantic predicates.  BOUND bounds the search; it is a
1155 buffer position.  See also the functions `match-beginning', `match-end'
1156 and `replace-match'."
1157   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
1158   (let ((continue t))
1159     (while (and (re-search-forward regexp bound 'limit)
1160                 (save-match-data
1161                   (if (eq (antlr-syntactic-context) 0)
1162                       (setq continue nil)
1163                     t))))
1164     (if continue nil (point))))
1165
1166 (defun antlr-search-forward (string)
1167   "Search forward from point for STRING.
1168 Set point to the end of the occurrence found, and return point.  Return
1169 nil if no occurrence was found.  Do not search within comments, strings
1170 and actions/semantic predicates."
1171   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
1172   (let ((continue t))
1173     (while (and (search-forward string nil 'limit)
1174                 (if (eq (antlr-syntactic-context) 0) (setq continue nil) t)))
1175     (if continue nil (point))))
1176
1177 (defun antlr-search-backward (string)
1178   "Search backward from point for STRING.
1179 Set point to the beginning of the occurrence found, and return point.
1180 Return nil if no occurrence was found.  Do not search within comments,
1181 strings and actions/semantic predicates."
1182   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
1183   (let ((continue t))
1184     (while (and (search-backward string nil 'limit)
1185                 (if (eq (antlr-syntactic-context) 0) (setq continue nil) t)))
1186     (if continue nil (point))))
1187
1188 (defsubst antlr-skip-sexps (count)
1189   "Skip the next COUNT balanced expressions and the comments after it.
1190 Return position before the comments after the last expression."
1191   (goto-char (or (ignore-errors-x (scan-sexps (point) count)) (point-max)))
1192   (prog1 (point)
1193     (c-forward-syntactic-ws)))
1194
1195
1196 ;;;===========================================================================
1197 ;;;  font-lock
1198 ;;;===========================================================================
1199
1200 (defun antlr-font-lock-keywords ()
1201   "Return font-lock keywords for current buffer.
1202 See `antlr-font-lock-additional-keywords', `antlr-language' and
1203 `antlr-font-lock-maximum-decoration'."
1204   (if (eq antlr-font-lock-maximum-decoration 'none)
1205       antlr-font-lock-additional-keywords
1206     (append antlr-font-lock-additional-keywords
1207             (eval (let ((major-mode antlr-language)) ; dynamic
1208                         (font-lock-choose-keywords
1209                          (cdr (assq antlr-language
1210                                     antlr-font-lock-keywords-alist))
1211                          (if (eq antlr-font-lock-maximum-decoration 'inherit)
1212                              font-lock-maximum-decoration
1213                            antlr-font-lock-maximum-decoration)))))))
1214
1215
1216 ;;;===========================================================================
1217 ;;;  imenu support
1218 ;;;===========================================================================
1219
1220 (defun antlr-grammar-tokens ()
1221   "Return alist for tokens defined in current buffer."
1222   (save-excursion (antlr-imenu-create-index-function t)))
1223
1224 (defun antlr-imenu-create-index-function (&optional tokenrefs-only)
1225   "Return imenu index-alist for ANTLR grammar files.
1226 IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names."
1227   (let ((items nil)
1228         (classes nil)
1229         (continue t))
1230     ;; Using `imenu-progress-message' would require imenu for compilation, but
1231     ;; nobody is missing these messages.  The generic imenu function searches
1232     ;; backward, which is slower and more likely not to work during editing.
1233     (antlr-with-syntax-table antlr-action-syntax-table
1234       (antlr-invalidate-context-cache)
1235       (goto-char (point-min))
1236       (antlr-skip-file-prelude t)
1237       (while continue
1238         (if (looking-at "{") (antlr-skip-sexps 1))
1239         (if (looking-at antlr-class-header-regexp)
1240             (or tokenrefs-only
1241                 (push (cons (match-string 2)
1242                             (if imenu-use-markers
1243                                 (copy-marker (match-beginning 2))
1244                               (match-beginning 2)))
1245                       classes))
1246           (if (looking-at "p\\(ublic\\|rotected\\|rivate\\)")
1247               (antlr-skip-sexps 1))
1248           (when (looking-at "\\sw+")
1249             (if tokenrefs-only
1250                 (if (antlr-upcase-p (char-after (point)))
1251                     (push (list (match-string 0)) items))
1252               (push (cons (match-string 0)
1253                           (if imenu-use-markers
1254                               (copy-marker (match-beginning 0))
1255                             (match-beginning 0)))
1256                     items))))
1257         (if (setq continue (antlr-search-forward ";"))
1258             (antlr-skip-exception-part t))))
1259     (if classes
1260         (cons (cons "Classes" (nreverse classes)) (nreverse items))
1261       (nreverse items))))
1262
1263
1264 ;;;===========================================================================
1265 ;;;  Parse grammar files (internal functions)
1266 ;;;===========================================================================
1267
1268 (defun antlr-skip-exception-part (skip-comment)
1269   "Skip exception part of current rule, i.e., everything after `;'.
1270 This also includes the options and tokens part of a grammar class
1271 header.  If SKIP-COMMENT is non-nil, also skip the comment after that
1272 part."
1273   (let ((pos (point))
1274         (class nil))
1275     (c-forward-syntactic-ws)
1276     (while (looking-at "options\\>\\|tokens\\>")
1277       (setq class t)
1278       (setq pos (antlr-skip-sexps 2)))
1279     (if class
1280         ;; Problem: an action only belongs to a class def, not a normal rule.
1281         ;; But checking the current rule type is too expensive => only expect
1282         ;; an action if we have found an option or tokens part.
1283         (if (looking-at "{") (setq pos (antlr-skip-sexps 1)))
1284       (while (looking-at "exception\\>")
1285         (setq pos (antlr-skip-sexps 1))
1286         (when (looking-at "\\[")
1287           (setq pos (antlr-skip-sexps 1)))
1288         (while (looking-at "catch\\>")
1289           (setq pos (antlr-skip-sexps 3)))))
1290     (or skip-comment (goto-char pos))))
1291
1292 (defun antlr-skip-file-prelude (skip-comment)
1293   "Skip the file prelude: the header and file options.
1294 If SKIP-COMMENT is non-nil, also skip the comment after that part.
1295 Return the start position of the file prelude.
1296
1297 Hack: if SKIP-COMMENT is `header-only' only skip header and return
1298 position before the comment after the header."
1299   (let* ((pos (point))
1300          (pos0 pos))
1301     (c-forward-syntactic-ws)
1302     (if skip-comment (setq pos0 (point)))
1303     (while (looking-at "header\\>[ \t]*\\(\"\\)?")
1304       (setq pos (antlr-skip-sexps (if (match-beginning 1) 3 2))))
1305     (if (eq skip-comment 'header-only)  ; a hack...
1306         pos
1307       (when (looking-at "options\\>")
1308         (setq pos (antlr-skip-sexps 2)))
1309       (or skip-comment (goto-char pos))
1310       pos0)))
1311
1312 (defun antlr-next-rule (arg skip-comment)
1313   "Move forward to next end of rule.  Do it ARG many times.
1314 A grammar class header and the file prelude are also considered as a
1315 rule.  Negative argument ARG means move back to ARGth preceding end of
1316 rule.  The behavior is not defined when ARG is zero.  If SKIP-COMMENT
1317 is non-nil, move to beginning of the rule."
1318   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
1319   ;; PRE: ARG<>0
1320   (let ((pos (point))
1321         (beg (point)))
1322     ;; first look whether point is in exception part
1323     (if (antlr-search-backward ";")
1324         (progn
1325           (setq beg (point))
1326           (forward-char)
1327           (antlr-skip-exception-part skip-comment))
1328       (antlr-skip-file-prelude skip-comment))
1329     (if (< arg 0)
1330         (unless (and (< (point) pos) (zerop (incf arg)))
1331           ;; if we have moved backward, we already moved one defun backward
1332           (goto-char beg)               ; rewind (to ";" / point)
1333           (while (and arg (<= (incf arg) 0))
1334             (if (antlr-search-backward ";")
1335                 (setq beg (point))
1336               (when (>= arg -1)
1337                 ;; try file prelude:
1338                 (setq pos (antlr-skip-file-prelude skip-comment))
1339                 (if (zerop arg)
1340                     (if (>= (point) beg)
1341                         (goto-char (if (>= pos beg) (point-min) pos)))
1342                   (goto-char (if (or (>= (point) beg) (= (point) pos))
1343                                  (point-min) pos))))
1344               (setq arg nil)))
1345           (when arg                     ; always found a ";"
1346             (forward-char)
1347             (antlr-skip-exception-part skip-comment)))
1348       (if (<= (point) pos)              ; moved backward?
1349           (goto-char pos)               ; rewind
1350         (decf arg))                     ; already moved one defun forward
1351       (unless (zerop arg)
1352         (while (>= (decf arg) 0)
1353           (antlr-search-forward ";"))
1354         (antlr-skip-exception-part skip-comment)))))
1355
1356 (defun antlr-outside-rule-p ()
1357   "Non-nil if point is outside a grammar rule.
1358 Move to the beginning of the current rule if point is inside a rule."
1359   ;; WARNING: Should only be used with `antlr-action-syntax-table'!
1360   (let ((pos (point)))
1361     (antlr-next-rule -1 nil)
1362     (let ((between (or (bobp) (< (point) pos))))
1363       (c-forward-syntactic-ws)
1364       (and between (> (point) pos) (goto-char pos)))))
1365
1366
1367 ;;;===========================================================================
1368 ;;;  Parse grammar files (commands)
1369 ;;;===========================================================================
1370 ;; No (interactive "_") in Emacs... use `zmacs-region-stays'.
1371
1372 (defun antlr-inside-rule-p ()
1373   "Non-nil if point is inside a grammar rule.
1374 A grammar class header and the file prelude are also considered as a
1375 rule."
1376   (save-excursion
1377     (antlr-with-syntax-table antlr-action-syntax-table
1378       (not (antlr-outside-rule-p)))))
1379
1380 (defunx antlr-end-of-rule (&optional arg)
1381   "Move forward to next end of rule.  Do it ARG [default: 1] many times.
1382 A grammar class header and the file prelude are also considered as a
1383 rule.  Negative argument ARG means move back to ARGth preceding end of
1384 rule.  If ARG is zero, run `antlr-end-of-body'."
1385   (interactive "_p")
1386   (if (zerop arg)
1387       (antlr-end-of-body)
1388     (antlr-with-syntax-table antlr-action-syntax-table
1389       (antlr-next-rule arg nil))))
1390
1391 (defunx antlr-beginning-of-rule (&optional arg)
1392   "Move backward to preceding beginning of rule.  Do it ARG many times.
1393 A grammar class header and the file prelude are also considered as a
1394 rule.  Negative argument ARG means move forward to ARGth next beginning
1395 of rule.  If ARG is zero, run `antlr-beginning-of-body'."
1396   (interactive "_p")
1397   (if (zerop arg)
1398       (antlr-beginning-of-body)
1399     (antlr-with-syntax-table antlr-action-syntax-table
1400       (antlr-next-rule (- arg) t))))
1401
1402 (defunx antlr-end-of-body (&optional msg)
1403   "Move to position after the `;' of the current rule.
1404 A grammar class header is also considered as a rule.  With optional
1405 prefix arg MSG, move to `:'."
1406   (interactive "_")
1407   (antlr-with-syntax-table antlr-action-syntax-table
1408     (let ((orig (point)))
1409       (if (antlr-outside-rule-p)
1410           (error "Outside an ANTLR rule"))
1411       (let ((bor (point)))
1412         (when (< (antlr-skip-file-prelude t) (point))
1413           ;; Yes, we are in the file prelude
1414           (goto-char orig)
1415           (error (or msg "The file prelude is without `;'")))
1416         (antlr-search-forward ";")
1417         (when msg
1418           (when (< (point)
1419                    (progn (goto-char bor)
1420                           (or (antlr-search-forward ":") (point-max))))
1421             (goto-char orig)
1422             (error msg))
1423           (c-forward-syntactic-ws))))))
1424
1425 (defunx antlr-beginning-of-body ()
1426   "Move to the first element after the `:' of the current rule."
1427   (interactive "_")
1428   (antlr-end-of-body "Class headers and the file prelude are without `:'"))
1429
1430
1431 ;;;===========================================================================
1432 ;;;  Literal normalization, Hide Actions
1433 ;;;===========================================================================
1434
1435 (defun antlr-downcase-literals (&optional transform)
1436   "Convert all literals in buffer to lower case.
1437 If non-nil, TRANSFORM is used on literals instead of `downcase-region'."
1438   (interactive)
1439   (or transform (setq transform 'downcase-region))
1440   (let ((literals 0))
1441     (save-excursion
1442       (goto-char (point-min))
1443       (antlr-with-syntax-table antlr-action-syntax-table
1444         (antlr-invalidate-context-cache)
1445         (while (antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" nil)
1446           (funcall transform (match-beginning 0) (match-end 0))
1447           (incf literals))))
1448     (message "Transformed %d literals" literals)))
1449
1450 (defun antlr-upcase-literals ()
1451   "Convert all literals in buffer to upper case."
1452   (interactive)
1453   (antlr-downcase-literals 'upcase-region))
1454
1455 (defun antlr-hide-actions (arg &optional silent)
1456   "Hide or unhide all actions in buffer.
1457 Hide all actions including arguments in brackets if ARG is 1 or if
1458 called interactively without prefix argument.  Hide all actions
1459 excluding arguments in brackets if ARG is 2 or higher.  Unhide all
1460 actions if ARG is 0 or negative.  See `antlr-action-visibility'.
1461
1462 Display a message unless optional argument SILENT is non-nil."
1463   (interactive "p")
1464   (save-buffer-state-x
1465     (if (> arg 0)
1466         (let ((regexp (if (= arg 1) "[]}]" "}"))
1467               (diff (and antlr-action-visibility
1468                          (+ (max antlr-action-visibility 0) 2))))
1469           (antlr-hide-actions 0 t)
1470           (save-excursion
1471             (goto-char (point-min))
1472             (antlr-with-syntax-table antlr-action-syntax-table
1473               (antlr-invalidate-context-cache)
1474               (while (antlr-re-search-forward regexp nil)
1475                 (let ((beg (ignore-errors-x (scan-sexps (point) -1))))
1476                   (when beg
1477                     (if diff            ; braces are visible
1478                         (if (> (point) (+ beg diff))
1479                             (add-text-properties (1+ beg) (1- (point))
1480                                                  '(invisible t intangible t)))
1481                       ;; if actions is on line(s) of its own, hide WS
1482                       (and (looking-at "[ \t]*$")
1483                            (save-excursion
1484                              (goto-char beg)
1485                              (skip-chars-backward " \t")
1486                              (and (bolp) (setq beg (point))))
1487                            (beginning-of-line 2)) ; beginning of next line
1488                       (add-text-properties beg (point)
1489                                            '(invisible t intangible t))))))))
1490           (or silent
1491               (message "Hide all actions (%s arguments)...done"
1492                        (if (= arg 1) "including" "excluding"))))
1493       (remove-text-properties (point-min) (point-max)
1494                               '(invisible nil intangible nil))
1495       (or silent
1496           (message "Unhide all actions (including arguments)...done")))))
1497
1498
1499 ;;;===========================================================================
1500 ;;;  Insert option: command
1501 ;;;===========================================================================
1502
1503 (defun antlr-insert-option (level option &optional location)
1504   "Insert file/grammar/rule/subrule option near point.
1505 LEVEL determines option kind to insert: 1=file, 2=grammar, 3=rule,
1506 4=subrule.  OPTION is a string with the name of the option to insert.
1507 LOCATION can be specified for not calling `antlr-option-kind' twice.
1508
1509 Inserting an option with this command works as follows:
1510
1511  1. When called interactively, LEVEL is determined by the prefix
1512     argument or automatically deduced without prefix argument.
1513  2. Signal an error if no option of that level could be inserted, e.g.,
1514     if the buffer is read-only, the option area is outside the visible
1515     part of the buffer or a subrule/rule option should be inserted with
1516     point outside a subrule/rule.
1517  3. When called interactively, OPTION is read from the minibuffer with
1518     completion over the known options of the given LEVEL.
1519  4. Ask user for confirmation if the given OPTION does not seem to be a
1520     valid option to insert into the current file.
1521  5. Find a correct position to insert the option.
1522  6. Depending on the option, insert it the following way \(inserting an
1523     option also means inserting the option section if necessary\):
1524      - Insert the option and let user insert the value at point.
1525      - Read a value (with completion) from the minibuffer, using a
1526        previous value as initial contents, and insert option with value.
1527  7. Final action depending on the option.  For example, set the language
1528     according to a newly inserted language option.
1529
1530 The name of all options with a specification for their values are stored
1531 in `antlr-options-alists'.  The used specification also depends on the
1532 value of `antlr-tool-version', i.e., step 4 will warn you if you use an
1533 option that has been introduced in newer version of ANTLR, and step 5
1534 will offer completion using version-correct values.
1535
1536 If the option already exists inside the visible part of the buffer, this
1537 command can be used to change the value of that option.  Otherwise, find
1538 a correct position where the option can be inserted near point.
1539
1540 The search for a correct position is as follows:
1541
1542   * If search is within an area where options can be inserted, use the
1543     position of point.  Inside the options section and if point is in
1544     the middle of a option definition, skip the rest of it.
1545   * If an options section already exists, insert the options at the end.
1546     If only the beginning of the area is visible, insert at the
1547     beginning.
1548   * Otherwise, find the position where an options section can be
1549     inserted and insert a new section before any comments.  If the
1550     position before the comments is not visible, insert the new section
1551     after the comments.
1552
1553 This function also inserts \"options {...}\" and the \":\" if necessary,
1554 see `antlr-options-auto-colon'.  See also `antlr-options-assign-string'.
1555
1556 This command might also set the mark like \\[set-mark-command] does, see
1557 `antlr-options-push-mark'."
1558   (interactive (antlr-insert-option-interactive current-prefix-arg))
1559   (barf-if-buffer-read-only)
1560   (or location (setq location (cdr (antlr-option-kind level))))
1561   (cond ((null level)
1562          (error "Cannot deduce what kind of option to insert"))
1563         ((atom location)
1564          (error "Cannot insert any %s options around here"
1565                 (elt antlr-options-headings (1- level)))))
1566   (let ((area (car location))
1567         (place (cdr location)))
1568     (cond ((null place)         ; invisible
1569            (error (if area
1570                       "Invisible %s options, use %s to make them visible"
1571                     "Invisible area for %s options, use %s to make it visible")
1572                   (elt antlr-options-headings (1- level))
1573                   (substitute-command-keys "\\[widen]")))
1574           ((null area)                  ; without option part
1575            (antlr-insert-option-do level option nil
1576                                    (null (cdr place))
1577                                    (car place)))
1578           ((save-excursion              ; with option part, option visible
1579              (goto-char (max (point-min) (car area)))
1580              (re-search-forward (concat "\\(^\\|;\\)[ \t]*\\(\\<"
1581                                         (regexp-quote option)
1582                                         "\\>\\)[ \t\n]*\\(\\(=[ \t]?\\)[ \t]*\\(\\(\\sw\\|\\s_\\)+\\|\"\\([^\n\"\\]\\|[\\][^\n]\\)*\"\\)?\\)?")
1583                                 ;; 2=name, 3=4+5, 4="=", 5=value
1584                                 (min (point-max) (cdr area))
1585                                 t))
1586            (antlr-insert-option-do level option
1587                                    (cons (or (match-beginning 5)
1588                                              (match-beginning 3))
1589                                          (match-end 5))
1590                                    (and (null (cdr place)) area)
1591                                    (or (match-beginning 5)
1592                                        (match-end 4)
1593                                        (match-end 2))))
1594           (t                            ; with option part, option not yet
1595            (antlr-insert-option-do level option t
1596                                    (and (null (cdr place)) area)
1597                                    (car place))))))
1598
1599 (defun antlr-insert-option-interactive (arg)
1600   "Interactive specification for `antlr-insert-option'.
1601 Use prefix argument ARG to return \(LEVEL OPTION LOCATION)."
1602   (barf-if-buffer-read-only)
1603   (if arg (setq arg (prefix-numeric-value arg)))
1604   (unless (memq arg '(nil 1 2 3 4))
1605     (error "Valid prefix args: no=auto, 1=file, 2=grammar, 3=rule, 4=subrule"))
1606   (let* ((kind (antlr-option-kind arg))
1607          (level (car kind)))
1608     (if (atom (cdr kind))
1609         (list level nil (cdr kind))
1610       (let* ((table (elt antlr-options-alists (1- level)))
1611              (completion-ignore-case t) ;dynamic
1612              (input (completing-read (format "Insert %s option: "
1613                                              (elt antlr-options-headings
1614                                                   (1- level)))
1615                                      table)))
1616         (list level input (cdr kind))))))
1617
1618 (defun antlr-options-menu-filter (level menu-items)
1619   "Return items for options submenu of level LEVEL."
1620   ;; checkdoc-params: (menu-items)
1621   (let ((active (if buffer-read-only
1622                     nil
1623                   (consp (cdr-safe (cdr (antlr-option-kind level)))))))
1624     (mapcar (lambda (option)
1625               (vector option
1626                       (list 'antlr-insert-option level option)
1627                       :active active))
1628             (sort (mapcar 'car (elt antlr-options-alists (1- level)))
1629                   'string-lessp))))
1630
1631
1632 ;;;===========================================================================
1633 ;;;  Insert option: determine section-kind
1634 ;;;===========================================================================
1635
1636 (defun antlr-option-kind (requested)
1637   "Return level and location for option to insert near point.
1638 Call function `antlr-option-level' with argument REQUESTED.  If the
1639 result is nil, return \(REQUESTED \. error).  If the result has the
1640 non-nil value LEVEL, return \(LEVEL \. LOCATION) where LOCATION looks
1641 like \(AREA \. PLACE), see `antlr-option-location'."
1642   (save-excursion
1643     (save-restriction
1644       (let ((min0 (point-min))          ; before `widen'!
1645             (max0 (point-max))
1646             (orig (point))
1647             (level (antlr-option-level requested)) ; calls `widen'!
1648             pos)
1649         (cond ((null level)
1650                (setq level requested))
1651               ((eq level 1)             ; file options
1652                (goto-char (point-min))
1653                (setq pos (antlr-skip-file-prelude 'header-only)))
1654               ((not (eq level 3))       ; grammar or subrule options
1655                (setq pos (point))
1656                (c-forward-syntactic-ws))
1657               ((looking-at "^\\(private[ \t\n]\\|public[ \t\n]\\|protected[ \t\n]\\)?[ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t\n]*\\(!\\)?[ \t\n]*\\(\\[\\)?")
1658                ;; rule options, with complete rule header
1659                (goto-char (or (match-end 4) (match-end 3)))
1660                (setq pos (antlr-skip-sexps (if (match-end 5) 1 0)))
1661                (when (looking-at "returns[ \t\n]*\\[")
1662                  (goto-char (1- (match-end 0)))
1663                  (setq pos (antlr-skip-sexps 1)))))
1664         (cons level
1665               (cond ((null pos) 'error)
1666                     ((looking-at "options[ \t\n]*{")
1667                      (goto-char (match-end 0))
1668                      (setq pos (ignore-errors-x (scan-lists (point) 1 1)))
1669                      (antlr-option-location orig min0 max0
1670                                             (point)
1671                                             (if pos (1- pos) (point-max))
1672                                             t))
1673                     (t
1674                      (antlr-option-location orig min0 max0
1675                                             pos (point)
1676                                             nil))))))))
1677
1678 (defun antlr-option-level (requested)
1679   "Return level for option to insert near point.
1680 Remove any restrictions from current buffer and return level for the
1681 option to insert near point, i.e., 1, 2, 3, 4, or nil if no such option
1682 can be inserted.  If REQUESTED is non-nil, it is the only possible value
1683 to return except nil.  If REQUESTED is nil, return level for the nearest
1684 option kind, i.e., the highest number possible.
1685
1686 If the result is 2, point is at the beginning of the class after the
1687 class definition.  If the result is 3 or 4, point is at the beginning of
1688 the rule/subrule after the init action.  Otherwise, the point position
1689 is undefined."
1690   (widen)
1691   (if (eq requested 1)
1692       1
1693     (antlr-with-syntax-table antlr-action-syntax-table
1694       (antlr-invalidate-context-cache)
1695       (let* ((orig (point))
1696              (outsidep (antlr-outside-rule-p))
1697              bor depth)
1698         (if (eq (char-after) ?\{) (antlr-skip-sexps 1))
1699         (setq bor (point))              ; beginning of rule (after init action)
1700         (cond ((eq requested 2)         ; grammar options required?
1701                (let (boc)               ; beginning of class
1702                  (goto-char (point-min))
1703                  (while (and (<= (point) bor)
1704                              (antlr-re-search-forward antlr-class-header-regexp
1705                                                       nil))
1706                    (if (<= (match-beginning 0) bor)
1707                        (setq boc (match-end 0))))
1708                  (when boc
1709                    (goto-char boc)
1710                    2)))
1711               ((save-excursion          ; in region of file options?
1712                  (goto-char (point-min))
1713                  (antlr-skip-file-prelude t) ; ws/comment after: OK
1714                  (< orig (point)))
1715                (and (null requested) 1))
1716               (outsidep                 ; outside rule not OK
1717                nil)
1718               ((looking-at antlr-class-header-regexp) ; rule = class def?
1719                (goto-char (match-end 0))
1720                (and (null requested) 2))
1721               ((eq requested 3)         ; rule options required?
1722                (goto-char bor)
1723                3)
1724               ((setq depth (antlr-syntactic-grammar-depth orig bor))
1725                (if (> depth 0)          ; move out of actions
1726                    (goto-char (scan-lists (point) -1 depth)))
1727                (set-syntax-table antlr-mode-syntax-table)
1728                (antlr-invalidate-context-cache)
1729                (if (eq (antlr-syntactic-context) 0) ; not in subrule?
1730                    (unless (eq requested 4)
1731                      (goto-char bor)
1732                      3)
1733                  (goto-char (1+ (scan-lists (point) -1 1)))
1734                  4)))))))
1735
1736 (defun antlr-option-location (orig min-vis max-vis min-area max-area withp)
1737   "Return location for the options area.
1738 ORIG is the original position of `point', MIN-VIS is `point-min' and
1739 MAX-VIS is `point-max'.  If WITHP is non-nil, there exists an option
1740 specification and it starts after the brace at MIN-AREA and stops at
1741 MAX-AREA.  If WITHP is nil, there is no area and the region where it
1742 could be inserted starts at MIN-AREA and stops at MAX-AREA.
1743
1744 The result has the form (AREA . PLACE).  AREA is (MIN-AREA . MAX-AREA)
1745 if WITHP is non-nil, and nil otherwise.  PLACE is nil if the area is
1746 invisible, (ORIG) if ORIG is inside the area, (MIN-AREA . beginning) for
1747 a visible start position and (MAX-AREA . end) for a visible end position
1748 where the beginning is preferred if WITHP is nil and the end if WITHP is
1749 non-nil."
1750   (cons (and withp (cons min-area max-area))
1751         (cond ((and (<= min-area orig) (<= orig max-area)
1752                     (save-excursion
1753                       (goto-char orig)
1754                       (not (memq (antlr-syntactic-context)
1755                                  '(comment block-comment)))))
1756                ;; point in options area and not in comment
1757                (list orig))
1758               ((and (null withp) (<= min-vis min-area) (<= min-area max-vis))
1759                ;; use start of options area (only if not `withp')
1760                (cons min-area 'beginning))
1761               ((and (<= min-vis max-area) (<= max-area max-vis))
1762                ;; use end of options area
1763                (cons max-area 'end))
1764               ((and withp (<= min-vis min-area) (<= min-area max-vis))
1765                ;; use start of options area (only if `withp')
1766                (cons min-area 'beginning)))))
1767
1768 (defun antlr-syntactic-grammar-depth (pos beg)
1769   "Return syntactic context depth at POS.
1770 Move to POS and from there on to the beginning of the string or comment
1771 if POS is inside such a construct.  Then, return the syntactic context
1772 depth at point if the point position is smaller than BEG.
1773 WARNING: this may alter `match-data'."
1774   (goto-char pos)
1775   (let ((context (or (antlr-syntactic-context) 0)))
1776     (while (and context (not (integerp context)))
1777       (cond ((eq context 'string)
1778              (setq context
1779                    (and (search-backward "\"" nil t)
1780                         (>= (point) beg)
1781                         (or (antlr-syntactic-context) 0))))
1782             ((memq context '(comment block-comment))
1783              (setq context
1784                    (and (re-search-backward "/[/*]" nil t)
1785                         (>= (point) beg)
1786                         (or (antlr-syntactic-context) 0))))))
1787     context))
1788
1789
1790 ;;;===========================================================================
1791 ;;;  Insert options: do the insertion
1792 ;;;===========================================================================
1793
1794 (defun antlr-insert-option-do (level option old area pos)
1795   "Insert option into buffer at position POS.
1796 Insert option of level LEVEL and name OPTION.  If OLD is non-nil, an
1797 options area is already exists.  If OLD looks like \(BEG \. END), the
1798 option already exists.  Then, BEG is the start position of the option
1799 value, the position of the `=' or nil, and END is the end position of
1800 the option value or nil.
1801
1802 If the original point position was outside an options area, AREA is nil.
1803 Otherwise, and if an option specification already exists, AREA is a cons
1804 cell where the two values determine the area inside the braces."
1805   (let* ((spec (cdr (assoc option (elt antlr-options-alists (1- level)))))
1806          (value (antlr-option-spec level option (cdr spec) (consp old))))
1807     (if (fboundp (car spec)) (funcall (car spec) 'before-input option))
1808     ;; set mark (unless point was inside options area before)
1809     (if (cond (area (eq antlr-options-push-mark t))
1810               ((numberp antlr-options-push-mark)
1811                (> (count-lines (min (point) pos) (max (point) pos))
1812                   antlr-options-push-mark))
1813               (antlr-options-push-mark))
1814         (push-mark))
1815     ;; read option value -----------------------------------------------------
1816     (goto-char pos)
1817     (if (null value)
1818         ;; no option specification found
1819         (if (y-or-n-p (format "Insert unknown %s option %s? "
1820                               (elt antlr-options-headings (1- level))
1821                               option))
1822             (message "Insert value for %s option %s"
1823                      (elt antlr-options-headings (1- level))
1824                      option)
1825           (error "Didn't insert unknown %s option %s"
1826                  (elt antlr-options-headings (1- level))
1827                  option))
1828       ;; option specification found
1829       (setq value (cdr value))
1830       (if (car value)
1831           (let ((initial (and (consp old) (cdr old)
1832                               (buffer-substring (car old) (cdr old)))))
1833             (setq value (apply (car value)
1834                                (and initial
1835                                     (if (eq (aref initial 0) ?\")
1836                                         (read initial)
1837                                       initial))
1838                                (cdr value))))
1839         (message (cadr value))
1840         (setq value nil)))
1841     ;; insert value ----------------------------------------------------------
1842     (if (consp old)
1843         (antlr-insert-option-existing old value)
1844       (if (consp area)
1845           ;; Move outside string/comment if point is inside option spec
1846           (antlr-syntactic-grammar-depth (point) (car area)))
1847       (antlr-insert-option-space area old)
1848       (or old (antlr-insert-option-area level))
1849       (insert option " = ;")
1850       (backward-char)
1851       (if value (insert value)))
1852     ;; final -----------------------------------------------------------------
1853     (if (fboundp (car spec)) (funcall (car spec) 'after-insertion option))))
1854
1855 (defun antlr-option-spec (level option specs existsp)
1856   "Return version correct option value specification.
1857 Return specification for option OPTION of kind level LEVEL.  SPECS
1858 should correspond to the VALUE-SPEC... in `antlr-option-alists'.
1859 EXISTSP determines whether the option already exists."
1860   (let (value)
1861     (while (and specs (>= antlr-tool-version (caar specs)))
1862       (setq value (pop specs)))
1863     (cond (value)                       ; found correct spec
1864           ((null specs) nil)            ; didn't find any specs
1865           (existsp (car specs)) ; wrong version, but already present
1866           ((y-or-n-p (format "Insert v%s %s option %s in v%s? "
1867                              (antlr-version-string (caar specs))
1868                              (elt antlr-options-headings (1- level))
1869                              option
1870                              (antlr-version-string antlr-tool-version)))
1871            (car specs))
1872           (t
1873            (error "Didn't insert v%s %s option %s in v%s"
1874                   (antlr-version-string (caar specs))
1875                   (elt antlr-options-headings (1- level))
1876                   option
1877                   (antlr-version-string antlr-tool-version))))))
1878
1879 (defun antlr-version-string (version)
1880   "Format the Antlr version number VERSION, see `antlr-tool-version'."
1881   (let ((version100 (/ version 100)))
1882     (format "%d.%d.%d"
1883             (/ version100 100) (mod version100 100) (mod version 100))))
1884
1885
1886 ;;;===========================================================================
1887 ;;;  Insert options: the details (used by `antlr-insert-option-do')
1888 ;;;===========================================================================
1889
1890 (defun antlr-insert-option-existing (old value)
1891   "Insert option value VALUE at point for existing option.
1892 For OLD, see `antlr-insert-option-do'."
1893   ;; no = => insert =
1894   (unless (car old) (insert antlr-options-assign-string))
1895   ;; with user input => insert if necessary
1896   (when value
1897     (if (cdr old)               ; with value
1898         (if (string-equal value (buffer-substring (car old) (cdr old)))
1899             (goto-char (cdr old))
1900           (delete-region (car old) (cdr old))
1901           (insert value))
1902       (insert value)))
1903   (unless (looking-at "\\([^\n=;{}/'\"]\\|'\\([^\n'\\]\\|\\\\.\\)*'\\|\"\\([^\n\"\\]\\|\\\\.\\)*\"\\)*;")
1904     ;; stuff (no =, {, } or /) at point is not followed by ";"
1905     (insert ";")
1906     (backward-char)))
1907
1908 (defun antlr-insert-option-space (area old)
1909   "Find appropriate place to insert option, insert newlines/spaces.
1910 For AREA and OLD, see `antlr-insert-option-do'."
1911   (let ((orig (point))
1912         (open t))
1913     (skip-chars-backward " \t")
1914     (unless (bolp)
1915       (let ((before (char-after (1- (point)))))
1916         (goto-char orig)
1917         (and old                        ; with existing options area
1918              (consp area)               ; if point inside existing area
1919              (not (eq before ?\;))      ; if not at beginning of option
1920                                         ; => skip to end of option
1921              (if (and (search-forward ";" (cdr area) t)
1922                       (let ((context (antlr-syntactic-context)))
1923                         (or (null context) (numberp context))))
1924                  (setq orig (point))
1925                (goto-char orig)))
1926         (skip-chars-forward " \t")
1927
1928         (if (looking-at "$\\|//")
1929             ;; just comment after point => skip (+ lines w/ same col comment)
1930             (let ((same (if (> (match-end 0) (match-beginning 0))
1931                             (current-column))))
1932               (beginning-of-line 2)
1933               (or (bolp) (insert "\n"))
1934               (when (and same (null area)) ; or (consp area)?
1935                 (while (and (looking-at "[ \t]*\\(//\\)")
1936                             (goto-char (match-beginning 1))
1937                             (= (current-column) same))
1938                   (beginning-of-line 2)
1939                   (or (bolp) (insert "\n")))))
1940           (goto-char orig)
1941           (if (null old)
1942               (progn (insert "\n") (antlr-indent-line))
1943             (unless (eq (char-after (1- (point))) ?\ )
1944               (insert " "))
1945             (unless (eq (char-after (point)) ?\ )
1946               (insert " ")
1947               (backward-char))
1948             (setq open nil)))))
1949     (when open
1950       (beginning-of-line 1)
1951       (insert "\n")
1952       (backward-char)
1953       (antlr-indent-line))))
1954
1955 (defun antlr-insert-option-area (level)
1956   "Insert new options area for options of level LEVEL.
1957 Used by `antlr-insert-option-do'."
1958   (insert "options {\n\n}")
1959   (when (and antlr-options-auto-colon
1960              (memq level '(3 4))
1961              (save-excursion
1962                (c-forward-syntactic-ws)
1963                (if (eq (char-after (point)) ?\{) (antlr-skip-sexps 1))
1964                (not (eq (char-after (point)) ?\:))))
1965     (insert "\n:")
1966     (antlr-indent-line)
1967     (end-of-line 0))
1968   (backward-char 1)
1969   (antlr-indent-line)
1970   (beginning-of-line 0)
1971   (antlr-indent-line))
1972
1973
1974 ;;;===========================================================================
1975 ;;;  Insert options: in `antlr-options-alists'
1976 ;;;===========================================================================
1977
1978 (defun antlr-read-value (initial-contents prompt
1979                                           &optional as-string table table-x)
1980   "Read a string from the minibuffer, possibly with completion.
1981 If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
1982 PROMPT is a string to prompt with, normally it ends in a colon and a
1983 space.  If AS-STRING is t or is a member \(comparison done with `eq') of
1984 `antlr-options-style', return printed representation of the user input,
1985 otherwise return the user input directly.
1986
1987 If TABLE or TABLE-X is non-nil, read with completion.  The completion
1988 table is the resulting alist of TABLE-X concatenated with TABLE where
1989 TABLE can also be a function evaluation to an alist.
1990
1991 Used inside `antlr-options-alists'."
1992   (let* ((completion-ignore-case t)     ; dynamic
1993          (table0 (and (or table table-x)
1994                       (append table-x
1995                               (if (functionp table) (funcall table) table))))
1996          (input (if table0
1997                     (completing-read prompt table0 nil nil initial-contents)
1998                   (read-from-minibuffer prompt initial-contents))))
1999     (if (and as-string
2000              (or (eq as-string t)
2001                  (cdr (assq as-string antlr-options-style))))
2002         (format "%S" input)
2003       input)))
2004
2005 (defun antlr-read-boolean (initial-contents prompt &optional table)
2006   "Read a boolean value from the minibuffer, with completion.
2007 If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
2008 PROMPT is a string to prompt with, normally it ends in a question mark
2009 and a space.  \"(true or false) \" is appended if TABLE is nil.
2010
2011 Read with completion over \"true\", \"false\" and the keys in TABLE, see
2012 also `antlr-read-value'.
2013
2014 Used inside `antlr-options-alists'."
2015   (antlr-read-value initial-contents
2016                     (if table prompt (concat prompt "(true or false) "))
2017                     nil
2018                     table '(("false") ("true"))))
2019
2020 (defun antlr-language-option-extra (phase &rest dummies)
2021 ;; checkdoc-params: (dummies)
2022   "Change language according to the new value of the \"language\" option.
2023 Call `antlr-mode' if the new language would be different from the value
2024 of `antlr-language', keeping the value of variable `font-lock-mode'.
2025
2026 Called in PHASE `after-insertion', see `antlr-options-alists'."
2027   (when (eq phase 'after-insertion)
2028     (let ((new-language (antlr-language-option t)))
2029       (or (null new-language)
2030           (eq new-language antlr-language)
2031           (let ((font-lock (and (boundp 'font-lock-mode) font-lock-mode)))
2032             (if font-lock (font-lock-mode 0))
2033             (antlr-mode)
2034             (and font-lock (null font-lock-mode) (font-lock-mode 1)))))))
2035
2036 (defun antlr-c++-mode-extra (phase option &rest dummies)
2037 ;; checkdoc-params: (option dummies)
2038   "Warn if C++ option is used with the wrong language.
2039 Ask user \(\"y or n\"), if a C++ only option is going to be inserted but
2040 `antlr-language' has not the value `c++-mode'.
2041
2042 Called in PHASE `before-input', see `antlr-options-alists'."
2043   (and (eq phase 'before-input)
2044        (not (eq antlr-language 'c++-mode))
2045        (not (y-or-n-p (format "Insert C++ %s option? " option)))
2046        (error "Didn't insert C++ %s option with language %s"
2047               option (cadr (assq antlr-language antlr-language-alist)))))
2048
2049
2050 ;;;===========================================================================
2051 ;;;  Compute dependencies
2052 ;;;===========================================================================
2053
2054 (defun antlr-file-dependencies ()
2055   "Return dependencies for grammar in current buffer.
2056 The result looks like \(FILE \(CLASSES \. SUPERS) VOCABS \. LANGUAGE)
2057   where CLASSES = ((CLASS . CLASS-EVOCAB) ...),
2058         SUPERS  = ((SUPER . USE-EVOCAB-P) ...), and
2059         VOCABS  = ((EVOCAB ...) . (IVOCAB ...))
2060
2061 FILE is the current buffer's file-name without directory part and
2062 LANGUAGE is the value of `antlr-language' in the current buffer.  Each
2063 EVOCAB is an export vocabulary and each IVOCAB is an import vocabulary.
2064
2065 Each CLASS is a grammar class with its export vocabulary CLASS-EVOCAB.
2066 Each SUPER is a super-grammar class where USE-EVOCAB-P indicates whether
2067 its export vocabulary is used as an import vocabulary."
2068   (unless buffer-file-name
2069     (error "Grammar buffer does not visit a file"))
2070   (let (classes export-vocabs import-vocabs superclasses default-vocab)
2071     (antlr-with-syntax-table antlr-action-syntax-table
2072       (goto-char (point-min))
2073       (while (antlr-re-search-forward antlr-class-header-regexp nil)
2074         ;; parse class definition --------------------------------------------
2075         (let* ((class (match-string 2))
2076                (sclass (match-string 4))
2077                ;; export vocab defaults to class name (first grammar in file)
2078                ;; or to the export vocab of the first grammar in file:
2079                (evocab (or default-vocab class))
2080                (ivocab nil))
2081           (goto-char (match-end 0))
2082           (c-forward-syntactic-ws)
2083           (while (looking-at "options\\>\\|\\(tokens\\)\\>")
2084             (if (match-beginning 1)
2085                 (antlr-skip-sexps 2)
2086               (goto-char (match-end 0))
2087               (c-forward-syntactic-ws)
2088               ;; parse grammar option sections -------------------------------
2089               (when (eq (char-after (point)) ?\{)
2090                 (let* ((beg (1+ (point)))
2091                        (end (1- (antlr-skip-sexps 1)))
2092                        (cont (point)))
2093                 (goto-char beg)
2094                 (if (re-search-forward "\\<exportVocab[ \t]*=[ \t]*\\([A-Za-z\300-\326\330-\337]\\sw*\\)" end t)
2095                     (setq evocab (match-string 1)))
2096                 (goto-char beg)
2097                 (if (re-search-forward "\\<importVocab[ \t]*=[ \t]*\\([A-Za-z\300-\326\330-\337]\\sw*\\)" end t)
2098                     (setq ivocab (match-string 1)))
2099                 (goto-char cont)))))
2100           (unless (member sclass '("Parser" "Lexer" "TreeParser"))
2101             (let ((super (assoc sclass superclasses)))
2102               (if super
2103                   (or ivocab (setcdr super t))
2104                 (push (cons sclass (null ivocab)) superclasses))))
2105           ;; remember class with export vocabulary:
2106           (push (cons class evocab) classes)
2107           ;; default export vocab is export vocab of first grammar in file:
2108           (or default-vocab (setq default-vocab evocab))
2109           (or (member evocab export-vocabs) (push evocab export-vocabs))
2110           (or (null ivocab)
2111               (member ivocab import-vocabs) (push ivocab import-vocabs)))))
2112     (if classes
2113         (list* (file-name-nondirectory buffer-file-name)
2114                (cons (nreverse classes) (nreverse superclasses))
2115                (cons (nreverse export-vocabs) (nreverse import-vocabs))
2116                antlr-language))))
2117
2118 (defun antlr-directory-dependencies (dirname)
2119   "Return dependencies for all grammar files in directory DIRNAME.
2120 The result looks like \((CLASS-SPEC ...) \. \(FILE-DEP ...))
2121   where CLASS-SPEC = (CLASS (FILE \. EVOCAB) ...).
2122
2123 FILE-DEP are the dependencies for each grammar file in DIRNAME, see
2124 `antlr-file-dependencies'.  For each grammar class CLASS, FILE is a
2125 grammar file in which CLASS is defined and EVOCAB is the name of the
2126 export vocabulary specified in that file."
2127   (let ((grammar (directory-files dirname t "\\.g\\'")))
2128     (when grammar
2129       (let ((temp-buffer (get-buffer-create
2130                           (generate-new-buffer-name " *temp*")))
2131             (antlr-imenu-name nil)              ; dynamic-let: no imenu
2132             (expanded-regexp (concat (format (regexp-quote
2133                                               (cadr antlr-special-file-formats))
2134                                              ".+")
2135                                      "\\'"))
2136             classes dependencies)
2137         (unwind-protect
2138             (save-excursion
2139               (set-buffer temp-buffer)
2140               (widen)                   ; just in case...
2141               (dolist (file grammar)
2142                 (when (and (file-regular-p file)
2143                            (null (string-match expanded-regexp file)))
2144                   (insert-file-contents file t nil nil t)
2145                   (normal-mode t)       ; necessary for major-mode, syntax
2146                                         ; table and `antlr-language'
2147                   (when (eq major-mode 'antlr-mode)
2148                     (let* ((file-deps (antlr-file-dependencies))
2149                            (file (car file-deps)))
2150                       (when file-deps
2151                         (dolist (class-def (caadr file-deps))
2152                           (let ((file-evocab (cons file (cdr class-def)))
2153                                 (class-spec (assoc (car class-def) classes)))
2154                             (if class-spec
2155                                 (nconc (cdr class-spec) (list file-evocab))
2156                               (push (list (car class-def) file-evocab)
2157                                     classes))))
2158                         (push file-deps dependencies)))))))
2159           (kill-buffer temp-buffer))
2160         (cons (nreverse classes) (nreverse dependencies))))))
2161
2162
2163 ;;;===========================================================================
2164 ;;;  Compilation: run ANTLR tool
2165 ;;;===========================================================================
2166
2167 (defun antlr-superclasses-glibs (supers classes)
2168   "Compute the grammar lib option for the super grammars SUPERS.
2169 Look in CLASSES for the right grammar lib files for SUPERS.  SUPERS is
2170 part SUPER in the result of `antlr-file-dependencies'.  CLASSES is the
2171 part \(CLASS-SPEC ...) in the result of `antlr-directory-dependencies'.
2172
2173 The result looks like \(OPTION WITH-UNKNOWN GLIB ...).  OPTION is the
2174 complete \"-glib\" option.  WITH-UNKNOWN has value t iff there is none
2175 or more than one grammar file for at least one super grammar.
2176
2177 Each GLIB looks like \(GRAMMAR-FILE \. EVOCAB).  GRAMMAR-FILE is a file
2178 in which a super-grammar is defined.  EVOCAB is the value of the export
2179 vocabulary of the super-grammar or nil if it is not needed."
2180   ;; If the superclass is defined in the same file, that file will be included
2181   ;; with -glib again.  This will lead to a redefinition.  But defining a
2182   ;; analyzer of the same class twice in a file will lead to an error anyway...
2183   (let (glibs unknown)
2184     (while supers
2185       (let* ((super (pop supers))
2186              (sup-files (cdr (assoc (car super) classes)))
2187              (file (and sup-files (null (cdr sup-files)) (car sup-files))))
2188         (or file (setq unknown t))      ; not exactly one file
2189         (push (cons (or (car file)
2190                         (format (car antlr-unknown-file-formats)
2191                                 (car super)))
2192                     (and (cdr super)
2193                          (or (cdr file)
2194                              (format (cadr antlr-unknown-file-formats)
2195                                      (car super)))))
2196               glibs)))
2197     (cons (if glibs (concat " -glib " (mapconcat 'car glibs ";")) "")
2198           (cons unknown glibs))))
2199
2200 (defun antlr-run-tool (command file &optional saved)
2201   "Run Antlr took COMMAND on grammar FILE.
2202 When called interactively, COMMAND is read from the minibuffer and
2203 defaults to `antlr-tool-command' with a computed \"-glib\" option if
2204 necessary.
2205
2206 Save all buffers first unless optional value SAVED is non-nil.  When
2207 called interactively, the buffers are always saved, see also variable
2208 `antlr-ask-about-save'."
2209   (interactive (antlr-run-tool-interactive))
2210   (or saved (save-some-buffers (not antlr-ask-about-save)))
2211   (let ((default-directory (file-name-directory file)))
2212     (require 'compile)                  ; only `compile' autoload
2213     (compile-internal (concat command " " (file-name-nondirectory file))
2214                       "No more errors" "Antlr-Run")))
2215
2216 (defun antlr-run-tool-interactive ()
2217   ;; code in `interactive' is not compiled
2218   "Interactive specification for `antlr-run-tool'.
2219 Use prefix argument ARG to return \(COMMAND FILE SAVED)."
2220   (let* ((supers (cdadr (save-excursion
2221                           (save-restriction
2222                             (widen)
2223                             (antlr-file-dependencies)))))
2224          (glibs ""))
2225     (when supers
2226       (save-some-buffers (not antlr-ask-about-save) nil)
2227       (setq glibs (car (antlr-superclasses-glibs
2228                         supers
2229                         (car (antlr-directory-dependencies
2230                               (antlr-default-directory)))))))
2231     (list (antlr-read-shell-command "Run Antlr on current file with: "
2232                                     (concat antlr-tool-command glibs " "))
2233           buffer-file-name
2234           supers)))
2235
2236
2237 ;;;===========================================================================
2238 ;;;  Makefile creation
2239 ;;;===========================================================================
2240
2241 (defun antlr-makefile-insert-variable (number pre post)
2242   "Insert Makefile variable numbered NUMBER according to specification.
2243 Also insert strings PRE and POST before and after the variable."
2244   (let ((spec (cadr antlr-makefile-specification)))
2245     (when spec
2246       (insert pre
2247               (if number (format (cadr spec) number) (car spec))
2248               post))))
2249
2250 (defun antlr-insert-makefile-rules (&optional in-makefile)
2251   "Insert Makefile rules in the current buffer at point.
2252 IN-MAKEFILE is non-nil, if the current buffer is the Makefile.  See
2253 command `antlr-show-makefile-rules' for detail."
2254   (let* ((dirname (antlr-default-directory))
2255          (deps0 (antlr-directory-dependencies dirname))
2256          (classes (car deps0))          ; CLASS -> (FILE . EVOCAB) ...
2257          (deps (cdr deps0))             ; FILE -> (c . s) (ev . iv) . LANGUAGE
2258          (with-error nil)
2259          (gen-sep (or (caddr (cadr antlr-makefile-specification)) " "))
2260          (n (and (cdr deps) (cadr antlr-makefile-specification) 0)))
2261     (or in-makefile (set-buffer standard-output))
2262     (dolist (dep deps)
2263       (let ((supers (cdadr dep))
2264             (lang (cdr (assoc (cdddr dep) antlr-file-formats-alist))))
2265         (if n (incf n))
2266         (antlr-makefile-insert-variable n "" " =")
2267         (if supers
2268             (insert " "
2269                     (format (cadr antlr-special-file-formats)
2270                             (file-name-sans-extension (car dep)))))
2271         (dolist (class-def (caadr dep))
2272           (let ((sep gen-sep))
2273             (dolist (class-file (cadr lang))
2274               (insert sep (format class-file (car class-def)))
2275               (setq sep " "))))
2276         (dolist (evocab (caaddr dep))
2277           (let ((sep gen-sep))
2278             (dolist (vocab-file (cons (car antlr-special-file-formats)
2279                                       (car lang)))
2280               (insert sep (format vocab-file evocab))
2281               (setq sep " "))))
2282         (antlr-makefile-insert-variable n "\n$(" ")")
2283         (insert ": " (car dep))
2284         (dolist (ivocab (cdaddr dep))
2285           (insert " " (format (car antlr-special-file-formats) ivocab)))
2286         (let ((glibs (antlr-superclasses-glibs supers classes)))
2287           (if (cadr glibs) (setq with-error t))
2288           (dolist (super (cddr glibs))
2289             (insert " " (car super))
2290             (if (cdr super)
2291                 (insert " " (format (car antlr-special-file-formats)
2292                                     (cdr super)))))
2293           (insert "\n\t"
2294                   (caddr antlr-makefile-specification)
2295                   (car glibs)
2296                   " $<\n"
2297                   (car antlr-makefile-specification)))))
2298     (if n
2299         (let ((i 0))
2300           (antlr-makefile-insert-variable nil "" " =")
2301           (while (<= (incf i) n)
2302             (antlr-makefile-insert-variable i " $(" ")"))
2303           (insert "\n" (car antlr-makefile-specification))))
2304     (if (string-equal (car antlr-makefile-specification) "\n")
2305         (backward-delete-char 1))
2306     (when with-error
2307       (goto-char (point-min))
2308       (insert antlr-help-unknown-file-text))
2309     (unless in-makefile
2310       (copy-region-as-kill (point-min) (point-max))
2311       (goto-char (point-min))
2312       (insert (format antlr-help-rules-intro dirname)))))
2313
2314 ;;;###autoload
2315 (defun antlr-show-makefile-rules ()
2316   "Show Makefile rules for all grammar files in the current directory.
2317 If the `major-mode' of the current buffer has the value `makefile-mode',
2318 the rules are directory inserted at point.  Otherwise, a *Help* buffer
2319 is shown with the rules which are also put into the `kill-ring' for
2320 \\[yank].
2321
2322 This command considers import/export vocabularies and grammar
2323 inheritance and provides a value for the \"-glib\" option if necessary.
2324 Customize variable `antlr-makefile-specification' for the appearance of
2325 the rules.
2326
2327 If the file for a super-grammar cannot be determined, special file names
2328 are used according to variable `antlr-unknown-file-formats' and a
2329 commentary with value `antlr-help-unknown-file-text' is added.  The
2330 *Help* buffer always starts with the text in `antlr-help-rules-intro'."
2331   (interactive)
2332   (if (null (eq major-mode 'makefile-mode))
2333       (antlr-with-displaying-help-buffer 'antlr-insert-makefile-rules)
2334     (push-mark)
2335     (antlr-insert-makefile-rules t)))
2336
2337
2338 ;;;===========================================================================
2339 ;;;  Indentation
2340 ;;;===========================================================================
2341
2342 (defun antlr-indent-line ()
2343   "Indent the current line as ANTLR grammar code.
2344 The indentation of non-comment lines are calculated by `c-basic-offset',
2345 multiplied by:
2346  - the level of the paren/brace/bracket depth,
2347  - plus 0/2/1, depending on the position inside the rule: header, body,
2348    exception part,
2349  - minus 1 if `antlr-indent-item-regexp' matches the beginning of the
2350    line starting from the first non-whitespace.
2351
2352 Lines inside block comments are indented by `c-indent-line' according to
2353 `antlr-indent-comment'.
2354
2355 Lines in actions except top-level actions in a header part or an option
2356 area are indented by `c-indent-line'.
2357
2358 Lines in header actions are indented at column 0 if `antlr-language'
2359 equals to a key in `antlr-indent-at-bol-alist' and the line starting at
2360 the first non-whitespace is matched by the corresponding value.
2361
2362 For the initialization of `c-basic-offset', see `antlr-indent-style' and,
2363 to a lesser extent, `antlr-tab-offset-alist'."
2364   (save-restriction
2365     (let ((orig (point))
2366           (min0 (point-min))
2367           bol boi indent syntax cc-syntax)
2368       (widen)
2369       (beginning-of-line)
2370       (setq bol (point))
2371       (if (< bol min0)
2372           (error "Beginning of current line not visible"))
2373       (skip-chars-forward " \t")
2374       (setq boi (point))
2375       ;; check syntax at beginning of indentation ----------------------------
2376       (antlr-with-syntax-table antlr-action-syntax-table
2377         (antlr-invalidate-context-cache)
2378         (setq syntax (antlr-syntactic-context))
2379         (cond ((symbolp syntax)
2380                (setq indent nil))       ; block-comments, strings, (comments)
2381               ((progn
2382                  (antlr-next-rule -1 t)
2383                  (if (antlr-search-forward ":") (< boi (1- (point))) t))
2384                (setq indent 0))         ; in rule header
2385               ((if (antlr-search-forward ";") (< boi (point)) t)
2386                (setq indent 2))         ; in rule body
2387               (t
2388                (forward-char)
2389                (antlr-skip-exception-part nil)
2390                (setq indent (if (> (point) boi) 1 0))))) ; in exception part?
2391       ;; check whether to use indentation engine of cc-mode ------------------
2392       (antlr-invalidate-context-cache)
2393       (goto-char boi)
2394       (when (and indent (> syntax 0))
2395         (cond ((> syntax 1)             ; block in action => use cc-mode
2396                (setq indent nil))
2397               ((and (= indent 0)
2398                     (assq antlr-language antlr-indent-at-bol-alist)
2399                     (looking-at (cdr (assq antlr-language
2400                                            antlr-indent-at-bol-alist))))
2401                (setq syntax 'bol))
2402               ((setq cc-syntax (c-guess-basic-syntax))
2403                (let ((cc cc-syntax) symbol)
2404                  (while (setq symbol (pop cc))
2405                    (when (cdr symbol)
2406                      (or (memq (car symbol)
2407                                antlr-disabling-cc-syntactic-symbols)
2408                          (setq indent nil))
2409                      (setq cc nil)))))))
2410 ;;;             ((= indent 1)           ; exception part => use cc-mode
2411 ;;;              (setq indent nil))
2412 ;;;             ((save-restriction      ; not in option part => cc-mode
2413 ;;;                (goto-char (scan-lists (point) -1 1))
2414 ;;;                (skip-chars-backward " \t\n")
2415 ;;;                (narrow-to-region (point-min) (point))
2416 ;;;                (not (re-search-backward "\\<options\\'" nil t)))
2417 ;;;              (setq indent nil)))))
2418         ;; compute the corresponding indentation and indent --------------------
2419       (if (null indent)
2420           ;; Use the indentation engine of cc-mode
2421           (progn
2422             (goto-char orig)
2423             (if (or (numberp syntax)
2424                     (if (eq syntax 'string) nil (eq antlr-indent-comment t)))
2425                 (c-indent-line cc-syntax)))
2426         ;; do it ourselves
2427         (goto-char boi)
2428         (unless (symbolp syntax)                ; direct indentation
2429           ;;(antlr-invalidate-context-cache)
2430           (incf indent (antlr-syntactic-context))
2431           (and (> indent 0) (looking-at antlr-indent-item-regexp) (decf indent))
2432           (setq indent (* indent c-basic-offset)))
2433         ;; the usual major-mode indent stuff ---------------------------------
2434         (setq orig (- (point-max) orig))
2435         (unless (= (current-column) indent)
2436           (delete-region bol boi)
2437           (beginning-of-line)
2438           (indent-to indent))
2439         ;; If initial point was within line's indentation,
2440         ;; position after the indentation.  Else stay at same point in text.
2441         (if (> (- (point-max) orig) (point))
2442             (goto-char (- (point-max) orig)))))))
2443
2444 (defun antlr-indent-command (&optional arg)
2445   "Indent the current line or insert tabs/spaces.
2446 With optional prefix argument ARG or if the previous command was this
2447 command, insert ARG tabs or spaces according to `indent-tabs-mode'.
2448 Otherwise, indent the current line with `antlr-indent-line'."
2449   (interactive "*P")
2450   (if (or arg (eq last-command 'antlr-indent-command))
2451       (insert-tab arg)
2452     (let ((antlr-indent-comment (and antlr-indent-comment t))) ; dynamic
2453       (antlr-indent-line))))
2454
2455 (defun antlr-electric-character (&optional arg)
2456   "Insert the character you type and indent the current line.
2457 Insert the character like `self-insert-command' and indent the current
2458 line as `antlr-indent-command' does.  Do not indent the line if
2459
2460  * this command is called with a prefix argument ARG,
2461  * there are characters except whitespaces between point and the
2462    beginning of the line, or
2463  * point is not inside a normal grammar code, { and } are also OK in
2464    actions.
2465
2466 This command is useful for a character which has some special meaning in
2467 ANTLR's syntax and influences the auto indentation, see
2468 `antlr-indent-item-regexp'."
2469   (interactive "*P")
2470   (if (or arg
2471           (save-excursion (skip-chars-backward " \t") (not (bolp)))
2472           (antlr-with-syntax-table antlr-action-syntax-table
2473             (antlr-invalidate-context-cache)
2474             (let ((context (antlr-syntactic-context)))
2475               (not (and (numberp context)
2476                         (or (zerop context)
2477                             (memq last-command-char '(?\{ ?\}))))))))
2478       (self-insert-command (prefix-numeric-value arg))
2479     (self-insert-command (prefix-numeric-value arg))
2480     (antlr-indent-line)))
2481
2482
2483 ;;;===========================================================================
2484 ;;;  Mode entry
2485 ;;;===========================================================================
2486
2487 (defun antlr-c-common-init ()
2488   "Like `c-common-init' except menu, auto-hungry and c-style stuff."
2489   ;; X/Emacs 20 only
2490   (make-local-variable 'paragraph-start)
2491   (make-local-variable 'paragraph-separate)
2492   (make-local-variable 'paragraph-ignore-fill-prefix)
2493   (make-local-variable 'require-final-newline)
2494   (make-local-variable 'parse-sexp-ignore-comments)
2495   (make-local-variable 'indent-line-function)
2496   (make-local-variable 'indent-region-function)
2497   (make-local-variable 'comment-start)
2498   (make-local-variable 'comment-end)
2499   (make-local-variable 'comment-column)
2500   (make-local-variable 'comment-start-skip)
2501   (make-local-variable 'comment-multi-line)
2502   (make-local-variable 'outline-regexp)
2503   (make-local-variable 'outline-level)
2504   (make-local-variable 'adaptive-fill-regexp)
2505   (make-local-variable 'adaptive-fill-mode)
2506   (make-local-variable 'imenu-generic-expression) ;set in the mode functions
2507   (and (boundp 'comment-line-break-function)
2508        (make-local-variable 'comment-line-break-function))
2509   ;; Emacs 19.30 and beyond only, AFAIK
2510   (if (boundp 'fill-paragraph-function)
2511       (progn
2512         (make-local-variable 'fill-paragraph-function)
2513         (setq fill-paragraph-function 'c-fill-paragraph)))
2514   ;; now set their values
2515   (setq paragraph-start (concat page-delimiter "\\|$")
2516         paragraph-separate paragraph-start
2517         paragraph-ignore-fill-prefix t
2518         require-final-newline t
2519         parse-sexp-ignore-comments t
2520         indent-line-function 'c-indent-line
2521         indent-region-function 'c-indent-region
2522         outline-regexp "[^#\n\^M]"
2523         outline-level 'c-outline-level
2524         comment-column 32
2525         comment-start-skip "/\\*+ *\\|// *"
2526         comment-multi-line nil
2527         comment-line-break-function 'c-comment-line-break-function
2528         adaptive-fill-regexp nil
2529         adaptive-fill-mode nil)
2530   (c-set-style (or antlr-indent-style "gnu"))
2531   (and (boundp 'c-current-comment-prefix) (boundp 'c-comment-prefix-regexp)
2532        (setq c-current-comment-prefix
2533              (if (listp c-comment-prefix-regexp)
2534                  (cdr-safe (or (assoc major-mode c-comment-prefix-regexp)
2535                                (assoc 'other c-comment-prefix-regexp)))
2536                c-comment-prefix-regexp)))
2537   ;; we have to do something special for c-offsets-alist so that the
2538   ;; buffer local value has its own alist structure.
2539   (setq c-offsets-alist (copy-alist c-offsets-alist))
2540   ;; setup the comment indent variable in a Emacs version portable way
2541   ;; ignore any byte compiler warnings you might get here
2542   (make-local-variable 'comment-indent-function)
2543   (setq comment-indent-function 'c-comment-indent))
2544
2545 (defun antlr-language-option (search)
2546   "Find language in `antlr-language-alist' for language option.
2547 If SEARCH is non-nil, find element for language option.  Otherwise, find
2548 the default language."
2549   (let ((value (and search
2550                     (save-excursion
2551                       (goto-char (point-min))
2552                       (re-search-forward (cdr antlr-language-limit-n-regexp)
2553                                          (car antlr-language-limit-n-regexp)
2554                                          t))
2555                     (match-string 1)))
2556         (seq antlr-language-alist)
2557         r)
2558     ;; Like (find VALUE antlr-language-alist :key 'cddr :test 'member)
2559     (while seq
2560       (setq r (pop seq))
2561       (if (member value (cddr r))
2562           (setq seq nil)                ; stop
2563         (setq r nil)))                  ; no result yet
2564     (car r)))
2565
2566
2567 ;;;###autoload
2568 (defun antlr-mode ()
2569   "Major mode for editing ANTLR grammar files.
2570 \\{antlr-mode-map}"
2571   (interactive)
2572   (c-initialize-cc-mode)                ; required when depending on cc-mode
2573   (kill-all-local-variables)
2574   ;; ANTLR specific ----------------------------------------------------------
2575   (setq major-mode 'antlr-mode
2576         mode-name "Antlr")
2577   (setq local-abbrev-table antlr-mode-abbrev-table)
2578   (unless antlr-mode-syntax-table
2579     (setq antlr-mode-syntax-table (make-syntax-table))
2580     (c-populate-syntax-table antlr-mode-syntax-table))
2581   (set-syntax-table antlr-mode-syntax-table)
2582   (unless antlr-action-syntax-table
2583     (let ((slist (nth 3 antlr-font-lock-defaults)))
2584       (setq antlr-action-syntax-table
2585             (copy-syntax-table antlr-mode-syntax-table))
2586       (while slist
2587         (modify-syntax-entry (caar slist) (cdar slist)
2588                              antlr-action-syntax-table)
2589         (setq slist (cdr slist)))))
2590   (use-local-map antlr-mode-map)
2591   (make-local-variable 'antlr-language)
2592   (unless antlr-language
2593     (setq antlr-language
2594           (or (antlr-language-option t) (antlr-language-option nil))))
2595   (if (stringp (cadr (assq antlr-language antlr-language-alist)))
2596       (setq mode-name
2597             (concat "Antlr."
2598                     (cadr (assq antlr-language antlr-language-alist)))))
2599   ;; indentation, for the C engine -------------------------------------------
2600   (antlr-c-common-init)
2601   (setq indent-line-function 'antlr-indent-line
2602         indent-region-function nil)     ; too lazy
2603   (setq c-buffer-is-cc-mode antlr-language)
2604   (if (fboundp 'c-init-language-vars)
2605       (c-init-language-vars)            ; cc-mode >= v5.29
2606     (let ((settings                     ; (cdr '(setq...)) will be optimized
2607            (if (eq antlr-language 'c++-mode)
2608                (cdr '(setq              ;' from `c++-mode' v5.20, v5.28
2609                       c-keywords (c-identifier-re c-C++-keywords)
2610                       c-conditional-key c-C++-conditional-key
2611                       c-comment-start-regexp c-C++-comment-start-regexp
2612                       c-class-key c-C++-class-key
2613                       c-extra-toplevel-key c-C++-extra-toplevel-key
2614                       c-access-key c-C++-access-key
2615                       c-recognize-knr-p nil
2616                       c-bitfield-key c-C-bitfield-key ; v5.28
2617                       ))
2618              (cdr '(setq                ; from `java-mode' v5.20, v5.28
2619                     c-keywords (c-identifier-re c-Java-keywords)
2620                     c-conditional-key c-Java-conditional-key
2621                     c-comment-start-regexp c-Java-comment-start-regexp
2622                     c-class-key c-Java-class-key
2623                     c-method-key nil
2624                     c-baseclass-key nil
2625                     c-recognize-knr-p nil
2626                     c-access-key c-Java-access-key ; v5.20
2627                     c-inexpr-class-key c-Java-inexpr-class-key ; v5.28
2628                     )))))
2629       (while settings
2630         (when (boundp (car settings))
2631           (ignore-errors
2632             (set (car settings) (eval (cadr settings)))))
2633         (setq settings (cddr settings)))))
2634   (setq comment-start "// "
2635         comment-end "")
2636   ;; various -----------------------------------------------------------------
2637   (make-local-variable 'font-lock-defaults)
2638   (setq font-lock-defaults antlr-font-lock-defaults)
2639   (easy-menu-add antlr-mode-menu)
2640   (make-local-variable 'imenu-create-index-function)
2641   (setq imenu-create-index-function 'antlr-imenu-create-index-function)
2642   (make-local-variable 'imenu-generic-expression)
2643   (setq imenu-generic-expression t)     ; fool stupid test
2644   (and antlr-imenu-name                 ; there should be a global variable...
2645        (fboundp 'imenu-add-to-menubar)
2646        (imenu-add-to-menubar
2647         (if (stringp antlr-imenu-name) antlr-imenu-name "Index")))
2648   (antlr-set-tabs)
2649   (run-hooks 'antlr-mode-hook))
2650
2651 ;; A smarter version of `group-buffers-menu-by-mode-then-alphabetically' (in
2652 ;; XEmacs) could use the following property.  The header of the submenu would
2653 ;; be "Antlr" instead of "Antlr.C++" or (not and!) "Antlr.Java".
2654 (put 'antlr-mode 'mode-name "Antlr")
2655
2656 ;;;###autoload
2657 (defun antlr-set-tabs ()
2658   "Use ANTLR's convention for TABs according to `antlr-tab-offset-alist'.
2659 Used in `antlr-mode'.  Also a useful function in `java-mode-hook'."
2660   (if buffer-file-name
2661       (let ((alist antlr-tab-offset-alist) elem)
2662         (while alist
2663           (setq elem (pop alist))
2664           (and (or (null (car elem)) (eq (car elem) major-mode))
2665                (or (null (cadr elem))
2666                    (string-match (cadr elem) buffer-file-name))
2667                (setq tab-width (caddr elem)
2668                      indent-tabs-mode (cadddr elem)
2669                      alist nil))))))
2670
2671 ;;; Local IspellPersDict: .ispell_antlr
2672 ;;; antlr-mode.el ends here