]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/ada-mode.el
Merge from emacs--devo--0
[gnu-emacs] / lisp / progmodes / ada-mode.el
index b47d167661b9d0ca534c2611a61801737d3298c4..aa3aea0d71bb87d0048a5dcfc2f981d8570c651e 100644 (file)
@@ -1,7 +1,7 @@
 ;;; ada-mode.el --- major-mode for editing Ada sources
 
 ;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;               2005, 2006  Free Software Foundation, Inc.
+;;               2005, 2006, 2007  Free Software Foundation, Inc.
 
 ;; Author: Rolf Ebert      <ebert@inf.enst.fr>
 ;;      Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
@@ -13,7 +13,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,
 ;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
-;;; This mode is a major mode for editing Ada83 and Ada95 source code.
-;;; This is a major rewrite of the file packaged with Emacs-20.  The
-;;; ada-mode is composed of four Lisp files, ada-mode.el, ada-xref.el,
-;;; ada-prj.el and ada-stmt.el. Only this file (ada-mode.el) is
-;;; completely independent from the GNU Ada compiler Gnat, distributed
-;;; by Ada Core Technologies. All the other files rely heavily on
-;;; features provided only by Gnat.
+;;; This mode is a major mode for editing Ada code.  This is a major
+;;; rewrite of the file packaged with Emacs-20.  The Ada mode is
+;;; composed of four Lisp files: ada-mode.el, ada-xref.el, ada-prj.el
+;;; and ada-stmt.el.  Only this file (ada-mode.el) is completely
+;;; independent from the GNU Ada compiler GNAT, distributed by Ada
+;;; Core Technologies.  All the other files rely heavily on features
+;;; provided only by GNAT.
 ;;;
 ;;; Note: this mode will not work with Emacs 19. If you are on a VMS
 ;;; system, where the latest version of Emacs is 19.28, you will need
@@ -77,7 +77,7 @@
 ;;; (yet) been recoded in this new mode.  Perhaps you prefer sticking
 ;;; to his version.
 ;;;
-;;; A complete rewrite for Emacs-20 / Gnat-3.11 has been done by Ada Core
+;;; A complete rewrite for Emacs-20 / GNAT-3.11 has been done by Ada Core
 ;;; Technologies.
 
 ;;; Credits:
@@ -149,7 +149,7 @@ If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
 (defun ada-mode-version ()
   "Return Ada mode version."
   (interactive)
-  (let ((version-string "3.6w"))
+  (let ((version-string "3.7"))
     (if (interactive-p)
        (message version-string)
       version-string)))
@@ -437,7 +437,7 @@ An example is:
   "*Name of the compiler to use.
 This will determine what features are made available through the Ada mode.
 The possible choices are:
-`gnat': Use Ada Core Technologies' Gnat compiler.  Add some cross-referencing
+`gnat': Use Ada Core Technologies' GNAT compiler.  Add some cross-referencing
     features.
 `generic': Use a generic compiler."
   :type '(choice (const gnat)
@@ -471,27 +471,29 @@ The extensions should include a `.' if needed.")
 (defvar ada-mode-symbol-syntax-table nil
   "Syntax table for Ada, where `_' is a word constituent.")
 
-(defconst ada-83-string-keywords
-  '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin"
-    "body" "case" "constant" "declare" "delay" "delta" "digits" "do"
-    "else" "elsif" "end" "entry" "exception" "exit" "for" "function"
-    "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new"
-    "not" "null" "of" "or" "others" "out" "package" "pragma" "private"
-    "procedure" "raise" "range" "record" "rem" "renames" "return"
-    "reverse" "select" "separate" "subtype" "task" "terminate" "then"
-    "type" "use" "when" "while" "with" "xor")
-  "List of Ada 83 keywords.
+(eval-when-compile
+  ;; These values are used in eval-when-compile expressions.
+  (defconst ada-83-string-keywords
+    '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin"
+      "body" "case" "constant" "declare" "delay" "delta" "digits" "do"
+      "else" "elsif" "end" "entry" "exception" "exit" "for" "function"
+      "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new"
+      "not" "null" "of" "or" "others" "out" "package" "pragma" "private"
+      "procedure" "raise" "range" "record" "rem" "renames" "return"
+      "reverse" "select" "separate" "subtype" "task" "terminate" "then"
+      "type" "use" "when" "while" "with" "xor")
+    "List of Ada 83 keywords.
 Used to define `ada-*-keywords'.")
 
-(defconst ada-95-string-keywords
-  '("abstract" "aliased" "protected" "requeue" "tagged" "until")
-  "List of keywords new in Ada 95.
+  (defconst ada-95-string-keywords
+    '("abstract" "aliased" "protected" "requeue" "tagged" "until")
+    "List of keywords new in Ada 95.
 Used to define `ada-*-keywords'.")
 
-(defconst ada-2005-string-keywords
-  '("interface" "overriding" "synchronized")
-  "List of keywords new in Ada 2005.
-Used to define `ada-*-keywords.'")
+  (defconst ada-2005-string-keywords
+    '("interface" "overriding" "synchronized")
+    "List of keywords new in Ada 2005.
+Used to define `ada-*-keywords.'"))
 
 (defvar ada-ret-binding nil
   "Variable to save key binding of RET when casing is activated.")
@@ -792,33 +794,24 @@ the 4 file locations can be clicked on and jumped to."
                                  (match-string 1))))
          (error-pos (point-marker))
          source)
