[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el [lexbind]
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el [lexbind] |
|
Date: |
Tue, 14 Oct 2003 19:30:23 -0400 |
Index: emacs/lisp/progmodes/ada-xref.el
diff -c emacs/lisp/progmodes/ada-xref.el:1.10.2.1
emacs/lisp/progmodes/ada-xref.el:1.10.2.2
*** emacs/lisp/progmodes/ada-xref.el:1.10.2.1 Fri Apr 4 01:20:31 2003
--- emacs/lisp/progmodes/ada-xref.el Tue Oct 14 19:30:15 2003
***************
*** 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.
--- 1,13 ----
;;; ada-xref.el --- for lookup and completion in Ada mode
! ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002, 2003
;; 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.181
;; Keywords: languages ada xref
;; This file is part of GNU Emacs.
***************
*** 44,49 ****
--- 44,51 ----
(require 'compile)
(require 'comint)
+ (require 'find-file)
+ (require 'ada-mode)
;; ------ Use variables
(defcustom ada-xref-other-buffer t
***************
*** 66,71 ****
--- 68,83 ----
Set to 0, if you don't use crunched filenames. This should be a string."
:type 'string :group 'ada)
+ (defcustom ada-gnatls-args '("-v")
+ "*Arguments to pass to gnatfind when the location of the runtime is
searched.
+ Typical use is to pass --RTS=soft-floats on some systems that support it.
+
+ You can also add -I- if you do not want the current directory to be included.
+ Otherwise, going from specs to bodies and back will first look for files in
the
+ current directory. This only has an impact if you are not using project files,
+ but only ADA_INCLUDE_PATH."
+ :type '(repeat string) :group 'ada)
+
(defcustom ada-prj-default-comp-opt "-gnatq -gnatQ"
"Default compilation options."
:type 'string :group 'ada)
***************
*** 202,207 ****
--- 214,250 ----
\((project_name . value) (project_name . value) ...)
As always, the values of the project file are defined through properties.")
+
+ ;; ----- 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)))
+
+
+ ;; -----------------------------------------------------------------------
+
(defun ada-quote-cmd (cmd)
"Duplicates all \\ characters in CMD so that it can be passed to `compile'"
(mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
***************
*** 220,227 ****
;; Even if we get an error, delete the *gnatls* buffer
(unwind-protect
(progn
! (call-process (concat cross-prefix "gnatls")
! nil t nil "-v")
(goto-char (point-min))
;; Source path
--- 263,270 ----
;; Even if we get an error, delete the *gnatls* buffer
(unwind-protect
(progn
! (apply 'call-process (concat cross-prefix "gnatls")
! (append '(nil t nil) ada-gnatls-args))
(goto-char (point-min))
;; Source path
***************
*** 230,236 ****
(forward-line 1)
(while (not (looking-at "^$"))
(back-to-indentation)
! (unless (looking-at "<Current_Directory>")
(add-to-list 'ada-xref-runtime-library-specs-path
(buffer-substring-no-properties
(point)
--- 273,280 ----
(forward-line 1)
(while (not (looking-at "^$"))
(back-to-indentation)
! (if (looking-at "<Current_Directory>")
! (add-to-list 'ada-xref-runtime-library-specs-path ".")
(add-to-list 'ada-xref-runtime-library-specs-path
(buffer-substring-no-properties
(point)
***************
*** 243,249 ****
(forward-line 1)
(while (not (looking-at "^$"))
(back-to-indentation)
! (unless (looking-at "<Current_Directory>")
(add-to-list 'ada-xref-runtime-library-ali-path
(buffer-substring-no-properties
(point)
--- 287,294 ----
(forward-line 1)
(while (not (looking-at "^$"))
(back-to-indentation)
! (if (looking-at "<Current_Directory>")
! (add-to-list 'ada-xref-runtime-library-ali-path ".")
(add-to-list 'ada-xref-runtime-library-ali-path
(buffer-substring-no-properties
(point)
***************
*** 312,319 ****
(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 "
--- 357,363 ----
(cond
(ada-prj-default-project-file
ada-prj-default-project-file)
! (file (ada-prj-find-prj-file file t))
(t
(message (concat "Not editing an Ada file,"
"and no default project "
***************
*** 433,488 ****
(defun ada-xref-update-project-menu ()
"Update the menu Ada->Project, with the list of available project files."
! (interactive)
! (let (submenu)
!
! ;; Create the standard items
! (set 'submenu (list (cons 'Load (cons "Load..."
! 'ada-set-default-project-file))
! (cons 'New (cons "New..." 'ada-prj-new))
! (cons 'Edit (cons "Edit..." 'ada-prj-edit))
! (cons 'sep (cons "---" nil))))
!
! ;; Add the new items
! (mapcar
! (lambda (x)
! (let ((name (or (car x) "<default>"))
! (command `(lambda ()
! "Change the active project file."
! (interactive)
! (ada-parse-prj-file ,(car x))
! (set 'ada-prj-default-project-file ,(car x))
! (ada-xref-update-project-menu))))
! (set 'submenu
! (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
! (equal ada-prj-default-project-file
! (car x))
! ))))))))
!
! ;; Parses all the known project files, and insert at least the default
! ;; one (in case ada-xref-project-files is nil)
! (or ada-xref-project-files '(nil)))
!
! (if (not ada-xemacs)
! (if (and (lookup-key ada-mode-map [menu-bar Ada])
! (lookup-key ada-mode-map [menu-bar Ada Project]))
! (setcdr (lookup-key ada-mode-map [menu-bar Ada Project])
! submenu)
! (if (lookup-key ada-mode-map [menu-bar ada Project])
! (setcdr (lookup-key ada-mode-map [menu-bar ada Project])
! submenu))))
! ))
;;-------------------------------------------------------------
--- 477,518 ----
(defun ada-xref-update-project-menu ()
"Update the menu Ada->Project, with the list of available project files."
! ;; Create the standard items.
! (let ((submenu
! `("Project"
! ["Load..." ada-set-default-project-file t]
! ["New..." ada-prj-new t]
! ["Edit..." ada-prj-edit t]
! "---"
! ;; Add the new items
! ,@(mapcar
! (lambda (x)
! (let ((name (or (car x) "<default>"))
! (command `(lambda ()
! "Change the active project file."
! (interactive)
! (ada-parse-prj-file ,(car x))
! (set 'ada-prj-default-project-file ,(car x))
! (ada-xref-update-project-menu))))
! (vector
! (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
! (equal ada-prj-default-project-file
! (car x))
! ))))
!
! ;; Parses all the known project files, and insert at
! ;; least the default one (in case
! ;; ada-xref-project-files is nil)
! (or ada-xref-project-files '(nil))))))
!
! (easy-menu-add-item ada-mode-menu '() submenu)))
;;-------------------------------------------------------------
***************
*** 528,742 ****
(error (concat filename " not found in src_dir")))))
- ;; ----- 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)
- )
-
;; ----- Utilities -------------------------------------------------
(defun ada-require-project-file ()
--- 558,563 ----
***************
*** 766,782 ****
This is overriden on VMS to convert from VMS filenames to Unix filenames."
name)
! (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)
! )
;; ------ Handling the project file -----------------------------
! (defun ada-prj-find-prj-file (&optional no-user-question)
! "Find the prj file associated with the current buffer.
If NO-USER-QUESTION is non-nil, use a default file if not project file was
found, and do not ask the user.
If the buffer is not an Ada buffer, associate it with the default project
--- 587,609 ----
This is overriden on VMS to convert from VMS filenames to Unix filenames."
name)
! (defun ada-set-default-project-file (name &optional keep-existing)
! "Set the file whose name is NAME as the default project file.
! If KEEP-EXISTING is true and a project file has already been loaded, nothing
! is done. This is meant to be used from ada-mode-hook, for instance to force
! a project file unless the user has already loaded one."
(interactive "fProject file:")
! (if (or (not keep-existing)
! (not ada-prj-default-project-file)
! (equal ada-prj-default-project-file ""))
! (progn
! (setq ada-prj-default-project-file name)
! (ada-reread-prj-file name))))
;; ------ Handling the project file -----------------------------
! (defun ada-prj-find-prj-file (&optional file no-user-question)
! "Find the prj file associated with FILE (or the current buffer if nil).
If NO-USER-QUESTION is non-nil, use a default file if not project file was
found, and do not ask the user.
If the buffer is not an Ada buffer, associate it with the default project
***************
*** 789,802 ****
;; the current buffer is not a real file (for instance an emerge buffer)
(if (or (not (string= mode-name "Ada"))
! (not (buffer-file-name))
! (and ada-prj-default-project-file
! (not (string= ada-prj-default-project-file ""))))
! (set 'selected ada-prj-default-project-file)
;; other cases: use a more complex algorithm
! (let* ((current-file (buffer-file-name))
(first-choice (concat
(file-name-sans-extension current-file)
ada-project-file-extension))
--- 616,631 ----
;; the current buffer is not a real file (for instance an emerge buffer)
(if (or (not (string= mode-name "Ada"))
! (not (buffer-file-name)))
!
! (if (and ada-prj-default-project-file
! (not (string= ada-prj-default-project-file "")))
! (setq selected ada-prj-default-project-file)
! (setq selected nil))
;; other cases: use a more complex algorithm
! (let* ((current-file (or file (buffer-file-name)))
(first-choice (concat
(file-name-sans-extension current-file)
ada-project-file-extension))
***************
*** 836,841 ****
--- 665,671 ----
counter
(nth (1- counter) prj-files)))
(setq counter (1+ counter))
+
))) ; end of with-output-to ...
(setq choice nil)
(while (or
***************
*** 859,865 ****
(unless (string= ada-last-prj-file "")
(set 'selected ada-last-prj-file))))
)))
! selected
))
--- 689,696 ----
(unless (string= ada-last-prj-file "")
(set 'selected ada-last-prj-file))))
)))
!
! (or selected "default.adp")
))
***************
*** 872,877 ****
--- 703,711 ----
(ada-buffer (current-buffer)))
(setq prj-file (expand-file-name prj-file))
+ ;; Set the project file as the active one.
+ (setq ada-prj-default-project-file prj-file)
+
;; Initialize the project with the default values
(ada-xref-set-default-prj-values 'project (current-buffer))
***************
*** 880,945 ****
;; 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))
!
! ;; Now overrides these values with the project file
! (while (not (eobp))
! (if (looking-at "^\\([^=]+\\)=\\(.*\\)")
! (cond
! ((string= (match-string 1) "src_dir")
! (add-to-list 'src_dir
! (file-name-as-directory (match-string 2))))
! ((string= (match-string 1) "obj_dir")
! (add-to-list 'obj_dir
! (file-name-as-directory (match-string 2))))
! ((string= (match-string 1) "casing")
! (set 'casing (cons (match-string 2) casing)))
! ((string= (match-string 1) "build_dir")
! (set 'project
! (plist-put project 'build_dir
! (file-name-as-directory (match-string 2)))))
! ((string= (match-string 1) "make_cmd")
! (add-to-list 'make_cmd (match-string 2)))
! ((string= (match-string 1) "comp_cmd")
! (add-to-list 'comp_cmd (match-string 2)))
! ((string= (match-string 1) "check_cmd")
! (add-to-list 'check_cmd (match-string 2)))
! ((string= (match-string 1) "run_cmd")
! (add-to-list 'run_cmd (match-string 2)))
! ((string= (match-string 1) "debug_pre_cmd")
! (add-to-list 'debug_pre_cmd (match-string 2)))
! ((string= (match-string 1) "debug_post_cmd")
! (add-to-list 'debug_post_cmd (match-string 2)))
! (t
! (set 'project (plist-put project (intern (match-string 1))
! (match-string 2))))))
! (forward-line 1))
!
! (if src_dir (set 'project (plist-put project 'src_dir
! (reverse src_dir))))
! (if obj_dir (set 'project (plist-put project 'obj_dir
! (reverse obj_dir))))
! (if casing (set 'project (plist-put project 'casing
! (reverse casing))))
! (if make_cmd (set 'project (plist-put project 'make_cmd
! (reverse make_cmd))))
! (if comp_cmd (set 'project (plist-put project 'comp_cmd
! (reverse comp_cmd))))
! (if check_cmd (set 'project (plist-put project 'check_cmd
! (reverse check_cmd))))
! (if run_cmd (set 'project (plist-put project 'run_cmd
! (reverse run_cmd))))
! (set 'project (plist-put project 'debug_post_cmd
! (reverse debug_post_cmd)))
! (set 'project (plist-put project 'debug_pre_cmd
! (reverse debug_pre_cmd)))
;; Delete the default project file from the list, if it is there.
;; Note that in that case, this default project is the only one in
--- 714,807 ----
;; find-file anyway, since the speedbar frame is special and does not
;; allow the selection of a file in it.
! (if (file-exists-p prj-file)
! (progn
! (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))
!
! ;; Now overrides these values with the project file
! (while (not (eobp))
! (if (looking-at "^\\([^=]+\\)=\\(.*\\)")
! (cond
! ((string= (match-string 1) "src_dir")
! (add-to-list 'src_dir
! (file-name-as-directory (match-string 2))))
! ((string= (match-string 1) "obj_dir")
! (add-to-list 'obj_dir
! (file-name-as-directory (match-string 2))))
! ((string= (match-string 1) "casing")
! (set 'casing (cons (match-string 2) casing)))
! ((string= (match-string 1) "build_dir")
! (set 'project
! (plist-put project 'build_dir
! (file-name-as-directory (match-string
2)))))
! ((string= (match-string 1) "make_cmd")
! (add-to-list 'make_cmd (match-string 2)))
! ((string= (match-string 1) "comp_cmd")
! (add-to-list 'comp_cmd (match-string 2)))
! ((string= (match-string 1) "check_cmd")
! (add-to-list 'check_cmd (match-string 2)))
! ((string= (match-string 1) "run_cmd")
! (add-to-list 'run_cmd (match-string 2)))
! ((string= (match-string 1) "debug_pre_cmd")
! (add-to-list 'debug_pre_cmd (match-string 2)))
! ((string= (match-string 1) "debug_post_cmd")
! (add-to-list 'debug_post_cmd (match-string 2)))
! (t
! (set 'project (plist-put project (intern (match-string 1))
! (match-string 2))))))
! (forward-line 1))
!
! (if src_dir (set 'project (plist-put project 'src_dir
! (reverse src_dir))))
! (if obj_dir (set 'project (plist-put project 'obj_dir
! (reverse obj_dir))))
! (if casing (set 'project (plist-put project 'casing
! (reverse casing))))
! (if make_cmd (set 'project (plist-put project 'make_cmd
! (reverse make_cmd))))
! (if comp_cmd (set 'project (plist-put project 'comp_cmd
! (reverse comp_cmd))))
! (if check_cmd (set 'project (plist-put project 'check_cmd
! (reverse check_cmd))))
! (if run_cmd (set 'project (plist-put project 'run_cmd
! (reverse run_cmd))))
! (set 'project (plist-put project 'debug_post_cmd
! (reverse debug_post_cmd)))
! (set 'project (plist-put project 'debug_pre_cmd
! (reverse debug_pre_cmd)))
!
! ;; Kill the project buffer
! (kill-buffer nil)
! (set-buffer ada-buffer)
! )
!
! ;; Else the file wasn't readable (probably the default project).
! ;; We initialize it with the current environment variables.
! ;; We need to add the startup directory in front so that
! ;; files locally redefined are properly found. We cannot
! ;; add ".", which varies too much depending on what the
! ;; current buffer is.
! (set 'project
! (plist-put project 'src_dir
! (append
! (list command-line-default-directory)
! (split-string (or (getenv "ADA_INCLUDE_PATH") "")
":")
! (list "." default-directory))))
! (set 'project
! (plist-put project 'obj_dir
! (append
! (list command-line-default-directory)
! (split-string (or (getenv "ADA_OBJECTS_PATH") "")
":")
! (list "." default-directory))))
! )
!
;; Delete the default project file from the list, if it is there.
;; Note that in that case, this default project is the only one in
***************
*** 952,960 ****
(setcdr (assoc prj-file ada-xref-project-files) project)
(add-to-list 'ada-xref-project-files (cons prj-file project)))
- ;; Set the project file as the active one.
- (setq ada-prj-default-project-file prj-file)
-
;; Sets up the compilation-search-path so that Emacs is able to
;; go to the source of the errors in a compilation buffer
(setq compilation-search-path (ada-xref-get-src-dir-field))
--- 814,819 ----
***************
*** 967,980 ****
;; Add the directories to the search path for ff-find-other-file
;; Do not add the '/' or '\' at the end
! (setq ada-search-directories
(append (mapcar 'directory-file-name compilation-search-path)
ada-search-directories))
- ;; Kill the project buffer
- (kill-buffer nil)
- (set-buffer ada-buffer)
-
(ada-xref-update-project-menu)
)
--- 826,835 ----
;; Add the directories to the search path for ff-find-other-file
;; Do not add the '/' or '\' at the end
! (setq ada-search-directories-internal
(append (mapcar 'directory-file-name compilation-search-path)
ada-search-directories))
(ada-xref-update-project-menu)
)
***************
*** 1043,1049 ****
(concat "'\"" (substring entity 1 -1) "\"'"))
entity))
(switches (ada-xref-get-project-field 'gnatfind_opt))
! (command (concat "gnatfind " switches " "
quote-entity
(if file (concat ":" (file-name-nondirectory file)))
(if line (concat ":" line))
--- 898,904 ----
(concat "'\"" (substring entity 1 -1) "\"'"))
entity))
(switches (ada-xref-get-project-field 'gnatfind_opt))
! (command (concat "gnat find " switches " "
quote-entity
(if file (concat ":" (file-name-nondirectory file)))
(if line (concat ":" line))
***************
*** 1055,1061 ****
;; 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
--- 910,919 ----
;; If a project file is defined, use it
(if (and ada-prj-default-project-file
(not (string= ada-prj-default-project-file "")))
! (if (string-equal (file-name-extension ada-prj-default-project-file)
! "gpr")
! (setq command (concat command " -P" ada-prj-default-project-file))
! (setq command (concat command " -p" ada-prj-default-project-file))))
(if (and append (get-buffer "*gnatfind*"))
(save-excursion
***************
*** 1079,1113 ****
(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))
- ;; ----- 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)))
-
-
-
;; ----- Identifier Completion --------------------------------------------
(defun ada-complete-identifier (pos)
"Tries to complete the identifier around POS.
--- 937,942 ----
***************
*** 1150,1160 ****
;; ----- Cross-referencing ----------------------------------------
(defun ada-point-and-xref ()
! "Calls `mouse-set-point' and then `ada-goto-declaration'."
(interactive)
(mouse-set-point last-input-event)
(ada-goto-declaration (point)))
(defun ada-goto-declaration (pos &optional other-frame)
"Display the declaration of the identifier around POS.
The declaration is shown in another buffer if `ada-xref-other-buffer' is
--- 979,1007 ----
;; ----- Cross-referencing ----------------------------------------
(defun ada-point-and-xref ()
! "Jump to the declaration of the entity below the cursor."
(interactive)
(mouse-set-point last-input-event)
(ada-goto-declaration (point)))
+ (defun ada-point-and-xref-body ()
+ "Jump to the body of the entity under the cursor."
+ (interactive)
+ (mouse-set-point last-input-event)
+ (ada-goto-body (point)))
+
+ (defun ada-goto-body (pos &optional other-frame)
+ "Display the body of the entity around POS.
+ If the entity doesn't have a body, display its declaration.
+ As a side effect, the buffer for the declaration is also open."
+ (interactive "d")
+ (ada-goto-declaration pos other-frame)
+
+ ;; Temporarily force the display in the same buffer, since we
+ ;; already changed previously
+ (let ((ada-xref-other-buffer nil))
+ (ada-goto-declaration (point) nil)))
+
(defun ada-goto-declaration (pos &optional other-frame)
"Display the declaration of the identifier around POS.
The declaration is shown in another buffer if `ada-xref-other-buffer' is
***************
*** 1186,1192 ****
(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.
The declation is shown in another frame if `ada-xref-other-buffer' is
non-nil."
(interactive "d")
--- 1033,1039 ----
(message "Cross-referencing information is not up-to-date. Please
recompile.")
)))))))
! (defun ada-goto-declaration-other-frame (pos)
"Display the declaration of the identifier around POS.
The declation is shown in another frame if `ada-xref-other-buffer' is
non-nil."
(interactive "d")
***************
*** 1258,1264 ****
;; Insert newlines so as to separate the name of the commands to run
;; and the output of the commands. this doesn't work with cmdproxy.exe,
;; which gets confused by newline characters.
! (if (not (string-match "cmdproxy.exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
(compile (ada-quote-cmd cmd))))
--- 1105,1111 ----
;; Insert newlines so as to separate the name of the commands to run
;; and the output of the commands. this doesn't work with cmdproxy.exe,
;; which gets confused by newline characters.
! (if (not (string-match ".exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
(compile (ada-quote-cmd cmd))))
***************
*** 1291,1297 ****
;; Insert newlines so as to separate the name of the commands to run
;; and the output of the commands. this doesn't work with cmdproxy.exe,
;; which gets confused by newline characters.
! (if (not (string-match "cmdproxy.exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
(compile (ada-quote-cmd cmd))))
--- 1138,1144 ----
;; Insert newlines so as to separate the name of the commands to run
;; and the output of the commands. this doesn't work with cmdproxy.exe,
;; which gets confused by newline characters.
! (if (not (string-match ".exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
(compile (ada-quote-cmd cmd))))
***************
*** 1395,1405 ****
(if (or arg ada-xref-confirm-compile)
(set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
! (let (comint-exec
! in-post-mode
! gud-gdb-massage-args)
;; Do not add -fullname, since we can have a 'rsh' command in front.
(fset 'gud-gdb-massage-args (lambda (file args) args))
(set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator))
--- 1242,1251 ----
(if (or arg ada-xref-confirm-compile)
(set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
! (let ((old-comint-exec (symbol-function 'comint-exec)))
;; Do not add -fullname, since we can have a 'rsh' command in front.
+ ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef
(fset 'gud-gdb-massage-args (lambda (file args) args))
(set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator))
***************
*** 1408,1417 ****
(set 'post-cmd (mapconcat 'identity post-cmd "\n"))
(if post-cmd
! (set 'post-cmd (concat post-cmd "\n")))
;; Temporarily replaces the definition of `comint-exec' so that we
;; can execute commands before running gdb.
(fset 'comint-exec
`(lambda (buffer name command startfile switches)
(let (compilation-buffer-name-function)
--- 1254,1265 ----
(set 'post-cmd (mapconcat 'identity post-cmd "\n"))
(if post-cmd
! (set 'post-cmd (concat post-cmd "\n")))
!
;; Temporarily replaces the definition of `comint-exec' so that we
;; can execute commands before running gdb.
+ ;; FIXME: This is evil and not temporary !!! -stef
(fset 'comint-exec
`(lambda (buffer name command startfile switches)
(let (compilation-buffer-name-function)
***************
*** 1435,1440 ****
--- 1283,1293 ----
(funcall (symbol-function 'jdb) cmd)
(gdb cmd))
+ ;; Restore the standard fset command (or for instance C-U M-x shell
+ ;; wouldn't work anymore
+
+ (fset 'comint-exec old-comint-exec)
+
;; Send post-commands to the debugger
(process-send-string (get-buffer-process (current-buffer)) post-cmd)
***************
*** 1465,1471 ****
;; Reread the location of the standard runtime library
(ada-initialize-runtime-library
! (or (ada-xref-get-project-field 'cross-prefix) ""))
)
;; ------ Private routines
--- 1318,1324 ----
;; Reread the location of the standard runtime library
(ada-initialize-runtime-library
! (or (ada-xref-get-project-field 'cross_prefix) ""))
)
;; ------ Private routines
***************
*** 1780,1786 ****
(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)
--- 1633,1639 ----
(unless (re-search-forward (concat (ada-ali-index-of identlist)
"|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)?
\\)*"
(ada-line-of identlist)
! "[^etpzkd<>=^]"
(ada-column-of identlist) "\\>")
nil t)
***************
*** 1886,1892 ****
(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]+\\)[ *]")
--- 1739,1745 ----
(goto-char (point-max))
(while (re-search-backward my-regexp nil t)
(save-excursion
! (set 'line-ali (count-lines 1 (point)))
(beginning-of-line)
;; have a look at the line and column numbers
(if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
***************
*** 1977,1989 ****
(set 'locations (list (list (match-string 1 ali-line) ;; line
(match-string 2 ali-line) ;; column
(ada-declare-file-of identlist))))
! (while (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line start)
(setq line (match-string 1 ali-line)
! col (match-string 2 ali-line)
! start (match-end 2))
;; it there was a file number in the same line
! (if (string-match (concat "\\([0-9]+\\)|\\([^|bc]+\\)?"
(match-string 0 ali-line))
ali-line)
(let ((file-number (match-string 1 ali-line)))
--- 1830,1843 ----
(set 'locations (list (list (match-string 1 ali-line) ;; line
(match-string 2 ali-line) ;; column
(ada-declare-file-of identlist))))
! (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)"
! ali-line start)
(setq line (match-string 1 ali-line)
! col (match-string 3 ali-line)
! start (match-end 3))
;; it there was a file number in the same line
! (if (string-match (concat "[^{(<]\\([0-9]+\\)|\\([^|bc]+\\)?"
(match-string 0 ali-line))
ali-line)
(let ((file-number (match-string 1 ali-line)))
***************
*** 2371,2382 ****
"Function called by `ada-mode-hook' to initialize the ada-xref.el package.
For instance, it creates the gnat-specific menus, sets some hooks for
find-file...."
- (make-local-hook 'ff-file-created-hooks)
;; This should really be an `add-hook'. -stef
! (setq ff-file-created-hooks 'ada-make-body-gnatstub)
;; Completion for file names in the mini buffer should ignore .ali files
(add-to-list 'completion-ignored-extensions ".ali")
)
--- 2225,2237 ----
"Function called by `ada-mode-hook' to initialize the ada-xref.el package.
For instance, it creates the gnat-specific menus, sets some hooks for
find-file...."
;; This should really be an `add-hook'. -stef
! (setq ff-file-created-hook 'ada-make-body-gnatstub)
;; Completion for file names in the mini buffer should ignore .ali files
(add-to-list 'completion-ignored-extensions ".ali")
+
+ (ada-xref-update-project-menu)
)
***************
*** 2395,2423 ****
(if (ada-find-file-in-dir "ddd" exec-path)
(set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
- ;; 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)
-
(add-hook 'ada-mode-hook 'ada-xref-initialize)
;; Initializes the cross references to the runtime library
(ada-initialize-runtime-library "")
;; Add these standard directories to the search path
! (set 'ada-search-directories
(append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path)
ada-search-directories))
- ;; 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)
;;; ada-xref.el ends here
--- 2250,2266 ----
(if (ada-find-file-in-dir "ddd" exec-path)
(set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
(add-hook 'ada-mode-hook 'ada-xref-initialize)
;; Initializes the cross references to the runtime library
(ada-initialize-runtime-library "")
;; Add these standard directories to the search path
! (set 'ada-search-directories-internal
(append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path)
ada-search-directories))
(provide 'ada-xref)
+ ;;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e
;;; ada-xref.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/progmodes/ada-xref.el [lexbind],
Miles Bader <=