/[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.15 by lektu, Sun May 4 19:54:00 2003 UTC revision 1.16 by monnier, Tue May 13 21:15:44 2003 UTC
# Line 477  All the directories are returned as abso Line 477  All the directories are returned as abso
477    
478  (defun ada-xref-update-project-menu ()  (defun ada-xref-update-project-menu ()
479    "Update the menu Ada->Project, with the list of available project files."    "Update the menu Ada->Project, with the list of available project files."
480    (let (submenu)    ;; Create the standard items.
481      (let ((submenu
482      ;;  Create the standard items           `("Project"
483      (set 'submenu (list (cons 'Load (cons "Load..."             ["Load..." ada-set-default-project-file t]
484                                            'ada-set-default-project-file))             ["New..."  ada-prj-new t]
485                          (cons 'New  (cons "New..."  'ada-prj-new))             ["Edit..." ada-prj-edit t]
486                          (cons 'Edit (cons "Edit..." 'ada-prj-edit))             "---"
487                          (cons 'sep  (cons "---" nil))))             ;;  Add the new items
488               ,@(mapcar
489      ;;  Add the new items                (lambda (x)
490      (mapcar                  (let ((name (or (car x) "<default>"))
491       (lambda (x)                        (command `(lambda ()
492         (let ((name (or (car x) "<default>"))                                    "Change the active project file."
493               (command `(lambda ()                                    (interactive)
494                           "Change the active project file."                                    (ada-parse-prj-file ,(car x))
495                           (interactive)                                    (set 'ada-prj-default-project-file ,(car x))
496                           (ada-parse-prj-file ,(car x))                                    (ada-xref-update-project-menu))))
497                           (set 'ada-prj-default-project-file ,(car x))                    (vector
498                           (ada-xref-update-project-menu))))                     (if (string= (file-name-extension name)
499           (set 'submenu                                  ada-project-file-extension)
500                (append submenu                         (file-name-sans-extension
501                        (list (cons (intern name)                          (file-name-nondirectory name))
502                                    (list                       (file-name-nondirectory name))
503                                     'menu-item                     command
504                                     (if (string= (file-name-extension name)                     :button (cons
505                                                  ada-project-file-extension)                              :toggle
506                                         (file-name-sans-extension                              (equal ada-prj-default-project-file
507                                          (file-name-nondirectory name))                                     (car x))
508                                       (file-name-nondirectory name))                              ))))
509                                     command      
510                                     :button (cons                ;; Parses all the known project files, and insert at
511                                              :toggle                ;; least the default one (in case
512                                              (equal ada-prj-default-project-file                ;; ada-xref-project-files is nil)
513                                                     (car x))                (or ada-xref-project-files '(nil))))))
514                                              ))))))))        
515        (easy-menu-add-item ada-mode-menu '() submenu)))
      ;; 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 (featurep 'xemacs))  
          (if (lookup-key ada-mode-map [menu-bar Ada Project])  
              (setcdr (lookup-key ada-mode-map [menu-bar Ada Project])  
                      submenu)))  
     ))  
516    
517    
518  ;;-------------------------------------------------------------  ;;-------------------------------------------------------------
# Line 1042  If OTHER-FRAME is non-nil, display the c Line 1033  If OTHER-FRAME is non-nil, display the c
1033               (message "Cross-referencing information is not up-to-date. Please recompile.")               (message "Cross-referencing information is not up-to-date. Please recompile.")
1034               )))))))               )))))))
1035    
1036  (defun ada-goto-declaration-other-frame (pos &optional other-frame)  (defun ada-goto-declaration-other-frame (pos)
1037    "Display the declaration of the identifier around POS.    "Display the declaration of the identifier around POS.
1038  The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."  The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
1039    (interactive "d")    (interactive "d")
# Line 1251  If ARG is non-nil, ask the user to confi Line 1242  If ARG is non-nil, ask the user to confi
1242      (if (or arg ada-xref-confirm-compile)      (if (or arg ada-xref-confirm-compile)
1243          (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))          (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
1244    
1245      (let ((old-comint-exec (symbol-function 'comint-exec))      (let ((old-comint-exec (symbol-function 'comint-exec)))
           comint-exec  
           in-post-mode  
           gud-gdb-massage-args)  
1246    
1247        ;;  Do not add -fullname, since we can have a 'rsh' command in front.        ;;  Do not add -fullname, since we can have a 'rsh' command in front.
1248          ;;  FIXME: This is evil but luckily a nop under Emacs-21.3.50 !  -stef
1249        (fset 'gud-gdb-massage-args (lambda (file args) args))        (fset 'gud-gdb-massage-args (lambda (file args) args))
1250    
1251        (set 'pre-cmd  (mapconcat 'identity pre-cmd  ada-command-separator))        (set 'pre-cmd  (mapconcat 'identity pre-cmd  ada-command-separator))
# Line 1265  If ARG is non-nil, ask the user to confi Line 1254  If ARG is non-nil, ask the user to confi
1254    
1255        (set 'post-cmd (mapconcat 'identity post-cmd "\n"))        (set 'post-cmd (mapconcat 'identity post-cmd "\n"))
1256        (if post-cmd        (if post-cmd
1257          (set 'post-cmd (concat post-cmd "\n")))            (set 'post-cmd (concat post-cmd "\n")))
1258    
1259    
1260        ;;  Temporarily replaces the definition of `comint-exec' so that we        ;;  Temporarily replaces the definition of `comint-exec' so that we
1261        ;;  can execute commands before running gdb.        ;;  can execute commands before running gdb.
1262        (make-local-variable 'comint-exec)        ;;  FIXME: This is evil and not temporary !!!  -stef
1263        (fset 'comint-exec        (fset 'comint-exec
1264              `(lambda (buffer name command startfile switches)              `(lambda (buffer name command startfile switches)
1265                 (let (compilation-buffer-name-function)                 (let (compilation-buffer-name-function)

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

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