+
+      ;; set source marker
       (save-excursion
-       (save-restriction
-         (widen)
-         ;;  Use funcall so as to prevent byte-compiler warnings
-         ;;  `ada-find-file' is not defined if ada-xref wasn't loaded. But
-         ;;  if we can find it, we should use it instead of
-         ;;  `compilation-find-file', since the latter doesn't know anything
-         ;;  about source path.
-
-         (if (functionp 'ada-find-file)
-             (setq file (funcall (symbol-function 'ada-find-file)
-                                 (match-string 1)))
-           (setq file (funcall (symbol-function 'compilation-find-file)
-                               (point-marker) (match-string 1)
-                               "./")))
-         (set-buffer file)
-
-         (if (stringp line)
-             (goto-line (string-to-number line)))
-         (setq source (point-marker))))
-      (funcall (symbol-function 'compilation-goto-locus)
-              (cons source error-pos))
+        (compilation-find-file (point-marker) (match-string 1) "./")
+        (set-buffer file)
+
+        (if (stringp line)
+            (goto-line (string-to-number line)))
+
+        (setq source (point-marker)))
+
+      (compilation-goto-locus error-pos source nil)
+
       ))
 
    ;; otherwise, default behavior
    (t
-    (funcall (symbol-function 'compile-goto-error)))
+    (compile-goto-error))
    )
   (recenter))
 
@@ -836,13 +829,12 @@ the 4 file locations can be clicked on and jumped to."
 ;; Thus their syntax property is changed automatically, and we can still use
 ;; the standard Emacs functions for sexp (see `ada-in-string-p')
 ;;
-;; On Emacs, this is done through the `syntax-table' text property. The
-;; modification is done automatically each time the user as typed a new
-;; character. This is already done in `font-lock-mode' (in
-;; `font-lock-syntactic-keywords', so we take advantage of the existing
-;; mechanism. If font-lock-mode is not activated, we do it by hand in
-;; `ada-after-change-function', thanks to `ada-deactivate-properties' and
-;; `ada-initialize-properties'.
+;; On Emacs, this is done through the `syntax-table' text property.  The
+;; corresponding action is applied automatically each time the buffer
+;; changes.  If `font-lock-mode' is enabled (the default) the action is
+;; set up by `font-lock-syntactic-keywords'.  Otherwise, we do it
+;; manually in `ada-after-change-function'.  The proper method is
+;; installed by `ada-handle-syntax-table-properties'.
 ;;
 ;; on XEmacs, the `syntax-table' property does not exist and we have to use a
 ;; slow advice to `parse-partial-sexp' to do the same thing.
@@ -859,7 +851,6 @@ The standard table declares `_' as a symbol constituent, the second one
 declares it as a word constituent."
   (interactive)
   (setq ada-mode-syntax-table (make-syntax-table))
-  (set-syntax-table  ada-mode-syntax-table)
 
   ;; define string brackets (`%' is alternative string bracket, but
   ;; almost never used as such and throws font-lock and indentation
@@ -943,50 +934,59 @@ declares it as a word constituent."
            (insert (caddar change))
            (setq change (cdr change)))))))
 
