Fix up comment convention on the arch-tag lines.
[bpt/emacs.git] / lisp / progmodes / antlr-mode.el
index bdf376b..3b0c3cc 100644 (file)
@@ -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, 2008
+;; 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:
 
 
 ;;; Code:
 
-(provide 'antlr-mode)
+(eval-when-compile 
+  (require 'cl))
+
 (require 'easymenu)
 
+;; Just to get the rid of the byte compiler warning.  The code for
+;; this function and its friends are too complex for their own good.
+(declare-function cond-emacs-xemacs-macfn "antlr-mode" (args &optional msg))
+
 ;; General Emacs/XEmacs-compatibility compile-time macros
-(eval-when-compile
-  (require 'cl)
+(eval-when-compile 
   (defmacro cond-emacs-xemacs (&rest args)
     (cond-emacs-xemacs-macfn
      args "`cond-emacs-xemacs' must return exactly one element"))
       (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)))
   ;; 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))
   (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))
       `(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)
 (put 'save-buffer-state-x 'lisp-indent-function 0)
 
 ;; get rid of byte-compile warnings
-(eval-when-compile                     ; required and optional libraries
-  (require 'cc-mode)
-  (ignore-errors (require 'font-lock))
-  (ignore-errors (require 'compile))
-  ;;(ignore-errors (defun c-init-language-vars))) dangerous on Emacs!
-  ;;(ignore-errors (defun c-init-c-language-vars))) dangerous on Emacs!
-  ;;(ignore-errors (defun c-basic-common-init))   dangerous on Emacs!
-  (defvar outline-level) (defvar imenu-use-markers)
-  (defvar imenu-create-index-function))
+(eval-when-compile
+  (require 'cc-mode))
+
+(defvar outline-level)
+(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
@@ -318,7 +321,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 +570,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'.")
 
@@ -827,65 +830,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.
@@ -904,56 +930,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.")
 
@@ -1642,7 +1668,7 @@ Return \(LEVEL OPTION LOCATION)."
                      :active active))
            (sort (mapcar 'car (elt antlr-options-alists (1- level)))
                  'string-lessp))))
-    
+
 
 ;;;===========================================================================
 ;;;  Insert option: determine section-kind
@@ -1851,7 +1877,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)
@@ -1919,7 +1945,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'."
@@ -1939,7 +1965,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))
@@ -2186,8 +2212,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
@@ -2224,9 +2250,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
@@ -2646,7 +2671,9 @@ Used in `antlr-mode'.  Also a useful function in `java-mode-hook'."
                     indent-tabs-mode (cadddr elem)
                     alist nil))))))
 
+(provide 'antlr-mode)
+
 ;;; Local IspellPersDict: .ispell_antlr
 
-;;; arch-tag: 5de2be79-3d13-4560-8fbc-f7d0234dcb5c
+;; arch-tag: 5de2be79-3d13-4560-8fbc-f7d0234dcb5c
 ;;; antlr-mode.el ends here