X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c1741bb3a10401c083afaad1a4cf1d8cb879f74e..b17f53abc28496125965f36147b76ea5f6a2b4fb:/lisp/progmodes/antlr-mode.el diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 1a35fe4186..d7e2ff3574 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -1,6 +1,7 @@ ;;; antlr-mode.el --- major mode for ANTLR grammar files -;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 +;; Free Software Foundation, Inc. ;; ;; Author: Christoph.Wedler@sap.com ;; Keywords: languages, ANTLR, code generator @@ -11,7 +12,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -21,8 +22,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -98,7 +99,7 @@ (and (eq (car args) :@) (null msg) ; (:@ ...spliced...) (setq args (cdr args) msg "(:@ ....) must return exactly one element")) - (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS)) + (let ((ignore (if (featurep 'xemacs) :EMACS :XEMACS)) (mode :BOTH) code) (while (consp args) (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args))) @@ -114,7 +115,7 @@ ;; existing functions when they are `fboundp', provide shortcuts if they are ;; known to be defined in a specific Emacs branch (for short .elc) (defmacro defunx (name arglist &rest definition) - (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses) + (let ((xemacsp (featurep 'xemacs)) reuses) (while (memq (car definition) '(:try :emacs-and-try :xemacs-and-try)) (if (eq (pop definition) (if xemacsp :xemacs-and-try :emacs-and-try)) @@ -151,7 +152,7 @@ (defmacro ignore-errors-x (&rest body) (let ((specials '((scan-sexps . 4) (scan-lists . 5))) spec nils) - (if (and (string-match "XEmacs" emacs-version) + (if (and (featurep 'xemacs) (null (cdr body)) (consp (car body)) (setq spec (assq (caar body) specials)) (>= (setq nils (- (cdr spec) (length (car body)))) 0)) @@ -165,7 +166,7 @@ `(let ((,modified (buffer-modified-p))) (unwind-protect (let ((buffer-undo-list t) (inhibit-read-only t) - ,@(unless (string-match "XEmacs" emacs-version) + ,@(unless (featurep 'xemacs) '((inhibit-point-motion-hooks t) deactivate-mark)) before-change-functions after-change-functions buffer-file-name buffer-file-truename) @@ -318,7 +319,7 @@ 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 an header action, indent the line at column 0 instead according +part of a header action, indent the line at column 0 instead according to the normal rules of `antlr-indent-line'." :group 'antlr :type '(repeat (cons (function :tag "Major mode") regexp))) @@ -567,7 +568,7 @@ The standard value contains the following functions as READ-FN: 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 iff +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'.") @@ -785,6 +786,7 @@ bound to `antlr-language'. For example, with value \((java-mode \. 2) (c++-mode \. 0)) Java actions are fontified with level 2 and C++ actions are not fontified at all." + :group 'antlr :type '(choice (const :tag "None" none) (const :tag "Inherit" inherit) (const :tag "Default" nil) @@ -826,65 +828,88 @@ font-lock keywords according to `font-lock-defaults' used for the code in the grammar's actions and semantic predicates, see `antlr-font-lock-maximum-decoration'.") -(defvar antlr-font-lock-default-face 'antlr-font-lock-default-face) -(defface antlr-font-lock-default-face nil +(defvar antlr-default-face 'antlr-default) +(defface antlr-default '((t nil)) "Face to prevent strings from language dependent highlighting. Do not change." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-default-face 'face-alias 'antlr-default) -(defvar antlr-font-lock-keyword-face 'antlr-font-lock-keyword-face) -(defface antlr-font-lock-keyword-face +(defvar antlr-keyword-face 'antlr-keyword) +(defface antlr-keyword (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "black" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-keyword-face))) "ANTLR keywords." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-keyword-face 'face-alias 'antlr-keyword) -(defvar antlr-font-lock-syntax-face 'antlr-font-lock-keyword-face) -(defface antlr-font-lock-syntax-face +(defvar antlr-syntax-face 'antlr-keyword) +(defface antlr-syntax (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "black" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-constant-face))) "ANTLR syntax symbols like :, |, (, ), ...." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-syntax-face 'face-alias 'antlr-syntax) -(defvar antlr-font-lock-ruledef-face 'antlr-font-lock-ruledef-face) -(defface antlr-font-lock-ruledef-face +(defvar antlr-ruledef-face 'antlr-ruledef) +(defface antlr-ruledef (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-function-name-face))) "ANTLR rule references (definition)." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-ruledef-face 'face-alias 'antlr-ruledef) -(defvar antlr-font-lock-tokendef-face 'antlr-font-lock-tokendef-face) -(defface antlr-font-lock-tokendef-face +(defvar antlr-tokendef-face 'antlr-tokendef) +(defface antlr-tokendef (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-function-name-face))) "ANTLR token references (definition)." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-tokendef-face 'face-alias 'antlr-tokendef) -(defvar antlr-font-lock-ruleref-face 'antlr-font-lock-ruleref-face) -(defface antlr-font-lock-ruleref-face - '((((class color) (background light)) (:foreground "blue4"))) +(defvar antlr-ruleref-face 'antlr-ruleref) +(defface antlr-ruleref + '((((class color) (background light)) (:foreground "blue4")) + (t :inherit font-lock-type-face)) "ANTLR rule references (usage)." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-ruleref-face 'face-alias 'antlr-ruleref) -(defvar antlr-font-lock-tokenref-face 'antlr-font-lock-tokenref-face) -(defface antlr-font-lock-tokenref-face - '((((class color) (background light)) (:foreground "orange4"))) +(defvar antlr-tokenref-face 'antlr-tokenref) +(defface antlr-tokenref + '((((class color) (background light)) (:foreground "orange4")) + (t :inherit font-lock-type-face)) "ANTLR token references (usage)." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-tokenref-face 'face-alias 'antlr-tokenref) -(defvar antlr-font-lock-literal-face 'antlr-font-lock-literal-face) -(defface antlr-font-lock-literal-face +(defvar antlr-literal-face 'antlr-literal) +(defface antlr-literal (cond-emacs-xemacs '((((class color) (background light)) - (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t)))) + (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t)) + (t :inherit font-lock-string-face))) "ANTLR special literal tokens. It is used to highlight strings matched by the first regexp group of `antlr-font-lock-literal-regexp'." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-literal-face 'face-alias 'antlr-literal) (defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" "Regexp matching literals with special syntax highlighting, or nil. @@ -903,56 +928,56 @@ group. The string matched by the first group is highlighted with (cond-emacs-xemacs `((antlr-invalidate-context-cache) ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))" - (1 antlr-font-lock-tokendef-face)) - ("\\$\\sw+" (0 font-lock-keyword-face)) + (1 antlr-tokendef-face)) + ("\\$\\sw+" (0 keyword-face)) ;; the tokens are already fontified as string/docstrings: (,(lambda (limit) (if antlr-font-lock-literal-regexp (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) - (1 antlr-font-lock-literal-face t) + (1 antlr-literal-face t) :XEMACS (0 nil)) ; XEmacs bug workaround (,(lambda (limit) (antlr-re-search-forward antlr-class-header-regexp limit)) - (1 antlr-font-lock-keyword-face) - (2 antlr-font-lock-ruledef-face) - (3 antlr-font-lock-keyword-face) + (1 antlr-keyword-face) + (2 antlr-ruledef-face) + (3 antlr-keyword-face) (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) - 'antlr-font-lock-keyword-face - 'font-lock-type-face))) + antlr-keyword-face + type-face))) (,(lambda (limit) (antlr-re-search-forward "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" limit)) - (1 antlr-font-lock-keyword-face)) + (1 antlr-keyword-face)) (,(lambda (limit) (antlr-re-search-forward "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" limit)) (1 font-lock-type-face) ; not XEmacs' java level-3 fruit salad (3 (if (antlr-upcase-p (char-after (match-beginning 3))) - 'antlr-font-lock-tokendef-face - 'antlr-font-lock-ruledef-face) nil t) - (4 antlr-font-lock-syntax-face nil t)) + antlr-tokendef-face + antlr-ruledef-face) nil t) + (4 antlr-syntax-face nil t)) (,(lambda (limit) (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) (1 (if (antlr-upcase-p (char-after (match-beginning 0))) - 'antlr-font-lock-tokendef-face - 'antlr-font-lock-ruledef-face) nil t) - (2 antlr-font-lock-syntax-face nil t)) + antlr-tokendef-face + antlr-ruledef-face) nil t) + (2 antlr-syntax-face nil t)) (,(lambda (limit) ;; v:ruleref and v:"literal" is allowed... (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) (1 (if (match-beginning 2) (if (eq (char-after (match-beginning 2)) ?=) - 'antlr-font-lock-default-face - 'font-lock-variable-name-face) + antlr-default-face + font-lock-variable-name-face) (if (antlr-upcase-p (char-after (match-beginning 1))) - 'antlr-font-lock-tokenref-face - 'antlr-font-lock-ruleref-face))) - (2 antlr-font-lock-default-face nil t)) + antlr-tokenref-face + antlr-ruleref-face))) + (2 antlr-default-face nil t)) (,(lambda (limit) (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit)) - (0 'antlr-font-lock-syntax-face)))) + (0 antlr-syntax-face)))) "Font-lock keywords for ANTLR's normal grammar code. See `antlr-font-lock-keywords-alist' for the keywords of actions.") @@ -1641,7 +1666,7 @@ Return \(LEVEL OPTION LOCATION)." :active active)) (sort (mapcar 'car (elt antlr-options-alists (1- level))) 'string-lessp)))) - + ;;;=========================================================================== ;;; Insert option: determine section-kind @@ -1850,7 +1875,7 @@ cell where the two values determine the area inside the braces." (read initial) initial)) (cdr value)))) - (message (cadr value)) + (message "%s" (or (cadr value) "")) (setq value nil))) ;; insert value ---------------------------------------------------------- (if (consp old) @@ -1918,7 +1943,7 @@ For OLD, see `antlr-insert-option-do'." ;; stuff (no =, {, } or /) at point is not followed by ";" (insert ";") (backward-char))) - + (defun antlr-insert-option-space (area old) "Find appropriate place to insert option, insert newlines/spaces. For AREA and OLD, see `antlr-insert-option-do'." @@ -1938,7 +1963,7 @@ For AREA and OLD, see `antlr-insert-option-do'." (setq orig (point)) (goto-char orig))) (skip-chars-forward " \t") - + (if (looking-at "$\\|//") ;; just comment after point => skip (+ lines w/ same col comment) (let ((same (if (> (match-end 0) (match-beginning 0)) @@ -2185,8 +2210,8 @@ part SUPER in the result of `antlr-file-dependencies'. CLASSES is the part \(CLASS-SPEC ...) in the result of `antlr-directory-dependencies'. The result looks like \(OPTION WITH-UNKNOWN GLIB ...). OPTION is the -complete \"-glib\" option. WITH-UNKNOWN has value t iff there is none -or more than one grammar file for at least one super grammar. +complete \"-glib\" option. WITH-UNKNOWN is t if there is none or more +than one grammar file for at least one super grammar. Each GLIB looks like \(GRAMMAR-FILE \. EVOCAB). GRAMMAR-FILE is a file in which a super-grammar is defined. EVOCAB is the value of the export @@ -2223,9 +2248,8 @@ called interactively, the buffers are always saved, see also variable (interactive (antlr-run-tool-interactive)) (or saved (save-some-buffers (not antlr-ask-about-save))) (let ((default-directory (file-name-directory file))) - (require 'compile) ; only `compile' autoload - (compile-internal (concat command " " (file-name-nondirectory file)) - "No more errors" "Antlr-Run"))) + (compilation-start (concat command " " (file-name-nondirectory file)) + nil #'(lambda (mode-name) "*Antlr-Run*")))) (defun antlr-run-tool-interactive () ;; code in `interactive' is not compiled @@ -2623,7 +2647,7 @@ the default language." (imenu-add-to-menubar (if (stringp antlr-imenu-name) antlr-imenu-name "Index"))) (antlr-set-tabs) - (run-hooks 'antlr-mode-hook)) + (run-mode-hooks 'antlr-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