-(defun ada-deactivate-properties ()
-  "Deactivate Ada mode's properties handling.
-This would be a duplicate of font-lock if both are used at the same time."
-  (remove-hook 'after-change-functions 'ada-after-change-function t))
-
-(defun ada-initialize-properties ()
-  "Initialize some special text properties in the whole buffer.
-In particular, character constants are said to be strings, #...# are treated
-as numbers instead of gnatprep comments."
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (while (re-search-forward "'.'" nil t)
-       (add-text-properties (match-beginning 0) (match-end 0)
-                            '(syntax-table ("'" . ?\"))))
-      (goto-char (point-min))
-      (while (re-search-forward "^[ \t]*#" nil t)
-       (add-text-properties (match-beginning 0) (match-end 0)
-                            '(syntax-table (11 . 10))))
-      (set-buffer-modified-p nil)
-
-      ;;  Setting this only if font-lock is not set won't work
-      ;;  if the user activates or deactivates font-lock-mode,
-      ;;  but will make things faster most of the time
-      (add-hook 'after-change-functions 'ada-after-change-function nil t)
-      )))
+(defun ada-set-syntax-table-properties ()
+  "Assign `syntax-table' properties in accessible part of buffer.
+In particular, character constants are said to be strings, #...#
+are treated as numbers instead of gnatprep comments."
+  (let ((modified (buffer-modified-p))
+       (buffer-undo-list t)
+       (inhibit-read-only t)
+       (inhibit-point-motion-hooks t)
+       (inhibit-modification-hooks t))
+    (remove-text-properties (point-min) (point-max) '(syntax-table nil))
+    (goto-char (point-min))
+    (while (re-search-forward
+           ;; The following regexp was adapted from
+           ;; `ada-font-lock-syntactic-keywords'.
+           "^[ \t]*\\(#\\(?:if\\|else\\|elsif\\|end\\)\\)\\|[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)"
+           nil t)
+      (if (match-beginning 1)
+         (put-text-property
+              (match-beginning 1) (match-end 1) 'syntax-table '(11 . ?\n))
+       (put-text-property
+            (match-beginning 2) (match-end 2) 'syntax-table '(7 . ?'))
+       (put-text-property
+            (match-beginning 3) (match-end 3) 'syntax-table '(7 . ?'))))
+    (unless modified
+      (restore-buffer-modified-p nil))))
 
 (defun ada-after-change-function (beg end old-len)
   "Called when the region between BEG and END was changed in the buffer.
 OLD-LEN indicates what the length of the replaced text was."
-  (let ((inhibit-point-motion-hooks t)
-       (eol (point)))
+  (save-excursion
+    (save-restriction
+      (let ((from (progn (goto-char beg) (line-beginning-position)))
+           (to (progn (goto-char end) (line-end-position))))
+       (narrow-to-region from to)
+       (save-match-data
+         (ada-set-syntax-table-properties))))))
+
+(defun ada-initialize-syntax-table-properties ()
+  "Assign `syntax-table' properties in current buffer."
     (save-excursion
-      (save-match-data
-       (beginning-of-line)
-       (remove-text-properties (point) eol '(syntax-table nil))
-       (while (re-search-forward "'.'" eol t)
-         (add-text-properties (match-beginning 0) (match-end 0)
-                              '(syntax-table ("'" . ?\"))))
-       (beginning-of-line)
-       (if (looking-at "^[ \t]*#")
-           (add-text-properties (match-beginning 0) (match-end 0)
-                                '(syntax-table (11 . 10))))))))
+      (save-restriction
+       (widen)
+       (save-match-data
+         (ada-set-syntax-table-properties))))
+    (add-hook 'after-change-functions 'ada-after-change-function nil t))
+
+(defun ada-handle-syntax-table-properties ()
+  "Handle `syntax-table' properties."
+  (if font-lock-mode
+      ;; `font-lock-mode' will take care of `syntax-table' properties.
+      (remove-hook 'after-change-functions 'ada-after-change-function t)
+    ;; Take care of `syntax-table' properties manually.
+    (ada-initialize-syntax-table-properties)))
 
 ;;------------------------------------------------------------------
 ;;  Testing the grammatical context
@@ -1157,6 +1157,8 @@ If you use ada-xref.el:
 
   (interactive)
   (kill-all-local-variables)
+  
+  (set-syntax-table ada-mode-syntax-table)
 
   (set (make-local-variable 'require-final-newline) mode-require-final-newline)
 
@@ -1343,17 +1345,11 @@ If you use ada-xref.el:
   (setq local-abbrev-table ada-mode-abbrev-table)
 
   ;;  Support for which-function mode
-  ;; which-function-mode does not work with nested subprograms, since it is
-  ;; based only on the regexps generated by imenu, and thus can only detect the
-  ;; beginning of subprograms, not the end.
-  ;; Fix is: redefine a new function ada-which-function, and call it when the
-  ;; major-mode is ada-mode.
-
   (make-local-variable 'which-func-functions)
   (setq which-func-functions '(ada-which-function))
 
   ;;  Support for indent-new-comment-line (Especially for XEmacs)
-  (setq comment-multi-line nil)
+  (set (make-local-variable 'comment-multi-line) nil)
 
   (setq major-mode 'ada-mode
        mode-name "Ada")
@@ -1390,9 +1386,8 @@ If you use ada-xref.el:
   ;;  font-lock-mode
 
   (unless (featurep 'xemacs)
-    (progn
-      (ada-initialize-properties)
-      (add-hook 'font-lock-mode-hook 'ada-deactivate-properties nil t)))
+    (ada-initialize-syntax-table-properties)
+    (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t))
 
   ;; the following has to be done after running the ada-mode-hook
   ;; because users might want to set the values of these variable
@@ -4621,6 +4616,7 @@ Moves to 'begin' if in a declarative part."
   (define-key ada-mode-map "\C-cc"     'ada-change-prj)
   (define-key ada-mode-map "\C-cd"     'ada-set-default-project-file)
   (define-key ada-mode-map "\C-cg"     'ada-gdb-application)
+  (define-key ada-mode-map "\C-c\C-m"  'ada-set-main-compile-application)
   (define-key ada-mode-map "\C-cr"     'ada-run-application)
   (define-key ada-mode-map "\C-c\C-o"  'ada-goto-parent)
   (define-key ada-mode-map "\C-c\C-r"  'ada-find-references)
@@ -4705,11 +4701,14 @@ Moves to 'begin' if in a declarative part."
              :included (fboundp 'customize-group)]
             ["Check file"    ada-check-current   t]
             ["Compile file"  ada-compile-current t]
+            ["Set main and Build" ada-set-main-compile-application t]
+            ["Show main" ada-show-current-main t]
             ["Build"         ada-compile-application t]
             ["Run"           ada-run-application     t]
             ["Debug"         ada-gdb-application (eq ada-which-compiler 'gnat)]
             ["------"        nil nil]
             ("Project"
+             ["Show project" ada-show-current-project t]
              ["Load..."      ada-set-default-project-file t]
              ["New..."       ada-prj-new                  t]
              ["Edit..."      ada-prj-edit                 t])
@@ -5209,8 +5208,7 @@ Return nil if no body was found."
   ;; This sets the properties of the characters, so that ada-in-string-p
   ;; correctly handles '"' too...
   '(("[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
-    ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))
-    ))
+    ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))))
 
 (defvar ada-font-lock-keywords
   (eval-when-compile
@@ -5421,7 +5419,7 @@ for `ada-procedure-start-regexp'."
 (defun ada-make-body ()
   "Create an Ada package body in the current buffer.
 The spec must be the previously visited buffer.
-This function typically is to be hooked into `ff-file-created-hooks'."
+This function typically is to be hooked into `ff-file-created-hook'."
   (delete-region (point-min) (point-max))
   (insert-buffer-substring (car (cdr (buffer-list))))
   (goto-char (point-min))
@@ -5532,6 +5530,8 @@ This function typically is to be hooked into `ff-file-created-hooks'."
 (autoload 'ada-set-default-project-file     "ada-xref" nil nil)
 (autoload 'ada-set-default-project-file     "ada-xref" nil t)
 (autoload 'ada-xref-goto-previous-reference "ada-xref" nil t)
+(autoload 'ada-set-main-compile-application "ada-xref" nil t)
+(autoload 'ada-show-current-main            "ada-xref" nil t)
 
 (autoload 'ada-customize                    "ada-prj"  nil t)
 (autoload 'ada-prj-edit                     "ada-prj"  nil t)