/[emacs]/emacs/lisp/progmodes/ada-xref.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/ada-xref.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by monnier, Mon Jul 16 13:38:53 2001 UTC revision 1.9 by monnier, Tue Apr 9 18:54:20 2002 UTC
# Line 1  Line 1 
1  ;;; ada-xref.el --- for lookup and completion in Ada mode  ;;; ada-xref.el --- for lookup and completion in Ada mode
2    
3  ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.  ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001
4    ;;    Free Software Foundation, Inc.
5    
6  ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>  ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
7  ;;      Rolf Ebert <ebert@inf.enst.fr>  ;;      Rolf Ebert <ebert@inf.enst.fr>
# Line 31  Line 32 
32  ;;; cross reference capabilities of the GNAT Ada compiler  ;;; cross reference capabilities of the GNAT Ada compiler
33  ;;; for lookup and completion in Ada mode.  ;;; for lookup and completion in Ada mode.
34  ;;;  ;;;
 ;;; The functions provided are the following ones :  
 ;;;    - `ada-complete-identifier': completes the current identifier as much as  
 ;;;      possible, depending of the known identifier in the unit  
 ;;;    - `ada-point-and-xref': moves the mouse pointer and shows the declaration  
 ;;;      of the selected identifier (either in the same buffer or in another  
 ;;;      buffer  
 ;;;    - `ada-goto-declaration': shows the declaration of the selected  
 ;;;      identifier (the one under the cursor), either in the same buffer or in  
 ;;;      another buffer  
 ;;;    - `ada-goto-declaration-other-frame': same as previous, but opens a new  
 ;;      frame to show the declaration  
 ;;;    - `ada-compile-application': recompile your whole application, provided  
 ;;;      that a project file exists in your directory  
 ;;;    - `ada-run-application': run your application directly from Emacs  
 ;;;    - `ada-reread-prj-file': force Emacs to read your project file again.  
 ;;;      Otherwise, this file is only read the first time Emacs needs some  
 ;;;      informations, which are then kept in memory  
 ;;;    - `ada-change-prj': change the prj file associated with a buffer  
 ;;;    - `ada-change-default-prj': change the default project file used for  
 ;;;      every new buffer  
 ;;;  
35  ;;; If a file *.`adp' exists in the ada-file directory, then it is  ;;; If a file *.`adp' exists in the ada-file directory, then it is
36  ;;; read for configuration informations. It is read only the first  ;;; read for configuration informations. It is read only the first
37  ;;; time a cross-reference is asked for, and is not read later.  ;;; time a cross-reference is asked for, and is not read later.
# Line 86  the application." Line 66  the application."
66  Set to 0, if you don't use crunched filenames. This should be a string."  Set to 0, if you don't use crunched filenames. This should be a string."
67    :type 'string :group 'ada)    :type 'string :group 'ada)
68    
69  (defcustom ada-prj-default-comp-opt "-gnatq"  (defcustom ada-prj-default-comp-opt "-gnatq -gnatQ"
70    "Default compilation options."    "Default compilation options."
71    :type 'string :group 'ada)    :type 'string :group 'ada)
72    
# Line 102  Set to 0, if you don't use crunched file Line 82  Set to 0, if you don't use crunched file
82    "Default options for gnatmake."    "Default options for gnatmake."
83    :type 'string :group 'ada)    :type 'string :group 'ada)
84    
85    (defcustom ada-prj-gnatfind-switches "-rf"
86      "Default switches to use for gnatfind.
87    You should modify this variable, for instance to add -a, if you are working
88    in an environment where most ALI files are write-protected.
89    The command gnatfind is used every time you choose the menu
90    \"Show all references\"."
91      :type 'string :group 'ada)
92    
93  (defcustom ada-prj-default-comp-cmd  (defcustom ada-prj-default-comp-cmd
94    "${cross_prefix}gcc -c ${comp_opt}"    "${cross_prefix}gcc -x ada -c ${comp_opt} ${full_current}"
95    "*Default command to be used to compile a single file.    "*Default command to be used to compile a single file.
96  Emacs will add the filename at the end of this command. This is the same  Emacs will add the filename at the end of this command. This is the same
97  syntax as in the project file."  syntax as in the project file."
# Line 137  This has the same syntax as in the proje Line 125  This has the same syntax as in the proje
125  Otherwise, ask the user for the name of the project file to use."  Otherwise, ask the user for the name of the project file to use."
126    :type 'boolean :group 'ada)    :type 'boolean :group 'ada)
127    
128    (defconst is-windows (memq system-type (quote (windows-nt)))
129      "True if we are running on windows NT or windows 95.")
130    
131    (defcustom ada-tight-gvd-integration nil
132      "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
133    If GVD is not the debugger used, nothing happens.")
134    
135  ;; ------- Nothing to be modified by the user below this  ;; ------- Nothing to be modified by the user below this
136  (defvar ada-last-prj-file ""  (defvar ada-last-prj-file ""
137    "Name of the last project file entered by the user.")    "Name of the last project file entered by the user.")
# Line 144  Otherwise, ask the user for the name of Line 139  Otherwise, ask the user for the name of
139  (defvar ada-check-switch "-gnats"  (defvar ada-check-switch "-gnats"
140    "Switch added to the command line to check the current file.")    "Switch added to the command line to check the current file.")
141    
142  (defvar ada-project-file-extension ".adp"  (defconst ada-project-file-extension ".adp"
143    "The extension used for project files.")    "The extension used for project files.")
144    
 (defconst is-windows (memq system-type (quote (windows-nt)))  
   "True if we are running on windows NT or windows 95.")  
   
145  (defvar ada-xref-runtime-library-specs-path '()  (defvar ada-xref-runtime-library-specs-path '()
146    "Directories where the specs for the standard library is found.    "Directories where the specs for the standard library is found.
147  This is used for cross-references.")  This is used for cross-references.")
# Line 162  This is used for cross-references.") Line 154  This is used for cross-references.")
154    "List of positions selected by the cross-references functions.    "List of positions selected by the cross-references functions.
155  Used to go back to these positions.")  Used to go back to these positions.")
156    
157    (defvar ada-cd-command
158      (if (string-match "cmdproxy.exe" shell-file-name)
159          "cd /d"
160        "cd")
161      "Command to use to change to a specific directory. On windows systems
162    using cmdproxy.exe as the shell, we need to use /d or the drive is never
163    changed.")
164    
165    (defvar ada-command-separator (if is-windows " && " "\n")
166      "Separator to use when sending multiple commands to `compile' or
167    `start-process'.
168    cmdproxy.exe doesn't recognize multiple-line commands, so we have to use
169    \"&&\" for now.")
170    
171  (defconst ada-xref-pos-ring-max 16  (defconst ada-xref-pos-ring-max 16
172    "Number of positions kept in the list ada-xref-pos-ring.")    "Number of positions kept in the list ada-xref-pos-ring.")
173    
# Line 169  Used to go back to these positions.") Line 175  Used to go back to these positions.")
175    "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"    "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
176    "Regexp to match for operators.")    "Regexp to match for operators.")
177    
 (defvar ada-xref-default-prj-file nil  
   "Name of the default prj file, per directory.  
 Every directory is potentially associated with a default project file.  
 If it is nil, then the first prj file loaded will be the default for this  
 Emacs session.")  
   
   
178  (defvar ada-xref-project-files '()  (defvar ada-xref-project-files '()
179    "Associative list of project files.    "Associative list of project files.
180  It has the following format:  It has the following format:
181  \((project_name . value) (project_name . value) ...)  \((project_name . value) (project_name . value) ...)
182  As always, the values of the project file are defined through properties.")  As always, the values of the project file are defined through properties.")
183    
184  (defvar ada-prj-prj-file nil  (defun ada-quote-cmd (cmd)
185    "Buffer local variable that specifies the name of the project file.    "Duplicates all \\ characters in CMD so that it can be passed to `compile'"
186  Getting the project is done by looking up the key in ada-pxref-project-file.")    (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
187    
188  (defun my-local-variable-if-set-p (variable &optional buffer)  (defun ada-initialize-runtime-library (cross-prefix)
189    "Returns t if VARIABLE is local in BUFFER and is non-nil."    "Initializes the variables for the runtime library location.
190    (and (local-variable-p variable buffer)  CROSS-PREFIX is the prefix to use for the gnatls command"
        (save-excursion  
          (set-buffer buffer)  
          (symbol-value variable))))  
   
 (defun ada-initialize-runtime-library ()  
   "Initializes the variables for the runtime library location."  
191    (save-excursion    (save-excursion
192      (set 'ada-xref-runtime-library-specs-path '())      (setq ada-xref-runtime-library-specs-path '()
193      (set 'ada-xref-runtime-library-ali-path '())            ada-xref-runtime-library-ali-path   '())
194      (set-buffer (get-buffer-create "*gnatls*"))      (set-buffer (get-buffer-create "*gnatls*"))
195      (widen)      (widen)
196      (erase-buffer)      (erase-buffer)
# Line 206  Getting the project is done by looking u Line 199  Getting the project is done by looking u
199          ;;  Even if we get an error, delete the *gnatls* buffer          ;;  Even if we get an error, delete the *gnatls* buffer
200          (unwind-protect          (unwind-protect
201              (progn              (progn
202                (call-process "gnatls" nil t nil "-v")                (call-process (concat cross-prefix "gnatls")
203                                nil t nil "-v")
204                (goto-char (point-min))                (goto-char (point-min))
205    
206                ;;  Source path                ;;  Source path
# Line 248  Getting the project is done by looking u Line 242  Getting the project is done by looking u
242    "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.    "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
243  The project file must have been loaded first.  The project file must have been loaded first.
244  As a special case, ${current} is replaced with the name of the currently  As a special case, ${current} is replaced with the name of the currently
245  edited file, minus extension but with directory."  edited file, minus extension but with directory, and ${full_current} is
246    replaced by the name including the extension."
247    
248    (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string)    (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string)
249      (let (value)      (let (value
250        (if (string= (match-string 2 cmd-string) "current")            (name (match-string 2 cmd-string)))
251            (set 'value (file-name-sans-extension (buffer-file-name)))        (cond
252           ((string= name "current")
253            (setq value (file-name-sans-extension (buffer-file-name))))
254           ((string= name "full_current")
255            (setq value (buffer-file-name)))
256           (t
257          (save-match-data          (save-match-data
258            (set 'value (ada-xref-get-project-field            (setq value (ada-xref-get-project-field (intern name))))))
259                         (intern (match-string 2 cmd-string))))))  
260          ;; Check if there is an environment variable with the same name
261          (if (null value)
262              (if (not (setq value (getenv name)))
263                  (message (concat "No environment variable " name " found"))))
264                    
265        (cond        (cond
266         ((null value)         ((null value)
267          (set 'cmd-string (replace-match "" t t cmd-string)))          (setq cmd-string (replace-match "" t t cmd-string)))
268         ((stringp value)         ((stringp value)
269          (set 'cmd-string (replace-match value t t cmd-string)))          (setq cmd-string (replace-match value t t cmd-string)))
270         ((listp value)         ((listp value)
271          (let ((prefix (match-string 1 cmd-string)))          (let ((prefix (match-string 1 cmd-string)))
272            (set 'cmd-string (replace-match            (setq cmd-string (replace-match
273                              (mapconcat (lambda(x) (concat prefix x)) value " ")                              (mapconcat (lambda(x) (concat prefix x)) value " ")
274                              t t cmd-string)))))                              t t cmd-string)))))
275        ))        ))
# Line 282  edited file, minus extension but with di Line 287  edited file, minus extension but with di
287             ;;  Try hard to find a default value for filename, so that the user             ;;  Try hard to find a default value for filename, so that the user
288             ;;  can edit his project file even if the current buffer is not an             ;;  can edit his project file even if the current buffer is not an
289             ;;  Ada file or not even associated with a file             ;;  Ada file or not even associated with a file
290             (list 'filename        (cond             (list 'filename (expand-file-name
291                                     (file                              (cond
292                                      (ada-prj-get-prj-dir file))                               (file
293                                     (ada-prj-prj-file                                (ada-prj-get-prj-dir file))
294                                      ada-prj-prj-file)                               (ada-prj-default-project-file
295                                     (ada-xref-default-prj-file                                ada-prj-default-project-file)
296                                      ada-xref-default-prj-file)                               (t
297                                     (t                                (message (concat "Not editing an Ada file,"
298                                      (error (concat "Not editing an Ada file,"                                                 "and no default project "
299                                                     "and no default project "                                                 "file specified!"))
300                                                     "file specified!"))))                                "")))
301                   'build_dir       (file-name-as-directory (expand-file-name "."))                   'build_dir       (file-name-as-directory (expand-file-name "."))
302                   'src_dir         (list ".")                   'src_dir         (list ".")
303                   'obj_dir         (list ".")                   'obj_dir         (list ".")
# Line 303  edited file, minus extension but with di Line 308  edited file, minus extension but with di
308                   'bind_opt        ada-prj-default-bind-opt                   'bind_opt        ada-prj-default-bind-opt
309                   'link_opt        ada-prj-default-link-opt                   'link_opt        ada-prj-default-link-opt
310                   'gnatmake_opt    ada-prj-default-gnatmake-opt                   'gnatmake_opt    ada-prj-default-gnatmake-opt
311                     'gnatfind_opt    ada-prj-gnatfind-switches
312                   'main            (if file                   'main            (if file
313                                        (file-name-sans-extension file)                                        (file-name-nondirectory
314                                           (file-name-sans-extension file))
315                                      "")                                      "")
316                   'main_unit       (if file                   'main_unit       (if file
317                                        (file-name-nondirectory                                        (file-name-nondirectory
# Line 312  edited file, minus extension but with di Line 319  edited file, minus extension but with di
319                                      "")                                      "")
320                   'cross_prefix    ""                   'cross_prefix    ""
321                   'remote_machine  ""                   'remote_machine  ""
322                   'comp_cmd        (concat "cd ${build_dir} && "                   'comp_cmd        (list (concat ada-cd-command " ${build_dir}")
323                                            ada-prj-default-comp-cmd)                                          ada-prj-default-comp-cmd)
324                   'check_cmd       (concat ada-prj-default-comp-cmd " "                   'check_cmd       (list (concat ada-prj-default-comp-cmd " "
325                                            ada-check-switch)                                                  ada-check-switch))
326                   'make_cmd        (concat "cd ${build_dir} && "                   'make_cmd        (list (concat ada-cd-command " ${build_dir}")
327                                            ada-prj-default-make-cmd)                                          ada-prj-default-make-cmd)
328                   'run_cmd         (concat "cd ${build_dir} && ${main}"                   'run_cmd         (list (concat ada-cd-command " ${build_dir}")
329                                            (if is-windows ".exe"))                                          (concat "${main}"
330                                                    (if is-windows ".exe")))
331                     'debug_pre_cmd   (list (concat ada-cd-command
332                                                    " ${build_dir}"))
333                   'debug_cmd       (concat ada-prj-default-debugger                   'debug_cmd       (concat ada-prj-default-debugger
334                                            (if is-windows " ${main}.exe"                                            (if is-windows " ${main}.exe"
335                                              " ${main}"))))                                              " ${main}"))
336                     'debug_post_cmd  (list nil)))
337        )        )
338      (set symbol plist)))      (set symbol plist)))
339        
340  (defun ada-xref-get-project-field (field)  (defun ada-xref-get-project-field (field)
341    "Extract the value of FIELD from the project file of the current buffer.    "Extract the value of FIELD from the current project file.
342  The project file must have been loaded first.  The project file must have been loaded first.
343  A default value is returned if the file was not found."  A default value is returned if the file was not found.
344    
345    Note that for src_dir and obj_dir, you should rather use
346    `ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' which will in
347    addition return the default paths."
348    
349    (let ((file-name ada-prj-prj-file)    (let ((file-name ada-prj-default-project-file)
350          file value)          file value)
351    
352      ;;  If a default project file was set, use it if no other project      ;;  Get the project file (either the current one, or a default one)
353      ;;  file was specified for the buffer      (setq file (or (assoc file-name ada-xref-project-files)
354      (if (and (not file-name)                     (assoc nil ada-xref-project-files)))
              ada-prj-default-project-file  
              (not (string= ada-prj-default-project-file "")))  
         (set 'file-name ada-prj-default-project-file))  
       
     (set 'file (assoc file-name ada-xref-project-files))  
355                    
356      ;;  If the file was not found, use the default values      ;;  If the file was not found, use the default values
357      (if file      (if file
# Line 351  A default value is returned if the file Line 361  A default value is returned if the file
361        ;; Create a default nil file that contains the default values        ;; Create a default nil file that contains the default values
362        (ada-xref-set-default-prj-values 'value (current-buffer))        (ada-xref-set-default-prj-values 'value (current-buffer))
363        (add-to-list 'ada-xref-project-files (cons nil value))        (add-to-list 'ada-xref-project-files (cons nil value))
364          (ada-xref-update-project-menu)
365        (set 'value (plist-get value field))        (set 'value (plist-get value field))
366        )        )
367      (if (stringp value)  
368          (ada-treat-cmd-string value)      ;;  Substitute the ${...} constructs in all the strings, including
369        value))      ;;  inside lists
370    )      (cond
371         ((stringp value)
372          (ada-treat-cmd-string value))
373         ((null value)
374          nil)
375         ((listp value)
376          (mapcar (lambda(x) (if x (ada-treat-cmd-string x) x)) value))
377         (t
378          value)
379         )
380      ))
381    
382    
383    (defun ada-xref-get-src-dir-field ()
384      "Return the full value for src_dir, including the default directories.
385    All the directories are returned as absolute directories."
386    
387      (let ((build-dir (ada-xref-get-project-field 'build_dir)))
388        (append
389         ;; Add ${build_dir} in front of the path
390         (list build-dir)
391        
392         (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir)
393                                    build-dir)
394        
395         ;; Add the standard runtime at the end
396         ada-xref-runtime-library-specs-path)))
397    
398    (defun ada-xref-get-obj-dir-field ()
399      "Return the full value for obj_dir, including the default directories.
400    All the directories are returned as absolute directories."
401    
402      (let ((build-dir (ada-xref-get-project-field 'build_dir)))
403        (append
404         ;; Add ${build_dir} in front of the path
405         (list build-dir)
406        
407         (ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir)
408                                    build-dir)
409        
410         ;; Add the standard runtime at the end
411         ada-xref-runtime-library-ali-path)))
412    
413    (defun ada-xref-update-project-menu ()
414      "Update the menu Ada->Project, with the list of available project files."
415      (interactive)
416      (let (submenu)
417    
418        ;;  Create the standard items
419        (set 'submenu (list (cons 'Load (cons "Load..."
420                                              'ada-set-default-project-file))
421                            (cons 'New  (cons "New..."  'ada-prj-new))
422                            (cons 'Edit (cons "Edit..." 'ada-prj-edit))
423                            (cons 'sep  (cons "---" nil))))
424        
425        ;;  Add the new items
426        (mapcar
427         (lambda (x)
428           (let ((name (or (car x) "<default>"))
429                 (command `(lambda ()
430                             "Change the active project file."
431                             (interactive)
432                             (ada-parse-prj-file ,(car x))
433                             (set 'ada-prj-default-project-file ,(car x))
434                             (ada-xref-update-project-menu))))
435             (set 'submenu
436                  (append submenu
437                          (list (cons (intern name)
438                                      (list
439                                       'menu-item (file-name-sans-extension
440                                                   (file-name-nondirectory name))
441                                       command
442                                       :button (cons
443                                                :toggle
444                                                (equal ada-prj-default-project-file
445                                                       (car x))
446                                                ))))))))
447        
448         ;; Parses all the known project files, and insert at least the default
449         ;; one (in case ada-xref-project-files is nil)
450         (or ada-xref-project-files '(nil)))
451    
452         (if (not ada-xemacs)
453             (if (lookup-key ada-mode-map [menu-bar Ada Project])
454                 (setcdr (lookup-key ada-mode-map [menu-bar Ada Project])
455                         submenu)))
456        ))
457    
458    
459    ;;-------------------------------------------------------------
460    ;;--  Searching a file anywhere on the source path.
461    ;;--
462    ;;--  The following functions provide support for finding a file anywhere
463    ;;--  on the source path, without providing an explicit directory.
464    ;;--  They also provide file name completion in the minibuffer.
465    ;;--
466    ;;--  Public subprograms:  ada-find-file
467    ;;--
468    ;;-------------------------------------------------------------
469    
470    (defun ada-do-file-completion (string predicate flag)
471      "Completion function when reading a file from the minibuffer.
472    Completion is attempted in all the directories in the source path, as
473    defined in the project file."
474      (let (list
475            (dirs (ada-xref-get-src-dir-field)))
476    
477        (while dirs
478          (if (file-directory-p (car dirs))
479              (set 'list (append list (file-name-all-completions string (car dirs)))))
480          (set 'dirs (cdr dirs)))
481        (cond ((equal flag 'lambda)
482               (assoc string list))
483              (flag
484               list)
485              (t
486               (try-completion string
487                               (mapcar (lambda (x) (cons x 1)) list)
488                          predicate)))))
489    
490    ;;;###autoload
491    (defun ada-find-file (filename)
492      "Open a file anywhere in the source path.
493    Completion is available."
494      (interactive
495       (list (completing-read "File: " 'ada-do-file-completion)))
496      (let ((file (ada-find-src-file-in-dir filename)))
497        (if file
498            (find-file file)
499          (error (concat filename " not found in src_dir")))))
500    
501    
502  ;; ----- Keybindings ------------------------------------------------------  ;; ----- Keybindings ------------------------------------------------------
503    
# Line 376  A default value is returned if the file Line 517  A default value is returned if the file
517    (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference)    (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference)
518    (define-key ada-mode-map "\C-c\C-x" 'ada-reread-prj-file)    (define-key ada-mode-map "\C-c\C-x" 'ada-reread-prj-file)
519    (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)    (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)
   (define-key ada-mode-map "\C-cb"  'ada-buffer-list)  
520    (define-key ada-mode-map "\C-cc"  'ada-change-prj)    (define-key ada-mode-map "\C-cc"  'ada-change-prj)
521    (define-key ada-mode-map "\C-cd"  'ada-change-default-prj)    (define-key ada-mode-map "\C-cd"  'ada-set-default-project-file)
522    (define-key ada-mode-map "\C-cg"  'ada-gdb-application)    (define-key ada-mode-map "\C-cg"  'ada-gdb-application)
523    (define-key ada-mode-map "\C-cr"  'ada-run-application)    (define-key ada-mode-map "\C-cr"  'ada-run-application)
524    (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)    (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)
525    (define-key ada-mode-map "\C-c\C-r" 'ada-find-references)    (define-key ada-mode-map "\C-c\C-r" 'ada-find-references)
526    (define-key ada-mode-map "\C-c\C-v" 'ada-check-current)    (define-key ada-mode-map "\C-c\C-v" 'ada-check-current)
527      (define-key ada-mode-map "\C-c\C-f" 'ada-find-file)
528    )    )
529    
530  ;; ----- Menus --------------------------------------------------------------  ;; ----- Menus --------------------------------------------------------------
# Line 412  name as was passed to `ada-create-menu'. Line 553  name as was passed to `ada-create-menu'.
553                   menu-list ["Debug" ada-gdb-application t] "Goto")                   menu-list ["Debug" ada-gdb-application t] "Goto")
554          (funcall (symbol-function 'add-menu-button)          (funcall (symbol-function 'add-menu-button)
555                   menu-list ["--" nil t] "Goto")                   menu-list ["--" nil t] "Goto")
         (funcall (symbol-function 'add-submenu)  
                  menu-list '("Project"  
                              ["Associate"   ada-change-prj t]  
                              ["Set Default..." ada-set-default-project-file t]  
                              ["List" ada-buffer-list t])  
                  "Goto")  
556          (funcall (symbol-function 'add-menu-button)          (funcall (symbol-function 'add-menu-button)
557                   goto-menu ["Goto Parent Unit" ada-goto-parent t]                   goto-menu ["Goto Parent Unit" ada-goto-parent t]
558                   "Next compilation error")                   "Next compilation error")
# Line 475  name as was passed to `ada-create-menu'. Line 610  name as was passed to `ada-create-menu'.
610                    (setq ada-xref-confirm-compile                    (setq ada-xref-confirm-compile
611                          (not ada-xref-confirm-compile))                          (not ada-xref-confirm-compile))
612                    :style toggle :selected ada-xref-confirm-compile])                    :style toggle :selected ada-xref-confirm-compile])
613            (if (string-match "gvd" ada-prj-default-debugger)
614                (funcall (symbol-function 'add-menu-button)
615                         options-menu
616                         ["Tight Integration With Gnu Visual Debugger"
617                          (setq ada-tight-gvd-integration
618                                (not ada-tight-gvd-integration))
619                          :style toggle :selected ada-tight-gvd-integration]))
620          )          )
621            
622      ;; for Emacs      ;; for Emacs
# Line 494  name as was passed to `ada-create-menu'. Line 636  name as was passed to `ada-create-menu'.
636        (define-key-after menu [Debug]   '("Debug" . ada-gdb-application) 'Run)        (define-key-after menu [Debug]   '("Debug" . ada-gdb-application) 'Run)
637        (define-key-after menu [rem]     '("--"    . nil) 'Debug)        (define-key-after menu [rem]     '("--"    . nil) 'Debug)
638        (define-key-after menu [Project]        (define-key-after menu [Project]
639          (cons "Project"          (cons "Project" (make-sparse-keymap)) 'rem)
               (funcall (symbol-function 'easy-menu-create-menu)  
                        "Project"  
                        '(["Associate..."   ada-change-prj t  
                           :included (string= mode-name "Ada")]  
                          ["Set Default..." ada-set-default-project-file t]  
                          ["List"        ada-buffer-list t])))  
         'rem)  
640    
641        (define-key help-menu [Gnat_ug]        (define-key help-menu [Gnat_ug]
642          '("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug"))))          '("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug"))))
# Line 511  name as was passed to `ada-create-menu'. Line 646  name as was passed to `ada-create-menu'.
646          '("Gcc Documentation" . (lambda() (interactive) (info "gcc"))))          '("Gcc Documentation" . (lambda() (interactive) (info "gcc"))))
647        (define-key help-menu [gdb]        (define-key help-menu [gdb]
648          '("Gdb Documentation" . (lambda() (interactive) (info "gdb"))))          '("Gdb Documentation" . (lambda() (interactive) (info "gdb"))))
649        (define-key help-menu [gdb]        (define-key help-menu [arm95]
650          '("Ada95 Reference Manual" . (lambda() (interactive) (info "arm95"))))          '("Ada95 Reference Manual" . (lambda() (interactive) (info "arm95"))))
651    
652        (define-key goto-menu [rem]    '("----" . nil))        (define-key goto-menu [rem]    '("----" . nil))
# Line 548  name as was passed to `ada-create-menu'. Line 683  name as was passed to `ada-create-menu'.
683                     (lambda()(interactive)                     (lambda()(interactive)
684                       (setq ada-xref-other-buffer (not ada-xref-other-buffer)))                       (setq ada-xref-other-buffer (not ada-xref-other-buffer)))
685                     :button (:toggle . ada-xref-other-buffer)) t)                     :button (:toggle . ada-xref-other-buffer)) t)
686    
687          (if (string-match "gvd" ada-prj-default-debugger)
688              (define-key-after options-menu [tightgvd]
689                '(menu-item "Tight Integration With Gnu Visual Debugger"
690                            (lambda()(interactive)
691                              (setq ada-tight-gvd-integration
692                                    (not ada-tight-gvd-integration)))
693                            :button (:toggle . ada-tight-gvd-integration)) t))
694    
695          (define-key ada-mode-map [menu-bar Ada Edit rem3] '("------------" . nil))
696          (define-key ada-mode-map [menu-bar Ada Edit open-file-from-src-path]
697            '("Search File on source path..." . ada-find-file))
698        )        )
699      )      )
700      (ada-xref-update-project-menu)
701    )    )
702    
703  ;; ----- Utilities -------------------------------------------------  ;; ----- Utilities -------------------------------------------------
704    
705  (defun ada-require-project-file ()  (defun ada-require-project-file ()
706    "If no project file is assigned to this buffer, load one."    "If no project file is currently active, load a default one."
707    (if (not (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)))    (if (or (not ada-prj-default-project-file)
708              (not ada-xref-project-files)
709              (string= ada-prj-default-project-file ""))
710        (ada-reread-prj-file)))        (ada-reread-prj-file)))
711                
712  (defun ada-xref-push-pos (filename position)  (defun ada-xref-push-pos (filename position)
# Line 582  This is overriden on VMS to convert from Line 732  This is overriden on VMS to convert from
732  (defun ada-set-default-project-file (name)  (defun ada-set-default-project-file (name)
733    "Set the file whose name is NAME as the default project file."    "Set the file whose name is NAME as the default project file."
734    (interactive "fProject file:")    (interactive "fProject file:")
   
   ;;  All the directories should use this file as the default from now on,  
   ;;  even if they were already associated with a file.  
   (set 'ada-xref-default-prj-file nil)  
   
735    (set 'ada-prj-default-project-file name)    (set 'ada-prj-default-project-file name)
   
   ;; Make sure that all the buffers see the new project file, even if they  
   ;; are not Ada buffers (for instance if we want to display the current  
   ;; project file in the frame title).  
   (setq-default ada-prj-prj-file name)  
     
736    (ada-reread-prj-file name)    (ada-reread-prj-file name)
737    )    )
738    
# Line 608  file. If none is set, return nil." Line 747  file. If none is set, return nil."
747    
748    (let (selected)    (let (selected)
749    
750      ;;  If we don't have an ada buffer, or the current buffer is not      ;;  Use the active project file if there is one.
751      ;;  a real file (for instance an emerge buffer)      ;;  This is also valid if we don't currently have an Ada buffer, or if
752        ;;  the current buffer is not a real file (for instance an emerge buffer)
753            
754      (if (or (not (string= mode-name "Ada"))      (if (or (not (string= mode-name "Ada"))
755              (not (buffer-file-name)))              (not (buffer-file-name))
756                (and ada-prj-default-project-file
757          ;;  1st case: not an Ada buffer                   (not (string= ada-prj-default-project-file ""))))
758          (if (and ada-prj-default-project-file          (set 'selected ada-prj-default-project-file)
759                   (not (string= ada-prj-default-project-file "")))        
760              (set 'selected ada-prj-default-project-file))        ;;  other cases: use a more complex algorithm
761                
762        ;;  2nd case: If the buffer already has a project file, use it        (let* ((current-file (buffer-file-name))
763        (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))               (first-choice (concat
764            (set 'selected ada-prj-prj-file)                              (file-name-sans-extension current-file)
765                                ada-project-file-extension))
766                 (dir          (file-name-directory current-file))
767                
768                 ;; on Emacs 20.2, directory-files does not work if
769                 ;; parse-sexp-lookup-properties is set
770                 (parse-sexp-lookup-properties nil)
771                 (prj-files    (directory-files
772                                dir t
773                                (concat ".*" (regexp-quote
774                                              ada-project-file-extension) "$")))
775                 (choice       nil))
776                    
777          (let* ((current-file (buffer-file-name))          (cond
778                 (first-choice (concat          
779                                (file-name-sans-extension current-file)           ;;  Else if there is a project file with the same name as the Ada
780                                ada-project-file-extension))           ;;  file, but not the same extension.
781                 (dir          (file-name-directory current-file))           ((file-exists-p first-choice)
782                            (set 'selected first-choice))
783                 ;; on Emacs 20.2, directory-files does not work if          
784                 ;; parse-sexp-lookup-properties is set           ;;  Else if only one project file was found in the current directory
785                 (parse-sexp-lookup-properties nil)           ((= (length prj-files) 1)
786                 (prj-files    (directory-files            (set 'selected (car prj-files)))
787                                dir t          
788                                (concat ".*" (regexp-quote ada-project-file-extension) "$")))           ;;  Else if there are multiple files, ask the user
789                 (choice       nil)           ((and (> (length prj-files) 1) (not no-user-question))
790                 (default      (assoc dir ada-xref-default-prj-file)))            (save-window-excursion
791                          (with-output-to-temp-buffer "*choice list*"
792            (cond                (princ "There are more than one possible project file.\n")
793                            (princ "Which one should we use ?\n\n")
794             ;;  3rd case: a project file is already associated with the directory                (princ "  no.   file name  \n")
795             (default                (princ "  ---   ------------------------\n")
796               (set 'selected (cdr default)))                (let ((counter 1))
797                              (while (<= counter (length prj-files))
798             ;;  4th case: the user has set a default project file for every file                    (princ (format "  %2d)    %s\n"
799             ((and ada-prj-default-project-file                                   counter
800                   (not (string= ada-prj-default-project-file "")))                                   (nth (1- counter) prj-files)))
801              (set 'selected ada-prj-default-project-file))                    (setq counter (1+ counter))
802                                ))) ; end of with-output-to ...
803             ;;  5th case: there is a project file with the same name as the Ada file,              (setq choice nil)
804             ;;  but not the same extension.              (while (or
805             ((file-exists-p first-choice)                      (not choice)
806              (set 'selected first-choice))                      (not (integerp choice))
807                                  (< choice 1)
808             ;;  6th case: only one project file was found in the current directory                      (> choice (length prj-files)))
809             ((= (length prj-files) 1)                (setq choice (string-to-int
810              (set 'selected (car prj-files)))                              (read-from-minibuffer "Enter No. of your choice: "))))
811                          (set 'selected (nth (1- choice) prj-files))))
812             ;;  7th case: if there are multiple files, ask the user          
813             ((and (> (length prj-files) 1) (not no-user-question))           ;; Else if no project file was found in the directory, ask a name
814              (save-window-excursion           ;; to the user, using as a default value the last one entered by
815                (with-output-to-temp-buffer "*choice list*"           ;; the user
816                  (princ "There are more than one possible project file. Which one should\n")           ((= (length prj-files) 0)
817                  (princ "be used ?\n\n")            (unless (or no-user-question (not ada-always-ask-project))
818                  (princ "  no.   file name  \n")              (setq ada-last-prj-file
819                  (princ "  ---   ------------------------\n")                    (read-file-name
820                  (let ((counter 1))                     (concat "project file [" ada-last-prj-file "]:")
821                    (while (<= counter (length prj-files))                     nil ada-last-prj-file))
822                      (princ (format "  %2d)    %s\n"              (unless (string= ada-last-prj-file "")
823                                     counter                (set 'selected ada-last-prj-file))))
824                                     (nth (1- counter) prj-files)))           )))
                     (setq counter (1+ counter))  
                     ))) ; end of with-output-to ...  
               (setq choice nil)  
               (while (or  
                       (not choice)  
                       (not (integerp choice))  
                       (< choice 1)  
                       (> choice (length prj-files)))  
                 (setq choice (string-to-int  
                               (read-from-minibuffer "Enter No. of your choice: "))))  
               (set 'selected (nth (1- choice) prj-files))))  
             
            ;; 8th case: no project file was found in the directory, ask a name to the  
            ;; user, using as a default value the last one entered by the user  
            ((= (length prj-files) 0)  
             (unless (or no-user-question (not ada-always-ask-project))  
               (setq ada-last-prj-file  
                     (read-file-name "project file:" nil ada-last-prj-file))  
               (unless (string= ada-last-prj-file "")  
                 (set 'selected ada-last-prj-file))))  
            ))))  
825      selected      selected
826      ))      ))
827    
# Line 700  file. If none is set, return nil." Line 830  file. If none is set, return nil."
830    "Reads and parses the PRJ-FILE file if it was found.    "Reads and parses the PRJ-FILE file if it was found.
831  The current buffer should be the ada-file buffer."  The current buffer should be the ada-file buffer."
832    (if prj-file    (if prj-file
833        (let (project src_dir obj_dir casing        (let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing
834                        run_cmd debug_pre_cmd debug_post_cmd
835              (ada-buffer (current-buffer)))              (ada-buffer (current-buffer)))
836          (set 'prj-file (expand-file-name prj-file))          (setq prj-file (expand-file-name prj-file))
837    
838          ;;  Initialize the project with the default values          ;;  Initialize the project with the default values
839          (ada-xref-set-default-prj-values 'project (current-buffer))          (ada-xref-set-default-prj-values 'project (current-buffer))
# Line 716  The current buffer should be the ada-fil Line 847  The current buffer should be the ada-fil
847                    
848          (widen)          (widen)
849          (goto-char (point-min))          (goto-char (point-min))
850            
851          ;;  Now overrides these values with the project file          ;;  Now overrides these values with the project file
852          (while (not (eobp))          (while (not (eobp))
853            (if (looking-at "^\\([^=]+\\)=\\(.*\\)")            (if (looking-at "^\\([^=]+\\)=\\(.*\\)")
# Line 733  The current buffer should be the ada-fil Line 864  The current buffer should be the ada-fil
864                  (set 'project                  (set 'project
865                       (plist-put project 'build_dir                       (plist-put project 'build_dir
866                                  (file-name-as-directory (match-string 2)))))                                  (file-name-as-directory (match-string 2)))))
867                   ((string= (match-string 1) "make_cmd")
868                    (add-to-list 'make_cmd (match-string 2)))
869                   ((string= (match-string 1) "comp_cmd")
870                    (add-to-list 'comp_cmd (match-string 2)))
871                   ((string= (match-string 1) "check_cmd")
872                    (add-to-list 'check_cmd (match-string 2)))
873                   ((string= (match-string 1) "run_cmd")
874                    (add-to-list 'run_cmd (match-string 2)))
875                   ((string= (match-string 1) "debug_pre_cmd")
876                    (add-to-list 'debug_pre_cmd (match-string 2)))
877                   ((string= (match-string 1) "debug_post_cmd")
878                    (add-to-list 'debug_post_cmd (match-string 2)))
879                 (t                 (t
880                  (set 'project (plist-put project (intern (match-string 1))                  (set 'project (plist-put project (intern (match-string 1))
881                                           (match-string 2))))))                                           (match-string 2))))))
# Line 742  The current buffer should be the ada-fil Line 885  The current buffer should be the ada-fil
885                                               (reverse src_dir))))                                               (reverse src_dir))))
886          (if obj_dir (set 'project (plist-put project 'obj_dir          (if obj_dir (set 'project (plist-put project 'obj_dir
887                                               (reverse obj_dir))))                                               (reverse obj_dir))))
888          (if casing  (set 'project (plist-put project 'casing  casing)))          (if casing  (set 'project (plist-put project 'casing
889                                                 (reverse casing))))
890            (if make_cmd (set 'project (plist-put project 'make_cmd
891                                                  (reverse make_cmd))))
892            (if comp_cmd (set 'project (plist-put project 'comp_cmd
893                                                  (reverse comp_cmd))))
894            (if check_cmd (set 'project (plist-put project 'check_cmd
895                                                   (reverse check_cmd))))
896            (if run_cmd (set 'project (plist-put project 'run_cmd
897                                                 (reverse run_cmd))))
898            (set 'project (plist-put project 'debug_post_cmd
899                                     (reverse debug_post_cmd)))
900            (set 'project (plist-put project 'debug_pre_cmd
901                                     (reverse debug_pre_cmd)))
902    
903            ;;  Delete the default project file from the list, if it is there.
904            ;;  Note that in that case, this default project is the only one in
905            ;;  the list
906            (if (assoc nil ada-xref-project-files)
907                (setq ada-xref-project-files nil))
908            
909          ;;  Memorize the newly read project file          ;;  Memorize the newly read project file
910          (if (assoc prj-file ada-xref-project-files)          (if (assoc prj-file ada-xref-project-files)
911              (setcdr (assoc prj-file ada-xref-project-files) project)              (setcdr (assoc prj-file ada-xref-project-files) project)
912            (add-to-list 'ada-xref-project-files (cons prj-file project)))            (add-to-list 'ada-xref-project-files (cons prj-file project)))
913    
914            ;;  Set the project file as the active one.
915            (setq ada-prj-default-project-file prj-file)
916                    
917          ;; Sets up the compilation-search-path so that Emacs is able to          ;; Sets up the compilation-search-path so that Emacs is able to
918          ;; go to the source of the errors in a compilation buffer          ;; go to the source of the errors in a compilation buffer
919          (setq compilation-search-path (ada-get-absolute-dir-list          (setq compilation-search-path (ada-xref-get-src-dir-field))
920                                         (plist-get project 'src_dir)  
921                                         (plist-get project 'build_dir)))          ;; Set the casing exceptions file list
922                    (if casing
923          ;;  Associate each source directory in the project file with this file              (progn
924          (mapcar (lambda (x)                (setq ada-case-exception-file (reverse casing))
925                    (if (not (assoc (expand-file-name x)                (ada-case-read-exceptions)))
                                   ada-xref-default-prj-file))  
                       (setq ada-xref-default-prj-file  
                             (cons (cons (expand-file-name x) prj-file)  
                                   ada-xref-default-prj-file))))  
                 compilation-search-path)  
926                    
927          ;; Add the directories to the search path for ff-find-other-file          ;; Add the directories to the search path for ff-find-other-file
928          ;; Do not add the '/' or '\' at the end          ;; Do not add the '/' or '\' at the end
929          (set (make-local-variable 'ff-search-directories)          (setq ada-search-directories
930               (append (mapcar 'directory-file-name compilation-search-path)               (append (mapcar 'directory-file-name compilation-search-path)
931                       ada-search-directories))                       ada-search-directories))
932                    
# Line 774  The current buffer should be the ada-fil Line 934  The current buffer should be the ada-fil
934          (kill-buffer nil)          (kill-buffer nil)
935          (set-buffer ada-buffer)          (set-buffer ada-buffer)
936    
937          ;;  Setup the project file for the current buffer          (ada-xref-update-project-menu)
         (set (make-local-variable 'ada-prj-prj-file) prj-file)  
   
938          )          )
939    
940        ;;  No prj file ? => Setup default values
941        ;;  Note that nil means that all compilation modes will first look in the
942        ;;  current directory, and only then in the current file's directory. This
943        ;;  current file is assumed at this point to be in the common source
944        ;;  directory.
945        (setq compilation-search-path (list nil default-directory))
946      ))      ))
947                
948            
# Line 813  ENTITY was first found the location give Line 978  ENTITY was first found the location give
978    (interactive "sEntity name: ")    (interactive "sEntity name: ")
979    (ada-require-project-file)    (ada-require-project-file)
980    
981    (let* ((command (concat "gnatfind -rf " entity    ;;  Prepare the gnatfind command. Note that we must protect the quotes
982      ;;  around operators, so that they are correctly handled and can be
983      ;;  processed (gnatfind \"+\":...).
984      (let* ((quote-entity
985              (if (= (aref entity 0) ?\")
986                  (if is-windows
987                      (concat "\\\"" (substring entity 1 -1) "\\\"")
988                    (concat "'\"" (substring entity 1 -1) "\"'"))
989                entity))
990             (switches (ada-xref-get-project-field 'gnatfind_opt))
991             (command (concat "gnatfind " switches " "
992                              quote-entity
993                            (if file (concat ":" (file-name-nondirectory file)))                            (if file (concat ":" (file-name-nondirectory file)))
994                            (if line (concat ":" line))                            (if line (concat ":" line))
995                            (if column (concat ":" column)))))                            (if column (concat ":" column)))))
996    
997      ;;  If a project file is defined, use it      ;;  If a project file is defined, use it
998      (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))      (if (and ada-prj-default-project-file
999          (setq command (concat command " -p" ada-prj-prj-file)))               (not (string= ada-prj-default-project-file "")))
1000            (setq command (concat command " -p" ada-prj-default-project-file)))
1001    
1002      (compile-internal command "No more references" "gnatfind")      (compile-internal command "No more references" "gnatfind")
1003    
# Line 831  ENTITY was first found the location give Line 1008  ENTITY was first found the location give
1008      )      )
1009    )    )
1010    
1011  (defun ada-buffer-list ()  (defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))
   "Display a buffer with all the Ada buffers and their associated project."  
   (interactive)  
   (save-excursion  
     (set-buffer (get-buffer-create "*Buffer List*"))  
     (setq buffer-read-only nil)  
     (erase-buffer)  
     (setq standard-output (current-buffer))  
     (princ "The following line is a list showing the associations between  
 directories and project file. It has the format : ((directory_1 . project_file1)  
 (directory2 . project_file2)...)\n\n")  
     (princ ada-xref-default-prj-file)  
     (princ "\n  
  Buffer              Mode         Project file  
  ------              ----         ------------  
 \n")  
     (let ((bl (buffer-list)))  
       (while bl  
         (let* ((buffer (car bl))  
                (buffer-name (buffer-name buffer))  
                this-buffer-mode-name  
                this-buffer-project-file)  
           (save-excursion  
             (set-buffer buffer)  
             (setq this-buffer-mode-name  
                   (if (eq buffer standard-output)  
                       "Buffer Menu" mode-name))  
             (if (string= this-buffer-mode-name  
                          "Ada")  
                 (setq this-buffer-project-file  
                       (if ( my-local-variable-if-set-p 'ada-prj-prj-file  
                                                    (current-buffer))  
                           (expand-file-name ada-prj-prj-file)  
                         ""))))  
           (if (string= this-buffer-mode-name  
                          "Ada")  
               (progn  
                 (princ (format "%-19s  "  buffer-name))  
                   (princ (format "%-6s " this-buffer-mode-name))  
                   (princ this-buffer-project-file)  
                   (princ "\n")  
                   ))  
           ) ;; end let*  
         (setq bl (cdr bl))  
         ) ;; end while  
       );; end let  
     ) ;; end save-excursion  
   (display-buffer "*Buffer List*")  
   (other-window 1)  
   )  
   
 (defun ada-change-prj (filename)  
   "Set FILENAME to be the project file for current buffer."  
   (interactive "fproject file:")  
   
   ;; make sure we are using an Ada file  
   (if (not (string= mode-name "Ada"))  
     (error "You must be in ada-mode to use this function"))  
   
   (set (make-local-variable 'ada-prj-prj-file) filename)  
   (ada-parse-prj-file filename)  
   )  
   
 (defun ada-change-default-prj (filename)  
   "Set FILENAME to be the default project file for the current directory."  
   (interactive "ffile name:")  
   (let ((dir (file-name-directory (buffer-file-name)))  
         (prj (expand-file-name filename)))  
   
     ;;  Associate the directory with a project file  
     (if (assoc dir ada-xref-default-prj-file)  
         (setcdr (assoc dir ada-xref-default-prj-file) prj)  
       (add-to-list 'ada-xref-default-prj-file (list dir prj)))  
   
     ;; Reparse the project file  
     (ada-parse-prj-file filename)))  
   
1012    
1013  ;; ----- Identlist manipulation -------------------------------------------  ;; ----- Identlist manipulation -------------------------------------------
1014  ;; An identlist is a vector that is used internally to reference an identifier  ;; An identlist is a vector that is used internally to reference an identifier
# Line 985  option." Line 1086  option."
1086    (mouse-set-point last-input-event)    (mouse-set-point last-input-event)
1087    (ada-goto-declaration (point)))    (ada-goto-declaration (point)))
1088    
1089  (defun ada-goto-declaration (pos)  (defun ada-goto-declaration (pos &optional other-frame)
1090    "Display the declaration of the identifier around POS.    "Display the declaration of the identifier around POS.
1091  The declaration is shown in another buffer if `ada-xref-other-buffer' is  The declaration is shown in another buffer if `ada-xref-other-buffer' is
1092  non-nil."  non-nil.
1093    If OTHER-FRAME is non-nil, display the cross-reference in another frame."
1094    (interactive "d")    (interactive "d")
1095    (ada-require-project-file)    (ada-require-project-file)
1096    (push-mark pos)    (push-mark pos)
1097    (ada-xref-push-pos (buffer-file-name) pos)    (ada-xref-push-pos (buffer-file-name) pos)
   (ada-find-in-ali (ada-read-identifier pos)))  
1098    
1099  (defun ada-goto-declaration-other-frame (pos)    ;;  First try the standard algorithm by looking into the .ali file, but if
1100      ;;  that file was too old or even did not exist, try to look in the whole
1101      ;;  object path for a possible location.
1102      (let ((identlist (ada-read-identifier pos)))
1103        (condition-case nil
1104            (ada-find-in-ali identlist other-frame)
1105          (error (ada-find-in-src-path identlist other-frame)))))
1106    
1107    (defun ada-goto-declaration-other-frame (pos &optional other-frame)
1108    "Display the declaration of the identifier around POS.    "Display the declaration of the identifier around POS.
1109  The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."  The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
1110    (interactive "d")    (interactive "d")
1111    (ada-require-project-file)    (ada-goto-declaration pos t))
   (push-mark pos)  
   (ada-xref-push-pos (buffer-file-name) pos)  
   (ada-find-in-ali (ada-read-identifier pos) t))  
1112    
1113  (defun ada-remote (command)  (defun ada-remote (command)
1114    "Return the remote version of COMMAND, or COMMAND if remote_machine is nil."    "Return the remote version of COMMAND, or COMMAND if remote_machine is nil."
# Line 1014  The declation is shown in another frame Line 1120  The declation is shown in another frame
1120                machine                machine
1121                command))))                command))))
1122    
 (defun ada-get-absolute-dir (dir root-dir)  
   "Returns the absolute directory corresponding to DIR.  
 If DIR is a relative directory, the value of ROOT-DIR is added in front."  
   (if (= (string-to-char dir) ?/)  
       dir  
     (concat root-dir dir)))  
   
1123  (defun ada-get-absolute-dir-list (dir-list root-dir)  (defun ada-get-absolute-dir-list (dir-list root-dir)
1124    "Returns the list of absolute directories found in dir-list.    "Returns the list of absolute directories found in dir-list.
1125  If a directory is a relative directory, the value of ROOT-DIR is added in  If a directory is a relative directory, the value of ROOT-DIR is added in
1126  front."  front."
1127    (mapcar (lambda (x) (ada-get-absolute-dir x root-dir)) dir-list))    (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
1128    
1129  (defun ada-set-environment ()  (defun ada-set-environment ()
1130    "Return the new value for process-environment.    "Return the new value for process-environment.
# Line 1035  project file." Line 1134  project file."
1134          (objects   (getenv "ADA_OBJECTS_PATH"))          (objects   (getenv "ADA_OBJECTS_PATH"))
1135          (build-dir (ada-xref-get-project-field 'build_dir)))          (build-dir (ada-xref-get-project-field 'build_dir)))
1136      (if include      (if include
1137          (set 'include (concat include path-separator)))          (set 'include (concat path-separator include)))
1138      (if objects      (if objects
1139          (set 'objects (concat objects path-separator)))          (set 'objects (concat path-separator objects)))
1140      (cons      (cons
1141       (concat "ADA_INCLUDE_PATH="       (concat "ADA_INCLUDE_PATH="
1142               include               (mapconcat (lambda(x) (expand-file-name x build-dir))
              (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir))  
1143                          (ada-xref-get-project-field 'src_dir)                          (ada-xref-get-project-field 'src_dir)
1144                          path-separator))                          path-separator)
1145                 include)
1146       (cons       (cons
1147        (concat "ADA_OBJECTS_PATH="        (concat "ADA_OBJECTS_PATH="
1148                objects                (mapconcat (lambda(x) (expand-file-name x build-dir))
               (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir))  
1149                           (ada-xref-get-project-field 'obj_dir)                           (ada-xref-get-project-field 'obj_dir)
1150                           path-separator))                           path-separator)
1151                  objects)
1152        process-environment))))        process-environment))))
1153    
1154  (defun ada-compile-application (&optional arg)  (defun ada-compile-application (&optional arg)
# Line 1061  If ARG is not nil, ask for user confirma Line 1160  If ARG is not nil, ask for user confirma
1160          (process-environment (ada-set-environment))          (process-environment (ada-set-environment))
1161          (compilation-scroll-output t))          (compilation-scroll-output t))
1162    
1163      (set 'compilation-search-path      (setq compilation-search-path (ada-xref-get-src-dir-field))
          (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir)  
                                     (ada-xref-get-project-field 'build_dir)))  
1164    
1165      ;;  If no project file was found, ask the user      ;;  If no project file was found, ask the user
1166      (unless cmd      (unless cmd
1167        (setq cmd "" arg t))        (setq cmd '("") arg t))
1168    
1169      (compile (ada-remote      ;;  Make a single command from the list of commands, including the
1170                (if (or ada-xref-confirm-compile arg)      ;;  commands to run it on a remote machine.
1171                    (read-from-minibuffer "enter command to compile: " cmd)      (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
1172                  cmd)))      
1173    ))      (if (or ada-xref-confirm-compile arg)
1174            (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1175    
1176        ;;  Insert newlines so as to separate the name of the commands to run
1177        ;;  and the output of the commands. this doesn't work with cmdproxy.exe,
1178        ;;  which gets confused by newline characters.
1179        (if (not (string-match "cmdproxy.exe" shell-file-name))
1180            (setq cmd (concat cmd "\n\n")))
1181        
1182        (compile (ada-quote-cmd cmd))))
1183    
1184  (defun ada-compile-current (&optional arg prj-field)  (defun ada-compile-current (&optional arg prj-field)
1185    "Recompile the current file.    "Recompile the current file.
# Line 1087  command, and should be either comp_cmd ( Line 1193  command, and should be either comp_cmd (
1193           (process-environment (ada-set-environment))           (process-environment (ada-set-environment))
1194           (compilation-scroll-output t))           (compilation-scroll-output t))
1195            
1196      (set 'compilation-search-path      (setq compilation-search-path (ada-xref-get-src-dir-field))
          (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir)  
                                     (ada-xref-get-project-field 'build_dir)))  
1197    
1198        (unless cmd
1199          (setq cmd '("") arg t))
1200        
1201        ;;  Make a single command from the list of commands, including the
1202        ;;  commands to run it on a remote machine.
1203        (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
1204        
1205      ;;  If no project file was found, ask the user      ;;  If no project file was found, ask the user
1206      (if cmd      (if (or ada-xref-confirm-compile arg)
1207          (set 'cmd (concat cmd " " (ada-convert-file-name (buffer-file-name))))          (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1208        (setq cmd "" arg t))  
1209        ;;  Insert newlines so as to separate the name of the commands to run
1210        ;;  and the output of the commands. this doesn't work with cmdproxy.exe,
1211        ;;  which gets confused by newline characters.
1212        (if (not (string-match "cmdproxy.exe" shell-file-name))
1213            (setq cmd (concat cmd "\n\n")))
1214            
1215      (compile (ada-remote      (compile (ada-quote-cmd cmd))))
               (if (or ada-xref-confirm-compile arg)  
                   (read-from-minibuffer "enter command to compile: " cmd)  
                 cmd)))))  
1216    
1217  (defun ada-check-current (&optional arg)  (defun ada-check-current (&optional arg)
1218    "Recompile the current file.    "Recompile the current file.
# Line 1120  if ARG is not-nil, asks for user confirm Line 1233  if ARG is not-nil, asks for user confirm
1233    (let ((command (ada-xref-get-project-field 'run_cmd)))    (let ((command (ada-xref-get-project-field 'run_cmd)))
1234    
1235      ;;  Guess the command if it wasn't specified      ;;  Guess the command if it wasn't specified
1236      (if (or (not command) (string= command ""))      (if (not command)
1237          (set 'command (file-name-sans-extension (buffer-name))))          (set 'command (list (file-name-sans-extension (buffer-name)))))
1238    
1239        ;; Modify the command to run remotely
1240        (setq command (ada-remote (mapconcat 'identity command
1241                                             ada-command-separator)))
1242        
1243      ;; Ask for the arguments to the command if required      ;; Ask for the arguments to the command if required
1244      (if (or ada-xref-confirm-compile arg)      (if (or ada-xref-confirm-compile arg)
1245          (set 'command (read-from-minibuffer "Enter command to execute: " command)))          (setq command (read-from-minibuffer "Enter command to execute: "
1246                                                command)))
     ;; Modify the command to run remotely  
     (setq command (ada-remote command))  
1247    
1248      ;; Run the command      ;; Run the command
1249      (save-excursion      (save-excursion
1250        (set-buffer (get-buffer-create "*run*"))        (set-buffer (get-buffer-create "*run*"))
1251        (set 'buffer-read-only nil)        (set 'buffer-read-only nil)
1252    
1253        (erase-buffer)        (erase-buffer)
1254        (goto-char (point-min))        (start-process "run" (current-buffer) shell-file-name
1255        (insert "\nRunning " command "\n\n")                       "-c" command)
1256        (start-process "run" (current-buffer) shell-file-name "-c" command)        (comint-mode)
1257          ;;  Set these two variables to their default values, since otherwise
1258          ;;  the output buffer is scrolled so that only the last output line
1259          ;;  is visible at the top of the buffer.
1260          (set (make-local-variable 'scroll-step) 0)
1261          (set (make-local-variable 'scroll-conservatively) 0)
1262        )        )
1263      (display-buffer "*run*")      (display-buffer "*run*")
1264    
# Line 1146  if ARG is not-nil, asks for user confirm Line 1267  if ARG is not-nil, asks for user confirm
1267      (switch-to-buffer "*run*")      (switch-to-buffer "*run*")
1268      ))      ))
1269    
1270    (defun ada-gdb-application (&optional arg executable-name)
 (defun ada-gdb-application (&optional arg)  
1271    "Start the debugger on the application.    "Start the debugger on the application.
1272    EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the
1273    project file.
1274  If ARG is non-nil, ask the user to confirm the command."  If ARG is non-nil, ask the user to confirm the command."
1275    (interactive "P")    (interactive "P")
1276    (let ((buffer (current-buffer))    (let ((buffer (current-buffer))
1277          gdb-buffer          cmd pre-cmd post-cmd)
         cmd)  
1278      (ada-require-project-file)      (ada-require-project-file)
1279      (set 'cmd (ada-xref-get-project-field 'debug_cmd))      (setq cmd   (if executable-name
1280      (let ((machine (ada-xref-get-project-field 'remote_machine)))                      (concat ada-prj-default-debugger " " executable-name)
1281        (if (and machine (not (string= machine "")))                    (ada-xref-get-project-field 'debug_cmd))
1282            (error "This feature is not supported yet for remote environments")))            pre-cmd  (ada-xref-get-project-field 'debug_pre_cmd)
1283              post-cmd (ada-xref-get-project-field 'debug_post_cmd))
1284    
1285      ;;  If the command was not given in the project file, start a bare gdb      ;;  If the command was not given in the project file, start a bare gdb
1286      (if (not cmd)      (if (not cmd)
1287          (set 'cmd (concat ada-prj-default-debugger          (set 'cmd (concat ada-prj-default-debugger
1288                            " "                            " "
1289                            (file-name-sans-extension (buffer-file-name)))))                            (or executable-name
1290                                  (file-name-sans-extension (buffer-file-name))))))
1291    
1292        ;;  For gvd, add an extra switch so that the Emacs window is completly
1293        ;;  swallowed inside the Gvd one
1294        (if (and ada-tight-gvd-integration
1295                 (string-match "^[^ \t]*gvd" cmd))
1296            ;;  Start a new frame, so that when gvd exists we do not kill Emacs
1297            ;;  We make sure that gvd swallows the new frame, not the one the
1298            ;;  user has been using until now
1299            ;;  The frame is made invisible initially, so that GtkPlug gets a
1300            ;;  chance to fully manage it. Then it works fine with Enlightenment
1301            ;;  as well
1302            (let ((frame (make-frame '((visibility . nil)))))
1303              (set 'cmd (concat
1304                         cmd " --editor-window="
1305                         (cdr (assoc 'outer-window-id (frame-parameters frame)))))
1306              (select-frame frame)))
1307    
1308        ;;  Add a -fullname switch
1309        ;;  Use the remote machine
1310        (set 'cmd (ada-remote (concat cmd " -fullname ")))
1311    
1312        ;;  Ask for confirmation if required
1313      (if (or arg ada-xref-confirm-compile)      (if (or arg ada-xref-confirm-compile)
1314          (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))          (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
1315    
1316      ;;  Set the variable gud-last-last-frame so that glide-debug can find      (let (comint-exec
1317      ;;  the name of the Ada file, and thus of the project file if needed.            in-post-mode
1318      (if ada-prj-prj-file            gud-gdb-massage-args)
1319          (set 'gud-last-last-frame (cons ada-prj-prj-file 1)))  
1320              ;;  Do not add -fullname, since we can have a 'rsh' command in front.
1321      (if (and (string-match "jdb" (comint-arguments cmd 0 0))        (fset 'gud-gdb-massage-args (lambda (file args) args))
1322               (boundp 'jdb))  
1323          (funcall (symbol-function 'jdb) cmd)        (set 'pre-cmd  (mapconcat 'identity pre-cmd  ada-command-separator))
1324        (gdb cmd))        (if (not (equal pre-cmd ""))
1325              (setq pre-cmd (concat pre-cmd ada-command-separator)))
1326      (set 'gdb-buffer (symbol-value 'gud-comint-buffer))  
1327              (set 'post-cmd (mapconcat 'identity post-cmd "\n"))
1328      ;;  Switch back to the source buffer        (if post-cmd
1329      ;;  and Activate the debug part in the contextual menu          (set 'post-cmd (concat post-cmd "\n")))
1330      (switch-to-buffer buffer)  
1331          ;;  Temporarily replaces the definition of `comint-exec' so that we
1332      (if (functionp 'gud-make-debug-menu)        ;;  can execute commands before running gdb.
1333          (funcall (symbol-function 'gud-make-debug-menu)))        (fset 'comint-exec
1334                `(lambda (buffer name command startfile switches)
1335      ;;  Warning: on Emacs >= 20.3.8, same-window-regexps includes gud-*,                 (let (compilation-buffer-name-function)
1336      ;;  so the following call to display buffer will select the                   (save-excursion
1337      ;;  buffer instead of displaying it in another window                     (set 'compilation-buffer-name-function
1338      ;;  This is why the second argument to display-buffer is 't'                          (lambda(x) (buffer-name buffer)))
1339      (display-buffer gdb-buffer t)                     (compile (ada-quote-cmd
1340      ))                               (concat ,pre-cmd
1341                                         command " "
1342                                         (mapconcat 'identity switches " "))))))
1343                   ))
1344    
1345          ;;  Tight integration should force the tty mode
1346          (if (and (string-match "gvd" (comint-arguments cmd 0 0))
1347                   ada-tight-gvd-integration
1348                   (not (string-match "--tty" cmd)))
1349              (setq cmd (concat cmd "--tty")))
1350          
1351          (if (and (string-match "jdb" (comint-arguments cmd 0 0))
1352                   (boundp 'jdb))
1353              (funcall (symbol-function 'jdb) cmd)
1354            (gdb cmd))
1355    
1356          ;;  Send post-commands to the debugger
1357          (process-send-string (get-buffer-process (current-buffer)) post-cmd)
1358    
1359          ;;  Move to the end of the debugger buffer, so that it is automatically
1360          ;;  scrolled from then on.
1361          (end-of-buffer)
1362    
1363          ;;  Display both the source window and the debugger window (the former
1364          ;;  above the latter). No need to show the debugger window unless it
1365          ;;  is going to have some relevant information.
1366          (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
1367                  (string-match "--tty" cmd))
1368              (split-window-vertically))
1369          (switch-to-buffer buffer)
1370          )))
1371    
1372    
1373  (defun ada-reread-prj-file (&optional filename)  (defun ada-reread-prj-file (&optional filename)
# Line 1205  automatically modifies the setup for all Line 1380  automatically modifies the setup for all
1380    (if filename    (if filename
1381        (ada-parse-prj-file filename)        (ada-parse-prj-file filename)
1382      (ada-parse-prj-file (ada-prj-find-prj-file)))      (ada-parse-prj-file (ada-prj-find-prj-file)))
   )  
1383    
1384      ;; Reread the location of the standard runtime library
1385      (ada-initialize-runtime-library
1386       (or (ada-xref-get-project-field 'cross-prefix) ""))
1387      )
1388    
1389  ;; ------ Private routines  ;; ------ Private routines
1390    
1391  (defun ada-xref-current (file &optional ali-file-name)  (defun ada-xref-current (file &optional ali-file-name)
1392    "Update the cross-references for FILE.    "Update the cross-references for FILE.
1393  This in fact recompiles FILE to create ALI-FILE-NAME."  This in fact recompiles FILE to create ALI-FILE-NAME.
1394    This function returns the name of the file that was recompiled to generate
1395    the cross-reference information. Note that the ali file can then be deduced by
1396    replacing the file extension with .ali"
1397    ;; kill old buffer    ;; kill old buffer
1398    (if (and ali-file-name    (if (and ali-file-name
1399             (get-file-buffer ali-file-name))             (get-file-buffer ali-file-name))
1400        (kill-buffer (get-file-buffer ali-file-name)))        (kill-buffer (get-file-buffer ali-file-name)))
1401    ;; read the project file    
1402    (ada-require-project-file)    (let* ((name      (ada-convert-file-name file))
1403    (let* ((cmd (ada-xref-get-project-field 'comp_cmd))           (body-name (or (ada-get-body-name name) name)))
1404           (process-environment (ada-set-environment))  
1405           (compilation-scroll-output t)      ;; Always recompile the body when we can. We thus temporarily switch to a
1406           (name      (ada-convert-file-name (buffer-file-name)))      ;; buffer than contains the body of the unit
1407           (body-name (ada-get-body-name name)))      (save-excursion
1408          (let ((body-visible (find-buffer-visiting body-name))
1409      ;; Always recompile the body when we can              process)
1410      (set 'body-name (or body-name name))          (if body-visible
1411                (set-buffer body-visible)
1412      ;; prompt for command to execute            (find-file body-name))
1413      (set 'cmd (concat cmd " " body-name))  
1414      (compile (ada-remote          ;; Execute the compilation. Note that we must wait for the end of the
1415                (if ada-xref-confirm-compile          ;; process, or the ALI file would still not be available.
1416                    (read-from-minibuffer "enter command to compile: " cmd)          ;; Unfortunately, the underlying `compile' command that we use is
1417                  cmd)))))          ;; asynchronous.
1418            (ada-compile-current)
1419            (setq process (get-buffer-process "*compilation*"))
1420    
1421            (while (and process
1422                        (not (equal (process-status process) 'exit)))
1423              (sit-for 1))
1424    
1425            ;; remove the buffer for the body if it wasn't there before
1426            (unless body-visible
1427              (kill-buffer (find-buffer-visiting body-name)))
1428            ))
1429        body-name))
1430    
1431  (defun ada-find-file-in-dir (file dir-list)  (defun ada-find-file-in-dir (file dir-list)
1432    "Search for FILE in DIR-LIST."    "Search for FILE in DIR-LIST."
# Line 1251  This in fact recompiles FILE to create A Line 1444  This in fact recompiles FILE to create A
1444    "Find an .ali file in obj_dir. The current buffer must be the Ada file.    "Find an .ali file in obj_dir. The current buffer must be the Ada file.
1445  Adds build_dir in front of the search path to conform to gnatmake's behavior,  Adds build_dir in front of the search path to conform to gnatmake's behavior,
1446  and the standard runtime location at the end."  and the standard runtime location at the end."
1447    (ada-find-file-in-dir file    (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
                         (append  
   
                          ;; Add ${build_dir} in front of the path  
                          (list (ada-xref-get-project-field 'build_dir))  
                           
                          (ada-get-absolute-dir-list  
                           (ada-xref-get-project-field 'obj_dir)  
                           (ada-xref-get-project-field 'build_dir))  
   
                          ;; Add the standard runtime at the end  
                          ada-xref-runtime-library-ali-path)))  
1448    
1449  (defun ada-find-src-file-in-dir (file)  (defun ada-find-src-file-in-dir (file)
1450    "Find a source file in src_dir. The current buffer must be the Ada file.    "Find a source file in src_dir. The current buffer must be the Ada file.
1451  Adds src_dir in front of the search path to conform to gnatmake's behavior,  Adds src_dir in front of the search path to conform to gnatmake's behavior,
1452  and the standard runtime location at the end."  and the standard runtime location at the end."
1453    (ada-find-file-in-dir file    (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
                         (append  
   
                          ;; Add ${build_dir} in front of the path  
                          (list (ada-xref-get-project-field 'build_dir))  
   
                          (ada-get-absolute-dir-list  
                           (ada-xref-get-project-field 'src_dir)  
                           (ada-xref-get-project-field 'build_dir))  
   
                          ;; Add the standard runtime at the end  
                          ada-xref-runtime-library-specs-path)))  
     
1454    
1455  (defun ada-get-ali-file-name (file)  (defun ada-get-ali-file-name (file)
1456    "Create the ali file name for the ada-file FILE.    "Create the ali file name for the ada-file FILE.
# Line 1298  the project file." Line 1468  the project file."
1468    ;;   3- If the file is not found or step 2 failed:    ;;   3- If the file is not found or step 2 failed:
1469    ;;      find the name of the "other file", ie the body, and look    ;;      find the name of the "other file", ie the body, and look
1470    ;;      for its associated .ali file by subtituing the extension    ;;      for its associated .ali file by subtituing the extension
1471      ;;
1472      ;; We must also handle the case of separate packages and subprograms:
1473      ;;   4- If no ali file was found, we try to modify the file name by removing
1474      ;;      everything after the last '-' or '.' character, so as to get the
1475      ;;      ali file for the parent unit. If we found an ali file, we check that
1476      ;;      it indeed contains the definition for the separate entity by checking
1477      ;;      the 'D' lines. This is done repeatedly, in case the direct parent is
1478      ;;      also a separate.
1479    
1480    (save-excursion    (save-excursion
1481      (set-buffer (get-file-buffer file))      (set-buffer (get-file-buffer file))
1482      (let ((short-ali-file-name      (let ((short-ali-file-name
1483             (concat (file-name-sans-extension (file-name-nondirectory file))             (concat (file-name-sans-extension (file-name-nondirectory file))
1484                     ".ali"))                     ".ali"))
1485            ali-file-name)            ali-file-name
1486        ;; First step            is-spec)
1487        ;; we take the first possible completion  
1488        (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name))        ;; If we have a non-standard file name, and this is a spec, we first
1489          ;; look for the .ali file of the body, since this is the one that
1490        ;; If we have found the .ali file, but the source file was a spec        ;; contains the most complete information. If not found, we will do what
1491        ;; with a non-standard name, search the .ali file for the body if any,        ;; we can with the .ali file for the spec...
1492        ;; since the xref information is more complete in that one  
1493        (unless ali-file-name        (if (not (string= (file-name-extension file) "ads"))
1494            (if (not (string= (file-name-extension file) "ads"))            (let ((specs ada-spec-suffixes))
1495                (let ((is-spec nil)              (while specs
1496                      (specs ada-spec-suffixes)                (if (string-match (concat (regexp-quote (car specs)) "$")
1497                      body-ali)                                  file)
1498                  (while specs                    (set 'is-spec t))
1499                    (if (string-match (concat (regexp-quote (car specs)) "$")                (set 'specs (cdr specs)))))
1500                                      file)  
1501                        (set 'is-spec t))        (if is-spec
1502                    (set 'specs (cdr specs)))            (set 'ali-file-name
1503                   (ada-find-ali-file-in-dir
1504                  (if is-spec                  (concat (file-name-sans-extension
1505                      (set 'body-ali                           (file-name-nondirectory
1506                           (ada-find-ali-file-in-dir                            (ada-other-file-name)))
1507                            (concat (file-name-sans-extension                          ".ali"))))
1508                                     (file-name-nondirectory        
1509                                      (ada-other-file-name)))  
1510                                    ".ali"))))        (setq ali-file-name
1511                  (if body-ali              (or ali-file-name
1512                      (set 'ali-file-name body-ali))))                  
1513                            ;;  Else we take the .ali file associated with the unit
1514          ;;  else we did not find the .ali file                  (ada-find-ali-file-in-dir short-ali-file-name)
1515          ;;  Second chance: in case the files do not have standard names (such                  
1516          ;;  as for instance file_s.ada and file_b.ada), try to go to the  
1517          ;;  other file and look for its ali file                  ;;  else we did not find the .ali file Second chance: in case
1518          (setq short-ali-file-name                  ;;  the files do not have standard names (such as for instance
1519                (concat (file-name-sans-extension                  ;;  file_s.ada and file_b.ada), try to go to the other file
1520                         (file-name-nondirectory (ada-other-file-name)))                  ;;  and look for its ali file
1521                        ".ali"))                  (ada-find-ali-file-in-dir
1522          (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name))                   (concat (file-name-sans-extension
1523                                      (file-name-nondirectory (ada-other-file-name)))
1524          ;; If still not found, try to recompile the file                           ".ali"))
1525          (if (not ali-file-name)  
1526              (progn                  
1527                ;; recompile only if the user asked for this                  ;;  If we still don't have an ali file, try to get the one
1528                (if ada-xref-create-ali                  ;;  from the parent unit, in case we have a separate entity.
1529                    (ada-xref-current file ali-file-name))                  (let ((parent-name (file-name-sans-extension
1530                (error "Ali file not found. Recompile your file")))                                      (file-name-nondirectory file))))
1531          )                    
1532                      (while (and (not ali-file-name)
1533                                  (string-match "^\\(.*\\)[.-][^.-]*" parent-name))
1534                        
1535                        (set 'parent-name (match-string 1 parent-name))
1536                        (set 'ali-file-name (ada-find-ali-file-in-dir
1537                                             (concat parent-name ".ali")))
1538                        )
1539                      ali-file-name)))
1540          
1541          ;; If still not found, try to recompile the file
1542          (if (not ali-file-name)
1543              ;; recompile only if the user asked for this. and search the ali
1544              ;; filename again. We avoid a possible infinite recursion by
1545              ;; temporarily disabling the automatic compilation.
1546              
1547              (if ada-xref-create-ali
1548                  (setq ali-file-name
1549                        (concat (file-name-sans-extension (ada-xref-current file))
1550                                ".ali"))
1551    
1552        ;; same if the .ali file is too old and we must recompile it              (error "Ali file not found. Recompile your file"))
1553        (if (and (file-newer-than-file-p file ali-file-name)        
1554                 ada-xref-create-ali)          
1555            (ada-xref-current file ali-file-name))          ;; same if the .ali file is too old and we must recompile it
1556            (if (and (file-newer-than-file-p file ali-file-name)
1557                     ada-xref-create-ali)
1558                (ada-xref-current file ali-file-name)))
1559    
1560        ;; else returns the correct absolute file name        ;;  Always return the correct absolute file name
1561        (expand-file-name ali-file-name))        (expand-file-name ali-file-name))
1562      ))        ))
1563    
1564  (defun ada-get-ada-file-name (file original-file)  (defun ada-get-ada-file-name (file original-file)
1565    "Create the complete file name (+directory) for FILE.    "Create the complete file name (+directory) for FILE.
# Line 1398  file for possible paths." Line 1598  file for possible paths."
1598      (count-lines begin (point))))      (count-lines begin (point))))
1599    
1600  (defun ada-read-identifier (pos)  (defun ada-read-identifier (pos)
1601    "Returns the identlist around POS and switch to the .ali buffer."    "Returns the identlist around POS and switch to the .ali buffer.
1602    The returned list represents the entity, and can be manipulated through the
1603    ;; If there's a compilation in progress, it's probably because the  macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
   ;; .ali file didn't exist. So we should wait...  
   (if compilation-in-progress  
       (progn  
         (message "Compilation in progress. Try again when it is finished")  
         (set 'quit-flag t)))  
1604    
1605    ;; If at end of buffer (e.g the buffer is empty), error    ;; If at end of buffer (e.g the buffer is empty), error
1606    (if (>= (point) (point-max))    (if (>= (point) (point-max))
# Line 1510  from the ali file (definition file and p Line 1705  from the ali file (definition file and p
1705            ;; if we did not find it, it may be because the first reference            ;; if we did not find it, it may be because the first reference
1706            ;; is not required to have a 'unit_number|' item included.            ;; is not required to have a 'unit_number|' item included.
1707            ;; Or maybe we are already on the declaration...            ;; Or maybe we are already on the declaration...
1708            (unless (re-search-forward (concat "^\\([a-zA-Z0-9_.\"]+[ *]\\)*"            (unless (re-search-forward
1709                                               (ada-line-of identlist)                     (concat
1710                                               "[^0-9]"                      "^\\(\\([a-zA-Z0-9_.]+\\|\"[<>=+*-/a-z]\"\\)[ *]\\)*"
1711                                               (ada-column-of identlist))                      (ada-line-of identlist)
1712                                       nil t)                      "[^0-9]"
1713                        (ada-column-of identlist))
1714                       nil t)
1715                            
1716              ;; If still not found, then either the declaration is unknown              ;; If still not found, then either the declaration is unknown
1717              ;; or the source file has been modified since the ali file was              ;; or the source file has been modified since the ali file was
# Line 1566  from the ali file (definition file and p Line 1763  from the ali file (definition file and p
1763              )              )
1764    
1765            (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)            (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
1766                (ada-set-declare-file  
1767                 identlist                ;;  If we can find the file
1768                 (ada-get-ada-file-name (match-string 1)                (condition-case err
1769                                        (ada-file-of identlist))))                    (ada-set-declare-file
1770                       identlist
1771                       (ada-get-ada-file-name (match-string 1)
1772                                              (ada-file-of identlist)))
1773                    
1774                    ;;  Else clean up the ali file
1775                    (error
1776                     (kill-buffer ali-buffer)
1777                     (error (error-message-string err)))
1778                    ))
1779                        
1780            (ada-set-references   identlist current-line)            (ada-set-references   identlist current-line)
1781            ))            ))
# Line 1630  This function is disabled for operators, Line 1836  This function is disabled for operators,
1836                        
1837             ;; more than one => display choice list             ;; more than one => display choice list
1838             (t             (t
1839              (with-output-to-temp-buffer "*choice list*"              (save-window-excursion
1840                  (with-output-to-temp-buffer "*choice list*"
1841                (princ "Identifier is overloaded and Xref information is not up to date.\n")                  
1842                (princ "Possible declarations are:\n\n")                  (princ "Identifier is overloaded and Xref information is not up to date.\n")
1843                (princ "  no.   in file                at line  col\n")                  (princ "Possible declarations are:\n\n")
1844                (princ "  ---   ---------------------     ----  ----\n")                  (princ "  no.   in file                at line  col\n")
1845                (let ((counter 1))                  (princ "  ---   ---------------------     ----  ----\n")
1846                  (while (<= counter len)                  (let ((counter 0))
1847                    (princ (format "  %2d)    %-21s   %4s  %4s\n"                    (while (< counter len)
1848                                   counter                      (princ (format "  %2d)    %-21s   %4s  %4s\n"
1849                                     (1+ counter)
1850                                   (ada-get-ada-file-name                                   (ada-get-ada-file-name
1851                                    (nth 1 (nth (1- counter) declist))                                    (nth 1 (nth counter declist))
1852                                    (ada-file-of identlist))                                    (ada-file-of identlist))
1853                                   (nth 2 (nth (1- counter) declist))                                   (nth 2 (nth counter declist))
1854                                   (nth 3 (nth (1- counter) declist))                                   (nth 3 (nth counter declist))
1855                                   ))                                   ))
1856                    (setq counter (1+ counter))                      (setq counter (1+ counter))
1857                    ) ; end of while                      ) ; end of while
1858                  ) ; end of let                    ) ; end of let
1859                ) ; end of with-output-to ...                  ) ; end of with-output-to ...
1860              (setq choice nil)                (setq choice nil)
1861              (while (or                (while (or
1862                      (not choice)                        (not choice)
1863                      (not (integerp choice))                        (not (integerp choice))
1864                      (< choice 1)                        (< choice 1)
1865                      (> choice len))                        (> choice len))
1866                (setq choice (string-to-int                  (setq choice
1867                              (read-from-minibuffer "Enter No. of your choice: "))))                        (string-to-int
1868                           (read-from-minibuffer "Enter No. of your choice: "))))
1869                  )
1870              (set-buffer ali-buffer)              (set-buffer ali-buffer)
1871              (goto-line (car (nth (1- choice) declist)))              (goto-line (car (nth (1- choice) declist)))
1872              ))))))              ))))))
# Line 1670  opens a new window to show the declarati Line 1879  opens a new window to show the declarati
1879    
1880    (ada-get-all-references identlist)    (ada-get-all-references identlist)
1881    (let ((ali-line (ada-references-of identlist))    (let ((ali-line (ada-references-of identlist))
1882            (locations nil)
1883            (start 0)
1884          file  line  col)          file  line  col)
1885    
1886        ;; Note: in some cases, an entity can have multiple references to the
1887        ;; bodies (this is for instance the case for a separate subprogram, that
1888        ;; has a reference both to the stub and to the real body).
1889        ;; In that case, we simply go to each one in turn.
1890    
1891        ;; Get all the possible locations
1892        (string-match "^\\([0-9]+\\)[a-zA-Z+]\\([0-9]+\\)[ *]" ali-line)
1893        (set 'locations (list (list (match-string 1 ali-line) ;; line
1894                                    (match-string 2 ali-line) ;; column
1895                                    (ada-declare-file-of identlist))))
1896        (while (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line start)
1897          (setq line  (match-string 1 ali-line)
1898                col   (match-string 2 ali-line)
1899                start (match-end 2))
1900    
1901          ;;  it there was a file number in the same line
1902          (if (string-match (concat "\\([0-9]+\\)|\\([^|bc]+\\)?"
1903                                    (match-string 0 ali-line))
1904                            ali-line)
1905              (let ((file-number (match-string 1 ali-line)))
1906                (goto-char (point-min))
1907                (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t
1908                                   (string-to-number file-number))
1909                (set 'file (match-string 1))
1910                )
1911            ;; Else get the nearest file
1912            (set 'file (ada-declare-file-of identlist)))
1913          
1914          (set 'locations (append locations (list (list line col file)))))
1915    
1916        ;; Add the specs at the end again, so that from the last body we go to
1917        ;; the specs
1918        (set 'locations (append locations (list (car locations))))
1919    
1920        ;; Find the new location we want to go to.
1921        ;; If we are on none of the locations listed, we simply go to the specs.
1922    
1923        (setq line (caar locations)
1924              col  (nth 1 (car locations))
1925              file (nth 2 (car locations)))
1926            
1927      ;; If we were on a declaration, go to the body      (while locations
1928      (if (ada-on-declaration identlist)        (if (and (string= (caar locations) (ada-line-of identlist))
1929          (if (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line)                 (string= (nth 1 (car locations)) (ada-column-of identlist))
1930              (progn                 (string= (file-name-nondirectory (nth 2 (car locations)))
1931                (setq line (match-string 1 ali-line)                          (file-name-nondirectory (ada-file-of identlist))))
1932                      col  (match-string 2 ali-line))            (setq locations (cadr locations)
1933                ;;  it there was a file number in the same line                  line      (car locations)
1934                (if (string-match "\\([0-9]+\\)|\\([^|bc]+\\)?[bc]" ali-line)                  col       (nth 1 locations)
1935                    (let ((file-number (match-string 1 ali-line)))                  file      (nth 2 locations)
1936                      (goto-char (point-min))                  locations nil)
1937                      (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t          (set 'locations (cdr locations))))
1938                                         (string-to-number file-number))  
1939                      (set 'file (match-string 1))      ;;  Find the file in the source path
1940                      )      (set 'file (ada-get-ada-file-name file (ada-file-of identlist)))
1941                  ;; Else get the nearest file  
1942                  (set 'file (ada-declare-file-of identlist))      ;; Kill the .ali buffer
1943                  )      (kill-buffer (current-buffer))
               )  
           (error "No body found"))  
       
       ;; Else we were not on the declaration, find the place for it  
       (string-match "\\([0-9]+\\)[a-zA-Z+]\\([0-9]+\\)[ *]" ali-line)  
       (setq line (match-string 1 ali-line)  
             col  (match-string 2 ali-line)  
             file (ada-declare-file-of identlist))  
       )  
1944    
1945      ;; Now go to the buffer      ;; Now go to the buffer
1946      (ada-xref-change-buffer      (ada-xref-change-buffer file
1947       (ada-get-ada-file-name file (ada-file-of identlist))                              (string-to-number line)
1948       (string-to-number line)                              (1- (string-to-number col))
1949       (1- (string-to-number col))                              identlist
1950       identlist                              other-frame)
      other-frame)  
1951      ))      ))
1952    
1953    (defun ada-find-in-src-path (identlist &optional other-frame)
1954      "More general function for cross-references.
1955    This function should be used when the standard algorithm that parses the
1956    .ali file has failed, either because that file was too old or even did not
1957    exist.
1958    This function attempts to find the possible declarations for the identifier
1959    anywhere in the object path.
1960    This command requires the external `egrep' program to be available.
1961    
1962    This works well when one is using an external librarie and wants
1963    to find the declaration and documentation of the subprograms one is
1964    is using."
1965      
1966      (let (list
1967            (dirs (ada-xref-get-obj-dir-field))
1968            (regexp (concat "[ *]" (ada-name-of identlist)))
1969            line column
1970            choice
1971            file)
1972        
1973        (save-excursion
1974          
1975          ;;  Do the grep in all the directories. We do multiple shell
1976          ;;  commands instead of one in case there is no .ali file in one
1977          ;;  of the directory and the shell stops because of that.
1978          
1979          (set-buffer (get-buffer-create "*grep*"))
1980          (while dirs
1981            (insert (shell-command-to-string
1982                     (concat "egrep -i -h '^X|" regexp "( |$)' "
1983                             (file-name-as-directory (car dirs)) "*.ali")))
1984            (set 'dirs (cdr dirs)))
1985          
1986          ;;  Now parse the output
1987          (set 'case-fold-search t)
1988          (goto-char (point-min))
1989          (while (re-search-forward regexp nil t)
1990            (save-excursion
1991              (beginning-of-line)
1992              (if (not (= (char-after) ?X))
1993                  (progn
1994                    (looking-at "\\([0-9]+\\).\\([0-9]+\\)")
1995                    (setq line   (match-string 1)
1996                          column (match-string 2))
1997                    (re-search-backward "^X [0-9]+ \\(.*\\)$")
1998                    (set 'file (list (match-string 1) line column))
1999              
2000                    ;;  There could be duplicate choices, because of the structure
2001                    ;;  of the .ali files
2002                    (unless (member file list)
2003                      (set 'list (append list (list file))))))))
2004          
2005          ;;  Current buffer is still "*grep*"
2006          (kill-buffer "*grep*")
2007          )
2008        
2009        ;;  Now display the list of possible matches
2010        (cond
2011        
2012         ;;  No choice found => Error
2013         ((null list)
2014          (error "No cross-reference found, please recompile your file"))
2015        
2016         ;;  Only one choice => Do the cross-reference
2017         ((= (length list) 1)
2018          (set 'file (ada-find-src-file-in-dir (caar list)))
2019          (if file
2020              (ada-xref-change-buffer file
2021                                      (string-to-number (nth 1 (car list)))
2022                                      (string-to-number (nth 2 (car list)))
2023                                      identlist
2024                                      other-frame)
2025            (error (concat (caar list) " not found in src_dir")))
2026          (message "This is only a (good) guess at the cross-reference.")
2027          )
2028        
2029         ;;  Else, ask the user
2030         (t
2031          (save-window-excursion
2032            (with-output-to-temp-buffer "*choice list*"
2033              
2034              (princ "Identifier is overloaded and Xref information is not up to date.\n")
2035              (princ "Possible declarations are:\n\n")
2036              (princ "  no.   in file                at line  col\n")
2037              (princ "  ---   ---------------------     ----  ----\n")
2038              (let ((counter 0))
2039                (while (< counter (length list))
2040                  (princ (format "  %2d)    %-21s   %4s  %4s\n"
2041                                 (1+ counter)
2042                                 (nth 0 (nth counter list))
2043                                 (nth 1 (nth counter list))
2044                                 (nth 2 (nth counter list))
2045                                 ))
2046                  (setq counter (1+ counter))
2047                  )))
2048            (setq choice nil)
2049            (while (or (not choice)
2050                       (not (integerp choice))
2051                       (< choice 1)
2052                       (> choice (length list)))
2053              (setq choice
2054                    (string-to-int
2055                     (read-from-minibuffer "Enter No. of your choice: "))))
2056            )
2057          (set 'choice (1- choice))
2058          (kill-buffer "*choice list*")
2059    
2060          (set 'file (ada-find-src-file-in-dir (car (nth choice list))))
2061          (if file
2062              (ada-xref-change-buffer file
2063                                      (string-to-number (nth 1 (nth choice list)))
2064                                      (string-to-number (nth 2 (nth choice list)))
2065                                      identlist
2066                                      other-frame)
2067            (error (concat (car (nth choice list)) " not found in src_dir")))
2068          (message "This is only a (good) guess at the cross-reference.")
2069          ))))
2070    
2071  (defun ada-xref-change-buffer  (defun ada-xref-change-buffer
2072    (file line column identlist &optional other-frame)    (file line column identlist &optional other-frame)
2073    "Select and display FILE, at LINE and COLUMN. The new file is    "Select and display FILE, at LINE and COLUMN.
 associated with the same project file as the one for IDENTLIST.  
2074  If we do not end on the same identifier as IDENTLIST, find the closest  If we do not end on the same identifier as IDENTLIST, find the closest
2075  match. Kills the .ali buffer at the end.  match. Kills the .ali buffer at the end.
2076  If OTHER-FRAME is non-nil, creates a new frame to show the file."  If OTHER-FRAME is non-nil, creates a new frame to show the file."
2077    
2078    (let (prj-file    (let (declaration-buffer)
         declaration-buffer  
         (ali-buffer (current-buffer)))  
   
     ;; get the current project file for the source ada file  
     (save-excursion  
       (set-buffer (get-file-buffer (ada-file-of identlist)))  
       (set 'prj-file ada-prj-prj-file))  
2079    
2080      ;; Select and display the destination buffer      ;; Select and display the destination buffer
2081      (if ada-xref-other-buffer      (if ada-xref-other-buffer
# Line 1736  If OTHER-FRAME is non-nil, creates a new Line 2088  If OTHER-FRAME is non-nil, creates a new
2088        (find-file file)        (find-file file)
2089        )        )
2090    
     ;; If the new buffer is not already associated with a project file, do it  
     (unless (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))  
       (set (make-local-variable 'ada-prj-prj-file) prj-file))  
   
2091      ;; move the cursor to the correct position      ;; move the cursor to the correct position
2092      (push-mark)      (push-mark)
2093      (goto-line line)      (goto-line line)
# Line 1750  If OTHER-FRAME is non-nil, creates a new Line 2098  If OTHER-FRAME is non-nil, creates a new
2098      ;; this is probably the right one.      ;; this is probably the right one.
2099      (unless (looking-at (ada-name-of identlist))      (unless (looking-at (ada-name-of identlist))
2100        (ada-xref-search-nearest (ada-name-of identlist)))        (ada-xref-search-nearest (ada-name-of identlist)))
2101        ))
     (kill-buffer ali-buffer)))  
2102    
2103    
2104  (defun ada-xref-search-nearest (name)  (defun ada-xref-search-nearest (name)
# Line 1878  This function typically is to be hooked Line 2225  This function typically is to be hooked
2225    
2226    (save-some-buffers nil nil)    (save-some-buffers nil nil)
2227    
2228    (ada-require-project-file)    ;; If the current buffer is the body (as is the case when calling this
2229      ;; function from ff-file-created-hooks), then kill this temporary buffer
2230      (unless (interactive-p)
2231        (progn
2232          (set-buffer-modified-p nil)
2233          (kill-buffer (current-buffer))))
2234            
2235    
2236      ;;  Make sure the current buffer is the spec (this might not be the case
2237      ;;  if for instance the user was asked for a project file)
2238    
2239      (unless (buffer-file-name (car (buffer-list)))
2240        (set-buffer (cadr (buffer-list))))
2241    
2242    (delete-region (point-min) (point-max))    ;;  Make sure we have a project file (for parameters to gnatstub). Note that
2243      ;;  this might have already been done if we have been called from the hook,
2244      ;;  but this is not an expensive call)
2245      (ada-require-project-file)
2246    
2247    ;; Call the external process gnatstub    ;; Call the external process gnatstub
2248    (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))    (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
2249           (filename      (buffer-file-name (car (cdr (buffer-list)))))           (filename      (buffer-file-name (car (buffer-list))))
2250           (output        (concat (file-name-sans-extension filename) ".adb"))           (output        (concat (file-name-sans-extension filename) ".adb"))
2251           (gnatstub-cmd  (concat "gnatstub " gnatstub-opts " " filename))           (gnatstub-cmd  (concat "gnatstub " gnatstub-opts " " filename))
2252           (buffer        (get-buffer-create "*gnatstub*")))           (buffer        (get-buffer-create "*gnatstub*")))
# Line 1911  This function typically is to be hooked Line 2273  This function typically is to be hooked
2273    
2274        ;; Else clean up the output        ;; Else clean up the output
2275    
       ;;  Kill the temporary buffer created by find-file  
       (set-buffer-modified-p nil)  
       (kill-buffer (current-buffer))  
   
2276        (if (file-exists-p output)        (if (file-exists-p output)
2277            (progn            (progn
2278              (find-file output)              (find-file output)
# Line 1925  This function typically is to be hooked Line 2283  This function typically is to be hooked
2283          )          )
2284        )))        )))
2285    
   
2286  (defun ada-xref-initialize ()  (defun ada-xref-initialize ()
2287    "Function called by `ada-mode-hook' to initialize the ada-xref.el package.    "Function called by `ada-mode-hook' to initialize the ada-xref.el package.
2288  For instance, it creates the gnat-specific menus, sets some hooks for  For instance, it creates the gnat-specific menus, sets some hooks for
# Line 1946  find-file...." Line 2303  find-file...."
2303    
2304  ;; ----- Add to ada-mode-hook ---------------------------------------------  ;; ----- Add to ada-mode-hook ---------------------------------------------
2305    
2306    ;;  Use gvd or ddd as the default debugger if it was found
2307    ;;  On windows, do not use the --tty switch for GVD, since this is
2308    ;;  not supported. Actually, we do not use this on Unix either, since otherwise
2309    ;;  there is no console window left in GVD, and people have to use the
2310    ;;  Emacs one.
2311    ;;  This must be done before initializing the Ada menu.
2312    (if (ada-find-file-in-dir "gvd" exec-path)
2313        (set 'ada-prj-default-debugger "gvd ")
2314      (if (ada-find-file-in-dir "gvd.exe" exec-path)
2315         (set 'ada-prj-default-debugger "gvd ")
2316      (if (ada-find-file-in-dir "ddd" exec-path)
2317          (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
2318    
2319  ;;  Set the keymap once and for all, so that the keys set by the user in his  ;;  Set the keymap once and for all, so that the keys set by the user in his
2320  ;;  config file are not overwritten every time we open a new file.  ;;  config file are not overwritten every time we open a new file.
2321  (ada-add-ada-menu)  (ada-add-ada-menu)
# Line 1953  find-file...." Line 2323  find-file...."
2323    
2324  (add-hook 'ada-mode-hook 'ada-xref-initialize)  (add-hook 'ada-mode-hook 'ada-xref-initialize)
2325    
 ;;  Use ddd as the default debugger if it was found  
 (if (ada-find-file-in-dir "ddd" exec-path)  
     (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))  
   
2326  ;;  Initializes the cross references to the runtime library  ;;  Initializes the cross references to the runtime library
2327  (ada-initialize-runtime-library)  (ada-initialize-runtime-library "")
2328    
2329  ;;  Add these standard directories to the search path  ;;  Add these standard directories to the search path
2330  (set 'ada-search-directories  (set 'ada-search-directories

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26