X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/256dec12f4a5e40e5117e2c36642fbcfdb33bed6..7c511b96e0cc692a4b772fe34ed7470b4020c20e:/lisp/progmodes/antlr-mode.el diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index b7315bd41a..b7bf99efa2 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -1,11 +1,11 @@ ;;; antlr-mode.el --- major mode for ANTLR grammar files -;; Copyright (C) 1999-2001 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; ;; Author: Christoph.Wedler@sap.com -;; Keywords: languages -;; Version: 2.1 -;; X-URL: http://www.fmi.uni-passau.de/~wedler/antlr-mode/ +;; Keywords: languages, ANTLR, code generator +;; Version: (see `antlr-version' below) +;; X-URL: http://antlr-mode.sourceforge.net/ ;; This file is part of GNU Emacs. @@ -26,60 +26,22 @@ ;;; Commentary: -;; This Emacs extension (major mode) provides various features for editing -;; ANTLR grammar files. ANTLR is a tool for LL(k)-based language recognition -;; and an excellent alternative to lex & yacc, see . -;; Some features depend on the value of ANTLR's "language" option (check the -;; modeline for "Antlr.Java" or "Antlr.C++"). - -;; This package provides the following features: -;; * Syntax highlighting for grammar symbols and the code in actions. -;; * Indentation (pretty-print) for the current line (TAB) and lines in the -;; selected region (C-M-\). Inserting an ANTLR syntax symbol (one of -;; ":;|&(){}") might also indent the current line. -;; * Menu "Index" and Speedbar tags with all class, token and rule -;; definitions. Jump to corresponding position by selecting an entry. -;; * Commands to move to previous/next rule, beginning/end of rule body etc. -;; * Commands to hide/unhide actions. -;; * Support to insert/change file/grammar/rule/subrule options. -;; * Run ANTLR from within Emacs, create Makefile dependencies. - -;; SYNTAX HIGHLIGHTING comes in three phases. First, comments and strings are -;; highlighted. Second, the grammar code is highlighted according to -;; `antlr-font-lock-additional-keywords' (rule refs: dark blue, token refs: -;; dark orange, definition: bold blue). Third, actions, semantic predicates -;; and arguments are highlighted according to the usual font-lock keywords of -;; the major-mode corresponding to ANTLR's "language" option, see also -;; `antlr-font-lock-maximum-decoration'. We define special font-lock faces for -;; the grammar code to allow you to distinguish ANTLR keywords from Java/C++ -;; keywords. - -;; INDENTATION. This package supports ANTLR's (intended) indentation style -;; which is based on a simple paren/brace/bracket depth-level calculation, see -;; `antlr-indent-line'. The indentation engine of cc-mode is only used inside -;; block comments. By default, this package defines a tab width of 4 to be -;; consistent to both ANTLR's conventions (TABs usage) and the -;; `c-indentation-style' "java" which sets `c-basic-offset' to 4, see -;; `antlr-tab-offset-alist'. You might want to set this variable to nil. - -;; OPTION SUPPORT. This package provides special support to insert or change -;; file, grammar, rule and subrule options via the menu or via the keyboard -;; with completion. For most options, you can also insert the value with -;; completion (or select a value from a list by pressing `?'). You get a -;; warning if an option is not supported by the version of ANTLR you are using -;; (`antlr-tool-version' defaults to 2.7.1), or if the option shouldn't be -;; inserted for other reasons. This package knows the correct position where -;; to insert the option and inserts "options {...}" if it is not already -;; present. For details, see the docstring of command \\[antlr-insert-option]. - -;; MAKEFILE CREATION. Command \\[antlr-show-makefile-rules] shows/inserts the -;; dependencies for all grammar files in the current directory. It considers -;; ANTLR's "language" option, import/export vocabularies and grammar -;; inheritance, and provides a value for the -glib option if necessary (which -;; you have to edit if the super-grammar is not in the same directory). - -;; TODO/WISH-LIST. Things which might be supported in future versions: +;; The Emacs package ANTLR-Mode provides: syntax highlighting for ANTLR grammar +;; files, automatic indentation, menus containing rule/token definitions and +;; supported options and various other things like running ANTLR from within +;; Emacs. +;; For details, check or, if you prefer +;; the manual style, follow all commands mentioned in the documentation of +;; `antlr-mode'. ANTLR is a LL(k)-based recognition tool which generates +;; lexers, parsers and tree transformers in Java, C++ or Sather and can be +;; found at . + +;; Bug fixes, bug reports, improvements, and suggestions for the newest version +;; are strongly appreciated. + +;; To-do/Wish-list: +;; ;; * Next Version [C-c C-w]. Produce HTML document with syntax highlighted ;; and hyper-links (using htmlize). ;; * Next Version [C-c C-u]. Insert/update special comments: each rule lists @@ -89,10 +51,13 @@ ;; * Planned. Further support for imenu, i.e., include entries for method ;; definitions at beginning of grammar class. ;; * Planned [C-c C-p]. Pack/unpack rule/subrule & options (one/multi-line). - +;; ;; * Probably. Show rules/dependencies for ANT like for Makefile (does ANT ;; support vocabularies and grammar inheritance?), I have to look at ;; jde-ant.el: http://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html +;; * Probably. Make `indent-region' faster, especially in actions. ELP +;; profiling in a class init action shows half the time is spent in +;; `antlr-next-rule', the other half in `c-guess-basic-syntax'. ;; * Unlikely. Sather as generated language with syntax highlighting etc/. ;; Questions/problems: is sather-mode.el the standard mode for sather, is it ;; still supported, what is its relationship to eiffel3.el? Requirement: @@ -101,10 +66,6 @@ ;; and action code and run special highlighting functions on these regions. ;; Problems: code size, this mode would depend on font-lock internals. -;; Bug fixes, bug reports, improvements, and suggestions are strongly -;; appreciated. Please check the newest version first: -;; http://www.fmi.uni-passau.de/~wedler/antlr-mode/changes.html - ;;; Installation: ;; This file requires Emacs-20.3, XEmacs-20.4 or higher and package cc-mode. @@ -116,10 +77,6 @@ ;; (add-hook 'speedbar-load-hook ; would be too late in antlr-mode.el ;; (lambda () (speedbar-add-supported-extension ".g"))) -;; If you edit ANTLR's source files, you might also want to use -;; (autoload 'antlr-set-tabs "antlr-mode") -;; (add-hook 'java-mode-hook 'antlr-set-tabs) - ;; I strongly recommend to use font-lock with a support mode like fast-lock, ;; lazy-lock or better jit-lock (Emacs-21.1+) / lazy-shot (XEmacs). @@ -128,48 +85,114 @@ ;;; Code: (provide 'antlr-mode) +(require 'easymenu) + +;; General Emacs/XEmacs-compatibility compile-time macros +(eval-when-compile + (require 'cl) + (defmacro cond-emacs-xemacs (&rest args) + (cond-emacs-xemacs-macfn + args "`cond-emacs-xemacs' must return exactly one element")) + (defun cond-emacs-xemacs-macfn (args &optional msg) + (if (atom args) args + (and (eq (car args) :@) (null msg) ; (:@ ...spliced...) + (setq args (cdr args) + msg "(:@ ....) must return exactly one element")) + (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS)) + (mode :BOTH) code) + (while (consp args) + (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args))) + (if (atom args) + (or args (error "Used selector %s without elements" mode)) + (or (eq ignore mode) + (push (cond-emacs-xemacs-macfn (car args)) code)) + (pop args))) + (cond (msg (if (or args (cdr code)) (error msg) (car code))) + ((or (null args) (eq ignore mode)) (nreverse code)) + (t (nconc (nreverse code) args)))))) + ;; Emacs/XEmacs-compatibility `defun': remove interactive "_" for Emacs, use + ;; existing functions when they are `fboundp', provide shortcuts if they are + ;; known to be defined in a specific Emacs branch (for short .elc) + (defmacro defunx (name arglist &rest definition) + (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses) + (while (memq (car definition) + '(:try :emacs-and-try :xemacs-and-try)) + (if (eq (pop definition) (if xemacsp :xemacs-and-try :emacs-and-try)) + (setq reuses (car definition) + definition nil) + (push (pop definition) reuses))) + (if (and reuses (symbolp reuses)) + `(defalias ',name ',reuses) + (let* ((docstring (if (stringp (car definition)) (pop definition))) + (spec (and (not xemacsp) + (eq (car-safe (car definition)) 'interactive) + (null (cddar definition)) + (cadar definition)))) + (if (and (stringp spec) + (not (string-equal spec "")) + (eq (aref spec 0) ?_)) + (setq definition + (cons (if (string-equal spec "_") + '(interactive) + `(interactive ,(substring spec 1))) + (cdr definition)))) + (if (null reuses) + `(defun ,name ,arglist ,docstring + ,@(cond-emacs-xemacs-macfn definition)) + ;; no dynamic docstring in this case + `(eval-and-compile ; no warnings in Emacs + (defalias ',name + (cond ,@(mapcar (lambda (func) `((fboundp ',func) ',func)) + (nreverse reuses)) + (t ,(if definition + `(lambda ,arglist ,docstring + ,@(cond-emacs-xemacs-macfn definition)) + 'ignore)))))))))) + (defmacro ignore-errors-x (&rest body) + (let ((specials '((scan-sexps . 4) (scan-lists . 5))) + spec nils) + (if (and (string-match "XEmacs" emacs-version) + (null (cdr body)) (consp (car body)) + (setq spec (assq (caar body) specials)) + (>= (setq nils (- (cdr spec) (length (car body)))) 0)) + `(,@(car body) ,@(make-list nils nil) t) + `(ignore-errors ,@body))))) + +;; More compile-time-macros +(eval-when-compile + (defmacro save-buffer-state-x (&rest body) ; similar to EMACS/lazy-lock.el + (let ((modified (with-no-warnings (gensym "save-buffer-state-x-modified-")))) + `(let ((,modified (buffer-modified-p))) + (unwind-protect + (let ((buffer-undo-list t) (inhibit-read-only t) + ,@(unless (string-match "XEmacs" emacs-version) + '((inhibit-point-motion-hooks t) deactivate-mark)) + before-change-functions after-change-functions + buffer-file-name buffer-file-truename) + ,@body) + (and (not ,modified) (buffer-modified-p) + (set-buffer-modified-p nil))))))) +(put 'save-buffer-state-x 'lisp-indent-function 0) + +;; get rid of byte-compile warnings (eval-when-compile ; required and optional libraries (require 'cc-mode) - (defvar c-Java-access-key) ; former cc-mode variable - (condition-case nil (require 'font-lock) (error nil)) - (condition-case nil (require 'compile) (error nil)) + (ignore-errors (require 'font-lock)) + (ignore-errors (require 'compile)) + ;;(ignore-errors (defun c-init-language-vars))) dangerous on Emacs! + ;;(ignore-errors (defun c-init-c-language-vars))) dangerous on Emacs! + ;;(ignore-errors (defun c-basic-common-init)) dangerous on Emacs! (defvar outline-level) (defvar imenu-use-markers) (defvar imenu-create-index-function)) -(eval-when-compile ; Emacs: cl, easymenu, XEmacs vars - (require 'cl) - (require 'easymenu) - (defvar zmacs-region-stays)) -(eval-when-compile ; XEmacs: Emacs vars - (defvar inhibit-point-motion-hooks) (defvar deactivate-mark)) - -(eval-and-compile ; XEmacs functions, simplified - (if (featurep 'xemacs) - (defalias 'antlr-scan-sexps 'scan-sexps) - (defalias 'antlr-scan-sexps 'antlr-scan-sexps-internal)) - (if (featurep 'xemacs) - (defalias 'antlr-scan-lists 'scan-lists) - (defalias 'antlr-scan-lists 'antlr-scan-lists-internal)) - (if (fboundp 'default-directory) - (defalias 'antlr-default-directory 'default-directory) - (defun antlr-default-directory () default-directory)) - (if (fboundp 'read-shell-command) - (defalias 'antlr-read-shell-command 'read-shell-command) - (defun antlr-read-shell-command (prompt &optional initial-input history) - (read-from-minibuffer prompt initial-input nil nil - (or history 'shell-command-history)))) - (if (fboundp 'with-displaying-help-buffer) - (defalias 'antlr-with-displaying-help-buffer 'with-displaying-help-buffer) - (defun antlr-with-displaying-help-buffer (thunk &optional name) - (with-output-to-temp-buffer "*Help*" - (save-excursion (funcall thunk))))) - (if (and (fboundp 'buffer-syntactic-context) - (fboundp 'buffer-syntactic-context-depth)) - (progn - (defalias 'antlr-invalidate-context-cache 'antlr-xemacs-bug-workaround) - (defalias 'antlr-syntactic-context 'antlr-fast-syntactic-context)) - (defalias 'antlr-invalidate-context-cache 'ignore) - (defalias 'antlr-syntactic-context 'antlr-slow-syntactic-context))) +;; We cannot use `c-forward-syntactic-ws' directly since it is a macro since +;; cc-mode-5.30 => antlr-mode compiled with older cc-mode would fail (macro +;; call) when used with newer cc-mode. Also, antlr-mode compiled with newer +;; cc-mode would fail (undefined `c-forward-sws') when used with older cc-mode. +;; Additional to the `defalias' below, we must set `antlr-c-forward-sws' to +;; `c-forward-syntactic-ws' when `c-forward-sws' is not defined after requiring +;; cc-mode. +(defalias 'antlr-c-forward-sws 'c-forward-sws) ;;;;########################################################################## @@ -181,11 +204,12 @@ "Major mode for ANTLR grammar files." :group 'languages :link '(emacs-commentary-link "antlr-mode.el") - :link '(url-link "http://www.fmi.uni-passau.de/~wedler/antlr-mode/") + :link '(url-link "http://antlr-mode.sourceforge.net/") :prefix "antlr-") -(defconst antlr-version "2.1" - "ANTLR major mode version number.") +(defconst antlr-version "2.2c" + "ANTLR major mode version number. +Check for the newest.") ;;;=========================================================================== @@ -272,12 +296,13 @@ ANTLR's and Java's indentation styles. Used by `antlr-set-tabs'." (defcustom antlr-indent-style "java" "*If non-nil, cc-mode indentation style used for `antlr-mode'. -See `c-set-style' for details." +See `c-set-style' and for details, where the most interesting part in +`c-style-alist' is the value of `c-basic-offset'." :group 'antlr :type '(choice (const nil) regexp)) (defcustom antlr-indent-item-regexp - "[]}):;|&]\\|default[ \t]*:\\|case[ \t]+\\('\\\\?.'\\|[0-9]+\\|[A-Za-z_][A-Za-z_0-9]*\\)[ \t]*:" ; & is local ANTLR extension (SGML's and-connector) + "[]}):;|&]" ; & is local ANTLR extension (SGML's and-connector) "Regexp matching lines which should be indented by one TAB less. See `antlr-indent-line' and command \\[antlr-indent-command]." :group 'antlr @@ -285,17 +310,28 @@ See `antlr-indent-line' and command \\[antlr-indent-command]." (defcustom antlr-indent-at-bol-alist ;; eval-when-compile not usable with defcustom... - '((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\\)\\>")) + '((java-mode . "\\(package\\|import\\)\\>") + (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\\)\\>")) "Alist of regexps matching lines are indented at column 0. Each element in this list looks like (MODE . REGEXP) where MODE is a function and REGEXP is a regular expression. -If `antlr-language' equals to a MODE and the line starting at the first -non-whitespace is matched by the corresponding REGEXP, indent the line -at column 0 instead according to the normal rules of `antlr-indent-line'." +If `antlr-language' equals to a MODE, the line starting at the first +non-whitespace is matched by the corresponding REGEXP, and the line is +part of an header action, indent the line at column 0 instead according +to the normal rules of `antlr-indent-line'." :group 'antlr :type '(repeat (cons (function :tag "Major mode") regexp))) +;; adopt indentation to cc-engine +(defvar antlr-disabling-cc-syntactic-symbols + '(statement-block-intro + defun-block-intro topmost-intro statement-case-intro member-init-intro + arglist-intro brace-list-intro knr-argdecl-intro inher-intro + objc-method-intro + block-close defun-close class-close brace-list-close arglist-close + inline-close extern-lang-close namespace-close)) + ;;;=========================================================================== ;;; Options: customization @@ -647,7 +683,7 @@ DIRECTORY is the name of the current directory.") ;;; Menu ;;;=========================================================================== -(defcustom antlr-imenu-name t +(defcustom antlr-imenu-name t ; (featurep 'xemacs) ; TODO: Emacs-21 bug? "*Non-nil, if a \"Index\" menu should be added to the menubar. If it is a string, it is used instead \"Index\". Requires package imenu." @@ -687,9 +723,10 @@ imenu." (easy-menu-define antlr-mode-menu antlr-mode-map "Major mode menu." `("Antlr" - ,@(if (and antlr-options-use-submenus - (boundp 'emacs-major-version) - (or (featurep 'xemacs) (>= emacs-major-version 21))) + ,@(if (cond-emacs-xemacs + :EMACS (and antlr-options-use-submenus + (>= emacs-major-version 21)) + :XEMACS antlr-options-use-submenus) `(("Insert File Option" :filter ,(lambda (x) (antlr-options-menu-filter 1 x))) ("Insert Grammar Option" @@ -797,25 +834,33 @@ Do not change." (defvar antlr-font-lock-keyword-face 'antlr-font-lock-keyword-face) (defface antlr-font-lock-keyword-face - '((((class color) (background light)) (:foreground "black" :weight bold))) + (cond-emacs-xemacs + '((((class color) (background light)) + (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) "ANTLR keywords." :group 'antlr) (defvar antlr-font-lock-syntax-face 'antlr-font-lock-keyword-face) (defface antlr-font-lock-syntax-face - '((((class color) (background light)) (:foreground "black" :weight bold))) + (cond-emacs-xemacs + '((((class color) (background light)) + (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) "ANTLR syntax symbols like :, |, (, ), ...." :group 'antlr) (defvar antlr-font-lock-ruledef-face 'antlr-font-lock-ruledef-face) (defface antlr-font-lock-ruledef-face - '((((class color) (background light)) (:foreground "blue" :weight bold))) + (cond-emacs-xemacs + '((((class color) (background light)) + (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) "ANTLR rule references (definition)." :group 'antlr) (defvar antlr-font-lock-tokendef-face 'antlr-font-lock-tokendef-face) (defface antlr-font-lock-tokendef-face - '((((class color) (background light)) (:foreground "blue" :weight bold))) + (cond-emacs-xemacs + '((((class color) (background light)) + (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) "ANTLR token references (definition)." :group 'antlr) @@ -833,7 +878,9 @@ Do not change." (defvar antlr-font-lock-literal-face 'antlr-font-lock-literal-face) (defface antlr-font-lock-literal-face - '((((class color) (background light)) (:foreground "brown4" :weight bold))) + (cond-emacs-xemacs + '((((class color) (background light)) + (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t)))) "ANTLR special literal tokens. It is used to highlight strings matched by the first regexp group of `antlr-font-lock-literal-regexp'." @@ -853,47 +900,48 @@ group. The string matched by the first group is highlighted with "Regexp matching class headers.") (defvar antlr-font-lock-additional-keywords - `((antlr-invalidate-context-cache) - ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))" - (1 antlr-font-lock-tokendef-face)) - ("\\$\\sw+" (0 font-lock-keyword-face)) - ;; the tokens are already fontified as string/docstrings: - (,(lambda (limit) - (if antlr-font-lock-literal-regexp - (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) - (1 antlr-font-lock-literal-face t) - ,@(and (featurep 'xemacs) '((0 nil)))) ; XEmacs bug workaround - (,(lambda (limit) - (antlr-re-search-forward antlr-class-header-regexp limit)) - (1 antlr-font-lock-keyword-face) - (2 antlr-font-lock-ruledef-face) - (3 antlr-font-lock-keyword-face) - (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) - 'antlr-font-lock-keyword-face - 'font-lock-type-face))) - (,(lambda (limit) - (antlr-re-search-forward - "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" - limit)) + (cond-emacs-xemacs + `((antlr-invalidate-context-cache) + ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))" + (1 antlr-font-lock-tokendef-face)) + ("\\$\\sw+" (0 font-lock-keyword-face)) + ;; the tokens are already fontified as string/docstrings: + (,(lambda (limit) + (if antlr-font-lock-literal-regexp + (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) + (1 antlr-font-lock-literal-face t) + :XEMACS (0 nil)) ; XEmacs bug workaround + (,(lambda (limit) + (antlr-re-search-forward antlr-class-header-regexp limit)) + (1 antlr-font-lock-keyword-face) + (2 antlr-font-lock-ruledef-face) + (3 antlr-font-lock-keyword-face) + (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) + 'antlr-font-lock-keyword-face + 'font-lock-type-face))) + (,(lambda (limit) + (antlr-re-search-forward + "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" + limit)) (1 antlr-font-lock-keyword-face)) - (,(lambda (limit) - (antlr-re-search-forward - "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" - limit)) + (,(lambda (limit) + (antlr-re-search-forward + "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" + limit)) (1 font-lock-type-face) ; not XEmacs' java level-3 fruit salad (3 (if (antlr-upcase-p (char-after (match-beginning 3))) 'antlr-font-lock-tokendef-face 'antlr-font-lock-ruledef-face) nil t) (4 antlr-font-lock-syntax-face nil t)) - (,(lambda (limit) - (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) + (,(lambda (limit) + (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) (1 (if (antlr-upcase-p (char-after (match-beginning 0))) 'antlr-font-lock-tokendef-face 'antlr-font-lock-ruledef-face) nil t) (2 antlr-font-lock-syntax-face nil t)) - (,(lambda (limit) - ;; v:ruleref and v:"literal" is allowed... - (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) + (,(lambda (limit) + ;; v:ruleref and v:"literal" is allowed... + (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) (1 (if (match-beginning 2) (if (eq (char-after (match-beginning 2)) ?=) 'antlr-font-lock-default-face @@ -902,9 +950,9 @@ group. The string matched by the first group is highlighted with 'antlr-font-lock-tokenref-face 'antlr-font-lock-ruleref-face))) (2 antlr-font-lock-default-face nil t)) - (,(lambda (limit) - (antlr-re-search-forward "[|&:;(]\\|)\\([*+?]\\|=>\\)?" limit)) - (0 'antlr-font-lock-syntax-face))) + (,(lambda (limit) + (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit)) + (0 'antlr-font-lock-syntax-face)))) "Font-lock keywords for ANTLR's normal grammar code. See `antlr-font-lock-keywords-alist' for the keywords of actions.") @@ -939,6 +987,16 @@ not to confuse their context_cache.") "Abbreviation table used in `antlr-mode' buffers.") (define-abbrev-table 'antlr-mode-abbrev-table ()) +(defvar antlr-slow-cache-enabling-symbol 'loudly +;; Emacs' font-lock changes buffer's tick counter, therefore this value should +;; be a parameter of a font-lock function, but not any other variable of +;; functions which call `antlr-slow-syntactic-context'. + "If value is a bound symbol, cache will be used even with text changes. +This is no user option. Used for `antlr-slow-syntactic-context'.") + +(defvar antlr-slow-cache-diff-threshold 5000 + "Maximum distance between `point' and cache position for cache use. +Used for `antlr-slow-syntactic-context'.") ;;;;########################################################################## @@ -948,7 +1006,7 @@ not to confuse their context_cache.") ;;;=========================================================================== -;;; Syntax functions -- Emacs vs XEmacs dependent +;;; Syntax functions -- Emacs vs XEmacs dependent, part 1 ;;;=========================================================================== ;; From help.el (XEmacs-21.1), without `copy-syntax-table' @@ -961,62 +1019,140 @@ not to confuse their context_cache.") (put 'antlr-with-syntax-table 'lisp-indent-function 1) (put 'antlr-with-syntax-table 'edebug-form-spec '(form body)) -(defun antlr-scan-sexps-internal (from count &optional dummy no-error) -;; checkdoc-params: (from count dummy) - "Like `scan-sexps' but with additional arguments. -When optional arg NO-ERROR is non-nil, `antlr-scan-sexps-internal' will -return nil instead of signaling an error." - (if no-error - (condition-case nil - (scan-sexps from count) - (error nil)) - (scan-sexps from count))) - -(defun antlr-scan-lists-internal (from count depth &optional dummy no-error) -;; checkdoc-params: (from count depth dummy) - "Like `scan-lists' but with additional arguments. -When optional arg NO-ERROR is non-nil, `antlr-scan-lists-internal' will -return nil instead of signaling an error." - (if no-error - (condition-case nil - (scan-lists from count depth) - (error nil)) - (scan-lists from count depth))) - -(defun antlr-xemacs-bug-workaround (&rest dummies) +(defunx antlr-default-directory () + :xemacs-and-try default-directory + "Return `default-directory'." + default-directory) + +;; Check Emacs-21.1 simple.el, `shell-command'. +(defunx antlr-read-shell-command (prompt &optional initial-input history) + :xemacs-and-try read-shell-command + "Read a string from the minibuffer, using `shell-command-history'." + (read-from-minibuffer prompt initial-input nil nil + (or history 'shell-command-history))) + +(defunx antlr-with-displaying-help-buffer (thunk &optional name) + :xemacs-and-try with-displaying-help-buffer + "Make a help buffer and call `thunk' there." + (with-output-to-temp-buffer "*Help*" + (save-excursion (funcall thunk)))) + + +;;;=========================================================================== +;;; Context cache +;;;=========================================================================== + +(defvar antlr-slow-context-cache nil "Internal.") + +;;;(defvar antlr-statistics-full-neg 0) +;;;(defvar antlr-statistics-full-diff 0) +;;;(defvar antlr-statistics-full-other 0) +;;;(defvar antlr-statistics-cache 0) +;;;(defvar antlr-statistics-inval 0) + +(defunx antlr-invalidate-context-cache (&rest dummies) ;; checkdoc-params: (dummies) - "Invalidate context_cache for syntactical context information." - ;; XEmacs bug workaround + "Invalidate context cache for syntactical context information." + :XEMACS ; XEmacs bug workaround (save-excursion (set-buffer (get-buffer-create " ANTLR XEmacs bug workaround")) - (buffer-syntactic-context-depth)) - nil) - -(defun antlr-fast-syntactic-context () - "Return some syntactic context information. -Return `string' if point is within a string, `block-comment' or -`comment' is point is within a comment or the depth within all -parenthesis-syntax delimiters at point otherwise. -WARNING: this may alter `match-data'." - (or (buffer-syntactic-context) (buffer-syntactic-context-depth))) + (buffer-syntactic-context-depth) + nil) + :EMACS +;;; (incf antlr-statistics-inval) + (setq antlr-slow-context-cache nil)) -(defun antlr-slow-syntactic-context () +(defunx antlr-syntactic-context () "Return some syntactic context information. Return `string' if point is within a string, `block-comment' or `comment' is point is within a comment or the depth within all parenthesis-syntax delimiters at point otherwise. WARNING: this may alter `match-data'." - (let ((orig (point))) - (beginning-of-defun) - (let ((state (parse-partial-sexp (point) orig))) - (goto-char orig) - (cond ((nth 3 state) 'string) - ((nth 4 state) 'comment) ; block-comment? -- we don't care - (t (car state)))))) + :XEMACS + (or (buffer-syntactic-context) (buffer-syntactic-context-depth)) + :EMACS + (let ((orig (point)) diff state + ;; Arg, Emacs' (buffer-modified-tick) changes with font-lock. Use + ;; hack that `loudly' is bound during font-locking => cache use will + ;; increase from 7% to 99.99% during font-locking. + (tick (or (boundp antlr-slow-cache-enabling-symbol) + (buffer-modified-tick)))) + (if (and (cdr antlr-slow-context-cache) + (>= (setq diff (- orig (cadr antlr-slow-context-cache))) 0) + (< diff antlr-slow-cache-diff-threshold) + (eq (current-buffer) (caar antlr-slow-context-cache)) + (eq tick (cdar antlr-slow-context-cache))) + ;; (setq antlr-statistics-cache (1+ antlr-statistics-cache) ...) + (setq state (parse-partial-sexp (cadr antlr-slow-context-cache) orig + nil nil + (cddr antlr-slow-context-cache))) + (if (>= orig antlr-slow-cache-diff-threshold) + (beginning-of-defun) + (goto-char (point-min))) +;;; (cond ((and diff (< diff 0)) (incf antlr-statistics-full-neg)) +;;; ((and diff (>= diff 3000)) (incf antlr-statistics-full-diff)) +;;; (t (incf antlr-statistics-full-other))) + (setq state (parse-partial-sexp (point) orig))) + (goto-char orig) + (if antlr-slow-context-cache + (setcdr antlr-slow-context-cache (cons orig state)) + (setq antlr-slow-context-cache + (cons (cons (current-buffer) tick) + (cons orig state)))) + (cond ((nth 3 state) 'string) + ((nth 4 state) 'comment) ; block-comment? -- we don't care + (t (car state))))) + +;;; (incf (aref antlr-statistics 2)) +;;; (unless (and (eq (current-buffer) +;;; (caar antlr-slow-context-cache)) +;;; (eq (buffer-modified-tick) +;;; (cdar antlr-slow-context-cache))) +;;; (incf (aref antlr-statistics 1)) +;;; (setq antlr-slow-context-cache nil)) +;;; (let* ((orig (point)) +;;; (base (cadr antlr-slow-context-cache)) +;;; (curr (cddr antlr-slow-context-cache)) +;;; (state (cond ((eq orig (car curr)) (cdr curr)) +;;; ((eq orig (car base)) (cdr base)))) +;;; diff diff2) +;;; (unless state +;;; (incf (aref antlr-statistics 3)) +;;; (when curr +;;; (if (< (setq diff (abs (- orig (car curr)))) +;;; (setq diff2 (abs (- orig (car base))))) +;;; (setq state curr) +;;; (setq state base +;;; diff diff2)) +;;; (if (or (>= (1+ diff) (point)) (>= diff 3000)) +;;; (setq state nil))) ; start from bod/bob +;;; (if state +;;; (setq state +;;; (parse-partial-sexp (car state) orig nil nil (cdr state))) +;;; (if (>= orig 3000) (beginning-of-defun) (goto-char (point-min))) +;;; (incf (aref antlr-statistics 4)) +;;; (setq cw (list orig (point) base curr)) +;;; (setq state (parse-partial-sexp (point) orig))) +;;; (goto-char orig) +;;; (if antlr-slow-context-cache +;;; (setcdr (cdr antlr-slow-context-cache) (cons orig state)) +;;; (setq antlr-slow-context-cache +;;; (cons (cons (current-buffer) (buffer-modified-tick)) +;;; (cons (cons orig state) (cons orig state)))))) +;;; (cond ((nth 3 state) 'string) +;;; ((nth 4 state) 'comment) ; block-comment? -- we don't care +;;; (t (car state))))) + +;;; (beginning-of-defun) +;;; (let ((state (parse-partial-sexp (point) orig))) +;;; (goto-char orig) +;;; (cond ((nth 3 state) 'string) +;;; ((nth 4 state) 'comment) ; block-comment? -- we don't care +;;; (t (car state)))))) ;;;=========================================================================== -;;; Misc functions +;;; Miscellaneous functions ;;;=========================================================================== (defun antlr-upcase-p (char) @@ -1066,9 +1202,9 @@ strings and actions/semantic predicates." (defsubst antlr-skip-sexps (count) "Skip the next COUNT balanced expressions and the comments after it. Return position before the comments after the last expression." - (goto-char (or (antlr-scan-sexps (point) count nil t) (point-max))) + (goto-char (or (ignore-errors-x (scan-sexps (point) count)) (point-max))) (prog1 (point) - (c-forward-syntactic-ws))) + (antlr-c-forward-sws))) ;;;=========================================================================== @@ -1104,19 +1240,15 @@ See `antlr-font-lock-additional-keywords', `antlr-language' and IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names." (let ((items nil) (classes nil) - (semi (point-max))) - ;; Using `imenu-progress-message' would require imenu for compilation -- - ;; nobody is missing these messages... + (continue t)) + ;; Using `imenu-progress-message' would require imenu for compilation, but + ;; nobody is missing these messages. The generic imenu function searches + ;; backward, which is slower and more likely not to work during editing. (antlr-with-syntax-table antlr-action-syntax-table - ;; We stick to the imenu standard and search backwards, although I don't - ;; think this is right. It is slower and more likely not to work during - ;; editing (you are more likely to add functions to the end of the file). - (while semi - (goto-char semi) - (setq semi (antlr-search-backward ";")) - (if semi - (progn (forward-char) (antlr-skip-exception-part t)) - (antlr-skip-file-prelude t)) + (antlr-invalidate-context-cache) + (goto-char (point-min)) + (antlr-skip-file-prelude t) + (while continue (if (looking-at "{") (antlr-skip-sexps 1)) (if (looking-at antlr-class-header-regexp) (or tokenrefs-only @@ -1135,8 +1267,12 @@ IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names." (if imenu-use-markers (copy-marker (match-beginning 0)) (match-beginning 0))) - items)))))) - (if classes (cons (cons "Classes" classes) items) items))) + items)))) + (if (setq continue (antlr-search-forward ";")) + (antlr-skip-exception-part t)))) + (if classes + (cons (cons "Classes" (nreverse classes)) (nreverse items)) + (nreverse items)))) ;;;=========================================================================== @@ -1150,7 +1286,7 @@ header. If SKIP-COMMENT is non-nil, also skip the comment after that part." (let ((pos (point)) (class nil)) - (c-forward-syntactic-ws) + (antlr-c-forward-sws) (while (looking-at "options\\>\\|tokens\\>") (setq class t) (setq pos (antlr-skip-sexps 2))) @@ -1176,7 +1312,7 @@ Hack: if SKIP-COMMENT is `header-only' only skip header and return position before the comment after the header." (let* ((pos (point)) (pos0 pos)) - (c-forward-syntactic-ws) + (antlr-c-forward-sws) (if skip-comment (setq pos0 (point))) (while (looking-at "header\\>[ \t]*\\(\"\\)?") (setq pos (antlr-skip-sexps (if (match-beginning 1) 3 2)))) @@ -1238,7 +1374,7 @@ Move to the beginning of the current rule if point is inside a rule." (let ((pos (point))) (antlr-next-rule -1 nil) (let ((between (or (bobp) (< (point) pos)))) - (c-forward-syntactic-ws) + (antlr-c-forward-sws) (and between (> (point) pos) (goto-char pos))))) @@ -1255,35 +1391,33 @@ rule." (antlr-with-syntax-table antlr-action-syntax-table (not (antlr-outside-rule-p))))) -(defun antlr-end-of-rule (&optional arg) +(defunx antlr-end-of-rule (&optional arg) "Move forward to next end of rule. Do it ARG [default: 1] many times. A grammar class header and the file prelude are also considered as a rule. Negative argument ARG means move back to ARGth preceding end of rule. If ARG is zero, run `antlr-end-of-body'." - (interactive "p") + (interactive "_p") (if (zerop arg) (antlr-end-of-body) (antlr-with-syntax-table antlr-action-syntax-table - (antlr-next-rule arg nil)) - (setq zmacs-region-stays t))) + (antlr-next-rule arg nil)))) -(defun antlr-beginning-of-rule (&optional arg) +(defunx antlr-beginning-of-rule (&optional arg) "Move backward to preceding beginning of rule. Do it ARG many times. A grammar class header and the file prelude are also considered as a rule. Negative argument ARG means move forward to ARGth next beginning of rule. If ARG is zero, run `antlr-beginning-of-body'." - (interactive "p") + (interactive "_p") (if (zerop arg) (antlr-beginning-of-body) (antlr-with-syntax-table antlr-action-syntax-table - (antlr-next-rule (- arg) t)) - (setq zmacs-region-stays t))) + (antlr-next-rule (- arg) t)))) -(defun antlr-end-of-body (&optional msg) +(defunx antlr-end-of-body (&optional msg) "Move to position after the `;' of the current rule. A grammar class header is also considered as a rule. With optional prefix arg MSG, move to `:'." - (interactive) + (interactive "_") (antlr-with-syntax-table antlr-action-syntax-table (let ((orig (point))) (if (antlr-outside-rule-p) @@ -1300,12 +1434,11 @@ prefix arg MSG, move to `:'." (or (antlr-search-forward ":") (point-max)))) (goto-char orig) (error msg)) - (c-forward-syntactic-ws))))) - (setq zmacs-region-stays t)) + (antlr-c-forward-sws)))))) -(defun antlr-beginning-of-body () +(defunx antlr-beginning-of-body () "Move to the first element after the `:' of the current rule." - (interactive) + (interactive "_") (antlr-end-of-body "Class headers and the file prelude are without `:'")) @@ -1342,12 +1475,7 @@ actions if ARG is 0 or negative. See `antlr-action-visibility'. Display a message unless optional argument SILENT is non-nil." (interactive "p") - ;; from Emacs/lazy-lock: `save-buffer-state' - (let ((modified (buffer-modified-p)) - (buffer-undo-list t) (inhibit-read-only t) - (inhibit-point-motion-hooks t) deactivate-mark ; Emacs only - before-change-functions after-change-functions - buffer-file-name buffer-file-truename) + (save-buffer-state-x (if (> arg 0) (let ((regexp (if (= arg 1) "[]}]" "}")) (diff (and antlr-action-visibility @@ -1358,7 +1486,7 @@ Display a message unless optional argument SILENT is non-nil." (antlr-with-syntax-table antlr-action-syntax-table (antlr-invalidate-context-cache) (while (antlr-re-search-forward regexp nil) - (let ((beg (antlr-scan-sexps (point) -1 nil t))) + (let ((beg (ignore-errors-x (scan-sexps (point) -1)))) (when beg (if diff ; braces are visible (if (> (point) (+ beg diff)) @@ -1379,9 +1507,7 @@ Display a message unless optional argument SILENT is non-nil." (remove-text-properties (point-min) (point-max) '(invisible nil intangible nil)) (or silent - (message "Unhide all actions (including arguments)...done"))) - (and (not modified) (buffer-modified-p) - (set-buffer-modified-p nil)))) + (message "Unhide all actions (including arguments)...done"))))) ;;;=========================================================================== @@ -1416,7 +1542,7 @@ Inserting an option with this command works as follows: according to a newly inserted language option. The name of all options with a specification for their values are stored -in `antlr-options-alist'. The used specification also depends on the +in `antlr-options-alists'. The used specification also depends on the value of `antlr-tool-version', i.e., step 4 will warn you if you use an option that has been introduced in newer version of ANTLR, and step 5 will offer completion using version-correct values. @@ -1486,7 +1612,7 @@ This command might also set the mark like \\[set-mark-command] does, see (defun antlr-insert-option-interactive (arg) "Interactive specification for `antlr-insert-option'. -Use prefix argument ARG to return \(LEVEL OPTION LOCATION)." +Return \(LEVEL OPTION LOCATION)." (barf-if-buffer-read-only) (if arg (setq arg (prefix-numeric-value arg))) (unless (memq arg '(nil 1 2 3 4)) @@ -1541,7 +1667,7 @@ like \(AREA \. PLACE), see `antlr-option-location'." (setq pos (antlr-skip-file-prelude 'header-only))) ((not (eq level 3)) ; grammar or subrule options (setq pos (point)) - (c-forward-syntactic-ws)) + (antlr-c-forward-sws)) ((looking-at "^\\(private[ \t\n]\\|public[ \t\n]\\|protected[ \t\n]\\)?[ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t\n]*\\(!\\)?[ \t\n]*\\(\\[\\)?") ;; rule options, with complete rule header (goto-char (or (match-end 4) (match-end 3))) @@ -1553,7 +1679,7 @@ like \(AREA \. PLACE), see `antlr-option-location'." (cond ((null pos) 'error) ((looking-at "options[ \t\n]*{") (goto-char (match-end 0)) - (setq pos (antlr-scan-lists (point) 1 1 nil t)) + (setq pos (ignore-errors-x (scan-lists (point) 1 1))) (antlr-option-location orig min0 max0 (point) (if pos (1- pos) (point-max)) @@ -1636,8 +1762,12 @@ a visible start position and (MAX-AREA . end) for a visible end position where the beginning is preferred if WITHP is nil and the end if WITHP is non-nil." (cons (and withp (cons min-area max-area)) - (cond ((and (<= min-area orig) (<= orig max-area)) - ;; point in options area + (cond ((and (<= min-area orig) (<= orig max-area) + (save-excursion + (goto-char orig) + (not (memq (antlr-syntactic-context) + '(comment block-comment))))) + ;; point in options area and not in comment (list orig)) ((and (null withp) (<= min-vis min-area) (<= min-area max-vis)) ;; use start of options area (only if not `withp') @@ -1843,7 +1973,7 @@ Used by `antlr-insert-option-do'." (when (and antlr-options-auto-colon (memq level '(3 4)) (save-excursion - (c-forward-syntactic-ws) + (antlr-c-forward-sws) (if (eq (char-after (point)) ?\{) (antlr-skip-sexps 1)) (not (eq (char-after (point)) ?\:)))) (insert "\n:") @@ -1873,7 +2003,8 @@ table is the resulting alist of TABLE-X concatenated with TABLE where TABLE can also be a function evaluation to an alist. Used inside `antlr-options-alists'." - (let* ((table0 (and (or table table-x) + (let* ((completion-ignore-case t) ; dynamic + (table0 (and (or table table-x) (append table-x (if (functionp table) (funcall table) table)))) (input (if table0 @@ -1924,6 +2055,7 @@ Ask user \(\"y or n\"), if a C++ only option is going to be inserted but Called in PHASE `before-input', see `antlr-options-alists'." (and (eq phase 'before-input) + (not (eq antlr-language 'c++-mode)) (not (y-or-n-p (format "Insert C++ %s option? " option))) (error "Didn't insert C++ %s option with language %s" option (cadr (assq antlr-language antlr-language-alist))))) @@ -1949,7 +2081,7 @@ Each SUPER is a super-grammar class where USE-EVOCAB-P indicates whether its export vocabulary is used as an import vocabulary." (unless buffer-file-name (error "Grammar buffer does not visit a file")) - (let (classes exportVocabs importVocabs superclasses default-vocab) + (let (classes export-vocabs import-vocabs superclasses default-vocab) (antlr-with-syntax-table antlr-action-syntax-table (goto-char (point-min)) (while (antlr-re-search-forward antlr-class-header-regexp nil) @@ -1961,12 +2093,12 @@ its export vocabulary is used as an import vocabulary." (evocab (or default-vocab class)) (ivocab nil)) (goto-char (match-end 0)) - (c-forward-syntactic-ws) + (antlr-c-forward-sws) (while (looking-at "options\\>\\|\\(tokens\\)\\>") (if (match-beginning 1) (antlr-skip-sexps 2) (goto-char (match-end 0)) - (c-forward-syntactic-ws) + (antlr-c-forward-sws) ;; parse grammar option sections ------------------------------- (when (eq (char-after (point)) ?\{) (let* ((beg (1+ (point))) @@ -1988,13 +2120,13 @@ its export vocabulary is used as an import vocabulary." (push (cons class evocab) classes) ;; default export vocab is export vocab of first grammar in file: (or default-vocab (setq default-vocab evocab)) - (or (member evocab exportVocabs) (push evocab exportVocabs)) + (or (member evocab export-vocabs) (push evocab export-vocabs)) (or (null ivocab) - (member ivocab importVocabs) (push ivocab importVocabs))))) + (member ivocab import-vocabs) (push ivocab import-vocabs))))) (if classes (list* (file-name-nondirectory buffer-file-name) (cons (nreverse classes) (nreverse superclasses)) - (cons (nreverse exportVocabs) (nreverse importVocabs)) + (cons (nreverse export-vocabs) (nreverse import-vocabs)) antlr-language)))) (defun antlr-directory-dependencies (dirname) @@ -2088,29 +2220,33 @@ necessary. Save all buffers first unless optional value SAVED is non-nil. When called interactively, the buffers are always saved, see also variable `antlr-ask-about-save'." - (interactive - ;; code in `interactive' is not compiled: do not use cl macros (`cdadr') - (let* ((supers (cdr (cadr (save-excursion - (save-restriction - (widen) - (antlr-file-dependencies)))))) - (glibs "")) - (when supers - (save-some-buffers (not antlr-ask-about-save) nil) - (setq glibs (car (antlr-superclasses-glibs - supers - (car (antlr-directory-dependencies - (antlr-default-directory))))))) - (list (antlr-read-shell-command "Run Antlr on current file with: " - (concat antlr-tool-command glibs " ")) - buffer-file-name - supers))) + (interactive (antlr-run-tool-interactive)) (or saved (save-some-buffers (not antlr-ask-about-save))) (let ((default-directory (file-name-directory file))) (require 'compile) ; only `compile' autoload (compile-internal (concat command " " (file-name-nondirectory file)) "No more errors" "Antlr-Run"))) +(defun antlr-run-tool-interactive () + ;; code in `interactive' is not compiled + "Interactive specification for `antlr-run-tool'. +Use prefix argument ARG to return \(COMMAND FILE SAVED)." + (let* ((supers (cdadr (save-excursion + (save-restriction + (widen) + (antlr-file-dependencies))))) + (glibs "")) + (when supers + (save-some-buffers (not antlr-ask-about-save) nil) + (setq glibs (car (antlr-superclasses-glibs + supers + (car (antlr-directory-dependencies + (antlr-default-directory))))))) + (list (antlr-read-shell-command "Run Antlr on current file with: " + (concat antlr-tool-command glibs " ")) + buffer-file-name + supers))) + ;;;=========================================================================== ;;; Makefile creation @@ -2219,7 +2355,7 @@ commentary with value `antlr-help-unknown-file-text' is added. The (defun antlr-indent-line () "Indent the current line as ANTLR grammar code. -The indentation of non-comment lines are calculated by `c-basic-offset', +The indentation of grammar lines are calculated by `c-basic-offset', multiplied by: - the level of the paren/brace/bracket depth, - plus 0/2/1, depending on the position inside the rule: header, body, @@ -2230,16 +2366,19 @@ multiplied by: Lines inside block comments are indented by `c-indent-line' according to `antlr-indent-comment'. -If `antlr-language' equals to a key in `antlr-indent-at-bol-alist' and -the line starting at the first non-whitespace is matched by the -corresponding value, indent the line at column 0. +Lines in actions except top-level actions in a header part or an option +area are indented by `c-indent-line'. + +Lines in header actions are indented at column 0 if `antlr-language' +equals to a key in `antlr-indent-at-bol-alist' and the line starting at +the first non-whitespace is matched by the corresponding value. For the initialization of `c-basic-offset', see `antlr-indent-style' and, to a lesser extent, `antlr-tab-offset-alist'." (save-restriction (let ((orig (point)) (min0 (point-min)) - bol boi indent syntax) + bol boi indent syntax cc-syntax) (widen) (beginning-of-line) (setq bol (point)) @@ -2253,11 +2392,6 @@ to a lesser extent, `antlr-tab-offset-alist'." (setq syntax (antlr-syntactic-context)) (cond ((symbolp syntax) (setq indent nil)) ; block-comments, strings, (comments) - ((and (assq antlr-language antlr-indent-at-bol-alist) - (looking-at (cdr (assq antlr-language - antlr-indent-at-bol-alist)))) - (setq syntax 'bol) - (setq indent 0)) ; indentation at 0 ((progn (antlr-next-rule -1 t) (if (antlr-search-forward ":") (< boi (1- (point))) t)) @@ -2268,20 +2402,45 @@ to a lesser extent, `antlr-tab-offset-alist'." (forward-char) (antlr-skip-exception-part nil) (setq indent (if (> (point) boi) 1 0))))) ; in exception part? - ;; compute the corresponding indentation and indent -------------------- + ;; check whether to use indentation engine of cc-mode ------------------ + (antlr-invalidate-context-cache) + (goto-char boi) + (when (and indent (> syntax 0)) + (cond ((> syntax 1) ; block in action => use cc-mode + (setq indent nil)) + ((and (= indent 0) + (assq antlr-language antlr-indent-at-bol-alist) + (looking-at (cdr (assq antlr-language + antlr-indent-at-bol-alist)))) + (setq syntax 'bol)) + ((setq cc-syntax (c-guess-basic-syntax)) + (let ((cc cc-syntax) symbol) + (while (setq symbol (pop cc)) + (when (cdr symbol) + (or (memq (car symbol) + antlr-disabling-cc-syntactic-symbols) + (setq indent nil)) + (setq cc nil))))))) +;;; ((= indent 1) ; exception part => use cc-mode +;;; (setq indent nil)) +;;; ((save-restriction ; not in option part => cc-mode +;;; (goto-char (scan-lists (point) -1 1)) +;;; (skip-chars-backward " \t\n") +;;; (narrow-to-region (point-min) (point)) +;;; (not (re-search-backward "\\ indent 0) (looking-at antlr-indent-item-regexp) (decf indent)) (setq indent (* indent c-basic-offset))) @@ -2339,20 +2498,46 @@ ANTLR's syntax and influences the auto indentation, see ;;; Mode entry ;;;=========================================================================== +(defun antlr-c-init-language-vars () + "Like `c-init-language-vars-for' when using cc-mode before v5.29." + (let ((settings ; (cdr '(setq...)) will be optimized + (if (eq antlr-language 'c++-mode) + (cdr '(setq ;' from `c++-mode' v5.20, v5.28 + c-keywords (c-identifier-re c-C++-keywords) + c-conditional-key c-C++-conditional-key + c-comment-start-regexp c-C++-comment-start-regexp + c-class-key c-C++-class-key + c-extra-toplevel-key c-C++-extra-toplevel-key + c-access-key c-C++-access-key + c-recognize-knr-p nil + c-bitfield-key c-C-bitfield-key ; v5.28 + )) + (cdr '(setq ; from `java-mode' v5.20, v5.28 + c-keywords (c-identifier-re c-Java-keywords) + c-conditional-key c-Java-conditional-key + c-comment-start-regexp c-Java-comment-start-regexp + c-class-key c-Java-class-key + c-method-key nil + c-baseclass-key nil + c-recognize-knr-p nil + c-access-key c-Java-access-key ; v5.20 + c-inexpr-class-key c-Java-inexpr-class-key ; v5.28 + ))))) + (while settings + (when (boundp (car settings)) + (ignore-errors + (set (car settings) (eval (cadr settings))))) + (setq settings (cddr settings))))) + (defun antlr-c-common-init () - "Like `c-common-init' except menu, auto-hungry and c-style stuff." + "Like `c-basic-common-init' when using cc-mode before v5.30." ;; X/Emacs 20 only (make-local-variable 'paragraph-start) (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-ignore-fill-prefix) (make-local-variable 'require-final-newline) (make-local-variable 'parse-sexp-ignore-comments) - (make-local-variable 'indent-line-function) - (make-local-variable 'indent-region-function) (make-local-variable 'comment-start) - (make-local-variable 'comment-end) - (make-local-variable 'comment-column) - (make-local-variable 'comment-start-skip) (make-local-variable 'comment-multi-line) (make-local-variable 'outline-regexp) (make-local-variable 'outline-level) @@ -2370,18 +2555,19 @@ ANTLR's syntax and influences the auto indentation, see (setq paragraph-start (concat page-delimiter "\\|$") paragraph-separate paragraph-start paragraph-ignore-fill-prefix t - require-final-newline t parse-sexp-ignore-comments t - indent-line-function 'c-indent-line - indent-region-function 'c-indent-region - outline-regexp "[^#\n\^M]" - outline-level 'c-outline-level comment-column 32 - comment-start-skip "/\\*+ *\\|// *" comment-multi-line nil comment-line-break-function 'c-comment-line-break-function adaptive-fill-regexp nil adaptive-fill-mode nil) + (c-set-style (or antlr-indent-style "gnu")) + (and (boundp 'c-current-comment-prefix) (boundp 'c-comment-prefix-regexp) + (setq c-current-comment-prefix + (if (listp c-comment-prefix-regexp) + (cdr-safe (or (assoc major-mode c-comment-prefix-regexp) + (assoc 'other c-comment-prefix-regexp))) + c-comment-prefix-regexp))) ;; we have to do something special for c-offsets-alist so that the ;; buffer local value has its own alist structure. (setq c-offsets-alist (copy-alist c-offsets-alist)) @@ -2403,7 +2589,7 @@ the default language." (match-string 1))) (seq antlr-language-alist) r) - ;; Like (find-VALUE antlr-language-alist :key 'cddr :test 'member) + ;; Like (find VALUE antlr-language-alist :key 'cddr :test 'member) (while seq (setq r (pop seq)) (if (member value (cddr r)) @@ -2411,14 +2597,15 @@ the default language." (setq r nil))) ; no result yet (car r))) - ;;;###autoload (defun antlr-mode () "Major mode for editing ANTLR grammar files. \\{antlr-mode-map}" (interactive) - (c-initialize-cc-mode) ; for java syntax table (kill-all-local-variables) + (c-initialize-cc-mode) ; cc-mode is required + (unless (fboundp 'c-forward-sws) ; see above + (fset 'antlr-c-forward-sws 'c-forward-syntactic-ws)) ;; ANTLR specific ---------------------------------------------------------- (setq major-mode 'antlr-mode mode-name "Antlr") @@ -2445,28 +2632,34 @@ the default language." (concat "Antlr." (cadr (assq antlr-language antlr-language-alist))))) ;; indentation, for the C engine ------------------------------------------- - (antlr-c-common-init) + (setq c-buffer-is-cc-mode antlr-language) + (cond ((fboundp 'c-init-language-vars-for) ; cc-mode 5.30.5+ + (c-init-language-vars-for antlr-language)) + ((fboundp 'c-init-c-language-vars) ; cc-mode 5.30 to 5.30.4 + (c-init-c-language-vars) ; not perfect, but OK + (setq c-recognize-knr-p nil)) + ((fboundp 'c-init-language-vars) ; cc-mode 5.29 + (let ((init-fn 'c-init-language-vars)) + (funcall init-fn))) ; is a function in v5.29 + (t ; cc-mode upto 5.28 + (antlr-c-init-language-vars))) ; do it myself + (cond ((fboundp 'c-basic-common-init) ; cc-mode 5.30+ + (c-basic-common-init antlr-language (or antlr-indent-style "gnu"))) + (t + (antlr-c-common-init))) + (make-local-variable 'outline-regexp) + (make-local-variable 'outline-level) + (make-local-variable 'require-final-newline) + (make-local-variable 'indent-line-function) + (make-local-variable 'indent-region-function) + (setq outline-regexp "[^#\n\^M]" + outline-level 'c-outline-level) ; TODO: define own + (setq require-final-newline t) (setq indent-line-function 'antlr-indent-line indent-region-function nil) ; too lazy (setq comment-start "// " - comment-end "") - (c-set-style "java") - (if (eq antlr-language 'c++-mode) - (setq c-conditional-key c-C++-conditional-key - c-comment-start-regexp c-C++-comment-start-regexp - c-class-key c-C++-class-key - c-extra-toplevel-key c-C++-extra-toplevel-key - c-access-key c-C++-access-key - c-recognize-knr-p nil) - (setq c-conditional-key c-Java-conditional-key - c-comment-start-regexp c-Java-comment-start-regexp - c-class-key c-Java-class-key - c-method-key nil - c-baseclass-key nil - c-recognize-knr-p nil - c-access-key (and (boundp 'c-Java-access-key) c-Java-access-key)) - (and (boundp 'c-inexpr-class-key) (boundp 'c-Java-inexpr-class-key) - (setq c-inexpr-class-key c-Java-inexpr-class-key))) + comment-end "" + comment-start-skip "/\\*+ *\\|// *") ;; various ----------------------------------------------------------------- (make-local-variable 'font-lock-defaults) (setq font-lock-defaults antlr-font-lock-defaults) @@ -2502,21 +2695,7 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'." indent-tabs-mode (cadddr elem) alist nil)))))) -; LocalWords: antlr ANother ANTLR's Cpp Lexer TreeParser esp refs VALUEs ea ee -; LocalWords: Java's Nomencl ruledef tokendef ruleref tokenref setType ader ev -; LocalWords: ivate syntab lexer treeparser lic rotected rivate bor boi AFAIK -; LocalWords: slist knr inexpr unhide jit GENS SEP GEN sTokenTypes hpp cpp DEP -; LocalWords: VOCAB EVOCAB Antlr's TokenTypes exportVocab incl excl SUPERS gen -; LocalWords: VOCABS IVOCAB exportVocabs importVocabs superclasses vocab kens -; LocalWords: sclass evocab ivocab importVocab deps glibs supers sep dep lang -; LocalWords: htmlize subrule jde Sather sather eiffel SGML's XYYZZ namespace -; LocalWords: mangleLiteralPrefix namespaceStd namespaceAntlr genHashLines AST -; LocalWords: testLiterals defaultErrorHandler codeGenMakeSwitchThreshold XXX -; LocalWords: codeGenBitsetTestThreshold bitset analyzerDebug codeGenDebug boc -; LocalWords: buildAST ASTLabelType charVocabulary caseSensitive autoTokenDef -; LocalWords: caseSensitiveLiterals classHeaderSuffix keywordsMeltTo NAMEs LL -; LocalWords: warnWhenFollowAmbig generateAmbigWarnings ARGs tokenrefs withp -; LocalWords: outsidep existsp JOR sert endif se ndef mport nclude pragma LE -; LocalWords: TION ASE RSION OMPT ava serting VEL mparison AMMAR +;;; Local IspellPersDict: .ispell_antlr +;;; arch-tag: 5de2be79-3d13-4560-8fbc-f7d0234dcb5c ;;; antlr-mode.el ends here