[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: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el |
|
Date: |
Fri, 04 Apr 2003 01:22:48 -0500 |
Index: emacs/lisp/progmodes/ada-xref.el
diff -c emacs/lisp/progmodes/ada-xref.el:1.12
emacs/lisp/progmodes/ada-xref.el:1.13
*** emacs/lisp/progmodes/ada-xref.el:1.12 Thu Oct 3 14:21:02 2002
--- emacs/lisp/progmodes/ada-xref.el Tue Feb 4 08:24:34 2003
***************
*** 225,231 ****
(goto-char (point-min))
;; Source path
!
(search-forward "Source Search Path:")
(forward-line 1)
(while (not (looking-at "^$"))
--- 225,231 ----
(goto-char (point-min))
;; Source path
!
(search-forward "Source Search Path:")
(forward-line 1)
(while (not (looking-at "^$"))
***************
*** 238,244 ****
(forward-line 1))
;; Object path
!
(search-forward "Object Search Path:")
(forward-line 1)
(while (not (looking-at "^$"))
--- 238,244 ----
(forward-line 1))
;; Object path
!
(search-forward "Object Search Path:")
(forward-line 1)
(while (not (looking-at "^$"))
***************
*** 282,288 ****
(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)))
--- 282,288 ----
(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)))
***************
*** 303,309 ****
plist)
(save-excursion
(set-buffer ada-buffer)
!
(set 'plist
;; Try hard to find a default value for filename, so that the user
;; can edit his project file even if the current buffer is not an
--- 303,309 ----
plist)
(save-excursion
(set-buffer ada-buffer)
!
(set 'plist
;; Try hard to find a default value for filename, so that the user
;; can edit his project file even if the current buffer is not an
***************
*** 357,363 ****
'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.
--- 357,363 ----
'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.
***************
*** 373,379 ****
;; Get the project file (either the current one, or a default one)
(setq file (or (assoc file-name ada-xref-project-files)
(assoc nil ada-xref-project-files)))
!
;; If the file was not found, use the default values
(if file
;; Get the value from the file
--- 373,379 ----
;; Get the project file (either the current one, or a default one)
(setq file (or (assoc file-name ada-xref-project-files)
(assoc nil ada-xref-project-files)))
!
;; If the file was not found, use the default values
(if file
;; Get the value from the file
***************
*** 409,418 ****
(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)))
--- 409,418 ----
(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)))
***************
*** 424,433 ****
(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)))
--- 424,433 ----
(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)))
***************
*** 442,448 ****
(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)
--- 442,448 ----
(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)
***************
*** 469,475 ****
(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)))
--- 469,475 ----
(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)))
***************
*** 650,656 ****
(not ada-tight-gvd-integration))
:style toggle :selected ada-tight-gvd-integration]))
)
!
;; for Emacs
(let* ((menu (or (lookup-key ada-mode-map [menu-bar Ada])
;; Emacs-21.4's easymenu.el downcases the events.
--- 650,656 ----
(not ada-tight-gvd-integration))
:style toggle :selected ada-tight-gvd-integration]))
)
!
;; for Emacs
(let* ((menu (or (lookup-key ada-mode-map [menu-bar Ada])
;; Emacs-21.4's easymenu.el downcases the events.
***************
*** 699,705 ****
'("Goto Declaration Other Frame" . ada-goto-declaration-other-frame))
(define-key goto-menu [Decl]
'("Goto Declaration/Body" . ada-goto-declaration))
!
(define-key edit-menu [rem] '("----" . nil))
(define-key edit-menu [Complete] '("Complete Identifier"
. ada-complete-identifier))
--- 699,705 ----
'("Goto Declaration Other Frame" . ada-goto-declaration-other-frame))
(define-key goto-menu [Decl]
'("Goto Declaration/Body" . ada-goto-declaration))
!
(define-key edit-menu [rem] '("----" . nil))
(define-key edit-menu [Complete] '("Complete Identifier"
. ada-complete-identifier))
***************
*** 745,751 ****
(not ada-xref-project-files)
(string= ada-prj-default-project-file ""))
(ada-reread-prj-file)))
!
(defun ada-xref-push-pos (filename position)
"Push (FILENAME, POSITION) on the position ring for cross-references."
(setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring))
--- 745,751 ----
(not ada-xref-project-files)
(string= ada-prj-default-project-file ""))
(ada-reread-prj-file)))
!
(defun ada-xref-push-pos (filename position)
"Push (FILENAME, POSITION) on the position ring for cross-references."
(setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring))
***************
*** 787,807 ****
;; 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)
--- 787,807 ----
;; 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)
***************
*** 810,827 ****
(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
--- 810,827 ----
(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
***************
*** 846,852 ****
(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
--- 846,852 ----
(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
***************
*** 921,927 ****
(set 'project (plist-put project (intern (match-string 1))
(match-string 2))))))
(forward-line 1))
!
(if src_dir (set 'project (plist-put project 'src_dir
(reverse src_dir))))
(if obj_dir (set 'project (plist-put project 'obj_dir
--- 921,927 ----
(set 'project (plist-put project (intern (match-string 1))
(match-string 2))))))
(forward-line 1))
!
(if src_dir (set 'project (plist-put project 'src_dir
(reverse src_dir))))
(if obj_dir (set 'project (plist-put project 'obj_dir
***************
*** 946,952 ****
;; 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)
--- 946,952 ----
;; 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)
***************
*** 954,960 ****
;; 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))
--- 954,960 ----
;; 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))
***************
*** 964,976 ****
(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))
!
;; Kill the project buffer
(kill-buffer nil)
(set-buffer ada-buffer)
--- 964,976 ----
(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))
!
;; Kill the project buffer
(kill-buffer nil)
(set-buffer ada-buffer)
***************
*** 985,992 ****
;; directory.
(setq compilation-search-path (list nil default-directory))
))
!
!
(defun ada-find-references (&optional pos arg local-only)
"Find all references to the entity under POS.
Calls gnatfind to find the references.
--- 985,992 ----
;; directory.
(setq compilation-search-path (list nil default-directory))
))
!
!
(defun ada-find-references (&optional pos arg local-only)
"Find all references to the entity under POS.
Calls gnatfind to find the references.
***************
*** 1061,1067 ****
(save-excursion
(set-buffer "*gnatfind*")
(setq old-contents (buffer-string))))
!
(compile-internal command "No more references" "gnatfind")
;; Hide the "Compilation" menu
--- 1061,1067 ----
(save-excursion
(set-buffer "*gnatfind*")
(setq old-contents (buffer-string))))
!
(compile-internal command "No more references" "gnatfind")
;; Hide the "Compilation" menu
***************
*** 1251,1257 ****
;; 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)))
--- 1251,1257 ----
;; 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)))
***************
*** 1260,1266 ****
;; 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)
--- 1260,1266 ----
;; 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)
***************
*** 1274,1289 ****
(cmd (ada-xref-get-project-field field))
(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)))
--- 1274,1289 ----
(cmd (ada-xref-get-project-field field))
(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)))
***************
*** 1293,1299 ****
;; 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)
--- 1293,1299 ----
;; 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)
***************
*** 1321,1327 ****
;; 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: "
--- 1321,1327 ----
;; 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: "
***************
*** 1412,1418 ****
;; 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
--- 1412,1418 ----
;; 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
***************
*** 1429,1435 ****
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)
--- 1429,1435 ----
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)
***************
*** 1480,1486 ****
(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)))
--- 1480,1486 ----
(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)))
***************
*** 1516,1522 ****
(while (and (not found) dir-list)
(set 'found (concat (file-name-as-directory (car dir-list))
(file-name-nondirectory file)))
!
(unless (file-exists-p found)
(set 'found nil))
(set 'dir-list (cdr dir-list)))
--- 1516,1522 ----
(while (and (not found) dir-list)
(set 'found (concat (file-name-as-directory (car dir-list))
(file-name-nondirectory file)))
!
(unless (file-exists-p found)
(set 'found nil))
(set 'dir-list (cdr dir-list)))
***************
*** 1587,1600 ****
(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
--- 1587,1600 ----
(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
***************
*** 1605,1639 ****
(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)
--- 1605,1639 ----
(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)
***************
*** 1657,1663 ****
(set-buffer buffer)
(find-file original-file)
(ada-require-project-file)))
!
;; we choose the first possible completion and we
;; return the absolute file name
(let ((filename (ada-find-src-file-in-dir file)))
--- 1657,1663 ----
(set-buffer buffer)
(find-file original-file)
(ada-require-project-file)))
!
;; we choose the first possible completion and we
;; return the absolute file name
(let ((filename (ada-find-src-file-in-dir file)))
***************
*** 1687,1693 ****
;; If at end of buffer (e.g the buffer is empty), error
(if (>= (point) (point-max))
(error "No identifier on point"))
!
;; goto first character of the identifier/operator (skip backward < and >
;; since they are part of multiple character operators
(goto-char pos)
--- 1687,1693 ----
;; If at end of buffer (e.g the buffer is empty), error
(if (>= (point) (point-max))
(error "No identifier on point"))
!
;; goto first character of the identifier/operator (skip backward < and >
;; since they are part of multiple character operators
(goto-char pos)
***************
*** 1724,1730 ****
(if (looking-at "[a-zA-Z0-9_]+")
(set 'identifier (match-string 0))
(error "No identifier around")))
!
;; Build the identlist
(set 'identlist (ada-make-identlist))
(ada-set-name identlist (downcase identifier))
--- 1724,1730 ----
(if (looking-at "[a-zA-Z0-9_]+")
(set 'identifier (match-string 0))
(error "No identifier around")))
!
;; Build the identlist
(set 'identlist (ada-make-identlist))
(ada-set-name identlist (downcase identifier))
***************
*** 1739,1745 ****
(defun ada-get-all-references (identlist)
"Completes and returns IDENTLIST with the information extracted
from the ali file (definition file and places where it is referenced)."
!
(let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
declaration-found)
(set-buffer ali-buffer)
--- 1739,1745 ----
(defun ada-get-all-references (identlist)
"Completes and returns IDENTLIST with the information extracted
from the ali file (definition file and places where it is referenced)."
!
(let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
declaration-found)
(set-buffer ali-buffer)
***************
*** 1749,1755 ****
;; First attempt: we might already be on the declaration of the identifier
;; We want to look for the declaration only in a definite interval (after
;; the "^X ..." line for the current file, and before the next "^X" line
!
(if (re-search-forward
(concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
nil t)
--- 1749,1755 ----
;; First attempt: we might already be on the declaration of the identifier
;; We want to look for the declaration only in a definite interval (after
;; the "^X ..." line for the current file, and before the next "^X" line
!
(if (re-search-forward
(concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
nil t)
***************
*** 1768,1774 ****
;; have to fall back on other algorithms
(unless declaration-found
!
;; Since we alread know the number of the file, search for a direct
;; reference to it
(goto-char (point-min))
--- 1768,1774 ----
;; have to fall back on other algorithms
(unless declaration-found
!
;; Since we alread know the number of the file, search for a direct
;; reference to it
(goto-char (point-min))
***************
*** 1796,1802 ****
"[^0-9]"
(ada-column-of identlist) "\\>")
nil t)
!
;; If still not found, then either the declaration is unknown
;; or the source file has been modified since the ali file was
;; created
--- 1796,1802 ----
"[^0-9]"
(ada-column-of identlist) "\\>")
nil t)
!
;; If still not found, then either the declaration is unknown
;; or the source file has been modified since the ali file was
;; created
***************
*** 1831,1837 ****
)))
)
!
;; Now that we have found a suitable line in the .ali file, get the
;; information available
(beginning-of-line)
--- 1831,1837 ----
)))
)
!
;; Now that we have found a suitable line in the .ali file, get the
;; information available
(beginning-of-line)
***************
*** 1854,1866 ****
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)
))
))
--- 1854,1866 ----
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)
))
))
***************
*** 1913,1928 ****
(error (concat "No declaration of "
(ada-name-of identlist)
" recorded in .ali file")))
!
;; one => should be the right one
((= len 1)
(goto-line (caar declist)))
!
;; more than one => display choice list
(t
(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")
--- 1913,1928 ----
(error (concat "No declaration of "
(ada-name-of identlist)
" recorded in .ali file")))
!
;; one => should be the right one
((= len 1)
(goto-line (caar declist)))
!
;; more than one => display choice list
(t
(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")
***************
*** 1994,2000 ****
)
;; 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
--- 1994,2000 ----
)
;; 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
***************
*** 2007,2013 ****
(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))
--- 2007,2013 ----
(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))
***************
*** 2046,2072 ****
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))
--- 2046,2072 ----
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))
***************
*** 2080,2102 ****
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)))
--- 2080,2102 ----
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)))
***************
*** 2109,2120 ****
(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")
--- 2109,2120 ----
(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")
***************
*** 2315,2321 ****
(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)
--- 2315,2321 ----
(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)
- [Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el,
Miles Bader <=