Mercurial > emacs
changeset 73563:23b9a43eb0a5
(ada-compile-current): Don't add newlines to commands.
| author | Juanma Barranquero <lekktu@gmail.com> |
|---|---|
| date | Tue, 31 Oct 2006 00:57:56 +0000 |
| parents | 368665ce6f35 |
| children | 0058ef19e376 |
| files | lisp/progmodes/ada-xref.el |
| diffstat | 1 files changed, 230 insertions(+), 251 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/progmodes/ada-xref.el Tue Oct 31 00:21:19 2006 +0000 +++ b/lisp/progmodes/ada-xref.el Tue Oct 31 00:57:56 2006 +0000 @@ -1,4 +1,4 @@ -;;; ada-xref.el --- for lookup and completion in Ada mode +;; ada-xref.el --- for lookup and completion in Ada mode ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, ;; 2004, 2005, 2006 Free Software Foundation, Inc. @@ -6,8 +6,7 @@ ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> ;; Rolf Ebert <ebert@inf.enst.fr> ;; Emmanuel Briot <briot@gnat.com> -;; Maintainer: Emmanuel Briot <briot@gnat.com> -;; Ada Core Technologies's version: Revision: 1.181 +;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org> ;; Keywords: languages ada xref ;; This file is part of GNU Emacs. @@ -38,6 +37,10 @@ ;;; You need Emacs >= 20.2 to run this package + +;;; History: +;; + ;;; Code: ;; ----- Requirements ----------------------------------------------------- @@ -47,7 +50,7 @@ (require 'find-file) (require 'ada-mode) -;; ------ Use variables +;; ------ User variables (defcustom ada-xref-other-buffer t "*If nil, always display the cross-references in the same buffer. Otherwise create either a new buffer or a new frame." @@ -59,7 +62,7 @@ :type 'boolean :group 'ada) (defcustom ada-xref-confirm-compile nil - "*If non-nil, ask for confirmation before compiling or running the application." + "*Non-nil means ask for confirmation before compiling or running the application." :type 'boolean :group 'ada) (defcustom ada-krunch-args "0" @@ -105,26 +108,25 @@ (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 -syntax as in the project file." +Emacs will substitute the current filename for ${full_current}, or add +the filename at the end. 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', -`gdb --emacs_gdbtk' or `ddd --tty -fullname'." + "*Default name of the debugger." :type 'string :group 'ada) (defcustom ada-prj-default-make-cmd (concat "${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} " - "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}") + "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}") "*Default command to be used to compile the application. This is the same syntax as in the project file." :type 'string :group 'ada) (defcustom ada-prj-default-project-file "" - "*Name of the project file to use for every Ada file. -Emacs will not try to use the standard algorithm to find the project file if -this string is not empty." + "*Name of the current project file. +Emacs will not try to use the search algorithm to find the project file if +this string is not empty. It is set whenever a project file is found." :type '(file :must-match t) :group 'ada) (defcustom ada-gnatstub-opts "-q -I${src_dir}" @@ -238,7 +240,7 @@ (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" + "Read the ali file FILE into a new buffer, and return the buffer's name." (find-file-noselect (ada-get-ali-file-name file))) @@ -250,7 +252,7 @@ (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." +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 '()) @@ -305,9 +307,9 @@ (defun ada-treat-cmd-string (cmd-string) "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 +Assumes project exists. +As a special case, ${current} is replaced with the name of the current +file, minus extension but with directory, and ${full_current} is replaced by the name including the extension." (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string) @@ -349,9 +351,8 @@ (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 + ;; Try hard to find a project file, even if the current + ;; buffer is not an Ada file or not associated with a file (list 'filename (expand-file-name (cond (ada-prj-default-project-file @@ -403,8 +404,7 @@ (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. +Project variables are substituted. 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 @@ -443,7 +443,6 @@ ) )) - (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." @@ -529,6 +528,7 @@ "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." + ;; FIXME: doc arguments (let (list (dirs (ada-xref-get-src-dir-field))) @@ -547,7 +547,7 @@ ;;;###autoload (defun ada-find-file (filename) - "Open a file anywhere in the source path. + "Open FILENAME, from anywhere in the source path. Completion is available." (interactive (list (completing-read "File: " 'ada-do-file-completion))) @@ -582,9 +582,10 @@ (goto-char (car pos))))) (defun ada-convert-file-name (name) - "Converts from NAME to a name that can be used by the compilation commands. + "Convert from NAME to a name that can be used by the compilation commands. This is overriden on VMS to convert from VMS filenames to Unix filenames." name) +;; FIXME: use convert-standard-filename instead (defun ada-set-default-project-file (name &optional keep-existing) "Set the file whose name is NAME as the default project file. @@ -694,12 +695,12 @@ (defun ada-parse-prj-file (prj-file) - "Reads and parses the PRJ-FILE file if it was found. -The current buffer should be the ada-file buffer." + "Read PRJ-FILE, set it as the active project." + ;; FIXME: doc nil, search, etc. (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))) + (ada-buffer (current-buffer))) (setq prj-file (expand-file-name prj-file)) ;; Set the project file as the active one. @@ -728,6 +729,8 @@ (while (not (eobp)) (if (looking-at "^\\([^=]+\\)=\\(.*\\)") (cond + ;; fields that are lists or paths require special processing + ;; FIXME: strip trailing spaces ((string= (match-string 1) "src_dir") (add-to-list 'src_dir (file-name-as-directory (match-string 2)))) @@ -753,6 +756,7 @@ ((string= (match-string 1) "debug_post_cmd") (add-to-list 'debug_post_cmd (match-string 2))) (t + ;; any other field in the file is just copied (set 'project (plist-put project (intern (match-string 1)) (match-string 2)))))) (forward-line 1)) @@ -783,20 +787,20 @@ ;; 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. + ;; 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) + (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) + (list command-line-default-directory) (split-string (or (getenv "ADA_OBJECTS_PATH") "") ":") (list "." default-directory)))) ) @@ -817,11 +821,11 @@ ;; 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))) + ;; 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 @@ -850,21 +854,21 @@ (ada-require-project-file) (let* ((identlist (ada-read-identifier pos)) - (alifile (ada-get-ali-file-name (ada-file-of identlist))) + (alifile (ada-get-ali-file-name (ada-file-of identlist))) (process-environment (ada-set-environment))) (set-buffer (get-file-buffer (ada-file-of identlist))) ;; if the file is more recent than the executable (if (or (buffer-modified-p (current-buffer)) - (file-newer-than-file-p (ada-file-of identlist) alifile)) - (ada-find-any-references (ada-name-of identlist) - (ada-file-of identlist) - nil nil local-only arg) + (file-newer-than-file-p (ada-file-of identlist) alifile)) + (ada-find-any-references (ada-name-of identlist) + (ada-file-of identlist) + 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) local-only arg))) + (ada-file-of identlist) + (ada-line-of identlist) + (ada-column-of identlist) local-only arg))) ) (defun ada-find-local-references (&optional pos arg) @@ -897,9 +901,9 @@ (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 file (concat ":" (file-name-nondirectory file))) + (if line (concat ":" line)) + (if column (concat ":" column)) (if local-only (concat " " (file-name-nondirectory file))) )) old-contents) @@ -907,10 +911,10 @@ ;; If a project file is defined, use it (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)))) + (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)))) (if (and append (get-buffer "*gnatfind*")) (save-excursion @@ -937,21 +941,19 @@ ;; ----- Identifier Completion -------------------------------------------- (defun ada-complete-identifier (pos) - "Tries to complete the identifier around POS. -The feature is only available if the files where compiled without -the option `-gnatx'." + "Try to complete the identifier around POS, using compiler cross-reference information." (interactive "d") (ada-require-project-file) ;; Initialize function-local variables and jump to the .ali buffer ;; Note that for regexp search is case insensitive too (let* ((curbuf (current-buffer)) - (identlist (ada-read-identifier pos)) - (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\(" - (regexp-quote (ada-name-of identlist)) - "[a-zA-Z0-9_]*\\)")) - (completed nil) - (symalist nil)) + (identlist (ada-read-identifier pos)) + (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\(" + (regexp-quote (ada-name-of identlist)) + "[a-zA-Z0-9_]*\\)")) + (completed nil) + (symalist nil)) ;; Open the .ali file (set-buffer (ada-get-ali-buffer (buffer-file-name))) @@ -990,6 +992,7 @@ (defun ada-goto-body (pos &optional other-frame) "Display the body of the entity around POS. +OTHER-FRAME non-nil means display in another frame. 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") @@ -1023,7 +1026,7 @@ ;; 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.") + (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 @@ -1048,8 +1051,8 @@ 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, add the value of ROOT-DIR in front." + "Return the list of absolute directories found in DIR-LIST. +If a directory is a relative directory, ROOT-DIR is prepended." (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list)) (defun ada-set-environment () @@ -1134,12 +1137,6 @@ (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) @@ -1162,7 +1159,7 @@ ;; Guess the command if it wasn't specified (if (not command) - (set 'command (list (file-name-sans-extension (buffer-name))))) + (set 'command (list (file-name-sans-extension (buffer-name))))) ;; Modify the command to run remotely (setq command (ada-remote (mapconcat 'identity command @@ -1197,9 +1194,9 @@ (defun ada-gdb-application (&optional arg executable-name) "Start the debugger on the application. +If ARG is non-nil, ask the user to confirm the command. 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." +project file." (interactive "P") (let ((buffer (current-buffer)) cmd pre-cmd post-cmd) @@ -1303,13 +1300,8 @@ (switch-to-buffer buffer) ))) - (defun ada-reread-prj-file (&optional filename) - "Forces Emacs to read either FILENAME or the project file associated -with the current buffer. -Otherwise, this file is only read once, and never read again. -Since the information in the project file is shared between all buffers, this -automatically modifies the setup for all the Ada buffer that use this file." + "Reread either the current project, or FILENAME if non-nil." (interactive "P") (if filename (ada-parse-prj-file filename) @@ -1330,7 +1322,7 @@ replacing the file extension with `.ali'." ;; kill old buffer (if (and ali-file-name - (get-file-buffer ali-file-name)) + (get-file-buffer ali-file-name)) (kill-buffer (get-file-buffer ali-file-name))) (let* ((name (ada-convert-file-name file)) @@ -1375,15 +1367,15 @@ 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 the ali file FILE, searching obj_dir for the current project. 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." + "Find the source file FILE, searching src_dir for the current project. +Adds the standard runtime location at the end of the search path to conform +to gnatmake's behavior." (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) (defun ada-get-ali-file-name (file) @@ -1414,9 +1406,9 @@ (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 + (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 @@ -1514,15 +1506,15 @@ ;; return the absolute file name (let ((filename (ada-find-src-file-in-dir file))) (if filename - (expand-file-name filename) - (error (concat - (file-name-nondirectory file) - " not found in src_dir; please check your project file"))) + (expand-file-name filename) + (error (concat + (file-name-nondirectory file) + " not found in src_dir; please check your project file"))) ))) (defun ada-find-file-number-in-ali (file) - "Returns the file number for FILE in the associated ali file." + "Return the file number for FILE in the associated ali file." (set-buffer (ada-get-ali-buffer file)) (goto-char (point-min)) @@ -1532,7 +1524,7 @@ (count-lines begin (point)))) (defun ada-read-identifier (pos) - "Returns the identlist around POS and switch to the .ali buffer. + "Return 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',..." @@ -1553,7 +1545,7 @@ ;; Just in front of a string => we could have an operator declaration, ;; as in "+", "-", .. (if (= (char-after) ?\") - (forward-char 1)) + (forward-char 1)) ;; if looking at an operator ;; This is only true if: @@ -1563,19 +1555,19 @@ (or (not (= (char-syntax (char-after)) ?w)) (not (or (= (char-syntax (char-after (match-end 0))) ?w) (= (char-after (match-end 0)) ?_))))) - (progn - (if (and (= (char-before) ?\") - (= (char-after (+ (length (match-string 0)) (point))) ?\")) - (forward-char -1)) - (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) + (progn + (if (and (= (char-before) ?\") + (= (char-after (+ (length (match-string 0)) (point))) ?\")) + (forward-char -1)) + (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) (if (ada-in-string-p) - (error "Inside string or character constant")) + (error "Inside string or character constant")) (if (looking-at (concat ada-keywords "[^a-zA-Z_]")) - (error "No cross-reference available for reserved keyword")) + (error "No cross-reference available for reserved keyword")) (if (looking-at "[a-zA-Z0-9_]+") - (set 'identifier (match-string 0)) - (error "No identifier around"))) + (set 'identifier (match-string 0)) + (error "No identifier around"))) ;; Build the identlist (set 'identlist (ada-make-identlist)) @@ -1589,8 +1581,8 @@ )) (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)." + "Complete IDENTLIST with definition file and places where it is referenced. +Information is extracted from the ali file." (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist))) declaration-found) @@ -1605,8 +1597,8 @@ (if (re-search-forward (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) nil t) - (let ((bound (save-excursion (re-search-forward "^X " nil t)))) - (set 'declaration-found + (let ((bound (save-excursion (re-search-forward "^X " nil t)))) + (set 'declaration-found (re-search-forward (concat "^" (ada-line-of identlist) "." (ada-column-of identlist) @@ -1636,10 +1628,10 @@ (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 + ;; 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 "^[0-9]+.[0-9]+[ *]" (ada-name-of identlist) @@ -1653,7 +1645,7 @@ ;; or the source file has been modified since the ali file was ;; created (set 'declaration-found nil) - ) + ) ) ;; Last check to be completly sure we have found the correct line (the @@ -1688,15 +1680,15 @@ ;; information available (beginning-of-line) (if declaration-found - (let ((current-line (buffer-substring + (let ((current-line (buffer-substring (point) (save-excursion (end-of-line) (point))))) - (save-excursion - (next-line 1) - (beginning-of-line) - (while (looking-at "^\\.\\(.*\\)") - (set 'current-line (concat current-line (match-string 1))) - (next-line 1)) - ) + (save-excursion + (next-line 1) + (beginning-of-line) + (while (looking-at "^\\.\\(.*\\)") + (set 'current-line (concat current-line (match-string 1))) + (next-line 1)) + ) (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t) @@ -1725,7 +1717,7 @@ (unless (= (string-to-char (ada-name-of identlist)) ?\") (progn - (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... )) + (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... )) (my-regexp (concat "[ *]" (regexp-quote (ada-name-of identlist)) " ")) (line-ada "--") @@ -1735,43 +1727,43 @@ (choice 0) (ali-buffer (current-buffer))) - (goto-char (point-max)) - (while (re-search-backward my-regexp nil t) - (save-excursion - (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]+\\)[ *]") - (progn - (setq line-ada (match-string 1)) - (setq col-ada (match-string 2))) - (setq line-ada "--") - (setq col-ada "--") - ) - ;; construct a list with the file names and the positions within - (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t) + (goto-char (point-max)) + (while (re-search-backward my-regexp nil t) + (save-excursion + (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]+\\)[ *]") + (progn + (setq line-ada (match-string 1)) + (setq col-ada (match-string 2))) + (setq line-ada "--") + (setq col-ada "--") + ) + ;; construct a list with the file names and the positions within + (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t) (add-to-list 'declist (list line-ali (match-string 1) line-ada col-ada)) - ) - ) - ) + ) + ) + ) - ;; how many possible declarations have we found ? - (setq len (length declist)) - (cond - ;; none => error - ((= len 0) - (kill-buffer (current-buffer)) - (error (concat "No declaration of " - (ada-name-of identlist) - " recorded in .ali file"))) + ;; how many possible declarations have we found ? + (setq len (length declist)) + (cond + ;; none => error + ((= len 0) + (kill-buffer (current-buffer)) + (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))) + ;; one => should be the right one + ((= len 1) + (goto-line (caar declist))) - ;; more than one => display choice list - (t + ;; more than one => display choice list + (t (save-window-excursion (with-output-to-temp-buffer "*choice list*" @@ -1782,13 +1774,13 @@ (let ((counter 0)) (while (< counter len) (princ (format " %2d) %-21s %4s %4s\n" - (1+ counter) + (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)) - )) + (nth 2 (nth counter declist)) + (nth 3 (nth counter declist)) + )) (setq counter (1+ counter)) ) ; end of while ) ; end of let @@ -1804,8 +1796,8 @@ (read-from-minibuffer "Enter No. of your choice: ")))) ) (set-buffer ali-buffer) - (goto-line (car (nth (1- choice) declist))) - )))))) + (goto-line (car (nth (1- choice) declist))) + )))))) (defun ada-find-in-ali (identlist &optional other-frame) @@ -1899,7 +1891,7 @@ 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." - +;; FIXME: what does this function do? (let (list (dirs (ada-xref-get-obj-dir-field)) (regexp (concat "[ *]" (ada-name-of identlist))) @@ -2020,12 +2012,12 @@ ;; Select and display the destination buffer (if ada-xref-other-buffer - (if other-frame - (find-file-other-frame file) - (set 'declaration-buffer (find-file-noselect file)) - (set-buffer declaration-buffer) - (switch-to-buffer-other-window declaration-buffer) - ) + (if other-frame + (find-file-other-frame file) + (set 'declaration-buffer (find-file-noselect file)) + (set-buffer declaration-buffer) + (switch-to-buffer-other-window declaration-buffer) + ) (find-file file) ) @@ -2043,11 +2035,11 @@ (defun ada-xref-search-nearest (name) - "Searches for NAME nearest to the position recorded in the Xref file. -It returns the position of the declaration in the buffer or nil if not found." + "Search for NAME nearest to the position recorded in the Xref file. +Return the position of the declaration in the buffer, or nil if not found." (let ((orgpos (point)) - (newpos nil) - (diff nil)) + (newpos nil) + (diff nil)) (goto-char (point-max)) @@ -2056,33 +2048,33 @@ ;; check if it really is a complete Ada identifier (if (and - (not (save-excursion - (goto-char (match-end 0)) - (looking-at "_"))) - (not (ada-in-string-or-comment-p)) - (or - ;; variable declaration ? - (save-excursion - (skip-chars-forward "a-zA-Z_0-9" ) - (ada-goto-next-non-ws) - (looking-at ":[^=]")) - ;; procedure, function, task or package declaration ? - (save-excursion - (ada-goto-previous-word) - (looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>")))) + (not (save-excursion + (goto-char (match-end 0)) + (looking-at "_"))) + (not (ada-in-string-or-comment-p)) + (or + ;; variable declaration ? + (save-excursion + (skip-chars-forward "a-zA-Z_0-9" ) + (ada-goto-next-non-ws) + (looking-at ":[^=]")) + ;; procedure, function, task or package declaration ? + (save-excursion + (ada-goto-previous-word) + (looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>")))) - ;; check if it is nearer than the ones before if any - (if (or (not diff) - (< (abs (- (point) orgpos)) diff)) - (progn - (setq newpos (point) + ;; check if it is nearer than the ones before if any + (if (or (not diff) + (< (abs (- (point) orgpos)) diff)) + (progn + (setq newpos (point) diff (abs (- newpos orgpos)))))) ) (if newpos - (progn - (message "ATTENTION: this declaration is only a (good) guess ...") - (goto-char newpos)) + (progn + (message "ATTENTION: this declaration is only a (good) guess ...") + (goto-char newpos)) nil))) @@ -2093,26 +2085,26 @@ (ada-require-project-file) (let ((buffer (ada-get-ali-buffer (buffer-file-name))) - (unit-name nil) - (body-name nil) - (ali-name nil)) + (unit-name nil) + (body-name nil) + (ali-name nil)) (save-excursion (set-buffer buffer) (goto-char (point-min)) (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)") (setq unit-name (match-string 1)) (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name)) - (progn - (kill-buffer buffer) - (error "No parent unit !")) - (setq unit-name (match-string 1 unit-name)) - ) + (progn + (kill-buffer buffer) + (error "No parent unit !")) + (setq unit-name (match-string 1 unit-name)) + ) ;; look for the file name for the parent unit specification (goto-char (point-min)) (re-search-forward (concat "^W " unit-name - "%s[ \t]+\\([^ \t]+\\)[ \t]+" - "\\([^ \t\n]+\\)")) + "%s[ \t]+\\([^ \t]+\\)[ \t]+" + "\\([^ \t\n]+\\)")) (setq body-name (match-string 1)) (setq ali-name (match-string 2)) (kill-buffer buffer) @@ -2123,15 +2115,15 @@ (save-excursion ;; Tries to open the new ali file to find the spec file (if ali-name - (progn - (find-file ali-name) - (goto-char (point-min)) - (re-search-forward (concat "^U " unit-name "%s[ \t]+" - "\\([^ \t]+\\)")) - (setq body-name (match-string 1)) - (kill-buffer (current-buffer)) - ) - ) + (progn + (find-file ali-name) + (goto-char (point-min)) + (re-search-forward (concat "^U " unit-name "%s[ \t]+" + "\\([^ \t]+\\)")) + (setq body-name (match-string 1)) + (kill-buffer (current-buffer)) + ) + ) ) (find-file body-name) @@ -2146,14 +2138,14 @@ (set-buffer krunch-buf) ;; send adaname to external process `gnatkr'. (call-process "gnatkr" nil krunch-buf nil - adaname ada-krunch-args) + adaname ada-krunch-args) ;; fetch output of that process (setq adaname (buffer-substring - (point-min) - (progn - (goto-char (point-min)) - (end-of-line) - (point)))) + (point-min) + (progn + (goto-char (point-min)) + (end-of-line) + (point)))) (kill-buffer krunch-buf))) adaname ) @@ -2187,10 +2179,10 @@ ;; 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*"))) + (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*"))) (save-excursion (set-buffer buffer) @@ -2203,25 +2195,25 @@ (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd) (if (save-excursion - (set-buffer buffer) - (goto-char (point-min)) - (search-forward "command not found" nil t)) - (progn - (message "gnatstub was not found -- using the basic algorithm") - (sleep-for 2) - (kill-buffer buffer) - (ada-make-body)) + (set-buffer buffer) + (goto-char (point-min)) + (search-forward "command not found" nil t)) + (progn + (message "gnatstub was not found -- using the basic algorithm") + (sleep-for 2) + (kill-buffer buffer) + (ada-make-body)) ;; Else clean up the output (if (file-exists-p output) - (progn - (find-file output) - (kill-buffer buffer)) + (progn + (find-file output) + (kill-buffer buffer)) - ;; display the error buffer - (display-buffer buffer) - ) + ;; display the error buffer + (display-buffer buffer) + ) ))) (defun ada-xref-initialize () @@ -2237,22 +2229,9 @@ (ada-xref-update-project-menu) ) - ;; ----- 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")))) - (add-hook 'ada-mode-hook 'ada-xref-initialize) ;; Initializes the cross references to the runtime library