]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/ada-prj.el
Add new maintainer (deego).
[gnu-emacs] / lisp / progmodes / ada-prj.el
index b5ff783322250278f8d1939b89638e2b11529215..09ec600486e4dc34efc02522fe6f20775724857f 100644 (file)
@@ -1,26 +1,30 @@
-;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode
+;;; ada-prj.el --- easy editing of project files for the ada-mode
 
-;; Copyright (C) 1998, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 99, 2000, 2001, 2002
+;;  Free Software Foundation, Inc.
 
 ;; Author: Emmanuel Briot <briot@gnat.com>
-;; Ada Core Technologies's version:   $Revision: 1.3 $
+;; Ada Core Technologies's version:   Revision: 1.55.2.2 (GNAT 3.15)
 ;; Keywords: languages, ada, project file
 
-;; This file is not part of GNU Emacs.
+;; This file is part of GNU Emacs.
 
-;; This program is free software; you can redistribute it and/or modify
+;; 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)
 ;; any later version.
 
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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.
+
+;;; Commentary:
 
 ;;; This package provides a set of functions to easily edit the project
 ;;; files used by the ada-mode.
@@ -30,7 +34,7 @@
 ;;; Internally, a project file is represented as a property list, with each
 ;;; field of the project file matching one property of the list.
 
-;; Code:
+;;; Code:
 
 
 ;; ----- Requirements -----------------------------------------------------
@@ -50,6 +54,9 @@
 (defvar ada-prj-ada-buffer nil
   "Indicates what Ada source file was being edited.")
 
+(defvar ada-old-cross-prefix nil
+  "The cross-prefix associated with the currently loaded runtime library.")
+
 
 ;; ----- Functions --------------------------------------------------------
 
