emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el


From: Stefan Monnier
Subject: [Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el
Date: Thu, 20 Jun 2002 13:31:57 -0400

Index: emacs/lisp/progmodes/ada-xref.el
diff -c emacs/lisp/progmodes/ada-xref.el:1.10 
emacs/lisp/progmodes/ada-xref.el:1.11
*** emacs/lisp/progmodes/ada-xref.el:1.10       Sat Apr 27 23:17:51 2002
--- emacs/lisp/progmodes/ada-xref.el    Thu Jun 20 13:31:56 2002
***************
*** 1,13 ****
  ;;; ada-xref.el --- for lookup and completion in Ada mode
  
! ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001
  ;;    Free Software Foundation, Inc.
  
  ;; Author: Markus Heritsch <address@hidden>
  ;;      Rolf Ebert <address@hidden>
  ;;      Emmanuel Briot <address@hidden>
  ;; Maintainer: Emmanuel Briot <address@hidden>
! ;; Ada Core Technologies's version:   $Revision: 1.10 $
  ;; Keywords: languages ada xref
  
  ;; This file is part of GNU Emacs.
--- 1,13 ----
  ;;; ada-xref.el --- for lookup and completion in Ada mode
  
! ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002
  ;;    Free Software Foundation, Inc.
  
  ;; Author: Markus Heritsch <address@hidden>
  ;;      Rolf Ebert <address@hidden>
  ;;      Emmanuel Briot <address@hidden>
  ;; Maintainer: Emmanuel Briot <address@hidden>
! ;; Ada Core Technologies's version:   Revision: 1.155.2.8 (GNAT 3.15)
  ;; Keywords: languages ada xref
  
  ;; This file is part of GNU Emacs.
***************
*** 51,57 ****
  Otherwise create either a new buffer or a new frame."
    :type 'boolean :group 'ada)
  
! (defcustom ada-xref-create-ali t
    "*If non-nil, run gcc whenever the cross-references are not up-to-date.
  If nil, the cross-reference mode will never run gcc."
    :type 'boolean :group 'ada)
--- 51,57 ----
  Otherwise create either a new buffer or a new frame."
    :type 'boolean :group 'ada)
  
! (defcustom ada-xref-create-ali nil
    "*If non-nil, run gcc whenever the cross-references are not up-to-date.
  If nil, the cross-reference mode will never run gcc."
    :type 'boolean :group 'ada)
***************
*** 91,97 ****
    :type 'string :group 'ada)
  
  (defcustom ada-prj-default-comp-cmd
!   "${cross_prefix}gcc -x ada -c ${comp_opt} ${full_current}"
    "*Default command to be used to compile a single file.
  Emacs will add the filename at the end of this command. This is the same
  syntax as in the project file."
--- 91,98 ----
    :type 'string :group 'ada)
  
  (defcustom ada-prj-default-comp-cmd
!   (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} 
-cargs"
!         " ${comp_opt}")
    "*Default command to be used to compile a single file.
  Emacs will add the filename at the end of this command. This is the same
  syntax as in the project file."
***************
*** 132,137 ****
--- 133,158 ----
    "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
  If GVD is not the debugger used, nothing happens.")
  
