antlr-mode.el 62.9 KB
Newer Older
1
;;; antlr-mode.el --- major mode for ANTLR grammar files
2

3
;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
4 5
;;
;; Author: Christoph.Wedler@sap.com
6
;; Keywords: languages
7
;; Version: 1.4
Gerd Moellmann's avatar
Gerd Moellmann committed
8
;; X-URL: http://www.fmi.uni-passau.de/~wedler/antlr-mode/
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Major mode for editing ANTLR grammar files, i.e., files ending with `.g'.
;; ANTLR is ANother Tool for Language Recognition (an excellent alternative to
;; lex/yacc), see <http://www.ANTLR.org> and <news:comp.compilers.tools.pccts>.

;; This package provides the following features:
34 35
;;  * Syntax coloring (via font-lock) for grammar symbols and the code in
;;    actions.  The latter depends on the language settings.
36 37
;;  * Indentation for the current line (TAB) and selected region (C-M-\).
;;  * Support for imenu/speedbar: menu "Index" (Parser, Lexer, TreeParser).
38 39 40 41 42 43 44 45 46 47
;;  * Commands to move to previous/next rule, beginning/end of rule body etc.
;;  * Commands to hide/unhide actions, upcase/downcase literals.
;;  * Run ANTLR from within Emacs, create Makefile dependencies.

;; LANGUAGE SETTINGS.  This mode needs to know which language is used in
;; actions and semantic predicated of the grammar.  This information is used
;; for syntax coloring and the creation of the Makefile dependencies.  It is
;; stored in variable `antlr-language' and automatically set according to
;; ANTLR's file option "language", see `antlr-language-alist'.  The supported
;; languages are "Java" (java-mode) and "Cpp" (c++-mode).
48 49 50 51 52

;; INDENTATION.  This package supports ANTLR's (intended) indentation style
;; which is based on a simple paren/brace/bracket depth-level calculation, see
;; `antlr-indent-line'.  The indentation engine of cc-mode is only used inside
;; block comments (it is not easy to use it for actions, esp if they come early
53 54
;; in the rule body).  By default, this package defines a tab width of 4 to be
;; consistent to both ANTLR's conventions (TABs usage) and the
55
;; `c-indentation-style' "java" which sets `c-basic-offset' to 4, see
56
;; `antlr-tab-offset-alist'.  You might want to set this variable to nil.
57 58 59

;; SYNTAX COLORING comes in three phases.  First, comments and strings are
;; highlighted.  Second, the grammar code is highlighted according to
60 61 62
;; `antlr-font-lock-additional-keywords' (rule refs: dark blue, token refs:
;; dark orange, definition: bold blue).  Third, actions, semantic predicates
;; and arguments are highlighted according to the usual font-lock keywords of
63 64 65 66
;; `antlr-language', see also `antlr-font-lock-maximum-decoration'.  We define
;; special font-lock faces for the grammar code to allow you to distinguish
;; ANTLR keywords from Java/C++ keywords.

67 68 69 70 71 72 73 74 75 76 77
;; MAKEFILE CREATION.  Command \\[antlr-show-makefile-rules] shows/inserts the
;; dependencies for all grammar files in the current directory.  It considers
;; import/export vocabularies and grammar inheritance and provides a value for
;; the -glib option if necessary (which you have to edit if the super-grammar
;; is not in the same directory).

;; TODO.  Support to insert/change file/grammar/rule/subrule options.  imenu
;; support for method definitions in actions is not really planned (you can
;; send be a patch, though).  This mode would become too dependent on cc-mode
;; or I would have to do a lot of language-dependent things myself...

Gerd Moellmann's avatar
Gerd Moellmann committed
78 79 80 81
;; Bug fixes, bug reports, improvements, and suggestions are strongly
;; appreciated.  Please check the newest version first:
;;   http://www.fmi.uni-passau.de/~wedler/antlr-mode/changes.html

82 83
;;; Installation:

84
;; This file requires Emacs-20.3, XEmacs-20.4 or higher and package cc-mode.
85 86 87 88 89 90 91 92 93 94 95 96

;; If antlr-mode is not part of your distribution, put this file into your
;; load-path and the following into your ~/.emacs:
;;   (autoload 'antlr-mode "antlr-mode" nil t)
;;   (setq auto-mode-alist (cons '("\\.g\\'" . antlr-mode) auto-mode-alist))
;;   (add-hook 'speedbar-load-hook  ; would be too late in antlr-mode.el
;;	       (lambda () (speedbar-add-supported-extension ".g")))

;; If you edit ANTLR's source files, you might also want to use
;;   (autoload 'antlr-set-tabs "antlr-mode")
;;   (add-hook 'java-mode-hook 'antlr-set-tabs)

97 98 99
;; I strongly recommend to use font-lock with a support mode like fast-lock,
;; lazy-lock or better jit-lock (Emacs-21.1+) / lazy-shot (XEmacs).

100 101 102 103 104 105
;; To customize, use `M-x customize-group RET antlr RET' or the custom browser
;; (Emacs->Programming->Languages->Antlr).

;;; Code:

(provide 'antlr-mode)
106 107 108 109 110 111 112
(eval-when-compile			; required and optional libraries
  (require 'cc-mode)
  (defvar outline-level) (defvar imenu-use-markers)
  (defvar imenu-create-index-function))
(eval-when-compile			; Emacs: cl, easymenu
  (require 'cl)
  (require 'easymenu))
113 114
(eval-when-compile			; XEmacs: Emacs vars
  (defvar inhibit-point-motion-hooks) (defvar deactivate-mark))
115

116 117
(eval-and-compile			; XEmacs functions, simplified
  (if (featurep 'xemacs)
118 119
      (defalias 'antlr-scan-sexps 'scan-sexps)
    (defalias 'antlr-scan-sexps 'antlr-scan-sexps-internal))
120 121 122 123 124 125 126 127 128 129 130 131 132
  (if (fboundp 'default-directory)
      (defalias 'antlr-default-directory 'default-directory)
    (defun antlr-default-directory () default-directory))
  (if (fboundp 'read-shell-command)
      (defalias 'antlr-read-shell-command 'read-shell-command)
    (defun antlr-read-shell-command (prompt &optional initial-input history)
      (read-from-minibuffer prompt initial-input nil nil
			    (or history 'shell-command-history))))
  (if (fboundp 'with-displaying-help-buffer)
      (defalias 'antlr-with-displaying-help-buffer 'with-displaying-help-buffer)
    (defun antlr-with-displaying-help-buffer (thunk &optional name)
      (with-output-to-temp-buffer "*Help*"
	(save-excursion (funcall thunk)))))
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
  (if (and (fboundp 'buffer-syntactic-context)
	   (fboundp 'buffer-syntactic-context-depth))
      (progn
	(defalias 'antlr-invalidate-context-cache 'antlr-xemacs-bug-workaround)
	(defalias 'antlr-syntactic-context 'antlr-fast-syntactic-context))
    (defalias 'antlr-invalidate-context-cache 'ignore)
    (defalias 'antlr-syntactic-context 'antlr-slow-syntactic-context)))



;;;;##########################################################################
;;;;  Variables
;;;;##########################################################################


(defgroup antlr nil
  "Major mode for ANTLR grammar files."
  :group 'languages
  :link '(emacs-commentary-link "antlr-mode.el")
Gerd Moellmann's avatar
Gerd Moellmann committed
152
  :link '(url-link "http://www.fmi.uni-passau.de/~wedler/antlr-mode/")
153 154
  :prefix "antlr-")

155
(defconst antlr-version "1.4"
156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
  "ANTLR major mode version number.")


;;;===========================================================================
;;;  Controlling ANTLR's code generator (language option)
;;;===========================================================================

(defvar antlr-language nil
  "Major mode corresponding to ANTLR's \"language\" option.
Set via `antlr-language-alist'.  The only useful place to change this
buffer-local variable yourself is in `antlr-mode-hook' or in the \"local
variable list\" near the end of the file, see
`enable-local-variables'.")

(defcustom antlr-language-alist
171 172
  '((java-mode "Java" nil "\"Java\"" "Java")
    (c++-mode "C++" "\"Cpp\"" "Cpp"))
173 174 175 176 177
  "List of ANTLR's supported languages.
Each element in this list looks like
  (MAJOR-MODE MODELINE-STRING OPTION-VALUE...)

MAJOR-MODE, the major mode of the code in the grammar's actions, is the
178 179 180
value of `antlr-language' if the first group in the string matched by
REGEXP in `antlr-language-limit-n-regexp' is one of the OPTION-VALUEs.
An OPTION-VALUE of nil denotes the fallback element.  MODELINE-STRING is
181 182 183 184 185 186 187 188 189 190
also displayed in the modeline next to \"Antlr\"."
  :group 'antlr
  :type '(repeat (group :value (java-mode "")
			(function :tag "Major mode")
			(string :tag "Modeline string")
			(repeat :tag "ANTLR language option" :inline t
				(choice (const :tag "Default" nil)
					string )))))

(defcustom antlr-language-limit-n-regexp
191
  '(3000 . "language[ \t]*=[ \t]*\\(\"?[A-Z][A-Za-z_]*\"?\\)")
192 193
  "Used to set a reasonable value for `antlr-language'.
Looks like (LIMIT . REGEXP).  Search for REGEXP from the beginning of
194 195
the buffer to LIMIT and use the first group in the matched string to set
the language according to `antlr-language-alist'."
196 197 198 199 200 201
  :group 'antlr
  :type '(cons (choice :tag "Limit" (const :tag "No" nil) (integer :value 0))
	       regexp))


;;;===========================================================================
202
;;;  Hide/Unhide, Indent/Tabs
203 204
;;;===========================================================================

205 206 207 208 209
(defcustom antlr-action-visibility 3
  "Visibility of actions when command `antlr-hide-actions' is used.
If nil, the actions with their surrounding braces are hidden.  If a
number, do not hide the braces, only hide the contents if its length is
greater than this number."
210
  :group 'antlr
211 212
  :type '(choice (const :tag "Completely hidden" nil)
		 (integer :tag "Hidden if longer than" :value 3)))