@@ -57,8 +64,9 @@
   "Open a new project file"
   (interactive)
   (let* ((prj
-         (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))
-             ada-prj-prj-file
+         (if (and ada-prj-default-project-file
+                  (not (string= ada-prj-default-project-file "")))
+             ada-prj-default-project-file
            "default.adp"))
         (filename (read-file-name "Project file: "
                                   (if prj "" nil)
   "Editing the project file associated with the current Ada buffer.
 If there is none, opens a new project file"
   (interactive)
-  (let ((file (ada-prj-find-prj-file)))
-    (if file
-       (progn
-         (ada-reread-prj-file file)
-         (ada-customize))
-      (ada-prj-new))))
-
-(defun ada-prj-add-ada-menu ()
-  "Add a new submenu to the Ada menu.
-The items are added to the menu NAME in map MAP. NAME should be the same
-name as was passed to `ada-create-menu'."
-  (if ada-xemacs
-      (progn
-       (funcall (symbol-function 'add-menu-button)
-                '("Ada" "Project")
-                ["Edit" ada-prj-edit t] "Associate")
-       (funcall (symbol-function 'add-menu-button)
-                '("Ada" "Project")
-                ["New..." ada-prj-new t] "Associate"))
-    (define-key (lookup-key ada-mode-map [menu-bar Ada Project])
-      [Edit] '("Edit current" . ada-prj-edit))
-    (define-key (lookup-key ada-mode-map [menu-bar Ada Project])
-      [New]  '("New" . ada-prj-new))))
+  (if ada-prj-default-project-file
+      (ada-customize)
+    (ada-prj-new)))
 
 (defun ada-prj-add-keymap ()
   "Add new keybindings for ada-prj."
@@ -114,10 +102,8 @@ project file is found, returns the default values."
       (if (file-exists-p filename)
          (ada-reread-prj-file))
 
-      ;; Else use the one from the current buffer
-      (save-excursion
-       (set-buffer ada-buffer)
-       (set 'prj ada-prj-prj-file)))
+      ;; Else use the active one
+      (set 'prj ada-prj-default-project-file))
 
        
     (if (and prj
@@ -157,25 +143,35 @@ If the current value of FIELD is the default value, returns an empty string."
          (ada-prj-save-specific-option 'bind_opt)
          (ada-prj-save-specific-option 'link_opt)
          (ada-prj-save-specific-option 'gnatmake_opt)
+         (ada-prj-save-specific-option 'gnatfind_opt)
          (ada-prj-save-specific-option 'cross_prefix)
          (ada-prj-save-specific-option 'remote_machine)
-         (ada-prj-save-specific-option 'comp_cmd)
-         (ada-prj-save-specific-option 'check_cmd)
-         (ada-prj-save-specific-option 'make_cmd)
-         (ada-prj-save-specific-option 'run_cmd)
          (ada-prj-save-specific-option 'debug_cmd)
 
          ;;  Always save the fields that depend on the current buffer
-         (concat "main="      (plist-get ada-prj-current-values 'main) "\n")
-         (concat "main_unit=" (plist-get ada-prj-current-values 'main_unit) "\n")
-         (concat "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n")
-         
-         (ada-prj-set-list "casing"
-                           (plist-get ada-prj-current-values 'casing)) "\n"
+         "main="      (plist-get ada-prj-current-values 'main) "\n"
+         "main_unit=" (plist-get ada-prj-current-values 'main_unit) "\n"
+         "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n"
+         (ada-prj-set-list "check_cmd"
+                           (plist-get ada-prj-current-values 'check_cmd)) "\n"
+         (ada-prj-set-list "make_cmd"
+                           (plist-get ada-prj-current-values 'make_cmd)) "\n"
+         (ada-prj-set-list "comp_cmd"
+                           (plist-get ada-prj-current-values 'comp_cmd)) "\n"
+         (ada-prj-set-list "run_cmd"
+                           (plist-get ada-prj-current-values 'run_cmd)) "\n"
          (ada-prj-set-list "src_dir"
-                           (plist-get ada-prj-current-values 'src_dir)) "\n"
+                           (plist-get ada-prj-current-values 'src_dir)
+                           t) "\n"
          (ada-prj-set-list "obj_dir"
-                           (plist-get ada-prj-current-values 'obj_dir)) "\n"
+                           (plist-get ada-prj-current-values 'obj_dir)
+                           t) "\n"
+         (ada-prj-set-list "debug_pre_cmd"
+                           (plist-get ada-prj-current-values 'debug_pre_cmd))
+         "\n"
+         (ada-prj-set-list "debug_post_cmd"
+                           (plist-get ada-prj-current-values 'debug_post_cmd))
+         "\n"
          ))
     
     (find-file file-name)
@@ -188,9 +184,8 @@ If the current value of FIELD is the default value, returns an empty string."
     ;; kill the editor buffer
     (kill-buffer "*Customize Ada Mode*")
 
-    ;; automatically associates the current buffer with the
-    ;; new project file
-    (set (make-local-variable 'ada-prj-prj-file) file-name)
+    ;; automatically set the new project file as the active one
+    (set 'ada-prj-default-project-file file-name)
 
     ;; force Emacs to reread the project files
     (ada-reread-prj-file file-name)
@@ -239,8 +234,12 @@ If the current value of FIELD is the default value, returns an empty string."
 (defun ada-prj-load-directory (field &optional file-name)
   "Append the content of FILE-NAME to FIELD in the current project file.
 If FILE-NAME is nil, ask the user for the name."
-  (unless file-name
-    (set 'file-name (read-file-name "Root directory: " nil nil t)))
+
+  ;;  Do not use an external dialog for this, since it wouldn't allow
+  ;;  the user to select a directory
+  (let ((use-dialog-box nil))
+    (unless file-name
+      (set 'file-name (read-file-name "Root directory: " nil nil t))))
 
   (set 'ada-prj-current-values
        (plist-put ada-prj-current-values
@@ -258,10 +257,18 @@ The current buffer must be the project editing buffer."
   (let ((inhibit-read-only t))
     (erase-buffer))
 
+  ;;  Widget support in Emacs 21 requires that we clear the buffer first
+  (if (and (not (boundp 'running-xemacs)) (>= emacs-major-version 21))
+      (progn
+       (setq widget-field-new  nil
+             widget-field-list nil)
+       (mapcar (lambda (x) (delete-overlay x)) (car (overlay-lists)))
+       (mapcar (lambda (x) (delete-overlay x)) (cdr (overlay-lists)))))
+  
   ;;  Display the tabs
   
   (widget-insert "\n               Project and Editor configuration.\n
-   ___________    ____________    ____________    ____________\n  / ")
+  ___________    ____________    ____________    ____________    ____________\n / ")
   (widget-create 'push-button :notify
                 (lambda (&rest dummy) (ada-prj-display-page 1)) "General")
   (widget-insert " \\  /   ")
@@ -273,6 +280,9 @@ The current buffer must be the project editing buffer."
   (widget-insert " \\  / ")
   (widget-create 'push-button :notify
                 (lambda (&rest dummy) (ada-prj-display-page 4)) "Ada Menu")
+  (widget-insert " \\  / ")
+  (widget-create 'push-button :notify
+                (lambda (&rest dummy) (ada-prj-display-page 5)) "Debugger")
   (widget-insert " \\\n")
 
   ;;  Display the currently selected page
@@ -283,7 +293,7 @@ The current buffer must be the project editing buffer."
    ;;  First page (General)
    ;;
    ((= tab-num 1)
-    (widget-insert "_/             \\/______________\\/______________\\/______________\\_____\n\n")
+    (widget-insert "/             \\/______________\\/______________\\/______________\\/______________\\\n")
 
     (widget-insert "Project file name:\n")
     (widget-insert (plist-get ada-prj-current-values 'filename))
@@ -330,7 +340,15 @@ To use JGNAT, enter 'j'.")
    ;;  Second page (Paths)
    ;;
    ((= tab-num 2)
-    (widget-insert "_/_____________\\/              \\/______________\\/______________\\_____\n\n")
+    (if (not (equal (plist-get ada-prj-current-values 'cross_prefix)
+                   ada-old-cross-prefix))
+       (progn
+         (setq ada-old-cross-prefix
+               (plist-get ada-prj-current-values 'cross_prefix))
+         (ada-initialize-runtime-library ada-old-cross-prefix)))
+
+    
+    (widget-insert "/_____________\\/              \\/______________\\/______________\\/______________\\\n")
     (ada-prj-field 'src_dir  "Source directories"
 "Enter the list of directories where your Ada
 sources can be found. These directories will be
@@ -340,9 +358,9 @@ Note that src_dir includes both the build directory
 and the standard runtime."
       t t
       (mapconcat (lambda(x)
-                  (concat "           " x))
-                ada-xref-runtime-library-specs-path
-                "\n")
+                   (concat "           " x))
+                 ada-xref-runtime-library-specs-path
+                 "\n")
       )
     (widget-insert "\n\n")
     
@@ -355,9 +373,9 @@ Note that obj_dir includes both the build directory
 and the standard runtime."
       t t
       (mapconcat (lambda(x)
-                  (concat "           " x))
-                ada-xref-runtime-library-ali-path
-                "\n")
+                   (concat "           " x))
+                 ada-xref-runtime-library-ali-path
+                 "\n")
       )
     (widget-insert "\n\n")
     )
@@ -366,7 +384,7 @@ and the standard runtime."
    ;;  Third page (Switches)
    ;;
    ((= tab-num 3)
-    (widget-insert "_/_____________\\/______________\\/              \\/______________\\_____\n\n")
+    (widget-insert "/_____________\\/______________\\/              \\/______________\\/______________\\\n")
     (ada-prj-field 'comp_opt "Switches for the compiler"
 "These switches are used in the default
 compilation commands, both for compiling a
@@ -380,56 +398,78 @@ command and are passed to the linker")
     (ada-prj-field 'gnatmake_opt "Switches for gnatmake"
 "These switches are used in the default gnatmake
 command.")                
+    (ada-prj-field 'gnatfind_opt "Switches for gnatfind"
+"The command gnatfind is run every time the Ada/Goto/List_References menu.
+You should for instance add -a if you are working in an environment
+where most ALI files are write-protected, since otherwise they get
+ignored by gnatfind and you don't see the references within.")
     )
 
    ;;
    ;;  Fourth page
    ;;
    ((= tab-num 4)
-    (widget-insert "_/_____________\\/______________\\/______________\\/              \\_____\n\n")
-    (widget-insert "All the fields below can use variable substitution\n")
-    (widget-insert "The syntax is ${name}, where name is the name that\n")
-    (widget-insert "appears after the Help buttons in this buffer.\n")
-    (widget-insert "As a special case, ${current} is replaced with the name\n")
-    (widget-insert "of the file currently edited, with directory name but\n")
-    (widget-insert "no extension.\n\n")
+    (widget-insert "/_____________\\/______________\\/______________\\/              \\/______________\\\n")
     (widget-insert
-     "The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH\n")
+"All the fields below can use variable substitution The syntax is ${name},
+where name is the name that appears after the Help buttons in this buffer. As
+a special case, ${current} is replaced with the name of the file currently
+edited, with directory name but no extension, whereas ${full_current} is
+replaced with the name of the current file with directory name and
+extension.\n")
     (widget-insert
-     "are set to ${src_dir} and ${obj_dir} before running the compilation\n")
+"The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are set to
+${src_dir} and ${obj_dir} before running the compilation commands, so that you
+don't need to specify the -aI and -aO switches on the command line\n")
     (widget-insert
-     "commands, so that you don't need to specify the -aI and -aO\n")
-    (widget-insert
-     "switches on the command line\n\n")
-    
+"You can reference any environment variable using the same ${...} syntax as
+above, and put the name of the variable between the quotes.\n\n")
     (ada-prj-field 'check_cmd
       "Check syntax of a single file (menu Ada->Check File)"
 "This command is run to check the syntax and semantics of a file.
-The file name is added at the end of this command.")
+The file name is added at the end of this command." t)
     (ada-prj-field 'comp_cmd
       "Compiling a single file (menu Ada->Compile File)"
 "This command is run when the recompilation
 of a single file is needed. The file name is
-added at the end of this command.")
+added at the end of this command." t)
     (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)"
 "This command is run when you want to rebuild
 your whole application. It is never issues
 automatically and you will need to ask for it.
 If remote_machine has been set, this command
-will be executed on the remote machine.")
+will be executed on the remote machine." t)
     (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)"
 "This command specifies how to run the
 application, including any switch you need to
 specify. If remote_machine has been set, this
-command will be executed on the remote host.")
+command will be executed on the remote host." t)
+    )
+
+   ;;
+   ;;  Fifth page
+   ;;
+   ((= tab-num 5)
+    (widget-insert "/_____________\\/______________\\/______________\\/______________\\/              \\\n")
+    (ada-prj-field 'debug_pre_cmd "Commands to execute before launching the
+debugger"
+"The following commands are executed one after the other before starting
+the debugger. These can be used to set up your environment." t)
+    
     (ada-prj-field 'debug_cmd "Debugging the application"
 "Specifies how to debug the application, possibly
 remotely if remote_machine has been set. We
 recommend the following debuggers:
   > gdb
-  > gdbtk
+  > gvd --tty
   > ddd --tty -fullname -toolbar")
+
+    (ada-prj-field 'debug_post_cmd "Commands to execute in the debugger"
+"The following commands are executed one in the debugger once it has been
+started. These can be used to initialize the debugger, for instance to
+connect to the target when working with cross-environments" t)
     )
+   
    )
 
 
@@ -462,32 +502,55 @@ If FILENAME is given, edit that file."
   (let ((ada-buffer (current-buffer))
        (inhibit-read-only t))
 
-    (ada-require-project-file)
-    
-    (switch-to-buffer "*Customize Ada Mode*")
-    (kill-all-local-variables)
+    ;;  We can only edit interactively the standard ada-mode project files. If
+    ;;  the user is using other formats for the project file (through hooks in
+    ;;  `ada-load-project-hook', we simply edit the file
     
-    (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer)
-    (ada-prj-initialize-values  'ada-prj-current-values ada-buffer filename)
-
-    (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
-
-    (use-local-map (copy-keymap custom-mode-map))
-    (local-set-key "\C-x\C-s" 'ada-prj-save)
-
-    (make-local-variable 'widget-keymap)
-    (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)
+    (if (and (not new-file)
+            (or ada-prj-default-project-file filename)
+            (string= (file-name-extension
+                      (or filename ada-prj-default-project-file))
+                     "gpr"))
+       (progn
+         (find-file ada-prj-default-project-file)
+         (add-hook 'after-save-hook 'ada-reread-prj-file t t)
+         )
 
-    (ada-prj-display-page 1)
-  ))
+      ;;  Else start the interactive editor
+      (switch-to-buffer "*Customize Ada Mode*")
+      (kill-all-local-variables)
+      
+      (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer)
+      (ada-prj-initialize-values
+       'ada-prj-current-values ada-buffer filename)
+      
+      (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
+      
+      (use-local-map (copy-keymap custom-mode-map))
+      (local-set-key "\C-x\C-s" 'ada-prj-save)
+      
+      (make-local-variable 'widget-keymap)
+      (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)
+      
+      (set (make-local-variable 'ada-old-cross-prefix)
+          (ada-xref-get-project-field 'cross-prefix))
+      
+      (ada-prj-display-page 1)
+      )))
 
 ;; ---------------- Utilities --------------------------------
 
-(defun ada-prj-set-list (string ada-dir-list)
-  "Join the strings in ADA-DIR-LIST into a single string. Each name is put
-on a separate line that begins with STRING."
-  (mapconcat (lambda (x) (concat string "=" (file-name-as-directory x)))
-             ada-dir-list "\n"))
+(defun ada-prj-set-list (string ada-list &optional is-directory)
+  "Join the strings in ADA-LIST into a single string.
+Each name is put on a separate line that begins with STRING.
+If IS-DIRECTORY is non-nil, each name is explicitly converted to a
+directory name."
+
+  (mapconcat (lambda (x) (concat string "="
+                                (if is-directory
+                                    (file-name-as-directory x)
+                                  x)))
+             ada-list "\n"))
 
 
 (defun ada-prj-get-prj-dir (&optional ada-file)
@@ -497,8 +560,6 @@ If ADA-FILE is nil, returns the project file for the current buffer."
     (setq ada-file (buffer-file-name)))
 
   (save-excursion
-    (set-buffer (get-file-buffer ada-file))
-    
     (let ((prj-file (ada-prj-find-prj-file t)))
       (if (or (not prj-file)
              (not (file-exists-p prj-file))
@@ -515,7 +576,7 @@ change in ada-prj-current-values so that selecting another page and coming
 back keeps the new value."
   (set 'ada-prj-current-values
        (plist-put ada-prj-current-values
-                 (widget-get widget 'prj-field)
+                 (widget-get widget ':prj-field)
                  (widget-value widget))))
 
 (defun ada-prj-display-help (widget widget-modified event)
@@ -536,15 +597,17 @@ this function can be used as :notify for the widget."
       )))
 
 (defun ada-prj-show-value (widget widget-modified event)
-  (let ((value (plist-get ada-prj-current-values
-                         (widget-get widget 'prj-field)))
-       (inhibit-read-only t))
+  (let* ((field (widget-get widget ':prj-field))
+        (value (plist-get ada-prj-current-values field))
+        (inhibit-read-only t)
+        w)
 
     ;;  If the other widget is already visible, delete it
     (if (widget-get widget 'prj-other-widget)
        (progn
          (widget-delete (widget-get widget 'prj-other-widget))
          (widget-put widget 'prj-other-widget nil)
+         (widget-put widget ':prj-field field)
          (widget-default-value-set widget "Show Value")
          )
 
@@ -553,14 +616,15 @@ this function can be used as :notify for the widget."
        (mouse-set-point event)
        (forward-line 1)
        (beginning-of-line)
-       (widget-put widget 'prj-other-widget
-                   (widget-create 'editable-list
-                                  :entry-format "%i%d %v"
-                                  :notify 'ada-prj-field-modified
-                                  :help-echo (widget-get widget 'prj-help)
-                                  :value value
-                                  (list 'editable-field
-                                        :keymap widget-keymap)))
+       (setq w (widget-create 'editable-list
+                              :entry-format "%i%d %v"
+                              :notify 'ada-prj-field-modified
+                              :help-echo (widget-get widget 'prj-help)
+                              :value value
+                              (list 'editable-field :keymap widget-keymap)))
+       (widget-put widget 'prj-other-widget w)
+       (widget-put w ':prj-field field)
+       (widget-put widget ':prj-field field)
        (widget-default-value-set widget "Hide Value")
        )
       )
@@ -606,6 +670,7 @@ AFTER-TEXT is inserted just after the widget."
                                     (list 'quote field)))
                         "Load Recursive Directory")
          (widget-insert "\n           ${build_dir}\n")))
+
     (set 'widget
         (if is-list
             (if (< (length value) 15)
@@ -615,11 +680,11 @@ AFTER-TEXT is inserted just after the widget."
                                :help-echo help-text
                                :value value
                                (list 'editable-field :keymap widget-keymap))
+
               (let ((w (widget-create 'push-button
                                       :notify 'ada-prj-show-value
                                       "Show value")))
                 (widget-insert "\n")
-                (widget-put w 'prj-field field)
                 (widget-put w 'prj-help  help-text)
                 (widget-put w 'prj-other-widget nil)
                 w)
@@ -630,7 +695,7 @@ AFTER-TEXT is inserted just after the widget."
                          :help-echo help-text
                          :keymap widget-keymap
                          value)))
-    (widget-put widget 'prj-field field)
+    (widget-put widget ':prj-field field)
     (if after-text
        (widget-insert after-text))
     (widget-insert "\n")
@@ -640,7 +705,7 @@ AFTER-TEXT is inserted just after the widget."
 ;;  Set the keymap once and for all, so that the keys set by the user in his
 ;;  config file are not overwritten every time we open a new file.
 (ada-prj-add-keymap)
-(ada-prj-add-ada-menu)
 
 (provide 'ada-prj)
-;;; package ada-prj.el ends here
+
+;;; ada-prj.el ends here