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