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