commit 665792f6973b74db0f62264391f3102050331fd7 Author: Philip Kaludercic Date: Thu Dec 11 08:25:40 2025 +0100 Handle remaining usages of 'package-vc-install-from-checkout' * doc/emacs/package.texi (Fetching Package Sources): Remove mention of `package-vc-install-from-checkout'. * doc/misc/use-package.texi (Install package): Remove mention of :vc in combination with :load-path. * lisp/use-package/use-package-core.el (use-package-vc-install): Suppress compile-time warning and generate warning during evaluation instead. * test/lisp/emacs-lisp/package-vc-tests.el (package-vc-tests-checkout-from-elpa-install-from-checkout) (package-vc-tests-checkout-with-git-install-from-checkout): Suppress obsoletion warning. diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 49d7e65c5b1..fd8a79aa922 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -666,16 +666,6 @@ with the maintainers, first commit your changes then use the command @xref{Preparing Patches}. @end ifnottex -@findex package-vc-install-from-checkout -@findex package-vc-rebuild - If you maintain your own packages you might want to use a local -checkout instead of cloning a remote repository. You can do this by -using @code{package-vc-install-from-checkout}, which creates a symbolic link -from the package directory (@pxref{Package Files}) to your checkout -and initializes the code. Note that you might have to use -@code{package-vc-rebuild} to repeat the initialization and update the -autoloads. - @subsection Specifying Package Sources @cindex package specification @cindex specification, for source packages diff --git a/doc/misc/use-package.texi b/doc/misc/use-package.texi index dc586ca9ae9..2e9fd87776a 100644 --- a/doc/misc/use-package.texi +++ b/doc/misc/use-package.texi @@ -1747,20 +1747,6 @@ latest commit of the package @code{foo} from the specified remote. Alternatively, the @code{use-package-vc-prefer-newest} user option exists to always prefer the latest commit. -The @code{:vc} keyword can also be used for local packages, by -combining it with @code{:load-path} (@pxref{Load path}): - -@example -@group -;; Use a local copy of BBDB instead of the one from GNU ELPA. -(use-package bbdb - :vc t - :load-path "/path/to/bbdb/dir/") -@end group -@end example - -The above dispatches to @code{package-vc-install-from-checkout}. - @node Pinning packages @section Pinning packages using @code{:pin} @cindex installing package from specific archive diff --git a/lisp/use-package/use-package-core.el b/lisp/use-package/use-package-core.el index 96b7a61edc9..0f049a6f86b 100644 --- a/lisp/use-package/use-package-core.el +++ b/lisp/use-package/use-package-core.el @@ -1700,7 +1700,10 @@ remote host, call `package-vc-install' instead." (spec (if opts (cons name opts) name))) (unless (package-installed-p name) (if local-path - (package-vc-install-from-checkout local-path (symbol-name name)) + (with-suppressed-warnings ((obsolete package-vc-install-from-checkout)) + (warn "Support for :vc with :load-path is obsolete. \ +Use the User Lisp directory instead.") + (package-vc-install-from-checkout local-path (symbol-name name))) (package-vc-install spec rev))))) (defun use-package-handler/:vc (name _keyword arg rest state) diff --git a/test/lisp/emacs-lisp/package-vc-tests.el b/test/lisp/emacs-lisp/package-vc-tests.el index c06dce71e03..f118a871f99 100644 --- a/test/lisp/emacs-lisp/package-vc-tests.el +++ b/test/lisp/emacs-lisp/package-vc-tests.el @@ -605,7 +605,8 @@ Make checkout with `package-vc-checkout'." (push (list (package-vc-tests-load-history-marker 'install-begin)) load-history) (should (eq t - (package-vc-install-from-checkout checkout-dir))) + (with-suppressed-warnings ((obsolete package-vc-install-from-checkout)) + (package-vc-install-from-checkout checkout-dir)))) (push (list (package-vc-tests-load-history-marker 'install-end)) load-history) (let ((extras (package-desc-extras (package-vc-tests-package-desc pkg t)))) @@ -621,8 +622,8 @@ Make checkout with git(1)." (push (list (package-vc-tests-load-history-marker 'install-begin)) load-history) (should (eq t - (package-vc-install-from-checkout checkout-dir - (symbol-name pkg)))) + (with-suppressed-warnings ((obsolete package-vc-install-from-checkout)) + (package-vc-install-from-checkout checkout-dir (symbol-name pkg))))) (push (list (package-vc-tests-load-history-marker 'install-end)) load-history) (let ((extras (package-desc-extras (package-vc-tests-package-desc pkg t)))) commit a465c43b29fc7757d4beaefb9ac49dcfc6e7111e Author: Philip Kaludercic Date: Sat Dec 6 12:22:03 2025 +0100 Simplify 'comint-write-input-ring' * lisp/comint.el (comint-write-input-ring): Use 'with-temp-buffer', 'decf' and write the buffer contents without 'buffer-string'. (bug#79954) diff --git a/lisp/comint.el b/lisp/comint.el index d94bc97ede3..be691363fe9 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1120,21 +1120,16 @@ See also `comint-read-input-ring'." ((not (file-writable-p comint-input-ring-file-name)) (message "Cannot write history file %s" comint-input-ring-file-name)) (t - (let* ((history-buf (get-buffer-create " *Temp Input History*")) - (ring comint-input-ring) + (let* ((ring comint-input-ring) (file comint-input-ring-file-name) (separator comint-input-ring-separator) (index (ring-length ring))) ;; Write it all out into a buffer first. Much faster, but messier, ;; than writing it one line at a time. - (with-current-buffer history-buf - (erase-buffer) + (with-temp-buffer (while (> index 0) - (setq index (1- index)) - (insert (ring-ref ring index) separator)) - (write-region (buffer-string) nil file nil 'no-message) - (kill-buffer nil)))))) - + (insert (ring-ref ring (decf index)) separator)) + (write-region nil nil file nil 'no-message)))))) (defvar comint-dynamic-list-input-ring-window-conf) commit b969905a4759f11130d0f3ed5810cf6df0e34adb Author: Stephen Gildea Date: Wed Dec 10 12:50:38 2025 -0800 ; time-stamp: Prefer 'string-match-p' over 'string-match' * lisp/time-stamp.el (time-stamp, time-stamp--system-name): Use 'string-match-p' instead of 'string-match'. (time-stamp--count-newlines): New function to implement the algorithm. (time-stamp--system-name-1): New function, a testing seam. * test/lisp/time-stamp-tests.el (with-time-stamp-system-name): Use the new testing seam to expand test coverage. diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index 5e9e09be862..1e018e0df68 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -387,17 +387,13 @@ to customize the information in the time stamp and where it is written." (setq ts-count 1))) ;; Figure out what lines the end should be on. (if (stringp ts-format) - (let ((nl-start 0)) - (while (string-match "\n" ts-format nl-start) - (setq format-lines (1+ format-lines) nl-start (match-end 0))))) + (setq format-lines (time-stamp--count-newlines ts-format))) (cond ((not (and (stringp ts-start) (stringp ts-end))) (time-stamp--message "time-stamp-start or time-stamp-end is not a string")) (t - (let ((nl-start 0)) - (while (string-match "\n" ts-end nl-start) - (setq end-lines (1+ end-lines) nl-start (match-end 0)))) + (setq end-lines (1+ (time-stamp--count-newlines ts-end))) ;; Find overall what lines to look at (save-excursion (save-restriction @@ -849,6 +845,16 @@ for the full name or :nondirectory for base name only." (setq file-name (file-name-nondirectory file-name))) (apply #'string (mapcar safe-character-filter file-name)))) +(defun time-stamp--count-newlines (str) + "Return the number of newlines in STR." + (declare (pure t)) + (let ((nl-count 0) + (nl-start 0)) + (while (setq nl-start (string-match-p "\n" str nl-start)) + (setq nl-count (1+ nl-count) + nl-start (1+ nl-start))) + nl-count)) + (defun time-stamp--message (warning-string) "Display WARNING-STRING for one second." (message "%s" warning-string) @@ -857,10 +863,16 @@ for the full name or :nondirectory for base name only." (defun time-stamp--system-name (type) "Return the host name of this system. TYPE is :short for the unqualified name, :full for the full name." - (let ((fullname (system-name))) - (if (and (eq type :short) (string-match "\\." fullname)) - (substring fullname 0 (match-beginning 0)) - fullname))) + (time-stamp--system-name-1 (system-name) type)) + +(defun time-stamp--system-name-1 (sysname type) + "Return SYSNAME, shortened if TYPE is :short." + (declare (pure t)) + (let (first-dot) + (if (and (eq type :short) + (setq first-dot (string-match-p "\\." sysname))) + (substring sysname 0 first-dot) + sysname))) (defvar time-stamp-conversion-warn t "Enable warnings for old formats in `time-stamp-format'. diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index fe77f102ea2..d67a288f5db 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -64,9 +64,7 @@ (declare (indent 1) (debug t)) `(cl-letf (((symbol-function 'time-stamp--system-name) (lambda (type) - (if (and (eq type :short) (string-match "\\." ,name)) - (substring ,name 0 (match-beginning 0)) - ,name)))) + (time-stamp--system-name-1 ,name type)))) ,@body)) commit fcbb9066bea0f1fb3a2185b8257e54083e6e39c9 Author: Eli Zaretskii Date: Wed Dec 10 20:32:17 2025 +0200 ; * lisp/progmodes/antlr-mode.el (cl-seq): Require. diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 262cb781300..eb61d529259 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -112,6 +112,7 @@ (when (< emacs-major-version 28) ; preloaded in Emacs 28 (require 'easymenu)) (require 'cc-mode) +(require 'cl-seq) ; for cl-find, whose autoload form is in cl-loaddefs.el (defvar outline-level) (defvar imenu-use-markers) commit fc70ead9b5cbc347c801d866f7f0a30d5c32b0d1 Merge: 24e55057055 d243551678f Author: Stefan Monnier Date: Wed Dec 10 13:20:28 2025 -0500 Merge branch 'antlr-mode' commit d243551678fd950fc9bce2a3f5fa34a6927c7fdb Author: Stefan Monnier Date: Wed Dec 10 13:19:50 2025 -0500 antlr-mode.el: Cosmetics, mostly to silence compiler warnings * lisp/progmodes/antlr-mode.el: Prefer #' to quote function names. Fix a few incorrect ' in docstring markup. (antlr-font-lock-checked-face): Don't use obsolete `font-lock-warning-face` variable. (antlr-do-syntax-propertize): Use `emacs-major-version`. (antlr-set-tool-version-and-mode-line): Don't set `indent-region-function` to a non-function value. (antlr-mode): Remove call to obsolete `easy-menu-add`. (antlr-delphi-indent-action-line, antlr-ruby-indent-action-line): Avoid obsolete functions `point-at-[be]ol`. (antlr-python-indent-action-line): Make sure `syntax-ppss-*` vars are bound dynamically rather than statically. diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index d68476d9a64..262cb781300 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -278,7 +278,7 @@ The value is language-dependent, see `antlr-language-variables'.") (defvar antlr-java-init-cc-mode 'java-mode "Value for `antlr-init-cc-mode' when using language `antlr-java'.") -(defvar antlr-init-submode 'antlr-set-tabs +(defvar antlr-init-submode #'antlr-set-tabs "Function used to initialize the action language. Important for languages which do not depend on CC Mode. The value is language-dependent, see `antlr-language-variables'.") @@ -901,30 +901,30 @@ imenu. For sorted menu entries, customize variable (defvar antlr-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\t" 'antlr-indent-command) - (define-key map "\e\C-a" 'antlr-beginning-of-rule) - (define-key map "\e\C-e" 'antlr-end-of-rule) - (define-key map "\C-c\C-a" 'antlr-beginning-of-body) - (define-key map "\C-c\C-e" 'antlr-end-of-body) + (define-key map "\t" #'antlr-indent-command) + (define-key map "\e\C-a" #'antlr-beginning-of-rule) + (define-key map "\e\C-e" #'antlr-end-of-rule) + (define-key map "\C-c\C-a" #'antlr-beginning-of-body) + (define-key map "\C-c\C-e" #'antlr-end-of-body) (define-key map "\C-c\C-f" 'subword-forward) (define-key map "\C-c\C-b" 'subword-backward) - (define-key map "\C-c\C-c" 'comment-region) - (define-key map "\C-c\C-k" 'antlr-insert-keyword-rule) - (define-key map "\C-c\C-v" 'antlr-hide-actions) - (define-key map "\C-c\C-r" 'antlr-run-tool) - (define-key map "\C-c\C-o" 'antlr-insert-option) + (define-key map "\C-c\C-c" #'comment-region) + (define-key map "\C-c\C-k" #'antlr-insert-keyword-rule) + (define-key map "\C-c\C-v" #'antlr-hide-actions) + (define-key map "\C-c\C-r" #'antlr-run-tool) + (define-key map "\C-c\C-o" #'antlr-insert-option) ;; I'm too lazy to define my own: - (define-key map "\ea" 'c-beginning-of-statement) - (define-key map "\ee" 'c-end-of-statement) + (define-key map "\ea" #'c-beginning-of-statement) + (define-key map "\ee" #'c-end-of-statement) ;; electric keys: - (define-key map ":" 'antlr-electric-character) - (define-key map ";" 'antlr-electric-character) - (define-key map "|" 'antlr-electric-character) - (define-key map "&" 'antlr-electric-character) - (define-key map "(" 'antlr-electric-character) - (define-key map ")" 'antlr-electric-character) - (define-key map "{" 'antlr-electric-character) - (define-key map "}" 'antlr-electric-character) + (define-key map ":" #'antlr-electric-character) + (define-key map ";" #'antlr-electric-character) + (define-key map "|" #'antlr-electric-character) + (define-key map "&" #'antlr-electric-character) + (define-key map "(" #'antlr-electric-character) + (define-key map ")" #'antlr-electric-character) + (define-key map "{" #'antlr-electric-character) + (define-key map "}" #'antlr-electric-character) map) "Keymap used in `antlr-mode' buffers.") @@ -982,8 +982,8 @@ imenu. For sorted menu entries, customize variable ;;;=========================================================================== (defvar antlr-syntax-propertize nil - "Specification used to apply ‘syntax-table’ text properties. -When non-nil, the value looks like \(MAIN EXTEND-REGION MULTILINE-CHAR). + "Specification used to apply `'syntax-table' text properties. +When non-nil, the value looks like (MAIN EXTEND-REGION MULTILINE-CHAR). MAIN is used as value for `syntax-propertize-function'. @@ -1121,7 +1121,8 @@ The value might be language-dependent, see `antlr-language-variables'.") "Valid ANTLR action names in Java. Value for `antlr-action-names' when using language `antlr-java'.") -(defvar antlr-token-identifier-p 'antlr-upcase-p +;; FIXME: We usually call such variables "foo-predicate". +(defvar antlr-token-identifier-p #'antlr-upcase-p "Function for syntax highlighting to distinguish token refs from rule refs. Function is called with the first character of the identifier; it should return non-nil if the identifier is a token reference.") @@ -1550,7 +1551,7 @@ If the matched string is an element of STRINGS (or STRINGS is not a list), return FACE, otherwise return `font-lock-warning-face'." (if (if (consp strings) (member (match-string-no-properties group) strings) strings) face - font-lock-warning-face)) + 'font-lock-warning-face)) ;;;=========================================================================== @@ -1561,7 +1562,7 @@ return FACE, otherwise return `font-lock-warning-face'." ;; imenu-induced. If entries are missing in the menu (as are sometimes for me ;; on Emacs-25.1.1), try M-x imenu RET -> you see all. This might not be the ;; case anymore with the reordering of `imenu-add-to-menubar'... -(defvar antlr-do-syntax-propertize (version< emacs-version "25") +(defvar antlr-do-syntax-propertize (< emacs-major-version 25) "Whether \\[antlr-mode] runs `syntax-propertize' on the complete buffer. Running it explicitly at the beginning of the mode might be necessary for a correct Index menu and motion commands.") @@ -1574,7 +1575,7 @@ necessary for a correct Index menu and motion commands.") (defun antlr-imenu-create-index-function (&optional refs-only) "Return imenu index-alist for ANTLR grammar files. IF REFS-ONLY is non-nil, just return alist with ref names, -with value 'upcase, only return alist with tokenref names." +with value `upcase', only return alist with tokenref names." (let ((items nil) (classes nil) (continue t)) @@ -1865,7 +1866,7 @@ prefix arg MSG, move to `:'." "Convert all literals in buffer to lower case. If non-nil, TRANSFORM is used on literals instead of `downcase-region'." (interactive) - (or transform (setq transform 'downcase-region)) + (or transform (setq transform #'downcase-region)) (let ((literals 0)) (save-excursion (goto-char (point-min)) @@ -1877,7 +1878,7 @@ If non-nil, TRANSFORM is used on literals instead of `downcase-region'." (defun antlr-upcase-literals () "Convert all literals in buffer to upper case." (interactive) - (antlr-downcase-literals 'upcase-region)) + (antlr-downcase-literals #'upcase-region)) ;; TODO: `antlr-hide-actions' should probably be a minor mode like ;; `hide-ifdef-mode'. Whether to exclude arguments (of limited use) should be @@ -2050,8 +2051,8 @@ Use `current-prefix-arg' for ARG. Return \(LEVEL OPTION LOCATION)." (vector option (list 'antlr-insert-option level option) :active active)) - (sort (mapcar 'car (elt antlr-options-alists (1- level))) - 'string-lessp)))) + (sort (mapcar #'car (elt antlr-options-alists (1- level))) + #'string-lessp)))) ;;;=========================================================================== @@ -2370,8 +2371,8 @@ Used by `antlr-insert-option-do'." ;;; Insert options: in `antlr-options-alists' ;;;=========================================================================== -(defun antlr-read-value (initial-contents prompt - &optional as-string table table-x) +(defun antlr-read-value ( initial-contents prompt + &optional as-string table table-x) "Read a string from the minibuffer, possibly with completion. If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. PROMPT is a string to prompt with, normally it ends in a colon and a @@ -2419,7 +2420,7 @@ PROMPT is a string to prompt with, normally it ends in a colon and a space. Used inside `antlr-options-alists'." - (let ((table (apply 'nconc + (let ((table (apply #'nconc (mapcar (lambda (l) (mapcar #'list (cdr l))) antlr-language-list)))) (antlr-read-value initial-contents prompt nil table))) @@ -2597,7 +2598,7 @@ vocabulary of the super-grammar or nil if it is not needed." (format (cadr antlr-unknown-file-formats) (car super))))) glibs))) - (cons (if glibs (concat " -glib " (mapconcat 'car glibs ";")) "") + (cons (if glibs (concat " -glib " (mapconcat #'car glibs ";")) "") (cons unknown glibs)))) @@ -2631,7 +2632,7 @@ called interactively, the buffers are always saved, see also variable (error-regexp-alist antlr-compilation-error-regexp-alist) (process-environment (if antlr-tool-path - (let ((path (mapconcat 'substitute-env-vars + (let ((path (mapconcat #'substitute-env-vars antlr-tool-path path-separator))) (cons (concat "PATH=" path path-separator (getenv "PATH")) @@ -2994,12 +2995,12 @@ If not found, use the default, which is the first element." (car antlr-language-limit-n-regexp)) t) (car (cl-find (match-string-no-properties 1) antlr-language-list - :key 'cdr :test 'member))))) + :key #'cdr :test #'member))))) (defun antlr-guess-tool-version () "Guess whether current grammar is for ANTLR v2 or v3. -By default, we assume v3. Only if we find a keyword 'class' or -'header' at the beginning of a line before any 'grammar' keyword, +By default, we assume v3. Only if we find a keyword `class' or +`header' at the beginning of a line before any `grammar' keyword, we assume v2." (save-excursion (goto-char (point-min)) @@ -3010,8 +3011,8 @@ we assume v2." (defun antlr-skip-import-statement () "Skip whitespaces, comments and special declarations after the header. -See `antlr-skip-line-regexp', which skips the 'scope' declaration in -ANTLR v3, and the 'import' declaration in ANTLR v4." +See `antlr-skip-line-regexp', which skips the `scope' declaration in +ANTLR v3, and the `import' declaration in ANTLR v4." (if (not (and antlr-skip-line-regexp (looking-at antlr-skip-line-regexp))) (antlr-skip-sexps 1) (goto-char (match-end 0)) @@ -3051,9 +3052,11 @@ This function is used in `hack-local-variables-hook'." (assq 'antlr-language file-local-variables-alist)) (antlr-set-tool-version-and-mode-line))) -(add-hook 'hack-local-variables-hook 'antlr-hack-local-variables-hook) +(add-hook 'hack-local-variables-hook #'antlr-hack-local-variables-hook) (defun antlr-set-tool-version-and-mode-line () + ;; FIXME: This does a *lot* more setup than is normal for + ;; `hack-local-variables-hook'. "Late setup for `antlr-mode' and sub modes." ;; tool and language version and dependent variables ----------------------- (let ((guess (if (local-variable-p 'antlr-tool-version) @@ -3082,7 +3085,7 @@ This function is used in `hack-local-variables-hook'." (or antlr-indent-style "gnu")) (funcall antlr-init-submode) (set (make-local-variable 'indent-line-function) #'antlr-indent-line) - (set (make-local-variable 'indent-region-function) nil) ; TODO + (kill-local-variable 'indent-region-function) ;FIXME: Needed? ;; syntax-propertize ------------------------------------------------------- (when antlr-syntax-propertize (setq-local syntax-propertize-function (car antlr-syntax-propertize)) @@ -3107,8 +3110,8 @@ This function is used in `hack-local-variables-hook'." (fboundp 'imenu-add-to-menubar) (imenu-add-to-menubar (if (stringp antlr-imenu-name) antlr-imenu-name "Index"))) - (setq mode-name ; TODO: or use ("" ...)? - (concat antlr-tool-mode-name "." antlr-language-mode-name))) + ;; FIXME: No need to set this so late. + (setq mode-name '("" antlr-tool-mode-name "." antlr-language-mode-name))) (defvar antlr-delayed-mode-hook '(antlr-set-tool-version-and-mode-line) @@ -3131,7 +3134,7 @@ This function is used in `hack-local-variables-hook'." (set (make-local-variable 'imenu-create-index-function) #'antlr-imenu-create-index-function) (set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test - (easy-menu-add antlr-mode-menu) + ;; FIXME: How does this hook differ from `antlr-mode-hook'? (run-mode-hooks 'antlr-delayed-mode-hook)) ;; A smarter version of `group-buffers-menu-by-mode-then-alphabetically' (in @@ -3219,7 +3222,7 @@ It is probably better to automatically deduce the TAB setting." (defvar antlr-js-action-mode 'js-mode "Value for `antlr-action-mode' when using language `antlr-js'.") -(defvar antlr-js-init-submode 'antlr-init-js +(defvar antlr-js-init-submode #'antlr-init-js "Value for `antlr-init-submode' when using language `antlr-js'.") (defvar antlr-js-action-font-lock-keywords @@ -3228,7 +3231,7 @@ It is probably better to automatically deduce the TAB setting." js--font-lock-keywords-1 js--font-lock-keywords-2) "Value for `antlr-action-font-lock-keywords' when using language `antlr-js'.") -(defvar antlr-js-indent-action-line 'antlr-js-indent-action-line +(defvar antlr-js-indent-action-line #'antlr-js-indent-action-line "Value for `antlr-indent-action-line' when using language `antlr-js'.") (defun antlr-init-js () @@ -3255,7 +3258,7 @@ It is probably better to automatically deduce the TAB setting." (defvar antlr-delphi-action-mode 'opascal-mode "Value for `antlr-action-mode' when using language `antlr-delphi'.") -(defvar antlr-delphi-init-submode 'antlr-init-delphi +(defvar antlr-delphi-init-submode #'antlr-init-delphi "Value for `antlr-init-submode' when using language `antlr-delphi'.") (defvar antlr-delphi-action-font-lock-keywords @@ -3263,7 +3266,7 @@ It is probably better to automatically deduce the TAB setting." opascal-font-lock-keywords) "Value for `antlr-action-font-lock-keywords' when using language `antlr-delphi'.") -(defvar antlr-delphi-indent-action-line 'antlr-delphi-indent-action-line +(defvar antlr-delphi-indent-action-line #'antlr-delphi-indent-action-line "Value for `antlr-indent-action-line' when using language `antlr-delphi'.") (defun antlr-init-delphi () @@ -3279,14 +3282,14 @@ It is probably better to automatically deduce the TAB setting." (defun antlr-delphi-indent-action-line (boa) "Indent the current line in a Delphi (opascal) action. Argument BOA is the start position of the action." - (narrow-to-region (1+ boa) (point-at-eol)) + (narrow-to-region (1+ boa) (line-end-position)) ;; make Pascal mode only checks the code fragment after the opening brace, ;; otherwise its indentation gets confused as {...} are block comments (opascal-indent-line) ;; or use low-level `opascal-corrected-indentation' - but that does not have ;; a docstring, i.e. not really official ? (widen) - (unless (memq (char-after (point-at-bol)) '(?\ ?\t)) + (unless (memq (char-after (line-beginning-position)) '(?\ ?\t)) ;; no indentation -> considered top-level -> indentation can also be ;; performed by c-mode (c-indent-line))) @@ -3306,7 +3309,7 @@ Argument BOA is the start position of the action." (defvar antlr-ruby-action-mode 'ruby-mode "Value for `antlr-action-mode' when using language `antlr-ruby'.") -(defvar antlr-ruby-init-submode 'antlr-init-ruby +(defvar antlr-ruby-init-submode #'antlr-init-ruby "Value for `antlr-init-submode' when using language `antlr-ruby'.") (defvar antlr-ruby-action-font-lock-keywords @@ -3314,7 +3317,7 @@ Argument BOA is the start position of the action." ruby-font-lock-keywords) "Value for `antlr-action-font-lock-keywords' when using language `antlr-ruby'.") -(defvar antlr-ruby-indent-action-line 'antlr-ruby-indent-action-line +(defvar antlr-ruby-indent-action-line #'antlr-ruby-indent-action-line "Value for `antlr-indent-action-line' when using language `antlr-ruby'.") (defun antlr-init-ruby () @@ -3328,10 +3331,10 @@ Argument BOA is the start position of the action." (defun antlr-ruby-indent-action-line (boa) "Indent the current line in a Ruby action. Argument BOA is the start position of the action." - (narrow-to-region (1+ boa) (point-at-eol)) + (narrow-to-region (1+ boa) (line-end-position)) (ruby-indent-line) (widen) - (unless (memq (char-after (point-at-bol)) '(?\ ?\t)) + (unless (memq (char-after (line-beginning-position)) '(?\ ?\t)) ;; no indentation -> considered top-level -> indentation can also be ;; performed by cc-mode (c-indent-line))) @@ -3350,7 +3353,7 @@ Argument BOA is the start position of the action." (defvar antlr-python-action-mode 'python-mode "Value for `antlr-action-mode' when using language `antlr-python'.") -(defvar antlr-python-init-submode 'antlr-init-python +(defvar antlr-python-init-submode #'antlr-init-python "Value for `antlr-init-submode' when using language `antlr-python'.") (defvar antlr-python-action-font-lock-keywords @@ -3358,7 +3361,7 @@ Argument BOA is the start position of the action." python-font-lock-keywords) "Value for `antlr-action-font-lock-keywords' when using language `antlr-python'.") -(defvar antlr-python-indent-action-line 'antlr-python-indent-action-line +(defvar antlr-python-indent-action-line #'antlr-python-indent-action-line "Value for `antlr-indent-action-line' when using language `antlr-python'.") (defun antlr-init-python () @@ -3380,6 +3383,8 @@ Argument BOA is the start position of the action." (when (and boa (eq antlr-indent-comment t) ; indent-region (boundp 'prog-indentation-context)) ; Emacs 24.5 or later + ;; FIXME: These vars don't exist any more. + (defvar syntax-ppss-cache) (defvar syntax-ppss-last) (let ((syntax-ppss-cache nil) ;#dynamic, in older Emacs... (syntax-ppss-last nil) ;#dynamic, in older Emacs... ;; TODO: do we also need to call `syntax-propertize' or commit 24e550570554b3ae89d9621d6602fd3f993a7d29 Author: Juri Linkov Date: Wed Dec 10 19:37:33 2025 +0200 Evaluate result on first call to throttled func in timeout.el * lisp/emacs-lisp/timeout.el (timeout--throttle-advice) (timeout-throttled-func): Replace 'prog1' with 'progn' to return the evaluated value of 'result' (bug#79979). This will capture the correct return value the first time a throttled function is called. Previously, it would return nil on the very first call. (timeout-debounce, timeout-throttle, timeout-throttled-func) (timeout-debounced-func): Add the autoload cookie. diff --git a/lisp/emacs-lisp/timeout.el b/lisp/emacs-lisp/timeout.el index 2b90650f02a..7529d4bc0a4 100644 --- a/lisp/emacs-lisp/timeout.el +++ b/lisp/emacs-lisp/timeout.el @@ -82,7 +82,7 @@ This is intended for use as function advice." (result)) (lambda (orig-fn &rest args) "Throttle calls to this function." - (prog1 result + (progn (unless (and throttle-timer (timerp throttle-timer)) (setq result (apply orig-fn args)) (setq throttle-timer @@ -90,7 +90,8 @@ This is intended for use as function advice." (timeout--eval-value timeout-value) nil (lambda () (cancel-timer throttle-timer) - (setq throttle-timer nil))))))))) + (setq throttle-timer nil))))) + result)))) (defun timeout--debounce-advice (&optional delay default) "Return a function that debounces its argument function. @@ -122,6 +123,7 @@ This is intended for use as function advice." (apply orig-fn args)))) (current-buffer)))))))) +;;;###autoload (defun timeout-debounce (func &optional delay default) "Debounce FUNC by making it run DELAY seconds after it is called. @@ -143,6 +145,7 @@ returned." '((name . debounce) (depth . -99))))) +;;;###autoload (defun timeout-throttle (func &optional throttle) "Make FUNC run no more frequently than once every THROTTLE seconds. @@ -159,6 +162,7 @@ previous successful call is returned." '((name . throttle) (depth . -98))))) +;;;###autoload (defun timeout-throttled-func (func &optional throttle) "Return a throttled version of function FUNC. @@ -182,7 +186,7 @@ previous successful call is returned." "\n\nThrottle calls to this function")) (interactive (advice-eval-interactive-spec (cadr (interactive-form func)))) - (prog1 result + (progn (unless (and throttle-timer (timerp throttle-timer)) (setq result (apply func args)) (setq throttle-timer @@ -190,14 +194,15 @@ previous successful call is returned." (timeout--eval-value throttle-value) nil (lambda () (cancel-timer throttle-timer) - (setq throttle-timer nil))))))) + (setq throttle-timer nil))))) + result)) ;; NON-INTERACTIVE version (lambda (&rest args) (:documentation (concat (documentation func) "\n\nThrottle calls to this function")) - (prog1 result + (progn (unless (and throttle-timer (timerp throttle-timer)) (setq result (apply func args)) (setq throttle-timer @@ -205,8 +210,10 @@ previous successful call is returned." (timeout--eval-value throttle-value) nil (lambda () (cancel-timer throttle-timer) - (setq throttle-timer nil)))))))))) + (setq throttle-timer nil))))) + result))))) +;;;###autoload (defun timeout-debounced-func (func &optional delay default) "Return a debounced version of function FUNC. commit d8870cc1022cecba1bdbb3531659e9253c20c479 Author: Stefan Monnier Date: Wed Dec 10 06:48:17 2025 -0500 lisp/emacs-lisp/byte-opt.el (byte-optimize-memq): Beware improper lists diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index d936d7e341c..d6686952aca 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1133,7 +1133,7 @@ See Info node `(elisp) Integer Basics'." ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar)) ((and (eq (car-safe list) 'quote) (listp (setq list (cadr list))) - (= (length list) 1)) + (null (cdr list))) `(and (eq ,(nth 1 form) ',(nth 0 list)) ',list)) (t form))) commit 37468d244962dedc7ab760ffb19e15121975c1f0 Author: Christoph Wedler Date: Mon Dec 8 20:02:33 2025 +0100 Update progmodes/antlr-mode.el from v2.2c to v3.2.0 For the ChangeLog with timeline, see https://sourceforge.net/projects/antlr-mode/files/ The following is the ChangeLog between v2.2c to v3.2.0 without (intermediate) version numbers and changes already in the Emacs repository. * antlr-mode.el: Command `antlr-run-tool' now runs on the file for the current buffer by default. (antlr-run-tool-on-buffer-file): New user option. (antlr-run-tool-interactive): Use it. * antlr-mode.el: Allow `antlr-tool-version' and `antlr-language' be set in the Local Variables section of a file. (antlr-hack-local-variables-hook): New function. (antlr-set-tool-version-and-mode-line): Adapt (antlr-delayed-mode-hook): Renamed from `antlr-after-body-hook'. (antlr-font-lock-keywords): Correctly call `font-lock-value-in-major-mode'. * antlr-mode.el: Miscellaneous corrections and other changes. (antlr-insert-keyword-rule): Make it work in v2 and v4, too. (antlr-indent-line): Correctly calculate beginning of action. (antlr-grammar-header-regexp): Has a value which is valid for v3 and v4. (antlr-v4-grammar-header-regexp, antlr-v3-grammar-header-regexp): Delete. (antlr-tool-version-variables): tool-dependent variable for `antlr-grammar-header-regexp`' is optional. (antlr-upcase-p): Delete XEmacs bug workaround. * antlr-mode.el: Enhance options, add v4 language "Cpp". (antlr-v4-language-list): Add "Cpp". (antlr-v4-options-alists, antlr-v3-options-alists) (antlr-v2-options-alists): Do not hard-code languages. (antlr-read-language): New function used instead. (antlr-v4-options-alists): Add grammar option "contextSuperClass" and Cpp-only "exportMacro". (antlr-insert-option-do): Call the "right" antlr-mode for v4 grammars. (antlr-option-spec): Delete function. (antlr-insert-option-do): Do not use it. * antlr-mode.el: Correct command `antlr-insert-options'. (antlr-try-rule-or-grammar-option): New function. (antlr-option-level): Use it, correcting v3 and v4 behavior. (antlr-v2-options-alists): Correct "language" option. (antlr-syntactic-grammar-depth): Correct calculation (antlr-options-style): Make it really obsolete. (antlr-read-value): Do not use it. * antlr-mode.el: Disable command `antlr-show-makefile-rules' for ANTLR v3 and v4, these have "-depend" to show Makefile deps. (antlr-show-makefile-rules): User error when used with v3 or v4. * antlr-mode.el: Adapt command `antlr-run-tool' to ANTLR v3 and v4, do not calculate v2 option "-glib" for file dependencies. (antlr-tool-command): Make it tool-version dependent (antlr-v4-tool-command, antlr-v3-tool-command) (antlr-v2-tool-command): New user option. (antlr-run-tool-interactive): Only add "-glib" option with v2. (antlr-directory-dependencies): Only calculate deps with v2. (antlr-compilation-error-regexp-alist) (antlr-v4-compilation-error-regexp-alist): New variable. (antlr-tool-version-variables, antlr-run-tool): Use it. * antlr-mode.el: Cleanup, miscellaneous. Replace `match-string' by `match-string-no-properties' (see vc history). (antlr-grammar-file): New function. (antlr-insert-keyword-rule): New command. (antlr-mode-map): Use it. (antlr-font-lock-late-keywords): Correct face name. * antlr-mode.el: Allow to write a derived mode for grammars - like for PEG.js - whose rule header and body is separated by an operator other than ":" and other similar deviations. Also prepare for messages without file name in "*compilation*" buffer. (antlr-rule-body-start-op): New variable. (antlr-end-of-body, antlr-indent-line): Use it. (antlr-grammar-file): New variable. (antlr-run-tool): Set it local in *compilation*" to FILE. (antlr-font-lock-attribute-regexp, antlr-ruleref-assign-regexp): (antlr-v2-ruleref-assign-regexp, antlr-font-lock-negation-regexp): (antlr-font-lock-syntax-spec): New variables. (antlr-font-lock-additional-keywords): (antlr-font-lock-late-keywords): Use them here. (antlr-tool-version-variables): Add `antlr-ruleref-assign-regexp'. * antlr-mode.el: Adaptation to Emacs-25.1, cleanup. (antlr-insert-makefile-rules): Set variable properly. (antlr-syntax-propertize-template-literals): Using << inside an unclosed code block could lead to error during font-locking. (antlr-slow-cache-enabling-symbol): Delete variable. * antlr-mode.el: Adopt change below and other changes in the Emacs repository to current antlr-mode version. * antlr-mode.el: Use syntax-ppss. Check "are we in the grammar or action code?" does not use extra action syntax-table anymore, but 9th element of syntax-ppss / parse-partial-sexp, whose value is "subject to change" but has not changed since decades. (antlr-action-syntax-table): Delete variable. (antlr-font-lock-defaults): Do not give parentheses symbol syntax. (antlr-slow-context-cache): Delete variable. (antlr-invalidate-context-cache): Delete function. (antlr-syntactic-context): Use syntax-ppss, new optional arg PPSS. Now returns nil instead 0 if in normal grammar code. (antlr-syntax-propertize-template-literals, antlr-re-search-forward) (antlr-search-result, antlr-syntax-propertize-charsets) (antlr-electric-character): Simplify. (antlr-do-syntax-propertize): New variable. * antlr-mode.el: Code is not run under extra syntax table anymore. (antlr-syntax-propertize-wholerule, antlr-indent-at-bol-alist) (antlr-v4-grammar-header-regexp, antlr-v3-grammar-header-regexp) (antlr-v2-grammar-header-regexp, antlr-rule-postlude-skip-regexp) (antlr-skip-file-prelude, antlr-font-lock-additional-keywords) (antlr-imenu-create-index-function, antlr-inside-rule-p) (antlr-end-of-rule, antlr-beginning-of-rule antlr-end-of-body) (antlr-hide-actions, antlr-insert-option, antlr-option-level) (antlr-downcase-literals, antlr-file-dependencies) (antlr-guess-tool-version, antlr-indent-line): Do not call deleted function, do not use deleted variables, use regexp \\_> instead \\>., use both \\s_ and \\sw. * antlr-mode.el: Minor changes. (antlr-action-face, antlr-symbol-face): New face. (antlr-token-identifier-p): New variable. (antlr-font-lock-late-keywords): Use it, use antlr-grammar-header-regexp, use new faces. (antlr-syntax-propertize-charsets): Ignore @actionscope::name when searching for lexer rules. (antlr-syntax-propertize-template-literals): Change handling if the template literal does not end before eob. (antlr-font-lock-keywords): Use font-lock-eval-keywords. (antlr-rule-postlude-skip-regexp): Allow scope name to begin with underscore. * antlr-mode.el: Make antlr-mode more modular - allow to add new target languages without changing existing code. (antlr-language-variables, antlr-language-mode-name) (antlr-java-language-mode-name, antlr-action-mode) (antlr-java-action-mode, antlr-init-cc-mode) (antlr-java-init-cc-mode, antlr-init-submode) (antlr-indent-action-line, antlr-action-font-lock-keywords) (antlr-java-action-font-lock-keywords, antlr-action-scope-names) (antlr-action-names, antlr-java-action-names): New variables. (antlr-c-language-mode-name, antlr-cpp-language-mode-name) (antlr-objc-language-mode-name, antlr-c-action-mode) (antlr-cpp-action-mode, antlr-objc-action-mode) (antlr-c-init-cc-mode, antlr-cpp-init-cc-mode) (antlr-obj-init-cc-mode, antlr-cpp-action-font-lock-keywords) (antlr-c-action-font-lock-keywords) (antlr-objc-action-font-lock-keywords) (antlr-js-language-mode-name, antlr-js-action-mode) (antlr-js-init-submode, antlr-js-action-font-lock-keywords) (antlr-js-indent-action-line, antlr-delphi-language-mode-name) (antlr-delphi-action-mode, antlr-delphi-init-submode) (antlr-delphi-action-font-lock-keywords) (antlr-delphi-indent-action-line, antlr-ruby-language-mode-name) (antlr-ruby-action-mode, antlr-ruby-init-submode) (antlr-ruby-action-font-lock-keywords) (antlr-ruby-indent-action-line, antlr-python-language-mode-name) (antlr-python-action-mode, antlr-python-action-font-lock-keywords) (antlr-python-indent-action-line, antlr-python-init-submode): New variables. (antlr-init-js, antlr-js-indent-action-line, antlr-init-delphi) (antlr-delphi-indent-action-line, antlr-init-ruby) (antlr-ruby-indent-action-line, antlr-init-python) (antlr-python-indent-action-line): New functions. (antlr-font-lock-keywords-alist): Remove variable. (antlr-guess-language): Rename from anlr-language-option, use antlr-language-list, use cl function. * antlr-mode.el: Make antlr-mode more modular - allow to add new ANTLR versions/flavors without changing existing code. (antlr-tool-version): Is a symbol now, default to nil = automatic. For backward compatibility, numbers between 20000 and 29999 are set to antlr-v2 in antlr-set-tool-version-and-mode-line. This variable should not be customized anymore - change :type spec. (antlr-tool-version-variables, antlr-tool-mode-name) (antlr-v4-tool-mode-name, antlr-v3-tool-mode-name) (antlr-v2-tool-mode-name, antlr-language-list) (antlr-v4-language-list, antlr-v3-language-list) (antlr-v2-language-list, antlr-syntax-propertize) (antlr-v4-syntax-propertize, antlr-v3-syntax-propertize) (antlr-v2-syntax-propertize, antlr-v2-options-alist) (antlr-v4-skip-line-regexp, antlr-v3-skip-line-regexp) (antlr-font-lock-symbol-regexp) (antlr-v4-font-lock-symbol-regexp) (antlr-v3-font-lock-symbol-regexp) (antlr-v4-grammar-header-regexp, antlr-v3-grammar-header-regexp) New variables. (antlr-options-alist): Make it tool-dependent. Remove sub-version specific settings for ANTLR v2. Remove function. (antlr-v2-grammar-header-regexp): Rename from antlr-class-header-regexp. (antlr-grammar-header-regexp): Make it tool-version dependent. (antlr-mode-menu, antlr-insert-option-interactive) (antlr-options-menu-filter, antlr-option-level) (antlr-insert-option-do): Use tool specific variable. (antlr-option-spec): ...and do not support sub versions. (antlr-guess-tool-version): Rename from antlr-tool-version. (antlr-set-local-variables): New function (antlr-set-tool-version-and-mode-line): Use them. * antlr-mode.el: Remove XEmacs and old Emacs compatibility code. (require): require cl-lib instead cl at compile time. (antlr-run-tool-interactive, antlr-insert-makefile-rules) (antlr-set-tabs, antlr-next-rule, antlr-downcase-literals) (antlr-file-dependencies): Use cl- prefix for cXXXr, cXXXXr, incf, decf, list*. (cond-emacs-xemacs, cond-emacs-xemacs-macfn, defunx) (ignore-errors-x, save-buffer-state-x): Delete functions/macros. (antlr-skip-sexps, antlr-hide-actions, antlr-option-kind): Adopt. (antlr-mode-menu): Do not test for Emacs below 21.0. (antlr-with-syntax-table): Delete, use with-syntax-table instead. (antlr-imenu-create-index-function, antlr-inside-rule-p) (antlr-end-of-rule, antlr-beginning-of-rule, antlr-end-of-body) (antlr-downcase-literals, antlr-hide-actions) (antlr-option-level, antlr-file-dependencies, antlr-indent-line) (antlr-electric-character, antlr-tool-version): Adopt. (antlr-default-directory): Delete function. Actually XEmacs' default-directory as a function is quite useful... (antlr-run-tool-interactive, antlr-insert-makefile-rules): Adopt. (antlr-read-shell-command): Delete, use read-shell-command. (antlr-run-tool-interactive): Adopt. (antlr-with-displaying-help-buffer): Delete. (antlr-show-makefile-rules): Use with-output-to-temp-buffer. (antlr-invalidate-context-cache) (antlr-syntactic-context): Remove XEmacs code. (antlr-end-of-rule, antlr-beginning-of-rule, antlr-end-of-body) (antlr-beginning-of-body): use interactive "^" for "_" in XEmacs. (antlr-mode): Do not consider cc-mode below 5.30. * antlr-mode.el: Scope references inside a v3 rule and import statements in a v4 grammar do not confuse the navigation anymore. (antlr-skip-line-regexp): New variable, contains regexp for v3 "scope" / v4 "import" up to the semicolon. (antlr-set-tool-version-and-mode-line): Set it. (antlr-search-result): New function. (antlr-search-forward, antlr-search-backward): Use it. Add extra regexp parameter for occurrences which should be skipped. (antlr-imenu-create-index-function, antlr-next-rule) (antlr-beginning-of-rule, antlr-indent-line): Provide `antlr-skip-line-regexp' when searching for ";". (antlr-rule-postlude-skip-alist): Make it a `defconst', re-compilation would use previous value. Add "import". (antlr-skip-rule-postlude): Allow function as SKIP. (antlr-skip-import-statement): New function for postlude skip. * antlr-mode.el: Correctly recognize ANTLR v4 lexer charsets, [...], and v3 templates, <<...>>, as literals. (antlr-syntax-propertize-wholerule) (antlr-syntax-propertize-charsets) (antlr-syntax-propertize-template-literals): New function (antlr-set-tool-version-and-mode-line): Use them. (antlr-imenu-create-index-function): Call `syntax-propertize'. * antlr-mode.el (antlr-end-of-defun-is-next): New option. If non-nil, both `antlr-end-of-rule' and `antlr-end-of-rule' jump to beginning of a rule with no or positive prefix arg, and to the end of a rule with negative prefix arg. Default nil means: `antlr-end-of-rule' jumps to beginning of a rule, `antlr-end-of-rule' jumps to end of a rule. (antlr-end-of-rule): Use it. (antlr-beginning-of-rule): Use it * antlr-mode.el: Options support for ANTLR v3 and v4. (antlr-v3-options-alists): Correct prompts. (antlr-v4-options-alists): New variable. (antlr-options-alists): Use it. (antlr-read-boolean): Use `y-or-n-p' without TABLE. (antlr-mode-menu): Do not include empty option menus. (antlr-option-level): Consider non-existent file/subrule options. Correctly recognize v3/v4 grammar definitions. * antlr-mode.el: Imenu and syntax-highlighting corrections. (antlr-font-lock-late-keywords): Correct syntax-highlighting of rule definitions with modifiers in same line. (antlr-grammar-header-regexp): New regexp for v3 and v4. (antlr-class-header-regexp): New function. (antlr-imenu-create-index-function): Also collect v4 scanner modes. Correctly scan fragment rules. * antlr-mode.el: Correctly skip the part of the rule which comes after the semicolon. To simplify things, consider v2 class preamble actions as belonging to the previous definition. (antlr-skip-file-prelude): Skip final ACTION. (antlr-rule-postlude-skip-alist) (antlr-rule-postlude-skip-regexp): New variables. (antlr-skip-rule-postlude): Use them. Rename from `antlr-skip-exception-part'. (antlr-beginning-of-body): Tool version-dependent error message. (antlr-options-alists): Consider v4 options. * antlr-mode.el (antlr-indent-line): For indentation cycling in Python, do not require a patched python.el anymore, but prog-mode.el and python.el from Emacs-24.5. Do not touch multi-line python actions which do not start in its own line - they are a bad idea anyway. * antlr-mode.el: Experimental indentation cycling for Python actions. Requires a patched python.el. Note: this patch is just a first proposal by me - things will change. (antlr-indent-line): Bind `python-submode-indentation-context' while calling `python-indent-line'. * antlr-mode.el: Use much less intrusive face settings, some minor font-lock changes. (antlr-syntax): Just inherit from `font-lock-keyword-face', face is now only used for AST-relevant operators (!, ^, ->), not parentheses, colons etc anymore - see below. (antlr-keyword): Just inherit from `font-lock-keyword-face'. (antlr-ruledef): Just inherit from `font-lock-function-name-face'. (antlr-tokendef): Just inherit from `font-lock-function-name-face'. (antlr-ruleref): Just inherit from `font-lock-type-face'. (antlr-tokenref): Just inherit from `font-lock-constant-face'. (antlr-attribute): Just inherit from `font-lock-preprocessor-face'. (antlr-literal): Just inherit from `font-lock-string-face' and specify :weight bold. (antlr-grammardef-face): Delete variable introduced in v3.0.2. (antlr-grammardef): Delete face, use `font-lock-type-face'. (antlr-font-lock-late-keywords): Change according to semantic change of `antlr-syntax', properly highlight scope definitions. (antlr-font-lock-additional-keywords): Change highlighting according to ANTLR change concerning grammar element labels, ANTLR v3/v4 only. Use `font-lock-negation-char-face' for ~, single dot. * antlr-mode.el: Be more robust / fix bug introduced with v3.0.5 - class definitions in ANTLR v2 grammars would look strange, makefile dependencies would not work even with ANTLR v2 grammars. (antlr-class-header-regexp): Revert accidentally change in regexp. (antlr-insert-makefile-rules): Be more robust against incomplete grammar files, i.e. those without any extracted dependency. * antlr-mode.el: Indentation for non-cc-based languages: JavaScript, Delphi, Ruby - Python actions are left as they are. (antlr-indent-line): For a line starting with the closing brace of bracket of an action / parameter section, use our own indentation engine, not that of the grammar language. (antlr-indent-line): Run indentation functions of `js-mode', `opascal-mode' and `ruby-mode' with buffer restriction starts after the opening brace/bracket. (antlr-indent-command): Preparation for future support for indentation cycling used by Python - do not insert a TAB with repeated call of this command. (antlr-set-tool-version-and-mode-line): Locally set indentation offsets/levels of grammar language according to offset used in the ANTLR grammar. * antlr-mode.el: Correct indentation of rule headers. (antlr-indent-line): When looking for the end of a rule header, do not stop at colon if that is followed by another one, because this the scope name of a preceeding grammar action. * antlr-mode.el: Support more action languages. (antlr-language-alist): Add entries for C, Delphi, JavaScript, ObjC, Python and Ruby, additional to Java and Cpp. (antlr-language-limit-n-regexp): Allow language name to contain digits. (antlr-font-lock-keywords-alist): Add font-lock specifications for the newly supported languages. (antlr-set-tool-version-and-mode-line): Handle non-cc-based languages, currently hard-coded. * antlr-mode.el: Preparation for non-cc-mode-based indentation. (antlr-indent-line): With non-cc-based languages, do not touch lines in braces and brackets, i.e. mainly actions. * antlr-mode.el: Bug fixes and minor changes. (antlr-indent-line): Introduced 3.0.4: lines starting with a colon would be incorrectly indented. (antlr-tool-version): v3 grammars with a class definition in a header action or containing a rule called "header" or "class" would be incorrectly categorized as v2 grammar. (antlr-set-tool-version-and-mode-line, antlr-mode): Set `indent-line-function' and friends after initializing cc-mode. (antlr-java-action-names): Renamed from `antlr-action-names', only include action names used with language Java. (antlr-font-lock-late-keywords): Check action names only in Java. * antlr-mode.el: Preparation for v3/v4 options support. (antlr-v3-options-alists): New variable. (antlr-options-alists): New function. (antlr-insert-option-interactive, antlr-options-menu-filter) (antlr-insert-option-do): Use it. (antlr-option-spec): Allow options-alist not to specify ANTLR subversions. * antlr-mode.el: More flexible tool invocation. (antlr-tool-path): New variable. (antlr-run-tool): Use it. (antlr-tool-command): Can now be a function. (antlr-run-tool-interactive): Change accordingly. * antlr-mode.el: Emacs-corrected and more flexible indentation. (antlr-syntactic-context): Bind `parse-sexp-ignore-comments' to t, parentheses inside comments would bring Emacs out of sync. (antlr-base-offset-alist): New user option. (antlr-indent-line): Use it. * antlr-mode.el: Delay language recognition and tab settings. (antlr-tool-version): Correctly recognize v2 grammars without header{...}. (antlr-set-tool-version-and-mode-line): Set language here. (antlr-mode): Do not set language here. * antlr-mode.el: Bug fixes. (antlr-language-limit-n-regexp): Also recognize 'LANG'. (antlr-imenu-create-index-function): in ANTLR v2 grammars, `which-function-mode' would not work, classes would not appear. (antlr-font-lock-checked-face): action names would not be highlighted, the doc string was inserted at the wrong place... * antlr-mode.el: Use "Antlr2"/"Antlr3"/"Antlr4" in mode line. (antlr-tool-version): Set default value to nil = automatic. (antlr-tool-version): New function. (antlr-set-tool-version-and-mode-line): New function. (antlr-after-body-hook): New variable. (antlr-mode): Run it as mode hook. (antlr-v4-mode): Do not update mode line anymore. * antlr-mode.el: Minor font-lock changes. (antlr-font-lock-literal-regexp): Also match strings surrounded by single quotes, and symbols and punctuation. (antlr-font-lock-late-keywords): Highlight regexp group 2 of that. * antlr-mode.el: Preparation for further v3 and v4 support. (antlr-v4-mode): New major mode for file suffix "g4". * antlr-mode.el: Adopt imenu and navigation to ANTLR v3 and v4. (antlr-imenu-create-index-function): Recognize fragment specification and named actions. (antlr-skip-exception-part): With v3 and v4, there is no 'exception' keyword, but an additional optional 'finally'. * antlr-mode.el: Adopt font-lock to ANTLR v3 and v4. (antlr-grammardef, antlr-attribute): New faces. (antlr-action-names, antlr-action-scope-names): New variables (antlr-font-lock-late-keywords): Recognize new elements. (antlr-font-lock-additional-keywords): Changed font-lock for $attr constructs. * antlr-mode.el: Newer cc-mode fontification is very eager, i.e. would overwrite that of antlr-mode. (antlr-font-lock-late-keywords): New variable, also using OVERRIDE in MATCH-HIGHLIGHT. (antlr-font-lock-keywords): Add at end of keywords. (antlr-font-lock-additional-keywords): Delete keywords here. * antlr-mode.el: Checked ANTLR up to latest v2. (antlr-tool-version): Set for ANTLR v2.7.7. (antlr-options-alists): Added options introduced with ANTLR v2.7.2, "classHeaderPrefix" and "noConstructors". * antlr-mode.el: redisplay during font-lock could signal "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned label". (antlr-font-lock-defaults): Do not set `beginning-of-defun'. * antlr-mode.el: Delete support for old cc-mode versions. (antlr-c-init-language-vars): Delete function. (antlr-mode): Do not call it anymore. (antlr-mode-syntax-table): Adopt docstring to changed init. * antlr-mode.el: imenu creation could signal "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned label". (antlr-slow-cache-diff-threshold): Delete variable. (antlr-syntactic-context): Do not use it here, do not call `beginning-of-defun' anymore. (antlr-mode): Allow /// etc as `comment-start-skip'. Still set `require-final-newline'. * antlr-mode.el (antlr-electric-character): With Emacs, use `last-command-event' instead `last-command-char'. * antlr-mode.el: imenu creation could signal "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned label". (antlr-slow-cache-diff-threshold): Deletia. (antlr-syntactic-context): Do not use it here, do not call `beginning-of-defun' anymore. diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 4f17dd77b2a..d68476d9a64 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -1,10 +1,10 @@ -;;; antlr-mode.el --- major mode for ANTLR grammar files -*- lexical-binding: t; -*- +;;; antlr-mode.el --- major mode for ANTLR grammar files -*- lexical-binding: t -*- ;; Copyright (C) 1999-2025 Free Software Foundation, Inc. ;; Author: Christoph Wedler ;; Keywords: languages, ANTLR, code generator -;; Version: 2.2c +;; Version: 3.2.0 ;; URL: https://antlr-mode.sourceforge.net/ ;; This file is part of GNU Emacs. @@ -27,58 +27,88 @@ ;; 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. +;; Emacs. It works for ANTLR v2, v3 and v4. ;; 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 . +;; lexers, parsers and tree transformers in Java, C++ or other languages and +;; can be found at . -;; Bug fixes, bug reports, improvements, and suggestions for the newest version -;; are strongly appreciated. - -;; To-do/Wish-list: +;; Topics for 3.2 or later: ;; -;; * 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 -;; all rules which use the current rule. With font-lock update. -;; * Next Version. Make hiding much more customizable. -;; * Planned [C-c C-j]. Jump to generated coding. -;; * 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: https://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html -;; * Probably. Make `indent-region' faster, especially in actions. ELP +;; * Special support for `indent-region': faster and better for Python 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: -;; this mode must not depend on a Sather mode. -;; * Unlikely. Faster syntax highlighting: sectionize the buffer into Antlr -;; and action code and run special highlighting functions on these regions. -;; Problems: code size, this mode would depend on font-lock internals. +;; Do not define a indent command, just a function to be put into +;; indent-line/region-function. +;; * In v4, highlight lexer commands after "->" +;; * Test: in `antlr-imenu-create-index-function', can we use +;; (or antlr-skip-line-regexp antlr-grammar-header-regexp) +;; * Use native menu bindings instead easymenu (and use :help) +;; * Support v4 rule element options +;; * Define minor mode for `antlr-hide-actions' functionality. +;; * [C-c C-u]. *Help* for current rule / all rules: used-By list (at least +;; for single-file grammars) +;; * [C-c C-j]. Jump to generated coding. + +;; Eventually: +;; +;; * Support for one of the multi-mode imenu extensions mentioned in +;; https://www.emacswiki.org/emacs-test/ImenuMode - if necessary +;; * [C-c C-w]. Produce HTML document with syntax highlighted and +;; hyper-links. With htmfontify: invisible actions did not really work +;; (only w/o spaces?, default invisible would be better anyway) - we need to +;; set tags afterwards ourselves... Firefox does not understand +;; encoding via XML declaration - use HTML meta tag. +;; * Support for outline-minor-mode. + +;; The following topics and suggestions are unlikely to be implemented: +;; +;; * Some constructs of languages (in actions) which are highly un-C-ish might +;; bring Emacs (and ANTLR!) out of sync: e.g. regexp literals in Perl, +;; character and percent literals in Ruby. +;; * Faster syntax highlighting: sectionize the buffer into Antlr and action +;; code and run special highlighting functions on these regions. UNLIKELY +;; due to: code size, this mode would depend on font-lock internals. +;; * Set the syntax-table of the inner mode before calling the indentation +;; engine of the inner mode (possible? - BUT: actions should still end at +;; the same place!). Probably not worth the effort. + +;; Bug fixes, bug reports, improvements, and suggestions for the newest version +;; are strongly appreciated. ;;; Installation: -;; If antlr-mode is not part of your distribution, put this file into your -;; load-path and the following into your init file: -;; (autoload 'antlr-mode "antlr-mode" nil t) -;; (setq auto-mode-alist (cons '("\\.g\\'" . antlr-mode) auto-mode-alist)) -;; (add-hook 'speedbar-load-hook ; would be too late in antlr-mode.el -;; (lambda () (speedbar-add-supported-extension ".g"))) +;; This file requires Emacs-24.3 or higher which already includes a version of +;; antlr-mode. If you want to use this (hopefully newer) version instead, put +;; this file into a directory early in `load-path' (or `push' a new one to it) +;; and M-x byte-compile-file this file file. + +;; If you want to use this mode with ANTLR v4 files, put the following into +;; your init file: +;; (autoload 'antlr-v4-mode "antlr-mode" nil t) +;; (push '("\\.g4\\'" . antlr-v4-mode) auto-mode-alist) ;; To customize, use menu item "Antlr" -> "Customize Antlr". -;;; Code: +;;; Development resources: + +;; Good examples for different action languages (for syntax coloring, ...), but +;; there are almost no examples with rule parameters and return values... -(eval-when-compile (require 'cl-lib)) +;; * examples-v3-master/Delphi: C/C.g, IslandGrammar/Simple.g, Python/Python.g +;; * examples-v3-master/JavaScript: island-grammar/Simple.g, python/Python.g +;; * examples-v3-master/Python: C/C.g, island-grammar/Simple.g, python/Python.g +;; * Ruby in antlr3-master/samples/standard: ../CPP.g, ../JavaScript.g, C/C.g, +;; python/Python.g +;; * grammars-v4-master/ +;;; Code: + +(eval-when-compile + (require 'cl-lib) + (require 'compile)) (when (< emacs-major-version 28) ; preloaded in Emacs 28 (require 'easymenu)) (require 'cc-mode) @@ -87,13 +117,6 @@ (defvar imenu-use-markers) (defvar imenu-create-index-function) -;; 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) @@ -109,10 +132,97 @@ :link '(url-link "https://antlr-mode.sourceforge.net/") :prefix "antlr-") -(defconst antlr-version "2.2c" +(defconst antlr-version "3.2.0" "ANTLR major mode version number. Check for the newest.") +(defcustom antlr-language-limit-n-regexp ; TODO: rename? (also for tool-version) + ;; actually, it is in v2 "L" only, in v3/v4 'L' only + '(30000 . "\\ for the newest.") (defvar antlr-language nil "Major mode corresponding to ANTLR's \"language\" option. -Set via `antlr-language-alist'. The only useful place to change this +Set via `antlr-language-list'. The only useful place to change this buffer-local variable yourself is in `antlr-mode-hook' or in the \"local variable list\" near the end of the file, see -`enable-local-variables'.") - -(defcustom antlr-language-alist - '((java-mode "Java" nil "\"Java\"" "Java") - (c++-mode "C++" "\"Cpp\"" "Cpp")) - "List of ANTLR's supported languages. +`enable-local-variables'. +The value is used to set other variables, see `antlr-language-variables'.") + +(defvar antlr-language-variables + '(antlr-language-mode-name + antlr-action-mode + &optional + antlr-init-cc-mode + antlr-init-submode + antlr-indent-action-line + antlr-action-font-lock-keywords + antlr-action-names) + "List of variables which have a language-dependent value. +For each antlr-VAR in this list, function `antlr-set-local-variables' +makes it buffer-local and uses the variable LANGUAGE-VAR, i.e., +antlr-java-VAR, antlr-cpp-VAR, and so on to set its value, +dependending on the value LANGUAGE of `antlr-language'. + +If that variable LANGUAGE-VAR does not exist, ignore antlr-VAR if it is +listed after the symbol &optional, or issue an error otherwise.") + +;; Languages other than Java are defined at the end -------------------------- + +(defvar antlr-language-mode-name "txt" + "The second part of the mode name used in the mode line. +The value is language-dependent, see `antlr-language-variables'.") + +(defvar antlr-java-language-mode-name "Java" + "Value for `antlr-language-mode-name' when using language `antlr-java'.") + +(defvar antlr-action-mode nil + "Major-mode for code in actions of the grammar. +The value is language-dependent, see `antlr-language-variables'.") + +(defvar antlr-java-action-mode 'java-mode + "Value for `antlr-action-mode' when using language `antlr-java'.") + +(defvar antlr-init-cc-mode 'java-mode + "Major-mode used to initialize the language variables of CC Mode. +Used as argument for `c-init-language-vars-for'. +The value is language-dependent, see `antlr-language-variables'.") + +(defvar antlr-java-init-cc-mode 'java-mode + "Value for `antlr-init-cc-mode' when using language `antlr-java'.") + +(defvar antlr-init-submode 'antlr-set-tabs + "Function used to initialize the action language. +Important for languages which do not depend on CC Mode. +The value is language-dependent, see `antlr-language-variables'.") + +(defcustom antlr-language-alist ; is obsolete now + nil + "List of ANTLR's supported languages. Variable is UNUSED. Each element in this list looks like (MAJOR-MODE MODELINE-STRING OPTION-VALUE...) @@ -137,21 +294,7 @@ value of `antlr-language' if the first group in the string matched by REGEXP in `antlr-language-limit-n-regexp' is one of the OPTION-VALUEs. An OPTION-VALUE of nil denotes the fallback element. MODELINE-STRING is also displayed in the mode line next to \"Antlr\"." - :type '(repeat (group :value (java-mode "") - (function :tag "Major mode") - (string :tag "Mode line string") - (repeat :tag "ANTLR language option" :inline t - (choice (const :tag "Default" nil) - string ))))) - -(defcustom antlr-language-limit-n-regexp - '(8192 . "language[ \t]*=[ \t]*\\(\"?[A-Z][A-Za-z_]*\"?\\)") - "Used to set a reasonable value for `antlr-language'. -Looks like \(LIMIT . REGEXP). Search for REGEXP from the beginning of -the buffer to LIMIT and use the first group in the matched string to set -the language according to `antlr-language-alist'." - :type '(cons (choice :tag "Limit" (const :tag "No" nil) (integer :value 0)) - regexp)) + :type '(sexp :tag "DO NOT CUSTOMIZE" :value nil)) ;;;=========================================================================== @@ -175,7 +318,7 @@ they are only changed by \\[antlr-indent-command]." (const :tag "Always" t) (sexp :tag "With TAB" :format "%t" :value tab))) -(defcustom antlr-tab-offset-alist +(defcustom antlr-tab-offset-alist ; TODO: still advertise? '((antlr-mode nil 4 nil) (java-mode "antlr" 4 nil)) "Alist to determine whether to use ANTLR's convention for TABs. @@ -197,26 +340,59 @@ See `c-set-style' and for details, where the most interesting part in `c-style-alist' is the value of `c-basic-offset'." :type '(choice (const nil) regexp)) +(defvar antlr-base-offset-alist ; TODO: make a defcustom? + '((:header . 0) (:body . 2) (:exception . 1)) + "Influence the rule indentation of `antlr-indent-line'. +The default 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 POS-SYMBOL inside the rule: + :header, :body, :exception part, customized by this variable. + - minus 1 if `antlr-indent-item-regexp' matches the beginning of the + line starting from the first non-whitespace. + +Each element in this list is an element (POS-SYMBOL . OFFSET). +The following POS-SYMBOL can be: + - `:header', the rule header before `antlr-rule-body-start-op', + - `:colon' for `antlr-rule-body-start-op', the character starting + the rule body, + - `:body`, the rule body starting at `antlr-rule-body-start-op' + and ending with ';' + - `:exception', the part of the rule after the ';', see function + `antlr-skip-rule-postlude'. + +`:header', `:body` and `:exception' must appear in the alist, +`:colon' is optional and its OFFSET defaults to the one from `:body`.") + (defcustom antlr-indent-item-regexp - "[]}):;|&]" ; & 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]." :type 'regexp) -(defcustom antlr-indent-at-bol-alist +(defcustom antlr-indent-at-bol-alist ; TODO: make this pure custom option (define language-dependent vars as defaults) ;; eval-when-compile not usable with defcustom... - '((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\\)\\>")) + '((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\\)\\_>") + (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, the line starting at the first -non-whitespace is matched by the corresponding REGEXP, and the line is -part of a header action, indent the line at column 0 instead according -to the normal rules of `antlr-indent-line'." +If the value of `antlr-action-mode' equals to a MODE, the line starting +at the first non-whitespace is matched by the corresponding REGEXP, and +the line is part of a header action, indent the line at column 0 instead +of according to the normal rules of `antlr-indent-line'." :type '(repeat (cons (function :tag "Major mode") regexp))) +(defvar antlr-indent-action-line nil + ;; TODO: better call it with action start? + "Function which indents the current line in actions. +The function is called with the character address of the '{' starting +the action. +If nil, use CC mode to indent the line. +The value might be language-dependent, see `antlr-language-variables'.") + ;; adopt indentation to cc-engine (defvar antlr-disabling-cc-syntactic-symbols '(statement-block-intro @@ -224,30 +400,30 @@ to the normal rules of `antlr-indent-line'." 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)) + inline-close extern-lang-close namespace-close) + "CC Mode syntactic context symbols adopting the indentation by CC Mode.") ;;;=========================================================================== ;;; Options: customization ;;;=========================================================================== +(defcustom antlr-end-of-defun-is-next nil + "Non-nil, if rule movement commands normally jump to beginning of rule. +If non-nil, both `antlr-end-of-rule' and `antlr-end-of-rule' jump +to beginning of a rule with no or positive prefix arg, and to the +end of a rule with negative prefix arg. + +Default nil means: `antlr-end-of-rule' jumps to beginning of a +rule, `antlr-end-of-rule' jumps to end of a rule." + :type 'boolean) + (defcustom antlr-options-use-submenus t "Non-nil, if the major mode menu should include option submenus. If nil, the menu just includes a command to insert options. Otherwise, it includes four submenus to insert file/grammar/rule/subrule options." :type 'boolean) -(defcustom antlr-tool-version 20701 - "The version number of the Antlr tool. -The value is an integer of the form XYYZZ which stands for vX.YY.ZZ. -This variable is used to warn about non-supported options and to supply -version correct option values when using \\[antlr-insert-option]. - -Don't use a number smaller than 20600 since the stored history of -Antlr's options starts with v2.06.00, see `antlr-options-alists'. You -can make this variable buffer-local." - :type 'integer) - (defcustom antlr-options-auto-colon t "Non-nil, if `:' is inserted with a rule or subrule options section. A `:' is only inserted if this value is non-nil, if a rule or subrule @@ -256,14 +432,8 @@ subrule options section before, and if a `:' is not already present after the section, ignoring whitespace, comments and the init action." :type 'boolean) -(defcustom antlr-options-style nil - "List of symbols which determine the style of option values. -If a style symbol is present, the corresponding option value is put into -quotes, i.e., represented as a string, otherwise it is represented as an -identifier. - -The only style symbol used in the default value of `antlr-options-alist' -is `language-as-string'. See also `antlr-read-value'." +(defcustom antlr-options-style nil ; TODO: obsolete + "Obsolete user option." :type '(repeat (symbol :tag "Style symbol"))) (defcustom antlr-options-push-mark t @@ -296,178 +466,311 @@ existing `=' won't be changed when changing an option value." The standard value is (\"file\" \"grammar\" \"rule\" \"subrule\"). See `antlr-options-alists'") -(defvar antlr-options-alists +(defvar antlr-options-alists nil + ;; TODO: distinguish between "no known option" (options{} is allowed), and + ;; does not exist (file options in v3 and v4) + "Definitions for Antlr's options of all four different kinds. + +The value looks like \(FILE GRAMMAR RULE SUBRULE) where each FILE, +GRAMMAR, RULE, and SUBRULE is a list of option definitions of the +corresponding kind, i.e., looks like \(OPTION-DEF...). + +Each OPTION-DEF looks like \(OPTION-NAME EXTRA-FN VALUE-SPEC...) which +defines a file/grammar/rule/subrule option with name OPTION-NAME. The +OPTION-NAMEs are used for the creation of the \"Insert XXX Option\" +submenus, see `antlr-options-use-submenus', and to allow the insertion +of the option name with completion when using \\[antlr-insert-option]. + +If EXTRA-FN is a function, it is called at different phases of the +insertion with arguments \(PHASE OPTION-NAME). PHASE can have the +values `before-input' or `after-insertion', additional phases might be +defined in future versions of this mode. The phase `before-input' +occurs before the user is asked to insert a value. The phase +`after-insertion' occurs after the option value has been inserted. +EXTRA-FN might be called with additional arguments in future versions of +this mode. + +Each specification VALUE-SPEC looks like \(VERSION READ-FN ARG...). The +last VALUE-SPEC in an OPTION-DEF whose VERSION is smaller or equal to +`antlr-tool-version' specifies how the user is asked for the value of +the option. + +If READ-FN is nil, the only ARG is a string which is printed at the echo +area to guide the user what to insert at point. Otherwise, READ-FN is +called with arguments \(INIT-VALUE ARG...) to get the new value of the +option. INIT-VALUE is the old value of the option or nil. + +The standard value contains the following functions as READ-FN: +`antlr-read-value' with ARGs = \(PROMPT AS-STRING TABLE) which reads a +general value, or `antlr-read-boolean' with ARGs = \(PROMPT TABLE) which +reads a boolean value or a member of TABLE. PROMPT is the prompt when +asking for a new value. If non-nil, TABLE is a table for completion or +a function evaluating to such a table. The return value is quoted if +AS-STRING is non-nil. + +The value is tool-dependent, see `antlr-tool-version-variables'.") + +(defvar antlr-v4-options-alists + ;; see https://github.com/antlr/antlr4 - doc/options.md + '(() ; no file options + (;; grammar options ------------------------------------------------------ + ("language" + ;; The target language for code generation. Default is Java. See Code + ;; Generation Targets for list of currently supported target languages. + antlr-language-option-extra antlr-read-language "Generated language: ") + ("tokenVocab" + ;; Where ANTLR should get predefined tokens and token types. Tree + ;; grammars need it to get the token types from the parser that creates + ;; its trees. Default value: Do not import token vocab. + nil antlr-read-value "Token vocabulary: ") + ("TokenLabelType" ; parser and tree only + ;; Set the type of all tree labels and tree-valued expressions. Without + ;; this option, trees are of type Object. TODO: Cross-reference default + ;; impl (org.antlr.runtime.tree.CommonTree in Java)? + nil antlr-read-value "Token type: ") + ("superClass" ; in combined grammar: for parser + ;; Set the superclass of the generated recognizer. Default value + ;; Lexer/Parser/TreeParser (org.antlr.runtime.Parser in Java)? + nil antlr-read-value "Super class: ") + ("contextSuperClass" + nil antlr-read-value "Rule context super class: ") + ("exportMacro" ; doc/cpp-target.md + antlr-c++-mode-extra antlr-read-value "Export macro: ")) + nil ; no rule option yet + nil ; no subrule options + ;; use ??, *?, +? for non-greedy subrules + ;; (but there are some greedy options in grammars-v4-master/...) + ;; rule element options in v4 are actually different (and have a different + ;; syntax): - not yet supported + ;; after op: + ;; after sempred: + ) + "Value for `antlr-options-alists' when using ANTLR v4.") + +;;; v3: +;; https://theantlrguy.atlassian.net/wiki/display/ANTLR3/ANTLR+3+Wiki+Home + +;; $ANTLR3/tool/src/main/java/org/antlr/tool/Grammar.java +;; https://theantlrguy.atlassian.net/wiki/display/ANTLR3/Grammar+options +;; https://theantlrguy.atlassian.net/wiki/display/ANTLR3/Rule+and+subrule+options +(defvar antlr-v3-options-alists + '(() ; no file options + (;; grammar options ------------------------------------------------------ + ("language" + ;; The target language for code generation. Default is Java. See Code + ;; Generation Targets for list of currently supported target languages. + antlr-language-option-extra antlr-read-language "Generated language: ") + ("tokenVocab" + ;; Where ANTLR should get predefined tokens and token types. Tree + ;; grammars need it to get the token types from the parser that creates + ;; its trees. Default value: Do not import token vocab. + nil antlr-read-value "Token vocabulary: ") + ("output" ; parser and tree only + ;; The type of output the generated parser should return. Valid values + ;; are AST and template. TODO: Briefly, what are the interpretations of + ;; these values? Default value: nothing + nil antlr-read-value "Output type (AST or template): ") ; TODO: completion + ("TokenLabelType" ; parser and tree only + ;; Set the type of all tree labels and tree-valued expressions. Without + ;; this option, trees are of type Object. TODO: Cross-reference default + ;; impl (org.antlr.runtime.tree.CommonTree in Java)? + nil antlr-read-value "Token type: ") + ("superClass" ; in combined grammar: for parser + ;; Set the superclass of the generated recognizer. Default value + ;; Lexer/Parser/TreeParser (org.antlr.runtime.Parser in Java)? + nil antlr-read-value "Super class: ") + ("filter" ; lexer only + ;; In the lexer, this allows you to try a list of lexer rules in + ;; order. The first one that matches, wins. This is the token that + ;; nextToken() returns. If nothing matches, the lexer consumes a single + ;; character and tries the list of rules again. See Lexical filters for + ;; more., Default: false + nil antlr-read-boolean "Lexical filter? ") + ("rewrite" ; parser and tree only + ;; Valid values are true and false. Default is false. Use this option + ;; when your translator output looks very much like the input. Your + ;; actions can modify the TokenRewriteStream to insert, delete, or + ;; replace ranges of tokens with another object. Used in conjunction with + ;; output=template, you can very easily build translators that tweak + ;; input files. + nil antlr-read-value "Template rewrite: ") + ("k" ; parser and tree only + ;; Limit the lookahead depth for the recognizer to at most k + ;; symbols. This prevents the decision from using acyclic LL* DFA. + nil antlr-read-value "Lookahead depth: ") + ("backtrack" ; parser and tree only + ;; Valid values are true and false. Default is false. Taken from + ;; http://www.antlr.org:8080/pipermail/antlr-interest/2006-July/016818.html + ;; : The new feature (a big one) is the backtrack=true option for + ;; grammar, rule, and block that lets you type in any old crap and ANTLR + ;; will backtrack if it can't figure out what you meant. No errors are + ;; reported by antlr during analysis. It implicitly adds a syn pred in + ;; front of every production, using them only if static grammar LL* + ;; analysis fails. Syn pred code is not generated if the pred is not used + ;; in a decision. This is essentially a rapid prototyping mode. It is + ;; what I have used on the java.g. Oh, it doesn't memoize partial parses + ;; (i.e. rule parsing results) during backtracking automatically now. You + ;; must also say memoize=true. Can make a HUGE difference to turn on. + nil antlr-read-boolean "Use automatic backtracking if necessary? ") + ("memoize" ; parser and tree only + ;; Valid values are true and false. When backtracking, remember whether + ;; or not rule references succeed so that the same input position cannot + ;; be parsed more than once by the same rule. This effectively guarantees + ;; linear parsing when backtracking at the cost of more memory. TODO: + ;; Default value: false + nil antlr-read-boolean "Store backtracking calculations? ")) + (;; rule options --------------------------------------------------------- + ("backtrack" + nil antlr-read-boolean "Use automatic backtracking if necessary? ") + ("memoize" + nil antlr-read-boolean "Store backtracking calculations? ")) + (;; subrule options ------------------------------------------------------ + ("k" + nil antlr-read-value "Lookahead depth: ") + ("greedy" ; default true + nil antlr-read-boolean "Make this optional/loop subrule greedy? "))) + "Value for `antlr-options-alists' when using ANTLR v3.") + +(defvar antlr-v2-options-alists '(;; file options ---------------------------------------------------------- - (("language" antlr-language-option-extra - (20600 antlr-read-value - "Generated language: " language-as-string - (("Java") ("Cpp") ("HTML") ("Diagnostic"))) - (20700 antlr-read-value - "Generated language: " language-as-string - (("Java") ("Cpp") ("HTML") ("Diagnostic") ("Sather")))) + (("language" + antlr-language-option-extra antlr-read-language "Generated language: ") ("mangleLiteralPrefix" nil - (20600 antlr-read-value - "Prefix for literals (default LITERAL_): " t)) + antlr-read-value "Prefix for literals (default LITERAL_): " t) ("namespace" antlr-c++-mode-extra - (20700 antlr-read-value - "Wrap generated C++ code in namespace: " t)) + antlr-read-value "Wrap generated C++ code in namespace: " t) ("namespaceStd" antlr-c++-mode-extra - (20701 antlr-read-value - "Replace ANTLR_USE_NAMESPACE(std) by: " t)) + antlr-read-value "Replace ANTLR_USE_NAMESPACE(std) by: " t) ("namespaceAntlr" antlr-c++-mode-extra - (20701 antlr-read-value - "Replace ANTLR_USE_NAMESPACE(antlr) by: " t)) + antlr-read-value "Replace ANTLR_USE_NAMESPACE(antlr) by: " t) ("genHashLines" antlr-c++-mode-extra - (20701 antlr-read-boolean - "Include #line in generated C++ code? ")) + antlr-read-boolean "Include #line in generated C++ code? ") + ("noConstructors" antlr-c++-mode-extra ; lexer only + antlr-read-boolean "Omit default constructors for generated classes? ") ) ;; grammar options -------------------------------------------------------- (("k" nil - (20600 antlr-read-value - "Lookahead depth: ")) + antlr-read-value "Lookahead depth: ") ("importVocab" nil - (20600 antlr-read-value - "Import vocabulary: ")) - ("exportVocab" nil - (20600 antlr-read-value - "Export vocabulary: ")) + antlr-read-value "Import vocabulary: ") + ("exportVocab" nil antlr-read-value + "Export vocabulary: ") ("testLiterals" nil ; lexer only - (20600 antlr-read-boolean - "Test each token against literals table? ")) + antlr-read-boolean "Test each token against literals table? ") ("defaultErrorHandler" nil ; not for lexer - (20600 antlr-read-boolean - "Generate default exception handler for each rule? ")) + antlr-read-boolean "Generate default exception handler for each rule? ") ("codeGenMakeSwitchThreshold" nil - (20600 antlr-read-value - "Min number of alternatives for `switch': ")) + antlr-read-value "Min number of alternatives for `switch': ") ("codeGenBitsetTestThreshold" nil - (20600 antlr-read-value - "Min size of lookahead set for bitset test: ")) + antlr-read-value "Min size of lookahead set for bitset test: ") ("analyzerDebug" nil - (20600 antlr-read-boolean - "Display debugging info during grammar analysis? ")) + antlr-read-boolean "Display debugging info during grammar analysis? ") ("codeGenDebug" nil - (20600 antlr-read-boolean - "Display debugging info during code generation? ")) + antlr-read-boolean "Display debugging info during code generation? ") ("buildAST" nil ; not for lexer - (20600 antlr-read-boolean - "Use automatic AST construction/transformation? ")) + antlr-read-boolean "Use automatic AST construction/transformation? ") ("ASTLabelType" nil ; not for lexer - (20600 antlr-read-value - "Class of user-defined AST node: " t)) + antlr-read-value "Class of user-defined AST node: " t) ("charVocabulary" nil ; lexer only - (20600 nil - "Insert character vocabulary")) + nil "Insert character vocabulary") ("interactive" nil - (20600 antlr-read-boolean - "Generate interactive lexer/parser? ")) + antlr-read-boolean "Generate interactive lexer/parser? ") ("caseSensitive" nil ; lexer only - (20600 antlr-read-boolean - "Case significant when matching characters? ")) + antlr-read-boolean "Case significant when matching characters? ") ("caseSensitiveLiterals" nil ; lexer only - (20600 antlr-read-boolean - "Case significant when testing literals table? ")) + antlr-read-boolean "Case significant when testing literals table? ") + ("classHeaderPrefix" nil + nil "Initial String for grammar class definition") ("classHeaderSuffix" nil - (20600 nil - "Additional string for grammar class definition")) + nil "Additional string for grammar class definition") ("filter" nil ; lexer only - (20600 antlr-read-boolean - "Skip rule (the name, true or false): " - antlr-grammar-tokens)) + antlr-read-boolean "Skip rule (the name, true or false): " + antlr-grammar-tokens) ("namespace" antlr-c++-mode-extra - (20700 antlr-read-value - "Wrap generated C++ code for grammar in namespace: " t)) + antlr-read-value "Wrap generated C++ code for grammar in namespace: " t) ("namespaceStd" antlr-c++-mode-extra - (20701 antlr-read-value - "Replace ANTLR_USE_NAMESPACE(std) by: " t)) + antlr-read-value "Replace ANTLR_USE_NAMESPACE(std) by: " t) ("namespaceAntlr" antlr-c++-mode-extra - (20701 antlr-read-value - "Replace ANTLR_USE_NAMESPACE(antlr) by: " t)) + antlr-read-value "Replace ANTLR_USE_NAMESPACE(antlr) by: " t) ("genHashLines" antlr-c++-mode-extra - (20701 antlr-read-boolean - "Include #line in generated C++ code? ")) -;;; ("autoTokenDef" nil ; parser only -;;; (80000 antlr-read-boolean ; default: true -;;; "Automatically define referenced token? ")) -;;; ("keywordsMeltTo" nil ; parser only -;;; (80000 antlr-read-value -;;; "Change non-matching keywords to token type: ")) + antlr-read-boolean "Include #line in generated C++ code? ") + ("noConstructors" antlr-c++-mode-extra ; lexer only + antlr-read-boolean "Omit default constructors for generated classes? ") ) ;; rule options ---------------------------------------------------------- (("testLiterals" nil ; lexer only - (20600 antlr-read-boolean - "Test this token against literals table? ")) + antlr-read-boolean "Test this token against literals table? ") ("defaultErrorHandler" nil ; not for lexer - (20600 antlr-read-boolean - "Generate default exception handler for this rule? ")) + antlr-read-boolean "Generate default exception handler for this rule? ") ("ignore" nil ; lexer only - (20600 antlr-read-value - "In this rule, ignore tokens of type: " nil - antlr-grammar-tokens)) + antlr-read-value "In this rule, ignore tokens of type: " nil + antlr-grammar-tokens) ("paraphrase" nil ; lexer only - (20600 antlr-read-value - "In messages, replace name of this token by: " t)) + antlr-read-value "In messages, replace name of this token by: " t) ) ;; subrule options ------------------------------------------------------- (("warnWhenFollowAmbig" nil - (20600 antlr-read-boolean - "Display warnings for ambiguities with FOLLOW? ")) + antlr-read-boolean "Display warnings for ambiguities with FOLLOW? ") ("generateAmbigWarnings" nil - (20600 antlr-read-boolean - "Display warnings for ambiguities? ")) + antlr-read-boolean "Display warnings for ambiguities? ") ("greedy" nil - (20700 antlr-read-boolean - "Make this optional/loop subrule greedy? ")) + antlr-read-boolean "Make this optional/loop subrule greedy? ") )) - "Definitions for Antlr's options of all four different kinds. + "Value for `antlr-options-alist' when using ANTLR v2.") -The value looks like \(FILE GRAMMAR RULE SUBRULE) where each FILE, -GRAMMAR, RULE, and SUBRULE is a list of option definitions of the -corresponding kind, i.e., looks like \(OPTION-DEF...). -Each OPTION-DEF looks like \(OPTION-NAME EXTRA-FN VALUE-SPEC...) which -defines a file/grammar/rule/subrule option with name OPTION-NAME. The -OPTION-NAMEs are used for the creation of the \"Insert XXX Option\" -submenus, see `antlr-options-use-submenus', and to allow the insertion -of the option name with completion when using \\[antlr-insert-option]. +;;;=========================================================================== +;;; Run tool +;;;=========================================================================== -If EXTRA-FN is a function, it is called at different phases of the -insertion with arguments \(PHASE OPTION-NAME). PHASE can have the -values `before-input' or `after-insertion', additional phases might be -defined in future versions of this mode. The phase `before-input' -occurs before the user is asked to insert a value. The phase -`after-insertion' occurs after the option value has been inserted. -EXTRA-FN might be called with additional arguments in future versions of -this mode. +(defvar antlr-tool-path nil ; TODO: make it a defcustom? + "Extra settings for environment variables $PATH and $LD_LIBRARY_PATH.") -Each specification VALUE-SPEC looks like \(VERSION READ-FN ARG...). The -last VALUE-SPEC in an OPTION-DEF whose VERSION is smaller or equal to -`antlr-tool-version' specifies how the user is asked for the value of -the option. +(defvar antlr-compilation-mode nil + "Mode used for compile output of \\[antlr-run-tool].") -If READ-FN is nil, the only ARG is a string which is printed at the echo -area to guide the user what to insert at point. Otherwise, READ-FN is -called with arguments \(INIT-VALUE ARG...) to get the new value of the -option. INIT-VALUE is the old value of the option or nil. +(defvar antlr-compilation-error-regexp-alist nil + "If non-nil, used instead `compilation-error-regexp-alist'`. +The value might be tool-dependent, see `antlr-tool-version-variables'.") -The standard value contains the following functions as READ-FN: -`antlr-read-value' with ARGs = \(PROMPT AS-STRING TABLE) which reads a -general value, or `antlr-read-boolean' with ARGs = \(PROMPT TABLE) which -reads a boolean value or a member of TABLE. PROMPT is the prompt when -asking for a new value. If non-nil, TABLE is a table for completion or -a function evaluating to such a table. The return value is quoted if -AS-STRING is non-nil and is either t or a symbol which is a member of -`antlr-options-style'.") +(defvar antlr-v4-compilation-error-regexp-alist + '(("\\(?:[eE]rror\\|\\([wW]arning\\)\\)[ \t]*([0-9]+):[ \t]*\ +\\([^\n:]+\\):\\([0-9]+\\):\\([0-9]+\\)" 2 3 4 (1)) + gnu) + "Value for `antlr-compilation-error-regexp-alist' when using ANTLR v4.") +(defcustom antlr-run-tool-on-buffer-file t ; was nil before 3.2.0 + "Non-nil, if \\[antlr-run-tool] runs on the file for the current buffer. +If nil, the provided tool command must include the file name." + :type 'boolean) -;;;=========================================================================== -;;; Run tool, create Makefile dependencies -;;;=========================================================================== +(defcustom antlr-tool-command nil + "Command used in \\[antlr-run-tool] to run the Antlr tool. +This variable should include all options passed to Antlr except the +option \"-glib\" which is automatically suggested if necessary. + +OBSOLETE as user option - customize version dependent user options." + :type 'string) + +(defcustom antlr-v4-tool-command "java org.antlr.v4.Tool" + ;; you probably also need to add s/th like + ;; "-cp /usr/local/lib/antlr-4.6-complete.jar" to the string + "Command used in \\[antlr-run-tool] to run the Antlr tool. +This variable should include all options passed to Antlr. +Value for `antlr-tool-command' when using ANTLR v4." + :type 'string) + +(defcustom antlr-v3-tool-command "java org.antlr.Tool" + "Command used in \\[antlr-run-tool] to run the Antlr tool. +This variable should include all options passed to Antlr. +Value for `antlr-tool-command' when using ANTLR v3." + :type 'string) -(defcustom antlr-tool-command "java antlr.Tool" +(defcustom antlr-v2-tool-command "java antlr.Tool" "Command used in \\[antlr-run-tool] to run the Antlr tool. This variable should include all options passed to Antlr except the -option \"-glib\" which is automatically suggested if necessary." +option \"-glib\" which is automatically suggested if necessary. +Value for `antlr-tool-command' when using ANTLR v2." :type 'string) (defcustom antlr-ask-about-save t @@ -475,9 +778,18 @@ option \"-glib\" which is automatically suggested if necessary." Otherwise, it saves all modified buffers before running without asking." :type 'boolean) + +;;;=========================================================================== +;;; Makefile creation (ANTLR v2 only) +;;;=========================================================================== + +;; TODO: make it a variable only (no `defcustom') (defcustom antlr-makefile-specification '("\n" ("GENS" "GENS%d" " \\\n\t") "$(ANTLR)") "Variable to specify the appearance of the generated makefile rules. +This variable is only used or ANTLR v2 grammars. For v3 and v4 +grammars, run the ANTLR tool with option \"--depend\". + This variable influences the output of \\[antlr-show-makefile-rules]. It looks like \(RULE-SEP GEN-VAR-SPEC COMMAND). @@ -507,6 +819,8 @@ COUNT starts with 1. GEN-SEP is used to separate long variable values." '((java-mode ("%sTokenTypes.java") ("%s.java")) (c++-mode ("%sTokenTypes.hpp") ("%s.cpp" "%s.hpp"))) "Language dependent formats which specify generated files. +This variable is only used or ANTLR v2 grammars. + Each element in this list looks like (MAJOR-MODE (VOCAB-FILE-FORMAT...) (CLASS-FILE-FORMAT...)). @@ -521,6 +835,8 @@ CLASS/%s the generated file for each grammar class CLASS.") (defvar antlr-special-file-formats '("%sTokenTypes.txt" "expanded%s.g") "Language independent formats which specify generated files. +This variable is only used or ANTLR v2 grammars. + The value looks like \(VOCAB-FILE-FORMAT EXPANDED-GRAMMAR-FORMAT). VOCAB-FILE-FORMAT is a format string, it specifies with substitution @@ -535,6 +851,8 @@ formats.") (defvar antlr-unknown-file-formats '("?%s?.g" "?%s?") "Formats which specify the names of unknown files. +This variable is only used or ANTLR v2 grammars. + The value looks like \(SUPER-GRAMMAR-FILE-FORMAT SUPER-EVOCAB-FORMAT). SUPER-GRAMMAR-FORMAT is a format string, it specifies with substitution @@ -551,6 +869,8 @@ of above mentioned class SUPER.") ## the current directory or is defined more than once. Please replace ## these filenames by the grammar files (and their exportVocab).\n\n" "String indicating the existence of unknown files in the Makefile. +This variable is only used or ANTLR v2 grammars. + See \\[antlr-show-makefile-rules] and `antlr-unknown-file-formats'.") (defvar antlr-help-rules-intro @@ -560,6 +880,8 @@ They are stored in the kill-ring, i.e., you can insert them with C-y into your Makefile. You can also invoke \\[antlr-show-makefile-rules] from within a Makefile to insert them directly.\n\n\n" "Introduction to use with \\[antlr-show-makefile-rules]. +This variable is only used or ANTLR v2 grammars. + It is a format string and used with substitution DIRECTORY/%s where DIRECTORY is the name of the current directory.") @@ -568,10 +890,11 @@ DIRECTORY is the name of the current directory.") ;;; Menu ;;;=========================================================================== -(defcustom antlr-imenu-name t ; (featurep 'xemacs) ; TODO: Emacs-21 bug? +(defcustom antlr-imenu-name t "Non-nil, if a \"Index\" menu should be added to the menubar. If it is a string, it is used instead \"Index\". Requires package -imenu." +imenu. For sorted menu entries, customize variable +`imenu-sort-function'." :type '(choice (const :tag "No menu" nil) (const :tag "Index menu" t) (string :tag "Other menu name"))) @@ -584,8 +907,9 @@ imenu." (define-key map "\C-c\C-a" 'antlr-beginning-of-body) (define-key map "\C-c\C-e" 'antlr-end-of-body) (define-key map "\C-c\C-f" 'subword-forward) - (define-key map "\C-c\C-b" 'c-backward-into-nomenclature) + (define-key map "\C-c\C-b" 'subword-backward) (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-k" 'antlr-insert-keyword-rule) (define-key map "\C-c\C-v" 'antlr-hide-actions) (define-key map "\C-c\C-r" 'antlr-run-tool) (define-key map "\C-c\C-o" 'antlr-insert-option) @@ -609,12 +933,16 @@ imenu." `("Antlr" ,@(if antlr-options-use-submenus `(("Insert File Option" + :visible (elt antlr-options-alists 0) :filter ,(lambda (x) (antlr-options-menu-filter 1 x))) ("Insert Grammar Option" + :visible (elt antlr-options-alists 1) :filter ,(lambda (x) (antlr-options-menu-filter 2 x))) ("Insert Rule Option" + :visible (elt antlr-options-alists 2) :filter ,(lambda (x) (antlr-options-menu-filter 3 x))) ("Insert Subrule Option" + :visible (elt antlr-options-alists 3) :filter ,(lambda (x) (antlr-options-menu-filter 4 x))) "---") '(["Insert Option" antlr-insert-option @@ -629,8 +957,8 @@ imenu." "---" ["Backward Statement" c-beginning-of-statement t] ["Forward Statement" c-end-of-statement t] - ["Backward Into Nomencl." c-backward-into-nomenclature t] - ["Forward Into Nomencl." subword-forward t]) + ["Backward Subword" subword-forward t] + ["Forward Subword" subword-backward t]) ["Indent Region" indent-region :active (and (not buffer-read-only) (c-region-is-active-p))] ["Comment Out Region" comment-region @@ -644,26 +972,177 @@ imenu." ["Unhide All Actions" (antlr-hide-actions 0) t] "---" ["Run Tool on Grammar" antlr-run-tool t] - ["Show Makefile Rules" antlr-show-makefile-rules t] + ["Show Makefile Rules" antlr-show-makefile-rules (eq antlr-tool-version 'antlr-v2)] "---" ["Customize Antlr" (customize-group 'antlr) t])) ;;;=========================================================================== -;;; font-lock +;;; basic syntax +;;;=========================================================================== + +(defvar antlr-syntax-propertize nil + "Specification used to apply ‘syntax-table’ text properties. +When non-nil, the value looks like \(MAIN EXTEND-REGION MULTILINE-CHAR). + +MAIN is used as value for `syntax-propertize-function'. + +EXTEND-REGION is for `syntax-propertize-extend-region-functions'; +it is appended to the existing value if it is a function, or +replaces the value otherwise, t leaves the value untouched. + +MULTILINE-CHAR is for `c-multiline-string-start-char' if non-nil; +if that variable already has a non-nil value, it is set to t. + +The value is tool-dependent, see `antlr-tool-version-variables'.") + +(defvar antlr-v4-syntax-propertize + '(antlr-syntax-propertize-charsets (antlr-syntax-propertize-wholerule)) + "Value for `antlr-syntax-propertize' when using ANTLR v4.") + +(defvar antlr-v3-syntax-propertize + '(antlr-syntax-propertize-template-literals syntax-propertize-multiline ?<) + "Value for `antlr-syntax-propertize' when using ANTLR v3.") + +(defvar antlr-v2-syntax-propertize nil + "Value for `antlr-syntax-propertize' when using ANTLR v2.") + +(defvar antlr-skip-line-regexp nil + "Regexp matching special declarations after the grammar header. +The value is tool-dependent, see `antlr-tool-version-variables'.") + +(defvar antlr-v4-skip-line-regexp "[ \t]*import[ \t]+[^][}{)(^\n;]+;" + "Value for `antlr-skip-line-regexp' when using ANTLR v4.") + +(defvar antlr-v3-skip-line-regexp "[ \t]*scope[ \t]+[^][}{)(^\n;]+;" + "Value for `antlr-skip-line-regexp' when using ANTLR v3.") + +(defvar antlr-rule-body-start-op ":" + "Single-character string which starts the rule body.") + + +;;;=========================================================================== +;;; tool- and language-dependent font-lock +;;;=========================================================================== + +(defvar antlr-font-lock-symbol-regexp nil + "Regexp matching symbol declarations in the grammar, or nil. +If a regexp, the buffer content matched by the first regexp group +is highlighted with face `antlr-keyword' and the content matched +by the second regexp group is highlighted with face +`antlr-symbol'. + +The value is tool-dependent, see `antlr-tool-version-variables'.") + +(defvar antlr-v4-font-lock-symbol-regexp + "^[ \t]*\\(mode\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)?" + "Value for `antlr-font-lock-symbol-regexp' when using ANTLR v4.") + +(defvar antlr-v3-font-lock-symbol-regexp + "^[ \t]*\\(scope\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)?" + "Value for `antlr-font-lock-symbol-regexp' when using ANTLR v3.") + +(defcustom antlr-font-lock-literal-regexp + ;; actually, in v3/v4 it is 'L' only + "\\([\"']\\)\\(\\sw\\(\\sw\\|-\\)*\\|\\(\\s_\\|\\s.\\)+\\|\\s(\\|\\s)\\)\\1" + "Regexp matching literals with special syntax highlighting, or nil. +If nil, there is no special syntax highlighting for some literals. +Otherwise, it should be a regular expression which must contain at least +two regexp groups. The string matched by the second group is highlighted +with face `antlr-literal'." + :type '(choice (const :tag "None" nil) regexp)) + +(defvar antlr-font-lock-attribute-regexp "\\(\\$\\sw+\\)" + "Regexp matching attributes within actions with special syntax highlighting. +If nil, there is no special syntax highlighting for attributes. +Otherwise, it should be a regular expression which must contain at least +one regexp group. The string matched by the first group is highlighted +with face `antlr-attribute'.") + +(defvar antlr-font-lock-negation-regexp "\\.\\.\\|\\([.~]\\)" + "Regexp whose first regexp group matches negation. +The negation is highlighted with face `font-lock-negation-char-face'.") + +(defvar antlr-font-lock-syntax-spec '("\\(->\\|[!^]\\)") + "Specification for highlighting syntax symbols for AST creation: !, ^, ->. +If non-nil, the value looks like (REGEXP). Syntax symbols are matched +by the first regexp group in REGEXP, and are highlighted with face +`antlr-syntax'.") +;; TODO: in v4, highlight lexer commands after "->" + +(defvar antlr-grammar-header-regexp + "\\<\\(lexer[ \t]+grammar\\|parser[ \t]+grammar\\|tree[ \t]+grammar\\|grammar\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\(?:\\sw\\|\\s_\\)*\\)[ \t]*;" + "Regexp matching class headers. +The value might be tool-dependent, see `antlr-tool-version-variables'.") + +(defvar antlr-v2-grammar-header-regexp + "\\<\\(class\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\(?:\\sw\\|\\s_\\)*\\)[ \t]+\\(extends\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\(?:\\sw\\|\\s_\\)*\\)[ \t]*;" + "Value for `antlr-grammar-header-regexp' when using ANTLR v2.") + +(defvar antlr-ruleref-assign-regexp "\\(\\sw+\\)[ \t]*\\(\\+?=\\)?" + "Regexp matching rule references or their optional labels. +If the second regexp group does not match, the first regexp group +matches a rule reference, which is highlighted with face `antlr-tokenref' +for token rules, and face `antlr-ruleref' for other rules. + +If there is no third regexp group or it does not match, the first +regexp group matches a rule label, which is highlighted with face +`font-lock-variable-name-face'. + +The value might be tool-dependent, see `antlr-tool-version-variables'.") + +(defvar antlr-v2-ruleref-assign-regexp "\\(\\sw+\\)[ \t]*\\([:]\\|\\(=\\)\\)?" + "Value for `antlr-ruleref-assign-regexp' when using ANTLR v2.") + +(defvar antlr-action-font-lock-keywords nil + "Font Lock keywords used for the actions in the grammar. +The value should be like the first element of `font-lock-defaults. +See also `antlr-font-lock-maximum-decoration'. +The value might be language-dependent, see `antlr-language-variables'.") + +(defvar antlr-java-action-font-lock-keywords + '(antlr-no-action-keywords + java-font-lock-keywords-1 java-font-lock-keywords-2 + java-font-lock-keywords-3) + "Value for `antlr-action-font-lock-keywords' when using language `antlr-java'.") + +(defvar antlr-action-scope-names '("lexer" "parser" "treeparser") + "Valid ANTLR action scope names.") + +(defvar antlr-action-names t + "Valid ANTLR action names. +This is a string list or t, which means that any name is valid. +The value might be language-dependent, see `antlr-language-variables'.") + +;; see $(ANTLR3)/tool/src/main/java/org/antlr/codegen/$(LANGUAGE)Target.java-isValidActionScope() +;; or $(ANTLR3.JAR)/antlr3-jar/org/antlr/codegen/templates/, fine-grep for "actions\." +(defvar antlr-java-action-names + '("init" "after" "header" "members" "rulecatch" "synpredgate") + "Valid ANTLR action names in Java. +Value for `antlr-action-names' when using language `antlr-java'.") + +(defvar antlr-token-identifier-p 'antlr-upcase-p + "Function for syntax highlighting to distinguish token refs from rule refs. +Function is called with the first character of the identifier; it should +return non-nil if the identifier is a token reference.") + + +;;;=========================================================================== +;;; general font-lock ;;;=========================================================================== (defcustom antlr-font-lock-maximum-decoration 'inherit "The maximum decoration level for fontifying actions. -Value `none' means, do not fontify actions, just normal grammar code -according to `antlr-font-lock-additional-keywords'. Value `inherit' -means, use value of `font-lock-maximum-decoration'. Any other value is +Value `none' means, do not fontify actions, just normal grammar +code according to `antlr-font-lock-additional-keywords' and +`antlr-font-lock-late-keywords'. Value `inherit' means, use +value of `font-lock-maximum-decoration'. Any other value is interpreted as in `font-lock-maximum-decoration' with no level-0 fontification, see `antlr-font-lock-keywords-alist'. While calculating the decoration level for actions, `major-mode' is -bound to `antlr-language'. For example, with value - ((java-mode . 2) (c++-mode . 0)) +bound to the value of `antlr-action-mode'. For example, with value + ((java-mode \. 2) (c++-mode \. 0)) Java actions are fontified with level 2 and C++ actions are not fontified at all." :type '(choice (const :tag "None" none) @@ -689,145 +1168,137 @@ fontified at all." "Empty font-lock keywords for actions. Do not change the value of this constant.") -(defvar antlr-font-lock-keywords-alist - '((java-mode - antlr-no-action-keywords - java-font-lock-keywords-1 java-font-lock-keywords-2 - java-font-lock-keywords-3) - (c++-mode - antlr-no-action-keywords - c++-font-lock-keywords-1 c++-font-lock-keywords-2 - c++-font-lock-keywords-3)) - "List of font-lock keywords for actions in the grammar. -Each element in this list looks like - (MAJOR-MODE KEYWORD...) - -If `antlr-language' is equal to MAJOR-MODE, the KEYWORDs are the -font-lock keywords according to `font-lock-defaults' used for the code -in the grammar's actions and semantic predicates, see -`antlr-font-lock-maximum-decoration'.") - (defface antlr-default '((t nil)) "Face to prevent strings from language dependent highlighting. Do not change.") (defface antlr-keyword - '((((class color) (background light)) - (:foreground "black" :weight bold)) - (t :inherit font-lock-keyword-face)) + '((t :inherit font-lock-keyword-face)) "ANTLR keywords.") (defface antlr-syntax - '((((class color) (background light)) - (:foreground "black" :weight bold)) - (t :inherit font-lock-constant-face)) - "ANTLR syntax symbols like :, |, (, ), ....") + '((t :inherit font-lock-keyword-face)) + "ANTLR syntax symbols for AST creation: !, ^, ->.") + +(defface antlr-action + '((t :inherit font-lock-builtin-face)) + "ANTLR action names: @ActionName, @ActionScope::ActionName.") (defface antlr-ruledef - '((((class color) (background light)) - (:foreground "blue" :weight bold)) - (t :inherit font-lock-function-name-face)) - "ANTLR rule references (definition).") + '((t :inherit font-lock-function-name-face)) + "ANTLR parser and treeparser rule symbols (definition).") (defface antlr-tokendef - '((((class color) (background light)) - (:foreground "blue" :weight bold)) - (t :inherit font-lock-function-name-face)) - "ANTLR token references (definition).") + '((t :inherit font-lock-function-name-face)) + "ANTLR scanner rule symbols (definition).") (defface antlr-ruleref - '((((class color) (background light)) (:foreground "blue4")) - (t :inherit font-lock-type-face)) - "ANTLR rule references (usage).") + '((t :inherit font-lock-type-face)) + "ANTLR parser and treeparser rule symbols (usage).") (defface antlr-tokenref - '((((class color) (background light)) (:foreground "orange4")) - (t :inherit font-lock-type-face)) - "ANTLR token references (usage).") + '((t :inherit font-lock-constant-face)) + "ANTLR scanner rule symbols (usage).") + +(defface antlr-symbol + '((t :inherit font-lock-variable-name-face)) + "ANTLR symbols (definition and usage) for things other than rules. +Used for grammars, v3 scopes and v4 modes.") (defface antlr-literal - '((((class color) (background light)) - (:foreground "brown4" :weight bold)) - (t :inherit font-lock-string-face)) + '((t :inherit font-lock-string-face :weight bold)) "ANTLR special literal tokens. It is used to highlight strings matched by the first regexp group of `antlr-font-lock-literal-regexp'.") -(defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" - "Regexp matching literals with special syntax highlighting, or nil. -If nil, there is no special syntax highlighting for some literals. -Otherwise, it should be a regular expression which must contain a regexp -group. The string matched by the first group is highlighted with -`antlr-font-lock-literal-face'." - :type '(choice (const :tag "None" nil) regexp)) - -(defvar antlr-class-header-regexp - "\\(class\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]+\\(extends\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\sw*\\)[ \t]*;" - "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-tokendef)) - ("\\$\\sw+" (0 'antlr-keyword)) - ;; the tokens are already fontified as string/docstrings: +(defface antlr-attribute '((t :inherit font-lock-preprocessor-face)) + "ANTLR references to attributes within actions.") + +(defvar antlr-font-lock-late-keywords + ;; The tokens are already fontified as string/docstrings. The extra + ;; fontification of literals must come after the fontification from cc-mode; + ;; otherwise `c-font-lock-invalid-string' fontifies the final doublequote of + ;; the last literal in a line with red (warning) - for whatever reason. + `((,(lambda (limit) ; v3, v4: literals are only '...' + (if antlr-font-lock-literal-regexp + (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) + (2 'antlr-literal t)) (,(lambda (limit) - (if antlr-font-lock-literal-regexp - (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) - (1 'antlr-literal t)) + (antlr-re-search-forward "^\\(\\sw+\\)" limit)) + (1 (if (funcall antlr-token-identifier-p (char-after (match-beginning 0))) + 'antlr-tokendef + 'antlr-ruledef) + t)) (,(lambda (limit) - (antlr-re-search-forward antlr-class-header-regexp limit)) - (1 'antlr-keyword) - (2 'antlr-ruledef) - (3 'antlr-keyword) - (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) + (antlr-re-search-forward antlr-grammar-header-regexp limit)) + (1 'antlr-keyword t) + (2 'antlr-symbol t) + (3 'antlr-keyword t t) + (4 (if (member (match-string-no-properties 4) '("Lexer" "Parser" "TreeParser")) 'antlr-keyword - 'font-lock-type-face))) + 'font-lock-type-face) + t t)) (,(lambda (limit) - (antlr-re-search-forward - "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" - limit)) - (1 'antlr-keyword)) + (antlr-re-search-forward + "\\<\\(header\\|options\\|tokens\\|channels\\|exception\\|catch\\|finally\\|returns\\|throws\\|import\\|locals\\)\\>" + limit)) + (1 'antlr-keyword t)) (,(lambda (limit) - (antlr-re-search-forward - "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" - limit)) - (1 'font-lock-type-face) ; not XEmacs's java level-3 fruit salad - (3 (if (antlr-upcase-p (char-after (match-beginning 3))) - 'antlr-tokendef - 'antlr-ruledef) - nil t) - (4 'antlr-syntax nil t)) + (when antlr-font-lock-symbol-regexp + (antlr-re-search-forward antlr-font-lock-symbol-regexp limit))) + (1 'antlr-keyword t) + (2 'antlr-symbol t t)) (,(lambda (limit) - (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) - (1 (if (antlr-upcase-p (char-after (match-beginning 0))) + (antlr-re-search-forward + "^\\(private\\|public\\|protected\\|fragment\\)\\>[ \t]*\\(\\sw+\\)?" + limit)) + (1 'antlr-keyword t) + (2 (if (funcall antlr-token-identifier-p (char-after (match-beginning 2))) 'antlr-tokendef 'antlr-ruledef) - nil t) - (2 'antlr-syntax nil t)) + t t)) + (,(lambda (limit) ; v3, v4 + (antlr-re-search-forward "@\\([A-Za-z\300-\326\330-\337_]\\sw*\\)\\(?:::\\([A-Za-z\300-\326\330-\337_]\\sw*\\)\\)?" limit)) + (1 (antlr-font-lock-checked-face (if (match-beginning 2) + antlr-action-scope-names + antlr-action-names) + 1 'antlr-action) + t) + (2 (antlr-font-lock-checked-face antlr-action-names 2 'antlr-action) + t t)) (,(lambda (limit) - ;; v:ruleref and v:"literal" is allowed... - (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) + (and antlr-font-lock-syntax-spec + (antlr-re-search-forward (car antlr-font-lock-syntax-spec) limit))) + (1 'antlr-syntax t))) + "Late font-lock keywords for ANTLR's normal grammar code. +See `antlr-font-lock-keywords-alist' for the keywords of actions.") + +(defvar antlr-font-lock-additional-keywords + `((,(lambda (limit) + (and antlr-font-lock-attribute-regexp + (re-search-forward antlr-font-lock-attribute-regexp limit 'limit))) + (1 'antlr-attribute)) + (,(lambda (limit) + ;; v2: v:ruleref v:"literal", v=ruleref (no highlighting), v3: v=ruleref + (antlr-re-search-forward antlr-ruleref-assign-regexp limit)) (1 (if (match-beginning 2) - (if (eq (char-after (match-beginning 2)) ?=) + (if (match-beginning 3) 'antlr-default - 'font-lock-variable-name-face) - (if (antlr-upcase-p (char-after (match-beginning 1))) + 'font-lock-variable-name-face) ; yes, same as vars in [...] + (if (funcall antlr-token-identifier-p (char-after (match-beginning 1))) 'antlr-tokenref 'antlr-ruleref))) (2 'antlr-default nil t)) (,(lambda (limit) - (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit)) - (0 'antlr-syntax))) - "Font-lock keywords for ANTLR's normal grammar code. + (antlr-re-search-forward antlr-font-lock-negation-regexp limit)) + (1 'font-lock-negation-char-face t t))) +"Early font-lock keywords for ANTLR's normal grammar code. See `antlr-font-lock-keywords-alist' for the keywords of actions.") (defvar antlr-font-lock-defaults '(antlr-font-lock-keywords - nil nil ((?_ . "w") (?\( . ".") (?\) . ".")) beginning-of-defun) - "Font-lock defaults used for ANTLR syntax highlighting. -The SYNTAX-ALIST element is also used to initialize -`antlr-action-syntax-table'.") + nil nil ((?_ . "w"))) + "Font-lock defaults used for ANTLR syntax highlighting.") ;;;=========================================================================== @@ -841,38 +1312,12 @@ The SYNTAX-ALIST element is also used to initialize (let ((st (make-syntax-table))) (c-populate-syntax-table st) st) - "Syntax table used in `antlr-mode' buffers. -If non-nil, it will be initialized in `antlr-mode'.") - -;; used for "in Java/C++ code" = syntactic-depth>0 -(defvar antlr-action-syntax-table - (let ((st (copy-syntax-table antlr-mode-syntax-table)) - (slist (nth 3 antlr-font-lock-defaults))) - (while slist - (modify-syntax-entry (caar slist) (cdar slist) st) - (setq slist (cdr slist))) - st) - "Syntax table used for ANTLR action parsing. -Initialized by `antlr-mode-syntax-table', changed by SYNTAX-ALIST in -`antlr-font-lock-defaults'. This table should be selected if you use -`buffer-syntactic-context' and `buffer-syntactic-context-depth' in order -not to confuse their context_cache.") + "Syntax table used in `antlr-mode' buffers.") (defvar antlr-mode-abbrev-table nil "Abbreviation table used in `antlr-mode' buffers.") (define-abbrev-table 'antlr-mode-abbrev-table ()) -(defvar antlr-slow-cache-enabling-symbol 'loudly -;; Emacs's 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'.") - ;;;;########################################################################## ;;;; The Code @@ -880,112 +1325,26 @@ Used for `antlr-slow-syntactic-context'.") -;;;=========================================================================== -;;; Syntax functions -;;;=========================================================================== - ;;;=========================================================================== ;;; 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) - -(defun antlr-invalidate-context-cache (&rest _dummies) -;; checkdoc-params: (dummies) - "Invalidate context cache for syntactical context information." -;;; (cl-incf antlr-statistics-inval) - (setq antlr-slow-context-cache nil)) - -(defun antlr-syntactic-context () +(defun antlr-syntactic-context (&optional ppss) "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 +`comment' if 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)) diff state - ;; Arg, Emacs's (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)) (cl-incf antlr-statistics-full-neg)) - ;; ((and diff (>= diff 3000)) (cl-incf antlr-statistics-full-diff)) - ;; (t (cl-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))))) - -;; (cl-incf (aref antlr-statistics 2)) -;; (unless (and (eq (current-buffer) -;; (caar antlr-slow-context-cache)) -;; (eq (buffer-modified-tick) -;; (cdar antlr-slow-context-cache))) -;; (cl-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 -;; (cl-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))) -;; (cl-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)))))) +WARNING: this may alter `match-data'. +Optional argument PPSS" ; TODO: warning this valid? + ;; does not work for negative depth + (or ppss (setq ppss (syntax-ppss))) + (cond ((nth 3 ppss) 'string) + ((nth 4 ppss) 'comment) + (t + (let ((poss (nth 9 ppss))) ; TODO Emacs: syntax-ppss-open-positions + (while (and poss (memq (char-after (car poss)) '(nil ?\())) + (setq poss (cdr poss))) + (and poss (length poss)))))) ; depth if inside {} or [] ;;;=========================================================================== @@ -994,9 +1353,8 @@ WARNING: this may alter `match-data'." (defun antlr-upcase-p (char) "Non-nil, if CHAR is an uppercase character (if CHAR was a char)." - ;; in XEmacs, upcase only works for ASCII - (or (and (<= ?A char) (<= char ?Z)) - (and (<= ?\300 char) (<= char ?\337)))) ; ?\327 is no letter + ;; (get-char-code-property char 'lowercase) + (not (eq (downcase char) char))) (defun antlr-re-search-forward (regexp bound) "Search forward from point for regular expression REGEXP. @@ -1005,36 +1363,47 @@ nil if no occurrence was found. Do not search within comments, strings and actions/semantic predicates. BOUND bounds the search; it is a buffer position. See also the functions `match-beginning', `match-end' and `replace-match'." - ;; WARNING: Should only be used with `antlr-action-syntax-table'! (let ((continue t)) (while (and (re-search-forward regexp bound 'limit) (save-match-data - (if (eq (antlr-syntactic-context) 0) - (setq continue nil) - t)))) + (or (antlr-syntactic-context) (setq continue nil))))) (if continue nil (point)))) -(defun antlr-search-forward (string) +(defsubst antlr-search-result (line-regexp) + "Return `point' if last search is valid, or nil otherwise. +The search is not considered valid if point is inside actions, comments +or strings, or if the beginning of the current line matches LINE-REGEXP +if that is non-nil." + (unless (antlr-syntactic-context) + (if (and line-regexp + (save-excursion + (beginning-of-line) + (looking-at line-regexp)) + (<= (point) (match-end 0) (1+ (point)))) + nil + (point)))) + +(defun antlr-search-forward (string &optional line-regexp) "Search forward from point for STRING. Set point to the end of the occurrence found, and return point. Return nil if no occurrence was found. Do not search within comments, strings -and actions/semantic predicates." - ;; WARNING: Should only be used with `antlr-action-syntax-table'! - (let ((continue t)) - (while (and (search-forward string nil 'limit) - (if (eq (antlr-syntactic-context) 0) (setq continue nil) t))) - (if continue nil (point)))) - -(defun antlr-search-backward (string) +and actions/semantic predicates. +See function `antlr-search-result' for the optional arg LINE-REGEXP." + (let ((result nil)) + (while (and (null result) (search-forward string nil 'limit)) + (setq result (antlr-search-result line-regexp))) + result)) + +(defun antlr-search-backward (string &optional line-regexp) "Search backward from point for STRING. Set point to the beginning of the occurrence found, and return point. Return nil if no occurrence was found. Do not search within comments, -strings and actions/semantic predicates." - ;; WARNING: Should only be used with `antlr-action-syntax-table'! - (let ((continue t)) - (while (and (search-backward string nil 'limit) - (if (eq (antlr-syntactic-context) 0) (setq continue nil) t))) - (if continue nil (point)))) +strings and actions/semantic predicates. +See function `antlr-search-result' for the optional arg LINE-REGEXP." + (let ((result nil)) + (while (and (null result) (search-backward string nil 'limit)) + (setq result (antlr-search-result line-regexp))) + result)) (defsubst antlr-skip-sexps (count) "Skip the next COUNT balanced expressions and the comments after it. @@ -1043,6 +1412,117 @@ Return position before the comments after the last expression." (prog1 (point) (antlr-c-forward-sws))) +(defun antlr-syntax-propertize-wholerule (start end) + ;; checkdoc-params: (start end) + "Function used to properly highlight ANTLR v4 charsets. +This function is used in `syntax-propertize-extend-region-functions' to +make sure that the propertized region starts at the beginning of a rule." + (goto-char start) + (beginning-of-line) + (while (if (bobp) nil (looking-at "[ \t\n}]\\|@init\\_>\\|options\\_>")) + (beginning-of-line 0)) + ;; no need to find the real end of a rule... end-of-line is good + (cons (point) + (progn (goto-char end) + (if (bolp) (point) (line-beginning-position 2))))) + +;; font-lock.el and/or syntax.el should say something about the use of +;; `syntax-ppss' when `font-lock-syntax-table' is set - we should not use the +;; same cache for calls inside and outside font-lock, don't we? + +(defun antlr-syntax-propertize-charsets (start end) + ;; checkdoc-params: (start end) + "Function used to properly highlight ANTLR v4 charsets. +This function is as value for `syntax-propertize-function' and makes +sure that charsets like [a-z] in token rule bodies are considered +literals." + (goto-char start) + (let ((mode (if (bolp) :start :next))) + (while (< (point) end) + (let ((context (antlr-syntactic-context))) + (cond ((numberp context) + (goto-char (or (ignore-errors (scan-lists (point) 1 context)) + end))) + ((eq mode :start) ; TODO: only if context = 0 + (when (looking-at "fragment\\_>") + (forward-char 8) + (skip-chars-forward " \t\n")) + (setq mode (if (antlr-upcase-p (char-after)) + :scanner + (if (eq (char-syntax (char-after)) ?w) + :end + :next)))) + ((eq mode :end) + (skip-chars-forward "^;" end) + (while (and (< (point) end) (antlr-syntactic-context)) + (forward-char) + (skip-chars-forward "^;" end)) + (setq mode :next)) + ((eq mode :next) + (beginning-of-line 2) + (while (and (< (point) end) (looking-at "[ \t\n@}]")) + (beginning-of-line 2)) + (setq mode :start)) + ((eq mode :scanner) + (skip-chars-forward "^:;" end) + (while (and (< (point) end) (antlr-syntactic-context)) + (forward-char) + (skip-chars-forward "^:;" end)) + (if (eq (char-after) ?:) + (if (eq (char-after (1+ (point))) ?:) + (forward-char 2) ; "::" for namespace + (setq mode :charset)) + (setq mode :next))) + ((eq mode :charset) + ;; LEXER_CHAR_SET : + ;; '[' ( '\\' ~('\r'|'\n') | ~('\r'|'\n'|'\\'|']') )* ']' + (skip-chars-forward "^;[" end) + (while (and (< (point) end) (antlr-syntactic-context)) + (forward-char) + (skip-chars-forward "^;[" end)) + (if (not (eq (char-after) ?\[)) + (setq mode :next) + (put-text-property (point) (progn (forward-char) (point)) + 'syntax-table + (eval-when-compile + (string-to-syntax "|"))) + (let (char (esc nil)) + (while (and (setq char (char-after)) + (not (eq char ?\n)) + (or esc (not (eq char ?\])))) + (setq esc (if esc nil (eq char ?\\))) + (forward-char))) + (put-text-property (point) (1+ (point)) + 'syntax-table + (eval-when-compile + (string-to-syntax "|")))))))))) + +(defun antlr-syntax-propertize-template-literals (start end) + ;; checkdoc-params: (start end) + "Function used to properly highlight ANTLR v3 template literals. +This function is as value for `syntax-propertize-function' and makes +sure that templates like <<...>> outside actions, strings or comments +are considered literals." + (goto-char start) + (while (search-forward "<<" end t) + (let ((context (antlr-syntactic-context))) + (if context + (when (numberp context) + (goto-char (min (or (ignore-errors (scan-lists (point) 1 context)) + end) + end))) + (let ((pos (- (point) 2))) + ;; put the text property on the inner "<>", since multi-line is set + ;; to be ok with `c-multiline-string-start-char' + (put-text-property (1+ pos) (point) 'syntax-table + (eval-when-compile + (string-to-syntax "|"))) + (when (search-forward ">>" end 'move) + (put-text-property (- (point) 2) (1- (point)) 'syntax-table + (eval-when-compile + (string-to-syntax "|")))) + (put-text-property pos (point) 'syntax-multiline t)))))) + ;;;=========================================================================== ;;; font-lock @@ -1052,63 +1532,82 @@ Return position before the comments after the last expression." "Return font-lock keywords for current buffer. See `antlr-font-lock-additional-keywords', `antlr-language' and `antlr-font-lock-maximum-decoration'." - (if (eq antlr-font-lock-maximum-decoration 'none) - antlr-font-lock-additional-keywords - (append antlr-font-lock-additional-keywords - (eval (let ((major-mode antlr-language)) ; dynamic - (font-lock-choose-keywords - (cdr (assq antlr-language - antlr-font-lock-keywords-alist)) - (if (eq antlr-font-lock-maximum-decoration 'inherit) - font-lock-maximum-decoration - antlr-font-lock-maximum-decoration))) - t)))) + (append antlr-font-lock-additional-keywords + (unless (eq antlr-font-lock-maximum-decoration 'none) + (let* ((major-mode antlr-action-mode) ;#dynamic + (level (font-lock-value-in-major-mode + (if (eq antlr-font-lock-maximum-decoration 'inherit) + font-lock-maximum-decoration + antlr-font-lock-maximum-decoration)))) + (font-lock-eval-keywords + (font-lock-choose-keywords antlr-action-font-lock-keywords + level)))) + antlr-font-lock-late-keywords)) + +(defun antlr-font-lock-checked-face (strings group face) ; checkdoc-order: nil + "Return font-lock face for regexp group GROUP. +If the matched string is an element of STRINGS (or STRINGS is not a list), +return FACE, otherwise return `font-lock-warning-face'." + (if (if (consp strings) (member (match-string-no-properties group) strings) strings) + face + font-lock-warning-face)) ;;;=========================================================================== ;;; imenu support ;;;=========================================================================== +;; Actually, issues in the "Index" (at least with sorted entries) menu are +;; imenu-induced. If entries are missing in the menu (as are sometimes for me +;; on Emacs-25.1.1), try M-x imenu RET -> you see all. This might not be the +;; case anymore with the reordering of `imenu-add-to-menubar'... +(defvar antlr-do-syntax-propertize (version< emacs-version "25") + "Whether \\[antlr-mode] runs `syntax-propertize' on the complete buffer. +Running it explicitly at the beginning of the mode might be +necessary for a correct Index menu and motion commands.") + (defun antlr-grammar-tokens () "Return alist for tokens defined in current buffer." - (save-excursion (antlr-imenu-create-index-function t))) + (save-excursion (antlr-imenu-create-index-function 'upcase))) -(defun antlr-imenu-create-index-function (&optional tokenrefs-only) +;; TODO: version dependent? +(defun antlr-imenu-create-index-function (&optional refs-only) "Return imenu index-alist for ANTLR grammar files. -IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names." +IF REFS-ONLY is non-nil, just return alist with ref names, +with value 'upcase, only return alist with tokenref names." (let ((items nil) (classes nil) (continue t)) - ;; The generic imenu function searches backward, which is slower - ;; and more likely not to work during editing. - (with-syntax-table antlr-action-syntax-table - (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 - (push (cons (match-string 2) - (if imenu-use-markers - (copy-marker (match-beginning 2)) - (match-beginning 2))) - classes)) - (if (looking-at "p\\(ublic\\|rotected\\|rivate\\)") - (antlr-skip-sexps 1)) - (when (looking-at "\\sw+") - (if tokenrefs-only - (if (antlr-upcase-p (char-after (point))) - (push (list (match-string 0)) items)) - (push (cons (match-string 0) - (if imenu-use-markers - (copy-marker (match-beginning 0)) - (match-beginning 0))) - items)))) - (if (setq continue (antlr-search-forward ";")) - (antlr-skip-exception-part 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. + (goto-char (point-min)) + (antlr-skip-file-prelude t) + (while continue + (if (looking-at "\\(class\\|lexer[ \t]+grammar\\|parser[ \t]+grammar\\|tree[ \t]+grammar\\|grammar\\|mode\\|import\\)[ \t]+\\([A-Za-z\300-\326\330-\337]\\(?:\\sw\\|\\s_\\)*\\)") ; TODO: import is (hopefully) temp + (and (not refs-only) + (memq (char-after (match-beginning 1)) '(?c ?m)) ;class, mode + (push (cons (match-string-no-properties 2) + (if imenu-use-markers + (copy-marker (match-beginning 2)) + (match-beginning 2))) + classes)) + (if (looking-at "p\\(ublic\\|rotected\\|rivate\\)\\_>\\|fragment\\_>") + (antlr-skip-sexps 1)) + (when (looking-at "\\(?:\\sw\\|\\s_\\)+") + (when (or (not (eq refs-only 'upcase)) + (antlr-upcase-p (char-after (point)))) + (push (cons (match-string-no-properties 0) + (if (and imenu-use-markers (not refs-only)) + (copy-marker (match-beginning 0)) + (match-beginning 0))) + items)))) + (if (setq continue (antlr-search-forward ";" antlr-skip-line-regexp)) + (antlr-skip-rule-postlude t))) (if classes - (cons (cons "Classes" (nreverse classes)) (nreverse items)) + (cons (cons (if (eq antlr-tool-version 'antlr-v2) "Classes" "Modes") + (nreverse classes)) + (nreverse items)) (nreverse items)))) @@ -1116,28 +1615,95 @@ IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names." ;;; Parse grammar files (internal functions) ;;;=========================================================================== -(defun antlr-skip-exception-part (skip-comment) - "Skip exception part of current rule, i.e., everything after `;'. -This also includes the options and tokens part of a grammar class -header. If SKIP-COMMENT is non-nil, also skip the comment after that -part." - (let ((pos (point)) - (class nil)) +;; --- simplified v2 grammar ------------------------------------------------- +;; file: ("header" STRING? ACTION)? OPTIONS? ACTION? class* +;; class: "class" ID // moved preable action to file rule +;; ("extends" ("Lexer"|"Parser"|"TreeParser") ID?)? ";" +;; OPTIONS? TOKENS? ACTION? rule* +;; rule: ("protected"|"public"|"private")? ID "!"? +;; (ARGS)? ('returns' ARGS)? ('throws' IDs )? OPTIONS? ACTION? +;; ":" alts ";" ("exception" ARGS? ("catch" ARGS ACTION)* )* + +;; --- simplified v3/v4 grammar ---------------------------------------------- +;; grammar: ('lexer'|'parser'|'tree')? 'grammar' id ';' +;; < OPTIONS? TOKENS? (grammar3only|grammar4only) action* > +;; rule* ('mode' ID ';' rule* )* // lexer MODE is v4 only +;; grammar3only: ('scope' id ACTION)* // strict sequence in <...> +;; grammar4only: ('import' IDs ';')? ('channels' ACTION)? // any sequence in <...> +;; action: '@' (ID '::')? ID ACTION +;; rule: ('protected'|'public'|'private'|'fragment')? ID '!'? +;; (ARGS)? ('returns' ARGS)? ('throws' IDs )? ('locals' ARGS)? +;; < OPTIONS? scope3only action* > +;; ':' alts ';' ('catch' ARGS ACTION)* ('finally' ACTION)? +;; scope3only: ('scope' ACTION)? ('scope' IDs ';' )? + +(eval-and-compile + (defconst antlr-rule-postlude-skip-alist--const ; const for eval-when-compile safety + '(("exception" 1 . t) ("import" antlr-skip-import-statement) + ("options" 2) ("tokens" 2) ("finally" 2) ("channels" 2) + ("catch" 3) ("scope" 3)) + "Constant for `antlr-rule-postlude-skip-alist'.")) + +(defvar antlr-rule-postlude-skip-alist antlr-rule-postlude-skip-alist--const + "Alist of keywords after the ';' which still belong to the grammar rule. +Each element looks like + (KEYWORD FUNCTION ARGS...) +or + (KEYWORD SEXPS-COUNT OPTIONALP) + +After the ';' ending a rule body, function `antlr-skip-rule-postlude' +skips whitespace and comments, and check the text after point against +`antlr-rule-postlude-skip-regexp'. While there is a match, + +- if regexp group 1 has not been matched: we set point the end of the, + match, and skip the next sexpr, whitespace and comments + +- if the string matched by regexp group 1 is not the car of an element + of `antlr-rule-postlude-skip-alist': we skip one sexpr - which should + move point to the end of the whole match, + +- when the corresponding element of `antlr-rule-postlude-skip-alist' + is of the first form, we call FUNCTION with arguments ARGS - this + the function should return the position after a match and move + point to the non whitespace/comment position after that + +- when the corresponding element of `antlr-rule-postlude-skip-alist' + is of the second form, we skip SEXPS-COUNT balanced expression + (including the keyword itself) + +The value might be tool-dependent, see `antlr-tool-version-variables'.") + +(defvar antlr-rule-postlude-skip-regexp + (eval-when-compile + (concat (regexp-opt (mapcar #'car antlr-rule-postlude-skip-alist--const) t) + "\\_>\\|@[A-Za-z\300-\326\330-\337_]\\(?:\\sw\\|\\s_\\)*\\(?:::[A-Za-z\300-\326\330-\337_]\\(?:\\sw\\|\\s_\\)*\\)?")) + "Regexp matching things after ';' which still belong to the grammar rule. +See `antlr-rule-postlude-skip-alist' for details. +The value might be tool-dependent, see `antlr-tool-version-variables'.") + +(defun antlr-skip-rule-postlude (skip-comment) + "Skip the postlude of a definition, i.e. everything after `;'. +Definitions are rules, grammar/class and v4 mode definition. If +SKIP-COMMENT is non-nil, also skip the whitespace and comment +after that part. See `antlr-rule-postlude-skip-alist'. + +Point is assumed to be after the `;'. Always return end position +before trailing whitespaces and comments" + (let ((pos (point))) (antlr-c-forward-sws) - (while (looking-at "options\\>\\|tokens\\>") - (setq class t) - (setq pos (antlr-skip-sexps 2))) - (if class - ;; Problem: an action only belongs to a class def, not a normal rule. - ;; But checking the current rule type is too expensive => only expect - ;; an action if we have found an option or tokens part. - (if (looking-at "{") (setq pos (antlr-skip-sexps 1))) - (while (looking-at "exception\\>") - (setq pos (antlr-skip-sexps 1)) - (when (looking-at "\\[") - (setq pos (antlr-skip-sexps 1))) - (while (looking-at "catch\\>") - (setq pos (antlr-skip-sexps 3))))) + (while (looking-at antlr-rule-postlude-skip-regexp) + (if (match-end 1) + (let ((skip (cdr (assoc (match-string-no-properties 1) + antlr-rule-postlude-skip-alist)))) + (if (functionp (car skip)) + (setq pos (apply (car skip) (cdr skip))) + (setq pos (antlr-skip-sexps (or (car skip) 1))) + (when (and (cdr skip) (eq (char-after) ?\[)) + (setq pos (antlr-skip-sexps 1))))) + (goto-char (match-end 0)) ; to end of @action / @scope::action + (antlr-c-forward-sws) + (setq pos (antlr-skip-sexps 1)))) + (if (eq (char-after) ?\{) (setq pos (antlr-skip-sexps 1))) ; v2 (or skip-comment (goto-char pos)))) (defun antlr-skip-file-prelude (skip-comment) @@ -1147,46 +1713,47 @@ Return the start position of the file prelude. Hack: if SKIP-COMMENT is `header-only' only skip header and return position before the comment after the header." - (let* ((pos (point)) + (let* ((pos (point)) ; should be (point-min) (pos0 pos)) (antlr-c-forward-sws) (if skip-comment (setq pos0 (point))) - (while (looking-at "header\\>[ \t]*\\(\"\\)?") + (while (looking-at "header\\_>[ \t]*\\(\"\\)?") (setq pos (antlr-skip-sexps (if (match-beginning 1) 3 2)))) (if (eq skip-comment 'header-only) ; a hack... pos - (when (looking-at "options\\>") + (when (looking-at "options\\_>") (setq pos (antlr-skip-sexps 2))) + (if (eq (char-after) ?\{) (setq pos (antlr-skip-sexps 1))) (or skip-comment (goto-char pos)) pos0))) (defun antlr-next-rule (arg skip-comment) "Move forward to next end of rule. Do it ARG many times. -A grammar class header and the file prelude are also considered as a -rule. Negative argument ARG means move back to ARGth preceding end of -rule. The behavior is not defined when ARG is zero. If SKIP-COMMENT -is non-nil, move to beginning of the rule." - ;; WARNING: Should only be used with `antlr-action-syntax-table'! +A grammar/class definition and the file prelude of Antlr v2 +grammars are also considered as a rule. Negative argument ARG +means move back to ARGth preceding end of rule. The behavior is +not defined when ARG is zero. If SKIP-COMMENT is non-nil, move +to beginning of the rule." ;; PRE: ARG<>0 (let ((pos (point)) (beg (point))) - ;; first look whether point is in exception part - (if (antlr-search-backward ";") + ;; first look whether point is in rule postlude + (if (antlr-search-backward ";" antlr-skip-line-regexp) (progn (setq beg (point)) (forward-char) - (antlr-skip-exception-part skip-comment)) + (antlr-skip-rule-postlude skip-comment)) (antlr-skip-file-prelude skip-comment)) (if (< arg 0) (unless (and (< (point) pos) (zerop (cl-incf arg))) ;; if we have moved backward, we already moved one defun backward (goto-char beg) ; rewind (to ";" / point) (while (and arg (<= (cl-incf arg) 0)) - (if (antlr-search-backward ";") + (if (antlr-search-backward ";" antlr-skip-line-regexp) (setq beg (point)) (when (>= arg -1) ;; try file prelude: - (setq pos (antlr-skip-file-prelude skip-comment)) + (setq pos (antlr-skip-file-prelude skip-comment)) ; header pos (if (zerop arg) (if (>= (point) beg) (goto-char (if (>= pos beg) (point-min) pos))) @@ -1195,21 +1762,20 @@ is non-nil, move to beginning of the rule." (setq arg nil))) (when arg ; always found a ";" (forward-char) - (antlr-skip-exception-part skip-comment))) + (antlr-skip-rule-postlude skip-comment))) (if (<= (point) pos) ; moved backward? (goto-char pos) ; rewind - (decf arg)) ; already moved one defun forward + (decf arg)) ; already moved one defun forward (unless (zerop arg) - (while (>= (decf arg) 0) - (antlr-search-forward ";")) - (antlr-skip-exception-part skip-comment))))) + (while (>= (decf arg) 0) + (antlr-search-forward ";" antlr-skip-line-regexp)) + (antlr-skip-rule-postlude skip-comment))))) (defun antlr-outside-rule-p () "Non-nil if point is outside a grammar rule. Move to the beginning of the current rule if point is inside a rule." - ;; WARNING: Should only be used with `antlr-action-syntax-table'! (let ((pos (point))) - (antlr-next-rule -1 nil) + (antlr-next-rule -1 nil) ; to end of previous rule (let ((between (or (bobp) (< (point) pos)))) (antlr-c-forward-sws) (and between (> (point) pos) (goto-char pos))))) @@ -1225,58 +1791,70 @@ Move to the beginning of the current rule if point is inside a rule." A grammar class header and the file prelude are also considered as a rule." (save-excursion - (with-syntax-table antlr-action-syntax-table - (not (antlr-outside-rule-p))))) + (not (antlr-outside-rule-p)))) (defun antlr-end-of-rule (&optional arg) - "Move forward to next end of rule. Do it ARG [default: 1] many times. -A grammar class header and the file prelude are also considered as a -rule. Negative argument ARG means move back to ARGth preceding end of + "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 a +rule. + +If `antlr-end-of-defun-is-next' is nil, move to next end of rule, +i.e. the end of the current rule with ARG = 1. Otherwise move +forward to the ARGth next rule. + +Negative argument ARG means move back to ARGth preceding end of rule. If ARG is zero, run `antlr-end-of-body'." (interactive "^p") + ;; yes, there is a variable `end-of-defun-function', but `end-of-defun' does + ;; far too much around the funcall of that variable (Emacs-24.4) (if (zerop arg) (antlr-end-of-body) - (with-syntax-table antlr-action-syntax-table - (antlr-next-rule arg nil)))) + (antlr-next-rule arg (and antlr-end-of-defun-is-next (> arg 0))))) (defun antlr-beginning-of-rule (&optional arg) "Move backward to preceding beginning of rule. Do it ARG many times. -A grammar class header and the file prelude are also considered as a -rule. Negative argument ARG means move forward to ARGth next beginning -of rule. If ARG is zero, run `antlr-beginning-of-body'." +A grammar/class header and the file prelude are also considered a +rule. + +Negative argument ARG means move forward to abs(ARG)th next rule: +beginning of rule if `antlr-end-of-defun-is-next' is nil, and end +of rule otherwise. + +If ARG is zero, run `antlr-beginning-of-body'." (interactive "^p") (if (zerop arg) (antlr-beginning-of-body) - (with-syntax-table antlr-action-syntax-table - (antlr-next-rule (- arg) t)))) + (antlr-next-rule (- arg) (if antlr-end-of-defun-is-next (> arg 0) t)))) (defun antlr-end-of-body (&optional msg) "Move to position after the `;' of the current rule. A grammar class header is also considered as a rule. With optional prefix arg MSG, move to `:'." (interactive "^") - (with-syntax-table antlr-action-syntax-table - (let ((orig (point))) - (if (antlr-outside-rule-p) - (error "Outside an ANTLR rule")) - (let ((bor (point))) - (when (< (antlr-skip-file-prelude t) (point)) - ;; Yes, we are in the file prelude - (goto-char orig) - (error (or msg "The file prelude is without `;'"))) - (antlr-search-forward ";") - (when msg - (when (< (point) - (progn (goto-char bor) - (or (antlr-search-forward ":") (point-max)))) - (goto-char orig) - (error msg)) - (antlr-c-forward-sws)))))) + (let ((orig (point))) + (if (antlr-outside-rule-p) + (error "Outside an ANTLR rule")) + (let ((bor (point))) ; beginning of current rule + (when (< (antlr-skip-file-prelude t) (point)) + ;; Yes, we are in the file prelude + (goto-char orig) + (error (or msg "The file prelude is without `;'"))) + (antlr-search-forward ";" antlr-skip-line-regexp) + (when msg + (when (< (point) + (progn (goto-char bor) + (or (antlr-search-forward antlr-rule-body-start-op) + (point-max)))) + (goto-char orig) + (error msg)) + (antlr-c-forward-sws))))) (defun antlr-beginning-of-body () "Move to the first element after the `:' of the current rule." (interactive "^") - (antlr-end-of-body "Class headers and the file prelude are without `:'")) + (antlr-end-of-body (if (eq antlr-tool-version 'antlr-v2) + "Class definitions and the file prelude are without `:'" + "Grammar and mode definitions are without `:'"))) ;;;=========================================================================== @@ -1291,11 +1869,9 @@ If non-nil, TRANSFORM is used on literals instead of `downcase-region'." (let ((literals 0)) (save-excursion (goto-char (point-min)) - (with-syntax-table antlr-action-syntax-table - (antlr-invalidate-context-cache) - (while (antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" nil) - (funcall transform (match-beginning 0) (match-end 0)) - (cl-incf literals)))) + (while (antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|\\s_\\|-\\)*\\)\"" nil) ; TODO: '...' + (funcall transform (match-beginning 0) (match-end 0)) + (cl-incf literals))) (message "Transformed %d literals" literals))) (defun antlr-upcase-literals () @@ -1303,6 +1879,9 @@ If non-nil, TRANSFORM is used on literals instead of `downcase-region'." (interactive) (antlr-downcase-literals 'upcase-region)) +;; TODO: `antlr-hide-actions' should probably be a minor mode like +;; `hide-ifdef-mode'. Whether to exclude arguments (of limited use) should be +;; controlled by `antlr-action-visibility' (negative value) (defun antlr-hide-actions (arg &optional silent) "Hide or unhide all actions in buffer. Hide all actions including arguments in brackets if ARG is 1 or if @@ -1320,24 +1899,22 @@ Display a message unless optional argument SILENT is non-nil." (antlr-hide-actions 0 t) (save-excursion (goto-char (point-min)) - (with-syntax-table antlr-action-syntax-table - (antlr-invalidate-context-cache) - (while (antlr-re-search-forward regexp nil) - (let ((beg (ignore-errors (scan-sexps (point) -1)))) - (when beg - (if diff ; braces are visible - (if (> (point) (+ beg diff)) - (add-text-properties (1+ beg) (1- (point)) - '(invisible t intangible t))) - ;; if actions is on line(s) of its own, hide WS - (and (looking-at "[ \t]*$") - (save-excursion - (goto-char beg) - (skip-chars-backward " \t") - (and (bolp) (setq beg (point)))) - (beginning-of-line 2)) ; beginning of next line - (add-text-properties beg (point) - '(invisible t intangible t)))))))) + (while (antlr-re-search-forward regexp nil) + (let ((beg (ignore-errors (scan-sexps (point) -1)))) + (when beg + (if diff ; braces are visible + (if (> (point) (+ beg diff)) + (add-text-properties (1+ beg) (1- (point)) + '(invisible t intangible t))) + ;; if actions is on line(s) of its own, hide WS + (and (looking-at "[ \t]*$") + (save-excursion + (goto-char beg) + (skip-chars-backward " \t") + (and (bolp) (setq beg (point)))) + (beginning-of-line 2)) ; beginning of next line + (add-text-properties beg (point) + '(invisible t intangible t))))))) (or silent (message "Hide all actions (%s arguments)...done" (if (= arg 1) "including" "excluding")))) @@ -1379,10 +1956,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-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. +in `antlr-options-alists' which depends on `antlr-tool-version'. If the option already exists inside the visible part of the buffer, this command can be used to change the value of that option. Otherwise, find @@ -1410,6 +1984,7 @@ This command might also set the mark like \\[set-mark-command] does, see (barf-if-buffer-read-only) (or location (setq location (cdr (antlr-option-kind level)))) (cond ((null level) + ;; TODO: better msg if there is (currently) no such option (error "Cannot deduce what kind of option to insert")) ((atom location) (error "Cannot insert any %s options around here" @@ -1430,7 +2005,7 @@ This command might also set the mark like \\[set-mark-command] does, see (goto-char (max (point-min) (car area))) (re-search-forward (concat "\\(^\\|;\\)[ \t]*\\(\\<" (regexp-quote option) - "\\>\\)[ \t\n]*\\(\\(=[ \t]?\\)[ \t]*\\(\\(\\sw\\|\\s_\\)+\\|\"\\([^\n\"\\]\\|[\\][^\n]\\)*\"\\)?\\)?") + "\\_>\\)[ \t\n]*\\(\\(=[ \t]?\\)[ \t]*\\(\\(\\sw\\|\\s_\\)+\\|\"\\([^\n\"\\]\\|[\\][^\n]\\)*\"\\)?\\)?") ;; 2=name, 3=4+5, 4="=", 5=value (min (point-max) (cdr area)) t)) @@ -1449,7 +2024,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'. -Return \(LEVEL OPTION LOCATION)." +Use `current-prefix-arg' for ARG. 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)) @@ -1468,7 +2043,6 @@ Return \(LEVEL OPTION LOCATION)." (defun antlr-options-menu-filter (level _menu-items) "Return items for options submenu of level LEVEL." - ;; checkdoc-params: (menu-items) (let ((active (if buffer-read-only nil (consp (cdr-safe (cdr (antlr-option-kind level))))))) @@ -1505,7 +2079,7 @@ like \(AREA . PLACE), see `antlr-option-location'." ((not (eq level 3)) ; grammar or subrule options (setq pos (point)) (antlr-c-forward-sws)) - ((looking-at "^\\(private[ \t\n]\\|public[ \t\n]\\|protected[ \t\n]\\)?[ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t\n]*\\(!\\)?[ \t\n]*\\(\\[\\)?") + ((looking-at "^\\(private[ \t\n]\\|public[ \t\n]\\|protected[ \t\n]\\|fragment[ \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))) (setq pos (antlr-skip-sexps (if (match-end 5) 1 0))) @@ -1540,51 +2114,51 @@ the rule/subrule after the init action. Otherwise, the point position is undefined." (widen) (if (eq requested 1) - 1 - (with-syntax-table antlr-action-syntax-table - (antlr-invalidate-context-cache) - (let* ((orig (point)) - (outsidep (antlr-outside-rule-p)) - bor depth) - (if (eq (char-after) ?\{) (antlr-skip-sexps 1)) - (setq bor (point)) ; beginning of rule (after init action) - (cond ((eq requested 2) ; grammar options required? - (let (boc) ; beginning of class - (goto-char (point-min)) - (while (and (<= (point) bor) - (antlr-re-search-forward antlr-class-header-regexp - nil)) - (if (<= (match-beginning 0) bor) - (setq boc (match-end 0)))) - (when boc - (goto-char boc) - 2))) - ((save-excursion ; in region of file options? - (goto-char (point-min)) - (antlr-skip-file-prelude t) ; ws/comment after: OK - (< orig (point))) - (and (null requested) 1)) - (outsidep ; outside rule not OK - nil) - ((looking-at antlr-class-header-regexp) ; rule = class def? - (goto-char (match-end 0)) - (and (null requested) 2)) - ((eq requested 3) ; rule options required? - (goto-char bor) - 3) - ((setq depth (antlr-syntactic-grammar-depth orig bor)) - (if (> depth 0) ; move out of actions - (goto-char (scan-lists (point) -1 depth))) - (set-syntax-table antlr-mode-syntax-table) - (antlr-invalidate-context-cache) - (if (eq (antlr-syntactic-context) 0) ; not in subrule? - (unless (eq requested 4) - (goto-char bor) - 3) - (goto-char (1+ (scan-lists (point) -1 1))) - 4))))))) + (and (car antlr-options-alists) 1) + (let* ((orig (point)) + (outsidep (antlr-outside-rule-p)) + bor) + (setq bor (point)) ; beginning of rule + (cond ((eq requested 2) ; grammar options required? + (antlr-try-rule-or-grammar-option requested bor)) + ((and (car antlr-options-alists) ; file options available (v2) + (save-excursion ; in region of file options? + (goto-char (point-min)) + (antlr-skip-file-prelude t) ; ws/comment after: OK + (< orig (point)))) + (and (null requested) 1)) + (outsidep ; outside -> grammar option + (when (memq requested '(nil 2)) + (antlr-try-rule-or-grammar-option 2 bor))) + ((looking-at antlr-grammar-header-regexp) ; rule = class def? + (goto-char (match-end 0)) + (and (null requested) 2)) + ((or (eq requested 3) (null (elt antlr-options-alists 3))) + (antlr-try-rule-or-grammar-option requested bor)) + ((antlr-syntactic-grammar-depth orig bor t) + 4) + (t + (antlr-try-rule-or-grammar-option requested bor)))))) + +(defun antlr-try-rule-or-grammar-option (requested bor) + "Try whether rule or grammar option can be applied. +Called by function `antlr-option-level' with arguments REQUESTED, +and BOR poiting to the beginning of the current rule." + (or (and (memq requested '(nil 3)) (elt antlr-options-alists 2) + (progn (goto-char bor) 3)) + (and (memq requested '(nil 2)) (cadr antlr-options-alists) + (let (boc) ; beginning of class + (goto-char (point-min)) + (while (and (<= (point) bor) + (antlr-re-search-forward antlr-grammar-header-regexp nil)) + (if (<= (match-beginning 0) bor) + (setq boc (match-end 0)))) + (when boc + (goto-char boc) + 2))))) (defun antlr-option-location (orig min-vis max-vis min-area max-area withp) + ;; checkdoc-order: nil "Return location for the options area. ORIG is the original position of `point', MIN-VIS is `point-min' and MAX-VIS is `point-max'. If WITHP is non-nil, there exists an option @@ -1616,26 +2190,25 @@ non-nil." ;; use start of options area (only if `withp') (cons min-area 'beginning))))) -(defun antlr-syntactic-grammar-depth (pos beg) +(defun antlr-syntactic-grammar-depth (pos beg &optional outside-action) "Return syntactic context depth at POS. Move to POS and from there on to the beginning of the string or comment if POS is inside such a construct. Then, return the syntactic context depth at point if the point position is smaller than BEG. -WARNING: this may alter `match-data'." +WARNING: this may alter `match-data'. +With optional argument OUTSIDE-ACTION, move to beginning of action." (goto-char pos) - (let ((context (or (antlr-syntactic-context) 0))) - (while (and context (not (integerp context))) - (cond ((eq context 'string) - (setq context - (and (search-backward "\"" nil t) - (>= (point) beg) - (or (antlr-syntactic-context) 0)))) - ((memq context '(comment block-comment)) - (setq context - (and (re-search-backward "/[/*]" nil t) - (>= (point) beg) - (or (antlr-syntactic-context) 0)))))) - context)) + (let ((ppss (syntax-ppss))) + (when (or (nth 3 ppss) (nth 4 ppss)) ; string or comment -> to beginning + (goto-char (nth 8 ppss))) + (when outside-action + (let ((poss (nth 9 ppss)) ; TODO: syntax-ppss-open-positions + open) + (while (and poss (eq (char-after (car poss)) ?\()) + (setq open (pop poss))) + (when open + (goto-char (1+ open)) + (>= open beg)))))) ;;;=========================================================================== @@ -1643,6 +2216,7 @@ WARNING: this may alter `match-data'." ;;;=========================================================================== (defun antlr-insert-option-do (level option old area pos) + ;; checkdoc-order: nil "Insert option into buffer at position POS. Insert option of level LEVEL and name OPTION. If OLD is non-nil, an options area is already exists. If OLD looks like \(BEG . END), the @@ -1654,7 +2228,7 @@ If the original point position was outside an options area, AREA is nil. Otherwise, and if an option specification already exists, AREA is a cons cell where the two values determine the area inside the braces." (let* ((spec (cdr (assoc option (elt antlr-options-alists (1- level))))) - (value (antlr-option-spec level option (cdr spec) (consp old)))) + (value (cdr spec))) (if (fboundp (car spec)) (funcall (car spec) 'before-input option)) ;; set mark (unless point was inside options area before) (if (cond (area (eq antlr-options-push-mark t)) @@ -1677,7 +2251,6 @@ cell where the two values determine the area inside the braces." (elt antlr-options-headings (1- level)) option)) ;; option specification found - (setq value (cdr value)) (if (car value) (let ((initial (and (consp old) (cdr old) (buffer-substring (car old) (cdr old))))) @@ -1703,42 +2276,13 @@ cell where the two values determine the area inside the braces." ;; final ----------------------------------------------------------------- (if (fboundp (car spec)) (funcall (car spec) 'after-insertion option)))) -(defun antlr-option-spec (level option specs existsp) - "Return version correct option value specification. -Return specification for option OPTION of kind level LEVEL. SPECS -should correspond to the VALUE-SPEC... in `antlr-options-alists'. -EXISTSP determines whether the option already exists." - (let (value) - (while (and specs (>= antlr-tool-version (caar specs))) - (setq value (pop specs))) - (cond (value) ; found correct spec - ((null specs) nil) ; didn't find any specs - (existsp (car specs)) ; wrong version, but already present - ((y-or-n-p (format "Insert v%s %s option %s in v%s? " - (antlr-version-string (caar specs)) - (elt antlr-options-headings (1- level)) - option - (antlr-version-string antlr-tool-version))) - (car specs)) - (t - (error "Didn't insert v%s %s option %s in v%s" - (antlr-version-string (caar specs)) - (elt antlr-options-headings (1- level)) - option - (antlr-version-string antlr-tool-version)))))) - -(defun antlr-version-string (version) - "Format the Antlr version number VERSION, see `antlr-tool-version'." - (let ((version100 (/ version 100))) - (format "%d.%d.%d" - (/ version100 100) (mod version100 100) (mod version 100)))) - ;;;=========================================================================== ;;; Insert options: the details (used by `antlr-insert-option-do') ;;;=========================================================================== (defun antlr-insert-option-existing (old value) + ;; checkdoc-order: nil "Insert option value VALUE at point for existing option. For OLD, see `antlr-insert-option-do'." ;; no = => insert = @@ -1777,7 +2321,7 @@ For AREA and OLD, see `antlr-insert-option-do'." (skip-chars-forward " \t") (if (looking-at "$\\|//") - ;; just comment after point => skip (+ lines with same col comment) + ;; just comment after point => skip (+ lines with same col comment) (let ((same (if (> (match-end 0) (match-beginning 0)) (current-column)))) (beginning-of-line 2) @@ -1831,9 +2375,8 @@ Used by `antlr-insert-option-do'." "Read a string from the minibuffer, possibly with completion. If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. PROMPT is a string to prompt with, normally it ends in a colon and a -space. If AS-STRING is t or is a member \(comparison done with `eq') of -`antlr-options-style', return printed representation of the user input, -otherwise return the user input directly. +space. If AS-STRING is non-nil, return printed representation of the user +input, otherwise return the user input directly. If TABLE or TABLE-X is non-nil, read with completion. The completion table is the resulting alist of TABLE-X concatenated with TABLE where @@ -1847,10 +2390,10 @@ Used inside `antlr-options-alists'." (input (if table0 (completing-read prompt table0 nil nil initial-contents) (read-from-minibuffer prompt initial-contents)))) - (if (and as-string - (or (eq as-string t) - (cdr (assq as-string antlr-options-style)))) - (format "%S" input) + (if as-string + ;; if necessary, `use print-escape-newlines', `print-escape-nonascii' + ;; if strings should be used in v3/v4, write our own (single quote) + (format "%S" input) input))) (defun antlr-read-boolean (initial-contents prompt &optional table) @@ -1859,52 +2402,67 @@ If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. PROMPT is a string to prompt with, normally it ends in a question mark and a space. \"(true or false) \" is appended if TABLE is nil. -Read with completion over \"true\", \"false\" and the keys in TABLE, see -also `antlr-read-value'. +Without TABLE, use `y-or-n-p', otherwise read with completion +over \"true\", \"false\" and the keys in TABLE, see also +`antlr-read-value'. Used inside `antlr-options-alists'." - (antlr-read-value initial-contents - (if table prompt (concat prompt "(true or false) ")) - nil - table '(("false") ("true")))) + (if table + (antlr-read-value initial-contents prompt + nil table '(("false") ("true"))) + (if (y-or-n-p prompt) "true" "false"))) + +(defun antlr-read-language (initial-contents prompt) + "Read an action language from the minibuffer, with completion. +If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. +PROMPT is a string to prompt with, normally it ends in a colon and a +space. + +Used inside `antlr-options-alists'." + (let ((table (apply 'nconc + (mapcar (lambda (l) (mapcar #'list (cdr l))) + antlr-language-list)))) + (antlr-read-value initial-contents prompt nil table))) (defun antlr-language-option-extra (phase &rest _dummies) -;; checkdoc-params: (dummies) "Change language according to the new value of the \"language\" option. Call `antlr-mode' if the new language would be different from the value of `antlr-language', keeping the value of variable `font-lock-mode'. Called in PHASE `after-insertion', see `antlr-options-alists'." (when (eq phase 'after-insertion) - (let ((new-language (antlr-language-option t))) + (let ((new-language (antlr-guess-language))) (or (null new-language) (eq new-language antlr-language) - (let ((font-lock font-lock-mode)) + (let ((font-lock (and (boundp 'font-lock-mode) font-lock-mode))) (if font-lock (font-lock-mode 0)) - (antlr-mode) + (funcall major-mode) ; TODO: do differently? (and font-lock (null font-lock-mode) (font-lock-mode 1))))))) (defun antlr-c++-mode-extra (phase option &rest _dummies) -;; checkdoc-params: (option dummies) - "Warn if C++ option is used with the wrong language. + ;; checkdoc-order: nil + "Warn if C++ option OPTION is used with the wrong language. Ask user \(\"y or n\"), if a C++ only option is going to be inserted but -`antlr-language' has not the value `c++-mode'. +`antlr-language' has not the value `antlr-cpp'. Called in PHASE `before-input', see `antlr-options-alists'." (and (eq phase 'before-input) - (not (eq antlr-language 'c++-mode)) + (not (eq antlr-language 'antlr-cpp)) (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))))) + (error "Didn't insert Cpp %s option with language %s" + option antlr-language-mode-name))) ;;;=========================================================================== ;;; Compute dependencies ;;;=========================================================================== +;; This whole section is ANTLR-v2 specific. It is not used in v3 and v4. (defun antlr-file-dependencies () "Return dependencies for grammar in current buffer. -The result looks like \(FILE \(CLASSES . SUPERS) VOCABS . LANGUAGE) +This function is for ANTLR v2 grammars only. + +The result looks like \(FILE \(CLASSES . SUPERS) VOCABS . LANGUAGE) where CLASSES = ((CLASS . CLASS-EVOCAB) ...), SUPERS = ((SUPER . USE-EVOCAB-P) ...), and VOCABS = ((EVOCAB ...) . (IVOCAB ...)) @@ -1919,55 +2477,56 @@ its export vocabulary is used as an import vocabulary." (unless buffer-file-name (error "Grammar buffer does not visit a file")) (let (classes export-vocabs import-vocabs superclasses default-vocab) - (with-syntax-table antlr-action-syntax-table - (goto-char (point-min)) - (while (antlr-re-search-forward antlr-class-header-regexp nil) - ;; parse class definition -------------------------------------------- - (let* ((class (match-string 2)) - (sclass (match-string 4)) - ;; export vocab defaults to class name (first grammar in file) - ;; or to the export vocab of the first grammar in file: - (evocab (or default-vocab class)) - (ivocab nil)) - (goto-char (match-end 0)) - (antlr-c-forward-sws) - (while (looking-at "options\\>\\|\\(tokens\\)\\>") - (if (match-beginning 1) - (antlr-skip-sexps 2) - (goto-char (match-end 0)) - (antlr-c-forward-sws) - ;; parse grammar option sections ------------------------------- - (when (eq (char-after (point)) ?\{) - (let* ((beg (1+ (point))) - (end (1- (antlr-skip-sexps 1))) - (cont (point))) + (goto-char (point-min)) + (while (antlr-re-search-forward antlr-grammar-header-regexp nil) + ;; parse class definition -------------------------------------------- + (let* ((class (match-string-no-properties 2)) + (sclass (match-string-no-properties 4)) + ;; export vocab defaults to class name (first grammar in file) + ;; or to the export vocab of the first grammar in file: + (evocab (or default-vocab class)) + (ivocab nil)) + (goto-char (match-end 0)) + (antlr-c-forward-sws) + (while (looking-at "options\\_>\\|\\(tokens\\)\\_>") + (if (match-beginning 1) + (antlr-skip-sexps 2) + (goto-char (match-end 0)) + (antlr-c-forward-sws) + ;; parse grammar option sections ------------------------------- + (when (eq (char-after (point)) ?\{) + (let* ((beg (1+ (point))) + (end (1- (antlr-skip-sexps 1))) + (cont (point))) (goto-char beg) - (if (re-search-forward "\\ (FILE . EVOCAB) ... (deps (cdr deps0)) ; FILE -> (c . s) (ev . iv) . LANGUAGE (with-error nil) - (gen-sep (or (caddr (cadr antlr-makefile-specification)) " ")) + (gen-sep (or (cl-caddr (cadr antlr-makefile-specification)) " ")) (n (and (cdr deps) (cadr antlr-makefile-specification) 0))) (or in-makefile (set-buffer standard-output)) (dolist (dep deps) - (let ((supers (cdadr dep)) - (lang (cdr (assoc (cdddr dep) antlr-file-formats-alist)))) + (let ((supers (cl-cdadr dep)) + (lang (cdr (assoc (cl-cdddr dep) antlr-file-formats-alist)))) (if n (cl-incf n)) (antlr-makefile-insert-variable n "" " =") (if supers (insert " " (format (cadr antlr-special-file-formats) (file-name-sans-extension (car dep))))) - (dolist (class-def (caadr dep)) + (dolist (class-def (cl-caadr dep)) (let ((sep gen-sep)) (dolist (class-file (cadr lang)) (insert sep (format class-file (car class-def))) (setq sep " ")))) - (dolist (evocab (caaddr dep)) + (dolist (evocab (cl-caaddr dep)) (let ((sep gen-sep)) (dolist (vocab-file (cons (car antlr-special-file-formats) (car lang))) @@ -2126,7 +2726,7 @@ command `antlr-show-makefile-rules' for detail." (setq sep " ")))) (antlr-makefile-insert-variable n "\n$(" ")") (insert ": " (car dep)) - (dolist (ivocab (cdaddr dep)) + (dolist (ivocab (cl-cdaddr dep)) (insert " " (format (car antlr-special-file-formats) ivocab))) (let ((glibs (antlr-superclasses-glibs supers classes))) (if (cadr glibs) (setq with-error t)) @@ -2136,7 +2736,7 @@ command `antlr-show-makefile-rules' for detail." (insert " " (format (car antlr-special-file-formats) (cdr super))))) (insert "\n\t" - (caddr antlr-makefile-specification) + (cl-caddr antlr-makefile-specification) (car glibs) " $<\n" (car antlr-makefile-specification))))) @@ -2146,8 +2746,10 @@ command `antlr-show-makefile-rules' for detail." (while (<= (cl-incf i) n) (antlr-makefile-insert-variable i " $(" ")")) (insert "\n" (car antlr-makefile-specification)))) - (if (string-equal (car antlr-makefile-specification) "\n") - (delete-char -1)) + (if (bobp) + (setq with-error t) + (if (string-equal (car antlr-makefile-specification) "\n") + (delete-char -1))) (when with-error (goto-char (point-min)) (insert antlr-help-unknown-file-text)) @@ -2160,6 +2762,8 @@ command `antlr-show-makefile-rules' for detail." ;;;###autoload (defun antlr-show-makefile-rules () "Show Makefile rules for all grammar files in the current directory. +This command is for ANTLR v2 grammars only. + If the `major-mode' of the current buffer has the value `makefile-mode', the rules are directory inserted at point. Otherwise, a *Help* buffer is shown with the rules which are also put into the `kill-ring' for @@ -2175,10 +2779,12 @@ are used according to variable `antlr-unknown-file-formats' and a commentary with value `antlr-help-unknown-file-text' is added. The *Help* buffer always starts with the text in `antlr-help-rules-intro'." (interactive) + (unless (eq antlr-tool-version 'antlr-v2) + (user-error (substitute-command-keys + "Run \\[antlr-run-tool] with option \"-depend\" instead"))) (if (null (derived-mode-p 'makefile-mode)) - (with-output-to-temp-buffer "*Help*" - (save-excursion - (antlr-insert-makefile-rules))) + (with-output-to-temp-buffer (help-buffer) + (save-excursion (antlr-insert-makefile-rules))) (push-mark) (antlr-insert-makefile-rules t))) @@ -2189,18 +2795,18 @@ 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 grammar lines are calculated by `c-basic-offset', -multiplied by: +The default 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, - exception part, + exception part, customized by `antlr-base-offset-alist', - minus 1 if `antlr-indent-item-regexp' matches the beginning of the line starting from the first non-whitespace. Lines inside block comments are indented by `c-indent-line' according to `antlr-indent-comment'. -Lines in actions except top-level actions in a header part or an option +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' @@ -2209,10 +2815,11 @@ 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'." + ;; TODO: this function needs to be rewritten (save-restriction (let ((orig (point)) (min0 (point-min)) - bol boi indent syntax cc-syntax) + bol boi indent syntax cc-syntax boa pdepth) (widen) (beginning-of-line) (setq bol (point)) @@ -2221,32 +2828,64 @@ to a lesser extent, `antlr-tab-offset-alist'." (skip-chars-forward " \t") (setq boi (point)) ;; check syntax at beginning of indentation ---------------------------- - (with-syntax-table antlr-action-syntax-table - (antlr-invalidate-context-cache) - (setq syntax (antlr-syntactic-context)) - (cond ((symbolp syntax) - (setq indent nil)) ; block-comments, strings, (comments) - ((progn - (antlr-next-rule -1 t) - (if (antlr-search-forward ":") (< boi (1- (point))) t)) - (setq indent 0)) ; in rule header - ((if (antlr-search-forward ";") (< boi (point)) t) - (setq indent 2)) ; in rule body - (t - (forward-char) - (antlr-skip-exception-part nil) - (setq indent (if (> (point) boi) 1 0))))) ; in exception part? + (let* ((ppss (syntax-ppss)) + (context (antlr-syntactic-context ppss)) + (open (nth 9 ppss))) ; TODO Emacs: syntax-ppss-open-positions + (setq syntax (or context 0)) + (setq pdepth (car ppss)) + ;; TODO: should boa = first non-?\( in (nth 9 ppss) ? + (when (numberp context) ; boa = beginning of action + (setq boa (nth (- (length open) context) open)))) + (cond ((symbolp syntax) + (setq indent nil)) ; block-comments, strings, (comments) -> cc engine + ((progn + (antlr-next-rule -1 t) ; to start of rule + (= (point) boi)) + (setq indent 0)) ; rule start always at 0 + ;; TODO: use antlr-skip-to-colon-or-semi + + ((if (let ((r (antlr-search-forward antlr-rule-body-start-op))) + (while (and r (eq (char-after) ?:)) ; skip double-colon + (forward-char) + (setq r (antlr-search-forward antlr-rule-body-start-op))) + r) + (< boi (1- (point))) + t) + (setq indent + (or (cdr (assq :header antlr-base-offset-alist)) 0))) + ((eq (char-after boi) ?:) + (setq indent + (or (cdr (assq :colon antlr-base-offset-alist)) + (cdr (assq :body antlr-base-offset-alist)) + 2))) + ((if (antlr-search-forward ";" antlr-skip-line-regexp) + (< boi (point)) + t) + (setq indent + (or (cdr (assq :body antlr-base-offset-alist)) 2))) + (t + (forward-char) + (antlr-skip-rule-postlude nil) + (setq indent + (if (> (point) boi) + (or (cdr (assq :exception antlr-base-offset-alist)) 1) + 0)))) ; in exception part? ;; 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 + (cond ((> syntax 1) ; block in action => use cc-mode (or nothing) + (setq indent nil) + (when antlr-indent-action-line + (setq syntax 'non-cc))) + ((and (= indent 0) ; TODO: recheck + (assq antlr-action-mode antlr-indent-at-bol-alist) + (looking-at (cdr (assq antlr-action-mode antlr-indent-at-bol-alist)))) (setq syntax 'bol)) + ((memq (char-after) '(?\} ?\]))) ; close the block -> usual grammar indent + (antlr-indent-action-line + ;; TODO: parameters, and mode-specific - should we handle options{} and tokens{} extra? + (setq indent nil syntax 'non-cc)) ((setq cc-syntax (c-guess-basic-syntax)) (let ((cc cc-syntax) symbol) (while (setq symbol (pop cc)) @@ -2255,30 +2894,29 @@ to a lesser extent, `antlr-tab-offset-alist'." 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 "\\ then we simply indent + ;; according to indent-level (then we do not have to check + ;; whether the LANGUAGE indents at col 0 (and use C indent) + (funcall antlr-indent-action-line boa)) + ((or (numberp syntax) + (if (eq syntax 'string) nil (eq antlr-indent-comment t))) + (c-indent-line cc-syntax)))) ;; do it ourselves (goto-char boi) (unless (symbolp syntax) ; direct indentation - ;;(antlr-invalidate-context-cache) - (cl-incf indent (antlr-syntactic-context)) - (and (> indent 0) (looking-at antlr-indent-item-regexp) (decf indent)) + (cl-incf indent pdepth) + (and (> indent 0) (looking-at antlr-indent-item-regexp) + (cl-decf indent)) (setq indent (* indent c-basic-offset))) ;; the usual major-mode indent stuff --------------------------------- + ;; TODO: use `indent-line-to' instead? (setq orig (- (point-max) orig)) (unless (= (current-column) indent) (delete-region bol boi) @@ -2290,12 +2928,13 @@ to a lesser extent, `antlr-tab-offset-alist'." (goto-char (- (point-max) orig))))))) (defun antlr-indent-command (&optional arg) + ;; TODO: drop this command if there is a extra function for `indent-region' "Indent the current line or insert tabs/spaces. -With optional prefix argument ARG or if the previous command was this -command, insert ARG tabs or spaces according to `indent-tabs-mode'. +With optional prefix argument ARG, insert ARG tabs or spaces according +to `indent-tabs-mode'. Otherwise, indent the current line with `antlr-indent-line'." (interactive "*P") - (if (or arg (eq last-command 'antlr-indent-command)) + (if arg (insert-tab arg) (let ((antlr-indent-comment (and antlr-indent-comment t))) ; dynamic (antlr-indent-line)))) @@ -2317,124 +2956,202 @@ ANTLR's syntax and influences the auto indentation, see (interactive "*P") (if (or arg (save-excursion (skip-chars-backward " \t") (not (bolp))) - (with-syntax-table antlr-action-syntax-table - (antlr-invalidate-context-cache) - (let ((context (antlr-syntactic-context))) - (not (and (numberp context) - (or (zerop context) - (memq last-command-event '(?\{ ?\})))))))) + (let ((context (antlr-syntactic-context))) + (and context + (not (and (numberp context) + (memq last-command-event '(?\{ ?\}))))))) (self-insert-command (prefix-numeric-value arg)) (self-insert-command (prefix-numeric-value arg)) (antlr-indent-line))) +(defun antlr-insert-keyword-rule (&optional keyword) + "Insert token rule for an case-insensitive keyword KEYWORD at point." + (interactive "sKeyword: ") + ;; Should be probably made a bit customizable... + (insert (upcase keyword) " : " + (mapconcat (lambda (c) + (let ((d (downcase c)) (u (upcase c))) + (cond ((eq d u) (string ?\' c ?\')) + ((eq antlr-tool-version 'antlr-v4) + (string ?\[ d u ?\])) + (t (string ?\( ?\' d ?\' ?| ?\' u ?\' ?\)))))) + keyword "") + " ;\n")) + ;;;=========================================================================== ;;; 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) t)))) - (setq settings (cddr settings))))) - -(defun antlr-language-option (search) - "Find language in `antlr-language-alist' for language option. -If SEARCH is non-nil, find element for language option. Otherwise, find -the default language." - (let ((value - (and search - (save-excursion - (goto-char (point-min)) - (re-search-forward (cdr antlr-language-limit-n-regexp) - (+ (point) - (car antlr-language-limit-n-regexp)) - t)) - (match-string 1))) - (seq antlr-language-alist) - r) - ;; Like (find VALUE antlr-language-alist :key 'cddr :test 'member) - (while seq - (setq r (pop seq)) - (if (member value (cddr r)) - (setq seq nil) ; stop - (setq r nil))) ; no result yet - (car r))) +(defun antlr-guess-language () + "Find language in `antlr-language-list' for language option. +If not found, use the default, which is the first element." + ;; TODO: think about save-restriction & widen + (save-excursion + (goto-char (point-min)) + (when (re-search-forward (cdr antlr-language-limit-n-regexp) + (+ (point) + (car antlr-language-limit-n-regexp)) + t) + (car (cl-find (match-string-no-properties 1) antlr-language-list + :key 'cdr :test 'member))))) + +(defun antlr-guess-tool-version () + "Guess whether current grammar is for ANTLR v2 or v3. +By default, we assume v3. Only if we find a keyword 'class' or +'header' at the beginning of a line before any 'grammar' keyword, +we assume v2." + (save-excursion + (goto-char (point-min)) + (if (and (antlr-re-search-forward "^\\(lexer[ \t]+grammar\\|parser[ \t]+grammar\\|tree[ \t]+grammar\\|grammar\\|\\(class\\|header\\)\\)\\_>" (+ (point) (car antlr-language-limit-n-regexp))) + (match-beginning 2)) ; class or header + 'antlr-v2 + 'antlr-v3))) + +(defun antlr-skip-import-statement () + "Skip whitespaces, comments and special declarations after the header. +See `antlr-skip-line-regexp', which skips the 'scope' declaration in +ANTLR v3, and the 'import' declaration in ANTLR v4." + (if (not (and antlr-skip-line-regexp (looking-at antlr-skip-line-regexp))) + (antlr-skip-sexps 1) + (goto-char (match-end 0)) + (prog1 (point) + (antlr-c-forward-sws)))) + +(defun antlr-set-local-variables (selector-symbol selector variables) + ;; checkdoc-order: nil + "Set SELECTOR dependent local variables for VARIABLES. +Also set SELECTOR-SYMBOL to SELECTOR. +See `antlr-tool-version-variables' and `antlr-language-variables'." + (unless (symbolp selector) + (error "Illegal selector %s" selector)) + (let ((required t) (prefix (symbol-name selector))) + (dolist (var variables) + (if (eq var '&optional) + (setq required nil) + (let ((name (symbol-name var))) + (unless (and (string-match "\\`antlr-" name) (boundp var)) + (error "Illegal element %s" var)) + (let ((valsym (intern (concat prefix (substring name 5))))) + (when (or (boundp valsym) required) + (set (make-local-variable var) (symbol-value valsym))))))) + (set (make-local-variable selector-symbol) selector) + nil)) + +;; I would have guessed that there is a possibility to run code at the end of +;; initializing a major mode which is definitely run at the end (with or +;; without local variables enabled). That is not the case... (only hard-coded +;; for font-lock). Hence, we run some code twice with local variables... + +(defun antlr-hack-local-variables-hook () + "Late setup for buffers with a local variables spec. +This function is used in `hack-local-variables-hook'." + (and (derived-mode-p 'antlr-mode) + (or (assq 'antlr-tool-version file-local-variables-alist) + (assq 'antlr-language file-local-variables-alist)) + (antlr-set-tool-version-and-mode-line))) + +(add-hook 'hack-local-variables-hook 'antlr-hack-local-variables-hook) + +(defun antlr-set-tool-version-and-mode-line () + "Late setup for `antlr-mode' and sub modes." + ;; tool and language version and dependent variables ----------------------- + (let ((guess (if (local-variable-p 'antlr-tool-version) + ;; backward-compatibility: + (if (numberp antlr-tool-version) 'antlr-v2 antlr-tool-version) + (antlr-guess-tool-version)))) + (when (with-demoted-errors "File mode error for `antlr-tool-version': %s" + (antlr-set-local-variables 'antlr-tool-version guess + antlr-tool-version-variables)) + (antlr-set-local-variables 'antlr-tool-version 'antlr-v3 + antlr-tool-version-variables))) + (let ((guess (if (local-variable-p 'antlr-language) + (or (cdr (assq antlr-language ; backward compatibility + '((java-mode . antlr-java) (c++-mode . antlr-cpp)))) + antlr-language) + (antlr-guess-language)))) + (when (with-demoted-errors "File mode error for `antlr-language': %s" + (antlr-set-local-variables 'antlr-language + (or guess (caar antlr-language-list)) + antlr-language-variables)) + (antlr-set-local-variables 'antlr-language 'antlr-java + antlr-language-variables))) + ;; language-dependent initializations -------------------------------------- + (c-init-language-vars-for antlr-init-cc-mode) + (c-basic-common-init antlr-init-cc-mode ; sets `indent-line-function' etc + (or antlr-indent-style "gnu")) + (funcall antlr-init-submode) + (set (make-local-variable 'indent-line-function) #'antlr-indent-line) + (set (make-local-variable 'indent-region-function) nil) ; TODO + ;; syntax-propertize ------------------------------------------------------- + (when antlr-syntax-propertize + (setq-local syntax-propertize-function (car antlr-syntax-propertize)) + (unless (eq (cadr antlr-syntax-propertize) t) + (if (functionp (cadr antlr-syntax-propertize)) + (add-hook 'syntax-propertize-extend-region-functions + (cadr antlr-syntax-propertize) 'append 'local) + (setq-local syntax-propertize-extend-region-functions + (cadr antlr-syntax-propertize)))) + (when (nth 2 antlr-syntax-propertize) + (setq-local c-multiline-string-start-char + (if c-multiline-string-start-char t + (nth 2 antlr-syntax-propertize)))) + (when antlr-do-syntax-propertize ; at least for imenu in Emacs-24.5 + (syntax-propertize (point-max)))) + ;; Before I had moved `imenu-add-to-menubar' from function `antlr-mode', it + ;; had already scanned the buffer before I have set `antlr-tool-version' here + ;; (variables which depend on it). Thus, I move the imenu function to this + ;; function, too... (do we need to explicitly call `imenu-update-menubar' to + ;; be on the safe side?) + (and antlr-imenu-name ; there should be a global variable... + (fboundp 'imenu-add-to-menubar) + (imenu-add-to-menubar + (if (stringp antlr-imenu-name) antlr-imenu-name "Index"))) + (setq mode-name ; TODO: or use ("" ...)? + (concat antlr-tool-mode-name "." antlr-language-mode-name))) + + +(defvar antlr-delayed-mode-hook '(antlr-set-tool-version-and-mode-line) + "Hook run after entering Antlr mode or a derived mode.") ;;;###autoload (define-derived-mode antlr-mode prog-mode - ;; FIXME: Since it uses cc-mode, it bumps into c-update-modeline's - ;; limitation to mode-name being a string. - ;; '("Antlr." (:eval (cadr (assq antlr-language antlr-language-alist)))) "Antlr" "Major mode for editing ANTLR grammar files." :abbrev-table antlr-mode-abbrev-table (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 ---------------------------------------------------------- - (unless antlr-language - (set (make-local-variable 'antlr-language) - (or (antlr-language-option t) (antlr-language-option nil)))) - (if (stringp (cadr (assq antlr-language antlr-language-alist))) - (setq mode-name - (concat "Antlr." - (cadr (assq antlr-language antlr-language-alist))))) - ;; indentation, for the C engine ------------------------------------------- - (setq c-buffer-is-cc-mode antlr-language) - (c-init-language-vars-for antlr-language) - (c-basic-common-init antlr-language (or antlr-indent-style "gnu")) + (set (make-local-variable 'require-final-newline) mode-require-final-newline) (set (make-local-variable 'outline-regexp) "[^#\n\^M]") (set (make-local-variable 'outline-level) #'c-outline-level) ;TODO: define own - (set (make-local-variable 'indent-line-function) #'antlr-indent-line) - (set (make-local-variable 'indent-region-function) nil) ; too lazy (setq comment-start "// " comment-end "" - comment-start-skip "/\\*+ *\\|// *") + comment-start-skip "/\\*+ *\\|//+ *") ;; various ----------------------------------------------------------------- (set (make-local-variable 'font-lock-defaults) antlr-font-lock-defaults) (set (make-local-variable 'imenu-create-index-function) #'antlr-imenu-create-index-function) (set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test - (and antlr-imenu-name ; there should be a global variable... - (imenu-add-to-menubar - (if (stringp antlr-imenu-name) antlr-imenu-name "Index"))) - (antlr-set-tabs)) + (easy-menu-add antlr-mode-menu) + (run-mode-hooks 'antlr-delayed-mode-hook)) ;; A smarter version of `group-buffers-menu-by-mode-then-alphabetically' (in ;; XEmacs) could use the following property. The header of the submenu would ;; be "Antlr" instead of "Antlr.C++" or (not and!) "Antlr.Java". (put 'antlr-mode 'mode-name "Antlr") +;;;###autoload +(define-derived-mode antlr-v4-mode antlr-mode + "Antlr" ; use this in the menubar, see below for the mode line + "Major mode for editing ANTLR v4 grammar files." + :syntax-table nil + :abbrev-table nil + (set (make-local-variable 'antlr-tool-version) 'antlr-v4)) + ;;;###autoload (defun antlr-set-tabs () "Use ANTLR's convention for TABs according to `antlr-tab-offset-alist'. -Used in `antlr-mode'. Also a useful function in `java-mode-hook'." +Used in `antlr-mode' for cc-mode-based languages. +It is probably better to automatically deduce the TAB setting." (if buffer-file-name (let ((alist antlr-tab-offset-alist) elem) (while alist @@ -2442,12 +3159,237 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'." (and (or (null (car elem)) (eq (car elem) major-mode)) (or (null (cadr elem)) (string-match (cadr elem) buffer-file-name)) - (setq tab-width (caddr elem) - indent-tabs-mode (cadddr elem) + (setq tab-width (cl-caddr elem) + indent-tabs-mode (cl-cadddr elem) alist nil)))))) -(provide 'antlr-mode) -;; Local IspellPersDict: .ispell_antlr +;;;=========================================================================== +;;; CC-mode languages +;;;=========================================================================== + +(defvar antlr-c-language-mode-name "C" + "Value for `antlr-language-mode-name' when using language `antlr-c'.") +(defvar antlr-cpp-language-mode-name "Cpp" + "Value for `antlr-language-mode-name' when using language `antlr-cpp'.") +(defvar antlr-objc-language-mode-name "ObjC" + "Value for `antlr-language-mode-name' when using language `antlr-objc'.") + +(defvar antlr-c-action-mode 'c-mode + "Value for `antlr-action-mode' when using language `antlr-c'.") +(defvar antlr-cpp-action-mode 'c++-mode + "Value for `antlr-action-mode' when using language `antlr-cpp'.") +(defvar antlr-objc-action-mode 'objc-mode + "Value for `antlr-action-mode' when using language `antlr-objc'.") + +(defvar antlr-c-init-cc-mode 'c-mode + "Value for `antlr-init-cc-mode' when using language `antlr-c'.") +(defvar antlr-cpp-init-cc-mode 'c++-mode + "Value for `antlr-init-cc-mode' when using language `antlr-cpp'.") +(defvar antlr-obj-init-cc-mode 'objc-mode + "Value for `antlr-init-cc-mode' when using language `antlr-objc'.") + +(defvar antlr-c-action-font-lock-keywords + '(antlr-no-action-keywords + c-font-lock-keywords-1 c-font-lock-keywords-2 + c-font-lock-keywords-3) + "Value for `antlr-action-font-lock-keywords' when using language `antlr-c'.") +(defvar antlr-cpp-action-font-lock-keywords + '(antlr-no-action-keywords + c++-font-lock-keywords-1 c++-font-lock-keywords-2 + c++-font-lock-keywords-3) + "Value for `antlr-action-font-lock-keywords' when using language `antlr-cpp'.") +(defvar antlr-objc-action-font-lock-keywords + '(antlr-no-action-keywords + objc-font-lock-keywords-1 objc-font-lock-keywords-2 + objc-font-lock-keywords-3) + "Value for `antlr-action-font-lock-keywords' when using language `antlr-objc'.") + + +;;;=========================================================================== +;;; JavaScript +;;;=========================================================================== + +(declare-function js-indent-line "js") +;; TODO: better support for js2-mode? + +(defvar antlr-js-language-mode-name "Js" + "Value for `antlr-language-mode-name' when using language `antlr-js'.") + +(defvar antlr-js-action-mode 'js-mode + "Value for `antlr-action-mode' when using language `antlr-js'.") + +(defvar antlr-js-init-submode 'antlr-init-js + "Value for `antlr-init-submode' when using language `antlr-js'.") + +(defvar antlr-js-action-font-lock-keywords + '(antlr-no-action-keywords + ;; do not use `js--font-lock-keywords-3' ! + js--font-lock-keywords-1 js--font-lock-keywords-2) + "Value for `antlr-action-font-lock-keywords' when using language `antlr-js'.") +(defvar antlr-js-indent-action-line 'antlr-js-indent-action-line + "Value for `antlr-indent-action-line' when using language `antlr-js'.") + +(defun antlr-init-js () + "Initialize action language `antlr-js'." + (require 'js)) + +(defun antlr-js-indent-action-line (_boa) + "Indent the current line in an JavaScript action." + (js-indent-line)) + + +;;;=========================================================================== +;;; Delphi (opascal) +;;;=========================================================================== + +(declare-function opascal-indent-line "opascal") +(defvar opascal-compound-block-indent) +(defvar opascal-indent-level) +(defvar opascal-case-label-indent) + +(defvar antlr-delphi-language-mode-name "Delphi" + "Value for `antlr-language-mode-name' when using language `antlr-delphi'.") + +(defvar antlr-delphi-action-mode 'opascal-mode + "Value for `antlr-action-mode' when using language `antlr-delphi'.") + +(defvar antlr-delphi-init-submode 'antlr-init-delphi + "Value for `antlr-init-submode' when using language `antlr-delphi'.") + +(defvar antlr-delphi-action-font-lock-keywords + '(antlr-no-action-keywords + opascal-font-lock-keywords) + "Value for `antlr-action-font-lock-keywords' when using language `antlr-delphi'.") + +(defvar antlr-delphi-indent-action-line 'antlr-delphi-indent-action-line + "Value for `antlr-indent-action-line' when using language `antlr-delphi'.") + +(defun antlr-init-delphi () + "Initialize action language `antlr-delphi'." + (require 'opascal) + (when (integerp c-basic-offset) + (when (equal opascal-compound-block-indent opascal-indent-level) + (setq-local opascal-compound-block-indent c-basic-offset)) + (when (equal opascal-case-label-indent opascal-indent-level) + (setq-local opascal-case-label-indent c-basic-offset)) + (setq-local opascal-indent-level c-basic-offset))) + +(defun antlr-delphi-indent-action-line (boa) + "Indent the current line in a Delphi (opascal) action. +Argument BOA is the start position of the action." + (narrow-to-region (1+ boa) (point-at-eol)) + ;; make Pascal mode only checks the code fragment after the opening brace, + ;; otherwise its indentation gets confused as {...} are block comments + (opascal-indent-line) + ;; or use low-level `opascal-corrected-indentation' - but that does not have + ;; a docstring, i.e. not really official ? + (widen) + (unless (memq (char-after (point-at-bol)) '(?\ ?\t)) + ;; no indentation -> considered top-level -> indentation can also be + ;; performed by c-mode + (c-indent-line))) + + +;;;=========================================================================== +;;; Ruby +;;;=========================================================================== + +(declare-function ruby-indent-line "ruby-mode") +(defvar ruby-indent-level) +(defvar ruby-use-smie) + +(defvar antlr-ruby-language-mode-name "Ruby" + "Value for `antlr-language-mode-name' when using language `antlr-ruby'.") + +(defvar antlr-ruby-action-mode 'ruby-mode + "Value for `antlr-action-mode' when using language `antlr-ruby'.") + +(defvar antlr-ruby-init-submode 'antlr-init-ruby + "Value for `antlr-init-submode' when using language `antlr-ruby'.") + +(defvar antlr-ruby-action-font-lock-keywords + '(antlr-no-action-keywords + ruby-font-lock-keywords) + "Value for `antlr-action-font-lock-keywords' when using language `antlr-ruby'.") + +(defvar antlr-ruby-indent-action-line 'antlr-ruby-indent-action-line + "Value for `antlr-indent-action-line' when using language `antlr-ruby'.") + +(defun antlr-init-ruby () + "Initialize action language `antlr-ruby'." + (require 'ruby-mode) + (setq-local ruby-indent-level c-basic-offset) + ;; Disable smie as long as we do not have a function for a part of + ;; `ruby-mode-variables' + (setq-local ruby-use-smie nil)) + +(defun antlr-ruby-indent-action-line (boa) + "Indent the current line in a Ruby action. +Argument BOA is the start position of the action." + (narrow-to-region (1+ boa) (point-at-eol)) + (ruby-indent-line) + (widen) + (unless (memq (char-after (point-at-bol)) '(?\ ?\t)) + ;; no indentation -> considered top-level -> indentation can also be + ;; performed by cc-mode + (c-indent-line))) + + +;;;=========================================================================== +;;; Python +;;;=========================================================================== + +(declare-function python-indent-line "python") +(defvar prog-indentation-context) + +(defvar antlr-python-language-mode-name "Python" + "Value for `antlr-language-mode-name' when using language `antlr-python'.") + +(defvar antlr-python-action-mode 'python-mode + "Value for `antlr-action-mode' when using language `antlr-python'.") + +(defvar antlr-python-init-submode 'antlr-init-python + "Value for `antlr-init-submode' when using language `antlr-python'.") + +(defvar antlr-python-action-font-lock-keywords + '(antlr-no-action-keywords + python-font-lock-keywords) + "Value for `antlr-action-font-lock-keywords' when using language `antlr-python'.") + +(defvar antlr-python-indent-action-line 'antlr-python-indent-action-line + "Value for `antlr-indent-action-line' when using language `antlr-python'.") + +(defun antlr-init-python () + "Initialize action language `antlr-python'." + (require 'python)) + +(defun antlr-python-indent-action-line (boa) + "Indent the current line in a Python action. +Argument BOA is the start position of the action." + (let (leftouter) + (save-excursion + (goto-char boa) + (setq leftouter (current-indentation)) + (forward-char) + (skip-chars-forward " \t") + (setq boa (and (eq (char-after) ?\n) (point)))) + ;; a multi-line Python action does not start in its own line: this is a bad + ;; idea -> we do not touch those actions + (when (and boa + (eq antlr-indent-comment t) ; indent-region + (boundp 'prog-indentation-context)) ; Emacs 24.5 or later + (let ((syntax-ppss-cache nil) ;#dynamic, in older Emacs... + (syntax-ppss-last nil) ;#dynamic, in older Emacs... + ;; TODO: do we also need to call `syntax-propertize' or + ;; `syntax-ppss-flush-cache'? and/or bind + ;; `syntax-propertize-function'? + (prog-indentation-context ;#dynamic + (list (+ leftouter c-basic-offset) (list (1+ boa))))) + (narrow-to-region (1+ boa) (point-max)) + (python-indent-line (eq this-command 'antlr-indent-command)))))) + + +(provide 'antlr-mode) ;;; antlr-mode.el ends here