Add 2012 to FSF copyright years for Emacs files
[bpt/emacs.git] / lisp / progmodes / antlr-mode.el
index 25e3f7f..634570c 100644 (file)
@@ -1,11 +1,10 @@
 ;;; antlr-mode.el --- major mode for ANTLR grammar files
 
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
-;;
+;; Copyright (C) 1999-2012  Free Software Foundation, Inc.
+
 ;; Author: Christoph.Wedler@sap.com
 ;; Keywords: languages, ANTLR, code generator
-;; Version: (see `antlr-version' below)
+;; Version: 2.2c
 ;; X-URL: http://antlr-mode.sourceforge.net/
 
 ;; This file is part of GNU Emacs.
 
 ;;; Code:
 
-(eval-when-compile 
+(eval-when-compile
   (require 'cl))
 
 (require 'easymenu)
+(require 'cc-mode)
 
 ;; 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 
+(eval-when-compile
   (defmacro cond-emacs-xemacs (&rest args)
     (cond-emacs-xemacs-macfn
      args "`cond-emacs-xemacs' must return exactly one element"))
@@ -835,6 +835,7 @@ Do not change."
   :group 'antlr)
 ;; backward-compatibility alias
 (put 'antlr-font-lock-default-face 'face-alias 'antlr-default)
+(put 'antlr-font-lock-default-face 'obsolete-face "22.1")
 
 (defvar antlr-keyword-face 'antlr-keyword)
 (defface antlr-keyword
@@ -846,6 +847,7 @@ Do not change."
   :group 'antlr)
 ;; backward-compatibility alias
 (put 'antlr-font-lock-keyword-face 'face-alias 'antlr-keyword)
+(put 'antlr-font-lock-keyword-face 'obsolete-face "22.1")
 
 (defvar antlr-syntax-face 'antlr-keyword)
 (defface antlr-syntax
@@ -857,6 +859,7 @@ Do not change."
   :group 'antlr)
 ;; backward-compatibility alias
 (put 'antlr-font-lock-syntax-face 'face-alias 'antlr-syntax)
+(put 'antlr-font-lock-syntax-face 'obsolete-face "22.1")
 
 (defvar antlr-ruledef-face 'antlr-ruledef)
 (defface antlr-ruledef
@@ -868,6 +871,7 @@ Do not change."
   :group 'antlr)
 ;; backward-compatibility alias
 (put 'antlr-font-lock-ruledef-face 'face-alias 'antlr-ruledef)
+(put 'antlr-font-lock-ruledef-face 'obsolete-face "22.1")
 
 (defvar antlr-tokendef-face 'antlr-tokendef)
 (defface antlr-tokendef
@@ -879,6 +883,7 @@ Do not change."
   :group 'antlr)
 ;; backward-compatibility alias
 (put 'antlr-font-lock-tokendef-face 'face-alias 'antlr-tokendef)
+(put 'antlr-font-lock-tokendef-face 'obsolete-face "22.1")
 
 (defvar antlr-ruleref-face 'antlr-ruleref)
 (defface antlr-ruleref
@@ -888,6 +893,7 @@ Do not change."
   :group 'antlr)
 ;; backward-compatibility alias
 (put 'antlr-font-lock-ruleref-face 'face-alias 'antlr-ruleref)
+(put 'antlr-font-lock-ruleref-face 'obsolete-face "22.1")
 
 (defvar antlr-tokenref-face 'antlr-tokenref)
 (defface antlr-tokenref
@@ -897,6 +903,7 @@ Do not change."
   :group 'antlr)
 ;; backward-compatibility alias
 (put 'antlr-font-lock-tokenref-face 'face-alias 'antlr-tokenref)
+(put 'antlr-font-lock-tokenref-face 'obsolete-face "22.1")
 
 (defvar antlr-literal-face 'antlr-literal)
 (defface antlr-literal
@@ -910,6 +917,7 @@ It is used to highlight strings matched by the first regexp group of
   :group 'antlr)
 ;; backward-compatibility alias
 (put 'antlr-font-lock-literal-face 'face-alias 'antlr-literal)
+(put 'antlr-font-lock-literal-face 'obsolete-face "22.1")
 
 (defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\""
   "Regexp matching literals with special syntax highlighting, or nil.
@@ -929,7 +937,7 @@ group.  The string matched by the first group is highlighted with
    `((antlr-invalidate-context-cache)
      ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))"
       (1 antlr-tokendef-face))
-     ("\\$\\sw+" (0 keyword-face))
+     ("\\$\\sw+" (0 antlr-keyword-face))
      ;; the tokens are already fontified as string/docstrings:
      (,(lambda (limit)
         (if antlr-font-lock-literal-regexp
@@ -943,7 +951,7 @@ group.  The string matched by the first group is highlighted with
       (3 antlr-keyword-face)
       (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
             antlr-keyword-face
-          type-face)))
+          font-lock-type-face)))
      (,(lambda (limit)
         (antlr-re-search-forward
          "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
@@ -996,12 +1004,21 @@ The SYNTAX-ALIST element is also used to initialize
 (defvar antlr-mode-hook nil
   "Hook called by `antlr-mode'.")
 
-(defvar antlr-mode-syntax-table nil
+(defvar antlr-mode-syntax-table
+  (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 nil
+(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
@@ -1056,7 +1073,7 @@ Used for `antlr-slow-syntactic-context'.")
   (read-from-minibuffer prompt initial-input nil nil
                        (or history 'shell-command-history)))
 
-(defunx antlr-with-displaying-help-buffer (thunk &optional name)
+(defunx antlr-with-displaying-help-buffer (thunk &optional _name)
   :xemacs-and-try with-displaying-help-buffer
   "Make a help buffer and call `thunk' there."
   (with-output-to-temp-buffer "*Help*"
@@ -1075,12 +1092,11 @@ Used for `antlr-slow-syntactic-context'.")
 ;;;(defvar antlr-statistics-cache 0)
 ;;;(defvar antlr-statistics-inval 0)
 
-(defunx antlr-invalidate-context-cache (&rest dummies)
+(defunx antlr-invalidate-context-cache (&rest _dummies)
 ;; checkdoc-params: (dummies)
   "Invalidate context cache for syntactical context information."
   :XEMACS                              ; XEmacs bug workaround
-  (save-excursion
-    (set-buffer (get-buffer-create " ANTLR XEmacs bug workaround"))
+  (with-current-buffer (get-buffer-create " ANTLR XEmacs bug workaround")
     (buffer-syntactic-context-depth)
     nil)
   :EMACS
@@ -1654,7 +1670,7 @@ Return \(LEVEL OPTION LOCATION)."
                                     table)))
        (list level input (cdr kind))))))
 
-(defun antlr-options-menu-filter (level menu-items)
+(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
@@ -2056,7 +2072,7 @@ Used inside `antlr-options-alists'."
                    nil
                    table '(("false") ("true"))))
 
-(defun antlr-language-option-extra (phase &rest dummies)
+(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
@@ -2072,7 +2088,7 @@ Called in PHASE `after-insertion', see `antlr-options-alists'."
            (antlr-mode)
            (and font-lock (null font-lock-mode) (font-lock-mode 1)))))))
 
-(defun antlr-c++-mode-extra (phase option &rest dummies)
+(defun antlr-c++-mode-extra (phase option &rest _dummies)
 ;; checkdoc-params: (option dummies)
   "Warn if C++ option is used with the wrong language.
 Ask user \(\"y or n\"), if a C++ only option is going to be inserted but
@@ -2165,37 +2181,32 @@ grammar file in which CLASS is defined and EVOCAB is the name of the
 export vocabulary specified in that file."
   (let ((grammar (directory-files dirname t "\\.g\\'")))
     (when grammar
-      (let ((temp-buffer (get-buffer-create
-                         (generate-new-buffer-name " *temp*")))
-           (antlr-imenu-name nil)              ; dynamic-let: no imenu
-           (expanded-regexp (concat (format (regexp-quote
-                                             (cadr antlr-special-file-formats))
-                                            ".+")
-                                    "\\'"))
+      (let ((antlr-imenu-name nil)             ; dynamic-let: no imenu
+           (expanded-regexp
+             (concat (format (regexp-quote
+                              (cadr antlr-special-file-formats))
+                             ".+")
+                     "\\'"))
            classes dependencies)
-       (unwind-protect
-           (save-excursion
-             (set-buffer temp-buffer)
-             (widen)                   ; just in case...
-             (dolist (file grammar)
-               (when (and (file-regular-p file)
-                          (null (string-match expanded-regexp file)))
-                 (insert-file-contents file t nil nil t)
-                 (normal-mode t)       ; necessary for major-mode, syntax
+        (with-temp-buffer
+          (dolist (file grammar)
+            (when (and (file-regular-p file)
+                       (null (string-match expanded-regexp file)))
+              (insert-file-contents file t nil nil t)
+              (normal-mode t)           ; necessary for major-mode, syntax
                                        ; table and `antlr-language'
-                 (when (eq major-mode 'antlr-mode)
-                   (let* ((file-deps (antlr-file-dependencies))
-                          (file (car file-deps)))
-                     (when file-deps
-                       (dolist (class-def (caadr file-deps))
-                         (let ((file-evocab (cons file (cdr class-def)))
-                               (class-spec (assoc (car class-def) classes)))
-                           (if class-spec
-                               (nconc (cdr class-spec) (list file-evocab))
-                             (push (list (car class-def) file-evocab)
-                                   classes))))
-                       (push file-deps dependencies)))))))
-         (kill-buffer temp-buffer))
+              (when (derived-mode-p 'antlr-mode)
+                (let* ((file-deps (antlr-file-dependencies))
+                       (file (car file-deps)))
+                  (when file-deps
+                    (dolist (class-def (caadr file-deps))
+                      (let ((file-evocab (cons file (cdr class-def)))
+                            (class-spec (assoc (car class-def) classes)))
+                        (if class-spec
+                            (nconc (cdr class-spec) (list file-evocab))
+                          (push (list (car class-def) file-evocab)
+                                classes))))
+                    (push file-deps dependencies)))))))
        (cons (nreverse classes) (nreverse dependencies))))))
 
 
@@ -2249,7 +2260,7 @@ called interactively, the buffers are always saved, see also variable
   (or saved (save-some-buffers (not antlr-ask-about-save)))
   (let ((default-directory (file-name-directory file)))
     (compilation-start (concat command " " (file-name-nondirectory file))
-                      nil #'(lambda (mode-name) "*Antlr-Run*"))))
+                      nil (lambda (_mode-name) "*Antlr-Run*"))))
 
 (defun antlr-run-tool-interactive ()
   ;; code in `interactive' is not compiled
@@ -2367,7 +2378,7 @@ 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)
-  (if (null (eq major-mode 'makefile-mode))
+  (if (null (derived-mode-p 'makefile-mode))
       (antlr-with-displaying-help-buffer 'antlr-insert-makefile-rules)
     (push-mark)
     (antlr-insert-makefile-rules t)))
@@ -2512,7 +2523,7 @@ ANTLR's syntax and influences the auto indentation, see
            (let ((context (antlr-syntactic-context)))
              (not (and (numberp context)
                        (or (zerop context)
-                           (memq last-command-char '(?\{ ?\}))))))))
+                           (memq last-command-event '(?\{ ?\}))))))))
       (self-insert-command (prefix-numeric-value arg))
     (self-insert-command (prefix-numeric-value arg))
     (antlr-indent-line)))
@@ -2557,13 +2568,15 @@ ANTLR's syntax and influences the auto indentation, see
   "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)
-                                        (car antlr-language-limit-n-regexp)
-                                        t))
-                   (match-string 1)))
+  (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)
@@ -2575,35 +2588,20 @@ the default language."
     (car r)))
 
 ;;;###autoload
-(defun antlr-mode ()
-  "Major mode for editing ANTLR grammar files.
-\\{antlr-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
+(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 ----------------------------------------------------------
-  (setq major-mode 'antlr-mode
-       mode-name "Antlr")
-  (setq local-abbrev-table antlr-mode-abbrev-table)
-  (unless antlr-mode-syntax-table
-    (setq antlr-mode-syntax-table (make-syntax-table))
-    (c-populate-syntax-table antlr-mode-syntax-table))
-  (set-syntax-table antlr-mode-syntax-table)
-  (unless antlr-action-syntax-table
-    (let ((slist (nth 3 antlr-font-lock-defaults)))
-      (setq antlr-action-syntax-table
-           (copy-syntax-table antlr-mode-syntax-table))
-      (while slist
-       (modify-syntax-entry (caar slist) (cdar slist)
-                            antlr-action-syntax-table)
-       (setq slist (cdr slist)))))
-  (use-local-map antlr-mode-map)
-  (make-local-variable 'antlr-language)
   (unless antlr-language
-    (setq antlr-language
-         (or (antlr-language-option t) (antlr-language-option nil))))
+    (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."
@@ -2621,33 +2619,24 @@ the default language."
        (t                              ; cc-mode upto 5.28
         (antlr-c-init-language-vars))) ; do it myself
   (c-basic-common-init antlr-language (or antlr-indent-style "gnu"))
-  (make-local-variable 'outline-regexp)
-  (make-local-variable 'outline-level)
-  (make-local-variable 'require-final-newline)
-  (make-local-variable 'indent-line-function)
-  (make-local-variable 'indent-region-function)
-  (setq outline-regexp "[^#\n\^M]"
-       outline-level 'c-outline-level) ; TODO: define own
-  (setq require-final-newline mode-require-final-newline)
-  (setq indent-line-function 'antlr-indent-line
-       indent-region-function nil)     ; too lazy
+  (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 "/\\*+ *\\|// *")
   ;; various -----------------------------------------------------------------
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults antlr-font-lock-defaults)
+  (set (make-local-variable 'font-lock-defaults) antlr-font-lock-defaults)
   (easy-menu-add antlr-mode-menu)
-  (make-local-variable 'imenu-create-index-function)
-  (setq imenu-create-index-function 'antlr-imenu-create-index-function)
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression t)    ; fool stupid test
+  (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...
        (fboundp 'imenu-add-to-menubar)
        (imenu-add-to-menubar
        (if (stringp antlr-imenu-name) antlr-imenu-name "Index")))
-  (antlr-set-tabs)
-  (run-mode-hooks 'antlr-mode-hook))
+  (antlr-set-tabs))
 
 ;; A smarter version of `group-buffers-menu-by-mode-then-alphabetically' (in
 ;; XEmacs) could use the following property.  The header of the submenu would
@@ -2673,5 +2662,4 @@ Used in `antlr-mode'.  Also a useful function in `java-mode-hook'."
 
 ;;; Local IspellPersDict: .ispell_antlr
 
-;; arch-tag: 5de2be79-3d13-4560-8fbc-f7d0234dcb5c
 ;;; antlr-mode.el ends here