[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el |
|
Date: |
Tue, 09 Apr 2002 14:54:20 -0400 |
Index: emacs/lisp/progmodes/ada-xref.el
diff -c emacs/lisp/progmodes/ada-xref.el:1.8
emacs/lisp/progmodes/ada-xref.el:1.9
*** emacs/lisp/progmodes/ada-xref.el:1.8 Mon Jul 16 09:38:53 2001
--- emacs/lisp/progmodes/ada-xref.el Tue Apr 9 14:54:20 2002
***************
*** 1,12 ****
;;; ada-xref.el --- for lookup and completion in Ada mode
! ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
;; Author: Markus Heritsch <address@hidden>
;; Rolf Ebert <address@hidden>
;; Emmanuel Briot <address@hidden>
;; Maintainer: Emmanuel Briot <address@hidden>
! ;; Ada Core Technologies's version: $Revision: 1.8 $
;; Keywords: languages ada xref
;; This file is part of GNU Emacs.
--- 1,13 ----
;;; ada-xref.el --- for lookup and completion in Ada mode
! ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001
! ;; Free Software Foundation, Inc.
;; Author: Markus Heritsch <address@hidden>
;; Rolf Ebert <address@hidden>
;; Emmanuel Briot <address@hidden>
;; Maintainer: Emmanuel Briot <address@hidden>
! ;; Ada Core Technologies's version: $Revision: 1.9 $
;; Keywords: languages ada xref
;; This file is part of GNU Emacs.
***************
*** 31,57 ****
;;; 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
;;; time a cross-reference is asked for, and is not read later.
--- 32,37 ----
***************
*** 86,92 ****
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"
"Default compilation options."
:type 'string :group 'ada)
--- 66,72 ----
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 -gnatQ"
"Default compilation options."
:type 'string :group 'ada)
***************
*** 102,109 ****
"Default options for gnatmake."
:type 'string :group 'ada)
(defcustom ada-prj-default-comp-cmd
! "${cross_prefix}gcc -c ${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
syntax as in the project file."
--- 82,97 ----
"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 -x ada -c ${comp_opt} ${full_current}"
"*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
syntax as in the project file."
***************
*** 137,142 ****
--- 125,137 ----
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.")
+
;; ------- Nothing to be modified by the user below this
(defvar ada-last-prj-file ""
"Name of the last project file entered by the user.")
***************
*** 144,155 ****
(defvar ada-check-switch "-gnats"
"Switch added to the command line to check the current file.")
! (defvar 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.")
--- 139,147 ----
(defvar ada-check-switch "-gnats"
"Switch added to the command line to check the current file.")
! (defconst ada-project-file-extension ".adp"
"The extension used for project files.")
(defvar ada-xref-runtime-library-specs-path '()
"Directories where the specs for the standard library is found.
This is used for cross-references.")
***************
*** 162,167 ****
--- 154,173 ----
"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 when sending 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.")
***************
*** 169,203 ****
"\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|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) ...)
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))))
!
! (defun ada-initialize-runtime-library ()
! "Initializes the variables for the runtime library location."
(save-excursion
! (set 'ada-xref-runtime-library-specs-path '())
! (set 'ada-xref-runtime-library-ali-path '())
(set-buffer (get-buffer-create "*gnatls*"))
(widen)
(erase-buffer)
--- 175,196 ----
"\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
"Regexp to match for operators.")
(defvar ada-xref-project-files '()
"Associative list of project files.
It has the following format:
\((project_name . value) (project_name . value) ...)
As always, the values of the project file are defined through properties.")
! (defun ada-quote-cmd (cmd)
! "Duplicates all \\ characters in CMD so that it can be passed to `compile'"
! (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
!
! (defun ada-initialize-runtime-library (cross-prefix)
! "Initializes the variables for the runtime library location.
! CROSS-PREFIX is the prefix to use for the gnatls command"
(save-excursion
! (setq ada-xref-runtime-library-specs-path '()
! ada-xref-runtime-library-ali-path '())
(set-buffer (get-buffer-create "*gnatls*"))
(widen)
(erase-buffer)
***************
*** 206,212 ****
;; Even if we get an error, delete the *gnatls* buffer
(unwind-protect
(progn
! (call-process "gnatls" nil t nil "-v")
(goto-char (point-min))
;; Source path
--- 199,206 ----
;; Even if we get an error, delete the *gnatls* buffer
(unwind-protect
(progn
! (call-process (concat cross-prefix "gnatls")
! nil t nil "-v")
(goto-char (point-min))
;; Source path
***************
*** 248,270 ****
"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."
(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)))
(save-match-data
! (set 'value (ada-xref-get-project-field
! (intern (match-string 2 cmd-string))))))
(cond
((null value)
! (set 'cmd-string (replace-match "" t t cmd-string)))
((stringp value)
! (set 'cmd-string (replace-match value t t cmd-string)))
((listp value)
(let ((prefix (match-string 1 cmd-string)))
! (set 'cmd-string (replace-match
(mapconcat (lambda(x) (concat prefix x)) value " ")
t t cmd-string)))))
))
--- 242,275 ----
"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, and ${full_current} is
! replaced by the name including the extension."
(while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string)
! (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
! (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)
! (setq cmd-string (replace-match "" t t cmd-string)))
((stringp value)
! (setq cmd-string (replace-match value t t cmd-string)))
((listp value)
(let ((prefix (match-string 1 cmd-string)))
! (setq cmd-string (replace-match
(mapconcat (lambda(x) (concat prefix x)) value " ")
t t cmd-string)))))
))
***************
*** 282,298 ****
;; 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!"))))
'build_dir (file-name-as-directory (expand-file-name
"."))
'src_dir (list ".")
'obj_dir (list ".")
--- 287,303 ----
;; 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 (expand-file-name
! (cond
! (file
! (ada-prj-get-prj-dir file))
! (ada-prj-default-project-file
! ada-prj-default-project-file)
! (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 ".")
***************
*** 303,310 ****
'bind_opt ada-prj-default-bind-opt
'link_opt ada-prj-default-link-opt
'gnatmake_opt ada-prj-default-gnatmake-opt
'main (if file
! (file-name-sans-extension file)
"")
'main_unit (if file
(file-name-nondirectory
--- 308,317 ----
'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-nondirectory
! (file-name-sans-extension file))
"")
'main_unit (if file
(file-name-nondirectory
***************
*** 312,347 ****
"")
'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"))
'debug_cmd (concat ada-prj-default-debugger
(if is-windows " ${main}.exe"
! " ${main}"))))
)
(set symbol plist)))
(defun ada-xref-get-project-field (field)
! "Extract the value of FIELD from the project file of the current buffer.
The project file must have been loaded first.
! A default value is returned if the file was not found."
! (let ((file-name ada-prj-prj-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))
;; If the file was not found, use the default values
(if file
--- 319,357 ----
"")
'cross_prefix ""
'remote_machine ""
! '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}"))
! 'debug_post_cmd (list nil)))
)
(set symbol plist)))
(defun ada-xref-get-project-field (field)
! "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.
!
! 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-default-project-file)
file value)
! ;; 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
***************
*** 351,362 ****
;; 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))
(set 'value (plist-get value field))
)
! (if (stringp value)
! (ada-treat-cmd-string value)
! value))
! )
;; ----- Keybindings ------------------------------------------------------
--- 361,503 ----
;; 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))
)
!
! ;; 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-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."
! (interactive)
! (let (submenu)
!
! ;; Create the standard items
! (set 'submenu (list (cons 'Load (cons "Load..."
! 'ada-set-default-project-file))
! (cons 'New (cons "New..." 'ada-prj-new))
! (cons 'Edit (cons "Edit..." 'ada-prj-edit))
! (cons 'sep (cons "---" nil))))
!
! ;; Add the new items
! (mapcar
! (lambda (x)
! (let ((name (or (car x) "<default>"))
! (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))))
! (set 'submenu
! (append submenu
! (list (cons (intern name)
! (list
! 'menu-item (file-name-sans-extension
! (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)))
!
! (if (not ada-xemacs)
! (if (lookup-key ada-mode-map [menu-bar Ada Project])
! (setcdr (lookup-key ada-mode-map [menu-bar Ada Project])
! 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")))))
!
;; ----- Keybindings ------------------------------------------------------
***************
*** 376,389 ****
(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 --------------------------------------------------------------
--- 517,530 ----
(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-cc" 'ada-change-prj)
! (define-key ada-mode-map "\C-cd" 'ada-set-default-project-file)
(define-key ada-mode-map "\C-cg" 'ada-gdb-application)
(define-key ada-mode-map "\C-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)
+ (define-key ada-mode-map "\C-c\C-f" 'ada-find-file)
)
;; ----- Menus --------------------------------------------------------------
***************
*** 412,423 ****
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")
--- 553,558 ----
***************
*** 475,480 ****
--- 610,622 ----
(setq ada-xref-confirm-compile
(not ada-xref-confirm-compile))
:style toggle :selected ada-xref-confirm-compile])
+ (if (string-match "gvd" ada-prj-default-debugger)
+ (funcall (symbol-function 'add-menu-button)
+ options-menu
+ ["Tight Integration With Gnu Visual Debugger"
+ (setq ada-tight-gvd-integration
+ (not ada-tight-gvd-integration))
+ :style toggle :selected ada-tight-gvd-integration]))
)
;; for Emacs
***************
*** 494,507 ****
(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"))))
--- 636,642 ----
(define-key-after menu [Debug] '("Debug" . ada-gdb-application) 'Run)
(define-key-after menu [rem] '("--" . nil) 'Debug)
(define-key-after menu [Project]
! (cons "Project" (make-sparse-keymap)) 'rem)
(define-key help-menu [Gnat_ug]
'("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug"))))
***************
*** 511,517 ****
'("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))
--- 646,652 ----
'("Gcc Documentation" . (lambda() (interactive) (info "gcc"))))
(define-key help-menu [gdb]
'("Gdb Documentation" . (lambda() (interactive) (info "gdb"))))
! (define-key help-menu [arm95]
'("Ada95 Reference Manual" . (lambda() (interactive) (info "arm95"))))
(define-key goto-menu [rem] '("----" . nil))
***************
*** 548,562 ****
(lambda()(interactive)
(setq ada-xref-other-buffer (not ada-xref-other-buffer)))
:button (:toggle . ada-xref-other-buffer)) t)
)
)
)
;; ----- 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)))
(ada-reread-prj-file)))
(defun ada-xref-push-pos (filename position)
--- 683,712 ----
(lambda()(interactive)
(setq ada-xref-other-buffer (not ada-xref-other-buffer)))
:button (:toggle . ada-xref-other-buffer)) t)
+
+ (if (string-match "gvd" ada-prj-default-debugger)
+ (define-key-after options-menu [tightgvd]
+ '(menu-item "Tight Integration With Gnu Visual Debugger"
+ (lambda()(interactive)
+ (setq ada-tight-gvd-integration
+ (not ada-tight-gvd-integration)))
+ :button (:toggle . ada-tight-gvd-integration)) t))
+
+ (define-key ada-mode-map [menu-bar Ada Edit rem3] '("------------" .
nil))
+ (define-key ada-mode-map [menu-bar Ada Edit open-file-from-src-path]
+ '("Search File on source path..." . ada-find-file))
)
)
+ (ada-xref-update-project-menu)
)
;; ----- Utilities -------------------------------------------------
(defun ada-require-project-file ()
! "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)
***************
*** 582,599 ****
(defun ada-set-default-project-file (name)
"Set the file whose name is NAME as the default project file."
(interactive "fProject file:")
-
- ;; All the directories should use this file as the default from now on,
- ;; even if they were already associated with a file.
- (set 'ada-xref-default-prj-file nil)
-
(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)
)
--- 732,738 ----
***************
*** 608,697 ****
(let (selected)
! ;; If we don't have an ada buffer, or 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
))
--- 747,827 ----
(let (selected)
! ;; 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))
! (and ada-prj-default-project-file
! (not (string= ada-prj-default-project-file ""))))
! (set 'selected ada-prj-default-project-file)
!
! ;; other cases: use a more complex algorithm
! (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))
! (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))))
! )))
selected
))
***************
*** 700,708 ****
"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
(ada-buffer (current-buffer)))
! (set 'prj-file (expand-file-name prj-file))
;; Initialize the project with the default values
(ada-xref-set-default-prj-values 'project (current-buffer))
--- 830,839 ----
"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 make_cmd comp_cmd check_cmd casing
! run_cmd debug_pre_cmd debug_post_cmd
(ada-buffer (current-buffer)))
! (setq prj-file (expand-file-name prj-file))
;; Initialize the project with the default values
(ada-xref-set-default-prj-values 'project (current-buffer))
***************
*** 716,722 ****
(widen)
(goto-char (point-min))
!
;; Now overrides these values with the project file
(while (not (eobp))
(if (looking-at "^\\([^=]+\\)=\\(.*\\)")
--- 847,853 ----
(widen)
(goto-char (point-min))
!
;; Now overrides these values with the project file
(while (not (eobp))
(if (looking-at "^\\([^=]+\\)=\\(.*\\)")
***************
*** 733,738 ****
--- 864,881 ----
(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))))))
***************
*** 742,772 ****
(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)))
!
;; 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)
;; 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)
(append (mapcar 'directory-file-name compilation-search-path)
ada-search-directories))
--- 885,932 ----
(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)))
!
! ;; 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)))
+
+ ;; Set the project file as the active one.
+ (setq ada-prj-default-project-file prj-file)
;; 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-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
! (setq ada-search-directories
(append (mapcar 'directory-file-name compilation-search-path)
ada-search-directories))
***************
*** 774,783 ****
(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)
!
)
))
--- 934,948 ----
(kill-buffer nil)
(set-buffer ada-buffer)
! (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))
))
***************
*** 813,826 ****
(interactive "sEntity name: ")
(ada-require-project-file)
! (let* ((command (concat "gnatfind -rf " entity
(if file (concat ":" (file-name-nondirectory file)))
(if line (concat ":" line))
(if column (concat ":" column)))))
;; 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)))
(compile-internal command "No more references" "gnatfind")
--- 978,1003 ----
(interactive "sEntity name: ")
(ada-require-project-file)
! ;; 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 "gnatfind " switches " "
! quote-entity
(if file (concat ":" (file-name-nondirectory file)))
(if line (concat ":" line))
(if column (concat ":" column)))))
;; If a project file is defined, use it
! (if (and ada-prj-default-project-file
! (not (string= ada-prj-default-project-file "")))
! (setq command (concat command " -p" ada-prj-default-project-file)))
(compile-internal command "No more references" "gnatfind")
***************
*** 831,913 ****
)
)
! (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:")
!
! ;; make sure we are using an Ada file
! (if (not (string= mode-name "Ada"))
! (error "You must be in ada-mode to use this function"))
!
! (set (make-local-variable 'ada-prj-prj-file) filename)
! (ada-parse-prj-file filename)
! )
!
! (defun ada-change-default-prj (filename)
! "Set FILENAME to be the default project file for the current directory."
! (interactive "ffile name:")
! (let ((dir (file-name-directory (buffer-file-name)))
! (prj (expand-file-name filename)))
!
! ;; Associate the directory with a project file
! (if (assoc dir ada-xref-default-prj-file)
! (setcdr (assoc dir ada-xref-default-prj-file) prj)
! (add-to-list 'ada-xref-default-prj-file (list dir prj)))
!
! ;; Reparse the project file
! (ada-parse-prj-file filename)))
!
;; ----- Identlist manipulation -------------------------------------------
;; An identlist is a vector that is used internally to reference an identifier
--- 1008,1014 ----
)
)
! (defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))
;; ----- Identlist manipulation -------------------------------------------
;; An identlist is a vector that is used internally to reference an identifier
***************
*** 985,1008 ****
(mouse-set-point last-input-event)
(ada-goto-declaration (point)))
! (defun ada-goto-declaration (pos)
"Display the declaration of the identifier around POS.
The declaration is shown in another buffer 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)))
! (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))
(defun ada-remote (command)
"Return the remote version of COMMAND, or COMMAND if remote_machine is nil."
--- 1086,1114 ----
(mouse-set-point last-input-event)
(ada-goto-declaration (point)))
! (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.
! 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)
! ;; 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 (ada-find-in-src-path identlist other-frame)))))
!
! (defun ada-goto-declaration-other-frame (pos &optional other-frame)
"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-goto-declaration pos t))
(defun ada-remote (command)
"Return the remote version of COMMAND, or COMMAND if remote_machine is nil."
***************
*** 1014,1031 ****
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))
(defun ada-set-environment ()
"Return the new value for process-environment.
--- 1120,1130 ----
machine
command))))
(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) (expand-file-name x root-dir)) dir-list))
(defun ada-set-environment ()
"Return the new value for process-environment.
***************
*** 1035,1055 ****
(objects (getenv "ADA_OBJECTS_PATH"))
(build-dir (ada-xref-get-project-field 'build_dir)))
(if include
! (set 'include (concat include path-separator)))
(if objects
! (set 'objects (concat objects path-separator)))
(cons
(concat "ADA_INCLUDE_PATH="
! include
! (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir))
(ada-xref-get-project-field 'src_dir)
! path-separator))
(cons
(concat "ADA_OBJECTS_PATH="
! objects
! (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir))
(ada-xref-get-project-field 'obj_dir)
! path-separator))
process-environment))))
(defun ada-compile-application (&optional arg)
--- 1134,1154 ----
(objects (getenv "ADA_OBJECTS_PATH"))
(build-dir (ada-xref-get-project-field 'build_dir)))
(if include
! (set 'include (concat path-separator include)))
(if objects
! (set 'objects (concat path-separator objects)))
(cons
(concat "ADA_INCLUDE_PATH="
! (mapconcat (lambda(x) (expand-file-name x build-dir))
(ada-xref-get-project-field 'src_dir)
! path-separator)
! include)
(cons
(concat "ADA_OBJECTS_PATH="
! (mapconcat (lambda(x) (expand-file-name x build-dir))
(ada-xref-get-project-field 'obj_dir)
! path-separator)
! objects)
process-environment))))
(defun ada-compile-application (&optional arg)
***************
*** 1061,1079 ****
(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)))
;; If no project file was found, ask the user
(unless cmd
! (setq cmd "" arg t))
! (compile (ada-remote
! (if (or ada-xref-confirm-compile arg)
! (read-from-minibuffer "enter command to compile: " cmd)
! cmd)))
! ))
(defun ada-compile-current (&optional arg prj-field)
"Recompile the current file.
--- 1160,1185 ----
(process-environment (ada-set-environment))
(compilation-scroll-output t))
! (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))
! ;; 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 "cmdproxy.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.
***************
*** 1087,1105 ****
(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)))
;; 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)))))
(defun ada-check-current (&optional arg)
"Recompile the current file.
--- 1193,1218 ----
(process-environment (ada-set-environment))
(compilation-scroll-output t))
! (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 (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 "cmdproxy.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.
***************
*** 1120,1143 ****
(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))))
;; 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))
;; 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)
)
(display-buffer "*run*")
--- 1233,1264 ----
(let ((command (ada-xref-get-project-field 'run_cmd)))
;; Guess the command if it wasn't specified
! (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)
! (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)
! (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*")
***************
*** 1146,1198 ****
(switch-to-buffer "*run*")
))
!
! (defun ada-gdb-application (&optional arg)
"Start the debugger on the application.
If ARG is non-nil, ask the user to confirm the command."
(interactive "P")
(let ((buffer (current-buffer))
! gdb-buffer
! 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")))
;; 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)))))
(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)
! ))
(defun ada-reread-prj-file (&optional filename)
--- 1267,1373 ----
(switch-to-buffer "*run*")
))
! (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))
! cmd pre-cmd post-cmd)
(ada-require-project-file)
! (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
" "
! (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)))
! (let (comint-exec
! in-post-mode
! gud-gdb-massage-args)
!
! ;; Do not add -fullname, since we can have a 'rsh' command in front.
! (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.
! (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))
!
! ;; 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)
***************
*** 1205,1239 ****
(if filename
(ada-parse-prj-file filename)
(ada-parse-prj-file (ada-prj-find-prj-file)))
- )
;; ------ 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."
;; 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))
!
! ;; 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)))))
(defun ada-find-file-in-dir (file dir-list)
"Search for FILE in DIR-LIST."
--- 1380,1432 ----
(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 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)))
!
! (let* ((name (ada-convert-file-name file))
! (body-name (or (ada-get-body-name name) name)))
!
! ;; 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."
***************
*** 1251,1286 ****
"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)))
(defun ada-find-src-file-in-dir (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)))
!
(defun ada-get-ali-file-name (file)
"Create the ali file name for the ada-file FILE.
--- 1444,1456 ----
"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 (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.
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 (ada-xref-get-src-dir-field)))
(defun ada-get-ali-file-name (file)
"Create the ali file name for the ada-file FILE.
***************
*** 1298,1365 ****
;; 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
(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")))
! )
! ;; 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
(expand-file-name ali-file-name))
! ))
(defun ada-get-ada-file-name (file original-file)
"Create the complete file name (+directory) for FILE.
--- 1468,1565 ----
;; 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
! 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 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)))
! ;; 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.
***************
*** 1398,1411 ****
(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)))
;; If at end of buffer (e.g the buffer is empty), error
(if (>= (point) (point-max))
--- 1598,1606 ----
(count-lines begin (point))))
(defun ada-read-identifier (pos)
! "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))
***************
*** 1510,1520 ****
;; 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)
;; If still not found, then either the declaration is unknown
;; or the source file has been modified since the ali file was
--- 1705,1717 ----
;; 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_.]+\\|\"[<>=+*-/a-z]\"\\)[ *]\\)*"
! (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
***************
*** 1566,1575 ****
)
(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))))
(ada-set-references identlist current-line)
))
--- 1763,1781 ----
)
(if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
!
! ;; 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)
))
***************
*** 1630,1663 ****
;; 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
(ada-get-ada-file-name
! (nth 1 (nth (1- counter) declist))
(ada-file-of identlist))
! (nth 2 (nth (1- counter) declist))
! (nth 3 (nth (1- 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:
"))))
(set-buffer ali-buffer)
(goto-line (car (nth (1- choice) declist)))
))))))
--- 1836,1872 ----
;; more than one => display choice list
(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 len)
! (princ (format " %2d) %-21s %4s %4s\n"
! (1+ counter)
(ada-get-ada-file-name
! (nth 1 (nth counter declist))
(ada-file-of identlist))
! (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: "))))
! )
(set-buffer ali-buffer)
(goto-line (car (nth (1- choice) declist)))
))))))
***************
*** 1670,1729 ****
(ada-get-all-references identlist)
(let ((ali-line (ada-references-of identlist))
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))
! )
;; 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)
))
(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.
If we do not end on the same identifier as IDENTLIST, find the closest
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))
;; Select and display the destination buffer
(if ada-xref-other-buffer
--- 1879,2081 ----
(ada-get-all-references identlist)
(let ((ali-line (ada-references-of identlist))
+ (locations nil)
+ (start 0)
file line col)
+
+ ;; 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 2 ali-line)
+ start (match-end 2))
+
+ ;; 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 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.
If we do not end on the same identifier as IDENTLIST, find the closest
match. Kills the .ali buffer at the end.
If OTHER-FRAME is non-nil, creates a new frame to show the file."
! (let (declaration-buffer)
;; Select and display the destination buffer
(if ada-xref-other-buffer
***************
*** 1736,1745 ****
(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)
--- 2088,2093 ----
***************
*** 1750,1757 ****
;; 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)
--- 2098,2104 ----
;; this is probably the right one.
(unless (looking-at (ada-name-of identlist))
(ada-xref-search-nearest (ada-name-of identlist)))
! ))
(defun ada-xref-search-nearest (name)
***************
*** 1878,1890 ****
(save-some-buffers nil nil)
! (ada-require-project-file)
! (delete-region (point-min) (point-max))
;; Call the external process gnatstub
(let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
! (filename (buffer-file-name (car (cdr (buffer-list)))))
(output (concat (file-name-sans-extension filename) ".adb"))
(gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename))
(buffer (get-buffer-create "*gnatstub*")))
--- 2225,2252 ----
(save-some-buffers nil nil)
! ;; 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))))
!
!
! ;; 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 (buffer-list))))
(output (concat (file-name-sans-extension filename) ".adb"))
(gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename))
(buffer (get-buffer-create "*gnatstub*")))
***************
*** 1911,1920 ****
;; 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)
--- 2273,2278 ----
***************
*** 1925,1931 ****
)
)))
-
(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, sets some hooks for
--- 2283,2288 ----
***************
*** 1946,1951 ****
--- 2303,2321 ----
;; ----- Add to ada-mode-hook ---------------------------------------------
+ ;; 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"))))
+
;; 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)
***************
*** 1953,1964 ****
(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)
;; Add these standard directories to the search path
(set 'ada-search-directories
--- 2323,2330 ----
(add-hook 'ada-mode-hook 'ada-xref-initialize)
;; Initializes the cross references to the runtime library
! (ada-initialize-runtime-library "")
;; Add these standard directories to the search path
(set 'ada-search-directories
- [Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el,
Stefan Monnier <=