/[emacs]/emacs/lisp/progmodes/ada-xref.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/ada-xref.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.18 by kfstorm, Tue Jun 29 13:01:14 2004 UTC revision 1.18.2.1 by miles, Sat Sep 4 12:01:10 2004 UTC
# Line 33  Line 33 
33  ;;; for lookup and completion in Ada mode.  ;;; for lookup and completion in Ada mode.
34  ;;;  ;;;
35  ;;; If a file *.`adp' exists in the ada-file directory, then it is  ;;; If a file *.`adp' exists in the ada-file directory, then it is
36  ;;; read for configuration informations. It is read only the first  ;;; read for configuration informations.  It is read only the first
37  ;;; time a cross-reference is asked for, and is not read later.  ;;; time a cross-reference is asked for, and is not read later.
38    
39  ;;; You need Emacs >= 20.2 to run this package  ;;; You need Emacs >= 20.2 to run this package
# Line 55  Otherwise create either a new buffer or Line 55  Otherwise create either a new buffer or
55    
56  (defcustom ada-xref-create-ali nil  (defcustom ada-xref-create-ali nil
57    "*If non-nil, run gcc whenever the cross-references are not up-to-date.    "*If non-nil, run gcc whenever the cross-references are not up-to-date.
58  If nil, the cross-reference mode will never run gcc."  If nil, the cross-reference mode never runs gcc."
59    :type 'boolean :group 'ada)    :type 'boolean :group 'ada)
60    
61  (defcustom ada-xref-confirm-compile nil  (defcustom ada-xref-confirm-compile nil
62    "*If non-nil, always ask for user confirmation before compiling or running    "*If non-nil, ask for confirmation before compiling or running the application."
 the application."  
63    :type 'boolean :group 'ada)    :type 'boolean :group 'ada)
64    
65  (defcustom ada-krunch-args "0"  (defcustom ada-krunch-args "0"
66    "*Maximum number of characters for filenames created by gnatkr.    "*Maximum number of characters for filenames created by `gnatkr'.
67  Set to 0, if you don't use crunched filenames. This should be a string."  Set to 0, if you don't use crunched filenames.  This should be a string."
68    :type 'string :group 'ada)    :type 'string :group 'ada)
69    
70  (defcustom ada-gnatls-args '("-v")  (defcustom ada-gnatls-args '("-v")
71    "*Arguments to pass to gnatfind when the location of the runtime is searched.    "*Arguments to pass to `gnatfind' to find location of the runtime.
72  Typical use is to pass --RTS=soft-floats on some systems that support it.  Typical use is to pass `--RTS=soft-floats' on some systems that support it.
73    
74  You can also add -I- if you do not want the current directory to be included.  You can also add `-I-' if you do not want the current directory to be included.
75  Otherwise, going from specs to bodies and back will first look for files in the  Otherwise, going from specs to bodies and back will first look for files in the
76  current directory. This only has an impact if you are not using project files,  current directory.  This only has an impact if you are not using project files,
77  but only ADA_INCLUDE_PATH."  but only ADA_INCLUDE_PATH."
78    :type '(repeat string) :group 'ada)    :type '(repeat string) :group 'ada)
79    
# Line 91  but only ADA_INCLUDE_PATH." Line 90  but only ADA_INCLUDE_PATH."
90    :type 'string :group 'ada)    :type 'string :group 'ada)
91    
92  (defcustom ada-prj-default-gnatmake-opt "-g"  (defcustom ada-prj-default-gnatmake-opt "-g"
93    "Default options for gnatmake."    "Default options for `gnatmake'."
94    :type 'string :group 'ada)    :type 'string :group 'ada)
95    
96  (defcustom ada-prj-gnatfind-switches "-rf"  (defcustom ada-prj-gnatfind-switches "-rf"
97    "Default switches to use for gnatfind.    "Default switches to use for `gnatfind'.
98  You should modify this variable, for instance to add -a, if you are working  You should modify this variable, for instance to add `-a', if you are working
99  in an environment where most ALI files are write-protected.  in an environment where most ALI files are write-protected.
100  The command gnatfind is used every time you choose the menu  The command `gnatfind' is used every time you choose the menu
101  \"Show all references\"."  \"Show all references\"."
102    :type 'string :group 'ada)    :type 'string :group 'ada)
103    
# Line 106  The command gnatfind is used every time Line 105  The command gnatfind is used every time
105    (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"    (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
106            " ${comp_opt}")            " ${comp_opt}")
107    "*Default command to be used to compile a single file.    "*Default command to be used to compile a single file.
108  Emacs will add the filename at the end of this command. This is the same  Emacs will add the filename at the end of this command.  This is the same
109  syntax as in the project file."  syntax as in the project file."
110    :type 'string :group 'ada)    :type 'string :group 'ada)
111    
112  (defcustom ada-prj-default-debugger "${cross_prefix}gdb"  (defcustom ada-prj-default-debugger "${cross_prefix}gdb"
113    "*Default name of the debugger. We recommend either `gdb',    "*Default name of the debugger.  We recommend either `gdb',
114  `gdb --emacs_gdbtk' or `ddd --tty -fullname'."  `gdb --emacs_gdbtk' or `ddd --tty -fullname'."
115    :type 'string :group 'ada)    :type 'string :group 'ada)
116    
# Line 129  this string is not empty." Line 128  this string is not empty."
128    :type '(file :must-match t) :group 'ada)    :type '(file :must-match t) :group 'ada)
129    
130  (defcustom ada-gnatstub-opts "-q -I${src_dir}"  (defcustom ada-gnatstub-opts "-q -I${src_dir}"
131    "*List of the options to pass to gnatsub to generate the body of a package.    "*List of the options to pass to `gnatsub' to generate the body of a package.
132  This has the same syntax as in the project file (with variable substitution)."  This has the same syntax as in the project file (with variable substitution)."
133    :type 'string :group 'ada)    :type 'string :group 'ada)
134    
# Line 139  Otherwise, ask the user for the name of Line 138  Otherwise, ask the user for the name of
138    :type 'boolean :group 'ada)    :type 'boolean :group 'ada)
139    
140  (defconst is-windows (memq system-type (quote (windows-nt)))  (defconst is-windows (memq system-type (quote (windows-nt)))
141    "True if we are running on windows NT or windows 95.")    "True if we are running on Windows NT or Windows 95.")
142    
143  (defcustom ada-tight-gvd-integration nil  (defcustom ada-tight-gvd-integration nil
144    "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.    "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
# Line 149  If GVD is not the debugger used, nothing Line 148  If GVD is not the debugger used, nothing
148  (defcustom ada-xref-search-with-egrep t  (defcustom ada-xref-search-with-egrep t
149    "*If non-nil, use egrep to find the possible declarations for an entity.    "*If non-nil, use egrep to find the possible declarations for an entity.
150  This alternate method is used when the exact location was not found in the  This alternate method is used when the exact location was not found in the
151  information provided by GNAT. However, it might be expensive if you have a lot  information provided by GNAT.  However, it might be expensive if you have a lot
152  of sources, since it will search in all the files in your project."  of sources, since it will search in all the files in your project."
153    :type 'boolean :group 'ada)    :type 'boolean :group 'ada)
154    
# Line 161  This hook should be used to support new Line 160  This hook should be used to support new
160    
161  If the function can load the file with the given filename, it should create a  If the function can load the file with the given filename, it should create a
162  buffer that contains a conversion of the file to the standard format of the  buffer that contains a conversion of the file to the standard format of the
163  project files, and return that buffer. (the usual \"src_dir=\" or \"obj_dir=\"  project files, and return that buffer.  (The usual \"src_dir=\" or \"obj_dir=\"
164  lines).  It should return nil if it doesn't know how to convert that project  lines.)  It should return nil if it doesn't know how to convert that project
165  file.")  file.")
166    
167    
# Line 192  Used to go back to these positions.") Line 191  Used to go back to these positions.")
191    (if (string-match "cmdproxy.exe" shell-file-name)    (if (string-match "cmdproxy.exe" shell-file-name)
192        "cd /d"        "cd /d"
193      "cd")      "cd")
194    "Command to use to change to a specific directory. On windows systems    "Command to use to change to a specific directory.
195  using cmdproxy.exe as the shell, we need to use /d or the drive is never  On Windows systems using `cmdproxy.exe' as the shell,
196  changed.")  we need to use `/d' or the drive is never changed.")
197    
198  (defvar ada-command-separator (if is-windows " && " "\n")  (defvar ada-command-separator (if is-windows " && " "\n")
199    "Separator to use when sending multiple commands to `compile' or    "Separator to use between multiple commands to `compile' or `start-process'.
200  `start-process'.  `cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use
 cmdproxy.exe doesn't recognize multiple-line commands, so we have to use  
201  \"&&\" for now.")  \"&&\" for now.")
202    
203  (defconst ada-xref-pos-ring-max 16  (defconst ada-xref-pos-ring-max 16
# Line 247  As always, the values of the project fil Line 245  As always, the values of the project fil
245  ;; -----------------------------------------------------------------------  ;; -----------------------------------------------------------------------
246    
247  (defun ada-quote-cmd (cmd)  (defun ada-quote-cmd (cmd)
248    "Duplicates all \\ characters in CMD so that it can be passed to `compile'"    "Duplicate all \\ characters in CMD so that it can be passed to `compile'."
249    (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))    (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
250    
251  (defun ada-initialize-runtime-library (cross-prefix)  (defun ada-initialize-runtime-library (cross-prefix)
252    "Initializes the variables for the runtime library location.    "Initialize the variables for the runtime library location.
253  CROSS-PREFIX is the prefix to use for the gnatls command"  CROSS-PREFIX is the prefix to use for the gnatls command."
254    (save-excursion    (save-excursion
255      (setq ada-xref-runtime-library-specs-path '()      (setq ada-xref-runtime-library-specs-path '()
256            ada-xref-runtime-library-ali-path   '())            ada-xref-runtime-library-ali-path   '())
# Line 591  This is overriden on VMS to convert from Line 589  This is overriden on VMS to convert from
589  (defun ada-set-default-project-file (name &optional keep-existing)  (defun ada-set-default-project-file (name &optional keep-existing)
590    "Set the file whose name is NAME as the default project file.    "Set the file whose name is NAME as the default project file.
591  If KEEP-EXISTING is true and a project file has already been loaded, nothing  If KEEP-EXISTING is true and a project file has already been loaded, nothing
592  is done. This is meant to be used from ada-mode-hook, for instance to force  is done.  This is meant to be used from `ada-mode-hook', for instance, to force
593  a project file unless the user has already loaded one."  a project file unless the user has already loaded one."
594    (interactive "fProject file:")    (interactive "fProject file:")
595    (if (or (not keep-existing)    (if (or (not keep-existing)
# Line 608  a project file unless the user has alrea Line 606  a project file unless the user has alrea
606  If NO-USER-QUESTION is non-nil, use a default file if not project file was  If NO-USER-QUESTION is non-nil, use a default file if not project file was
607  found, and do not ask the user.  found, and do not ask the user.
608  If the buffer is not an Ada buffer, associate it with the default project  If the buffer is not an Ada buffer, associate it with the default project
609  file. If none is set, return nil."  file.  If none is set, return nil."
610    
611    (let (selected)    (let (selected)
612    
# Line 711  The current buffer should be the ada-fil Line 709  The current buffer should be the ada-fil
709          (ada-xref-set-default-prj-values 'project (current-buffer))          (ada-xref-set-default-prj-values 'project (current-buffer))
710    
711          ;;  Do not use find-file below, since we don't want to show this          ;;  Do not use find-file below, since we don't want to show this
712          ;;  buffer. If the file is open through speedbar, we can't use          ;;  buffer.  If the file is open through speedbar, we can't use
713          ;;  find-file anyway, since the speedbar frame is special and does not          ;;  find-file anyway, since the speedbar frame is special and does not
714          ;;  allow the selection of a file in it.          ;;  allow the selection of a file in it.
715    
# Line 786  The current buffer should be the ada-fil Line 784  The current buffer should be the ada-fil
784            ;;  Else the file wasn't readable (probably the default project).            ;;  Else the file wasn't readable (probably the default project).
785            ;;  We initialize it with the current environment variables.            ;;  We initialize it with the current environment variables.
786            ;;  We need to add the startup directory in front so that            ;;  We need to add the startup directory in front so that
787            ;;  files locally redefined are properly found. We cannot            ;;  files locally redefined are properly found.  We cannot
788            ;;  add ".", which varies too much depending on what the            ;;  add ".", which varies too much depending on what the
789            ;;  current buffer is.            ;;  current buffer is.
790            (set 'project            (set 'project
# Line 836  The current buffer should be the ada-fil Line 834  The current buffer should be the ada-fil
834    
835      ;;  No prj file ? => Setup default values      ;;  No prj file ? => Setup default values
836      ;;  Note that nil means that all compilation modes will first look in the      ;;  Note that nil means that all compilation modes will first look in the
837      ;;  current directory, and only then in the current file's directory. This      ;;  current directory, and only then in the current file's directory.  This
838      ;;  current file is assumed at this point to be in the common source      ;;  current file is assumed at this point to be in the common source
839      ;;  directory.      ;;  directory.
840      (setq compilation-search-path (list nil default-directory))      (setq compilation-search-path (list nil default-directory))
# Line 846  The current buffer should be the ada-fil Line 844  The current buffer should be the ada-fil
844  (defun ada-find-references (&optional pos arg local-only)  (defun ada-find-references (&optional pos arg local-only)
845    "Find all references to the entity under POS.    "Find all references to the entity under POS.
846  Calls gnatfind to find the references.  Calls gnatfind to find the references.
847  if ARG is t, the contents of the old *gnatfind* buffer is preserved.  If ARG is t, the contents of the old *gnatfind* buffer is preserved.
848  if LOCAL-ONLY is t, only the declarations in the current file are returned."  If LOCAL-ONLY is t, only the declarations in the current file are returned."
849    (interactive "d    (interactive "d\nP")
 P")  
850    (ada-require-project-file)    (ada-require-project-file)
851    
852    (let* ((identlist (ada-read-identifier pos))    (let* ((identlist (ada-read-identifier pos))
# Line 872  P") Line 869  P")
869    
870  (defun ada-find-local-references (&optional pos arg)  (defun ada-find-local-references (&optional pos arg)
871    "Find all references to the entity under POS.    "Find all references to the entity under POS.
872  Calls gnatfind to find the references.  Calls `gnatfind' to find the references.
873  if ARG is t, the contents of the old *gnatfind* buffer is preserved."  If ARG is t, the contents of the old *gnatfind* buffer is preserved."
874    (interactive "d    (interactive "d\nP")
 P")  
875    (ada-find-references pos arg t))    (ada-find-references pos arg t))
876    
877  (defun ada-find-any-references  (defun ada-find-any-references
878    (entity &optional file line column local-only append)    (entity &optional file line column local-only append)
879    "Search for references to any entity whose name is ENTITY.    "Search for references to any entity whose name is ENTITY.
880  ENTITY was first found the location given by FILE, LINE and COLUMN.  ENTITY was first found the location given by FILE, LINE and COLUMN.
881  If LOCAL-ONLY is t, then only the references in file will be listed, which  If LOCAL-ONLY is t, then list only the references in FILE, which
882  is much faster.  is much faster.
883  If APPEND is t, then the output of the command will be append to the existing  If APPEND is t, then append the output of the command to the existing
884  buffer *gnatfind* if it exists."  buffer `*gnatfind*', if there is one."
885    (interactive "sEntity name: ")    (interactive "sEntity name: ")
886    (ada-require-project-file)    (ada-require-project-file)
887    
888    ;;  Prepare the gnatfind command. Note that we must protect the quotes    ;;  Prepare the gnatfind command.  Note that we must protect the quotes
889    ;;  around operators, so that they are correctly handled and can be    ;;  around operators, so that they are correctly handled and can be
890    ;;  processed (gnatfind \"+\":...).    ;;  processed (gnatfind \"+\":...).
891    (let* ((quote-entity    (let* ((quote-entity
# Line 921  buffer *gnatfind* if it exists." Line 917  buffer *gnatfind* if it exists."
917            (set-buffer "*gnatfind*")            (set-buffer "*gnatfind*")
918            (setq old-contents (buffer-string))))            (setq old-contents (buffer-string))))
919    
920      (compile-internal command "No more references" "gnatfind")      (let ((compilation-error "reference"))
921          (compilation-start command))
922    
923      ;;  Hide the "Compilation" menu      ;;  Hide the "Compilation" menu
924      (save-excursion      (save-excursion
# Line 941  buffer *gnatfind* if it exists." Line 938  buffer *gnatfind* if it exists."
938  ;; ----- Identifier Completion --------------------------------------------  ;; ----- Identifier Completion --------------------------------------------
939  (defun ada-complete-identifier (pos)  (defun ada-complete-identifier (pos)
940    "Tries to complete the identifier around POS.    "Tries to complete the identifier around POS.
941  The feature is only available if the files where compiled not using the -gnatx  The feature is only available if the files where compiled without
942  option."  the option `-gnatx'."
943    (interactive "d")    (interactive "d")
944    (ada-require-project-file)    (ada-require-project-file)
945    
# Line 1026  If OTHER-FRAME is non-nil, display the c Line 1023  If OTHER-FRAME is non-nil, display the c
1023           ;; entity, whose references are not given by GNAT           ;; entity, whose references are not given by GNAT
1024           (if (and (file-exists-p ali-file)           (if (and (file-exists-p ali-file)
1025                    (file-newer-than-file-p ali-file (ada-file-of identlist)))                    (file-newer-than-file-p ali-file (ada-file-of identlist)))
1026               (message "No cross-reference found. It might be a predefined entity.")               (message "No cross-reference found--may be a predefined entity.")
1027    
1028             ;; Else, look in every ALI file, except if the user doesn't want that             ;; Else, look in every ALI file, except if the user doesn't want that
1029             (if ada-xref-search-with-egrep             (if ada-xref-search-with-egrep
1030                 (ada-find-in-src-path identlist other-frame)                 (ada-find-in-src-path identlist other-frame)
1031               (message "Cross-referencing information is not up-to-date. Please recompile.")               (message "Cross-referencing information is not up-to-date; please recompile.")
1032               )))))))               )))))))
1033    
1034  (defun ada-goto-declaration-other-frame (pos)  (defun ada-goto-declaration-other-frame (pos)
# Line 1052  The declation is shown in another frame Line 1049  The declation is shown in another frame
1049    
1050  (defun ada-get-absolute-dir-list (dir-list root-dir)  (defun ada-get-absolute-dir-list (dir-list root-dir)
1051    "Returns the list of absolute directories found in dir-list.    "Returns the list of absolute directories found in dir-list.
1052  If a directory is a relative directory, the value of ROOT-DIR is added in  If a directory is a relative directory, add the value of ROOT-DIR in front."
 front."  
1053    (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))    (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
1054    
1055  (defun ada-set-environment ()  (defun ada-set-environment ()
1056    "Return the new value for process-environment.    "Prepare an environment for Ada compilation.
1057    This returns a new value to use for `process-environment',
1058    but does not actually put it into use.
1059  It modifies the source path and object path with the values found in the  It modifies the source path and object path with the values found in the
1060  project file."  project file."
1061    (let ((include   (getenv "ADA_INCLUDE_PATH"))    (let ((include   (getenv "ADA_INCLUDE_PATH"))
# Line 1082  project file." Line 1080  project file."
1080        process-environment))))        process-environment))))
1081    
1082  (defun ada-compile-application (&optional arg)  (defun ada-compile-application (&optional arg)
1083    "Compiles the application, using the command found in the project file.    "Compile the application, using the command found in the project file.
1084  If ARG is not nil, ask for user confirmation."  If ARG is not nil, ask for user confirmation."
1085    (interactive "P")    (interactive "P")
1086    (ada-require-project-file)    (ada-require-project-file)
# Line 1104  If ARG is not nil, ask for user confirma Line 1102  If ARG is not nil, ask for user confirma
1102          (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))          (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1103    
1104      ;;  Insert newlines so as to separate the name of the commands to run      ;;  Insert newlines so as to separate the name of the commands to run
1105      ;;  and the output of the commands. this doesn't work with cmdproxy.exe,      ;;  and the output of the commands.  This doesn't work with cmdproxy.exe,
1106      ;;  which gets confused by newline characters.      ;;  which gets confused by newline characters.
1107      (if (not (string-match ".exe" shell-file-name))      (if (not (string-match ".exe" shell-file-name))
1108          (setq cmd (concat cmd "\n\n")))          (setq cmd (concat cmd "\n\n")))
# Line 1137  command, and should be either comp_cmd ( Line 1135  command, and should be either comp_cmd (
1135          (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))          (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1136    
1137      ;;  Insert newlines so as to separate the name of the commands to run      ;;  Insert newlines so as to separate the name of the commands to run
1138      ;;  and the output of the commands. this doesn't work with cmdproxy.exe,      ;;  and the output of the commands.  This doesn't work with cmdproxy.exe,
1139      ;;  which gets confused by newline characters.      ;;  which gets confused by newline characters.
1140      (if (not (string-match ".exe" shell-file-name))      (if (not (string-match ".exe" shell-file-name))
1141          (setq cmd (concat cmd "\n\n")))          (setq cmd (concat cmd "\n\n")))
# Line 1152  If ARG is not nil, ask for user confirma Line 1150  If ARG is not nil, ask for user confirma
1150    
1151  (defun ada-run-application (&optional arg)  (defun ada-run-application (&optional arg)
1152    "Run the application.    "Run the application.
1153  if ARG is not-nil, asks for user confirmation."  if ARG is not-nil, ask for user confirmation."
1154    (interactive)    (interactive)
1155    (ada-require-project-file)    (ada-require-project-file)
1156    
# Line 1227  If ARG is non-nil, ask the user to confi Line 1225  If ARG is non-nil, ask the user to confi
1225          ;;  We make sure that gvd swallows the new frame, not the one the          ;;  We make sure that gvd swallows the new frame, not the one the
1226          ;;  user has been using until now          ;;  user has been using until now
1227          ;;  The frame is made invisible initially, so that GtkPlug gets a          ;;  The frame is made invisible initially, so that GtkPlug gets a
1228          ;;  chance to fully manage it. Then it works fine with Enlightenment          ;;  chance to fully manage it.  Then it works fine with Enlightenment
1229          ;;  as well          ;;  as well
1230          (let ((frame (make-frame '((visibility . nil)))))          (let ((frame (make-frame '((visibility . nil)))))
1231            (set 'cmd (concat            (set 'cmd (concat
# Line 1297  If ARG is non-nil, ask the user to confi Line 1295  If ARG is non-nil, ask the user to confi
1295        (end-of-buffer)        (end-of-buffer)
1296    
1297        ;;  Display both the source window and the debugger window (the former        ;;  Display both the source window and the debugger window (the former
1298        ;;  above the latter). No need to show the debugger window unless it        ;;  above the latter).  No need to show the debugger window unless it
1299        ;;  is going to have some relevant information.        ;;  is going to have some relevant information.
1300        (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))        (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
1301                (string-match "--tty" cmd))                (string-match "--tty" cmd))
# Line 1328  automatically modifies the setup for all Line 1326  automatically modifies the setup for all
1326    "Update the cross-references for FILE.    "Update the cross-references for FILE.
1327  This in fact recompiles FILE to create ALI-FILE-NAME.  This in fact recompiles FILE to create ALI-FILE-NAME.
1328  This function returns the name of the file that was recompiled to generate  This function returns the name of the file that was recompiled to generate
1329  the cross-reference information. Note that the ali file can then be deduced by  the cross-reference information.  Note that the ali file can then be deduced by
1330  replacing the file extension with .ali"  replacing the file extension with `.ali'."
1331    ;; kill old buffer    ;; kill old buffer
1332    (if (and ali-file-name    (if (and ali-file-name
1333             (get-file-buffer ali-file-name))             (get-file-buffer ali-file-name))
# Line 1338  replacing the file extension with .ali" Line 1336  replacing the file extension with .ali"
1336    (let* ((name      (ada-convert-file-name file))    (let* ((name      (ada-convert-file-name file))
1337           (body-name (or (ada-get-body-name name) name)))           (body-name (or (ada-get-body-name name) name)))
1338    
1339      ;; Always recompile the body when we can. We thus temporarily switch to a      ;; Always recompile the body when we can.  We thus temporarily switch to a
1340      ;; buffer than contains the body of the unit      ;; buffer than contains the body of the unit
1341      (save-excursion      (save-excursion
1342        (let ((body-visible (find-buffer-visiting body-name))        (let ((body-visible (find-buffer-visiting body-name))
# Line 1347  replacing the file extension with .ali" Line 1345  replacing the file extension with .ali"
1345              (set-buffer body-visible)              (set-buffer body-visible)
1346            (find-file body-name))            (find-file body-name))
1347    
1348          ;; Execute the compilation. Note that we must wait for the end of the          ;; Execute the compilation.  Note that we must wait for the end of the
1349          ;; process, or the ALI file would still not be available.          ;; process, or the ALI file would still not be available.
1350          ;; Unfortunately, the underlying `compile' command that we use is          ;; Unfortunately, the underlying `compile' command that we use is
1351          ;; asynchronous.          ;; asynchronous.
# Line 1377  replacing the file extension with .ali" Line 1375  replacing the file extension with .ali"
1375      found))      found))
1376    
1377  (defun ada-find-ali-file-in-dir (file)  (defun ada-find-ali-file-in-dir (file)
1378    "Find an .ali file in obj_dir. The current buffer must be the Ada file.    "Find an .ali file in obj_dir.  The current buffer must be the Ada file.
1379  Adds build_dir in front of the search path to conform to gnatmake's behavior,  Adds build_dir in front of the search path to conform to gnatmake's behavior,
1380  and the standard runtime location at the end."  and the standard runtime location at the end."
1381    (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))    (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
1382    
1383  (defun ada-find-src-file-in-dir (file)  (defun ada-find-src-file-in-dir (file)
1384    "Find a source file in src_dir. The current buffer must be the Ada file.    "Find a source file in src_dir.  The current buffer must be the Ada file.
1385  Adds src_dir in front of the search path to conform to gnatmake's behavior,  Adds src_dir in front of the search path to conform to gnatmake's behavior,
1386  and the standard runtime location at the end."  and the standard runtime location at the end."
1387    (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))    (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
# Line 1400  the project file." Line 1398  the project file."
1398    ;;      and look for this file    ;;      and look for this file
1399    ;;   2- If this file is found:    ;;   2- If this file is found:
1400    ;;      grep the "^U" lines, and make sure we are not reading the    ;;      grep the "^U" lines, and make sure we are not reading the
1401    ;;      .ali file for a spec file. If we are, go to step 3.    ;;      .ali file for a spec file.  If we are, go to step 3.
1402    ;;   3- If the file is not found or step 2 failed:    ;;   3- If the file is not found or step 2 failed:
1403    ;;      find the name of the "other file", ie the body, and look    ;;      find the name of the "other file", ie the body, and look
1404    ;;      for its associated .ali file by subtituing the extension    ;;      for its associated .ali file by subtituing the extension
# Line 1408  the project file." Line 1406  the project file."
1406    ;; We must also handle the case of separate packages and subprograms:    ;; We must also handle the case of separate packages and subprograms:
1407    ;;   4- If no ali file was found, we try to modify the file name by removing    ;;   4- If no ali file was found, we try to modify the file name by removing
1408    ;;      everything after the last '-' or '.' character, so as to get the    ;;      everything after the last '-' or '.' character, so as to get the
1409    ;;      ali file for the parent unit. If we found an ali file, we check that    ;;      ali file for the parent unit.  If we found an ali file, we check that
1410    ;;      it indeed contains the definition for the separate entity by checking    ;;      it indeed contains the definition for the separate entity by checking
1411    ;;      the 'D' lines. This is done repeatedly, in case the direct parent is    ;;      the 'D' lines.  This is done repeatedly, in case the direct parent is
1412    ;;      also a separate.    ;;      also a separate.
1413    
1414    (save-excursion    (save-excursion
# Line 1423  the project file." Line 1421  the project file."
1421    
1422        ;; If we have a non-standard file name, and this is a spec, we first        ;; If we have a non-standard file name, and this is a spec, we first
1423        ;; look for the .ali file of the body, since this is the one that        ;; look for the .ali file of the body, since this is the one that
1424        ;; contains the most complete information. If not found, we will do what        ;; contains the most complete information.  If not found, we will do what
1425        ;; we can with the .ali file for the spec...        ;; we can with the .ali file for the spec...
1426    
1427        (if (not (string= (file-name-extension file) "ads"))        (if (not (string= (file-name-extension file) "ads"))
# Line 1476  the project file." Line 1474  the project file."
1474    
1475        ;; If still not found, try to recompile the file        ;; If still not found, try to recompile the file
1476        (if (not ali-file-name)        (if (not ali-file-name)
1477            ;; recompile only if the user asked for this. and search the ali            ;; Recompile only if the user asked for this, and search the ali
1478            ;; filename again. We avoid a possible infinite recursion by            ;; filename again.  We avoid a possible infinite recursion by
1479            ;; temporarily disabling the automatic compilation.            ;; temporarily disabling the automatic compilation.
1480    
1481            (if ada-xref-create-ali            (if ada-xref-create-ali
# Line 1485  the project file." Line 1483  the project file."
1483                      (concat (file-name-sans-extension (ada-xref-current file))                      (concat (file-name-sans-extension (ada-xref-current file))
1484                              ".ali"))                              ".ali"))
1485    
1486              (error "Ali file not found. Recompile your file"))              (error "`.ali' file not found; recompile your source file"))
1487    
1488    
1489          ;; same if the .ali file is too old and we must recompile it          ;; same if the .ali file is too old and we must recompile it
# Line 1499  the project file." Line 1497  the project file."
1497    
1498  (defun ada-get-ada-file-name (file original-file)  (defun ada-get-ada-file-name (file original-file)
1499    "Create the complete file name (+directory) for FILE.    "Create the complete file name (+directory) for FILE.
1500  The original file (where the user was) is ORIGINAL-FILE. Search in project  The original file (where the user was) is ORIGINAL-FILE.  Search in project
1501  file for possible paths."  file for possible paths."
1502    
1503    (save-excursion    (save-excursion
# Line 1519  file for possible paths." Line 1517  file for possible paths."
1517            (expand-file-name filename)            (expand-file-name filename)
1518          (error (concat          (error (concat
1519                  (file-name-nondirectory file)                  (file-name-nondirectory file)
1520                  " not found in src_dir. Please check your project file")))                  " not found in src_dir; please check your project file")))
1521    
1522        )))        )))
1523    
# Line 1671  from the ali file (definition file and p Line 1669  from the ali file (definition file and p
1669                (set 'declaration-found nil))))                (set 'declaration-found nil))))
1670    
1671        ;; Still no success ! The ali file must be too old, and we need to        ;; Still no success ! The ali file must be too old, and we need to
1672        ;; use a basic algorithm based on guesses. Note that this only happens        ;; use a basic algorithm based on guesses.  Note that this only happens
1673        ;; if the user does not want us to automatically recompile files        ;; if the user does not want us to automatically recompile files
1674        ;; automatically        ;; automatically
1675        (unless declaration-found        (unless declaration-found
1676          (if (ada-xref-find-in-modified-ali identlist)          (if (ada-xref-find-in-modified-ali identlist)
1677              (set 'declaration-found t)              (set 'declaration-found t)
1678            ;; no more idea to find the declaration. Give up            ;; No more idea to find the declaration.  Give up
1679            (progn            (progn
1680              (kill-buffer ali-buffer)              (kill-buffer ali-buffer)
1681              (error (concat "No declaration of " (ada-name-of identlist)              (error (concat "No declaration of " (ada-name-of identlist)
# Line 1911  is using." Line 1909  is using."
1909    
1910      (save-excursion      (save-excursion
1911    
1912        ;;  Do the grep in all the directories. We do multiple shell        ;;  Do the grep in all the directories.  We do multiple shell
1913        ;;  commands instead of one in case there is no .ali file in one        ;;  commands instead of one in case there is no .ali file in one
1914        ;;  of the directory and the shell stops because of that.        ;;  of the directory and the shell stops because of that.
1915    
# Line 2011  is using." Line 2009  is using."
2009    (file line column identlist &optional other-frame)    (file line column identlist &optional other-frame)
2010    "Select and display FILE, at LINE and COLUMN.    "Select and display FILE, at LINE and COLUMN.
2011  If we do not end on the same identifier as IDENTLIST, find the closest  If we do not end on the same identifier as IDENTLIST, find the closest
2012  match. Kills the .ali buffer at the end.  match.  Kills the .ali buffer at the end.
2013  If OTHER-FRAME is non-nil, creates a new frame to show the file."  If OTHER-FRAME is non-nil, creates a new frame to show the file."
2014    
2015    (let (declaration-buffer)    (let (declaration-buffer)
# Line 2178  This function typically is to be hooked Line 2176  This function typically is to be hooked
2176    (unless (buffer-file-name (car (buffer-list)))    (unless (buffer-file-name (car (buffer-list)))
2177      (set-buffer (cadr (buffer-list))))      (set-buffer (cadr (buffer-list))))
2178    
2179    ;;  Make sure we have a project file (for parameters to gnatstub). Note that    ;;  Make sure we have a project file (for parameters to gnatstub).  Note that
2180    ;;  this might have already been done if we have been called from the hook,    ;;  this might have already been done if we have been called from the hook,
2181    ;;  but this is not an expensive call)    ;;  but this is not an expensive call)
2182    (ada-require-project-file)    (ada-require-project-file)
# Line 2240  find-file...." Line 2238  find-file...."
2238    
2239  ;;  Use gvd or ddd as the default debugger if it was found  ;;  Use gvd or ddd as the default debugger if it was found
2240  ;;  On windows, do not use the --tty switch for GVD, since this is  ;;  On windows, do not use the --tty switch for GVD, since this is
2241  ;;  not supported. Actually, we do not use this on Unix either, since otherwise  ;;  not supported.  Actually, we do not use this on Unix either,
2242  ;;  there is no console window left in GVD, and people have to use the  ;;  since otherwise there is no console window left in GVD,
2243  ;;  Emacs one.  ;;  and people have to use the Emacs one.
2244  ;;  This must be done before initializing the Ada menu.  ;;  This must be done before initializing the Ada menu.
2245  (if (ada-find-file-in-dir "gvd" exec-path)  (if (ada-find-file-in-dir "gvd" exec-path)
2246      (set 'ada-prj-default-debugger "gvd ")      (set 'ada-prj-default-debugger "gvd ")

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.18.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26