code.delx.au - gnu-emacs/blob - lisp/progmodes/ada-xref.el

   1 ;; @(#) ada-xref.el --- use Gnat for lookup and completion in Ada mode
   2
   3 ;; Copyright (C) 1994, 1995--1998, 1999 Free Software Foundation, Inc.
   4
   5 ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
   6 ;;      Rolf Ebert <ebert@inf.enst.fr>
   7 ;;      Emmanuel Briot <briot@gnat.com>
   8 ;; Maintainer: Emmanuel Briot <briot@gnat.com>
   9 ;; Ada Core Technologies's version:   $Revision: 1.75 $
  10 ;; Keywords: languages ada xref
  11
  12 ;; This file is not part of GNU Emacs.
  13
  14 ;; This program is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  26 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27
  28 ;;; Commentary:
  29 ;;; This Package provides a set of functions to use the output of the
  30 ;;; cross reference capabilities of the GNAT Ada compiler
  31 ;;; for lookup and completion in Ada mode.
  32 ;;;
  33 ;;; The functions provided are the following ones :
  34 ;;;    - `ada-complete-identifier': completes the current identifier as much as
  35 ;;;      possible, depending of the known identifier in the unit
  36 ;;;    - `ada-point-and-xref': moves the mouse pointer and shows the declaration
  37 ;;;      of the selected identifier (either in the same buffer or in another
  38 ;;;      buffer
  39 ;;;    - `ada-goto-declaration': shows the declaration of the selected
  40 ;;;      identifier (the one under the cursor), either in the same buffer or in
  41 ;;;      another buffer
  42 ;;;    - `ada-goto-declaration-other-frame': same as previous, but opens a new
  43 ;;      frame to show the declaration
  44 ;;;    - `ada-compile-application': recompile your whole application, provided
  45 ;;;      that a project file exists in your directory
  46 ;;;    - `ada-run-application': run your application directly from Emacs
  47 ;;;    - `ada-reread-prj-file': force Emacs to read your project file again.
  48 ;;;      Otherwise, this file is only read the first time Emacs needs some
  49 ;;;      informations, which are then kept in memory
  50 ;;;    - `ada-change-prj': change the prj file associated with a buffer
  51 ;;;    - `ada-change-default-prj': change the default project file used for
  52 ;;;      every new buffer
  53 ;;;
  54 ;;; If a file *.`adp' exists in the ada-file directory, then it is
  55 ;;; read for configuration informations. It is read only the first
  56 ;;; time a cross-reference is asked for, and is not read later.
  57
  58 ;;; You need Emacs >= 20.2 to run this package
  59
  60 ;; ----- Requirements -----------------------------------------------------
  61
  62 (require 'compile)
  63 (require 'comint)
  64
  65 ;; ----- Dynamic byte compilation -----------------------------------------
  66 (defvar byte-compile-dynamic nil)
  67 (make-local-variable 'byte-compile-dynamic)
  68 (setq byte-compile-dynamic t)
  69
  70 ;; ------ Use variables
  71 (defcustom ada-xref-other-buffer t
  72   "*If nil, always display the cross-references in the same buffer.
  73 Otherwise create either a new buffer or a new frame."
  74   :type 'boolean :group 'ada)
  75
  76 (defcustom ada-xref-create-ali t
  77   "*If non-nil, run gcc whenever the cross-references are not up-to-date.
  78 If nil, the cross-reference mode will never run gcc."
  79   :type 'boolean :group 'ada)
  80
  81 (defcustom ada-xref-confirm-compile nil
  82   "*If non-nil, always ask for user confirmation before compiling or running
  83 the application."
  84   :type 'boolean :group 'ada)
  85
  86 (defcustom ada-krunch-args "0"
  87   "*Maximum number of characters for filenames created by gnatkr.
  88 Set to 0, if you don't use crunched filenames. This should be a string."
  89   :type 'string :group 'ada)
  90
  91 (defcustom ada-prj-default-comp-cmd
  92   "${cross_prefix}gcc -c -g -gnatq ${comp_opt} -I${src_dir}"
  93   "*Default command to be used to compile a single file.
  94 Emacs will add the filename at the end of this command.
  95 This is the same syntax as in the project file."
  96   :type 'string :group 'ada)
  97
  98 (defcustom ada-prj-default-make-cmd
  99   (concat "${cross_prefix}gnatmake ${main} -aI${src_dir} -aO${obj_dir} "
 100           "-g -gnatq -cargs ${comp_opt} "
 101           "-bargs ${bind_opt} -largs ${link_opt}")
 102   "*Default command to be used to compile the application.
 103 This is the same syntax as in the project file."
 104   :type 'string :group 'ada)
 105
 106 (defcustom ada-prj-default-project-file ""
 107   "*Name of the project file to use for every Ada file.
 108 Emacs will not try to use the standard algorithm to find the project file if
 109 this string is not empty."
 110   :type '(file :must-match t) :group 'ada)
 111
 112 (defcustom ada-gnatstub-opts "-q -I${src_dir}"
 113   "*List of the options to pass to gnatsub to generate the body of a package.
 114 This has the same syntax as in the project file (with variable substitution)."
 115   :type 'string :group 'ada)
 116
 117 (defcustom ada-always-ask-project nil
 118   "*If nil, use default values when no project file was found.
 119 Otherwise, ask the user for the name of the project file to use.")
 120
 121 ;; ------- Nothing to be modified by the user below this
 122 (defvar ada-last-prj-file ""
 123   "Name of the last project file entered by the user.")
 124
 125 (defvar ada-check-switch " -gnats "
 126   "Switch added to the command line to check the current file.")
 127
 128 (defvar ada-project-file-extension ".adp"
 129   "The extension used for project files.")
 130
 131 (defconst is-windows (memq system-type (quote (windows-nt)))
 132   "True if we are running on windows NT or windows 95.")
 133
 134 (defvar ada-xref-pos-ring '()
 135   "List of positions selected by the cross-references functions.
 136 Used to go back to these positions.")
 137
 138 (defconst ada-xref-pos-ring-max 16
 139   "Number of positions kept in the list ada-xref-pos-ring.")
 140
 141 (defvar ada-operator-re
 142   "\\+\\|-\\|/\\|\\*\\|=\\|mod\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
 143   "Regexp to match for operators.")
 144
 145 (defvar ada-xref-default-prj-file nil
 146   "Name of the default prj file, per directory.
 147 Every directory is potentially associated with a default project file.
 148 If it is nil, then the first prj file loaded will be the default for this
 149 Emacs session.")
 150
 151 ;; These variables will be overwritted by buffer-local variables
 152 (defvar ada-prj-prj-file nil
 153   "Name of the project file for the current ada buffer.")
 154 (defvar ada-prj-src-dir nil
 155   "List of directories to look into for ada sources.")
 156 (defvar ada-prj-obj-dir nil
 157   "List of directories to look into for object and .ali files.")
 158 (defvar ada-prj-comp-opt nil
 159   "Switches to use on the command line for the default compile command.")
 160 (defvar ada-prj-bind-opt nil
 161   "Switches to use on the command line for the default bind command.")
 162 (defvar ada-prj-link-opt nil
 163   "Switches to use on the command line for the default link command.")
 164 (defvar ada-prj-comp-cmd nil
 165   "Command to use to compile the current file only.")
 166 (defvar ada-prj-make-cmd nil
 167   "Command to use to compile the whole current application.")
 168 (defvar ada-prj-run-cmd nil
 169   "Command to use to run the current application.")
 170 (defvar ada-prj-debug-cmd nil
 171   "Command to use to run the debugger.")
 172 (defvar ada-prj-main nil
 173   "Name of the main programm of the current application.")
 174 (defvar ada-prj-remote-machine nil
 175   "Name of the machine to log on before a compilation.")
 176 (defvar ada-prj-cross-prefix nil
 177   "Prefix to be added to the gnatmake, gcc, ... commands when
 178 using a cross-compilation environment.
 179 A '-' is automatically added at the end if not already present.
 180 For instance, the compiler is called `ada-prj-cross-prefix'gnatmake.")
 181
 182 ;; ----- Keybindings ------------------------------------------------------
 183
 184 (defun ada-add-keymap ()
 185   "Add new key bindings when using `ada-xrel.el'."
 186   (interactive)
 187   (if ada-xemacs
 188       (progn
 189         (define-key ada-mode-map '(shift button3) 'ada-point-and-xref)
 190         (define-key ada-mode-map '(control tab) 'ada-complete-identifier))
 191     (define-key ada-mode-map [C-tab] 'ada-complete-identifier)
 192     (define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref))
 193
 194   (define-key ada-mode-map "\C-co"    'ff-find-other-file)
 195   (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame)
 196   (define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration)
 197   (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference)
 198   (define-key ada-mode-map "\C-c\C-x" 'ada-reread-prj-file)
 199   (define-key ada-mode-map [f10] 'next-error)
 200   (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)
 201   (define-key ada-mode-map "\C-cb"  'ada-buffer-list)
 202   (define-key ada-mode-map "\C-cc"  'ada-change-prj)
 203   (define-key ada-mode-map "\C-cd"  'ada-change-default-prj)
 204   (define-key ada-mode-map "\C-cg"  'ada-gdb-application)
 205   (define-key ada-mode-map "\C-cr"  'ada-run-application)
 206   (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)
 207   (define-key ada-mode-map "\C-c\C-r" 'ada-find-references)
 208   (define-key ada-mode-map "\C-c\C-v" 'ada-check-current)
 209   )
 210
 211 ;; ----- Menus --------------------------------------------------------------
 212 (defun ada-add-ada-menu ()
 213   "Add some items to the standard Ada mode menu."
 214   (interactive)
 215
 216   (if ada-xemacs
 217       (progn
 218         (add-menu-button '("Ada") ["Check file" ada-check-current t] "Goto")
 219         (add-menu-button '("Ada") ["Compile file" ada-compile-current t]
 220                          "Goto")
 221         (add-menu-button '("Ada") ["Build" ada-compile-application t] "Goto")
 222         (add-menu-button '("Ada") ["Run" ada-run-application t] "Goto")
 223         (add-menu-button '("Ada") ["Debug" ada-gdb-application t] "Goto")
 224         (add-menu-button '("Ada") ["--" nil t] "Goto")
 225         (add-submenu '("Ada") '("Project"
 226                                 ["Associate"   ada-change-prj t]
 227                                 ["Set Default" ada-set-default-project-file t]
 228                                 ["List" ada-buffer-list t])
 229                      "Goto")
 230         (add-menu-button '("Ada" "Goto") ["Goto Parent Unit" ada-goto-parent t]
 231                          "Next compilation error")
 232         (add-menu-button '("Ada" "Goto") ["Goto References to any entity"
 233                                           ada-find-any-references t]
 234                          "Next compilation error")
 235         (add-menu-button '("Ada" "Goto") ["List References"
 236                                           ada-find-references t]
 237                          "Next compilation error")
 238         (add-menu-button '("Ada" "Goto") ["Goto Declaration Other Frame"
 239                                           ada-goto-declaration-other-frame t]
 240                          "Next compilation error")
 241         (add-menu-button '("Ada" "Goto") ["Goto Declaration/Body"
 242                                           ada-goto-declaration t]
 243                          "Next compilation error")
 244         (add-menu-button '("Ada" "Goto") ["Goto Previous Reference"
 245                                           ada-xref-goto-previous-reference t]
 246                          "Next compilation error")
 247         (add-menu-button '("Ada" "Goto") ["--" nil t]
 248                          "Next compilation error")
 249         (add-menu-button '("Ada" "Edit") ["Complete Identifier"
 250                                           ada-complete-identifier t]
 251                          "Indent Line")
 252         (add-menu-button '("Ada" "Edit") ["--------" nil t]
 253                          "Indent Line")
 254         (add-menu-button '("Ada" "Help") ["Gnat User Guide" (info "gnat_ug")])
 255         (add-menu-button '("Ada" "Help") ["Gnat Reference Manual"
 256                                           (info "gnat_rm")])
 257         (add-menu-button '("Ada" "Help") ["Gcc Documentation" (info "gcc")])
 258         (add-menu-button '("Ada" "Help") ["Gdb Documentation" (info "gdb")])
 259         )
 260
 261     ;; for Emacs
 262     (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [Check]
 263       '("Check file" . ada-check-current) 'Customize)
 264     (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [Compile]
 265       '("Compile file" . ada-compile-current) 'Check)
 266     (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [Build]
 267       '("Build" . ada-compile-application) 'Compile)
 268     (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [Run]
 269       '("Run" . ada-run-application) 'Build)
 270     (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [Debug]
 271       '("Debug" . ada-gdb-application) 'Run)
 272     (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [rem]
 273       '("--" . nil) 'Debug)
 274     (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [Project]
 275       (cons "Project" (easy-menu-create-menu
 276                        "Project"
 277                        '(["Associate" ada-change-prj t]
 278                          ["Set Default" ada-set-default-project-file t]
 279                          ["List" ada-buffer-list t])))
 280       'rem)
 281
 282     (let ((help-submenu (lookup-key ada-mode-map [menu-bar Ada Help]))
 283           (goto-submenu (lookup-key ada-mode-map [menu-bar Ada Goto]))
 284           (edit-submenu (lookup-key ada-mode-map [menu-bar Ada Edit])))
 285
 286       (define-key help-submenu [Gnat_ug]
 287         '("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug"))))
 288       (define-key help-submenu [Gnat_rm]
 289         '("Gnat Reference Manual" . (lambda() (interactive) (info "gnat_rm"))))
 290       (define-key help-submenu [Gcc]
 291         '("Gcc Documentation" . (lambda() (interactive) (info "gcc"))))
 292       (define-key help-submenu [gdb]
 293         '("Ada Aware Gdb Documentation" .
 294           (lambda() (interactive) (info "gdb"))))
 295       (define-key goto-submenu [rem]    '("----" . nil))
 296       (define-key goto-submenu [Parent]
 297         '("Goto Parent Unit" . ada-goto-parent))
 298       (define-key goto-submenu [References-any]
 299         '("Goto References to any entity" . ada-find-any-references))
 300       (define-key goto-submenu [References]
 301         '("List References" . ada-find-references))
 302       (define-key goto-submenu [Prev]
 303         '("Goto Previous Reference" . ada-xref-goto-previous-reference))
 304       (define-key goto-submenu [Decl-other]
 305         '("Goto Declaration Other Frame" . ada-goto-declaration-other-frame))
 306       (define-key goto-submenu [Decl]
 307         '("Goto Declaration/Body" . ada-goto-declaration))
 308
 309       (define-key edit-submenu [rem] '("----" . nil))
 310       (define-key edit-submenu [Complete] '("Complete Identifier"
 311                                             . ada-complete-identifier))
 312       )
 313     ))
 314
 315 ;; ----- Utilities -------------------------------------------------
 316
 317 (defun ada-require-project-file ()
 318   "If no project file is assigned to this buffer, load one."
 319   (if (not ( my-local-variable-if-set-p 'ada-prj-src-dir (current-buffer)))
 320       (ada-parse-prj-file (ada-prj-find-prj-file))))
 321
 322 (defun my-local-variable-if-set-p (variable &optional buffer)
 323   "Returns t if VARIABLE is local in BUFFER and is non-nil."
 324   (and (local-variable-p variable buffer)
 325        (save-excursion
 326          (set-buffer buffer)
 327          (symbol-value variable))))
 328
 329 (defun ada-xref-push-pos (filename position)
 330   "Push (FILENAME, POSITION) on the position ring for cross-references."
 331   (setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring))
 332   (if (> (length ada-xref-pos-ring) ada-xref-pos-ring-max)
 333       (setcdr (nthcdr (1- ada-xref-pos-ring-max) ada-xref-pos-ring) nil)))
 334
 335 (defun ada-xref-goto-previous-reference ()
 336   "Go to the previous cross-reference we were on."
 337   (interactive)
 338   (if ada-xref-pos-ring
 339       (let ((pos (car ada-xref-pos-ring)))
 340         (setq ada-xref-pos-ring (cdr ada-xref-pos-ring))
 341         (find-file (car (cdr pos)))
 342         (goto-char (car pos)))))
 343
 344 (defun ada-convert-file-name (name)
 345   "Converts from NAME to a name that can be used by the compilation commands.
 346 This is overriden on VMS to convert from VMS filenames to Unix filenames."
 347   name)
 348
 349 (defun ada-set-default-project-file (name)
 350   "Set the file whose name is NAME as the default project file."
 351   (interactive "fProject file:")
 352   (set 'ada-prj-default-project-file name)
 353   (ada-reread-prj-file t)
 354   )
 355
 356 (defun ada-replace-substring (cmd-string search-for replace-with)
 357   "Replace all instances of SEARCH-FOR with REPLACE-WITH in CMD-STRING."
 358   (while (string-match search-for cmd-string)
 359     (setq cmd-string (replace-match replace-with t t cmd-string)))
 360   cmd-string)
 361
 362 (defun ada-treat-cmd-string (cmd-string)
 363   "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
 364 The current buffer must be the one where all local variable are defined (that
 365 is the ada source)"
 366   (if ( my-local-variable-if-set-p 'ada-prj-src-dir (current-buffer))
 367       (if  (string-match "\\(-[^-\$I]*I\\)\${src_dir}" cmd-string)
 368           (progn
 369             (let ((str-def (substring cmd-string (match-beginning 1)
 370                                       (match-end 1))))
 371               (setq cmd-string
 372                     (ada-replace-substring cmd-string
 373                                            "\\(-[^-\$I]*I\\)\${src_dir}"
 374                       (mapconcat
 375                       (lambda (x) (concat str-def x))
 376                       ada-prj-src-dir " ")))))))
 377   (if ( my-local-variable-if-set-p 'ada-prj-obj-dir (current-buffer))
 378       (if (string-match "\\(-[^-\$O]*O\\)\${obj_dir}" cmd-string)
 379           (progn
 380             (let ((str-def (substring cmd-string (match-beginning 1)
 381                                       (match-end 1))))
 382               (setq cmd-string
 383                     (ada-replace-substring cmd-string
 384                                            "\\(-[^-\$O]*O\\)\${obj_dir}"
 385                         (mapconcat
 386                          (lambda (x) (concat str-def x))
 387                          ada-prj-obj-dir
 388                          " ")))))))
 389   (if ( my-local-variable-if-set-p 'ada-prj-remote-machine (current-buffer))
 390       (setq cmd-string
 391             (ada-replace-substring cmd-string "\${remote_machine}"
 392                                    ada-prj-remote-machine)))
 393   (if ( my-local-variable-if-set-p 'ada-prj-comp-opt (current-buffer))
 394       (setq cmd-string
 395             (ada-replace-substring cmd-string "\${comp_opt}"
 396                                    ada-prj-comp-opt)))
 397   (if ( my-local-variable-if-set-p 'ada-prj-bind-opt (current-buffer))
 398       (setq cmd-string
 399             (ada-replace-substring cmd-string "\${bind_opt}"
 400                                    ada-prj-bind-opt)))
 401   (if ( my-local-variable-if-set-p 'ada-prj-link-opt (current-buffer))
 402       (setq cmd-string
 403             (ada-replace-substring cmd-string "\${link_opt}"
 404                                    ada-prj-link-opt)))
 405   (if ( my-local-variable-if-set-p 'ada-prj-main (current-buffer))
 406       (setq cmd-string
 407             (ada-replace-substring cmd-string "\${main}"
 408                                    ada-prj-main)))
 409   (if ( my-local-variable-if-set-p 'ada-prj-cross-prefix (current-buffer))
 410       (setq cmd-string
 411             (ada-replace-substring cmd-string "\${cross_prefix}"
 412                                    ada-prj-cross-prefix)))
 413   cmd-string)
 414
 415
 416 (defun ada-prj-find-prj-file (&optional no-user-question)
 417   "Find the prj file associated with the current buffer.
 418 The rules are the following ones :
 419 - If the buffer is already associated with a prj file, use this one
 420 - else if there's a default prj file for the same directory use it
 421 - else if a prj file with the same filename exists, use it
 422 - else if there's only one prj file in the directory, use it
 423 - else if there are more than one prj file, ask the user
 424 - else if there is no prj file and NO-USER-QUESTION is nil, ask the user
 425   for the project file to use."
 426   (let* ((current-file (buffer-file-name))
 427          (first-choice (concat
 428                         (file-name-sans-extension current-file)
 429                         ada-project-file-extension))
 430          (dir          (file-name-directory current-file))
 431
 432          ;; on Emacs 20.2, directory-files does not work if
 433          ;; parse-sexp-lookup-properties is set
 434          (parse-sexp-lookup-properties nil)
 435          (prj-files    (directory-files
 436                         dir t
 437                         (concat ".*" (regexp-quote ada-project-file-extension) "$")))
 438          (choice       nil)
 439          (default      (assoc dir ada-xref-default-prj-file))
 440          )
 441
 442     (cond
 443
 444      ((my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))
 445       ada-prj-prj-file)
 446
 447      (default                       ;; directory default project file
 448        (cdr default))
 449
 450      ;; global default project file
 451      ((and ada-prj-default-project-file
 452            (not (string= ada-prj-default-project-file "")))
 453       ada-prj-default-project-file)
 454
 455      ((file-exists-p first-choice)
 456       first-choice)
 457
 458      ((= (length prj-files) 1)
 459       (car prj-files))
 460
 461      ((> (length prj-files) 1)
 462       ;; more than one possible prj file => ask the user
 463       (with-output-to-temp-buffer "*choice list*"
 464         (princ "There are more than one possible project file. Which one should\n")
 465         (princ "I use ?\n\n")
 466         (princ "  no.   file name  \n")
 467         (princ "  ---   ------------------------\n")
 468         (let ((counter 1))
 469           (while (<= counter (length prj-files))
 470             (princ (format "  %2d)    %s\n"
 471                            counter
 472                            (nth (1- counter) prj-files)))
 473             (setq counter (1+ counter))
 474             ) ; end of while
 475           ) ; end of let
 476         ) ; end of with-output-to ...
 477       (setq choice nil)
 478       (while (or
 479               (not choice)
 480               (not (integerp choice))
 481               (< choice 1)
 482               (> choice (length prj-files)))
 483         (setq choice (string-to-int
 484                       (read-from-minibuffer "Enter No. of your choice: "
 485                                             ))))
 486       (nth (1- choice) prj-files))
 487
 488      ((= (length prj-files) 0)
 489       ;;  no project file found. Ask the user about it (the default value
 490       ;;  is the last one the user entered.
 491       (if (or no-user-question (not ada-always-ask-project))
 492           nil
 493         (setq ada-last-prj-file
 494               (read-file-name "project file:" nil ada-last-prj-file))
 495         (if (string= ada-last-prj-file "") nil ada-last-prj-file))
 496      )
 497   )))
 498
 499
 500 (defun ada-parse-prj-file (prj-file)
 501   "Reads and parses the project file PRJ-FILE.
 502 Does nothing if PRJ-FILE was not found.
 503 The current buffer should be the ada-file buffer"
 504
 505   (let ((tmp-src-dir  nil)
 506         (tmp-obj-dir  nil)
 507         (tmp-comp-opt nil)
 508         (tmp-bind-opt nil)
 509         (tmp-link-opt nil)
 510         (tmp-main     nil)
 511         (tmp-comp-cmd nil)
 512         (tmp-make-cmd nil)
 513         (tmp-run-cmd  nil)
 514         (tmp-debug-cmd nil)
 515         (tmp-remote-machine nil)
 516         (tmp-cross-prefix nil)
 517         (tmp-cd-cmd   (if prj-file
 518                           (concat "cd " (file-name-directory prj-file) " && ")
 519                         (concat "cd " (file-name-directory (buffer-file-name (current-buffer))) " && ")))
 520         (ada-buffer (current-buffer))
 521         )
 522     ;; tries to find a project file in the current directory
 523     (if prj-file
 524         (progn
 525           (find-file prj-file)
 526
 527           ;; first look for the src_dir lines
 528           (widen)
 529           (goto-char (point-min))
 530           (while
 531               (re-search-forward "^src_dir=\\(.*\\)" nil t)
 532             (progn
 533               (setq tmp-src-dir (cons
 534                                  (file-name-as-directory
 535                                   (match-string 1))
 536                                  tmp-src-dir
 537                                  ))))
 538           ;; then for the obj_dir lines
 539           (goto-char (point-min))
 540           (while (re-search-forward "^obj_dir=\\(.*\\)" nil t)
 541             (setq tmp-obj-dir (cons
 542                                (file-name-as-directory
 543                                 (match-string 1))
 544                                tmp-obj-dir
 545                                )))
 546
 547           ;; then for the options lines
 548           (goto-char (point-min))
 549           (if (re-search-forward "^comp_opt=\\(.*\\)" nil t)
 550               (setq tmp-comp-opt (match-string 1)))
 551           (goto-char (point-min))
 552           (if (re-search-forward "^bind_opt=\\(.*\\)" nil t)
 553               (setq tmp-bind-opt (match-string 1)))
 554           (goto-char (point-min))
 555           (if (re-search-forward "^link_opt=\\(.*\\)" nil t)
 556               (setq tmp-link-opt (match-string 1)))
 557           (goto-char (point-min))
 558           (if (re-search-forward "^main=\\(.*\\)" nil t)
 559               (setq tmp-main (match-string 1)))
 560           (goto-char (point-min))
 561           (if (re-search-forward "^comp_cmd=\\(.*\\)" nil t)
 562               (setq tmp-comp-cmd (match-string 1)))
 563           (goto-char (point-min))
 564           (if (re-search-forward "^remote_machine=\\(.*\\)" nil t)
 565               (setq tmp-remote-machine (match-string 1)))
 566           (goto-char (point-min))
 567           (if (re-search-forward "^cross_prefix=\\(.*\\)" nil t)
 568               (setq tmp-cross-prefix (match-string 1)))
 569           (goto-char (point-min))
 570           (if (re-search-forward "^make_cmd=\\(.*\\)" nil t)
 571               (setq tmp-make-cmd (match-string 1)))
 572           (goto-char (point-min))
 573           (if (re-search-forward "^run_cmd=\\(.*\\)" nil t)
 574               (setq tmp-run-cmd (match-string 1)))
 575           (goto-char (point-min))
 576           (if (re-search-forward "^debug_cmd=\\(.*\\)" nil t)
 577               (setq tmp-debug-cmd (match-string 1)))
 578
 579           ;; kills the project file buffer, and go back to the ada buffer
 580           (kill-buffer nil)
 581           (set-buffer ada-buffer)
 582           ))
 583
 584     ;; creates local variables (with default values if needed)
 585     (set (make-local-variable 'ada-prj-prj-file) prj-file)
 586
 587     (set (make-local-variable 'ada-prj-src-dir)
 588          (if tmp-src-dir (reverse tmp-src-dir)  '("./")))
 589
 590     (set (make-local-variable 'ada-prj-obj-dir)
 591          (if tmp-obj-dir (reverse tmp-obj-dir)  '("./")))
 592
 593     (set (make-local-variable 'ada-prj-comp-opt)
 594          (if tmp-comp-opt tmp-comp-opt ""))
 595
 596     (set (make-local-variable 'ada-prj-bind-opt)
 597          (if tmp-bind-opt tmp-bind-opt ""))
 598
 599     (set (make-local-variable 'ada-prj-link-opt)
 600          (if tmp-link-opt tmp-link-opt ""))
 601
 602     (set (make-local-variable 'ada-prj-cross-prefix)
 603          (if tmp-cross-prefix
 604              (if (or (string= tmp-cross-prefix "")
 605                      (= (aref tmp-cross-prefix (1- (length tmp-cross-prefix))) ?-))
 606                  tmp-cross-prefix
 607                (concat tmp-cross-prefix "-"))
 608               ""))
 609
 610     (set (make-local-variable 'ada-prj-main)
 611          (if tmp-main tmp-main
 612            (substring (buffer-file-name) 0 -4)))
 613
 614     (set (make-local-variable 'ada-prj-remote-machine)
 615          (ada-treat-cmd-string
 616           (if tmp-remote-machine tmp-remote-machine "")))
 617
 618     (set (make-local-variable 'ada-prj-comp-cmd)
 619          (ada-treat-cmd-string
 620           (if tmp-comp-cmd tmp-comp-cmd
 621             (concat tmp-cd-cmd ada-prj-default-comp-cmd))))
 622
 623     (set (make-local-variable 'ada-prj-make-cmd)
 624          (ada-treat-cmd-string
 625           (if tmp-make-cmd tmp-make-cmd
 626             (concat tmp-cd-cmd ada-prj-default-make-cmd))))
 627
 628     (set (make-local-variable 'ada-prj-run-cmd)
 629          (ada-treat-cmd-string
 630           (if tmp-run-cmd tmp-run-cmd
 631             (if is-windows "${main}.exe" "${main}"))))
 632
 633     (set (make-local-variable 'ada-prj-debug-cmd)
 634          (ada-treat-cmd-string
 635           (if tmp-debug-cmd tmp-debug-cmd
 636             (if is-windows
 637                 "${cross_prefix}gdb ${main}.exe"
 638               "${cross_prefix}gdb ${main}"))))
 639
 640     ;; Add each directory in src_dir to the default prj list
 641     (if prj-file
 642         (mapcar (lambda (x)
 643                   (if (not (assoc (expand-file-name x)
 644                                   ada-xref-default-prj-file))
 645                       (setq ada-xref-default-prj-file
 646                             (cons (cons (expand-file-name x)
 647                                         prj-file)
 648                                   ada-xref-default-prj-file))))
 649                 ada-prj-src-dir))
 650
 651     ;; Add the directories to the search path for ff-find-other-file
 652     ;; Do not add the '/' or '\' at the end
 653     (set (make-local-variable 'ff-search-directories)
 654          (append (mapcar 'directory-file-name ada-prj-src-dir)
 655                  ada-search-directories))
 656
 657     ;; Sets up the compilation-search-path so that Emacs is able to
 658     ;; go to the source of the errors in a compilation buffer
 659     (setq compilation-search-path ada-prj-src-dir)
 660
 661     ))
 662
 663
 664 (defun ada-find-references (&optional pos)
 665   "Find all references to the entity under POS.
 666 Calls gnatfind to find the references."
 667   (interactive "")
 668   (unless pos
 669     (set 'pos (point)))
 670   (ada-require-project-file)
 671
 672   (let* ((identlist (ada-read-identifier pos))
 673          (alifile (ada-get-ali-file-name (ada-file-of identlist))))
 674
 675     (set-buffer (get-file-buffer (ada-file-of identlist)))
 676
 677     ;;  if the file is more recent than the executable
 678     (if (or (buffer-modified-p (current-buffer))
 679             (file-newer-than-file-p (ada-file-of identlist) alifile))
 680         (ada-find-any-references (ada-name-of identlist)
 681                                  (ada-file-of identlist)
 682                                  nil nil)
 683       (ada-find-any-references (ada-name-of identlist)
 684                                (ada-file-of identlist)
 685                                (ada-line-of identlist)
 686                                (ada-column-of identlist))))
 687   )
 688
 689 (defun ada-find-any-references (entity &optional file line column)
 690   "Search for references to any entity whose name is ENTITY.
 691 ENTITY was first found the location given by FILE, LINE and COLUMN."
 692   (interactive "sEntity name: ")
 693   (ada-require-project-file)
 694
 695   (let* ((command (concat "gnatfind -rf " entity
 696                           (if file (concat ":" (file-name-nondirectory file)))
 697                           (if line (concat ":" line))
 698                           (if column (concat ":" column)))))
 699
 700     ;;  If a project file is defined, use it
 701     (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))
 702         (setq command (concat command " -p" ada-prj-prj-file)))
 703
 704     (compile-internal command "No more references" "gnatfind")
 705
 706     ;;  Hide the "Compilation" menu
 707     (save-excursion
 708       (set-buffer "*gnatfind*")
 709       (local-unset-key [menu-bar compilation-menu]))
 710     )
 711   )
 712
 713 (defun ada-buffer-list ()
 714   "Display a buffer with all the Ada buffers and their associated project."
 715   (interactive)
 716   (save-excursion
 717     (set-buffer (get-buffer-create "*Buffer List*"))
 718     (setq buffer-read-only nil)
 719     (erase-buffer)
 720     (setq standard-output (current-buffer))
 721     (princ "The following line is a list showing the associations between
 722 directories and project file. It has the format : ((directory_1 . project_file1)
 723 (directory2 . project_file2)...)\n\n")
 724     (princ ada-xref-default-prj-file)
 725     (princ "\n
 726  Buffer              Mode         Project file
 727  ------              ----         ------------
 728 \n")
 729     (let ((bl (buffer-list)))
 730       (while bl
 731         (let* ((buffer (car bl))
 732                (buffer-name (buffer-name buffer))
 733                this-buffer-mode-name
 734                this-buffer-project-file)
 735           (save-excursion
 736             (set-buffer buffer)
 737             (setq this-buffer-mode-name
 738                   (if (eq buffer standard-output)
 739                       "Buffer Menu" mode-name))
 740             (if (string= this-buffer-mode-name
 741                          "Ada")
 742                 (setq this-buffer-project-file
 743                       (if ( my-local-variable-if-set-p 'ada-prj-prj-file
 744                                                    (current-buffer))
 745                           (expand-file-name ada-prj-prj-file)
 746                         ""))))
 747           (if (string= this-buffer-mode-name
 748                          "Ada")
 749               (progn
 750                 (princ (format "%-19s  "  buffer-name))
 751                   (princ (format "%-6s " this-buffer-mode-name))
 752                   (princ this-buffer-project-file)
 753                   (princ "\n")
 754                   ))
 755           ) ;; end let*
 756         (setq bl (cdr bl))
 757         ) ;; end while
 758       );; end let
 759     ) ;; end save-excursion
 760   (display-buffer "*Buffer List*")
 761   (other-window 1)
 762   )
 763
 764 (defun ada-change-prj (filename)
 765   "Set FILENAME to be the project file for current buffer."
 766   (interactive "fproject file:")
 767
 768   ;; make sure we are using an Ada file
 769   (if (not (string= mode-name "Ada"))
 770     (error "You must be in ada-mode to use this function"))
 771
 772   ;; create the local variable if necessay
 773   (if (not ( my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)))
 774       (make-local-variable 'ada-prj-prj-file))
 775
 776   ;; ask the user for the new file name
 777   (setq ada-prj-prj-file filename)
 778
 779   ;; force Emacs to reread the prj file next-time
 780   (ada-reread-prj-file)
 781   )
 782
 783 (defun ada-change-default-prj (filename)
 784   "Set FILENAME to be the default project file for the current directory."
 785   (interactive "ffile name:")
 786   (let ((dir (file-name-directory (buffer-file-name)))
 787         (prj (expand-file-name filename)))
 788
 789     ;;  Associate the directory with a project file
 790     (if (assoc dir ada-xref-default-prj-file)
 791         (setcdr (assoc dir ada-xref-default-prj-file) prj)
 792       (add-to-list 'ada-xref-default-prj-file (list dir prj)))
 793
 794     ;; Reparse the project file
 795     (ada-parse-prj-file ada-prj-default-project-file)))
 796
 797
 798 ;; ----- Identlist manipulation -------------------------------------------
 799 ;; An identlist is a vector that is used internally to reference an identifier
 800 ;; To facilitate its use, we provide the following macros
 801
 802 (defmacro ada-make-identlist () (make-vector 8 nil))
 803 (defmacro ada-name-of   (identlist)    (list 'aref identlist 0))
 804 (defmacro ada-line-of   (identlist)    (list 'aref identlist 1))
 805 (defmacro ada-column-of (identlist)    (list 'aref identlist 2))
 806 (defmacro ada-file-of   (identlist)    (list 'aref identlist 3))
 807 (defmacro ada-ali-index-of    (identlist) (list 'aref identlist 4))
 808 (defmacro ada-declare-file-of (identlist) (list 'aref identlist 5))
 809 (defmacro ada-references-of   (identlist) (list 'aref identlist 6))
 810 (defmacro ada-on-declaration  (identlist) (list 'aref identlist 7))
 811
 812 (defmacro ada-set-name         (identlist name) (list 'aset identlist 0 name))
 813 (defmacro ada-set-line         (identlist line) (list 'aset identlist 1 line))
 814 (defmacro ada-set-column       (identlist col)  (list 'aset identlist 2 col))
 815 (defmacro ada-set-file         (identlist file) (list 'aset identlist 3 file))
 816 (defmacro ada-set-ali-index   (identlist index) (list 'aset identlist 4 index))
 817 (defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file))
 818 (defmacro ada-set-references   (identlist ref)  (list 'aset identlist 6 ref))
 819 (defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))
 820
 821 (defsubst ada-get-ali-buffer (file)
 822   "Reads the ali file into a new buffer, and returns this buffer's name"
 823   (find-file-noselect (ada-get-ali-file-name file)))
 824
 825
 826
 827 ;; ----- Identifier Completion --------------------------------------------
 828 (defun ada-complete-identifier (pos)
 829   "Tries to complete the identifier around POS.
 830 The feature is only available if the files where not compiled using the -gnatx
 831 option."
 832   (interactive "d")
 833   (ada-require-project-file)
 834
 835   ;; Initialize function-local variablesand jump to the .ali buffer
 836   ;; Note that for regexp search is case insensitive too
 837   (let* ((curbuf (current-buffer))
 838          (identlist (ada-read-identifier pos))
 839          (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\("
 840                         (regexp-quote (ada-name-of identlist))
 841                         "[a-zA-Z0-9_]*\\)"))
 842          (completed nil)
 843          (symalist nil)
 844          (insertpos nil))
 845
 846     ;; we are already in the .ali buffer
 847     (goto-char (point-max))
 848
 849     ;; build an alist of possible completions
 850     (while (re-search-backward sofar nil t)
 851       (setq symalist (cons (cons (match-string 1) nil) symalist)))
 852
 853     (setq completed  (try-completion "" symalist))
 854
 855     ;; kills .ali buffer
 856     (kill-buffer nil)
 857
 858     ;; deletes the incomplete identifier in the buffer
 859     (set-buffer curbuf)
 860     (looking-at "[a-zA-Z0-9_]+")
 861     (replace-match "")
 862     ;; inserts the completed symbol
 863     (insert completed)
 864     ))
 865
 866 ;; ----- Cross-referencing ----------------------------------------
 867
 868 (defun ada-point-and-xref ()
 869  "Calls `mouse-set-point' and then `ada-goto-declaration'."
 870   (interactive)
 871   (mouse-set-point last-input-event)
 872   (ada-goto-declaration (point)))
 873
 874 (defun ada-goto-declaration (pos)
 875   "Display the declaration of the identifier around POS.
 876 The declaration is shown in another buffer if `ada-xref-other-buffer' is
 877 non-nil."
 878   (interactive "d")
 879   (ada-require-project-file)
 880   (push-mark pos)
 881   (ada-xref-push-pos (buffer-file-name) pos)
 882   (ada-find-in-ali (ada-read-identifier pos)))
 883
 884 (defun ada-goto-declaration-other-frame (pos)
 885   "Display the declaration of the identifier around POS.
 886 The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
 887   (interactive "d")
 888   (ada-require-project-file)
 889   (push-mark pos)
 890   (ada-xref-push-pos (buffer-file-name) pos)
 891   (ada-find-in-ali (ada-read-identifier pos) t))
 892
 893 (defun ada-compile (command)
 894   "Start COMMAND on the machine specified in the project file."
 895   (if (and (my-local-variable-if-set-p 'ada-prj-remote-machine (current-buffer))
 896            (not (string= ada-prj-remote-machine "")))
 897       (set 'command
 898            (concat "rsh " ada-prj-remote-machine " '"
 899                    command "'")))
 900   (compile command))
 901
 902 (defun ada-compile-application ()
 903   "Compiles the application, using the command found in the project file."
 904   (interactive)
 905   (ada-require-project-file)
 906
 907   ;; prompt for command to execute
 908   (ada-compile
 909    (if ada-xref-confirm-compile
 910        (read-from-minibuffer "enter command to compile: "
 911                              ada-prj-make-cmd)
 912      ada-prj-make-cmd))
 913   )
 914
 915 (defun ada-compile-current ()
 916   "Recompile the current file."
 917   (interactive)
 918   (ada-require-project-file)
 919
 920   ;; prompt for command to execute
 921   (ada-compile
 922    (if ada-xref-confirm-compile
 923        (read-from-minibuffer "enter command to compile: "
 924                              (concat
 925                               ada-prj-comp-cmd " " (ada-convert-file-name (buffer-file-name))))
 926      (concat ada-prj-comp-cmd " " (ada-convert-file-name (buffer-file-name)))))
 927   )
 928
 929 (defun ada-check-current ()
 930   "Recompile the current file."
 931   (interactive)
 932   (ada-require-project-file)
 933
 934   ;; prompt for command to execute
 935   (let ((command (concat ada-prj-comp-cmd ada-check-switch
 936                          (ada-convert-file-name (buffer-file-name)))))
 937     (compile
 938      (if ada-xref-confirm-compile
 939          (read-from-minibuffer "enter command to compile: " command)
 940        command))))
 941
 942
 943 (defun ada-run-application ()
 944   "Run the application."
 945   (interactive)
 946   (ada-require-project-file)
 947
 948   (if (and (my-local-variable-if-set-p 'ada-prj-cross-prefix (current-buffer))
 949            (not (string= ada-prj-cross-prefix "")))
 950       (error "This feature is not supported yet for cross-compilation environments"))
 951
 952   (let ((command ada-prj-run-cmd)
 953         (buffer  (current-buffer)))
 954     ;; Search the command name if necessary
 955     (if (not (my-local-variable-if-set-p 'ada-prj-run-cmd (current-buffer)))
 956         (setq command (file-name-sans-extension (buffer-name)))
 957       )
 958
 959     ;; Ask for the arguments to the command
 960     (setq command
 961           (read-from-minibuffer "Enter command to execute: "
 962                                 command))
 963
 964     ;; Run the command
 965     (save-excursion
 966       (set-buffer (get-buffer-create "*run*"))
 967       (goto-char (point-max))
 968       (insert "\nRunning " command "\n\n")
 969       (make-comint "run"
 970                    (comint-arguments command 0 0)
 971                    nil
 972                    (comint-arguments command 1 nil))
 973       )
 974     (display-buffer "*run*")
 975
 976     ;;  change to buffer *run* for interactive programs
 977     (other-window 1)
 978     (switch-to-buffer "*run*")
 979     )
 980   )
 981
 982
 983 (defun ada-gdb-application ()
 984   "Start the debugger on the application."
 985   (interactive)
 986
 987   (require 'gud)
 988   (let ((buffer (current-buffer))
 989         gdb-buffer)
 990     (ada-require-project-file)
 991
 992     (if (and (my-local-variable-if-set-p 'ada-prj-cross-prefix buffer)
 993              (not (string= ada-prj-cross-prefix "")))
 994         (error "This feature is not supported yet for cross-compilation environments"))
 995
 996     ;; If the command to use was given in the project file
 997     (if (my-local-variable-if-set-p 'ada-prj-debug-cmd buffer)
 998         (gdb ada-prj-debug-cmd)
 999       ;; Else the user will have to enter the command himself
1000       (gdb "")
1001       )
1002
1003     (set 'gdb-buffer (current-buffer))
1004
1005     ;;  Switch back to the source buffer
1006     ;;  and Activate the debug part in the contextual menu
1007     (switch-to-buffer buffer)
1008
1009     (if (functionp 'gud-make-debug-menu)
1010         (gud-make-debug-menu))
1011
1012     ;;  Warning: on Emacs >= 20.3.8, same-window-regexps includes gud-*,
1013     ;;  so the following call to display buffer will select the
1014     ;;  buffer instead of displaying it in another window
1015     ;;  This is why the second argument to display-buffer is 't'
1016     (display-buffer gdb-buffer t)
1017     ))
1018
1019
1020 (defun ada-reread-prj-file (&optional for-all-buffer)
1021   "Forces Emacs to read the project file again.
1022 Otherwise, this file is only read once, and never read again
1023 If FOR-ALL-BUFFER is non-nil, or the function was called with \C-u prefix,
1024 then do this for every opened buffer."
1025   (interactive "P")
1026   (if for-all-buffer
1027
1028       ;; do this for every buffer
1029       (mapcar (lambda (x)
1030                  (save-excursion
1031                    (set-buffer x)
1032                    ;; if we have the ada-mode and there is a real file
1033                    ;; associated with the buffer
1034                    (if (and (string= mode-name "Ada")
1035                             (buffer-file-name))
1036                        (progn
1037                          (kill-local-variable 'ada-prj-src-dir)
1038                          (kill-local-variable 'ada-prj-obj-dir)
1039                          (ada-parse-prj-file (ada-prj-find-prj-file))))
1040                    ))
1041                (buffer-list))
1042
1043     ;; else do this just for the current buffer
1044     (kill-local-variable 'ada-prj-src-dir)
1045     (kill-local-variable 'ada-prj-obj-dir)
1046     (ada-parse-prj-file (ada-prj-find-prj-file)))
1047   )
1048
1049 ;; ------ Private routines
1050
1051 (defun ada-xref-current (file &optional ali-file-name)
1052   "Update the cross-references for FILE.
1053 This in fact recompiles FILE to create ALI-FILE-NAME."
1054   ;; kill old buffer
1055   (if (and ali-file-name
1056            (get-file-buffer ali-file-name))
1057       (kill-buffer (get-file-buffer ali-file-name)))
1058   ;; prompt for command to execute
1059   (setq compile-command (concat ada-prj-comp-cmd
1060                                 " "
1061                                 file))
1062   (compile
1063    (if ada-xref-confirm-compile
1064        (read-from-minibuffer "enter command to execute gcc: "
1065                              compile-command)
1066      compile-command))
1067   )
1068
1069 (defun ada-first-non-nil (list)
1070   "Returns the first non-nil element of the LIST"
1071   (cond
1072    ((not list) nil)
1073    ((car list) (car list))
1074    (t (ada-first-non-nil (cdr list)))
1075    ))
1076
1077
1078 (defun ada-find-ali-file-in-dir (file)
1079   "Search for FILE in obj_dir.
1080 The current buffer must be the Ada file."
1081   (ada-first-non-nil
1082    (mapcar (lambda (x)
1083              (if (file-exists-p (concat (file-name-directory x)
1084                                         file))
1085                  (concat (file-name-directory x) file)
1086                nil))
1087            ada-prj-obj-dir))
1088   )
1089
1090 (defun ada-get-ali-file-name (file)
1091   "Create the ali file name for the ada-file FILE.
1092 The file is searched for in every directory shown in the obj_dir lines of
1093 the project file."
1094
1095   ;; This function has to handle the special case of non-standard
1096   ;; file names (i.e. not .adb or .ads)
1097   ;; The trick is the following:
1098   ;;   1- replace the extension of the current file with .ali,
1099   ;;      and look for this file
1100   ;;   2- If this file is found:
1101   ;;      grep the "^U" lines, and make sure we are not reading the
1102   ;;      .ali file for a spec file. If we are, go to step 3.
1103   ;;   3- If the file is not found or step 2 failed:
1104   ;;      find the name of the "other file", ie the body, and look
1105   ;;      for its associated .ali file by subtituing the extension
1106
1107   (save-excursion
1108     (set-buffer (get-file-buffer file))
1109     (let ((short-ali-file-name
1110            (concat (file-name-sans-extension (file-name-nondirectory file))
1111                    ".ali"))
1112           (ali-file-name ""))
1113       ;; First step
1114       ;; we take the first possible completion
1115       (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name))
1116
1117       ;; If we have found the .ali file, but the source file was a spec
1118       ;; with a non-standard name, search the .ali file for the body if any,
1119       ;; since the xref information is more complete in that one
1120       (unless ali-file-name
1121           (if (not (string= (file-name-extension file) ".ads"))
1122               (let ((is-spec nil)
1123                     (specs ada-spec-suffixes)
1124                     body-ali)
1125                 (while specs
1126                   (if (string-match (concat (regexp-quote (car specs)) "$")
1127                                     file)
1128                       (set 'is-spec t))
1129                   (set 'specs (cdr specs)))
1130
1131                 (if is-spec
1132                     (set 'body-ali
1133                          (ada-find-ali-file-in-dir
1134                           (concat (file-name-sans-extension
1135                                    (file-name-nondirectory
1136                                     (ada-other-file-name)))
1137                                   ".ali"))))
1138                 (if body-ali
1139                     (set 'ali-file-name body-ali))))
1140
1141         ;;  else we did not find the .ali file
1142         ;;  Second chance: in case the files do not have standard names (such
1143         ;;  as for instance file_s.ada and file_b.ada), try to go to the
1144         ;;  other file and look for its ali file
1145         (setq short-ali-file-name
1146               (concat (file-name-sans-extension
1147                        (file-name-nondirectory (ada-other-file-name)))
1148                       ".ali"))
1149         (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name))
1150
1151         ;; If still not found, try to recompile the file
1152         (if (not ali-file-name)
1153             (progn
1154               ;; recompile only if the user asked for this
1155               (if ada-xref-create-ali
1156                   (ada-xref-current file ali-file-name))
1157               (error "Ali file not found. Recompile your file")))
1158         )
1159
1160       ;; same if the .ali file is too old and we must recompile it
1161       (if (and (file-newer-than-file-p file ali-file-name)
1162                ada-xref-create-ali)
1163           (ada-xref-current file ali-file-name))
1164
1165       ;; else returns the correct absolute file name
1166       (expand-file-name ali-file-name))
1167     ))
1168
1169 (defun ada-get-ada-file-name (file original-file)
1170   "Create the complete file name (+directory) for FILE.
1171 The original file (where the user was) is ORIGINAL-FILE. Search in project
1172 file for possible paths."
1173
1174   (save-excursion
1175     (set-buffer (get-file-buffer original-file))
1176     ;; we choose the first possible completion and we
1177     ;; return the absolute file name
1178     (let ((filename
1179            (ada-first-non-nil (mapcar (lambda (x)
1180                           (if (file-exists-p (concat (file-name-directory x)
1181                                                      (file-name-nondirectory file)))
1182                               (concat (file-name-directory x)
1183                                       (file-name-nondirectory file))
1184                             nil))
1185                         ada-prj-src-dir))))
1186
1187       (if filename
1188           (expand-file-name filename)
1189         (error (concat
1190                 (file-name-nondirectory file)
1191                 " not found in src_dir. Please check your project file")))
1192
1193       )))
1194
1195 (defun ada-find-file-number-in-ali (file)
1196   "Returns the file number for FILE in the associated ali file."
1197   (set-buffer (ada-get-ali-buffer file))
1198   (goto-char (point-min))
1199
1200   (let ((begin (re-search-forward "^D")))
1201     (beginning-of-line)
1202     (re-search-forward (concat "^D " (file-name-nondirectory file)))
1203     (count-lines begin (point))))
1204
1205 (defun ada-read-identifier (pos)
1206   "Returns the identlist around POS and switch to the .ali buffer."
1207
1208   ;; If there's a compilation in progress, it's probably because the
1209   ;; .ali file didn't exist. So we should wait...
1210   (if compilation-in-progress
1211       (progn
1212         (message "Compilation in progress. Try again when it is finished")
1213         (set 'quit-flag t)))
1214
1215   ;; If at end of buffer (e.g the buffer is empty), error
1216   (if (>= (point) (point-max))
1217       (error "No identifier on point"))
1218
1219   ;; goto first character of the identifier/operator (skip backward < and >
1220   ;; since they are part of multiple character operators
1221   (goto-char pos)
1222   (skip-chars-backward "a-zA-Z0-9_<>")
1223
1224   ;; check if it really is an identifier
1225   (if (ada-in-comment-p)
1226       (error "Inside comment"))
1227
1228   (let (identifier identlist)
1229     ;; Just in front of a string => we could have an operator declaration,
1230     ;; as in "+", "-", ..
1231     (if (= (char-after) ?\")
1232         (forward-char 1))
1233
1234     ;; if looking at an operator
1235     (if (looking-at ada-operator-re)
1236         (progn
1237           (if (and (= (char-before) ?\")
1238                    (= (char-after (+ (length (match-string 0)) (point))) ?\"))
1239               (forward-char -1))
1240           (set 'identifier (concat "\"" (match-string 0) "\"")))
1241
1242       (if (ada-in-string-p)
1243           (error "Inside string or character constant"))
1244       (if (looking-at (concat ada-keywords "[^a-zA-Z_]"))
1245           (error "No cross-reference available for reserved keyword"))
1246       (if (looking-at "[a-zA-Z0-9_]+")
1247           (set 'identifier (match-string 0))
1248         (error "No identifier around")))
1249
1250     ;; Build the identlist
1251     (set 'identlist    (ada-make-identlist))
1252     (ada-set-name      identlist (downcase identifier))
1253     (ada-set-line      identlist
1254                        (number-to-string (count-lines (point-min) (point))))
1255     (ada-set-column    identlist
1256                        (number-to-string (1+ (current-column))))
1257     (ada-set-file      identlist (buffer-file-name))
1258     identlist
1259     ))
1260
1261 (defun ada-get-all-references (identlist)
1262   "Completes and returns the IDENTLIST with the information extracted
1263 from the ali file (definition file and places where it is referenced)."
1264
1265   (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
1266         declaration-found)
1267     (set-buffer ali-buffer)
1268     (goto-char (point-min))
1269     (ada-set-on-declaration identlist nil)
1270
1271     ;; First attempt: we might already be on the declaration of the identifier
1272     ;; We want to look for the declaration only in a definite interval (after
1273     ;; the "^X ..." line for the current file, and before the next "^X" line
1274
1275     (if (re-search-forward
1276          (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
1277          nil t)
1278         (let ((bound (save-excursion (re-search-forward "^X " nil t))))
1279           (set 'declaration-found
1280                (re-search-forward
1281                 (concat "^"    (ada-line-of identlist)
1282                         "."    (ada-column-of identlist)
1283                         "[ *]" (regexp-quote (ada-name-of identlist))
1284                         " \\(.*\\)$") bound t))
1285           (if declaration-found
1286               (ada-set-on-declaration identlist t))
1287           ))
1288
1289     ;; If declaration is still nil, then we were not on a declaration, and
1290     ;; have to fall back on other algorithms
1291
1292     (unless declaration-found
1293
1294       ;; Since we alread know the number of the file, search for a direct
1295       ;; reference to it
1296       (goto-char (point-min))
1297       (set 'declaration-found t)
1298       (ada-set-ali-index
1299        identlist
1300        (number-to-string (ada-find-file-number-in-ali
1301                           (ada-file-of identlist))))
1302       (unless (re-search-forward (concat (ada-ali-index-of identlist)
1303                                          "|\\([0-9]+.[0-9]+ \\)*"
1304                                          (ada-line-of identlist)
1305                                          "[^0-9]"
1306                                          (ada-column-of identlist))
1307                                  nil t)
1308
1309           ;; if we did not find it, it may be because the first reference
1310           ;; is not required to have a 'unit_number|' item included.
1311           ;; Or maybe we are already on the declaration...
1312           (unless (re-search-forward (concat "^\\([a-zA-Z0-9_.\"]+[ *]\\)*"
1313                                              (ada-line-of identlist)
1314                                              "[^0-9]"
1315                                              (ada-column-of identlist))
1316                                      nil t)
1317
1318             ;; If still not found, then either the declaration is unknown
1319             ;; or the source file has been modified since the ali file was
1320             ;; created
1321             (set 'declaration-found nil)
1322             )
1323           )
1324
1325       ;; Last check to be completly sure we have found the correct line (the
1326       ;; ali might not be up to date for instance)
1327       (if declaration-found
1328           (progn
1329             (beginning-of-line)
1330             ;; while we have a continuation line, go up one line
1331             (while (looking-at "^\\.")
1332               (previous-line 1))
1333             (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
1334                                         (ada-name-of identlist) " "))
1335               (set 'declaration-found nil))))
1336
1337       ;; Still no success ! The ali file must be too old, and we need to
1338       ;; use a basic algorithm based on guesses. Note that this only happens
1339       ;; if the user does not want us to automatically recompile files
1340       ;; automatically
1341       (unless declaration-found
1342         (unless (ada-xref-find-in-modified-ali identlist)
1343           ;; no more idea to find the declaration. Give up
1344           (progn
1345             (kill-buffer ali-buffer)
1346             (error (concat "No declaration of " (ada-name-of identlist)
1347                            " found."))
1348             )))
1349       )
1350
1351
1352     ;; Now that we have found a suitable line in the .ali file, get the
1353     ;; information available
1354     (beginning-of-line)
1355     (if declaration-found
1356         (let ((current-line (buffer-substring
1357                              (point) (save-excursion (end-of-line) (point)))))
1358           (save-excursion
1359             (next-line 1)
1360             (beginning-of-line)
1361             (while (looking-at "^\\.\\(.*\\)")
1362               (set 'current-line (concat current-line (match-string 1)))
1363               (next-line 1))
1364             )
1365
1366           (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
1367               (ada-set-declare-file
1368                identlist
1369                (ada-get-ada-file-name (match-string 1)
1370                                       (ada-file-of identlist))))
1371
1372           (ada-set-references   identlist current-line)
1373           ))
1374   ))
1375
1376 (defun ada-xref-find-in-modified-ali (identlist)
1377   "Find the matching position for IDENTLIST in the current ali buffer.
1378 This function is only called when the file was not up-to-date, so we need
1379 to make some guesses.
1380 This function is disabled for operators, and only works for identifiers."
1381
1382   (unless (= (string-to-char (ada-name-of identlist)) ?\")
1383       (progn
1384         (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... ))
1385               (my-regexp  (concat "[ *]"
1386                                   (regexp-quote (ada-name-of identlist)) " "))
1387               (line-ada "--")
1388               (col-ada  "--")
1389               (line-ali 0)
1390               (len 0)
1391               (choice 0))
1392
1393           (goto-char (point-max))
1394           (while (re-search-backward my-regexp nil t)
1395             (save-excursion
1396               (set 'line-ali (count-lines (point-min) (point)))
1397               (beginning-of-line)
1398               ;; have a look at the line and column numbers
1399               (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
1400                   (progn
1401                     (setq line-ada (match-string 1))
1402                     (setq col-ada  (match-string 2)))
1403                 (setq line-ada "--")
1404                 (setq col-ada  "--")
1405                 )
1406               ;; construct a list with the file names and the positions within
1407               (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t)
1408                   (add-to-list
1409                    'declist (list line-ali (match-string 1) line-ada col-ada))
1410                 )
1411               )
1412             )
1413
1414           ;; how many possible declarations have we found ?
1415           (setq len (length declist))
1416           (cond
1417            ;; none => error
1418            ((= len 0)
1419             (kill-buffer (current-buffer))
1420             (error (concat "No declaration of "
1421                            (ada-name-of identlist)
1422                            " recorded in .ali file")))
1423
1424            ;; one => should be the right one
1425            ((= len 1)
1426             (goto-line (caar declist)))
1427
1428            ;; more than one => display choice list
1429            (t
1430             (with-output-to-temp-buffer "*choice list*"
1431
1432               (princ "Identifier is overloaded and Xref information is not up to date.\n")
1433               (princ "Possible declarations are:\n\n")
1434               (princ "  no.   in file                at line  col\n")
1435               (princ "  ---   ---------------------     ----  ----\n")
1436               (let ((counter 1))
1437                 (while (<= counter len)
1438                   (princ (format "  %2d)    %-21s   %4s  %4s\n"
1439                                  counter
1440                                  (ada-get-ada-file-name
1441                                   (nth 1 (nth (1- counter) declist))
1442                                   (ada-file-of identlist))
1443                                  (nth 2 (nth (1- counter) declist))
1444                                  (nth 3 (nth (1- counter) declist))
1445                                  ))
1446                   (setq counter (1+ counter))
1447                   ) ; end of while
1448                 ) ; end of let
1449               ) ; end of with-output-to ...
1450             (setq choice nil)
1451             (while (or
1452                     (not choice)
1453                     (not (integerp choice))
1454                     (< choice 1)
1455                     (> choice len))
1456               (setq choice (string-to-int
1457                             (read-from-minibuffer "Enter No. of your choice: "))))
1458             (goto-line (car (nth (1- choice) declist)))
1459             ))))))
1460
1461
1462 (defun ada-find-in-ali (identlist &optional other-frame)
1463   "Look in the .ali file for the definition of the identifier in IDENTLIST.
1464 If OTHER-FRAME is non nil, and `ada-xref-other-buffer' is non nil,
1465 opens a new window to show the declaration."
1466
1467   (ada-get-all-references identlist)
1468   (let ((ali-line (ada-references-of identlist))
1469         file  line  col)
1470
1471     ;; If we were on a declaration, go to the body
1472     (if (ada-on-declaration identlist)
1473         (if (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line)
1474             (progn
1475               (setq line (match-string 1 ali-line)
1476                     col  (match-string 2 ali-line))
1477               ;;  it there was a file number in the same line
1478               (if (string-match "\\([0-9]+\\)|\\([^|bc]+\\)?[bc]" ali-line)
1479                   (let ((file-number (match-string 1 ali-line)))
1480                     (goto-char (point-min))
1481                     (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t
1482                                        (string-to-number file-number))
1483                     (set 'file (match-string 1))
1484                     )
1485                 ;; Else get the nearest file
1486                 (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
1487                 (set 'file (match-string 1))
1488                 )
1489               )
1490           (error "No body found"))
1491
1492       ;; Else we were not on the declaration, find the place for it
1493       (string-match "\\([0-9]+\\)[a-zA-Z+]\\([0-9]+\\)[ *]" ali-line)
1494       (setq line (match-string 1 ali-line)
1495             col  (match-string 2 ali-line)
1496             file (ada-declare-file-of identlist))
1497       )
1498
1499     ;; Now go to the buffer
1500     (ada-xref-change-buffer
1501      (ada-get-ada-file-name file (ada-file-of identlist))
1502      (string-to-number line)
1503      (1- (string-to-number col))
1504      identlist
1505      other-frame)
1506     ))
1507
1508 (defun ada-xref-change-buffer
1509   (file line column identlist &optional other-frame)
1510   "Select and display FILE, at LINE and COLUMN. The new file is
1511 associated with the same project file as the one for IDENTLIST.
1512 If we do not end on the same identifier as IDENTLIST, find the closest
1513 match. Kills the .ali buffer at the end.
1514 If OTHER-FRAME is non-nil, creates a new frame to show the file."
1515
1516   (let (prj-file
1517         declaration-buffer
1518         (ali-buffer (current-buffer)))
1519
1520     ;; get the current project file for the source ada file
1521     (save-excursion
1522       (set-buffer (get-file-buffer (ada-file-of identlist)))
1523       (set 'prj-file ada-prj-prj-file))
1524
1525     ;; Select and display the destination buffer
1526     (if ada-xref-other-buffer
1527         (if other-frame
1528             (find-file-other-frame file)
1529           (set 'declaration-buffer (find-file-noselect file))
1530           (set-buffer declaration-buffer)
1531           (switch-to-buffer-other-window declaration-buffer)
1532           )
1533       (find-file file)
1534       )
1535
1536     ;; If the new buffer is not already associated with a project file, do it
1537     (unless (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))
1538         (progn
1539           (make-local-variable 'ada-prj-prj-file)
1540           (set 'ada-prj-prj-file prj-file)))
1541
1542     ;; move the cursor to the correct position
1543     (push-mark)
1544     (goto-line line)
1545     (move-to-column column)
1546
1547     ;; If we are not on the identifier, the ali file was not up-to-date.
1548     ;; Try to find the nearest position where the identifier is found,
1549     ;; this is probably the right one.
1550     (unless (looking-at (ada-name-of identlist))
1551       (ada-xref-search-nearest (ada-name-of identlist)))
1552
1553     (kill-buffer ali-buffer)))
1554
1555
1556 (defun ada-xref-search-nearest (name)
1557   "Searches for NAME nearest to the position recorded in the Xref file.
1558 It returns the position of the declaration in the buffer or nil if not found."
1559   (let ((orgpos (point))
1560         (newpos nil)
1561         (diff nil))
1562
1563     (goto-char (point-max))
1564
1565     ;; loop - look for all declarations of name in this file
1566     (while (search-backward name nil t)
1567
1568       ;; check if it really is a complete Ada identifier
1569       (if (and
1570            (not (save-excursion
1571                   (goto-char (match-end 0))
1572                   (looking-at "_")))
1573            (not (ada-in-string-or-comment-p))
1574            (or
1575             ;; variable declaration ?
1576             (save-excursion
1577               (skip-chars-forward "a-zA-Z_0-9" )
1578               (ada-goto-next-non-ws)
1579               (looking-at ":[^=]"))
1580             ;; procedure, function, task or package declaration ?
1581             (save-excursion
1582               (ada-goto-previous-word)
1583               (looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>"))))
1584
1585           ;; check if it is nearer than the ones before if any
1586           (if (or (not diff)
1587                   (< (abs (- (point) orgpos)) diff))
1588               (progn
1589                 (setq newpos (point)
1590                       diff (abs (- newpos orgpos))))))
1591       )
1592
1593     (if newpos
1594         (progn
1595           (message "ATTENTION: this declaration is only a (good) guess ...")
1596           (goto-char newpos))
1597       nil)))
1598
1599
1600 ;; Find the parent library file of the current file
1601 (defun ada-goto-parent ()
1602   "Go to the parent library file."
1603   (interactive)
1604   (ada-require-project-file)
1605
1606   (let ((buffer (ada-get-ali-buffer (buffer-file-name)))
1607         (unit-name nil)
1608         (body-name nil)
1609         (ali-name nil))
1610     (save-excursion
1611       (set-buffer buffer)
1612       (goto-char (point-min))
1613       (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)")
1614       (setq unit-name (match-string 1))
1615       (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name))
1616           (progn
1617             (kill-buffer buffer)
1618             (error "No parent unit !"))
1619         (setq unit-name (match-string 1 unit-name))
1620         )
1621
1622       ;; look for the file name for the parent unit specification
1623       (goto-char (point-min))
1624       (re-search-forward (concat "^W " unit-name
1625                                  "%s[ \t]+\\([^ \t]+\\)[ \t]+"
1626                                  "\\([^ \t\n]+\\)"))
1627       (setq body-name (match-string 1))
1628       (setq ali-name (match-string 2))
1629       (kill-buffer buffer)
1630       )
1631
1632     (setq ali-name (ada-find-ali-file-in-dir ali-name))
1633
1634     (save-excursion
1635       ;; Tries to open the new ali file to find the spec file
1636       (if ali-name
1637           (progn
1638             (find-file ali-name)
1639             (goto-char (point-min))
1640             (re-search-forward (concat "^U " unit-name "%s[ \t]+"
1641                                        "\\([^ \t]+\\)"))
1642             (setq body-name (match-string 1))
1643             (kill-buffer (current-buffer))
1644             )
1645         )
1646       )
1647
1648     (find-file body-name)
1649     ))
1650
1651 (defun ada-make-filename-from-adaname (adaname)
1652   "Determine the filename in which ADANAME is found.
1653 This is a GNAT specific function that uses gnatkrunch."
1654   (let (krunch-buf)
1655     (setq krunch-buf (generate-new-buffer "*gkrunch*"))
1656     (save-excursion
1657       (set-buffer krunch-buf)
1658       ;; send adaname to external process `gnatkr'.
1659       (call-process "gnatkr" nil krunch-buf nil
1660                     adaname ada-krunch-args)
1661       ;; fetch output of that process
1662       (setq adaname (buffer-substring
1663                      (point-min)
1664                      (progn
1665                        (goto-char (point-min))
1666                        (end-of-line)
1667                        (point))))
1668       (kill-buffer krunch-buf)))
1669   adaname
1670   )
1671
1672
1673 (defun ada-make-body-gnatstub ()
1674   "Create an Ada package body in the current buffer.
1675 This function uses the `gnatstub' program to create the body.
1676 This function typically is to be hooked into `ff-file-created-hooks'."
1677   (interactive)
1678
1679   (save-some-buffers nil nil)
1680
1681   (ada-require-project-file)
1682
1683   (delete-region (point-min) (point-max))
1684
1685   ;; Call the external process gnatstub
1686   (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
1687          (filename      (buffer-file-name (car (cdr (buffer-list)))))
1688          (output        (concat (file-name-sans-extension filename) ".adb"))
1689          (gnatstub-cmd  (concat "gnatstub " gnatstub-opts " " filename))
1690          (buffer        (get-buffer-create "*gnatstub*")))
1691
1692     (save-excursion
1693       (set-buffer buffer)
1694       (compilation-minor-mode 1)
1695       (erase-buffer)
1696       (insert gnatstub-cmd)
1697       (newline)
1698       )
1699     ;; call gnatstub to create the body file
1700     (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
1701
1702     (if (save-excursion
1703           (set-buffer buffer)
1704           (goto-char (point-min))
1705           (search-forward "command not found" nil t))
1706         (progn
1707           (message "gnatstub was not found -- using the basic algorithm")
1708           (sleep-for 2)
1709           (kill-buffer buffer)
1710           (ada-make-body))
1711
1712       ;; Else clean up the output
1713
1714       ;;  Kill the temporary buffer created by find-file
1715       (set-buffer-modified-p nil)
1716       (kill-buffer (current-buffer))
1717
1718       (if (file-exists-p output)
1719           (progn
1720             (find-file output)
1721             (kill-buffer buffer))
1722
1723         ;; display the error buffer
1724         (display-buffer buffer)
1725         )
1726       )))
1727
1728
1729 (defun ada-xref-initialize ()
1730   "Function called by ada-mode-hook to initialize the ada-xref.el package.
1731 For instance, it creates the gnat-specific menus, set some hooks for
1732 find-file...."
1733   (ada-add-ada-menu)
1734   (make-local-hook 'ff-file-created-hooks)
1735   (setq ff-file-created-hooks 'ada-make-body-gnatstub)
1736
1737   ;; Read the project file and update the search path
1738   ;; before looking for the other file
1739   (make-local-hook 'ff-pre-find-hooks)
1740   (add-hook 'ff-pre-find-hooks 'ada-require-project-file)
1741
1742   ;; Completion for file names in the mini buffer should ignore .ali files
1743   (add-to-list 'completion-ignored-extensions ".ali")
1744   )
1745
1746
1747 ;; ----- Add to ada-mode-hook ---------------------------------------------
1748
1749 ;;  Set the keymap once and for all, so that the keys set by the user in his
1750 ;;  config file are not overwritten every time we open a new file.
1751 (ada-add-keymap)
1752
1753 (add-hook 'ada-mode-hook 'ada-xref-initialize)
1754
1755 (provide 'ada-xref)
1756
1757 ;;; ada-xref.el ends here