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

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

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

revision 1.8 by monnier, Tue Apr 9 18:56:34 2002 UTC revision 1.8.2.1 by miles, Fri Apr 4 06:20:31 2003 UTC
# Line 1  Line 1 
1  ;;; ada-prj.el --- easy editing of project files for the ada-mode  ;;; ada-prj.el --- easy editing of project files for the ada-mode
2    
3  ;; Copyright (C) 1998, 99, 2000, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1998, 99, 2000, 2001, 2002
4    ;;  Free Software Foundation, Inc.
5    
6  ;; Author: Emmanuel Briot <briot@gnat.com>  ;; Author: Emmanuel Briot <briot@gnat.com>
7  ;; Ada Core Technologies's version:   $Revision$  ;; Ada Core Technologies's version:   Revision: 1.55.2.2 (GNAT 3.15)
8  ;; Keywords: languages, ada, project file  ;; Keywords: languages, ada, project file
9    
10  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 74  Line 75 
75                                     prj)))                                     prj)))
76      (if (not (string= (file-name-extension filename t) ".adp"))      (if (not (string= (file-name-extension filename t) ".adp"))
77          (error "File name extension for project files must be .adp"))          (error "File name extension for project files must be .adp"))
78        
79      (ada-customize nil filename)))      (ada-customize nil filename)))
80    
81  (defun ada-prj-edit ()  (defun ada-prj-edit ()
82    "Editing the project file associated with the current Ada buffer.    "Editing the project file associated with the current Ada buffer.
83  If there is none, opens a new project file"  If there is none, opens a new project file"
84    (interactive)    (interactive)
85    (let ((file (ada-prj-find-prj-file)))    (if ada-prj-default-project-file
86      (if file        (ada-customize)
87          (progn      (ada-prj-new)))
           (ada-reread-prj-file file)  
           (ada-customize))  
       (ada-prj-new))))  