213

214 215 216 217 218 219 220 221 222 223 224
(defcustom antlr-indent-comment 'tab
  "*Non-nil, if the indentation should touch lines in block comments.
If nil, no continuation line of a block comment is changed.  If t, they
are changed according to `c-indentation-line'.  When not nil and not t,
they are only changed by \\[antlr-indent-command]."
  :group 'antlr
  :type '(radio (const :tag "No" nil)
		(const :tag "Always" t)
		(sexp :tag "With TAB" :format "%t" :value tab)))

(defcustom antlr-tab-offset-alist
225 226
  '((antlr-mode nil 4 nil)
    (java-mode "antlr" 4 nil))
227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246
  "Alist to determine whether to use ANTLR's convention for TABs.
Each element looks like (MAJOR-MODE REGEXP TAB-WIDTH INDENT-TABS-MODE).
The first element whose MAJOR-MODE is nil or equal to `major-mode' and
whose REGEXP is nil or matches `buffer-file-name' is used to set
`tab-width' and `indent-tabs-mode'.  This is useful to support both
ANTLR's and Java's indentation styles.  Used by `antlr-set-tabs'."
  :group 'antlr
  :type '(repeat (group :value (antlr-mode nil 8 nil)
			(choice (const :tag "All" nil)
				(function :tag "Major mode"))
			(choice (const :tag "All" nil) regexp)
			(integer :tag "Tab width")
			(boolean :tag "Indent-tabs-mode"))))

(defvar antlr-indent-item-regexp
  "[]}):;|&]\\|default[ \t]*:\\|case[ \t]+\\('\\\\?.'\\|[0-9]+\\|[A-Za-z_][A-Za-z_0-9]*\\)[ \t]*:" ; & is local ANTLR extension
  "Regexp matching lines which should be indented by one TAB less.
See command \\[antlr-indent-command].")


247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353
;;;===========================================================================
;;;  Run tool, create Makefile dependencies
;;;===========================================================================

(defcustom antlr-tool-command "java antlr.Tool"
  "*Command used in \\[antlr-run-tool] to run the Antlr tool.
This variable should include all options passed to Antlr except the
option \"-glib\" which is automatically suggested if necessary."
  :group 'antlr
  :type 'string)

(defcustom antlr-ask-about-save t
  "*If not nil, \\[antlr-run-tool] asks which buffers to save.
Otherwise, it saves all modified buffers before running without asking."
  :group 'antlr
  :type 'boolean)

(defcustom antlr-makefile-specification
  '("\n" ("GENS" "GENS%d" " \\\n\t") "$(ANTLR)")
  "*Variable to specify the appearance of the generated makefile rules.
This variable influences the output of \\[antlr-show-makefile-rules].
It looks like (RULE-SEP GEN-VAR-SPEC COMMAND).

RULE-SEP is the string to separate different makefile rules.  COMMAND is
a string with the command which runs the Antlr tool, it should include
all options except the option \"-glib\" which is automatically added
if necessary.

If GEN-VAR-SPEC is nil, each target directly consists of a list of
files.  If GEN-VAR-SPEC looks like (GEN-VAR GEN-VAR-FORMAT GEN-SEP), a
Makefile variable is created for each rule target.

Then, GEN-VAR is a string with the name of the variable which contains
the file names of all makefile rules.  GEN-VAR-FORMAT is a format string
producing the variable of each target with substitution COUNT/%d where
COUNT starts with 1.  GEN-SEP is used to separate long variable values."
  :group 'antlr
  :type '(list (string :tag "Rule separator")
	       (choice
		(const :tag "Direct targets" nil)
		(list :tag "Variables for targets"
		      (string :tag "Variable for all targets")
		      (string :tag "Format for each target variable")
		      (string :tag "Variable separator")))
	       (string :tag "ANTLR command")))

(defvar antlr-file-formats-alist
  '((java-mode ("%sTokenTypes.java") ("%s.java"))
    (c++-mode ("%sTokenTypes.hpp") ("%s.cpp" "%s.hpp")))
  "Language dependent formats which specify generated files.
Each element in this list looks looks like
  (MAJOR-MODE (VOCAB-FILE-FORMAT...) (CLASS-FILE-FORMAT...)).

The element whose MAJOR-MODE is equal to `antlr-language' is used to
specify the generated files which are language dependent.  See variable
`antlr-special-file-formats' for language independent files.

VOCAB-FILE-FORMAT is a format string, it specifies with substitution
VOCAB/%s the generated file for each export vocabulary VOCAB.
CLASS-FILE-FORMAT is a format string, it specifies with substitution
CLASS/%s the generated file for each grammar class CLASS.")

(defvar antlr-special-file-formats '("%sTokenTypes.txt" "expanded%s.g")
  "Language independent formats which specify generated files.
The value looks like (VOCAB-FILE-FORMAT EXPANDED-GRAMMAR-FORMAT).

VOCAB-FILE-FORMAT is a format string, it specifies with substitution
VOCAB/%s the generated or input file for each export or import
vocabulary VOCAB, respectively.  EXPANDED-GRAMMAR-FORMAT is a format
string, it specifies with substitution GRAMMAR/%s the constructed
grammar file if the file GRAMMAR.g contains a grammar class which
extends a class other than \"Lexer\", \"Parser\" or \"TreeParser\".

See variable `antlr-file-formats-alist' for language dependent
formats.")

(defvar antlr-unknown-file-formats '("?%s?.g" "?%s?")
  "*Formats which specify the names of unknown files.
The value looks like (SUPER-GRAMMAR-FILE-FORMAT SUPER-EVOCAB-FORMAT).

SUPER-GRAMMAR-FORMAT is a format string, it specifies with substitution
SUPER/%s the name of a grammar file for Antlr's option \"-glib\" if no
grammar file in the current directory defines the class SUPER or if it
is defined more than once.  SUPER-EVOCAB-FORMAT is a format string, it
specifies with substitution SUPER/%s the name for the export vocabulary
of above mentioned class SUPER.")

(defvar antlr-help-unknown-file-text
  "## The following rules contain filenames of the form
##  \"?SUPERCLASS?.g\" (and \"?SUPERCLASS?TokenTypes.txt\")
## where SUPERCLASS is not found to be defined in any grammar file of
## the current directory or is defined more than once.  Please replace
## these filenames by the grammar files (and their exportVocab).\n\n"
  "String indicating the existence of unknown files in the Makefile.
See \\[antlr-show-makefile-rules] and `antlr-unknown-file-formats'.")

(defvar antlr-help-rules-intro
  "The following Makefile rules define the dependencies for all (non-
expanded) grammars in directory \"%s\".\n
They are stored in the kill-ring, i.e., you can insert them with C-y
into your Makefile.  You can also invoke M-x antlr-show-makefile-rules
from within a Makefile to insert them directly.\n\n\n"
  "Introduction to use with \\[antlr-show-makefile-rules].
It is a format string and used with substitution DIRECTORY/%s where
DIRECTORY is the name of the current directory.")


354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375
;;;===========================================================================
;;;  Menu
;;;===========================================================================

(defcustom antlr-imenu-name t
  "*Non-nil, if a \"Index\" menu should be added to the menubar.
If it is a string, it is used instead \"Index\".  Requires package
imenu."
  :group 'antlr
  :type '(choice (const :tag "No menu" nil)
		 (const :tag "Index menu" t)
		 (string :tag "Other menu name")))

(defvar antlr-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\t" 'antlr-indent-command)
    (define-key map "\e\C-a" 'antlr-beginning-of-rule)
    (define-key map "\e\C-e" 'antlr-end-of-rule)
    (define-key map "\C-c\C-a" 'antlr-beginning-of-body)
    (define-key map "\C-c\C-e" 'antlr-end-of-body)
    (define-key map "\C-c\C-f" 'c-forward-into-nomenclature)
    (define-key map "\C-c\C-b" 'c-backward-into-nomenclature)
Gerd Moellmann's avatar
Gerd Moellmann committed
376
    (define-key map "\C-c\C-c" 'comment-region)
377
    (define-key map "\C-c\C-v" 'antlr-hide-actions)
378
    (define-key map "\C-c\C-r" 'antlr-run-tool)
379 380 381 382 383 384 385 386 387 388 389 390 391 392
    ;; I'm too lazy to define my own:
    (define-key map "\ea" 'c-beginning-of-statement)
    (define-key map "\ee" 'c-end-of-statement)
    map)
  "Keymap used in `antlr-mode' buffers.")

(easy-menu-define antlr-mode-menu
		  antlr-mode-map
		  "Major mode menu."
		  '("Antlr"
		    ["Indent Line" antlr-indent-command
		     :active (not buffer-read-only)]
		    ["Indent for Comment" indent-for-comment
		     :active (not buffer-read-only)]
Gerd Moellmann's avatar
Gerd Moellmann committed
393 394 395 396 397 398 399 400
		    ["Comment Out Region" comment-region
		     :active (and (not buffer-read-only)
				  (c-region-is-active-p))]
		    ["Uncomment Region"
		     (comment-region (region-beginning) (region-end) '(4))
		     :active (and (not buffer-read-only)
				  (c-region-is-active-p))]
		    "---"
401 402 403 404 405 406 407 408 409 410
		    ["Backward Rule" antlr-beginning-of-rule t]
		    ["Forward Rule" antlr-end-of-rule t]
		    ["Start of Rule Body" antlr-beginning-of-body
		     :active (antlr-inside-rule-p)]
		    ["End of Rule Body" antlr-end-of-body
		     :active (antlr-inside-rule-p)]
		    "---"
		    ["Backward Statement" c-beginning-of-statement t]
		    ["Forward Statement" c-end-of-statement t]
		    ["Backward Into Nomencl." c-backward-into-nomenclature t]
411 412 413 414
		    ["Forward Into Nomencl." c-forward-into-nomenclature t]
		    "---"
		    ["Hide Actions (incl. Args)" antlr-hide-actions t]
		    ["Hide Actions (excl. Args)" (antlr-hide-actions 2) t]
415 416 417 418
		    ["Unhide All Actions" (antlr-hide-actions 0) t]
		    "---"
		    ["Run Tool on Grammar" antlr-run-tool t]
		    ["Show Makefile Rules" antlr-show-makefile-rules t]))
419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453


;;;===========================================================================
;;;  font-lock
;;;===========================================================================

(defcustom antlr-font-lock-maximum-decoration 'inherit
  "*The maximum decoration level for fontifying actions.
Value `none' means, do not fontify actions, just normal grammar code
according to `antlr-font-lock-additional-keywords'.  Value `inherit'
means, use value of `font-lock-maximum-decoration'.  Any other value is
interpreted as in `font-lock-maximum-decoration' with no level-0
fontification, see `antlr-font-lock-keywords-alist'.

While calculating the decoration level for actions, `major-mode' is
bound to `antlr-language'.  For example, with value
  ((java-mode . 2) (c++-mode . 0))
Java actions are fontified with level 2 and C++ actions are not
fontified at all."
  :type '(choice (const :tag "none" none)
		 (const :tag "inherit" inherit)
		 (const :tag "default" nil)
		 (const :tag "maximum" t)
		 (integer :tag "level" 1)
		 (repeat :menu-tag "mode specific" :tag "mode specific"
			 :value ((t . t))
			 (cons :tag "Instance"
			       (radio :tag "Mode"
				      (const :tag "all" t)
				      (symbol :tag "name"))
			       (radio :tag "Decoration"
				      (const :tag "default" nil)
				      (const :tag "maximum" t)
				      (integer :tag "level" 1))))))

454 455 456 457 458 459 460
(defconst antlr-no-action-keywords nil
  ;; Using nil directly won't work (would use highest level, see
  ;; `font-lock-choose-keywords'), but a non-symbol, i.e., (list), at `car'
  ;; would break Emacs-21.0:
  "Empty font-lock keywords for actions.
Do not change the value of this constant.")

461 462
(defvar antlr-font-lock-keywords-alist
  '((java-mode
463
     antlr-no-action-keywords
464 465 466
     java-font-lock-keywords-1 java-font-lock-keywords-2
     java-font-lock-keywords-3)
    (c++-mode
467
     antlr-no-action-keywords
468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492
     c++-font-lock-keywords-1 c++-font-lock-keywords-2
     c++-font-lock-keywords-3))
  "List of font-lock keywords for actions in the grammar.
Each element in this list looks like
  (MAJOR-MODE KEYWORD...)

If `antlr-language' is equal to MAJOR-MODE, the KEYWORDs are the
font-lock keywords according to `font-lock-defaults' used for the code
in the grammar's actions and semantic predicates, see
`antlr-font-lock-maximum-decoration'.")

(defvar antlr-font-lock-keyword-face 'antlr-font-lock-keyword-face)
(defface antlr-font-lock-keyword-face
  '((((class color) (background light)) (:foreground "black" :bold t)))
  "ANTLR keywords."
  :group 'antlr)

(defvar antlr-font-lock-ruledef-face 'antlr-font-lock-ruledef-face)
(defface antlr-font-lock-ruledef-face
  '((((class color) (background light)) (:foreground "blue" :bold t)))
  "ANTLR rule references (definition)."
  :group 'antlr)

(defvar antlr-font-lock-tokendef-face 'antlr-font-lock-tokendef-face)
(defface antlr-font-lock-tokendef-face
493
  '((((class color) (background light)) (:foreground "blue" :bold t)))
494 495 496 497 498 499 500 501 502 503 504
  "ANTLR token references (definition)."
  :group 'antlr)

(defvar antlr-font-lock-ruleref-face 'antlr-font-lock-ruleref-face)
(defface antlr-font-lock-ruleref-face
  '((((class color) (background light)) (:foreground "blue4")))
  "ANTLR rule references (usage)."
  :group 'antlr)

(defvar antlr-font-lock-tokenref-face 'antlr-font-lock-tokenref-face)
(defface antlr-font-lock-tokenref-face
505
  '((((class color) (background light)) (:foreground "orange4")))
506 507 508 509 510 511 512 513 514 515 516
  "ANTLR token references (usage)."
  :group 'antlr)

(defvar antlr-font-lock-literal-face 'antlr-font-lock-literal-face)
(defface antlr-font-lock-literal-face
  '((((class color) (background light)) (:foreground "brown4" :bold t)))
  "ANTLR literal tokens consisting merely of letter-like characters."
  :group 'antlr)

(defvar antlr-font-lock-additional-keywords
  `((antlr-invalidate-context-cache)
517
    ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))"
518 519 520 521 522
     (1 antlr-font-lock-tokendef-face))
    ("\\$\\sw+" (0 font-lock-keyword-face))
    ;; the tokens are already fontified as string/docstrings:
    (,(lambda (limit)
	(antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" limit))
523 524 525
     (1 antlr-font-lock-literal-face t)
     ,@(and (string-match "XEmacs" emacs-version)
	    '((0 nil))))		; XEmacs bug workaround
526 527
    (,(lambda (limit)
	(antlr-re-search-forward
528
	 "^\\(class\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]+\\(extends\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]*;" limit))
529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580
     (1 antlr-font-lock-keyword-face)
     (2 antlr-font-lock-ruledef-face)
     (3 antlr-font-lock-keyword-face)
     (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
	    'antlr-font-lock-keyword-face
	  'font-lock-type-face)))
    (,(lambda (limit)
	(antlr-re-search-forward
	 "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
	 limit))
     (1 antlr-font-lock-keyword-face))
    (,(lambda (limit)
	(antlr-re-search-forward
	 "^\\(private\\|public\\|protected\\)\\>\\([ \t]+\\(\\sw+\\)\\)?"
	 limit))
     (1 font-lock-type-face)		; not XEmacs' java level-3 fruit salad
     (3 (if (antlr-upcase-p (char-after (match-beginning 3)))
	    'antlr-font-lock-tokendef-face
	  'antlr-font-lock-ruledef-face) nil t))
    (,(lambda (limit)
	(antlr-re-search-forward "^\\sw+" limit))
     (0 (if (antlr-upcase-p (char-after (match-beginning 0)))
	    'antlr-font-lock-tokendef-face
	  'antlr-font-lock-ruledef-face) nil t))
    (,(lambda (limit)
	;; not only before a rule ref, also before a literal
	(antlr-re-search-forward "\\<\\(\\sw+\\)[ \t]*:" limit))
     (1 font-lock-variable-name-face))
    (,(lambda (limit)
	(antlr-re-search-forward "\\<\\(\\sw+[ \t]*=[ \t]*\\)?\\(\\sw+[ \t]*:[ \t]*\\)?\\(\\sw+\\)" limit))
     ;;(1 antlr-font-lock-default-face nil t) ; fool java-font-lock-keywords
     (3 (if (antlr-upcase-p (char-after (match-beginning 3)))
	    'antlr-font-lock-tokenref-face
	  'antlr-font-lock-ruleref-face))))
  "Font-lock keywords for ANTLR's normal grammar code.
See `antlr-font-lock-keywords-alist' for the keywords of actions.")

(defvar antlr-font-lock-defaults
  '(antlr-font-lock-keywords
    nil nil ((?_ . "w") (?\( . ".") (?\) . ".")) beginning-of-defun)
  "Font-lock defaults used for ANTLR syntax coloring.
The SYNTAX-ALIST element is also used to initialize
`antlr-action-syntax-table'.")


;;;===========================================================================
;;;  Internal variables
;;;===========================================================================

(defvar antlr-mode-hook nil
  "Hook called by `antlr-mode'.")

581 582 583 584
(defvar antlr-mode-syntax-table nil
  "Syntax table used in `antlr-mode' buffers.
If non-nil, it will be initialized in `antlr-mode'.")

585 586 587
;; used for "in Java/C++ code" = syntactic-depth>0
(defvar antlr-action-syntax-table nil
  "Syntax table used for ANTLR action parsing.
588 589 590 591
Initialized by `antlr-mode-syntax-table', changed by SYNTAX-ALIST in
`antlr-font-lock-defaults'.  This table should be selected if you use
`buffer-syntactic-context' and `buffer-syntactic-context-depth' in order
not to confuse their context_cache.")
592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607

(defvar antlr-mode-abbrev-table nil
  "Abbreviation table used in `antlr-mode' buffers.")
(define-abbrev-table 'antlr-mode-abbrev-table ())



;;;;##########################################################################
;;;;  The Code
;;;;##########################################################################


;;;===========================================================================
;;;  Syntax functions -- Emacs vs XEmacs dependent
;;;===========================================================================

608
;; From help.el (XEmacs-21.1), without `copy-syntax-table'
609
(defmacro antlr-with-syntax-table (syntab &rest body)
610
  "Evaluate BODY with the syntax table SYNTAB."
611 612
  `(let ((stab (syntax-table)))
     (unwind-protect
613
	 (progn (set-syntax-table ,syntab) ,@body)
614 615 616 617 618 619 620 621
       (set-syntax-table stab))))
(put 'antlr-with-syntax-table 'lisp-indent-function 1)
(put 'antlr-with-syntax-table 'edebug-form-spec '(form body))

(defun antlr-scan-sexps-internal (from count &optional dummy no-error)
;; checkdoc-params: (from count dummy)
  "Like `scan-sexps' but with additional arguments.
When optional arg NO-ERROR is non-nil, `scan-sexps' will return nil
Gerd Moellmann's avatar
Gerd Moellmann committed
622
instead of signaling an error."
623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673
  (if no-error
      (condition-case nil
	  (scan-sexps from count)
	(t nil))
    (scan-sexps from count)))

(defun antlr-xemacs-bug-workaround (&rest dummies)
;; checkdoc-params: (dummies)
  "Invalidate context_cache for syntactical context information."
  ;; XEmacs bug workaround
  (save-excursion
    (set-buffer (get-buffer-create " ANTLR XEmacs bug workaround"))
    (buffer-syntactic-context-depth))
  nil)

(defun antlr-fast-syntactic-context ()
  "Return some syntactic context information.
Return `string' if point is within a string, `block-comment' or
`comment' is point is within a comment or the depth within all
parenthesis-syntax delimiters at point otherwise.
WARNING: this may alter `match-data'."
  (or (buffer-syntactic-context) (buffer-syntactic-context-depth)))

(defun antlr-slow-syntactic-context ()
  "Return some syntactic context information.
Return `string' if point is within a string, `block-comment' or
`comment' is point is within a comment or the depth within all
parenthesis-syntax delimiters at point otherwise.
WARNING: this may alter `match-data'."
  (let ((orig (point)))
    (beginning-of-defun)
    (let ((state (parse-partial-sexp (point) orig)))
      (goto-char orig)
      (cond ((nth 3 state) 'string)
	    ((nth 4 state) 'comment)	; block-comment? -- we don't care
	    (t (car state))))))


;;;===========================================================================
;;;  Misc functions
;;;===========================================================================

(defun antlr-upcase-p (char)
  "Non-nil, if CHAR is an uppercase character (if CHAR was a char)."
  ;; in XEmacs, upcase only works for ASCII
  (or (and (<= ?A char) (<= char ?Z))
      (and (<= ?\300 char) (<= char ?\337)))) ; ?\327 is no letter

(defun antlr-re-search-forward (regexp bound)
  "Search forward from point for regular expression REGEXP.
Set point to the end of the occurrence found, and return point.  Return
Gerd Moellmann's avatar
Gerd Moellmann committed
674
nil if no occurrence was found.  Do not search within comments, strings
675 676 677 678 679 680 681
and actions/semantic predicates.  BOUND bounds the search; it is a
buffer position.  See also the functions `match-beginning', `match-end'
and `replace-match'."
  ;; WARNING: Should only be used with `antlr-action-syntax-table'!
  (let ((continue t))
    (while (and (re-search-forward regexp bound 'limit)
		(save-match-data
682 683 684
		  (if (eq (antlr-syntactic-context) 0)
		      (setq continue nil)
		    t))))
685 686 687 688 689
    (if continue nil (point))))

(defun antlr-search-forward (string)
  "Search forward from point for STRING.
Set point to the end of the occurrence found, and return point.  Return
Gerd Moellmann's avatar
Gerd Moellmann committed
690
nil if no occurrence was found.  Do not search within comments, strings
691 692 693 694 695 696 697 698 699 700
and actions/semantic predicates."
  ;; WARNING: Should only be used with `antlr-action-syntax-table'!
  (let ((continue t))
    (while (and (search-forward string nil 'limit)
		(if (eq (antlr-syntactic-context) 0) (setq continue nil) t)))
    (if continue nil (point))))

(defun antlr-search-backward (string)
  "Search backward from point for STRING.
Set point to the beginning of the occurrence found, and return point.
Gerd Moellmann's avatar
Gerd Moellmann committed
701
Return nil if no occurrence was found.  Do not search within comments,
702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741
strings and actions/semantic predicates."
  ;; WARNING: Should only be used with `antlr-action-syntax-table'!
  (let ((continue t))
    (while (and (search-backward string nil 'limit)
		(if (eq (antlr-syntactic-context) 0) (setq continue nil) t)))
    (if continue nil (point))))

(defsubst antlr-skip-sexps (count)
  "Skip the next COUNT balanced expressions and the comments after it.
Return position before the comments after the last expression."
  (goto-char (or (antlr-scan-sexps (point) count nil t) (point-max)))
  (prog1 (point)
    (c-forward-syntactic-ws)))


;;;===========================================================================
;;;  font-lock
;;;===========================================================================

(defun antlr-font-lock-keywords ()
  "Return font-lock keywords for current buffer.
See `antlr-font-lock-additional-keywords', `antlr-language' and
`antlr-font-lock-maximum-decoration'."
  (if (eq antlr-font-lock-maximum-decoration 'none)
      antlr-font-lock-additional-keywords
    (append antlr-font-lock-additional-keywords
	    (eval (let ((major-mode antlr-language)) ; dynamic
			(font-lock-choose-keywords
			 (cdr (assq antlr-language
				    antlr-font-lock-keywords-alist))
			 (if (eq antlr-font-lock-maximum-decoration 'inherit)
			     font-lock-maximum-decoration
			   antlr-font-lock-maximum-decoration)))))))


;;;===========================================================================
;;;  imenu support
;;;===========================================================================

(defun antlr-imenu-create-index-function ()
Gerd Moellmann's avatar
Gerd Moellmann committed
742
  "Return imenu index-alist for ANTLR grammar files."
743 744 745 746 747 748 749 750 751 752 753 754 755 756 757
  (let ((items nil)
	(classes nil)
	(semi (point-max)))
    ;; Using `imenu-progress-message' would require imenu for compilation --
    ;; nobody is missing these messages...
    (antlr-with-syntax-table antlr-action-syntax-table
      ;; We stick to the imenu standard and search backwards, although I don't
      ;; think this is right.  It is slower and more likely not to work during
      ;; editing (you are more likely to add functions to the end of the file).
      (while semi
	(goto-char semi)
	(if (setq semi (antlr-search-backward ";"))
	    (progn (forward-char) (antlr-skip-exception-part t))
	  (antlr-skip-file-prelude t))
	(if (looking-at "{") (antlr-skip-sexps 1))
758 759 760 761 762 763
	(if (looking-at "class[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]+extends[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]*;")
	    (push (cons (match-string 1)
			(if imenu-use-markers
			    (copy-marker (match-beginning 1))
			  (match-beginning 1)))
		  classes)
764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803
	  (if (looking-at "p\\(ublic\\|rotected\\|rivate\\)")
	      (antlr-skip-sexps 1))
	  (when (looking-at "\\sw+")
	    (push (cons (match-string 0)
			(if imenu-use-markers
			    (copy-marker (match-beginning 0))
			  (match-beginning 0)))
		  items)))))
    (if classes (cons (cons "Classes" classes) items) items)))


;;;===========================================================================
;;;  Parse grammar files (internal functions)
;;;===========================================================================

(defun antlr-skip-exception-part (skip-comment)
  "Skip exception part of current rule, i.e., everything after `;'.
This also includes the options and tokens part of a grammar class
header.  If SKIP-COMMENT is non-nil, also skip the comment after that
part."
  (let ((pos (point))
	(class nil))
    (c-forward-syntactic-ws)
    (while (looking-at "options\\>\\|tokens\\>")
      (setq class t)
      (setq pos (antlr-skip-sexps 2)))
    (if class
	;; Problem: an action only belongs to a class def, not a normal rule.
	;; But checking the current rule type is too expensive => only expect
	;; an action if we have found an option or tokens part.
	(if (looking-at "{") (setq pos (antlr-skip-sexps 1)))
      (while (looking-at "exception\\>")
	(setq pos (antlr-skip-sexps 1))
	(if (looking-at "\\[") (setq pos (antlr-skip-sexps 1)))
	(while (looking-at "catch\\>")
	  (setq pos (antlr-skip-sexps 3)))))
    (or skip-comment (goto-char pos))))

(defun antlr-skip-file-prelude (skip-comment)
  "Skip the file prelude: the header and file options.
804 805
If SKIP-COMMENT is non-nil, also skip the comment after that part.
Return the start position of the file prelude."
806 807 808 809
  (let* ((pos (point))
	 (pos0 pos))
    (c-forward-syntactic-ws)
    (if skip-comment (setq pos0 (point)))
810 811
    (while (looking-at "header\\>[ \t]*\\(\"\\)?")
      (setq pos (antlr-skip-sexps (if (match-beginning 1) 3 2))))
812 813 814 815 816 817 818 819
    (if (looking-at "options\\>") (setq pos (antlr-skip-sexps 2)))
    (or skip-comment (goto-char pos))
    pos0))

(defun antlr-next-rule (arg skip-comment)
  "Move forward to next end of rule.  Do it ARG many times.
A grammar class header and the file prelude are also considered as a
rule.  Negative argument ARG means move back to ARGth preceding end of
Gerd Moellmann's avatar
Gerd Moellmann committed
820
rule.  The behavior is not defined when ARG is zero.  If SKIP-COMMENT
821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937
is non-nil, move to beginning of the rule."
  ;; WARNING: Should only be used with `antlr-action-syntax-table'!
  ;; PRE: ARG<>0
  (let ((pos (point))
	(beg (point)))
    ;; first look whether point is in exception part
    (if (antlr-search-backward ";")
	(progn
	  (setq beg (point))
	  (forward-char)
	  (antlr-skip-exception-part skip-comment))
      (antlr-skip-file-prelude skip-comment))
    (if (< arg 0)
	(unless (and (< (point) pos) (zerop (incf arg)))
	  ;; if we have moved backward, we already moved one defun backward
	  (goto-char beg)		; rewind (to ";" / point)
	  (while (and arg (<= (incf arg) 0))
	    (if (antlr-search-backward ";")
		(setq beg (point))
	      (when (>= arg -1)
		;; try file prelude:
		(setq pos (antlr-skip-file-prelude skip-comment))
		(if (zerop arg)
		    (if (>= (point) beg)
			(goto-char (if (>= pos beg) (point-min) pos)))
		  (goto-char (if (or (>= (point) beg) (= (point) pos))
				 (point-min) pos))))
	      (setq arg nil)))
	  (when arg			; always found a ";"
	    (forward-char)
	    (antlr-skip-exception-part skip-comment)))
      (if (<= (point) pos)		; moved backward?
	  (goto-char pos)		; rewind
	(decf arg))			; already moved one defun forward
      (unless (zerop arg)
	(while (>= (decf arg) 0)
	  (antlr-search-forward ";"))
	(antlr-skip-exception-part skip-comment)))))

(defun antlr-outside-rule-p ()
  "Non-nil if point is outside a grammar rule.
Move to the beginning of the current rule if point is inside a rule."
  ;; WARNING: Should only be used with `antlr-action-syntax-table'!
  (let ((pos (point)))
    (antlr-next-rule -1 nil)
    (let ((between (or (bobp) (< (point) pos))))
      (c-forward-syntactic-ws)
      (and between (> (point) pos) (goto-char pos)))))


;;;===========================================================================
;;;  Parse grammar files (commands)
;;;===========================================================================
;; No (interactive "_") in Emacs... use `zmacs-region-stays'.

(defun antlr-inside-rule-p ()
  "Non-nil if point is inside a grammar rule.
A grammar class header and the file prelude are also considered as a
rule."
  (save-excursion
    (antlr-with-syntax-table antlr-action-syntax-table
      (not (antlr-outside-rule-p)))))

(defun antlr-end-of-rule (&optional arg)
  "Move forward to next end of rule.  Do it ARG [default: 1] many times.
A grammar class header and the file prelude are also considered as a
rule.  Negative argument ARG means move back to ARGth preceding end of
rule.  If ARG is zero, run `antlr-end-of-body'."
  (interactive "p")
  (if (zerop arg)
      (antlr-end-of-body)
    (antlr-with-syntax-table antlr-action-syntax-table
      (antlr-next-rule arg nil))
    (setq zmacs-region-stays t)))

(defun antlr-beginning-of-rule (&optional arg)
  "Move backward to preceding beginning of rule.  Do it ARG many times.
A grammar class header and the file prelude are also considered as a
rule.  Negative argument ARG means move forward to ARGth next beginning
of rule.  If ARG is zero, run `antlr-beginning-of-body'."
  (interactive "p")
  (if (zerop arg)
      (antlr-beginning-of-body)
    (antlr-with-syntax-table antlr-action-syntax-table
      (antlr-next-rule (- arg) t))
    (setq zmacs-region-stays t)))

(defun antlr-end-of-body (&optional msg)
  "Move to position after the `;' of the current rule.
A grammar class header is also considered as a rule.  With optional
prefix arg MSG, move to `:'."
  (interactive)
  (antlr-with-syntax-table antlr-action-syntax-table
    (let ((orig (point)))
      (if (antlr-outside-rule-p)
	  (error "Outside an ANTLR rule"))
      (let ((bor (point)))
	(when (< (antlr-skip-file-prelude t) (point))
	  ;; Yes, we are in the file prelude
	  (goto-char orig)
	  (error (or msg "The file prelude is without `;'")))
	(antlr-search-forward ";")
	(when msg
	  (when (< (point)
		   (progn (goto-char bor)
			  (or (antlr-search-forward ":") (point-max))))
	    (goto-char orig)
	    (error msg))
	  (c-forward-syntactic-ws)))))
  (setq zmacs-region-stays t))

(defun antlr-beginning-of-body ()
  "Move to the first element after the `:' of the current rule."
  (interactive)
  (antlr-end-of-body "Class headers and the file prelude are without `:'"))


938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966
;;;===========================================================================
;;;  Literal normalization, Hide Actions
;;;===========================================================================

(defun antlr-downcase-literals (&optional transform)
  "Convert all literals in buffer to lower case.
If non-nil, TRANSFORM is used on literals instead of `downcase-region'."
  (interactive)
  (or transform (setq transform 'downcase-region))
  (let ((literals 0))
    (save-excursion
      (goto-char (point-min))
      (antlr-with-syntax-table antlr-action-syntax-table
	(antlr-invalidate-context-cache)
	(while (antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" nil)
	  (funcall transform (match-beginning 0) (match-end 0))
	  (incf literals))))
    (message "Transformed %d literals" literals)))

(defun antlr-upcase-literals ()
  "Convert all literals in buffer to upper case."
  (interactive)
  (antlr-downcase-literals 'upcase-region))

(defun antlr-hide-actions (arg &optional silent)
  "Hide or unhide all actions in buffer.
Hide all actions including arguments in brackets if ARG is 1 or if
called interactively without prefix argument.  Hide all actions
excluding arguments in brackets if ARG is 2 or higher.  Unhide all
967 968 969
actions if ARG is 0 or negative.  See `antlr-action-visibility'.

Display a message unless optional argument SILENT is non-nil."
970 971 972 973 974 975 976 977 978
  (interactive "p")
  ;; from Emacs/lazy-lock: `save-buffer-state'
  (let ((modified (buffer-modified-p))
	(buffer-undo-list t) (inhibit-read-only t)
	(inhibit-point-motion-hooks t) deactivate-mark ; Emacs only
	before-change-functions after-change-functions
	buffer-file-name buffer-file-truename)
    (if (> arg 0)
	(let ((regexp (if (= arg 1) "[]}]" "}"))
979 980
	      (diff (and antlr-action-visibility
			 (+ (max antlr-action-visibility 0) 2))))
981 982 983 984 985 986
	  (antlr-hide-actions 0 t)
	  (save-excursion
	    (goto-char (point-min))
	    (antlr-with-syntax-table antlr-action-syntax-table
	      (antlr-invalidate-context-cache)
	      (while (antlr-re-search-forward regexp nil)
987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001
		(let ((beg (antlr-scan-sexps (point) -1 nil t)))
		  (when beg
		    (if diff		; braces are visible
			(if (> (point) (+ beg diff))
			    (add-text-properties (1+ beg) (1- (point))
						 '(invisible t intangible t)))
		      ;; if actions is on line(s) of its own, hide WS
		      (and (looking-at "[ \t]*$")
			   (save-excursion
			     (goto-char beg)
			     (skip-chars-backward " \t")
			     (and (bolp) (setq beg (point))))
			   (beginning-of-line 2)) ; beginning of next line
		      (add-text-properties beg (point)
					   '(invisible t intangible t))))))))
1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012
	  (or silent
	      (message "Hide all actions (%s arguments)...done"
		       (if (= arg 1) "including" "excluding"))))
      (remove-text-properties (point-min) (point-max)
			      '(invisible nil intangible nil))
      (or silent
	  (message "Unhide all actions (including arguments)...done")))
    (and (not modified) (buffer-modified-p)
	 (set-buffer-modified-p nil))))


1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296
;;;===========================================================================
;;;  Compute dependencies
;;;===========================================================================

(defun antlr-file-dependencies ()
  "Return dependencies for grammar in current buffer.
The result looks like (FILE (CLASSES . SUPERS) VOCABS . LANGUAGE)
where CLASSES = ((CLASS . CLASS-EVOCAB) ...),
      SUPERS  = ((SUPER . USE-EVOCAB-P) ...), and
      VOCABS  = ((EVOCAB ...) . (IVOCAB ...))

FILE is the current buffer's file-name without directory part and
LANGUAGE is the value of `antlr-language' in the current buffer.  Each
EVOCAB is an export vocabulary and each IVOCAB is an import vocabulary.

Each CLASS is a grammar class with its export vocabulary CLASS-EVOCAB.
Each SUPER is a super-grammar class where USE-EVOCAB-P indicates whether
its export vocabulary is used as an import vocabulary."
  (unless buffer-file-name
    (error "Grammar buffer does not visit a file"))
  (let (classes exportVocabs importVocabs superclasses default-vocab)
    (antlr-with-syntax-table antlr-action-syntax-table
      (goto-char (point-min))
      (while (antlr-re-search-forward "class[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]+extends[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]*;" nil)
	;; parse class definition --------------------------------------------
	(let* ((class (match-string 1))
	       (sclass (match-string 2))
	       ;; export vocab defaults to class name (first grammar in file)
	       ;; or to the export vocab of the first grammar in file:
	       (evocab (or default-vocab class))
	       (ivocab nil))
	  (goto-char (match-end 0))
	  (c-forward-syntactic-ws)
	  (while (looking-at "options\\>\\|\\(tokens\\)\\>")
	    (if (match-beginning 1)
		(antlr-skip-sexps 2)
	      (goto-char (match-end 0))
	      (c-forward-syntactic-ws)
	      ;; parse grammar option section --------------------------------
	      (when (eq (char-after (point)) ?\{)
		(let* ((beg (1+ (point)))
		       (end (1- (antlr-skip-sexps 1)))
		       (cont (point)))
		(goto-char beg)
		(if (re-search-forward "\\<exportVocab[ \t]*=[ \t]*\\([A-Za-z\300-\326\330-\337]\\sw*\\)" end t)
		    (setq evocab (match-string 1)))
		(goto-char beg)
		(if (re-search-forward "\\<importVocab[ \t]*=[ \t]*\\([A-Za-z\300-\326\330-\337]\\sw*\\)" end t)
		    (setq ivocab (match-string 1)))
		(goto-char cont)))))
	  (unless (member sclass '("Parser" "Lexer" "TreeParser"))
	    (let ((super (assoc sclass superclasses)))
	      (if super
		  (or ivocab (setcdr super t))
		(push (cons sclass (null ivocab)) superclasses))))
	  ;; remember class with export vocabulary:
	  (push (cons class evocab) classes)
	  ;; default export vocab is export vocab of first grammar in file:
	  (or default-vocab (setq default-vocab evocab))
	  (or (member evocab exportVocabs) (push evocab exportVocabs))
	  (or (null ivocab)
	      (member ivocab importVocabs) (push ivocab importVocabs)))))
    (if classes
	(list* (file-name-nondirectory buffer-file-name)
	       (cons (nreverse classes) (nreverse superclasses))
	       (cons (nreverse exportVocabs) (nreverse importVocabs))
	       antlr-language))))

(defun antlr-directory-dependencies (dirname)
  "Return dependencies for all grammar files in directory DIRNAME.
The result looks like ((CLASS-SPEC ...) . (FILE-DEP ...))
where CLASS-SPEC = (CLASS (FILE . EVOCAB) ...).

FILE-DEP are the dependencies for each grammar file in DIRNAME, see
`antlr-file-dependencies'.  For each grammar class CLASS, FILE is a
grammar file in which CLASS is defined and EVOCAB is the name of the
export vocabulary specified in that file."
  (let ((grammar (directory-files dirname t "\\.g\\'")))
    (when grammar
      (let ((temp-buffer (get-buffer-create
			  (generate-new-buffer-name " *temp*")))
	    (antlr-imenu-name nil)		; dynamic-let: no imenu
	    (expanded-regexp (concat (format (regexp-quote
					      (cadr antlr-special-file-formats))
					     ".+")
				     "\\'"))
	    classes dependencies)
	(unwind-protect
	    (save-excursion
	      (set-buffer temp-buffer)
	      (widen)			; just in case...
	      (dolist (file grammar)
		(when (and (file-regular-p file)
			   (null (string-match expanded-regexp file)))
		  (insert-file-contents file t nil nil t)
		  (normal-mode t)	; necessary for major-mode, syntax
					; table and `antlr-language'
		  (when (eq major-mode 'antlr-mode)
		    (let* ((file-deps (antlr-file-dependencies))
			   (file (car file-deps)))
		      (when file-deps
			(dolist (class-def (caadr file-deps))
			  (let ((file-evocab (cons file (cdr class-def)))
				(class-spec (assoc (car class-def) classes)))
			    (if class-spec
				(nconc (cdr class-spec) (list file-evocab))
			      (push (list (car class-def) file-evocab)
				    classes))))
			(push file-deps dependencies)))))))
	  (kill-buffer temp-buffer))
	(cons (nreverse classes) (nreverse dependencies))))))


;;;===========================================================================
;;;  Compilation: run ANTLR tool
;;;===========================================================================

(defun antlr-superclasses-glibs (supers classes)
  "Compute the grammar lib option for the super grammars SUPERS.
Look in CLASSES for the right grammar lib files for SUPERS.  SUPERS is
part SUPER in the result of `antlr-file-dependencies'.  CLASSES is the
part (CLASS-SPEC ...) in the result of `antlr-directory-dependencies'.

The result looks like (OPTION WITH-UNKNOWN GLIB ...).  OPTION is the
complete \"-glib\" option.  WITH-UNKNOWN has value t iff there is none
or more than one grammar file for at least one super grammar.

Each GLIB looks like (GRAMMAR-FILE . EVOCAB).  GRAMMAR-FILE is a file in
which a super-grammar is defined.  EVOCAB is the value of the export
vocabulary of the super-grammar or nil if it is not needed."
  ;; If the superclass is defined in the same file, that file will be included
  ;; with -glib again.  This will lead to a redefinition.  But defining a
  ;; analyzer of the same class twice in a file will lead to an error anyway...
  (let (glibs unknown)
    (while supers
      (let* ((super (pop supers))
	     (sup-files (cdr (assoc (car super) classes)))
	     (file (and sup-files (null (cdr sup-files)) (car sup-files))))
	(or file (setq unknown t))	; not exactly one file
	(push (cons (or (car file)
			(format (car antlr-unknown-file-formats)
				(car super)))
		    (and (cdr super)
			 (or (cdr file)
			     (format (cadr antlr-unknown-file-formats)
				     (car super)))))
	      glibs)))
    (cons (if glibs (concat " -glib " (mapconcat 'car glibs ";")) "")
	  (cons unknown glibs))))

(defun antlr-run-tool (command file &optional saved)
  "Run Antlr took COMMAND on grammar FILE.
When called interactively, COMMAND is read from the minibuffer and
defaults to `antlr-tool-command' with a computed \"-glib\" option if
necessary.

Save all buffers first unless optional value SAVED is non-nil.  When
called interactively, the buffers are always saved, see also variable
`antlr-ask-about-save'."
  (interactive
   ;; code in `interactive' is not compiled: do not use cl macros (`cdadr')
   (let* ((supers (cdr (cadr (save-excursion
			       (save-restriction
				 (widen)
				 (antlr-file-dependencies))))))
	  (glibs ""))
     (when supers
       (save-some-buffers (not antlr-ask-about-save) nil)
       (setq glibs (car (antlr-superclasses-glibs
			 supers
			 (car (antlr-directory-dependencies
			       (antlr-default-directory)))))))
     (list (antlr-read-shell-command "Run Antlr on current file with: "
				     (concat antlr-tool-command glibs " "))
	   buffer-file-name
	   supers)))
  (or saved (save-some-buffers (not antlr-ask-about-save)))
  (let ((default-directory (file-name-directory file)))
    (require 'compile)			; only `compile' autoload
    (compile-internal (concat command " " (file-name-nondirectory file))
		      "No more errors" "Antlr-Run")))


;;;===========================================================================
;;;  Makefile creation
;;;===========================================================================

(defun antlr-makefile-insert-variable (number pre post)
  "Insert Makefile variable numbered NUMBER according to specification.
Also insert strings PRE and POST before and after the variable."
  (let ((spec (cadr antlr-makefile-specification)))
    (when spec
      (insert pre
	      (if number (format (cadr spec) number) (car spec))
	      post))))

(defun antlr-insert-makefile-rules (&optional in-makefile)
  "Insert Makefile rules in the current buffer at point.
IN-MAKEFILE is non-nil, if the current buffer is the Makefile.  See
command `antlr-show-makefile-rules' for detail."
  (let* ((dirname (antlr-default-directory))
	 (deps0 (antlr-directory-dependencies dirname))
	 (classes (car deps0))		; CLASS -> (FILE . EVOCAB) ...
	 (deps (cdr deps0))		; FILE -> (c . s) (ev . iv) . LANGUAGE
	 (with-error nil)
	 (gen-sep (or (caddr (cadr antlr-makefile-specification)) " "))
	 (n (and (cdr deps) (cadr antlr-makefile-specification) 0)))
    (or in-makefile (set-buffer standard-output))
    (dolist (dep deps)
      (let ((supers (cdadr dep))
	    (lang (cdr (assoc (cdddr dep) antlr-file-formats-alist))))
	(if n (incf n))
	(antlr-makefile-insert-variable n "" " =")
	(if supers
	    (insert " "
		    (format (cadr antlr-special-file-formats)
			    (file-name-sans-extension (car dep)))))
	(dolist (class-def (caadr dep))
	  (let ((sep gen-sep))
	    (dolist (class-file (cadr lang))
	      (insert sep (format class-file (car class-def)))
	      (setq sep " "))))
	(dolist (evocab (caaddr dep))
	  (let ((sep gen-sep))
	    (dolist (vocab-file (cons (car antlr-special-file-formats)
				      (car lang)))
	      (insert sep (format vocab-file evocab))
	      (setq sep " "))))
	(antlr-makefile-insert-variable n "\n$(" ")")
	(insert ": " (car dep))
	(dolist (ivocab (cdaddr dep))
	  (insert " " (format (car antlr-special-file-formats) ivocab)))
	(let ((glibs (antlr-superclasses-glibs supers classes)))
	  (if (cadr glibs) (setq with-error t))
	  (dolist (super (cddr glibs))
	    (insert " " (car super))
	    (if (cdr super)
		(insert " " (format (car antlr-special-file-formats)
				    (cdr super)))))
	  (insert "\n\t"
		  (caddr antlr-makefile-specification)
		  (car glibs)
		  " $<\n"
		  (car antlr-makefile-specification)))))
    (if n
	(let ((i 0))
	  (antlr-makefile-insert-variable nil "" " =")
	  (while (<= (incf i) n)
	    (antlr-makefile-insert-variable i " $(" ")"))
	  (insert "\n" (car antlr-makefile-specification))))
    (if (string-equal (car antlr-makefile-specification) "\n")
	(backward-delete-char 1))
    (when with-error
      (goto-char (point-min))
      (insert antlr-help-unknown-file-text))
    (unless in-makefile
      (copy-region-as-kill (point-min) (point-max))
      (goto-char (point-min))
      (insert (format antlr-help-rules-intro dirname)))))

;;;###autoload
(defun antlr-show-makefile-rules ()
  "Show Makefile rules for all grammar files in the current directory.
If the `major-mode' of the current buffer has the value `makefile-mode',
the rules are directory inserted at point.  Otherwise, a *Help* buffer
is shown with the rules which are also put into the `kill-ring' for
\\[yank].

This command considers import/export vocabularies and grammar
inheritance and provides a value for the \"-glib\" option if necessary.
Customize variable `antlr-makefile-specification' for the appearance of
the rules.

If the file for a super-grammar cannot be determined, special file names
are used according to variable `antlr-unknown-file-formats' and a
commentary with value `antlr-help-unknown-file-text' is added.  The
*Help* buffer always starts with the text in `antlr-help-rules-intro'."
  (interactive)
  (if (null (eq major-mode 'makefile-mode))
      (antlr-with-displaying-help-buffer 'antlr-insert-makefile-rules)
    (push-mark)
    (antlr-insert-makefile-rules t)))


1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310
;;;===========================================================================
;;;  Indentation
;;;===========================================================================

(defun antlr-indent-line ()
  "Indent the current line as ANTLR grammar code.
The indentation of non-comment lines are calculated by `c-basic-offset',
multiplied by:
 - the level of the paren/brace/bracket depth,
 - plus 0/2/1, depending on the position inside the rule: header, body,
   exception part,
 - minus 1 if `antlr-indent-item-regexp' matches the beginning of the
   line starting from the first non-blank.

Gerd Moellmann's avatar
Gerd Moellmann committed
1311
Lines inside block comments are not changed or indented by
1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322
`c-indent-line', see `antlr-indent-comment'."
  (let ((orig (point)) bol boi indent syntax)
    (beginning-of-line)
    (setq bol (point))
    (skip-chars-forward " \t")
    (setq boi (point))
    ;; check syntax at beginning of indentation ------------------------------
    (antlr-with-syntax-table antlr-action-syntax-table
      (antlr-invalidate-context-cache)
      (cond ((symbolp (setq syntax (antlr-syntactic-context)))
	     (setq indent nil))		; block-comments, strings, (comments)
1323 1324 1325
	    ((eq (char-after) ?#)	; cpp directive
	     (setq syntax 'cpp)
	     (setq indent 0))		; indentation at 0
1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344
	    ((progn
	       (antlr-next-rule -1 t)
	       (if (antlr-search-forward ":") (< boi (1- (point))) t))
	     (setq indent 0))		; in rule header
	    ((if (antlr-search-forward ";") (< boi (point)) t)
	     (setq indent 2))		; in rule body
	    (t
	     (forward-char)
	     (antlr-skip-exception-part nil)
	     (setq indent (if (> (point) boi) 1 0))))) ; in exception part?
    ;; compute the corresponding indentation and indent ----------------------
    (if (null indent)
	(progn
	  (goto-char orig)
	  (and (eq antlr-indent-comment t)
	       (not (eq syntax 'string))
	       (c-indent-line)))
      ;; do it ourselves
      (goto-char boi)
1345 1346 1347 1348 1349
      (unless (symbolp syntax)		; direct indentation
	(antlr-invalidate-context-cache)
	(incf indent (antlr-syntactic-context))
	(and (> indent 0) (looking-at antlr-indent-item-regexp) (decf indent))
	(setq indent (* indent c-basic-offset)))
1350
      ;; the usual major-mode indent stuff -----------------------------------
1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414
      (setq orig (- (point-max) orig))
      (unless (= (current-column) indent)
	(delete-region bol boi)
	(beginning-of-line)
	(indent-to indent))
      ;; If initial point was within line's indentation,
      ;; position after the indentation.  Else stay at same point in text.
      (if (> (- (point-max) orig) (point))
	  (goto-char (- (point-max) orig))))))

(defun antlr-indent-command (&optional arg)
  "Indent the current line or insert tabs/spaces.
With optional prefix argument ARG or if the previous command was this
command, insert ARG tabs or spaces according to `indent-tabs-mode'.
Otherwise, indent the current line with `antlr-indent-line'."
  (interactive "P")
  (if (or arg (eq last-command 'antlr-indent-command))
      (insert-tab arg)
    (let ((antlr-indent-comment (and antlr-indent-comment t))) ; dynamic
      (antlr-indent-line))))


;;;===========================================================================
;;;  Mode entry
;;;===========================================================================

(defun antlr-c-common-init ()
  "Like `c-common-init' except menu, auto-hungry and c-style stuff."
  ;; X/Emacs 20 only
  (make-local-variable 'paragraph-start)
  (make-local-variable 'paragraph-separate)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (make-local-variable 'require-final-newline)
  (make-local-variable 'parse-sexp-ignore-comments)
  (make-local-variable 'indent-line-function)
  (make-local-variable 'indent-region-function)
  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'comment-column)
  (make-local-variable 'comment-start-skip)
  (make-local-variable 'comment-multi-line)
  (make-local-variable 'outline-regexp)
  (make-local-variable 'outline-level)
  (make-local-variable 'imenu-generic-expression) ;set in the mode functions
  (and (boundp 'comment-line-break-function)
       (make-local-variable 'comment-line-break-function))
  ;; Emacs 19.30 and beyond only, AFAIK
  (if (boundp 'fill-paragraph-function)
      (progn
	(make-local-variable 'fill-paragraph-function)
	(setq fill-paragraph-function 'c-fill-paragraph)))
  ;; now set their values
  (setq paragraph-start (concat page-delimiter "\\|$")
	paragraph-separate paragraph-start
	paragraph-ignore-fill-prefix t
	require-final-newline t
	parse-sexp-ignore-comments t
	indent-line-function 'c-indent-line
	indent-region-function 'c-indent-region
	outline-regexp "[^#\n\^M]"
	outline-level 'c-outline-level
	comment-column 32
	comment-start-skip "/\\*+ *\\|// *"
	comment-multi-line nil
1415
	comment-line-break-function 'c-comment-line-break-function)
1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446
  ;; we have to do something special for c-offsets-alist so that the
  ;; buffer local value has its own alist structure.
  (setq c-offsets-alist (copy-alist c-offsets-alist))
  ;; setup the comment indent variable in a Emacs version portable way
  ;; ignore any byte compiler warnings you might get here
  (make-local-variable 'comment-indent-function)
  (setq comment-indent-function 'c-comment-indent))

(defun antlr-language-for-option (option-value)
  "Find element in `antlr-language-alist' for OPTION-VALUE."
  ;; Like (find OPTION-VALUE antlr-language-alist :key 'cddr :test 'member)
  (let ((seq antlr-language-alist)
	r)
    (while seq
      (setq r (pop seq))
      (if (member option-value (cddr r))
	  (setq seq nil)		; stop
	(setq r nil)))			; no result yet
    r))

;;;###autoload
(defun antlr-mode ()
  "Major mode for editing ANTLR grammar files.
\\{antlr-mode-map}"
  (interactive)
  (c-initialize-cc-mode)		; for java syntax table
  (kill-all-local-variables)
  ;; ANTLR specific ----------------------------------------------------------
  (setq major-mode 'antlr-mode
	mode-name "Antlr")
  (setq local-abbrev-table antlr-mode-abbrev-table)
1447 1448 1449 1450
  (unless antlr-mode-syntax-table
    (setq antlr-mode-syntax-table (make-syntax-table))
    (c-populate-syntax-table antlr-mode-syntax-table))
  (set-syntax-table antlr-mode-syntax-table)
1451 1452 1453
  (unless antlr-action-syntax-table
    (let ((slist (nth 3 antlr-font-lock-defaults)))
      (setq antlr-action-syntax-table
1454
	    (copy-syntax-table antlr-mode-syntax-table))
1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471
      (while slist
	(modify-syntax-entry (caar slist) (cdar slist)
			     antlr-action-syntax-table)
	(setq slist (cdr slist)))))
  (use-local-map antlr-mode-map)
  (make-local-variable 'antlr-language)
  (unless antlr-language
    (save-excursion
      (goto-char (point-min))
      (setq antlr-language
	    (car (or (and (re-search-forward (cdr antlr-language-limit-n-regexp)
					(car antlr-language-limit-n-regexp)
					t)
			  (antlr-language-for-option (match-string 1)))
		     (antlr-language-for-option nil))))))
  (if (stringp (cadr (assq antlr-language antlr-language-alist)))
      (setq mode-name
1472
	    (concat "Antlr."
1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493
		    (cadr (assq antlr-language antlr-language-alist)))))
  ;; indentation, for the C engine -------------------------------------------
  (antlr-c-common-init)
  (setq indent-line-function 'antlr-indent-line
	indent-region-function nil)	; too lazy
  (setq comment-start "// "
 	comment-end "")
  (c-set-style "java")
  (if (eq antlr-language 'c++-mode)
      (setq c-conditional-key c-C++-conditional-key
	    c-comment-start-regexp c-C++-comment-start-regexp
	    c-class-key c-C++-class-key
	    c-extra-toplevel-key c-C++-extra-toplevel-key
	    c-access-key c-C++-access-key
	    c-recognize-knr-p nil)
    (setq c-conditional-key c-Java-conditional-key
	  c-comment-start-regexp c-Java-comment-start-regexp
	  c-class-key c-Java-class-key
	  c-method-key nil
	  c-baseclass-key nil
	  c-recognize-knr-p nil
1494
	  c-access-key (and (boundp 'c-Java-access-key) c-Java-access-key))
1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511
    (and (boundp 'c-inexpr-class-key) (boundp 'c-Java-inexpr-class-key)
	 (setq c-inexpr-class-key c-Java-inexpr-class-key)))
  ;; various -----------------------------------------------------------------
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults antlr-font-lock-defaults)
  (easy-menu-add antlr-mode-menu)
  (make-local-variable 'imenu-create-index-function)
  (setq imenu-create-index-function 'antlr-imenu-create-index-function)
  (make-local-variable 'imenu-generic-expression)
  (setq imenu-generic-expression t)	; fool stupid test
  (and antlr-imenu-name			; there should be a global variable...
       (fboundp 'imenu-add-to-menubar)
       (imenu-add-to-menubar
	(if (stringp antlr-imenu-name) antlr-imenu-name "Index")))
  (antlr-set-tabs)
  (run-hooks 'antlr-mode-hook))

1512 1513 1514
;; A smarter version of `group-buffers-menu-by-mode-then-alphabetically' (in
;; XEmacs) could use the following property.  The header of the submenu would
;; be "Antlr" instead of "Antlr.C++" or (not and!) "Antlr.Java".
1515 1516
(put 'antlr-mode 'mode-name "Antlr")

1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531
;;;###autoload
(defun antlr-set-tabs ()
  "Use ANTLR's convention for TABs according to `antlr-tab-offset-alist'.
Used in `antlr-mode'.  Also a useful function in `java-mode-hook'."
  (if buffer-file-name
      (let ((alist antlr-tab-offset-alist) elem)
	(while alist
	  (setq elem (pop alist))
	  (and (or (null (car elem)) (eq (car elem) major-mode))
	       (or (null (cadr elem))
		   (string-match (cadr elem) buffer-file-name))
	       (setq tab-width (caddr elem)
		     indent-tabs-mode (cadddr elem)
		     alist nil))))))

Gerd Moellmann's avatar
Gerd Moellmann committed
1532
; LocalWords:  antlr ANother ANTLR's Cpp Lexer TreeParser esp refs VALUEs ea ee
1533
; LocalWords:  Java's Nomencl ruledef tokendef ruleref tokenref setType ader ev
Gerd Moellmann's avatar
Gerd Moellmann committed
1534
; LocalWords:  ivate syntab lexer treeparser lic rotected rivate bor boi AFAIK
1535 1536 1537 1538
; LocalWords:  slist knr inexpr unhide jit GENS SEP GEN sTokenTypes hpp cpp DEP
; LocalWords:  VOCAB EVOCAB Antlr's TokenTypes exportVocab incl excl SUPERS gen
; LocalWords:  VOCABS IVOCAB exportVocabs importVocabs superclasses vocab kens
; LocalWords:  sclass evocab ivocab importVocab deps glibs supers sep dep lang
1539 1540

;;; antlr-mode.el ends here