X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/15ea3b67a762629a984d638b750f70141744158c..199143f1fbc4f791ba20405ed1767e1cac099066:/lisp/progmodes/ada-xref.el diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index d358a127d8..fc1d2d46ab 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -1,66 +1,51 @@ -;; @(#) ada-xref.el --for lookup and completion in Ada mode +;;; ada-xref.el --- for lookup and completion in Ada mode -;; Copyright (C) 1994-1999 Free Software Foundation, Inc. +;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Markus Heritsch ;; Rolf Ebert ;; Emmanuel Briot ;; Maintainer: Emmanuel Briot -;; Ada Core Technologies's version: $Revision: 1.99 $ +;; Ada Core Technologies's version: Revision: 1.181 ;; Keywords: languages ada xref -;; This file is not part of GNU Emacs. +;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or modify +;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: ;;; This Package provides a set of functions to use the output of the ;;; cross reference capabilities of the GNAT Ada compiler ;;; for lookup and completion in Ada mode. ;;; -;;; 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 -;;; ;;; If a file *.`adp' exists in the ada-file directory, then it is -;;; read for configuration informations. It is read only the first +;;; read for configuration informations. It is read only the first ;;; time a cross-reference is asked for, and is not read later. ;;; You need Emacs >= 20.2 to run this package +;;; Code: + ;; ----- Requirements ----------------------------------------------------- (require 'compile) (require 'comint) +(require 'find-file) +(require 'ada-mode) ;; ------ Use variables (defcustom ada-xref-other-buffer t @@ -68,22 +53,31 @@ Otherwise create either a new buffer or a new frame." :type 'boolean :group 'ada) -(defcustom ada-xref-create-ali t +(defcustom ada-xref-create-ali nil "*If non-nil, run gcc whenever the cross-references are not up-to-date. -If nil, the cross-reference mode will never run gcc." +If nil, the cross-reference mode never runs gcc." :type 'boolean :group 'ada) (defcustom ada-xref-confirm-compile nil - "*If non-nil, always ask for user confirmation before compiling or running -the application." + "*If non-nil, ask for confirmation before compiling or running the application." :type 'boolean :group 'ada) (defcustom ada-krunch-args "0" - "*Maximum number of characters for filenames created by gnatkr. -Set to 0, if you don't use crunched filenames. This should be a string." + "*Maximum number of characters for filenames created by `gnatkr'. +Set to 0, if you don't use crunched filenames. This should be a string." :type 'string :group 'ada) -(defcustom ada-prj-default-comp-opt "-gnatq" +(defcustom ada-gnatls-args '("-v") + "*Arguments to pass to `gnatfind' to find location of the runtime. +Typical use is to pass `--RTS=soft-floats' on some systems that support it. + +You can also add `-I-' if you do not want the current directory to be included. +Otherwise, going from specs to bodies and back will first look for files in the +current directory. This only has an impact if you are not using project files, +but only ADA_INCLUDE_PATH." + :type '(repeat string) :group 'ada) + +(defcustom ada-prj-default-comp-opt "-gnatq -gnatQ" "Default compilation options." :type 'string :group 'ada) @@ -96,18 +90,27 @@ Set to 0, if you don't use crunched filenames. This should be a string." :type 'string :group 'ada) (defcustom ada-prj-default-gnatmake-opt "-g" - "Default options for gnatmake." + "Default options for `gnatmake'." + :type 'string :group 'ada) + +(defcustom ada-prj-gnatfind-switches "-rf" + "Default switches to use for `gnatfind'. +You should modify this variable, for instance to add `-a', if you are working +in an environment where most ALI files are write-protected. +The command `gnatfind' is used every time you choose the menu +\"Show all references\"." :type 'string :group 'ada) (defcustom ada-prj-default-comp-cmd - "${cross_prefix}gcc -c ${comp_opt}" + (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs" + " ${comp_opt}") "*Default command to be used to compile a single file. -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 syntax as in the project file." :type 'string :group 'ada) (defcustom ada-prj-default-debugger "${cross_prefix}gdb" - "*Default name of the debugger. We recommend either `gdb', + "*Default name of the debugger. We recommend either `gdb', `gdb --emacs_gdbtk' or `ddd --tty -fullname'." :type 'string :group 'ada) @@ -125,7 +128,7 @@ this string is not empty." :type '(file :must-match t) :group 'ada) (defcustom ada-gnatstub-opts "-q -I${src_dir}" - "*List of the options to pass to gnatsub to generate the body of a package. + "*List of the options to pass to `gnatsub' to generate the body of a package. This has the same syntax as in the project file (with variable substitution)." :type 'string :group 'ada) @@ -134,6 +137,34 @@ This has the same syntax as in the project file (with variable substitution)." Otherwise, ask the user for the name of the project file to use." :type 'boolean :group 'ada) +(defconst is-windows (memq system-type (quote (windows-nt))) + "True if we are running on Windows NT or Windows 95.") + +(defcustom ada-tight-gvd-integration nil + "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging. +If GVD is not the debugger used, nothing happens." + :type 'boolean :group 'ada) + +(defcustom ada-xref-search-with-egrep t + "*If non-nil, use egrep to find the possible declarations for an entity. +This alternate method is used when the exact location was not found in the +information provided by GNAT. However, it might be expensive if you have a lot +of sources, since it will search in all the files in your project." + :type 'boolean :group 'ada) + +(defvar ada-load-project-hook nil + "Hook that is run when loading a project file. +Each function in this hook takes one argument FILENAME, that is the name of +the project file to load. +This hook should be used to support new formats for the project files. + +If the function can load the file with the given filename, it should create a +buffer that contains a conversion of the file to the standard format of the +project files, and return that buffer. (The usual \"src_dir=\" or \"obj_dir=\" +lines.) It should return nil if it doesn't know how to convert that project +file.") + + ;; ------- Nothing to be modified by the user below this (defvar ada-last-prj-file "" "Name of the last project file entered by the user.") @@ -141,12 +172,9 @@ Otherwise, ask the user for the name of the project file to use." (defvar ada-check-switch "-gnats" "Switch added to the command line to check the current file.") -(defvar ada-project-file-extension ".adp" +(defconst ada-project-file-extension ".adp" "The extension used for project files.") -(defconst is-windows (memq system-type (quote (windows-nt))) - "True if we are running on windows NT or windows 95.") - (defvar ada-xref-runtime-library-specs-path '() "Directories where the specs for the standard library is found. This is used for cross-references.") @@ -159,6 +187,19 @@ This is used for cross-references.") "List of positions selected by the cross-references functions. Used to go back to these positions.") +(defvar ada-cd-command + (if (string-match "cmdproxy.exe" shell-file-name) + "cd /d" + "cd") + "Command to use to change to a specific directory. +On Windows systems using `cmdproxy.exe' as the shell, +we need to use `/d' or the drive is never changed.") + +(defvar ada-command-separator (if is-windows " && " "\n") + "Separator to use between multiple commands to `compile' or `start-process'. +`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use +\"&&\" for now.") + (defconst ada-xref-pos-ring-max 16 "Number of positions kept in the list ada-xref-pos-ring.") @@ -166,35 +207,53 @@ Used to go back to these positions.") "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>" "Regexp to match for operators.") -(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.") - - (defvar ada-xref-project-files '() "Associative list of project files. It has the following format: -((project_name . value) (project_name . value) ...) +\((project_name . value) (project_name . value) ...) As always, the values of the project file are defined through properties.") -(defvar ada-prj-prj-file nil - "Buffer local variable that specifies the name of the project file. -Getting the project is done by looking up the key in ada-pxref-project-file.") -(defun my-local-variable-if-set-p (variable &optional buffer) - "Returns t if VARIABLE is local in BUFFER and is non-nil." - (and (local-variable-p variable buffer) - (save-excursion - (set-buffer buffer) - (symbol-value variable)))) +;; ----- Identlist manipulation ------------------------------------------- +;; An identlist is a vector that is used internally to reference an identifier +;; To facilitate its use, we provide the following macros + +(defmacro ada-make-identlist () (make-vector 8 nil)) +(defmacro ada-name-of (identlist) (list 'aref identlist 0)) +(defmacro ada-line-of (identlist) (list 'aref identlist 1)) +(defmacro ada-column-of (identlist) (list 'aref identlist 2)) +(defmacro ada-file-of (identlist) (list 'aref identlist 3)) +(defmacro ada-ali-index-of (identlist) (list 'aref identlist 4)) +(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5)) +(defmacro ada-references-of (identlist) (list 'aref identlist 6)) +(defmacro ada-on-declaration (identlist) (list 'aref identlist 7)) + +(defmacro ada-set-name (identlist name) (list 'aset identlist 0 name)) +(defmacro ada-set-line (identlist line) (list 'aset identlist 1 line)) +(defmacro ada-set-column (identlist col) (list 'aset identlist 2 col)) +(defmacro ada-set-file (identlist file) (list 'aset identlist 3 file)) +(defmacro ada-set-ali-index (identlist index) (list 'aset identlist 4 index)) +(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file)) +(defmacro ada-set-references (identlist ref) (list 'aset identlist 6 ref)) +(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value)) + +(defsubst ada-get-ali-buffer (file) + "Reads the ali file into a new buffer, and returns this buffer's name" + (find-file-noselect (ada-get-ali-file-name file))) + + +;; ----------------------------------------------------------------------- -(defun ada-initialize-runtime-library () - "Initializes the variables for the runtime library location." +(defun ada-quote-cmd (cmd) + "Duplicate all \\ characters in CMD so that it can be passed to `compile'." + (mapconcat 'identity (split-string cmd "\\\\") "\\\\")) + +(defun ada-initialize-runtime-library (cross-prefix) + "Initialize the variables for the runtime library location. +CROSS-PREFIX is the prefix to use for the gnatls command." (save-excursion - (set 'ada-xref-runtime-library-specs-path '()) - (set 'ada-xref-runtime-library-ali-path '()) + (setq ada-xref-runtime-library-specs-path '() + ada-xref-runtime-library-ali-path '()) (set-buffer (get-buffer-create "*gnatls*")) (widen) (erase-buffer) @@ -203,16 +262,18 @@ Getting the project is done by looking up the key in ada-pxref-project-file.") ;; Even if we get an error, delete the *gnatls* buffer (unwind-protect (progn - (call-process "gnatls" nil t nil "-v") + (apply 'call-process (concat cross-prefix "gnatls") + (append '(nil t nil) ada-gnatls-args)) (goto-char (point-min)) ;; Source path - + (search-forward "Source Search Path:") (forward-line 1) (while (not (looking-at "^$")) (back-to-indentation) - (unless (looking-at "") + (if (looking-at "") + (add-to-list 'ada-xref-runtime-library-specs-path ".") (add-to-list 'ada-xref-runtime-library-specs-path (buffer-substring-no-properties (point) @@ -220,12 +281,13 @@ Getting the project is done by looking up the key in ada-pxref-project-file.") (forward-line 1)) ;; Object path - + (search-forward "Object Search Path:") (forward-line 1) (while (not (looking-at "^$")) (back-to-indentation) - (unless (looking-at "") + (if (looking-at "") + (add-to-list 'ada-xref-runtime-library-ali-path ".") (add-to-list 'ada-xref-runtime-library-ali-path (buffer-substring-no-properties (point) @@ -245,23 +307,34 @@ Getting the project is done by looking up the key in ada-pxref-project-file.") "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value. The project file must have been loaded first. As a special case, ${current} is replaced with the name of the currently -edited file, minus extension but with directory." +edited file, minus extension but with directory, and ${full_current} is +replaced by the name including the extension." (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string) - (let (value) - (if (string= (match-string 2 cmd-string) "current") - (set 'value (file-name-sans-extension (buffer-file-name))) + (let (value + (name (match-string 2 cmd-string))) + (cond + ((string= name "current") + (setq value (file-name-sans-extension (buffer-file-name)))) + ((string= name "full_current") + (setq value (buffer-file-name))) + (t (save-match-data - (set 'value (ada-xref-get-project-field - (intern (match-string 2 cmd-string)))))) + (setq value (ada-xref-get-project-field (intern name)))))) + + ;; Check if there is an environment variable with the same name + (if (null value) + (if (not (setq value (getenv name))) + (message (concat "No environment variable " name " found")))) + (cond ((null value) - (set 'cmd-string (replace-match "" t t cmd-string))) + (setq cmd-string (replace-match "" t t cmd-string))) ((stringp value) - (set 'cmd-string (replace-match value t t cmd-string))) + (setq cmd-string (replace-match value t t cmd-string))) ((listp value) (let ((prefix (match-string 1 cmd-string))) - (set 'cmd-string (replace-match + (setq cmd-string (replace-match (mapconcat (lambda(x) (concat prefix x)) value " ") t t cmd-string))))) )) @@ -274,22 +347,21 @@ edited file, minus extension but with directory." plist) (save-excursion (set-buffer ada-buffer) - + (set 'plist ;; Try hard to find a default value for filename, so that the user ;; can edit his project file even if the current buffer is not an ;; Ada file or not even associated with a file - (list 'filename (cond - (file - (ada-prj-get-prj-dir file)) - (ada-prj-prj-file - ada-prj-prj-file) - (ada-xref-default-prj-file - ada-xref-default-prj-file) - (t - (error (concat "Not editing an Ada file," - "and no default project " - "file specified!")))) + (list 'filename (expand-file-name + (cond + (ada-prj-default-project-file + ada-prj-default-project-file) + (file (ada-prj-find-prj-file file t)) + (t + (message (concat "Not editing an Ada file," + "and no default project " + "file specified!")) + ""))) 'build_dir (file-name-as-directory (expand-file-name ".")) 'src_dir (list ".") 'obj_dir (list ".") @@ -300,8 +372,10 @@ edited file, minus extension but with directory." 'bind_opt ada-prj-default-bind-opt 'link_opt ada-prj-default-link-opt 'gnatmake_opt ada-prj-default-gnatmake-opt + 'gnatfind_opt ada-prj-gnatfind-switches 'main (if file - (file-name-sans-extension file) + (file-name-nondirectory + (file-name-sans-extension file)) "") 'main_unit (if file (file-name-nondirectory @@ -309,37 +383,40 @@ edited file, minus extension but with directory." "") 'cross_prefix "" 'remote_machine "" - 'comp_cmd (concat "cd ${build_dir} && " - ada-prj-default-comp-cmd) - 'check_cmd (concat ada-prj-default-comp-cmd " " - ada-check-switch) - 'make_cmd (concat "cd ${build_dir} && " - ada-prj-default-make-cmd) - 'run_cmd (concat "cd ${build_dir} && ${main}" - (if is-windows ".exe")) + 'comp_cmd (list (concat ada-cd-command " ${build_dir}") + ada-prj-default-comp-cmd) + 'check_cmd (list (concat ada-prj-default-comp-cmd " " + ada-check-switch)) + 'make_cmd (list (concat ada-cd-command " ${build_dir}") + ada-prj-default-make-cmd) + 'run_cmd (list (concat ada-cd-command " ${build_dir}") + (concat "${main}" + (if is-windows ".exe"))) + 'debug_pre_cmd (list (concat ada-cd-command + " ${build_dir}")) 'debug_cmd (concat ada-prj-default-debugger (if is-windows " ${main}.exe" - " ${main}")))) + " ${main}")) + 'debug_post_cmd (list nil))) ) (set symbol plist))) - + (defun ada-xref-get-project-field (field) - "Extract the value of FIELD from the project file of the current buffer. + "Extract the value of FIELD from the current project file. The project file must have been loaded first. -A default value is returned if the file was not found." +A default value is returned if the file was not found. + +Note that for src_dir and obj_dir, you should rather use +`ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' which will in +addition return the default paths." - (let ((file-name ada-prj-prj-file) + (let ((file-name ada-prj-default-project-file) file value) - ;; If a default project file was set, use it if no other project - ;; file was specified for the buffer - (if (and (not file-name) - 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)) - + ;; Get the project file (either the current one, or a default one) + (setq file (or (assoc file-name ada-xref-project-files) + (assoc nil ada-xref-project-files))) + ;; If the file was not found, use the default values (if file ;; Get the value from the file @@ -348,214 +425,147 @@ A default value is returned if the file was not found." ;; Create a default nil file that contains the default values (ada-xref-set-default-prj-values 'value (current-buffer)) (add-to-list 'ada-xref-project-files (cons nil value)) + (ada-xref-update-project-menu) (set 'value (plist-get value field)) ) - (if (stringp value) - (ada-treat-cmd-string value) - value)) - ) -;; ----- Keybindings ------------------------------------------------------ + ;; Substitute the ${...} constructs in all the strings, including + ;; inside lists + (cond + ((stringp value) + (ada-treat-cmd-string value)) + ((null value) + nil) + ((listp value) + (mapcar (lambda(x) (if x (ada-treat-cmd-string x) x)) value)) + (t + value) + ) + )) -(defun ada-add-keymap () - "Add new key bindings when using `ada-xrel.el'." - (interactive) - (if ada-xemacs - (progn - (define-key ada-mode-map '(shift button3) 'ada-point-and-xref) - (define-key ada-mode-map '(control tab) 'ada-complete-identifier)) - (define-key ada-mode-map [C-tab] 'ada-complete-identifier) - (define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref)) - - (define-key ada-mode-map "\C-co" 'ff-find-other-file) - (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame) - (define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration) - (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference) - (define-key ada-mode-map "\C-c\C-x" 'ada-reread-prj-file) - (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application) - (define-key ada-mode-map "\C-cb" 'ada-buffer-list) - (define-key ada-mode-map "\C-cc" 'ada-change-prj) - (define-key ada-mode-map "\C-cd" 'ada-change-default-prj) - (define-key ada-mode-map "\C-cg" 'ada-gdb-application) - (define-key ada-mode-map "\C-cr" 'ada-run-application) - (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent) - (define-key ada-mode-map "\C-c\C-r" 'ada-find-references) - (define-key ada-mode-map "\C-c\C-v" 'ada-check-current) - ) -;; ----- Menus -------------------------------------------------------------- -(defun ada-add-ada-menu () - "Add some items to the standard Ada mode menu. -The items are added to the menu called NAME, which should be the same -name as was passed to `ada-create-menu'." - (interactive) - (if ada-xemacs - (let* ((menu-list '("Ada")) - (goto-menu '("Ada" "Goto")) - (edit-menu '("Ada" "Edit")) - (help-menu '("Ada" "Help")) - (options-menu (list "Ada" "Options"))) - (funcall (symbol-function 'add-menu-button) - menu-list ["Check file" ada-check-current - (string= mode-name "Ada")] "Goto") - (funcall (symbol-function 'add-menu-button) - menu-list ["Compile file" ada-compile-current - (string= mode-name "Ada")] "Goto") - (funcall (symbol-function 'add-menu-button) - menu-list ["Build" ada-compile-application t] "Goto") - (funcall (symbol-function 'add-menu-button) - menu-list ["Run" ada-run-application t] "Goto") - (funcall (symbol-function 'add-menu-button) - menu-list ["Debug" ada-gdb-application t] "Goto") - (funcall (symbol-function 'add-menu-button) - 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") - (funcall (symbol-function 'add-menu-button) - goto-menu ["Goto Parent Unit" ada-goto-parent t] - "Next compilation error") - (funcall (symbol-function 'add-menu-button) - goto-menu ["Goto References to any entity" - ada-find-any-references t] - "Next compilation error") - (funcall (symbol-function 'add-menu-button) - goto-menu ["List References" ada-find-references t] - "Next compilation error") - (funcall (symbol-function 'add-menu-button) - goto-menu ["Goto Declaration Other Frame" - ada-goto-declaration-other-frame t] - "Next compilation error") - (funcall (symbol-function 'add-menu-button) - goto-menu ["Goto Declaration/Body" - ada-goto-declaration t] - "Next compilation error") - (funcall (symbol-function 'add-menu-button) - goto-menu ["Goto Previous Reference" - ada-xref-goto-previous-reference t] - "Next compilation error") - (funcall (symbol-function 'add-menu-button) - goto-menu ["--" nil t] "Next compilation error") - (funcall (symbol-function 'add-menu-button) - edit-menu ["Complete Identifier" - ada-complete-identifier t] - "Indent Line") - (funcall (symbol-function 'add-menu-button) - edit-menu ["--------" nil t] "Indent Line") - (funcall (symbol-function 'add-menu-button) - help-menu ["Gnat User Guide" (info "gnat_ug")]) - (funcall (symbol-function 'add-menu-button) - help-menu ["Gnat Reference Manual" (info "gnat_rm")]) - (funcall (symbol-function 'add-menu-button) - help-menu ["Gcc Documentation" (info "gcc")]) - (funcall (symbol-function 'add-menu-button) - help-menu ["Gdb Documentation" (info "gdb")]) - (funcall (symbol-function 'add-menu-button) - help-menu ["Ada95 Reference Manual" (info "arm95")]) - (funcall (symbol-function 'add-menu-button) - options-menu - ["Show Cross-References in Other Buffer" - (setq ada-xref-other-buffer - (not ada-xref-other-buffer)) - :style toggle :selected ada-xref-other-buffer]) - (funcall (symbol-function 'add-menu-button) - options-menu - ["Automatically Recompile for Cross-References" - (setq ada-xref-create-ali (not ada-xref-create-ali)) - :style toggle :selected ada-xref-create-ali]) - (funcall (symbol-function 'add-menu-button) - options-menu - ["Confirm Commands" - (setq ada-xref-confirm-compile - (not ada-xref-confirm-compile)) - :style toggle :selected ada-xref-confirm-compile]) - ) - - ;; for Emacs - (let* ((menu (lookup-key ada-mode-map [menu-bar Ada])) - (edit-menu (lookup-key ada-mode-map [menu-bar Ada Edit])) - (help-menu (lookup-key ada-mode-map [menu-bar Ada Help])) - (goto-menu (lookup-key ada-mode-map [menu-bar Ada Goto])) - (options-menu (lookup-key ada-mode-map [menu-bar Ada Options]))) - - (define-key-after menu [Check] '("Check file" . ada-check-current) - 'Customize) - (define-key-after menu [Compile] '("Compile file" . ada-compile-current) - 'Check) - (define-key-after menu [Build] '("Build" . ada-compile-application) - 'Compile) - (define-key-after menu [Run] '("Run" . ada-run-application) 'Build) - (define-key-after menu [Debug] '("Debug" . ada-gdb-application) 'Run) - (define-key-after menu [rem] '("--" . nil) 'Debug) - (define-key-after menu [Project] - (cons "Project" - (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) - - (define-key help-menu [Gnat_ug] - '("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug")))) - (define-key help-menu [Gnat_rm] - '("Gnat Reference Manual" . (lambda() (interactive) (info "gnat_rm")))) - (define-key help-menu [Gcc] - '("Gcc Documentation" . (lambda() (interactive) (info "gcc")))) - (define-key help-menu [gdb] - '("Gdb Documentation" . (lambda() (interactive) (info "gdb")))) - (define-key help-menu [gdb] - '("Ada95 Reference Manual" . (lambda() (interactive) (info "arm95")))) - - (define-key goto-menu [rem] '("----" . nil)) - (define-key goto-menu [Parent] '("Goto Parent Unit" - . ada-goto-parent)) - (define-key goto-menu [References-any] - '("Goto References to any entity" . ada-find-any-references)) - (define-key goto-menu [References] - '("List References" . ada-find-references)) - (define-key goto-menu [Prev] - '("Goto Previous Reference" . ada-xref-goto-previous-reference)) - (define-key goto-menu [Decl-other] - '("Goto Declaration Other Frame" . ada-goto-declaration-other-frame)) - (define-key goto-menu [Decl] - '("Goto Declaration/Body" . ada-goto-declaration)) - - (define-key edit-menu [rem] '("----" . nil)) - (define-key edit-menu [Complete] '("Complete Identifier" - . ada-complete-identifier)) - - (define-key-after options-menu [xrefrecompile] - '(menu-item "Automatically Recompile for Cross-References" - (lambda()(interactive) - (setq ada-xref-create-ali (not ada-xref-create-ali))) - :button (:toggle . ada-xref-create-ali)) t) - (define-key-after options-menu [xrefconfirm] - '(menu-item "Confirm Commands" - (lambda()(interactive) - (setq ada-xref-confirm-compile - (not ada-xref-confirm-compile))) - :button (:toggle . ada-xref-confirm-compile)) t) - (define-key-after options-menu [xrefother] - '(menu-item "Show Cross-References in Other Buffer" - (lambda()(interactive) - (setq ada-xref-other-buffer (not ada-xref-other-buffer))) - :button (:toggle . ada-xref-other-buffer)) t) - ) - ) - ) +(defun ada-xref-get-src-dir-field () + "Return the full value for src_dir, including the default directories. +All the directories are returned as absolute directories." + + (let ((build-dir (ada-xref-get-project-field 'build_dir))) + (append + ;; Add ${build_dir} in front of the path + (list build-dir) + + (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) + build-dir) + + ;; Add the standard runtime at the end + ada-xref-runtime-library-specs-path))) + +(defun ada-xref-get-obj-dir-field () + "Return the full value for obj_dir, including the default directories. +All the directories are returned as absolute directories." + + (let ((build-dir (ada-xref-get-project-field 'build_dir))) + (append + ;; Add ${build_dir} in front of the path + (list build-dir) + + (ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir) + build-dir) + + ;; Add the standard runtime at the end + ada-xref-runtime-library-ali-path))) + +(defun ada-xref-update-project-menu () + "Update the menu Ada->Project, with the list of available project files." + ;; Create the standard items. + (let ((submenu + `("Project" + ["Load..." ada-set-default-project-file t] + ["New..." ada-prj-new t] + ["Edit..." ada-prj-edit t] + "---" + ;; Add the new items + ,@(mapcar + (lambda (x) + (let ((name (or (car x) "")) + (command `(lambda () + "Change the active project file." + (interactive) + (ada-parse-prj-file ,(car x)) + (set 'ada-prj-default-project-file ,(car x)) + (ada-xref-update-project-menu)))) + (vector + (if (string= (file-name-extension name) + ada-project-file-extension) + (file-name-sans-extension + (file-name-nondirectory name)) + (file-name-nondirectory name)) + command + :button (cons + :toggle + (equal ada-prj-default-project-file + (car x)) + )))) + + ;; Parses all the known project files, and insert at + ;; least the default one (in case + ;; ada-xref-project-files is nil) + (or ada-xref-project-files '(nil)))))) + + (easy-menu-add-item ada-mode-menu '() submenu))) + + +;;------------------------------------------------------------- +;;-- Searching a file anywhere on the source path. +;;-- +;;-- The following functions provide support for finding a file anywhere +;;-- on the source path, without providing an explicit directory. +;;-- They also provide file name completion in the minibuffer. +;;-- +;;-- Public subprograms: ada-find-file +;;-- +;;------------------------------------------------------------- + +(defun ada-do-file-completion (string predicate flag) + "Completion function when reading a file from the minibuffer. +Completion is attempted in all the directories in the source path, as +defined in the project file." + (let (list + (dirs (ada-xref-get-src-dir-field))) + + (while dirs + (if (file-directory-p (car dirs)) + (set 'list (append list (file-name-all-completions string (car dirs))))) + (set 'dirs (cdr dirs))) + (cond ((equal flag 'lambda) + (assoc string list)) + (flag + list) + (t + (try-completion string + (mapcar (lambda (x) (cons x 1)) list) + predicate))))) + +;;;###autoload +(defun ada-find-file (filename) + "Open a file anywhere in the source path. +Completion is available." + (interactive + (list (completing-read "File: " 'ada-do-file-completion))) + (let ((file (ada-find-src-file-in-dir filename))) + (if file + (find-file file) + (error (concat filename " not found in src_dir"))))) + ;; ----- Utilities ------------------------------------------------- (defun ada-require-project-file () - "If no project file is assigned to this buffer, load one." - (if (not (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))) + "If no project file is currently active, load a default one." + (if (or (not ada-prj-default-project-file) + (not ada-xref-project-files) + (string= ada-prj-default-project-file "")) (ada-reread-prj-file))) - + (defun ada-xref-push-pos (filename position) "Push (FILENAME, POSITION) on the position ring for cross-references." (setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring)) @@ -576,120 +586,110 @@ name as was passed to `ada-create-menu'." This is overriden on VMS to convert from VMS filenames to Unix filenames." name) -(defun ada-set-default-project-file (name) - "Set the file whose name is NAME as the default project file." +(defun ada-set-default-project-file (name &optional keep-existing) + "Set the file whose name is NAME as the default project file. +If KEEP-EXISTING is true and a project file has already been loaded, nothing +is done. This is meant to be used from `ada-mode-hook', for instance, to force +a project file unless the user has already loaded one." (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) - - (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) - - (ada-reread-prj-file name) - ) + (if (or (not keep-existing) + (not ada-prj-default-project-file) + (equal ada-prj-default-project-file "")) + (progn + (setq ada-prj-default-project-file name) + (ada-reread-prj-file name)))) ;; ------ Handling the project file ----------------------------- -(defun ada-prj-find-prj-file (&optional no-user-question) - "Find the prj file associated with the current buffer. +(defun ada-prj-find-prj-file (&optional file no-user-question) + "Find the prj file associated with FILE (or the current buffer if nil). If NO-USER-QUESTION is non-nil, use a default file if not project file was found, and do not ask the user. If the buffer is not an Ada buffer, associate it with the default project -file. If none is set, return nil." +file. If none is set, return nil." (let (selected) - ;; If we don't have an ada buffer, or the current buffer is not - ;; a real file (for instance an emerge buffer) - + ;; Use the active project file if there is one. + ;; This is also valid if we don't currently have an Ada buffer, or if + ;; the current buffer is not a real file (for instance an emerge buffer) + (if (or (not (string= mode-name "Ada")) (not (buffer-file-name))) - ;; 1st case: not an Ada buffer (if (and ada-prj-default-project-file (not (string= ada-prj-default-project-file ""))) - (set 'selected ada-prj-default-project-file)) - - ;; 2nd case: If the buffer already has a project file, use it - (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)) - (set 'selected ada-prj-prj-file) - - (let* ((current-file (buffer-file-name)) - (first-choice (concat - (file-name-sans-extension current-file) - ada-project-file-extension)) - (dir (file-name-directory current-file)) - - ;; on Emacs 20.2, directory-files does not work if - ;; parse-sexp-lookup-properties is set - (parse-sexp-lookup-properties nil) - (prj-files (directory-files - dir t - (concat ".*" (regexp-quote ada-project-file-extension) "$"))) - (choice nil) - (default (assoc dir ada-xref-default-prj-file))) - - (cond - - ;; 3rd case: a project file is already associated with the directory - (default - (set 'selected (cdr default))) - - ;; 4th case: the user has set a default project file for every file - ((and ada-prj-default-project-file - (not (string= ada-prj-default-project-file ""))) - (set 'selected ada-prj-default-project-file)) - - ;; 5th case: there is a project file with the same name as the Ada file, - ;; but not the same extension. - ((file-exists-p first-choice) - (set 'selected first-choice)) - - ;; 6th case: only one project file was found in the current directory - ((= (length prj-files) 1) - (set 'selected (car prj-files))) - - ;; 7th case: if there are multiple files, ask the user - ((and (> (length prj-files) 1) (not no-user-question)) - (save-window-excursion - (with-output-to-temp-buffer "*choice list*" - (princ "There are more than one possible project file. Which one should\n") - (princ "be used ?\n\n") - (princ " no. file name \n") - (princ " --- ------------------------\n") - (let ((counter 1)) - (while (<= counter (length prj-files)) - (princ (format " %2d) %s\n" - counter - (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)))) - )))) - selected + (setq selected ada-prj-default-project-file) + (setq selected nil)) + + ;; other cases: use a more complex algorithm + + (let* ((current-file (or file (buffer-file-name))) + (first-choice (concat + (file-name-sans-extension current-file) + ada-project-file-extension)) + (dir (file-name-directory current-file)) + + ;; on Emacs 20.2, directory-files does not work if + ;; parse-sexp-lookup-properties is set + (parse-sexp-lookup-properties nil) + (prj-files (directory-files + dir t + (concat ".*" (regexp-quote + ada-project-file-extension) "$"))) + (choice nil)) + + (cond + + ;; Else if there is a project file with the same name as the Ada + ;; file, but not the same extension. + ((file-exists-p first-choice) + (set 'selected first-choice)) + + ;; Else if only one project file was found in the current directory + ((= (length prj-files) 1) + (set 'selected (car prj-files))) + + ;; Else if there are multiple files, ask the user + ((and (> (length prj-files) 1) (not no-user-question)) + (save-window-excursion + (with-output-to-temp-buffer "*choice list*" + (princ "There are more than one possible project file.\n") + (princ "Which one should we use ?\n\n") + (princ " no. file name \n") + (princ " --- ------------------------\n") + (let ((counter 1)) + (while (<= counter (length prj-files)) + (princ (format " %2d) %s\n" + counter + (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)))) + + ;; Else if 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 + (concat "project file [" ada-last-prj-file "]:") + nil ada-last-prj-file)) + (unless (string= ada-last-prj-file "") + (set 'selected ada-last-prj-file)))) + ))) + + (or selected "default.adp") )) @@ -697,93 +697,156 @@ file. If none is set, return nil." "Reads and parses the PRJ-FILE file if it was found. The current buffer should be the ada-file buffer." (if prj-file - (let (project src_dir obj_dir casing + (let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing + run_cmd debug_pre_cmd debug_post_cmd (ada-buffer (current-buffer))) - (set 'prj-file (expand-file-name prj-file)) + (setq prj-file (expand-file-name prj-file)) + + ;; Set the project file as the active one. + (setq ada-prj-default-project-file prj-file) ;; Initialize the project with the default values (ada-xref-set-default-prj-values 'project (current-buffer)) ;; Do not use find-file below, since we don't want to show this - ;; buffer. If the file is open through speedbar, we can't use + ;; buffer. If the file is open through speedbar, we can't use ;; find-file anyway, since the speedbar frame is special and does not ;; allow the selection of a file in it. - (set-buffer (find-file-noselect prj-file)) - - (widen) - (goto-char (point-min)) - - ;; Now overrides these values with the project file - (while (not (eobp)) - (if (looking-at "^\\([^=]+\\)=\\(.*\\)") - (cond - ((string= (match-string 1) "src_dir") - (add-to-list 'src_dir - (file-name-as-directory (match-string 2)))) - ((string= (match-string 1) "obj_dir") - (add-to-list 'obj_dir - (file-name-as-directory (match-string 2)))) - ((string= (match-string 1) "casing") - (set 'casing (cons (match-string 2) casing))) - ((string= (match-string 1) "build_dir") - (set 'project - (plist-put project 'build_dir - (file-name-as-directory (match-string 2))))) - (t - (set 'project (plist-put project (intern (match-string 1)) - (match-string 2)))))) - (forward-line 1)) - - (if src_dir (set 'project (plist-put project 'src_dir - (reverse src_dir)))) - (if obj_dir (set 'project (plist-put project 'obj_dir - (reverse obj_dir)))) - (if casing (set 'project (plist-put project 'casing casing))) + (if (file-exists-p prj-file) + (progn + (let* ((buffer (run-hook-with-args-until-success + 'ada-load-project-hook prj-file))) + (unless buffer + (setq buffer (find-file-noselect prj-file nil))) + (set-buffer buffer)) + + (widen) + (goto-char (point-min)) + + ;; Now overrides these values with the project file + (while (not (eobp)) + (if (looking-at "^\\([^=]+\\)=\\(.*\\)") + (cond + ((string= (match-string 1) "src_dir") + (add-to-list 'src_dir + (file-name-as-directory (match-string 2)))) + ((string= (match-string 1) "obj_dir") + (add-to-list 'obj_dir + (file-name-as-directory (match-string 2)))) + ((string= (match-string 1) "casing") + (set 'casing (cons (match-string 2) casing))) + ((string= (match-string 1) "build_dir") + (set 'project + (plist-put project 'build_dir + (file-name-as-directory (match-string 2))))) + ((string= (match-string 1) "make_cmd") + (add-to-list 'make_cmd (match-string 2))) + ((string= (match-string 1) "comp_cmd") + (add-to-list 'comp_cmd (match-string 2))) + ((string= (match-string 1) "check_cmd") + (add-to-list 'check_cmd (match-string 2))) + ((string= (match-string 1) "run_cmd") + (add-to-list 'run_cmd (match-string 2))) + ((string= (match-string 1) "debug_pre_cmd") + (add-to-list 'debug_pre_cmd (match-string 2))) + ((string= (match-string 1) "debug_post_cmd") + (add-to-list 'debug_post_cmd (match-string 2))) + (t + (set 'project (plist-put project (intern (match-string 1)) + (match-string 2)))))) + (forward-line 1)) + + (if src_dir (set 'project (plist-put project 'src_dir + (reverse src_dir)))) + (if obj_dir (set 'project (plist-put project 'obj_dir + (reverse obj_dir)))) + (if casing (set 'project (plist-put project 'casing + (reverse casing)))) + (if make_cmd (set 'project (plist-put project 'make_cmd + (reverse make_cmd)))) + (if comp_cmd (set 'project (plist-put project 'comp_cmd + (reverse comp_cmd)))) + (if check_cmd (set 'project (plist-put project 'check_cmd + (reverse check_cmd)))) + (if run_cmd (set 'project (plist-put project 'run_cmd + (reverse run_cmd)))) + (set 'project (plist-put project 'debug_post_cmd + (reverse debug_post_cmd))) + (set 'project (plist-put project 'debug_pre_cmd + (reverse debug_pre_cmd))) + + ;; Kill the project buffer + (kill-buffer nil) + (set-buffer ada-buffer) + ) + + ;; Else the file wasn't readable (probably the default project). + ;; We initialize it with the current environment variables. + ;; We need to add the startup directory in front so that + ;; files locally redefined are properly found. We cannot + ;; add ".", which varies too much depending on what the + ;; current buffer is. + (set 'project + (plist-put project 'src_dir + (append + (list command-line-default-directory) + (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":") + (list "." default-directory)))) + (set 'project + (plist-put project 'obj_dir + (append + (list command-line-default-directory) + (split-string (or (getenv "ADA_OBJECTS_PATH") "") ":") + (list "." default-directory)))) + ) + + + ;; Delete the default project file from the list, if it is there. + ;; Note that in that case, this default project is the only one in + ;; the list + (if (assoc nil ada-xref-project-files) + (setq ada-xref-project-files nil)) ;; Memorize the newly read project file (if (assoc prj-file ada-xref-project-files) (setcdr (assoc prj-file ada-xref-project-files) project) (add-to-list 'ada-xref-project-files (cons prj-file project))) - + ;; Sets up the compilation-search-path so that Emacs is able to ;; go to the source of the errors in a compilation buffer - (setq compilation-search-path (ada-get-absolute-dir-list - (plist-get project 'src_dir) - (plist-get project 'build_dir))) - - ;; Associate each source directory in the project file with this file - (mapcar (lambda (x) - (if (not (assoc (expand-file-name x) - 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) - + (setq compilation-search-path (ada-xref-get-src-dir-field)) + + ;; Set the casing exceptions file list + (if casing + (progn + (setq ada-case-exception-file (reverse casing)) + (ada-case-read-exceptions))) + ;; Add the directories to the search path for ff-find-other-file ;; Do not add the '/' or '\' at the end - (set (make-local-variable 'ff-search-directories) + (setq ada-search-directories-internal (append (mapcar 'directory-file-name compilation-search-path) ada-search-directories)) - - ;; Kill the .ali buffer - (kill-buffer nil) - (set-buffer ada-buffer) - - ;; Setup the project file for the current buffer - (set (make-local-variable 'ada-prj-prj-file) prj-file) + (ada-xref-update-project-menu) ) + + ;; No prj file ? => Setup default values + ;; Note that nil means that all compilation modes will first look in the + ;; current directory, and only then in the current file's directory. This + ;; current file is assumed at this point to be in the common source + ;; directory. + (setq compilation-search-path (list nil default-directory)) )) - - -(defun ada-find-references (&optional pos) + + +(defun ada-find-references (&optional pos arg local-only) "Find all references to the entity under POS. -Calls gnatfind to find the references." - (interactive "") - (unless pos - (set 'pos (point))) +Calls gnatfind to find the references. +If ARG is t, the contents of the old *gnatfind* buffer is preserved. +If LOCAL-ONLY is t, only the declarations in the current file are returned." + (interactive "d\nP") (ada-require-project-file) (let* ((identlist (ada-read-identifier pos)) @@ -797,149 +860,86 @@ Calls gnatfind to find the references." (file-newer-than-file-p (ada-file-of identlist) alifile)) (ada-find-any-references (ada-name-of identlist) (ada-file-of identlist) - nil nil) + nil nil local-only arg) (ada-find-any-references (ada-name-of identlist) (ada-file-of identlist) (ada-line-of identlist) - (ada-column-of identlist)))) + (ada-column-of identlist) local-only arg))) ) -(defun ada-find-any-references (entity &optional file line column) +(defun ada-find-local-references (&optional pos arg) + "Find all references to the entity under POS. +Calls `gnatfind' to find the references. +If ARG is t, the contents of the old *gnatfind* buffer is preserved." + (interactive "d\nP") + (ada-find-references pos arg t)) + +(defun ada-find-any-references + (entity &optional file line column local-only append) "Search for references to any entity whose name is ENTITY. -ENTITY was first found the location given by FILE, LINE and COLUMN." +ENTITY was first found the location given by FILE, LINE and COLUMN. +If LOCAL-ONLY is t, then list only the references in FILE, which +is much faster. +If APPEND is t, then append the output of the command to the existing +buffer `*gnatfind*', if there is one." (interactive "sEntity name: ") (ada-require-project-file) - (let* ((command (concat "gnatfind -rf " entity + ;; Prepare the gnatfind command. Note that we must protect the quotes + ;; around operators, so that they are correctly handled and can be + ;; processed (gnatfind \"+\":...). + (let* ((quote-entity + (if (= (aref entity 0) ?\") + (if is-windows + (concat "\\\"" (substring entity 1 -1) "\\\"") + (concat "'\"" (substring entity 1 -1) "\"'")) + entity)) + (switches (ada-xref-get-project-field 'gnatfind_opt)) + (command (concat "gnat find " switches " " + quote-entity (if file (concat ":" (file-name-nondirectory file))) (if line (concat ":" line)) - (if column (concat ":" column))))) + (if column (concat ":" column)) + (if local-only (concat " " (file-name-nondirectory file))) + )) + old-contents) ;; If a project file is defined, use it - (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)) - (setq command (concat command " -p" ada-prj-prj-file))) + (if (and ada-prj-default-project-file + (not (string= ada-prj-default-project-file ""))) + (if (string-equal (file-name-extension ada-prj-default-project-file) + "gpr") + (setq command (concat command " -P" ada-prj-default-project-file)) + (setq command (concat command " -p" ada-prj-default-project-file)))) - (compile-internal command "No more references" "gnatfind") + (if (and append (get-buffer "*gnatfind*")) + (save-excursion + (set-buffer "*gnatfind*") + (setq old-contents (buffer-string)))) + + (let ((compilation-error "reference")) + (compilation-start command)) ;; Hide the "Compilation" menu (save-excursion (set-buffer "*gnatfind*") - (local-unset-key [menu-bar compilation-menu])) - ) - ) - -(defun ada-buffer-list () - "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:") + (local-unset-key [menu-bar compilation-menu]) - ;; 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) + (if old-contents + (progn + (goto-char 1) + (insert old-contents) + (goto-char (point-max))))) + ) ) -(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))) - - -;; ----- Identlist manipulation ------------------------------------------- -;; An identlist is a vector that is used internally to reference an identifier -;; To facilitate its use, we provide the following macros - -(defmacro ada-make-identlist () (make-vector 8 nil)) -(defmacro ada-name-of (identlist) (list 'aref identlist 0)) -(defmacro ada-line-of (identlist) (list 'aref identlist 1)) -(defmacro ada-column-of (identlist) (list 'aref identlist 2)) -(defmacro ada-file-of (identlist) (list 'aref identlist 3)) -(defmacro ada-ali-index-of (identlist) (list 'aref identlist 4)) -(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5)) -(defmacro ada-references-of (identlist) (list 'aref identlist 6)) -(defmacro ada-on-declaration (identlist) (list 'aref identlist 7)) - -(defmacro ada-set-name (identlist name) (list 'aset identlist 0 name)) -(defmacro ada-set-line (identlist line) (list 'aset identlist 1 line)) -(defmacro ada-set-column (identlist col) (list 'aset identlist 2 col)) -(defmacro ada-set-file (identlist file) (list 'aset identlist 3 file)) -(defmacro ada-set-ali-index (identlist index) (list 'aset identlist 4 index)) -(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file)) -(defmacro ada-set-references (identlist ref) (list 'aset identlist 6 ref)) -(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value)) - -(defsubst ada-get-ali-buffer (file) - "Reads the ali file into a new buffer, and returns this buffer's name" - (find-file-noselect (ada-get-ali-file-name file))) - - +(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file)) ;; ----- Identifier Completion -------------------------------------------- (defun ada-complete-identifier (pos) "Tries to complete the identifier around POS. -The feature is only available if the files where compiled not using the -gnatx -option." +The feature is only available if the files where compiled without +the option `-gnatx'." (interactive "d") (ada-require-project-file) @@ -977,29 +977,65 @@ option." ;; ----- Cross-referencing ---------------------------------------- (defun ada-point-and-xref () - "Calls `mouse-set-point' and then `ada-goto-declaration'." + "Jump to the declaration of the entity below the cursor." (interactive) (mouse-set-point last-input-event) (ada-goto-declaration (point))) -(defun ada-goto-declaration (pos) +(defun ada-point-and-xref-body () + "Jump to the body of the entity under the cursor." + (interactive) + (mouse-set-point last-input-event) + (ada-goto-body (point))) + +(defun ada-goto-body (pos &optional other-frame) + "Display the body of the entity around POS. +If the entity doesn't have a body, display its declaration. +As a side effect, the buffer for the declaration is also open." + (interactive "d") + (ada-goto-declaration pos other-frame) + + ;; Temporarily force the display in the same buffer, since we + ;; already changed previously + (let ((ada-xref-other-buffer nil)) + (ada-goto-declaration (point) nil))) + +(defun ada-goto-declaration (pos &optional other-frame) "Display the declaration of the identifier around POS. The declaration is shown in another buffer if `ada-xref-other-buffer' is -non-nil." +non-nil. +If OTHER-FRAME is non-nil, display the cross-reference in another frame." (interactive "d") (ada-require-project-file) (push-mark pos) (ada-xref-push-pos (buffer-file-name) pos) - (ada-find-in-ali (ada-read-identifier pos))) + + ;; First try the standard algorithm by looking into the .ali file, but if + ;; that file was too old or even did not exist, try to look in the whole + ;; object path for a possible location. + (let ((identlist (ada-read-identifier pos))) + (condition-case nil + (ada-find-in-ali identlist other-frame) + (error + (let ((ali-file (ada-get-ali-file-name (ada-file-of identlist)))) + + ;; If the ALI file was up-to-date, then we probably have a predefined + ;; entity, whose references are not given by GNAT + (if (and (file-exists-p ali-file) + (file-newer-than-file-p ali-file (ada-file-of identlist))) + (message "No cross-reference found--may be a predefined entity.") + + ;; Else, look in every ALI file, except if the user doesn't want that + (if ada-xref-search-with-egrep + (ada-find-in-src-path identlist other-frame) + (message "Cross-referencing information is not up-to-date; please recompile.") + ))))))) (defun ada-goto-declaration-other-frame (pos) "Display the declaration of the identifier around POS. The declation is shown in another frame if `ada-xref-other-buffer' is non-nil." (interactive "d") - (ada-require-project-file) - (push-mark pos) - (ada-xref-push-pos (buffer-file-name) pos) - (ada-find-in-ali (ada-read-identifier pos) t)) + (ada-goto-declaration pos t)) (defun ada-remote (command) "Return the remote version of COMMAND, or COMMAND if remote_machine is nil." @@ -1011,46 +1047,40 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil." machine command)))) -(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))) - (defun ada-get-absolute-dir-list (dir-list root-dir) "Returns the list of absolute directories found in dir-list. -If a directory is a relative directory, the value of ROOT-DIR is added in -front." - (mapcar (lambda (x) (ada-get-absolute-dir x root-dir)) dir-list)) +If a directory is a relative directory, add the value of ROOT-DIR in front." + (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list)) (defun ada-set-environment () - "Return the new value for process-environment. + "Prepare an environment for Ada compilation. +This returns a new value to use for `process-environment', +but does not actually put it into use. It modifies the source path and object path with the values found in the project file." (let ((include (getenv "ADA_INCLUDE_PATH")) (objects (getenv "ADA_OBJECTS_PATH")) (build-dir (ada-xref-get-project-field 'build_dir))) (if include - (set 'include (concat include path-separator))) + (set 'include (concat path-separator include))) (if objects - (set 'objects (concat objects path-separator))) + (set 'objects (concat path-separator objects))) (cons (concat "ADA_INCLUDE_PATH=" - include - (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir)) + (mapconcat (lambda(x) (expand-file-name x build-dir)) (ada-xref-get-project-field 'src_dir) - path-separator)) + path-separator) + include) (cons (concat "ADA_OBJECTS_PATH=" - objects - (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir)) + (mapconcat (lambda(x) (expand-file-name x build-dir)) (ada-xref-get-project-field 'obj_dir) - path-separator)) + path-separator) + objects) process-environment)))) (defun ada-compile-application (&optional arg) - "Compiles the application, using the command found in the project file. + "Compile the application, using the command found in the project file. If ARG is not nil, ask for user confirmation." (interactive "P") (ada-require-project-file) @@ -1058,19 +1088,26 @@ If ARG is not nil, ask for user confirmation." (process-environment (ada-set-environment)) (compilation-scroll-output t)) - (set 'compilation-search-path - (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) - (ada-xref-get-project-field 'build_dir))) + (setq compilation-search-path (ada-xref-get-src-dir-field)) ;; If no project file was found, ask the user (unless cmd - (setq cmd "" arg t)) + (setq cmd '("") arg t)) - (compile (ada-remote - (if (or ada-xref-confirm-compile arg) - (read-from-minibuffer "enter command to compile: " cmd) - cmd))) - )) + ;; Make a single command from the list of commands, including the + ;; commands to run it on a remote machine. + (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) + + (if (or ada-xref-confirm-compile arg) + (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) + + ;; Insert newlines so as to separate the name of the commands to run + ;; and the output of the commands. This doesn't work with cmdproxy.exe, + ;; which gets confused by newline characters. + (if (not (string-match ".exe" shell-file-name)) + (setq cmd (concat cmd "\n\n"))) + + (compile (ada-quote-cmd cmd)))) (defun ada-compile-current (&optional arg prj-field) "Recompile the current file. @@ -1083,20 +1120,27 @@ command, and should be either comp_cmd (default) or check_cmd." (cmd (ada-xref-get-project-field field)) (process-environment (ada-set-environment)) (compilation-scroll-output t)) - - (set 'compilation-search-path - (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) - (ada-xref-get-project-field 'build_dir))) + + (setq compilation-search-path (ada-xref-get-src-dir-field)) + + (unless cmd + (setq cmd '("") arg t)) + + ;; Make a single command from the list of commands, including the + ;; commands to run it on a remote machine. + (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) ;; If no project file was found, ask the user - (if cmd - (set 'cmd (concat cmd " " (ada-convert-file-name (buffer-file-name)))) - (setq cmd "" arg t)) - - (compile (ada-remote - (if (or ada-xref-confirm-compile arg) - (read-from-minibuffer "enter command to compile: " cmd) - cmd))))) + (if (or ada-xref-confirm-compile arg) + (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) + + ;; Insert newlines so as to separate the name of the commands to run + ;; and the output of the commands. This doesn't work with cmdproxy.exe, + ;; which gets confused by newline characters. + (if (not (string-match ".exe" shell-file-name)) + (setq cmd (concat cmd "\n\n"))) + + (compile (ada-quote-cmd cmd)))) (defun ada-check-current (&optional arg) "Recompile the current file. @@ -1106,7 +1150,7 @@ If ARG is not nil, ask for user confirmation of the command." (defun ada-run-application (&optional arg) "Run the application. -if ARG is not-nil, asks for user confirmation." +if ARG is not-nil, ask for user confirmation." (interactive) (ada-require-project-file) @@ -1117,24 +1161,32 @@ if ARG is not-nil, asks for user confirmation." (let ((command (ada-xref-get-project-field 'run_cmd))) ;; Guess the command if it wasn't specified - (if (or (not command) (string= command "")) - (set 'command (file-name-sans-extension (buffer-name)))) + (if (not command) + (set 'command (list (file-name-sans-extension (buffer-name))))) + + ;; Modify the command to run remotely + (setq command (ada-remote (mapconcat 'identity command + ada-command-separator))) ;; Ask for the arguments to the command if required (if (or ada-xref-confirm-compile arg) - (set 'command (read-from-minibuffer "Enter command to execute: " command))) - - ;; Modify the command to run remotely - (setq command (ada-remote command)) + (setq command (read-from-minibuffer "Enter command to execute: " + command))) ;; Run the command (save-excursion (set-buffer (get-buffer-create "*run*")) (set 'buffer-read-only nil) + (erase-buffer) - (goto-char (point-min)) - (insert "\nRunning " command "\n\n") - (start-process "run" (current-buffer) shell-file-name "-c" command) + (start-process "run" (current-buffer) shell-file-name + "-c" command) + (comint-mode) + ;; Set these two variables to their default values, since otherwise + ;; the output buffer is scrolled so that only the last output line + ;; is visible at the top of the buffer. + (set (make-local-variable 'scroll-step) 0) + (set (make-local-variable 'scroll-conservatively) 0) ) (display-buffer "*run*") @@ -1143,53 +1195,113 @@ if ARG is not-nil, asks for user confirmation." (switch-to-buffer "*run*") )) - -(defun ada-gdb-application (&optional arg) +(defun ada-gdb-application (&optional arg executable-name) "Start the debugger on the application. +EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the +project file. If ARG is non-nil, ask the user to confirm the command." (interactive "P") (let ((buffer (current-buffer)) - gdb-buffer - cmd) + cmd pre-cmd post-cmd) (ada-require-project-file) - (set 'cmd (ada-xref-get-project-field 'debug_cmd)) - (let ((machine (ada-xref-get-project-field 'remote_machine))) - (if (and machine (not (string= machine ""))) - (error "This feature is not supported yet for remote environments"))) + (setq cmd (if executable-name + (concat ada-prj-default-debugger " " executable-name) + (ada-xref-get-project-field 'debug_cmd)) + pre-cmd (ada-xref-get-project-field 'debug_pre_cmd) + post-cmd (ada-xref-get-project-field 'debug_post_cmd)) ;; If the command was not given in the project file, start a bare gdb (if (not cmd) (set 'cmd (concat ada-prj-default-debugger " " - (file-name-sans-extension (buffer-file-name))))) + (or executable-name + (file-name-sans-extension (buffer-file-name)))))) + + ;; For gvd, add an extra switch so that the Emacs window is completly + ;; swallowed inside the Gvd one + (if (and ada-tight-gvd-integration + (string-match "^[^ \t]*gvd" cmd)) + ;; Start a new frame, so that when gvd exists we do not kill Emacs + ;; We make sure that gvd swallows the new frame, not the one the + ;; user has been using until now + ;; The frame is made invisible initially, so that GtkPlug gets a + ;; chance to fully manage it. Then it works fine with Enlightenment + ;; as well + (let ((frame (make-frame '((visibility . nil))))) + (set 'cmd (concat + cmd " --editor-window=" + (cdr (assoc 'outer-window-id (frame-parameters frame))))) + (select-frame frame))) + + ;; Add a -fullname switch + ;; Use the remote machine + (set 'cmd (ada-remote (concat cmd " -fullname "))) + + ;; Ask for confirmation if required (if (or arg ada-xref-confirm-compile) (set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) - ;; Set the variable gud-last-last-frame so that glide-debug can find - ;; the name of the Ada file, and thus of the project file if needed. - (if ada-prj-prj-file - (set 'gud-last-last-frame (cons ada-prj-prj-file 1))) - - (if (and (string-match "jdb" (comint-arguments cmd 0 0)) - (boundp 'jdb)) - (funcall (symbol-function 'jdb) cmd) - (gdb cmd)) - - (set 'gdb-buffer (symbol-value 'gud-comint-buffer)) - - ;; Switch back to the source buffer - ;; and Activate the debug part in the contextual menu - (switch-to-buffer buffer) - - (if (functionp 'gud-make-debug-menu) - (funcall (symbol-function 'gud-make-debug-menu))) - - ;; Warning: on Emacs >= 20.3.8, same-window-regexps includes gud-*, - ;; so the following call to display buffer will select the - ;; buffer instead of displaying it in another window - ;; This is why the second argument to display-buffer is 't' - (display-buffer gdb-buffer t) - )) + (let ((old-comint-exec (symbol-function 'comint-exec))) + + ;; Do not add -fullname, since we can have a 'rsh' command in front. + ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef + (fset 'gud-gdb-massage-args (lambda (file args) args)) + + (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) + (if (not (equal pre-cmd "")) + (setq pre-cmd (concat pre-cmd ada-command-separator))) + + (set 'post-cmd (mapconcat 'identity post-cmd "\n")) + (if post-cmd + (set 'post-cmd (concat post-cmd "\n"))) + + + ;; Temporarily replaces the definition of `comint-exec' so that we + ;; can execute commands before running gdb. + ;; FIXME: This is evil and not temporary !!! -stef + (fset 'comint-exec + `(lambda (buffer name command startfile switches) + (let (compilation-buffer-name-function) + (save-excursion + (set 'compilation-buffer-name-function + (lambda(x) (buffer-name buffer))) + (compile (ada-quote-cmd + (concat ,pre-cmd + command " " + (mapconcat 'identity switches " ")))))) + )) + + ;; Tight integration should force the tty mode + (if (and (string-match "gvd" (comint-arguments cmd 0 0)) + ada-tight-gvd-integration + (not (string-match "--tty" cmd))) + (setq cmd (concat cmd "--tty"))) + + (if (and (string-match "jdb" (comint-arguments cmd 0 0)) + (boundp 'jdb)) + (funcall (symbol-function 'jdb) cmd) + (gdb cmd)) + + ;; Restore the standard fset command (or for instance C-U M-x shell + ;; wouldn't work anymore + + (fset 'comint-exec old-comint-exec) + + ;; Send post-commands to the debugger + (process-send-string (get-buffer-process (current-buffer)) post-cmd) + + ;; Move to the end of the debugger buffer, so that it is automatically + ;; scrolled from then on. + (end-of-buffer) + + ;; Display both the source window and the debugger window (the former + ;; above the latter). No need to show the debugger window unless it + ;; is going to have some relevant information. + (if (or (not (string-match "gvd" (comint-arguments cmd 0 0))) + (string-match "--tty" cmd)) + (split-window-vertically)) + (switch-to-buffer buffer) + ))) (defun ada-reread-prj-file (&optional filename) @@ -1202,35 +1314,53 @@ automatically modifies the setup for all the Ada buffer that use this file." (if filename (ada-parse-prj-file filename) (ada-parse-prj-file (ada-prj-find-prj-file))) - ) + ;; Reread the location of the standard runtime library + (ada-initialize-runtime-library + (or (ada-xref-get-project-field 'cross_prefix) "")) + ) ;; ------ Private routines (defun ada-xref-current (file &optional ali-file-name) "Update the cross-references for FILE. -This in fact recompiles FILE to create ALI-FILE-NAME." +This in fact recompiles FILE to create ALI-FILE-NAME. +This function returns the name of the file that was recompiled to generate +the cross-reference information. Note that the ali file can then be deduced by +replacing the file extension with `.ali'." ;; kill old buffer (if (and ali-file-name (get-file-buffer ali-file-name)) (kill-buffer (get-file-buffer ali-file-name))) - ;; read the project file - (ada-require-project-file) - (let* ((cmd (ada-xref-get-project-field 'comp_cmd)) - (process-environment (ada-set-environment)) - (compilation-scroll-output t) - (name (ada-convert-file-name (buffer-file-name))) - (body-name (ada-get-body-name name))) - ;; Always recompile the body when we can - (set 'body-name (or body-name name)) + (let* ((name (ada-convert-file-name file)) + (body-name (or (ada-get-body-name name) name))) - ;; prompt for command to execute - (set 'cmd (concat cmd " " body-name)) - (compile (ada-remote - (if ada-xref-confirm-compile - (read-from-minibuffer "enter command to compile: " cmd) - cmd))))) + ;; Always recompile the body when we can. We thus temporarily switch to a + ;; buffer than contains the body of the unit + (save-excursion + (let ((body-visible (find-buffer-visiting body-name)) + process) + (if body-visible + (set-buffer body-visible) + (find-file body-name)) + + ;; Execute the compilation. Note that we must wait for the end of the + ;; process, or the ALI file would still not be available. + ;; Unfortunately, the underlying `compile' command that we use is + ;; asynchronous. + (ada-compile-current) + (setq process (get-buffer-process "*compilation*")) + + (while (and process + (not (equal (process-status process) 'exit))) + (sit-for 1)) + + ;; remove the buffer for the body if it wasn't there before + (unless body-visible + (kill-buffer (find-buffer-visiting body-name))) + )) + body-name)) (defun ada-find-file-in-dir (file dir-list) "Search for FILE in DIR-LIST." @@ -1238,46 +1368,23 @@ This in fact recompiles FILE to create ALI-FILE-NAME." (while (and (not found) dir-list) (set 'found (concat (file-name-as-directory (car dir-list)) (file-name-nondirectory file))) - + (unless (file-exists-p found) (set 'found nil)) (set 'dir-list (cdr dir-list))) found)) (defun ada-find-ali-file-in-dir (file) - "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. Adds build_dir in front of the search path to conform to gnatmake's behavior, and the standard runtime location at the end." - (ada-find-file-in-dir file - (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))) + (ada-find-file-in-dir file (ada-xref-get-obj-dir-field))) (defun ada-find-src-file-in-dir (file) - "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. Adds src_dir in front of the search path to conform to gnatmake's behavior, and the standard runtime location at the end." - (ada-find-file-in-dir file - (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))) - + (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) (defun ada-get-ali-file-name (file) "Create the ali file name for the ada-file FILE. @@ -1291,76 +1398,106 @@ the project file." ;; and look for this file ;; 2- If this file is found: ;; grep the "^U" lines, and make sure we are not reading the - ;; .ali file for a spec file. If we are, go to step 3. + ;; .ali file for a spec file. If we are, go to step 3. ;; 3- If the file is not found or step 2 failed: ;; find the name of the "other file", ie the body, and look ;; for its associated .ali file by subtituing the extension + ;; + ;; We must also handle the case of separate packages and subprograms: + ;; 4- If no ali file was found, we try to modify the file name by removing + ;; everything after the last '-' or '.' character, so as to get the + ;; ali file for the parent unit. If we found an ali file, we check that + ;; it indeed contains the definition for the separate entity by checking + ;; the 'D' lines. This is done repeatedly, in case the direct parent is + ;; also a separate. (save-excursion (set-buffer (get-file-buffer file)) (let ((short-ali-file-name (concat (file-name-sans-extension (file-name-nondirectory file)) ".ali")) - ali-file-name) - ;; First step - ;; we take the first possible completion - (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name)) - - ;; If we have found the .ali file, but the source file was a spec - ;; with a non-standard name, search the .ali file for the body if any, - ;; since the xref information is more complete in that one - (unless ali-file-name - (if (not (string= (file-name-extension file) "ads")) - (let ((is-spec nil) - (specs ada-spec-suffixes) - body-ali) - (while specs - (if (string-match (concat (regexp-quote (car specs)) "$") - file) - (set 'is-spec t)) - (set 'specs (cdr specs))) - - (if is-spec - (set 'body-ali - (ada-find-ali-file-in-dir - (concat (file-name-sans-extension - (file-name-nondirectory - (ada-other-file-name))) - ".ali")))) - (if body-ali - (set 'ali-file-name body-ali)))) - - ;; else we did not find the .ali file - ;; Second chance: in case the files do not have standard names (such - ;; as for instance file_s.ada and file_b.ada), try to go to the - ;; other file and look for its ali file - (setq short-ali-file-name - (concat (file-name-sans-extension - (file-name-nondirectory (ada-other-file-name))) - ".ali")) - (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name)) - - ;; If still not found, try to recompile the file - (if (not ali-file-name) - (progn - ;; recompile only if the user asked for this - (if ada-xref-create-ali - (ada-xref-current file ali-file-name)) - (error "Ali file not found. Recompile your file"))) - ) + ali-file-name + is-spec) + + ;; If we have a non-standard file name, and this is a spec, we first + ;; look for the .ali file of the body, since this is the one that + ;; contains the most complete information. If not found, we will do what + ;; we can with the .ali file for the spec... + + (if (not (string= (file-name-extension file) "ads")) + (let ((specs ada-spec-suffixes)) + (while specs + (if (string-match (concat (regexp-quote (car specs)) "$") + file) + (set 'is-spec t)) + (set 'specs (cdr specs))))) + + (if is-spec + (set 'ali-file-name + (ada-find-ali-file-in-dir + (concat (file-name-sans-extension + (file-name-nondirectory + (ada-other-file-name))) + ".ali")))) + + + (setq ali-file-name + (or ali-file-name + + ;; Else we take the .ali file associated with the unit + (ada-find-ali-file-in-dir short-ali-file-name) + + + ;; else we did not find the .ali file Second chance: in case + ;; the files do not have standard names (such as for instance + ;; file_s.ada and file_b.ada), try to go to the other file + ;; and look for its ali file + (ada-find-ali-file-in-dir + (concat (file-name-sans-extension + (file-name-nondirectory (ada-other-file-name))) + ".ali")) + + + ;; If we still don't have an ali file, try to get the one + ;; from the parent unit, in case we have a separate entity. + (let ((parent-name (file-name-sans-extension + (file-name-nondirectory file)))) + + (while (and (not ali-file-name) + (string-match "^\\(.*\\)[.-][^.-]*" parent-name)) + + (set 'parent-name (match-string 1 parent-name)) + (set 'ali-file-name (ada-find-ali-file-in-dir + (concat parent-name ".ali"))) + ) + ali-file-name))) + + ;; If still not found, try to recompile the file + (if (not ali-file-name) + ;; Recompile only if the user asked for this, and search the ali + ;; filename again. We avoid a possible infinite recursion by + ;; temporarily disabling the automatic compilation. + + (if ada-xref-create-ali + (setq ali-file-name + (concat (file-name-sans-extension (ada-xref-current file)) + ".ali")) + + (error "`.ali' file not found; recompile your source file")) - ;; same if the .ali file is too old and we must recompile it - (if (and (file-newer-than-file-p file ali-file-name) - ada-xref-create-ali) - (ada-xref-current file ali-file-name)) - ;; else returns the correct absolute file name + ;; same if the .ali file is too old and we must recompile it + (if (and (file-newer-than-file-p file ali-file-name) + ada-xref-create-ali) + (ada-xref-current file ali-file-name))) + + ;; Always return the correct absolute file name (expand-file-name ali-file-name)) - )) + )) (defun ada-get-ada-file-name (file original-file) "Create the complete file name (+directory) for FILE. -The original file (where the user was) is ORIGINAL-FILE. Search in project +The original file (where the user was) is ORIGINAL-FILE. Search in project file for possible paths." (save-excursion @@ -1372,7 +1509,7 @@ file for possible paths." (set-buffer buffer) (find-file original-file) (ada-require-project-file))) - + ;; we choose the first possible completion and we ;; return the absolute file name (let ((filename (ada-find-src-file-in-dir file))) @@ -1380,7 +1517,7 @@ file for possible paths." (expand-file-name filename) (error (concat (file-name-nondirectory file) - " not found in src_dir. Please check your project file"))) + " not found in src_dir; please check your project file"))) ))) @@ -1395,19 +1532,14 @@ file for possible paths." (count-lines begin (point)))) (defun ada-read-identifier (pos) - "Returns the identlist around POS and switch to the .ali buffer." - - ;; If there's a compilation in progress, it's probably because the - ;; .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))) + "Returns the identlist around POS and switch to the .ali buffer. +The returned list represents the entity, and can be manipulated through the +macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." ;; If at end of buffer (e.g the buffer is empty), error (if (>= (point) (point-max)) (error "No identifier on point")) - + ;; goto first character of the identifier/operator (skip backward < and > ;; since they are part of multiple character operators (goto-char pos) @@ -1444,12 +1576,12 @@ file for possible paths." (if (looking-at "[a-zA-Z0-9_]+") (set 'identifier (match-string 0)) (error "No identifier around"))) - + ;; Build the identlist (set 'identlist (ada-make-identlist)) (ada-set-name identlist (downcase identifier)) (ada-set-line identlist - (number-to-string (count-lines (point-min) (point)))) + (number-to-string (count-lines 1 (point)))) (ada-set-column identlist (number-to-string (1+ (current-column)))) (ada-set-file identlist (buffer-file-name)) @@ -1459,7 +1591,7 @@ file for possible paths." (defun ada-get-all-references (identlist) "Completes and returns IDENTLIST with the information extracted from the ali file (definition file and places where it is referenced)." - + (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist))) declaration-found) (set-buffer ali-buffer) @@ -1469,7 +1601,7 @@ from the ali file (definition file and places where it is referenced)." ;; First attempt: we might already be on the declaration of the identifier ;; We want to look for the declaration only in a definite interval (after ;; the "^X ..." line for the current file, and before the next "^X" line - + (if (re-search-forward (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) nil t) @@ -1479,7 +1611,7 @@ from the ali file (definition file and places where it is referenced)." (concat "^" (ada-line-of identlist) "." (ada-column-of identlist) "[ *]" (ada-name-of identlist) - " \\(.*\\)$") bound t)) + "[{\(<= ]?\\(.*\\)$") bound t)) (if declaration-found (ada-set-on-declaration identlist t)) )) @@ -1488,7 +1620,7 @@ from the ali file (definition file and places where it is referenced)." ;; have to fall back on other algorithms (unless declaration-found - + ;; Since we alread know the number of the file, search for a direct ;; reference to it (goto-char (point-min)) @@ -1498,21 +1630,25 @@ from the ali file (definition file and places where it is referenced)." (number-to-string (ada-find-file-number-in-ali (ada-file-of identlist)))) (unless (re-search-forward (concat (ada-ali-index-of identlist) - "|\\([0-9]+.[0-9]+ \\)*" + "|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*" (ada-line-of identlist) - "[^0-9]" - (ada-column-of identlist)) + "[^etpzkd<>=^]" + (ada-column-of identlist) "\\>") nil t) ;; if we did not find it, it may be because the first reference ;; is not required to have a 'unit_number|' item included. ;; Or maybe we are already on the declaration... - (unless (re-search-forward (concat "^\\([a-zA-Z0-9_.\"]+[ *]\\)*" - (ada-line-of identlist) - "[^0-9]" - (ada-column-of identlist)) - nil t) - + (unless (re-search-forward + (concat + "^[0-9]+.[0-9]+[ *]" + (ada-name-of identlist) + "[ <{=\(]\\(.\\|\n\\.\\)*\\<" + (ada-line-of identlist) + "[^0-9]" + (ada-column-of identlist) "\\>") + nil t) + ;; If still not found, then either the declaration is unknown ;; or the source file has been modified since the ali file was ;; created @@ -1529,17 +1665,17 @@ from the ali file (definition file and places where it is referenced)." (while (looking-at "^\\.") (previous-line 1)) (unless (looking-at (concat "[0-9]+.[0-9]+[ *]" - (ada-name-of identlist) "[ <]")) + (ada-name-of identlist) "[ <{=\(]")) (set 'declaration-found nil)))) ;; Still no success ! The ali file must be too old, and we need to - ;; use a basic algorithm based on guesses. Note that this only happens + ;; use a basic algorithm based on guesses. Note that this only happens ;; if the user does not want us to automatically recompile files ;; automatically (unless declaration-found (if (ada-xref-find-in-modified-ali identlist) (set 'declaration-found t) - ;; no more idea to find the declaration. Give up + ;; No more idea to find the declaration. Give up (progn (kill-buffer ali-buffer) (error (concat "No declaration of " (ada-name-of identlist) @@ -1547,7 +1683,7 @@ from the ali file (definition file and places where it is referenced)." ))) ) - + ;; Now that we have found a suitable line in the .ali file, get the ;; information available (beginning-of-line) @@ -1563,11 +1699,20 @@ from the ali file (definition file and places where it is referenced)." ) (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t) - (ada-set-declare-file - identlist - (ada-get-ada-file-name (match-string 1) - (ada-file-of identlist)))) - + + ;; If we can find the file + (condition-case err + (ada-set-declare-file + identlist + (ada-get-ada-file-name (match-string 1) + (ada-file-of identlist))) + + ;; Else clean up the ali file + (error + (kill-buffer ali-buffer) + (error (error-message-string err))) + )) + (ada-set-references identlist current-line) )) )) @@ -1593,7 +1738,7 @@ This function is disabled for operators, and only works for identifiers." (goto-char (point-max)) (while (re-search-backward my-regexp nil t) (save-excursion - (set 'line-ali (count-lines (point-min) (point))) + (set 'line-ali (count-lines 1 (point))) (beginning-of-line) ;; have a look at the line and column numbers (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") @@ -1620,41 +1765,44 @@ This function is disabled for operators, and only works for identifiers." (error (concat "No declaration of " (ada-name-of identlist) " recorded in .ali file"))) - + ;; one => should be the right one ((= len 1) (goto-line (caar declist))) - + ;; more than one => display choice list (t - (with-output-to-temp-buffer "*choice list*" - - (princ "Identifier is overloaded and Xref information is not up to date.\n") - (princ "Possible declarations are:\n\n") - (princ " no. in file at line col\n") - (princ " --- --------------------- ---- ----\n") - (let ((counter 1)) - (while (<= counter len) - (princ (format " %2d) %-21s %4s %4s\n" - counter + (save-window-excursion + (with-output-to-temp-buffer "*choice list*" + + (princ "Identifier is overloaded and Xref information is not up to date.\n") + (princ "Possible declarations are:\n\n") + (princ " no. in file at line col\n") + (princ " --- --------------------- ---- ----\n") + (let ((counter 0)) + (while (< counter len) + (princ (format " %2d) %-21s %4s %4s\n" + (1+ counter) (ada-get-ada-file-name - (nth 1 (nth (1- counter) declist)) + (nth 1 (nth counter declist)) (ada-file-of identlist)) - (nth 2 (nth (1- counter) declist)) - (nth 3 (nth (1- counter) declist)) + (nth 2 (nth counter declist)) + (nth 3 (nth counter declist)) )) - (setq counter (1+ counter)) - ) ; end of while - ) ; end of let - ) ; end of with-output-to ... - (setq choice nil) - (while (or - (not choice) - (not (integerp choice)) - (< choice 1) - (> choice len)) - (setq choice (string-to-int - (read-from-minibuffer "Enter No. of your choice: ")))) + (setq counter (1+ counter)) + ) ; end of while + ) ; end of let + ) ; end of with-output-to ... + (setq choice nil) + (while (or + (not choice) + (not (integerp choice)) + (< choice 1) + (> choice len)) + (setq choice + (string-to-int + (read-from-minibuffer "Enter No. of your choice: ")))) + ) (set-buffer ali-buffer) (goto-line (car (nth (1- choice) declist))) )))))) @@ -1667,60 +1815,204 @@ opens a new window to show the declaration." (ada-get-all-references identlist) (let ((ali-line (ada-references-of identlist)) + (locations nil) + (start 0) file line col) - - ;; If we were on a declaration, go to the body - (if (ada-on-declaration identlist) - (if (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line) - (progn - (setq line (match-string 1 ali-line) - col (match-string 2 ali-line)) - ;; it there was a file number in the same line - (if (string-match "\\([0-9]+\\)|\\([^|bc]+\\)?[bc]" ali-line) - (let ((file-number (match-string 1 ali-line))) - (goto-char (point-min)) - (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t - (string-to-number file-number)) - (set 'file (match-string 1)) - ) - ;; Else get the nearest file - (set 'file (ada-declare-file-of identlist)) - ) - ) - (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)) - ) + + ;; Note: in some cases, an entity can have multiple references to the + ;; bodies (this is for instance the case for a separate subprogram, that + ;; has a reference both to the stub and to the real body). + ;; In that case, we simply go to each one in turn. + + ;; Get all the possible locations + (string-match "^\\([0-9]+\\)[a-zA-Z+]\\([0-9]+\\)[ *]" ali-line) + (set 'locations (list (list (match-string 1 ali-line) ;; line + (match-string 2 ali-line) ;; column + (ada-declare-file-of identlist)))) + (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)" + ali-line start) + (setq line (match-string 1 ali-line) + col (match-string 3 ali-line) + start (match-end 3)) + + ;; it there was a file number in the same line + (if (string-match (concat "[^{(<]\\([0-9]+\\)|\\([^|bc]+\\)?" + (match-string 0 ali-line)) + ali-line) + (let ((file-number (match-string 1 ali-line))) + (goto-char (point-min)) + (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t + (string-to-number file-number)) + (set 'file (match-string 1)) + ) + ;; Else get the nearest file + (set 'file (ada-declare-file-of identlist))) + + (set 'locations (append locations (list (list line col file))))) + + ;; Add the specs at the end again, so that from the last body we go to + ;; the specs + (set 'locations (append locations (list (car locations)))) + + ;; Find the new location we want to go to. + ;; If we are on none of the locations listed, we simply go to the specs. + + (setq line (caar locations) + col (nth 1 (car locations)) + file (nth 2 (car locations))) + + (while locations + (if (and (string= (caar locations) (ada-line-of identlist)) + (string= (nth 1 (car locations)) (ada-column-of identlist)) + (string= (file-name-nondirectory (nth 2 (car locations))) + (file-name-nondirectory (ada-file-of identlist)))) + (setq locations (cadr locations) + line (car locations) + col (nth 1 locations) + file (nth 2 locations) + locations nil) + (set 'locations (cdr locations)))) + + ;; Find the file in the source path + (set 'file (ada-get-ada-file-name file (ada-file-of identlist))) + + ;; Kill the .ali buffer + (kill-buffer (current-buffer)) ;; Now go to the buffer - (ada-xref-change-buffer - (ada-get-ada-file-name file (ada-file-of identlist)) - (string-to-number line) - (1- (string-to-number col)) - identlist - other-frame) + (ada-xref-change-buffer file + (string-to-number line) + (1- (string-to-number col)) + identlist + other-frame) )) +(defun ada-find-in-src-path (identlist &optional other-frame) + "More general function for cross-references. +This function should be used when the standard algorithm that parses the +.ali file has failed, either because that file was too old or even did not +exist. +This function attempts to find the possible declarations for the identifier +anywhere in the object path. +This command requires the external `egrep' program to be available. + +This works well when one is using an external librarie and wants +to find the declaration and documentation of the subprograms one is +is using." + + (let (list + (dirs (ada-xref-get-obj-dir-field)) + (regexp (concat "[ *]" (ada-name-of identlist))) + line column + choice + file) + + (save-excursion + + ;; Do the grep in all the directories. We do multiple shell + ;; commands instead of one in case there is no .ali file in one + ;; of the directory and the shell stops because of that. + + (set-buffer (get-buffer-create "*grep*")) + (while dirs + (insert (shell-command-to-string + (concat "egrep -i -h '^X|" regexp "( |$)' " + (file-name-as-directory (car dirs)) "*.ali"))) + (set 'dirs (cdr dirs))) + + ;; Now parse the output + (set 'case-fold-search t) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (save-excursion + (beginning-of-line) + (if (not (= (char-after) ?X)) + (progn + (looking-at "\\([0-9]+\\).\\([0-9]+\\)") + (setq line (match-string 1) + column (match-string 2)) + (re-search-backward "^X [0-9]+ \\(.*\\)$") + (set 'file (list (match-string 1) line column)) + + ;; There could be duplicate choices, because of the structure + ;; of the .ali files + (unless (member file list) + (set 'list (append list (list file)))))))) + + ;; Current buffer is still "*grep*" + (kill-buffer "*grep*") + ) + + ;; Now display the list of possible matches + (cond + + ;; No choice found => Error + ((null list) + (error "No cross-reference found, please recompile your file")) + + ;; Only one choice => Do the cross-reference + ((= (length list) 1) + (set 'file (ada-find-src-file-in-dir (caar list))) + (if file + (ada-xref-change-buffer file + (string-to-number (nth 1 (car list))) + (string-to-number (nth 2 (car list))) + identlist + other-frame) + (error (concat (caar list) " not found in src_dir"))) + (message "This is only a (good) guess at the cross-reference.") + ) + + ;; Else, ask the user + (t + (save-window-excursion + (with-output-to-temp-buffer "*choice list*" + + (princ "Identifier is overloaded and Xref information is not up to date.\n") + (princ "Possible declarations are:\n\n") + (princ " no. in file at line col\n") + (princ " --- --------------------- ---- ----\n") + (let ((counter 0)) + (while (< counter (length list)) + (princ (format " %2d) %-21s %4s %4s\n" + (1+ counter) + (nth 0 (nth counter list)) + (nth 1 (nth counter list)) + (nth 2 (nth counter list)) + )) + (setq counter (1+ counter)) + ))) + (setq choice nil) + (while (or (not choice) + (not (integerp choice)) + (< choice 1) + (> choice (length list))) + (setq choice + (string-to-int + (read-from-minibuffer "Enter No. of your choice: ")))) + ) + (set 'choice (1- choice)) + (kill-buffer "*choice list*") + + (set 'file (ada-find-src-file-in-dir (car (nth choice list)))) + (if file + (ada-xref-change-buffer file + (string-to-number (nth 1 (nth choice list))) + (string-to-number (nth 2 (nth choice list))) + identlist + other-frame) + (error (concat (car (nth choice list)) " not found in src_dir"))) + (message "This is only a (good) guess at the cross-reference.") + )))) + (defun ada-xref-change-buffer (file line column identlist &optional other-frame) - "Select and display FILE, at LINE and COLUMN. The new file is -associated with the same project file as the one for IDENTLIST. + "Select and display FILE, at LINE and COLUMN. If we do not end on the same identifier as IDENTLIST, find the closest -match. Kills the .ali buffer at the end. +match. Kills the .ali buffer at the end. If OTHER-FRAME is non-nil, creates a new frame to show the file." - (let (prj-file - 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)) + (let (declaration-buffer) ;; Select and display the destination buffer (if ada-xref-other-buffer @@ -1733,10 +2025,6 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file." (find-file file) ) - ;; 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)) - ;; move the cursor to the correct position (push-mark) (goto-line line) @@ -1747,8 +2035,7 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file." ;; this is probably the right one. (unless (looking-at (ada-name-of identlist)) (ada-xref-search-nearest (ada-name-of identlist))) - - (kill-buffer ali-buffer))) + )) (defun ada-xref-search-nearest (name) @@ -1875,13 +2162,28 @@ This function typically is to be hooked into `ff-file-created-hooks'." (save-some-buffers nil nil) - (ada-require-project-file) + ;; If the current buffer is the body (as is the case when calling this + ;; function from ff-file-created-hooks), then kill this temporary buffer + (unless (interactive-p) + (progn + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)))) + - (delete-region (point-min) (point-max)) + ;; Make sure the current buffer is the spec (this might not be the case + ;; if for instance the user was asked for a project file) + + (unless (buffer-file-name (car (buffer-list))) + (set-buffer (cadr (buffer-list)))) + + ;; Make sure we have a project file (for parameters to gnatstub). Note that + ;; this might have already been done if we have been called from the hook, + ;; but this is not an expensive call) + (ada-require-project-file) ;; Call the external process gnatstub (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts)) - (filename (buffer-file-name (car (cdr (buffer-list))))) + (filename (buffer-file-name (car (buffer-list)))) (output (concat (file-name-sans-extension filename) ".adb")) (gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename)) (buffer (get-buffer-create "*gnatstub*"))) @@ -1908,10 +2210,6 @@ This function typically is to be hooked into `ff-file-created-hooks'." ;; Else clean up the output - ;; Kill the temporary buffer created by find-file - (set-buffer-modified-p nil) - (kill-buffer (current-buffer)) - (if (file-exists-p output) (progn (find-file output) @@ -1922,53 +2220,46 @@ This function typically is to be hooked into `ff-file-created-hooks'." ) ))) - (defun ada-xref-initialize () - "Function called by ada-mode-hook to initialize the ada-xref.el package. -For instance, it creates the gnat-specific menus, set some hooks for + "Function called by `ada-mode-hook' to initialize the ada-xref.el package. +For instance, it creates the gnat-specific menus, sets some hooks for find-file...." - (make-local-hook 'ff-file-created-hooks) - (setq ff-file-created-hooks 'ada-make-body-gnatstub) - - ;; Read the project file and update the search path - ;; before looking for the other file - (make-local-hook 'ff-pre-find-hooks) - (add-hook 'ff-pre-find-hooks 'ada-require-project-file) + ;; This should really be an `add-hook'. -stef + (setq ff-file-created-hook 'ada-make-body-gnatstub) ;; Completion for file names in the mini buffer should ignore .ali files (add-to-list 'completion-ignored-extensions ".ali") + + (ada-xref-update-project-menu) ) ;; ----- Add to ada-mode-hook --------------------------------------------- -;; Set the keymap once and for all, so that the keys set by the user in his -;; config file are not overwritten every time we open a new file. -(ada-add-ada-menu) -(ada-add-keymap) +;; Use gvd or ddd as the default debugger if it was found +;; On windows, do not use the --tty switch for GVD, since this is +;; not supported. Actually, we do not use this on Unix either, +;; since otherwise there is no console window left in GVD, +;; and people have to use the Emacs one. +;; This must be done before initializing the Ada menu. +(if (ada-find-file-in-dir "gvd" exec-path) + (set 'ada-prj-default-debugger "gvd ") + (if (ada-find-file-in-dir "gvd.exe" exec-path) + (set 'ada-prj-default-debugger "gvd ") + (if (ada-find-file-in-dir "ddd" exec-path) + (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar")))) (add-hook 'ada-mode-hook 'ada-xref-initialize) -;; 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")) - ;; Initializes the cross references to the runtime library -(ada-initialize-runtime-library) +(ada-initialize-runtime-library "") ;; Add these standard directories to the search path -(set 'ada-search-directories +(set 'ada-search-directories-internal (append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path) ada-search-directories)) -;; Make sure that the files are always associated with a project file. Since -;; the project file has some fields that are used for the editor (like the -;; casing exceptions), it has to be read before the user edits a file). -(add-hook 'ada-mode-hook - (lambda() - (let ((file (ada-prj-find-prj-file t))) - (if file (ada-reread-prj-file file))))) - (provide 'ada-xref) -;;; ada-xref.el ends here \ No newline at end of file +;;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e +;;; ada-xref.el ends here