+ (defcustom ada-xref-search-with-egrep t
+   "*If non-nil, use egrep to find the possible declarations for an entity.
+ This alternate method is used when the exact location was not found in the
+ information provided by GNAT. However, it might be expensive if you have a lot
+ of sources, since it will search in all the files in your project."
+   :type 'boolean :group 'ada)
+ 
+ (defvar ada-load-project-hook nil
+   "Hook that is run when loading a project file.
+ Each function in this hook takes one argument FILENAME, that is the name of
+ the project file to load.
+ This hook should be used to support new formats for the project files.
+ 
+ If the function can load the file with the given filename, it should create a
+ buffer that contains a conversion of the file to the standard format of the
+ project files, and return that buffer. (the usual \"src_dir=\" or \"obj_dir=\"
+ lines).  It should return nil if it doesn't know how to convert that project
+ file.")
+ 
+ 
  ;; ------- Nothing to be modified by the user below this
  (defvar ada-last-prj-file ""
    "Name of the last project file entered by the user.")
***************
*** 289,298 ****
           ;;  Ada file or not even associated with a file
           (list 'filename (expand-file-name
                            (cond
-                            (file
-                             (ada-prj-get-prj-dir file))
                             (ada-prj-default-project-file
                              ada-prj-default-project-file)
                             (t
                              (message (concat "Not editing an Ada file,"
                                               "and no default project "
--- 310,319 ----
           ;;  Ada file or not even associated with a file
           (list 'filename (expand-file-name
                            (cond
                             (ada-prj-default-project-file
                              ada-prj-default-project-file)
+                            (file
+                             (ada-prj-get-prj-dir file))
                             (t
                              (message (concat "Not editing an Ada file,"
                                               "and no default project "
***************
*** 436,443 ****
              (append submenu
                      (list (cons (intern name)
                                  (list
!                                  'menu-item (file-name-sans-extension
!                                              (file-name-nondirectory name))
                                   command
                                   :button (cons
                                            :toggle
--- 457,468 ----
              (append submenu
                      (list (cons (intern name)
                                  (list
!                                  'menu-item
!                                  (if (string= (file-name-extension name)
!                                               ada-project-file-extension)
!                                      (file-name-sans-extension
!                                       (file-name-nondirectory name))
!                                    (file-name-nondirectory name))
                                   command
                                   :button (cons
                                            :toggle
***************
*** 515,521 ****
    (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-x" 'ada-reread-prj-file)
    (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)
    (define-key ada-mode-map "\C-cc"  'ada-change-prj)
    (define-key ada-mode-map "\C-cd"  'ada-set-default-project-file)
--- 540,545 ----
***************
*** 523,530 ****
    (define-key ada-mode-map "\C-cr"  'ada-run-application)
    (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)
    (define-key ada-mode-map "\C-c\C-r" 'ada-find-references)
    (define-key ada-mode-map "\C-c\C-v" 'ada-check-current)
!   (define-key ada-mode-map "\C-c\C-f" 'ada-find-file)
    )
  
  ;; ----- Menus --------------------------------------------------------------
--- 547,555 ----
    (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 --------------------------------------------------------------
***************
*** 564,569 ****
--- 589,597 ----
                 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")
***************
*** 620,630 ****
        )
      
      ;; for Emacs
!     (let* ((menu         (lookup-key ada-mode-map [menu-bar ada]))
!          (edit-menu    (lookup-key ada-mode-map [menu-bar ada edit]))
!          (help-menu    (lookup-key ada-mode-map [menu-bar ada help]))
!          (goto-menu    (lookup-key ada-mode-map [menu-bar ada goto]))
!          (options-menu (lookup-key ada-mode-map [menu-bar ada options])))
  
        (define-key-after menu [Check] '("Check file" . ada-check-current)
        'Customize)
--- 648,661 ----
        )
      
      ;; 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)
***************
*** 656,661 ****
--- 687,694 ----
        '("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]
***************
*** 732,738 ****
  (defun ada-set-default-project-file (name)
    "Set the file whose name is NAME as the default project file."
    (interactive "fProject file:")
!   (set 'ada-prj-default-project-file name)
    (ada-reread-prj-file name)
    )
  
--- 765,771 ----
  (defun ada-set-default-project-file (name)
    "Set the file whose name is NAME as the default project file."
    (interactive "fProject file:")
!   (setq ada-prj-default-project-file name)
    (ada-reread-prj-file name)
    )
  
***************
*** 843,850 ****
        ;;  find-file anyway, since the speedbar frame is special and does not
        ;;  allow the selection of a file in it.
  
!       (set-buffer (find-file-noselect prj-file))
!       
        (widen)
        (goto-char (point-min))
  
--- 876,887 ----
        ;;  find-file anyway, since the speedbar frame is special and does not
        ;;  allow the selection of a file in it.
  
!       (let* ((buffer (run-hook-with-args-until-success
!                      'ada-load-project-hook prj-file)))
!         (unless buffer
!           (setq buffer (find-file-noselect prj-file nil)))
!         (set-buffer buffer))
! 
        (widen)
        (goto-char (point-min))
  
***************
*** 930,936 ****
             (append (mapcar 'directory-file-name compilation-search-path)
                     ada-search-directories))
        
!       ;; Kill the .ali buffer
        (kill-buffer nil)
        (set-buffer ada-buffer)
  
--- 967,973 ----
             (append (mapcar 'directory-file-name compilation-search-path)
                     ada-search-directories))
        
!       ;; Kill the project buffer
        (kill-buffer nil)
        (set-buffer ada-buffer)
  
***************
*** 946,957 ****
      ))
        
      
! (defun ada-find-references (&optional pos)
    "Find all references to the entity under POS.
! Calls gnatfind to find the references."
!   (interactive "")
!   (unless pos
!     (set 'pos (point)))
    (ada-require-project-file)
  
    (let* ((identlist (ada-read-identifier pos))
--- 983,995 ----
      ))
        
      
! (defun ada-find-references (&optional pos arg local-only)
    "Find all references to the entity under POS.
! Calls gnatfind to find the references.
! if ARG is t, the contents of the old *gnatfind* buffer is preserved.
! if LOCAL-ONLY is t, only the declarations in the current file are returned."
!   (interactive "d
! P")
    (ada-require-project-file)
  
    (let* ((identlist (ada-read-identifier pos))
***************
*** 965,980 ****
              (file-newer-than-file-p (ada-file-of identlist) alifile))
          (ada-find-any-references (ada-name-of identlist)
                                   (ada-file-of identlist)
!                                  nil nil)
        (ada-find-any-references (ada-name-of identlist)
                                 (ada-file-of identlist)
                                 (ada-line-of identlist)
!                                (ada-column-of identlist))))
    )
  
! (defun ada-find-any-references (entity &optional file line column)
    "Search for references to any entity whose name is ENTITY.
! ENTITY was first found the location given by FILE, LINE and COLUMN."
    (interactive "sEntity name: ")
    (ada-require-project-file)
  
--- 1003,1031 ----
              (file-newer-than-file-p (ada-file-of identlist) alifile))
          (ada-find-any-references (ada-name-of identlist)
                                   (ada-file-of identlist)
!                                  nil nil local-only arg)
        (ada-find-any-references (ada-name-of identlist)
                                 (ada-file-of identlist)
                                 (ada-line-of identlist)
!                                (ada-column-of identlist) local-only arg)))
    )
  
! (defun ada-find-local-references (&optional pos arg)
!   "Find all references to the entity under POS.
! Calls gnatfind to find the references.
! if ARG is t, the contents of the old *gnatfind* buffer is preserved."
!   (interactive "d
! P")
!   (ada-find-references pos arg t))
! 
! (defun ada-find-any-references
!   (entity &optional file line column local-only append)
    "Search for references to any entity whose name is ENTITY.
! ENTITY was first found the location given by FILE, LINE and COLUMN.
! If LOCAL-ONLY is t, then only the references in file will be listed, which
! is much faster.
! If APPEND is t, then the output of the command will be append to the existing
! buffer *gnatfind* if it exists."
    (interactive "sEntity name: ")
    (ada-require-project-file)
  
***************
*** 992,1010 ****
                          quote-entity
                            (if file (concat ":" (file-name-nondirectory file)))
                            (if line (concat ":" line))
!                           (if column (concat ":" column)))))
  
      ;;  If a project file is defined, use it
      (if (and ada-prj-default-project-file
             (not (string= ada-prj-default-project-file "")))
          (setq command (concat command " -p" ada-prj-default-project-file)))
  
      (compile-internal command "No more references" "gnatfind")
  
      ;;  Hide the "Compilation" menu
      (save-excursion
        (set-buffer "*gnatfind*")
!       (local-unset-key [menu-bar compilation-menu]))
      )
    )
  
--- 1043,1075 ----
                          quote-entity
                            (if file (concat ":" (file-name-nondirectory file)))
                            (if line (concat ":" line))
!                           (if column (concat ":" column))
!                         (if local-only (concat " " (file-name-nondirectory 
file)))
!                         ))
!        old-contents)
  
      ;;  If a project file is defined, use it
      (if (and ada-prj-default-project-file
             (not (string= ada-prj-default-project-file "")))
          (setq command (concat command " -p" ada-prj-default-project-file)))
  
+     (if (and append (get-buffer "*gnatfind*"))
+       (save-excursion
+         (set-buffer "*gnatfind*")
+         (setq old-contents (buffer-string))))
+     
      (compile-internal command "No more references" "gnatfind")
  
      ;;  Hide the "Compilation" menu
      (save-excursion
        (set-buffer "*gnatfind*")
!       (local-unset-key [menu-bar compilation-menu])
! 
!       (if old-contents
!         (progn
!           (goto-char 1)
!           (insert old-contents)
!           (goto-char (point-max)))))
      )
    )
  
***************
*** 1102,1108 ****
    (let ((identlist (ada-read-identifier pos)))
      (condition-case nil
        (ada-find-in-ali identlist other-frame)
!       (error (ada-find-in-src-path identlist other-frame)))))
  
  (defun ada-goto-declaration-other-frame (pos &optional other-frame)
    "Display the declaration of the identifier around POS.
--- 1167,1186 ----
    (let ((identlist (ada-read-identifier pos)))
      (condition-case nil
        (ada-find-in-ali identlist other-frame)
!       (error
!        (let ((ali-file (ada-get-ali-file-name (ada-file-of identlist))))
! 
!        ;; If the ALI file was up-to-date, then we probably have a predefined
!        ;; entity, whose references are not given by GNAT
!        (if (and (file-exists-p ali-file)
!                 (file-newer-than-file-p ali-file (ada-file-of identlist)))
!            (message "No cross-reference found. It might be a predefined 
entity.")
! 
!          ;; Else, look in every ALI file, except if the user doesn't want that
!          (if ada-xref-search-with-egrep
!              (ada-find-in-src-path identlist other-frame)
!            (message "Cross-referencing information is not up-to-date. Please 
recompile.")
!            )))))))
  
  (defun ada-goto-declaration-other-frame (pos &optional other-frame)
    "Display the declaration of the identifier around POS.
***************
*** 1647,1653 ****
      (set 'identlist    (ada-make-identlist))
      (ada-set-name      identlist (downcase identifier))
      (ada-set-line      identlist
!                      (number-to-string (count-lines (point-min) (point))))
      (ada-set-column    identlist
                       (number-to-string (1+ (current-column))))
      (ada-set-file      identlist (buffer-file-name))
--- 1725,1731 ----
      (set 'identlist    (ada-make-identlist))
      (ada-set-name      identlist (downcase identifier))
      (ada-set-line      identlist
!                      (number-to-string (count-lines 1 (point))))
      (ada-set-column    identlist
                       (number-to-string (1+ (current-column))))
      (ada-set-file      identlist (buffer-file-name))
***************
*** 1677,1683 ****
                (concat "^"    (ada-line-of identlist)
                        "."    (ada-column-of identlist)
                        "[ *]" (ada-name-of identlist)
!                       " \\(.*\\)$") bound t))
          (if declaration-found
              (ada-set-on-declaration identlist t))
          ))
--- 1755,1761 ----
                (concat "^"    (ada-line-of identlist)
                        "."    (ada-column-of identlist)
                        "[ *]" (ada-name-of identlist)
!                       "[{\(<= ]?\\(.*\\)$") bound t))
          (if declaration-found
              (ada-set-on-declaration identlist t))
          ))
***************
*** 1696,1705 ****
         (number-to-string (ada-find-file-number-in-ali
                          (ada-file-of identlist))))
        (unless (re-search-forward (concat (ada-ali-index-of identlist)
!                                        "|\\([0-9]+.[0-9]+ \\)*"
                                         (ada-line-of identlist)
!                                        "[^0-9]"
!                                        (ada-column-of identlist))
                                 nil t)
  
            ;; if we did not find it, it may be because the first reference
--- 1774,1783 ----
         (number-to-string (ada-find-file-number-in-ali
                          (ada-file-of identlist))))
        (unless (re-search-forward (concat (ada-ali-index-of identlist)
!                                        "|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? 
\\)*"
                                         (ada-line-of identlist)
!                                        "[^etp]"
!                                        (ada-column-of identlist) "\\>")
                                 nil t)
  
            ;; if we did not find it, it may be because the first reference
***************
*** 1707,1716 ****
            ;; Or maybe we are already on the declaration...
            (unless (re-search-forward
                   (concat
!                   "^\\(\\([a-zA-Z0-9_.]+\\|\"[<>=+*-/a-z]\"\\)[ *]\\)*"
                    (ada-line-of identlist)
                    "[^0-9]"
!                   (ada-column-of identlist))
                   nil t)
            
            ;; If still not found, then either the declaration is unknown
--- 1785,1796 ----
            ;; Or maybe we are already on the declaration...
            (unless (re-search-forward
                   (concat
!                   "^[0-9]+.[0-9]+[ *]"
!                   (ada-name-of identlist)
!                   "[ <{=\(]\\(.\\|\n\\.\\)*\\<"
                    (ada-line-of identlist)
                    "[^0-9]"
!                   (ada-column-of identlist) "\\>")
                   nil t)
            
            ;; If still not found, then either the declaration is unknown
***************
*** 1729,1735 ****
            (while (looking-at "^\\.")
              (previous-line 1))
            (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
!                                       (ada-name-of identlist) "[ <]"))
              (set 'declaration-found nil))))
  
        ;; Still no success ! The ali file must be too old, and we need to
--- 1809,1815 ----
            (while (looking-at "^\\.")
              (previous-line 1))
            (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
!                                       (ada-name-of identlist) "[ <{=\(]"))
              (set 'declaration-found nil))))
  
        ;; Still no success ! The ali file must be too old, and we need to
***************
*** 1802,1808 ****
            (goto-char (point-max))
            (while (re-search-backward my-regexp nil t)
              (save-excursion
!               (set 'line-ali (count-lines (point-min) (point)))
                (beginning-of-line)
                ;; have a look at the line and column numbers
                (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
--- 1882,1888 ----
            (goto-char (point-max))
            (while (re-search-backward my-regexp nil t)
              (save-excursion
!               (setq line-ali (count-lines 1 (point)))
                (beginning-of-line)
                ;; have a look at the line and column numbers
                (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
***************
*** 2291,2301 ****
    ;; This should really be an `add-hook'.  -stef
    (setq ff-file-created-hooks 'ada-make-body-gnatstub)
  
-   ;; Read the project file and update the search path
-   ;; before looking for the other file
-   (make-local-hook 'ff-pre-find-hooks)
-   (add-hook 'ff-pre-find-hooks 'ada-require-project-file nil t)
- 
    ;; Completion for file names in the mini buffer should ignore .ali files
    (add-to-list 'completion-ignored-extensions ".ali")
    )
--- 2371,2376 ----
***************
*** 2334,2343 ****
  ;;  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)))))
  
  (provide 'ada-xref)
  
--- 2409,2418 ----
  ;;  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)))))
  
  (provide 'ada-xref)
  



reply via email to

[Prev in Thread] Current Thread [Next in Thread]