88    
89  (defun ada-prj-add-keymap ()  (defun ada-prj-add-keymap ()
90    "Add new keybindings for ada-prj."    "Add new keybindings for ada-prj."
# Line 107  project file is found, returns the defau Line 105  project file is found, returns the defau
105        ;; Else use the active one        ;; Else use the active one
106        (set 'prj ada-prj-default-project-file))        (set 'prj ada-prj-default-project-file))
107    
108          
109      (if (and prj      (if (and prj
110               (not (string= prj ""))               (not (string= prj ""))
111               (assoc prj ada-xref-project-files))               (assoc prj ada-xref-project-files))
112          (set symbol (copy-sequence (cdr (assoc prj ada-xref-project-files))))          (set symbol (copy-sequence (cdr (assoc prj ada-xref-project-files))))
113          
114        ;;  Set default values (except for the file name if this was given        ;;  Set default values (except for the file name if this was given
115        ;;  in the buffer        ;;  in the buffer
116        (ada-xref-set-default-prj-values symbol ada-buffer)        (ada-xref-set-default-prj-values symbol ada-buffer)
117        (if (and prj (not (string= prj "")))        (if (and prj (not (string= prj "")))
118            (set symbol (plist-put (eval symbol) 'filename prj)))            (set symbol (plist-put (eval symbol) 'filename prj)))
119        )))        )))
120        
121    
122  (defun ada-prj-save-specific-option (field)  (defun ada-prj-save-specific-option (field)
123    "Returns the string to print in the project file to save FIELD.    "Returns the string to print in the project file to save FIELD.
# Line 140  If the current value of FIELD is the def Line 138  If the current value of FIELD is the def
138    
139            ;;  Save the fields that do not depend on the current buffer            ;;  Save the fields that do not depend on the current buffer
140            ;;  only if they are different from the default value            ;;  only if they are different from the default value
141              
142            (ada-prj-save-specific-option 'comp_opt)            (ada-prj-save-specific-option 'comp_opt)
143            (ada-prj-save-specific-option 'bind_opt)            (ada-prj-save-specific-option 'bind_opt)
144            (ada-prj-save-specific-option 'link_opt)            (ada-prj-save-specific-option 'link_opt)
# Line 175  If the current value of FIELD is the def Line 173  If the current value of FIELD is the def
173                              (plist-get ada-prj-current-values 'debug_post_cmd))                              (plist-get ada-prj-current-values 'debug_post_cmd))
174            "\n"            "\n"
175            ))            ))
176        
177      (find-file file-name)      (find-file file-name)
178      (erase-buffer)      (erase-buffer)
179      (insert output)      (insert output)
# Line 236  If the current value of FIELD is the def Line 234  If the current value of FIELD is the def
234  (defun ada-prj-load-directory (field &optional file-name)  (defun ada-prj-load-directory (field &optional file-name)
235    "Append the content of FILE-NAME to FIELD in the current project file.    "Append the content of FILE-NAME to FIELD in the current project file.
236  If FILE-NAME is nil, ask the user for the name."  If FILE-NAME is nil, ask the user for the name."
237    (unless file-name  
238      (set 'file-name (read-file-name "Root directory: " nil nil t)))    ;;  Do not use an external dialog for this, since it wouldn't allow
239      ;;  the user to select a directory
240      (let ((use-dialog-box nil))
241        (unless file-name
242          (set 'file-name (read-file-name "Root directory: " nil nil t))))
243    
244    (set 'ada-prj-current-values    (set 'ada-prj-current-values
245         (plist-put ada-prj-current-values         (plist-put ada-prj-current-values
# Line 262  The current buffer must be the project e Line 264  The current buffer must be the project e
264                widget-field-list nil)                widget-field-list nil)
265          (mapcar (lambda (x) (delete-overlay x)) (car (overlay-lists)))          (mapcar (lambda (x) (delete-overlay x)) (car (overlay-lists)))
266          (mapcar (lambda (x) (delete-overlay x)) (cdr (overlay-lists)))))          (mapcar (lambda (x) (delete-overlay x)) (cdr (overlay-lists)))))
267      
268    ;;  Display the tabs    ;;  Display the tabs
269      
270    (widget-insert "\n               Project and Editor configuration.\n    (widget-insert "\n               Project and Editor configuration.\n
271    ___________    ____________    ____________    ____________    ____________\n / ")    ___________    ____________    ____________    ____________    ____________\n / ")
272    (widget-create 'push-button :notify    (widget-create 'push-button :notify
# Line 284  The current buffer must be the project e Line 286  The current buffer must be the project e
286    (widget-insert " \\\n")    (widget-insert " \\\n")
287    
288    ;;  Display the currently selected page    ;;  Display the currently selected page
289      
290    (cond    (cond
291      
292     ;;     ;;
293     ;;  First page (General)     ;;  First page (General)
294     ;;     ;;
# Line 333  vxworks, you would enter 'powerpc-wrs-vx Line 335  vxworks, you would enter 'powerpc-wrs-vx
335  To use JGNAT, enter 'j'.")  To use JGNAT, enter 'j'.")
336      )      )
337    
338      
339     ;;     ;;
340     ;;  Second page (Paths)     ;;  Second page (Paths)
341     ;;     ;;
# Line 345  To use JGNAT, enter 'j'.") Line 347  To use JGNAT, enter 'j'.")
347                  (plist-get ada-prj-current-values 'cross_prefix))                  (plist-get ada-prj-current-values 'cross_prefix))
348            (ada-initialize-runtime-library ada-old-cross-prefix)))            (ada-initialize-runtime-library ada-old-cross-prefix)))
349    
350        
351      (widget-insert "/_____________\\/              \\/______________\\/______________\\/______________\\\n")      (widget-insert "/_____________\\/              \\/______________\\/______________\\/______________\\\n")
352      (ada-prj-field 'src_dir  "Source directories"      (ada-prj-field 'src_dir  "Source directories"
353  "Enter the list of directories where your Ada  "Enter the list of directories where your Ada
# Line 361  and the standard runtime." Line 363  and the standard runtime."
363                   "\n")                   "\n")
364        )        )
365      (widget-insert "\n\n")      (widget-insert "\n\n")
366        
367      (ada-prj-field 'obj_dir  "Object directories"      (ada-prj-field 'obj_dir  "Object directories"
368  "Enter the list of directories where the GNAT  "Enter the list of directories where the GNAT
369  library files (ALI files) can be found. These  library files (ALI files) can be found. These
# Line 395  command and are passed to the binder") Line 397  command and are passed to the binder")
397  command and are passed to the linker")  command and are passed to the linker")
398      (ada-prj-field 'gnatmake_opt "Switches for gnatmake"      (ada-prj-field 'gnatmake_opt "Switches for gnatmake"
399  "These switches are used in the default gnatmake  "These switches are used in the default gnatmake
400  command.")                  command.")
401      (ada-prj-field 'gnatfind_opt "Switches for gnatfind"      (ada-prj-field 'gnatfind_opt "Switches for gnatfind"
402  "The command gnatfind is run every time the Ada/Goto/List_References menu.  "The command gnatfind is run every time the Ada/Goto/List_References menu.
403  You should for instance add -a if you are working in an environment  You should for instance add -a if you are working in an environment
# Line 453  command will be executed on the remote h Line 455  command will be executed on the remote h
455  debugger"  debugger"
456  "The following commands are executed one after the other before starting  "The following commands are executed one after the other before starting
457  the debugger. These can be used to set up your environment." t)  the debugger. These can be used to set up your environment." t)
458        
459      (ada-prj-field 'debug_cmd "Debugging the application"      (ada-prj-field 'debug_cmd "Debugging the application"
460  "Specifies how to debug the application, possibly  "Specifies how to debug the application, possibly
461  remotely if remote_machine has been set. We  remotely if remote_machine has been set. We
# Line 467  recommend the following debuggers: Line 469  recommend the following debuggers:
469  started. These can be used to initialize the debugger, for instance to  started. These can be used to initialize the debugger, for instance to
470  connect to the target when working with cross-environments" t)  connect to the target when working with cross-environments" t)
471      )      )
472      
473     )     )
474    
475    
# Line 500  If FILENAME is given, edit that file." Line 502  If FILENAME is given, edit that file."
502    (let ((ada-buffer (current-buffer))    (let ((ada-buffer (current-buffer))
503          (inhibit-read-only t))          (inhibit-read-only t))
504    
505      (ada-require-project-file)      ;;  We can only edit interactively the standard ada-mode project files. If
506            ;;  the user is using other formats for the project file (through hooks in
507      (switch-to-buffer "*Customize Ada Mode*")      ;;  `ada-load-project-hook', we simply edit the file
508      (kill-all-local-variables)  
509            (if (and (not new-file)
510      (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer)               (or ada-prj-default-project-file filename)
511      (ada-prj-initialize-values  'ada-prj-current-values ada-buffer filename)               (string= (file-name-extension
512                           (or filename ada-prj-default-project-file))
513      (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)                        "gpr"))
514            (progn
515      (use-local-map (copy-keymap custom-mode-map))            (find-file ada-prj-default-project-file)
516      (local-set-key "\C-x\C-s" 'ada-prj-save)            (add-hook 'after-save-hook 'ada-reread-prj-file t t)
517              )
518    
519          ;;  Else start the interactive editor
520          (switch-to-buffer "*Customize Ada Mode*")
521          (kill-all-local-variables)
522    
523      (make-local-variable 'widget-keymap)        (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer)
524      (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)        (ada-prj-initialize-values
525           'ada-prj-current-values ada-buffer filename)
526    
527      (set (make-local-variable 'ada-old-cross-prefix)        (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
          (ada-xref-get-project-field 'cross-prefix))  
528    
529      (ada-prj-display-page 1)        (use-local-map (copy-keymap custom-mode-map))
530    ))        (local-set-key "\C-x\C-s" 'ada-prj-save)
531    
532          (make-local-variable 'widget-keymap)
533          (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)
534    
535          (set (make-local-variable 'ada-old-cross-prefix)
536               (ada-xref-get-project-field 'cross-prefix))
537    
538          (ada-prj-display-page 1)
539          )))
540    
541  ;; ---------------- Utilities --------------------------------  ;; ---------------- Utilities --------------------------------
542    
# Line 544  If ADA-FILE is nil, returns the project Line 560  If ADA-FILE is nil, returns the project
560      (setq ada-file (buffer-file-name)))      (setq ada-file (buffer-file-name)))
561    
562    (save-excursion    (save-excursion
     (set-buffer (get-file-buffer ada-file))  
       
563      (let ((prj-file (ada-prj-find-prj-file t)))      (let ((prj-file (ada-prj-find-prj-file t)))
564        (if (or (not prj-file)        (if (or (not prj-file)
565                (not (file-exists-p prj-file))                (not (file-exists-p prj-file))

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.8.2.1

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