/[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.13 by lektu, Tue Feb 4 13:24:34 2003 UTC revision 1.14 by lektu, Tue Apr 29 23:40:08 2003 UTC
# Line 1  Line 1 
1  ;;; ada-xref.el --- for lookup and completion in Ada mode  ;;; ada-xref.el --- for lookup and completion in Ada mode
2    
3  ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002  ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002, 2003
4  ;;    Free Software Foundation, Inc.  ;;    Free Software Foundation, Inc.
5    
6  ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>  ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
7  ;;      Rolf Ebert <ebert@inf.enst.fr>  ;;      Rolf Ebert <ebert@inf.enst.fr>
8  ;;      Emmanuel Briot <briot@gnat.com>  ;;      Emmanuel Briot <briot@gnat.com>
9  ;; Maintainer: Emmanuel Briot <briot@gnat.com>  ;; Maintainer: Emmanuel Briot <briot@gnat.com>
10  ;; Ada Core Technologies's version:   Revision: 1.155.2.8 (GNAT 3.15)  ;; Ada Core Technologies's version:   Revision: 1.181
11  ;; Keywords: languages ada xref  ;; Keywords: languages ada xref
12    
13  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 66  the application." Line 66  the application."
66  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."
67    :type 'string :group 'ada)    :type 'string :group 'ada)
68    
69    (defcustom ada-gnatls-args '("-v")
70      "*Arguments to pass to gnatfind when the location of the runtime is searched.
71    Typical use is to pass --RTS=soft-floats on some systems that support it.
72    
73    You can also add -I- if you do not want the current directory to be included.
74    Otherwise, going from specs to bodies and back will first look for files in the
75    current directory. This only has an impact if you are not using project files,
76    but only ADA_INCLUDE_PATH."
77      :type '(repeat string) :group 'ada)
78    
79  (defcustom ada-prj-default-comp-opt "-gnatq -gnatQ"  (defcustom ada-prj-default-comp-opt "-gnatq -gnatQ"
80    "Default compilation options."    "Default compilation options."
81    :type 'string :group 'ada)    :type 'string :group 'ada)
# Line 202  It has the following format: Line 212  It has the following format:
212  \((project_name . value) (project_name . value) ...)  \((project_name . value) (project_name . value) ...)
213  As always, the values of the project file are defined through properties.")  As always, the values of the project file are defined through properties.")
214    
215    
216    ;; ----- Identlist manipulation -------------------------------------------
217    ;; An identlist is a vector that is used internally to reference an identifier
218    ;; To facilitate its use, we provide the following macros
219    
220    (defmacro ada-make-identlist () (make-vector 8 nil))
221    (defmacro ada-name-of   (identlist)    (list 'aref identlist 0))
222    (defmacro ada-line-of   (identlist)    (list 'aref identlist 1))
223    (defmacro ada-column-of (identlist)    (list 'aref identlist 2))
224    (defmacro ada-file-of   (identlist)    (list 'aref identlist 3))
225    (defmacro ada-ali-index-of    (identlist) (list 'aref identlist 4))
226    (defmacro ada-declare-file-of (identlist) (list 'aref identlist 5))
227    (defmacro ada-references-of   (identlist) (list 'aref identlist 6))
228    (defmacro ada-on-declaration  (identlist) (list 'aref identlist 7))
229    
230    (defmacro ada-set-name         (identlist name) (list 'aset identlist 0 name))
231    (defmacro ada-set-line         (identlist line) (list 'aset identlist 1 line))
232    (defmacro ada-set-column       (identlist col)  (list 'aset identlist 2 col))
233    (defmacro ada-set-file         (identlist file) (list 'aset identlist 3 file))
234    (defmacro ada-set-ali-index   (identlist index) (list 'aset identlist 4 index))
235    (defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file))
236    (defmacro ada-set-references   (identlist ref)  (list 'aset identlist 6 ref))
237    (defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))
238    
239    (defsubst ada-get-ali-buffer (file)
240      "Reads the ali file into a new buffer, and returns this buffer's name"
241      (find-file-noselect (ada-get-ali-file-name file)))
242    
243    
244    ;; -----------------------------------------------------------------------
245    
246  (defun ada-quote-cmd (cmd)  (defun ada-quote-cmd (cmd)
247    "Duplicates all \\ characters in CMD so that it can be passed to `compile'"    "Duplicates all \\ characters in CMD so that it can be passed to `compile'"
248    (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))    (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
# Line 220  CROSS-PREFIX is the prefix to use for th Line 261  CROSS-PREFIX is the prefix to use for th
261          ;;  Even if we get an error, delete the *gnatls* buffer          ;;  Even if we get an error, delete the *gnatls* buffer
262          (unwind-protect          (unwind-protect
263              (progn              (progn
264                (call-process (concat cross-prefix "gnatls")                (apply 'call-process (concat cross-prefix "gnatls")
265                              nil t nil "-v")                       (append '(nil t nil) ada-gnatls-args))
266                (goto-char (point-min))                (goto-char (point-min))
267    
268                ;;  Source path                ;;  Source path
# Line 230  CROSS-PREFIX is the prefix to use for th Line 271  CROSS-PREFIX is the prefix to use for th
271                (forward-line 1)                (forward-line 1)
272                (while (not (looking-at "^$"))                (while (not (looking-at "^$"))
273                  (back-to-indentation)                  (back-to-indentation)
274                  (unless (looking-at "<Current_Directory>")                  (if (looking-at "<Current_Directory>")
275                        (add-to-list 'ada-xref-runtime-library-specs-path  ".")
276                    (add-to-list 'ada-xref-runtime-library-specs-path                    (add-to-list 'ada-xref-runtime-library-specs-path
277                                 (buffer-substring-no-properties                                 (buffer-substring-no-properties
278                                  (point)                                  (point)
# Line 243  CROSS-PREFIX is the prefix to use for th Line 285  CROSS-PREFIX is the prefix to use for th
285                (forward-line 1)                (forward-line 1)
286                (while (not (looking-at "^$"))                (while (not (looking-at "^$"))
287                  (back-to-indentation)                  (back-to-indentation)
288                  (unless (looking-at "<Current_Directory>")                  (if (looking-at "<Current_Directory>")
289                        (add-to-list 'ada-xref-runtime-library-ali-path ".")
290                    (add-to-list 'ada-xref-runtime-library-ali-path                    (add-to-list 'ada-xref-runtime-library-ali-path
291                                 (buffer-substring-no-properties                                 (buffer-substring-no-properties
292                                  (point)                                  (point)
# Line 312  replaced by the name including the exten Line 355  replaced by the name including the exten
355                              (cond                              (cond
356                               (ada-prj-default-project-file                               (ada-prj-default-project-file
357                                ada-prj-default-project-file)                                ada-prj-default-project-file)
358                               (file                               (file (ada-prj-find-prj-file file t))
                               (ada-prj-get-prj-dir file))  
359                               (t                               (t
360                                (message (concat "Not editing an Ada file,"                                (message (concat "Not editing an Ada file,"
361                                                 "and no default project "                                                 "and no default project "
# Line 433  All the directories are returned as abso Line 475  All the directories are returned as abso
475    
476  (defun ada-xref-update-project-menu ()  (defun ada-xref-update-project-menu ()
477    "Update the menu Ada->Project, with the list of available project files."    "Update the menu Ada->Project, with the list of available project files."
   (interactive)  
478    (let (submenu)    (let (submenu)
479    
480      ;;  Create the standard items      ;;  Create the standard items
# Line 475  All the directories are returned as abso Line 516  All the directories are returned as abso
516       (or ada-xref-project-files '(nil)))       (or ada-xref-project-files '(nil)))
517    
518       (if (not ada-xemacs)       (if (not ada-xemacs)
519           (if (and (lookup-key ada-mode-map [menu-bar Ada])           (if (lookup-key ada-mode-map [menu-bar Ada Project])
520                    (lookup-key ada-mode-map [menu-bar Ada Project]))               (setcdr (lookup-key ada-mode-map [menu-bar Ada Project])
521               (setcdr (lookup-key ada-mode-map [menu-bar Ada Project])                       submenu)))
522                       submenu)      ))
            (if (lookup-key ada-mode-map [menu-bar ada Project])  
                (setcdr (lookup-key ada-mode-map [menu-bar ada Project])  
                        submenu))))  
      ))  
523    
524    
525  ;;-------------------------------------------------------------  ;;-------------------------------------------------------------
# Line 528  Completion is available." Line 565  Completion is available."
565        (error (concat filename " not found in src_dir")))))        (error (concat filename " not found in src_dir")))))
566    
567    
 ;; ----- Keybindings ------------------------------------------------------  
   
 (defun ada-add-keymap ()  
   "Add new key bindings when using `ada-xrel.el'."  
   (interactive)  
   (if ada-xemacs  
       (progn  
         (define-key ada-mode-map '(shift button3) 'ada-point-and-xref)  
         (define-key ada-mode-map '(control tab) 'ada-complete-identifier))  
     (define-key ada-mode-map [C-tab] 'ada-complete-identifier)  
     (define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref))  
   
   (define-key ada-mode-map "\C-co"    'ff-find-other-file)  
   (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame)  
   (define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration)  
   (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference)  
   (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)  
   (define-key ada-mode-map "\C-cc"  'ada-change-prj)  
   (define-key ada-mode-map "\C-cd"  'ada-set-default-project-file)  
   (define-key ada-mode-map "\C-cg"  'ada-gdb-application)  
   (define-key ada-mode-map "\C-cr"  'ada-run-application)  
   (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)  
   (define-key ada-mode-map "\C-c\C-r" 'ada-find-references)  
   (define-key ada-mode-map "\C-cl" 'ada-find-local-references)  
   (define-key ada-mode-map "\C-c\C-v" 'ada-check-current)  
   (define-key ada-mode-map "\C-cf" 'ada-find-file)  
   )  
   
 ;; ----- Menus --------------------------------------------------------------  
 (defun ada-add-ada-menu ()  
   "Add some items to the standard Ada mode menu.  
 The items are added to the menu called NAME, which should be the same  
 name as was passed to `ada-create-menu'."  
   (interactive)  
   (if ada-xemacs  
       (let* ((menu-list '("Ada"))  
              (goto-menu '("Ada" "Goto"))  
              (edit-menu '("Ada" "Edit"))  
              (help-menu '("Ada" "Help"))  
              (options-menu (list "Ada" "Options")))  
         (funcall (symbol-function 'add-menu-button)  
                  menu-list ["Check file" ada-check-current  
                             (string= mode-name "Ada")] "Goto")  
         (funcall (symbol-function 'add-menu-button)  
                  menu-list ["Compile file" ada-compile-current  
                             (string= mode-name "Ada")] "Goto")  
         (funcall (symbol-function 'add-menu-button)  
                  menu-list ["Build" ada-compile-application t] "Goto")  
         (funcall (symbol-function 'add-menu-button)  
                  menu-list ["Run" ada-run-application t] "Goto")  
         (funcall (symbol-function 'add-menu-button)  
                  menu-list ["Debug" ada-gdb-application t] "Goto")  
         (funcall (symbol-function 'add-menu-button)  
                  menu-list ["--" nil t] "Goto")  
         (funcall (symbol-function 'add-menu-button)  
                  goto-menu ["Goto Parent Unit" ada-goto-parent t]  
                  "Next compilation error")  
         (funcall (symbol-function 'add-menu-button)  
                  goto-menu ["Goto References to any entity"  
                             ada-find-any-references t]  
                  "Next compilation error")  
         (funcall (symbol-function 'add-menu-button)  
                  goto-menu ["List References" ada-find-references t]  
                  "Next compilation error")  
         (funcall (symbol-function 'add-menu-button)  
                  goto-menu ["List Local References" ada-find-local-references t]  
                  "Next compilation error")  
         (funcall (symbol-function 'add-menu-button)  
                  goto-menu ["Goto Declaration Other Frame"  
                             ada-goto-declaration-other-frame t]  
                  "Next compilation error")  
         (funcall (symbol-function 'add-menu-button)  
                  goto-menu ["Goto Declaration/Body"  
                             ada-goto-declaration t]  
                  "Next compilation error")  
         (funcall (symbol-function 'add-menu-button)  
                  goto-menu ["Goto Previous Reference"  
                             ada-xref-goto-previous-reference t]  
                  "Next compilation error")  
         (funcall (symbol-function 'add-menu-button)  
                  goto-menu ["--" nil t] "Next compilation error")  
         (funcall (symbol-function 'add-menu-button)  
                  edit-menu ["Complete Identifier"  
                             ada-complete-identifier t]  
                  "Indent Line")  
         (funcall (symbol-function 'add-menu-button)  
                  edit-menu ["--------" nil t] "Indent Line")  
         (funcall (symbol-function 'add-menu-button)  
                  help-menu ["Gnat User Guide" (info "gnat_ug")])  
         (funcall (symbol-function 'add-menu-button)  
                  help-menu ["Gnat Reference Manual" (info "gnat_rm")])  
         (funcall (symbol-function 'add-menu-button)  
                  help-menu ["Gcc Documentation" (info "gcc")])  
         (funcall (symbol-function 'add-menu-button)  
                  help-menu ["Gdb Documentation" (info "gdb")])  
         (funcall (symbol-function 'add-menu-button)  
                  help-menu ["Ada95 Reference Manual" (info "arm95")])  
         (funcall (symbol-function 'add-menu-button)  
                  options-menu  
                  ["Show Cross-References in Other Buffer"  
                   (setq ada-xref-other-buffer  
                         (not ada-xref-other-buffer))  
                   :style toggle :selected ada-xref-other-buffer])  
         (funcall (symbol-function 'add-menu-button)  
                  options-menu  
                  ["Automatically Recompile for Cross-References"  
                   (setq ada-xref-create-ali (not ada-xref-create-ali))  
                   :style toggle :selected ada-xref-create-ali])  
         (funcall (symbol-function 'add-menu-button)  
                  options-menu  
                  ["Confirm Commands"  
                   (setq ada-xref-confirm-compile  
                         (not ada-xref-confirm-compile))  
                   :style toggle :selected ada-xref-confirm-compile])  
         (if (string-match "gvd" ada-prj-default-debugger)  
             (funcall (symbol-function 'add-menu-button)  
                      options-menu  
                      ["Tight Integration With Gnu Visual Debugger"  
                       (setq ada-tight-gvd-integration  
                             (not ada-tight-gvd-integration))  
                       :style toggle :selected ada-tight-gvd-integration]))  
         )  
   
     ;; for Emacs  
     (let* ((menu      (or (lookup-key ada-mode-map [menu-bar Ada])  
                           ;; Emacs-21.4's easymenu.el downcases the events.  
                           (lookup-key ada-mode-map [menu-bar ada])))  
            (edit-menu (or (lookup-key menu [Edit]) (lookup-key menu [edit])))  
            (help-menu (or (lookup-key menu [Help]) (lookup-key menu [help])))  
            (goto-menu (or (lookup-key menu [Goto]) (lookup-key menu [goto])))  
            (options-menu (or (lookup-key menu [Options])  
                              (lookup-key menu [options]))))  
   
       (define-key-after menu [Check] '("Check file" . ada-check-current)  
         'Customize)  
       (define-key-after menu [Compile] '("Compile file" . ada-compile-current)  
         'Check)  
       (define-key-after menu [Build]   '("Build" . ada-compile-application)  
         'Compile)  
       (define-key-after menu [Run]     '("Run"   . ada-run-application) 'Build)  
       (define-key-after menu [Debug]   '("Debug" . ada-gdb-application) 'Run)  
       (define-key-after menu [rem]     '("--"    . nil) 'Debug)  
       (define-key-after menu [Project]  
         (cons "Project" (make-sparse-keymap)) 'rem)  
   
       (define-key help-menu [Gnat_ug]  
         '("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug"))))  
       (define-key help-menu [Gnat_rm]  
         '("Gnat Reference Manual" . (lambda() (interactive) (info "gnat_rm"))))  
       (define-key help-menu [Gcc]  
         '("Gcc Documentation" . (lambda() (interactive) (info "gcc"))))  
       (define-key help-menu [gdb]  
         '("Gdb Documentation" . (lambda() (interactive) (info "gdb"))))  
       (define-key help-menu [arm95]  
         '("Ada95 Reference Manual" . (lambda() (interactive) (info "arm95"))))  
   
       (define-key goto-menu [rem]    '("----" . nil))  
       (define-key goto-menu [Parent] '("Goto Parent Unit"  
                                        . ada-goto-parent))  
       (define-key goto-menu [References-any]  
         '("Goto References to any entity" . ada-find-any-references))  
       (define-key goto-menu [References]  
         '("List References" . ada-find-references))  
       (define-key goto-menu [Local-References]  
         '("List Local References" . ada-find-local-references))  
       (define-key goto-menu [Prev]  
         '("Goto Previous Reference" . ada-xref-goto-previous-reference))  
       (define-key goto-menu [Decl-other]  
         '("Goto Declaration Other Frame" . ada-goto-declaration-other-frame))  
       (define-key goto-menu [Decl]  
         '("Goto Declaration/Body" . ada-goto-declaration))  
   
       (define-key edit-menu [rem] '("----" . nil))  
       (define-key edit-menu [Complete] '("Complete Identifier"  
                                          . ada-complete-identifier))  
   
       (define-key-after options-menu [xrefrecompile]  
         '(menu-item "Automatically Recompile for Cross-References"  
                     (lambda()(interactive)  
                       (setq ada-xref-create-ali (not ada-xref-create-ali)))  
                     :button (:toggle . ada-xref-create-ali)) t)  
       (define-key-after options-menu [xrefconfirm]  
         '(menu-item "Confirm Commands"  
                    (lambda()(interactive)  
                      (setq ada-xref-confirm-compile  
                            (not ada-xref-confirm-compile)))  
                    :button (:toggle . ada-xref-confirm-compile)) t)  
       (define-key-after options-menu [xrefother]  
         '(menu-item "Show Cross-References in Other Buffer"  
                    (lambda()(interactive)  
                      (setq ada-xref-other-buffer (not ada-xref-other-buffer)))  
                    :button (:toggle . ada-xref-other-buffer)) t)  
   
       (if (string-match "gvd" ada-prj-default-debugger)  
           (define-key-after options-menu [tightgvd]  
             '(menu-item "Tight Integration With Gnu Visual Debugger"  
                         (lambda()(interactive)  
                           (setq ada-tight-gvd-integration  
                                 (not ada-tight-gvd-integration)))  
                         :button (:toggle . ada-tight-gvd-integration)) t))  
   
       (define-key edit-menu [rem3] '("------------" . nil))  
       (define-key edit-menu [open-file-from-src-path]  
         '("Search File on source path..." . ada-find-file))  
       )  
     )  
   (ada-xref-update-project-menu)  
   )  
   
568  ;; ----- Utilities -------------------------------------------------  ;; ----- Utilities -------------------------------------------------
569    
570  (defun ada-require-project-file ()  (defun ada-require-project-file ()
# Line 766  name as was passed to `ada-create-menu'. Line 594  name as was passed to `ada-create-menu'.
594  This is overriden on VMS to convert from VMS filenames to Unix filenames."  This is overriden on VMS to convert from VMS filenames to Unix filenames."
595    name)    name)
596    
597  (defun ada-set-default-project-file (name)  (defun ada-set-default-project-file (name &optional keep-existing)
598    "Set the file whose name is NAME as the default project file."    "Set the file whose name is NAME as the default project file.
599    If KEEP-EXISTING is true and a project file has already been loaded, nothing
600    is done. This is meant to be used from ada-mode-hook, for instance to force
601    a project file unless the user has already loaded one."
602    (interactive "fProject file:")    (interactive "fProject file:")
603    (setq ada-prj-default-project-file name)    (if (or (not keep-existing)
604    (ada-reread-prj-file name)            (not ada-prj-default-project-file)
605    )            (equal ada-prj-default-project-file ""))
606          (progn
607            (setq ada-prj-default-project-file name)
608            (ada-reread-prj-file name))))
609    
610  ;; ------ Handling the project file -----------------------------  ;; ------ Handling the project file -----------------------------
611    
612  (defun ada-prj-find-prj-file (&optional no-user-question)  (defun ada-prj-find-prj-file (&optional file no-user-question)
613    "Find the prj file associated with the current buffer.    "Find the prj file associated with FILE (or the current buffer if nil).
614  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
615  found, and do not ask the user.  found, and do not ask the user.
616  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
# Line 789  file. If none is set, return nil." Line 623  file. If none is set, return nil."
623      ;;  the current buffer is not a real file (for instance an emerge buffer)      ;;  the current buffer is not a real file (for instance an emerge buffer)
624    
625      (if (or (not (string= mode-name "Ada"))      (if (or (not (string= mode-name "Ada"))
626              (not (buffer-file-name))              (not (buffer-file-name)))
627              (and ada-prj-default-project-file  
628                   (not (string= ada-prj-default-project-file ""))))          (if (and ada-prj-default-project-file
629          (set 'selected ada-prj-default-project-file)                   (not (string= ada-prj-default-project-file "")))
630                (setq selected ada-prj-default-project-file)
631              (setq selected nil))
632    
633        ;;  other cases: use a more complex algorithm        ;;  other cases: use a more complex algorithm
634    
635        (let* ((current-file (buffer-file-name))        (let* ((current-file (or file (buffer-file-name)))
636               (first-choice (concat               (first-choice (concat
637                              (file-name-sans-extension current-file)                              (file-name-sans-extension current-file)
638                              ada-project-file-extension))                              ada-project-file-extension))
# Line 836  file. If none is set, return nil." Line 672  file. If none is set, return nil."
672                                   counter                                   counter
673                                   (nth (1- counter) prj-files)))                                   (nth (1- counter) prj-files)))
674                    (setq counter (1+ counter))                    (setq counter (1+ counter))
675    
676                    ))) ; end of with-output-to ...                    ))) ; end of with-output-to ...
677              (setq choice nil)              (setq choice nil)
678              (while (or              (while (or
# Line 859  file. If none is set, return nil." Line 696  file. If none is set, return nil."
696              (unless (string= ada-last-prj-file "")              (unless (string= ada-last-prj-file "")
697                (set 'selected ada-last-prj-file))))                (set 'selected ada-last-prj-file))))
698           )))           )))
699      selected  
700        (or selected "default.adp")
701      ))      ))
702    
703    
# Line 872  The current buffer should be the ada-fil Line 710  The current buffer should be the ada-fil
710              (ada-buffer (current-buffer)))              (ada-buffer (current-buffer)))
711          (setq prj-file (expand-file-name prj-file))          (setq prj-file (expand-file-name prj-file))
712    
713            ;;  Set the project file as the active one.
714            (setq ada-prj-default-project-file prj-file)
715    
716          ;;  Initialize the project with the default values          ;;  Initialize the project with the default values
717          (ada-xref-set-default-prj-values 'project (current-buffer))          (ada-xref-set-default-prj-values 'project (current-buffer))
718    
# Line 880  The current buffer should be the ada-fil Line 721  The current buffer should be the ada-fil
721          ;;  find-file anyway, since the speedbar frame is special and does not          ;;  find-file anyway, since the speedbar frame is special and does not
722          ;;  allow the selection of a file in it.          ;;  allow the selection of a file in it.
723    
724          (let* ((buffer (run-hook-with-args-until-success          (if (file-exists-p prj-file)
725                         'ada-load-project-hook prj-file)))              (progn
726            (unless buffer                (let* ((buffer (run-hook-with-args-until-success
727                                  'ada-load-project-hook prj-file)))
728                    (unless buffer
729              (setq buffer (find-file-noselect prj-file nil)))              (setq buffer (find-file-noselect prj-file nil)))
730            (set-buffer buffer))            (set-buffer buffer))
731    
# Line 938  The current buffer should be the ada-fil Line 781  The current buffer should be the ada-fil
781                                               (reverse run_cmd))))                                               (reverse run_cmd))))
782          (set 'project (plist-put project 'debug_post_cmd          (set 'project (plist-put project 'debug_post_cmd
783                                   (reverse debug_post_cmd)))                                   (reverse debug_post_cmd)))
784          (set 'project (plist-put project 'debug_pre_cmd                (set 'project (plist-put project 'debug_pre_cmd
785                                   (reverse debug_pre_cmd)))                                         (reverse debug_pre_cmd)))
786    
787                  ;; Kill the project buffer
788                  (kill-buffer nil)
789                  (set-buffer ada-buffer)
790                  )
791    
792              ;;  Else the file wasn't readable (probably the default project).
793              ;;  We initialize it with the current environment variables.
794              ;;  We need to add the startup directory in front so that
795              ;;  files locally redefined are properly found. We cannot
796              ;;  add ".", which varies too much depending on what the
797              ;;  current buffer is.
798              (set 'project
799                   (plist-put project 'src_dir
800                              (append
801                               (list command-line-default-directory)
802                               (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
803                               (list "." default-directory))))
804              (set 'project
805                   (plist-put project 'obj_dir
806                              (append
807                               (list command-line-default-directory)
808                               (split-string (or (getenv "ADA_OBJECTS_PATH") "") ":")
809                               (list "." default-directory))))
810              )
811    
812    
813          ;;  Delete the default project file from the list, if it is there.          ;;  Delete the default project file from the list, if it is there.
814          ;;  Note that in that case, this default project is the only one in          ;;  Note that in that case, this default project is the only one in
# Line 952  The current buffer should be the ada-fil Line 821  The current buffer should be the ada-fil
821              (setcdr (assoc prj-file ada-xref-project-files) project)              (setcdr (assoc prj-file ada-xref-project-files) project)
822            (add-to-list 'ada-xref-project-files (cons prj-file project)))            (add-to-list 'ada-xref-project-files (cons prj-file project)))
823    
         ;;  Set the project file as the active one.  
         (setq ada-prj-default-project-file prj-file)  
   
824          ;; Sets up the compilation-search-path so that Emacs is able to          ;; Sets up the compilation-search-path so that Emacs is able to
825          ;; go to the source of the errors in a compilation buffer          ;; go to the source of the errors in a compilation buffer
826          (setq compilation-search-path (ada-xref-get-src-dir-field))          (setq compilation-search-path (ada-xref-get-src-dir-field))
# Line 971  The current buffer should be the ada-fil Line 837  The current buffer should be the ada-fil
837               (append (mapcar 'directory-file-name compilation-search-path)               (append (mapcar 'directory-file-name compilation-search-path)
838                       ada-search-directories))                       ada-search-directories))
839    
         ;; Kill the project buffer  
         (kill-buffer nil)  
         (set-buffer ada-buffer)  
   
840          (ada-xref-update-project-menu)          (ada-xref-update-project-menu)
841          )          )
842    
# Line 1079  buffer *gnatfind* if it exists." Line 941  buffer *gnatfind* if it exists."
941    
942  (defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))  (defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))
943    
 ;; ----- Identlist manipulation -------------------------------------------  
 ;; An identlist is a vector that is used internally to reference an identifier  
 ;; To facilitate its use, we provide the following macros  
   
 (defmacro ada-make-identlist () (make-vector 8 nil))  
 (defmacro ada-name-of   (identlist)    (list 'aref identlist 0))  
 (defmacro ada-line-of   (identlist)    (list 'aref identlist 1))  
 (defmacro ada-column-of (identlist)    (list 'aref identlist 2))  
 (defmacro ada-file-of   (identlist)    (list 'aref identlist 3))  
 (defmacro ada-ali-index-of    (identlist) (list 'aref identlist 4))  
 (defmacro ada-declare-file-of (identlist) (list 'aref identlist 5))  
 (defmacro ada-references-of   (identlist) (list 'aref identlist 6))  
 (defmacro ada-on-declaration  (identlist) (list 'aref identlist 7))  
   
 (defmacro ada-set-name         (identlist name) (list 'aset identlist 0 name))  
 (defmacro ada-set-line         (identlist line) (list 'aset identlist 1 line))  
 (defmacro ada-set-column       (identlist col)  (list 'aset identlist 2 col))  
 (defmacro ada-set-file         (identlist file) (list 'aset identlist 3 file))  
 (defmacro ada-set-ali-index   (identlist index) (list 'aset identlist 4 index))  
 (defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file))  
 (defmacro ada-set-references   (identlist ref)  (list 'aset identlist 6 ref))  
 (defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))  
   
 (defsubst ada-get-ali-buffer (file)  
   "Reads the ali file into a new buffer, and returns this buffer's name"  
   (find-file-noselect (ada-get-ali-file-name file)))  
   
   
   
944  ;; ----- Identifier Completion --------------------------------------------  ;; ----- Identifier Completion --------------------------------------------
945  (defun ada-complete-identifier (pos)  (defun ada-complete-identifier (pos)
946    "Tries to complete the identifier around POS.    "Tries to complete the identifier around POS.
# Line 1150  option." Line 983  option."
983  ;; ----- Cross-referencing ----------------------------------------  ;; ----- Cross-referencing ----------------------------------------
984    
985  (defun ada-point-and-xref ()  (defun ada-point-and-xref ()
986   "Calls `mouse-set-point' and then `ada-goto-declaration'."    "Jump to the declaration of the entity below the cursor."
987    (interactive)    (interactive)
988    (mouse-set-point last-input-event)    (mouse-set-point last-input-event)
989    (ada-goto-declaration (point)))    (ada-goto-declaration (point)))
990    
991    (defun ada-point-and-xref-body ()
992      "Jump to the body of the entity under the cursor."
993      (interactive)
994      (mouse-set-point last-input-event)
995      (ada-goto-body (point)))
996    
997    (defun ada-goto-body (pos &optional other-frame)
998      "Display the body of the entity around POS.
999    If the entity doesn't have a body, display its declaration.
1000    As a side effect, the buffer for the declaration is also open."
1001      (interactive "d")
1002      (ada-goto-declaration pos other-frame)
1003    
1004      ;;  Temporarily force the display in the same buffer, since we
1005      ;;  already changed previously
1006      (let ((ada-xref-other-buffer nil))
1007        (ada-goto-declaration (point) nil)))
1008    
1009  (defun ada-goto-declaration (pos &optional other-frame)  (defun ada-goto-declaration (pos &optional other-frame)
1010    "Display the declaration of the identifier around POS.    "Display the declaration of the identifier around POS.
1011  The declaration is shown in another buffer if `ada-xref-other-buffer' is  The declaration is shown in another buffer if `ada-xref-other-buffer' is
# Line 1258  If ARG is not nil, ask for user confirma Line 1109  If ARG is not nil, ask for user confirma
1109      ;;  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
1110      ;;  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,
1111      ;;  which gets confused by newline characters.      ;;  which gets confused by newline characters.
1112      (if (not (string-match "cmdproxy.exe" shell-file-name))      (if (not (string-match ".exe" shell-file-name))
1113          (setq cmd (concat cmd "\n\n")))          (setq cmd (concat cmd "\n\n")))
1114    
1115      (compile (ada-quote-cmd cmd))))      (compile (ada-quote-cmd cmd))))
# Line 1291  command, and should be either comp_cmd ( Line 1142  command, and should be either comp_cmd (
1142      ;;  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
1143      ;;  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,
1144      ;;  which gets confused by newline characters.      ;;  which gets confused by newline characters.
1145      (if (not (string-match "cmdproxy.exe" shell-file-name))      (if (not (string-match ".exe" shell-file-name))
1146          (setq cmd (concat cmd "\n\n")))          (setq cmd (concat cmd "\n\n")))
1147    
1148      (compile (ada-quote-cmd cmd))))      (compile (ada-quote-cmd cmd))))
# Line 1395  If ARG is non-nil, ask the user to confi Line 1246  If ARG is non-nil, ask the user to confi
1246      (if (or arg ada-xref-confirm-compile)      (if (or arg ada-xref-confirm-compile)
1247          (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))          (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
1248    
1249      (let (comint-exec      (let ((old-comint-exec (symbol-function 'comint-exec))
1250              comint-exec
1251            in-post-mode            in-post-mode
1252            gud-gdb-massage-args)            gud-gdb-massage-args)
1253    
# Line 1410  If ARG is non-nil, ask the user to confi Line 1262  If ARG is non-nil, ask the user to confi
1262        (if post-cmd        (if post-cmd
1263          (set 'post-cmd (concat post-cmd "\n")))          (set 'post-cmd (concat post-cmd "\n")))
1264    
1265    
1266        ;;  Temporarily replaces the definition of `comint-exec' so that we        ;;  Temporarily replaces the definition of `comint-exec' so that we
1267        ;;  can execute commands before running gdb.        ;;  can execute commands before running gdb.
1268          (make-local-variable 'comint-exec)
1269        (fset 'comint-exec        (fset 'comint-exec
1270              `(lambda (buffer name command startfile switches)              `(lambda (buffer name command startfile switches)
1271                 (let (compilation-buffer-name-function)                 (let (compilation-buffer-name-function)
# Line 1435  If ARG is non-nil, ask the user to confi Line 1289  If ARG is non-nil, ask the user to confi
1289            (funcall (symbol-function 'jdb) cmd)            (funcall (symbol-function 'jdb) cmd)
1290          (gdb cmd))          (gdb cmd))
1291    
1292          ;;  Restore the standard fset command (or for instance C-U M-x shell
1293          ;;  wouldn't work anymore
1294    
1295          (fset 'comint-exec old-comint-exec)
1296    
1297        ;;  Send post-commands to the debugger        ;;  Send post-commands to the debugger
1298        (process-send-string (get-buffer-process (current-buffer)) post-cmd)        (process-send-string (get-buffer-process (current-buffer)) post-cmd)
1299    
# Line 1465  automatically modifies the setup for all Line 1324  automatically modifies the setup for all
1324    
1325    ;; Reread the location of the standard runtime library    ;; Reread the location of the standard runtime library
1326    (ada-initialize-runtime-library    (ada-initialize-runtime-library
1327     (or (ada-xref-get-project-field 'cross-prefix) ""))     (or (ada-xref-get-project-field 'cross_prefix) ""))
1328    )    )
1329    
1330  ;; ------ Private routines  ;; ------ Private routines
# Line 1780  from the ali file (definition file and p Line 1639  from the ali file (definition file and p
1639        (unless (re-search-forward (concat (ada-ali-index-of identlist)        (unless (re-search-forward (concat (ada-ali-index-of identlist)
1640                                           "|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*"                                           "|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*"
1641                                           (ada-line-of identlist)                                           (ada-line-of identlist)
1642                                           "[^etp]"                                           "[^etpzkd<>=^]"
1643                                           (ada-column-of identlist) "\\>")                                           (ada-column-of identlist) "\\>")
1644                                   nil t)                                   nil t)
1645    
# Line 1886  This function is disabled for operators, Line 1745  This function is disabled for operators,
1745            (goto-char (point-max))            (goto-char (point-max))
1746            (while (re-search-backward my-regexp nil t)            (while (re-search-backward my-regexp nil t)
1747              (save-excursion              (save-excursion
1748                (setq line-ali (count-lines 1 (point)))                (set 'line-ali (count-lines 1 (point)))
1749                (beginning-of-line)                (beginning-of-line)
1750                ;; have a look at the line and column numbers                ;; have a look at the line and column numbers
1751                (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")                (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
# Line 1977  opens a new window to show the declarati Line 1836  opens a new window to show the declarati
1836      (set 'locations (list (list (match-string 1 ali-line) ;; line      (set 'locations (list (list (match-string 1 ali-line) ;; line
1837                                  (match-string 2 ali-line) ;; column                                  (match-string 2 ali-line) ;; column
1838                                  (ada-declare-file-of identlist))))                                  (ada-declare-file-of identlist))))
1839      (while (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line start)      (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)"
1840                             ali-line start)
1841        (setq line  (match-string 1 ali-line)        (setq line  (match-string 1 ali-line)
1842              col   (match-string 2 ali-line)              col   (match-string 3 ali-line)
1843              start (match-end 2))              start (match-end 3))
1844    
1845        ;;  it there was a file number in the same line        ;;  it there was a file number in the same line
1846        (if (string-match (concat "\\([0-9]+\\)|\\([^|bc]+\\)?"        (if (string-match (concat "[^{(<]\\([0-9]+\\)|\\([^|bc]+\\)?"
1847                                  (match-string 0 ali-line))                                  (match-string 0 ali-line))
1848                          ali-line)                          ali-line)
1849            (let ((file-number (match-string 1 ali-line)))            (let ((file-number (match-string 1 ali-line)))
# Line 2377  find-file...." Line 2237  find-file...."
2237    
2238    ;; Completion for file names in the mini buffer should ignore .ali files    ;; Completion for file names in the mini buffer should ignore .ali files
2239    (add-to-list 'completion-ignored-extensions ".ali")    (add-to-list 'completion-ignored-extensions ".ali")
2240    
2241      (ada-xref-update-project-menu)
2242    )    )
2243    
2244    
# Line 2395  find-file...." Line 2257  find-file...."
2257    (if (ada-find-file-in-dir "ddd" exec-path)    (if (ada-find-file-in-dir "ddd" exec-path)
2258        (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))        (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
2259    
 ;;  Set the keymap once and for all, so that the keys set by the user in his  
 ;;  config file are not overwritten every time we open a new file.  
 (ada-add-ada-menu)  
 (ada-add-keymap)  
   
2260  (add-hook 'ada-mode-hook 'ada-xref-initialize)  (add-hook 'ada-mode-hook 'ada-xref-initialize)
2261    
2262  ;;  Initializes the cross references to the runtime library  ;;  Initializes the cross references to the runtime library
# Line 2410  find-file...." Line 2267  find-file...."
2267       (append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path)       (append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path)
2268               ada-search-directories))               ada-search-directories))
2269    
 ;;  Make sure that the files are always associated with a project file. Since  
 ;;  the project file has some fields that are used for the editor (like the  
 ;;  casing exceptions), it has to be read before the user edits a file).  
 ;; (add-hook 'ada-mode-hook  
 ;;        (lambda()  
 ;;          (let ((file (ada-prj-find-prj-file t)))  
 ;;            (if file (ada-reread-prj-file file)))))  
   
2270  (provide 'ada-xref)  (provide 'ada-xref)
2271    
2272  ;;; ada-xref.el ends here  ;;; ada-xref.el ends here

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

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