diff options
| author | Gerd Moellmann | 2000-07-24 11:14:01 +0000 |
|---|---|---|
| committer | Gerd Moellmann | 2000-07-24 11:14:01 +0000 |
| commit | c6fa13e32703f8b0634401778a758e76f2798f97 (patch) | |
| tree | bb34d6f79b74bc7ea2f647d7347ff00022ba6273 | |
| parent | cf543c1c14b17005af6780f221c985220a85aa7f (diff) | |
| download | emacs-c6fa13e32703f8b0634401778a758e76f2798f97.tar.gz emacs-c6fa13e32703f8b0634401778a758e76f2798f97.zip | |
Rewritten to show a tabbed-dialog.
(ada-prj-add-ada-menu): Remove the map and name parameters.
(ada-prj-display-page, ada-prj-field, ada-prj-initialize-values):
New function
(ada-prj-load-directory, ada-prj-subdirs-of): New functions
(ada-prj-load-from-file): New function
(ada-prj-save): Always save fields that depend on the current buffer
(ada-prj-show-value): New function
| -rw-r--r-- | lisp/progmodes/ada-prj.el | 916 |
1 files changed, 549 insertions, 367 deletions
diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index e23a3371155..7dc38e74e2a 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el | |||
| @@ -1,9 +1,9 @@ | |||
| 1 | ;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode | 1 | ;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1998-1999 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Emmanuel Briot <briot@gnat.com> | 5 | ;; Author: Emmanuel Briot <briot@gnat.com> |
| 6 | ;; Ada Core Technologies's version: $Revision: 1.30 $ | 6 | ;; Ada Core Technologies's version: $Revision: 1.44 $ |
| 7 | ;; Keywords: languages, ada, project file | 7 | ;; Keywords: languages, ada, project file |
| 8 | 8 | ||
| 9 | ;; This file is not part of GNU Emacs. | 9 | ;; This file is not part of GNU Emacs. |
| @@ -22,14 +22,13 @@ | |||
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to | 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to |
| 23 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | 23 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
| 24 | 24 | ||
| 25 | ;;; Commentary: | ||
| 26 | ;;; This package provides a set of functions to easily edit the project | 25 | ;;; This package provides a set of functions to easily edit the project |
| 27 | ;;; files used by the ada-mode. | 26 | ;;; files used by the ada-mode. |
| 28 | ;;; The only function publicly available here is `ada-prj-customize'. | 27 | ;;; The only function publicly available here is `ada-customize'. |
| 29 | ;;; Please ada-mode.el and its documentation for more information about the | 28 | ;;; See the documentation of the Ada mode for more information on the project |
| 30 | ;;; project files. | 29 | ;;; files. |
| 31 | ;;; | 30 | ;;; Internally, a project file is represented as a property list, with each |
| 32 | ;;; You need Emacs >= 20.2 to run this package | 31 | ;;; field of the project file matching one property of the list. |
| 33 | 32 | ||
| 34 | ;; Code: | 33 | ;; Code: |
| 35 | 34 | ||
| @@ -38,103 +37,147 @@ | |||
| 38 | 37 | ||
| 39 | (require 'cus-edit) | 38 | (require 'cus-edit) |
| 40 | 39 | ||
| 41 | |||
| 42 | ;; ----- Buffer local variables ------------------------------------------- | 40 | ;; ----- Buffer local variables ------------------------------------------- |
| 43 | ;; if non nil, then all the widgets will have the default values, instead | ||
| 44 | ;; of reading them from the project file | ||
| 45 | (make-variable-buffer-local (defvar ada-prj-edit-use-default-values nil)) | ||
| 46 | |||
| 47 | ;; List of the default values used for the field in the project file | ||
| 48 | ;; Mainly used to save only the modified fields into the file itself | ||
| 49 | ;; The values are hold in the properties of this variable | ||
| 50 | (make-variable-buffer-local (defvar ada-prj-default nil)) | ||
| 51 | |||
| 52 | (make-variable-buffer-local (defvar ada-prj-widget-prj-dir nil)) | ||
| 53 | (make-variable-buffer-local (defvar ada-prj-widget-src-dir nil)) | ||
| 54 | (make-variable-buffer-local (defvar ada-prj-widget-obj-dir nil)) | ||
| 55 | (make-variable-buffer-local (defvar ada-prj-widget-main nil)) | ||
| 56 | (make-variable-buffer-local (defvar ada-prj-widget-comp-opt nil)) | ||
| 57 | (make-variable-buffer-local (defvar ada-prj-widget-bind-opt nil)) | ||
| 58 | (make-variable-buffer-local (defvar ada-prj-widget-link-opt nil)) | ||
| 59 | (make-variable-buffer-local (defvar ada-prj-widget-remote-machine nil)) | ||
| 60 | (make-variable-buffer-local (defvar ada-prj-widget-comp-cmd nil)) | ||
| 61 | (make-variable-buffer-local (defvar ada-prj-widget-make-cmd nil)) | ||
| 62 | (make-variable-buffer-local (defvar ada-prj-widget-run-cmd nil)) | ||
| 63 | (make-variable-buffer-local (defvar ada-prj-widget-debug-cmd nil)) | ||
| 64 | (make-variable-buffer-local (defvar ada-prj-widget-cross-prefix nil)) | ||
| 65 | |||
| 66 | ;; ------ Functions ------------------------------------------------------- | ||
| 67 | 41 | ||
| 68 | (defun ada-prj-add-ada-menu () | 42 | (defvar ada-prj-current-values nil |
| 69 | "Add a new submenu to the Ada menu." | 43 | "Hold the current value of the fields, This is a property list.") |
| 44 | (make-variable-buffer-local 'ada-prj-current-values) | ||
| 45 | |||
| 46 | (defvar ada-prj-default-values nil | ||
| 47 | "Hold the default value for the fields, This is a property list.") | ||
| 48 | (make-variable-buffer-local 'ada-prj-default-values) | ||
| 49 | |||
| 50 | (defvar ada-prj-ada-buffer nil | ||
| 51 | "Indicates what Ada source file was being edited.") | ||
| 52 | |||
| 53 | |||
| 54 | ;; ----- Functions -------------------------------------------------------- | ||
| 55 | |||
| 56 | (defun ada-prj-new () | ||
| 57 | "Open a new project file" | ||
| 70 | (interactive) | 58 | (interactive) |
| 59 | (let* ((prj | ||
| 60 | (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)) | ||
| 61 | ada-prj-prj-file | ||
| 62 | "default.adp")) | ||
| 63 | (filename (read-file-name "Project file: " | ||
| 64 | (if prj "" nil) | ||
| 65 | nil | ||
| 66 | nil | ||
| 67 | prj))) | ||
| 68 | (if (not (string= (file-name-extension filename t) ".adp")) | ||
| 69 | (error "File name extension for project files must be .adp")) | ||
| 70 | |||
| 71 | (ada-customize nil filename))) | ||
| 72 | |||
| 73 | (defun ada-prj-edit () | ||
| 74 | "Editing the project file associated with the current Ada buffer. | ||
| 75 | If there is none, opens a new project file" | ||
| 76 | (interactive) | ||
| 77 | (let ((file (ada-prj-find-prj-file))) | ||
| 78 | (if file | ||
| 79 | (progn | ||
| 80 | (ada-reread-prj-file file) | ||
| 81 | (ada-customize)) | ||
| 82 | (ada-prj-new)))) | ||
| 71 | 83 | ||
| 84 | (defun ada-prj-add-ada-menu () | ||
| 85 | "Add a new submenu to the Ada menu. | ||
| 86 | The items are added to the menu NAME in map MAP. NAME should be the same | ||
| 87 | name as was passed to `ada-create-menu'." | ||
| 72 | (if ada-xemacs | 88 | (if ada-xemacs |
| 73 | (progn | 89 | (progn |
| 74 | (add-menu-button '("Ada" "Project") ["New/Edit" ada-customize t] "Associate") | 90 | (funcall (symbol-function 'add-menu-button) |
| 75 | ) | 91 | '("Ada" "Project") |
| 76 | (let ((prj-menu (lookup-key ada-mode-map [menu-bar Ada Project]))) | 92 | ["Edit" ada-prj-edit t] "Associate") |
| 77 | (define-key prj-menu [New] '("New/Edit" . ada-customize))) | 93 | (funcall (symbol-function 'add-menu-button) |
| 78 | )) | 94 | '("Ada" "Project") |
| 95 | ["New..." ada-prj-new t] "Associate")) | ||
| 96 | (define-key (lookup-key ada-mode-map [menu-bar Ada Project]) | ||
| 97 | [Edit] '("Edit current" . ada-prj-edit)) | ||
| 98 | (define-key (lookup-key ada-mode-map [menu-bar Ada Project]) | ||
| 99 | [New] '("New" . ada-prj-new)))) | ||
| 79 | 100 | ||
| 80 | (defun ada-prj-add-keymap () | 101 | (defun ada-prj-add-keymap () |
| 81 | "Add new keybindings for ada-prj." | 102 | "Add new keybindings for ada-prj." |
| 82 | (define-key ada-mode-map "\C-cu" 'ada-customize)) | 103 | (define-key ada-mode-map "\C-cu" 'ada-prj-edit)) |
| 104 | |||
| 105 | (defun ada-prj-initialize-values (symbol ada-buffer &optional filename) | ||
| 106 | "Set SYMBOL to the property list of the project file FILENAME. | ||
| 107 | If FILENAME is null, read the file associated with ADA-BUFFER. If no | ||
| 108 | project file is found, returns the default values." | ||
| 109 | |||
| 110 | (let ((prj filename)) | ||
| 111 | |||
| 112 | (if filename | ||
| 113 | ;; If filename is given, reread if first if needed | ||
| 114 | (if (file-exists-p filename) | ||
| 115 | (ada-reread-prj-file)) | ||
| 116 | |||
| 117 | ;; Else use the one from the current buffer | ||
| 118 | (save-excursion | ||
| 119 | (set-buffer ada-buffer) | ||
| 120 | (set 'prj ada-prj-prj-file))) | ||
| 121 | |||
| 122 | |||
| 123 | (if (and prj | ||
| 124 | (not (string= prj "")) | ||
| 125 | (assoc prj ada-xref-project-files)) | ||
| 126 | (set symbol (copy-sequence (cdr (assoc prj ada-xref-project-files)))) | ||
| 127 | |||
| 128 | ;; Set default values (except for the file name if this was given | ||
| 129 | ;; in the buffer | ||
| 130 | (ada-xref-set-default-prj-values symbol ada-buffer) | ||
| 131 | (if (and prj (not (string= prj ""))) | ||
| 132 | (set symbol (plist-put (eval symbol) 'filename prj))) | ||
| 133 | ))) | ||
| 134 | |||
| 83 | 135 | ||
| 84 | (defun ada-customize (&optional new-file) | 136 | (defun ada-prj-save-specific-option (field) |
| 85 | "Edit the project file associated with the current buffer. | 137 | "Returns the string to print in the project file to save FIELD. |
| 86 | If there is none or NEW-FILE is non-nil, make a new one." | 138 | If the current value of FIELD is the default value, returns an empty string." |
| 87 | (interactive) | 139 | (if (string= (plist-get ada-prj-current-values field) |
| 88 | (if new-file | 140 | (plist-get ada-prj-default-values field)) |
| 89 | (progn | 141 | "" |
| 90 | (setq ada-prj-edit-use-default-values t) | 142 | (concat (symbol-name field) |
| 91 | (kill-local-variable 'ada-prj-prj-file) | 143 | "=" (plist-get ada-prj-current-values field) "\n"))) |
| 92 | (ada-prj-customize) | ||
| 93 | (setq ada-prj-edit-use-default-values nil)) | ||
| 94 | (ada-prj-customize))) | ||
| 95 | 144 | ||
| 96 | (defun ada-prj-save () | 145 | (defun ada-prj-save () |
| 97 | "Save the currently edited project file." | 146 | "Save the edited project file." |
| 98 | (interactive) | 147 | (interactive) |
| 99 | (let ((file-name (widget-value ada-prj-widget-prj-dir)) | 148 | (let ((file-name (plist-get ada-prj-current-values 'filename)) |
| 100 | value output) | 149 | output) |
| 101 | (setq output | 150 | (set 'output |
| 102 | (concat | 151 | (concat |
| 103 | (ada-prj-set-list "src_dir" (widget-value ada-prj-widget-src-dir)) | 152 | |
| 104 | "\n" | 153 | ;; Save the fields that do not depend on the current buffer |
| 105 | (ada-prj-set-list "obj_dir" (widget-value ada-prj-widget-obj-dir)) | 154 | ;; only if they are different from the default value |
| 106 | "\n" | 155 | |
| 107 | (unless (string= (setq value (widget-value ada-prj-widget-comp-opt)) | 156 | (ada-prj-save-specific-option 'comp_opt) |
| 108 | (get 'ada-prj-default 'comp_opt)) | 157 | (ada-prj-save-specific-option 'bind_opt) |
| 109 | (concat "comp_opt=" value "\n")) | 158 | (ada-prj-save-specific-option 'link_opt) |
| 110 | (unless (string= (setq value (widget-value ada-prj-widget-bind-opt)) | 159 | (ada-prj-save-specific-option 'gnatmake_opt) |
| 111 | (get 'ada-prj-default 'bind_opt)) | 160 | (ada-prj-save-specific-option 'cross_prefix) |
| 112 | (concat "bind_opt=" value "\n")) | 161 | (ada-prj-save-specific-option 'remote_machine) |
| 113 | (unless (string= (setq value (widget-value ada-prj-widget-link-opt)) | 162 | (ada-prj-save-specific-option 'comp_cmd) |
| 114 | (get 'ada-prj-default 'link_opt)) | 163 | (ada-prj-save-specific-option 'check_cmd) |
| 115 | (concat "link_opt=" value "\n")) | 164 | (ada-prj-save-specific-option 'make_cmd) |
| 116 | (unless (string= (setq value (widget-value ada-prj-widget-main)) | 165 | (ada-prj-save-specific-option 'run_cmd) |
| 117 | (get 'ada-prj-default 'main)) | 166 | (ada-prj-save-specific-option 'debug_cmd) |
| 118 | (concat "main=" value "\n")) | 167 | |
| 119 | (unless (string= (setq value (widget-value ada-prj-widget-cross-prefix)) | 168 | ;; Always save the fields that depend on the current buffer |
| 120 | (get 'ada-prj-default 'cross-prefix)) | 169 | (concat "main=" (plist-get ada-prj-current-values 'main) "\n") |
| 121 | (concat "cross_prefix=" value "\n")) | 170 | (concat "main_unit=" (plist-get ada-prj-current-values 'main_unit) "\n") |
| 122 | (unless (string= (setq value (widget-value ada-prj-widget-remote-machine)) | 171 | (concat "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n") |
| 123 | (get 'ada-prj-default 'remote-machine)) | 172 | |
| 124 | (concat "remote_machine=" value "\n")) | 173 | (ada-prj-set-list "casing" |
| 125 | (unless (string= (setq value (widget-value ada-prj-widget-comp-cmd)) | 174 | (plist-get ada-prj-current-values 'casing)) "\n" |
| 126 | (get 'ada-prj-default 'comp_cmd)) | 175 | (ada-prj-set-list "src_dir" |
| 127 | (concat "comp_cmd=" value "\n")) | 176 | (plist-get ada-prj-current-values 'src_dir)) "\n" |
| 128 | (unless (string= (setq value (widget-value ada-prj-widget-make-cmd)) | 177 | (ada-prj-set-list "obj_dir" |
| 129 | (get 'ada-prj-default 'make_cmd)) | 178 | (plist-get ada-prj-current-values 'obj_dir)) "\n" |
| 130 | (concat "make_cmd=" value "\n")) | 179 | )) |
| 131 | (unless (string= (setq value (widget-value ada-prj-widget-run-cmd)) | 180 | |
| 132 | (get 'ada-prj-default 'run_cmd)) | ||
| 133 | (concat "run_cmd=" value "\n")) | ||
| 134 | (unless (string= (setq value (widget-value ada-prj-widget-debug-cmd)) | ||
| 135 | (get 'ada-prj-default 'debug_cmd)) | ||
| 136 | (concat "debug_cmd=" value "\n")) | ||
| 137 | )) | ||
| 138 | (find-file file-name) | 181 | (find-file file-name) |
| 139 | (erase-buffer) | 182 | (erase-buffer) |
| 140 | (insert output) | 183 | (insert output) |
| @@ -147,285 +190,306 @@ If there is none or NEW-FILE is non-nil, make a new one." | |||
| 147 | 190 | ||
| 148 | ;; automatically associates the current buffer with the | 191 | ;; automatically associates the current buffer with the |
| 149 | ;; new project file | 192 | ;; new project file |
| 150 | (make-local-variable 'ada-prj-prj-file) | 193 | (set (make-local-variable 'ada-prj-prj-file) file-name) |
| 151 | (setq ada-prj-prj-file file-name) | ||
| 152 | 194 | ||
| 153 | ;; force emacs to reread the project files | 195 | ;; force Emacs to reread the project files |
| 154 | (ada-reread-prj-file t) | 196 | (ada-reread-prj-file file-name) |
| 155 | ) | 197 | ) |
| 156 | ) | 198 | ) |
| 157 | 199 | ||
| 158 | (defun ada-prj-customize () | 200 | (defun ada-prj-load-from-file (symbol) |
| 159 | "Edit the project file associated with the current Ada buffer." | 201 | "Load SYMBOL value from file. One item per line should be found in the file." |
| 160 | (let* ((old-name (buffer-file-name)) | 202 | (save-excursion |
| 161 | prj-file) | 203 | (let ((file (read-file-name "File name: " nil nil t)) |
| 204 | (buffer (current-buffer)) | ||
| 205 | line | ||
| 206 | list) | ||
| 207 | (find-file file) | ||
| 208 | (widen) | ||
| 209 | (goto-char (point-min)) | ||
| 210 | (while (not (eobp)) | ||
| 211 | (set 'line (buffer-substring-no-properties | ||
| 212 | (point) (save-excursion (end-of-line) (point)))) | ||
| 213 | (add-to-list 'list line) | ||
| 214 | (forward-line 1) | ||
| 215 | ) | ||
| 216 | (kill-buffer nil) | ||
| 217 | (set-buffer buffer) | ||
| 218 | (set 'ada-prj-current-values | ||
| 219 | (plist-put ada-prj-current-values | ||
| 220 | symbol | ||
| 221 | (append (plist-get ada-prj-current-values symbol) | ||
| 222 | (reverse list)))) | ||
| 223 | ) | ||
| 224 | (ada-prj-display-page 2) | ||
| 225 | )) | ||
| 226 | |||
| 227 | (defun ada-prj-subdirs-of (dir) | ||
| 228 | "Returns a list of all the subdirectories of dir, recursively." | ||
| 229 | (let ((subdirs (directory-files dir t "^[^.].*")) | ||
| 230 | (dirlist (list dir))) | ||
| 231 | (while subdirs | ||
| 232 | (if (file-directory-p (car subdirs)) | ||
| 233 | (let ((sub (ada-prj-subdirs-of (car subdirs)))) | ||
| 234 | (if sub | ||
| 235 | (set 'dirlist (append sub dirlist))))) | ||
| 236 | (set 'subdirs (cdr subdirs))) | ||
| 237 | dirlist)) | ||
| 238 | |||
| 239 | (defun ada-prj-load-directory (field &optional file-name) | ||
| 240 | "Append the content of FILE-NAME to FIELD in the current project file. | ||
| 241 | If FILE-NAME is nil, ask the user for the name." | ||
| 242 | (unless file-name | ||
| 243 | (set 'file-name (read-file-name "Root directory: " nil nil t))) | ||
| 244 | |||
| 245 | (set 'ada-prj-current-values | ||
| 246 | (plist-put ada-prj-current-values | ||
| 247 | field | ||
| 248 | (append (plist-get ada-prj-current-values field) | ||
| 249 | (reverse (ada-prj-subdirs-of | ||
| 250 | (expand-file-name file-name)))))) | ||
| 251 | (ada-prj-display-page 2)) | ||
| 252 | |||
| 253 | (defun ada-prj-display-page (tab-num) | ||
| 254 | "Display one of the pages available in the notebook. TAB-NUM should have | ||
| 255 | a value between 1 and the maximum number of pages. | ||
| 256 | The current buffer must be the project editing buffer." | ||
| 257 | |||
| 258 | (let ((inhibit-read-only t)) | ||
| 259 | (erase-buffer)) | ||
| 260 | |||
| 261 | ;; Display the tabs | ||
| 262 | |||
| 263 | (widget-insert "\n Project and Editor configuration.\n | ||
| 264 | ___________ ____________ ____________ ____________\n / ") | ||
| 265 | (widget-create 'push-button :notify | ||
| 266 | (lambda (&rest dummy) (ada-prj-display-page 1)) "General") | ||
| 267 | (widget-insert " \\ / ") | ||
| 268 | (widget-create 'push-button :notify | ||
| 269 | (lambda (&rest dummy) (ada-prj-display-page 2)) "Paths") | ||
| 270 | (widget-insert " \\ / ") | ||
| 271 | (widget-create 'push-button :notify | ||
| 272 | (lambda (&rest dummy) (ada-prj-display-page 3)) "Switches") | ||
| 273 | (widget-insert " \\ / ") | ||
| 274 | (widget-create 'push-button :notify | ||
| 275 | (lambda (&rest dummy) (ada-prj-display-page 4)) "Ada Menu") | ||
| 276 | (widget-insert " \\\n") | ||
| 277 | |||
| 278 | ;; Display the currently selected page | ||
| 279 | |||
| 280 | (cond | ||
| 281 | |||
| 282 | ;; | ||
| 283 | ;; First page (General) | ||
| 284 | ;; | ||
| 285 | ((= tab-num 1) | ||
| 286 | (widget-insert "_/ \\/______________\\/______________\\/______________\\_____\n\n") | ||
| 287 | |||
| 288 | (widget-insert "Project file name:\n") | ||
| 289 | (widget-insert (plist-get ada-prj-current-values 'filename)) | ||
| 290 | (widget-insert "\n\n") | ||
| 291 | ; (ada-prj-field 'filename "Project file name" | ||
| 292 | ; "Enter the name and directory of the project | ||
| 293 | ; file. The name of the file should be the | ||
| 294 | ; name of the project itself. The extension | ||
| 295 | ; must be .adp") | ||
| 296 | ; (ada-prj-field 'casing "Casing Exceptions Dictionnaries" | ||
| 297 | ; "List of files that contain casing exception | ||
| 298 | ; dictionnaries. All these files contain one | ||
| 299 | ; identifier per line, with a special casing. | ||
| 300 | ; The first file has the highest priority." | ||
| 301 | ; t) | ||
| 302 | (ada-prj-field 'main "Executable file name" | ||
| 303 | "Name of the executable generated when you | ||
| 304 | compile your application. This should include | ||
| 305 | the full directory name, using ${build_dir} if | ||
| 306 | you wish.") | ||
| 307 | (ada-prj-field 'main_unit "File name of the main unit" | ||
| 308 | "Name of the file to pass to the gnatmake command, | ||
| 309 | and that will create the executable. | ||
| 310 | This should not include any directory specification.") | ||
| 311 | (ada-prj-field 'build_dir "Build directory" | ||
| 312 | "Reference directory for relative paths in | ||
| 313 | src_dir and obj_dir below. This is also the directory | ||
| 314 | where the compilation is done.") | ||
| 315 | (ada-prj-field 'remote_machine "Name of the remote machine (if any)" | ||
| 316 | "If you want to remotely compile, debug and | ||
| 317 | run your application, specify the name of a | ||
| 318 | remote machine here. This capability requires | ||
| 319 | the 'rsh' protocol on the remote machine.") | ||
| 320 | (ada-prj-field 'cross_prefix "Prefix used in for the cross tool chain" | ||
| 321 | "When working on multiple cross targets, it is | ||
| 322 | most convenient to specify the prefix of the | ||
| 323 | tool chain here. For instance, on PowerPc | ||
| 324 | vxworks, you would enter 'powerpc-wrs-vxworks-'. | ||
| 325 | To use JGNAT, enter 'j'.") | ||
| 326 | ) | ||
| 162 | 327 | ||
| 163 | (unless old-name | 328 | |
| 164 | (error | 329 | ;; |
| 165 | "No file name given for this buffer ! You need to open a file first")) | 330 | ;; Second page (Paths) |
| 331 | ;; | ||
| 332 | ((= tab-num 2) | ||
| 333 | (widget-insert "_/_____________\\/ \\/______________\\/______________\\_____\n\n") | ||
| 334 | (ada-prj-field 'src_dir "Source directories" | ||
| 335 | "Enter the list of directories where your Ada | ||
| 336 | sources can be found. These directories will be | ||
| 337 | used for the cross-references and for the default | ||
| 338 | compilation commands. | ||
| 339 | Note that src_dir includes both the build directory | ||
| 340 | and the standard runtime." | ||
| 341 | t t | ||
| 342 | (mapconcat (lambda(x) | ||
| 343 | (concat " " x)) | ||
| 344 | ada-xref-runtime-library-specs-path | ||
| 345 | "\n") | ||
| 346 | ) | ||
| 347 | (widget-insert "\n\n") | ||
| 166 | 348 | ||
| 167 | ;; Find the project file associated with the buffer | 349 | (ada-prj-field 'obj_dir "Object directories" |
| 168 | (setq prj-file (ada-prj-get-prj-dir old-name)) | 350 | "Enter the list of directories where the GNAT |
| 351 | library files (ALI files) can be found. These | ||
| 352 | files are used for cross-references and by the | ||
| 353 | gnatmake command. | ||
| 354 | Note that obj_dir includes both the build directory | ||
| 355 | and the standard runtime." | ||
| 356 | t t | ||
| 357 | (mapconcat (lambda(x) | ||
| 358 | (concat " " x)) | ||
| 359 | ada-xref-runtime-library-ali-path | ||
| 360 | "\n") | ||
| 361 | ) | ||
| 362 | (widget-insert "\n\n") | ||
| 363 | ) | ||
| 169 | 364 | ||
| 170 | (switch-to-buffer "*Customize Ada Mode*") | 365 | ;; |
| 171 | (kill-all-local-variables) | 366 | ;; Third page (Switches) |
| 367 | ;; | ||
| 368 | ((= tab-num 3) | ||
| 369 | (widget-insert "_/_____________\\/______________\\/ \\/______________\\_____\n\n") | ||
| 370 | (ada-prj-field 'comp_opt "Switches for the compiler" | ||
| 371 | "These switches are used in the default | ||
| 372 | compilation commands, both for compiling a | ||
| 373 | single file and rebuilding the whole project") | ||
| 374 | (ada-prj-field 'bind_opt "Switches for the binder" | ||
| 375 | "These switches are used in the default build | ||
| 376 | command and are passed to the binder") | ||
| 377 | (ada-prj-field 'link_opt "Switches for the linker" | ||
| 378 | "These switches are used in the default build | ||
| 379 | command and are passed to the linker") | ||
| 380 | (ada-prj-field 'gnatmake_opt "Switches for gnatmake" | ||
| 381 | "These switches are used in the default gnatmake | ||
| 382 | command.") | ||
| 383 | ) | ||
| 172 | 384 | ||
| 173 | ;; Find the default values | 385 | ;; |
| 174 | (setq ada-prj-default nil) | 386 | ;; Fourth page |
| 175 | (put 'ada-prj-default 'src_dir (list (file-name-directory old-name))) | 387 | ;; |
| 176 | (put 'ada-prj-default 'obj_dir (list (file-name-directory old-name))) | 388 | ((= tab-num 4) |
| 177 | (put 'ada-prj-default 'comp_opt "") | 389 | (widget-insert "_/_____________\\/______________\\/______________\\/ \\_____\n\n") |
| 178 | (put 'ada-prj-default 'bind_opt "") | 390 | (widget-insert "All the fields below can use variable substitution\n") |
| 179 | (put 'ada-prj-default 'link_opt "") | 391 | (widget-insert "The syntax is ${name}, where name is the name that\n") |
| 180 | (put 'ada-prj-default 'main "") | 392 | (widget-insert "appears after the Help buttons in this buffer.\n") |
| 181 | (put 'ada-prj-default 'cross_prefix "") | 393 | (widget-insert "As a special case, ${current} is replaced with the name\n") |
| 182 | (put 'ada-prj-default 'remote_machine "") | 394 | (widget-insert "of the file currently edited, with directory name but\n") |
| 183 | (put 'ada-prj-default 'comp_cmd | 395 | (widget-insert "no extension.\n\n") |
| 184 | (concat "cd " (file-name-directory old-name) " && " | 396 | (widget-insert |
| 185 | ada-prj-default-comp-cmd)) | 397 | "The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH\n") |
| 186 | (put 'ada-prj-default 'make_cmd | 398 | (widget-insert |
| 187 | (concat "cd " (file-name-directory old-name) " && " | 399 | "are set to ${src_dir} and ${obj_dir} before running the compilation\n") |
| 188 | ada-prj-default-make-cmd)) | 400 | (widget-insert |
| 189 | (put 'ada-prj-default 'run_cmd (if is-windows "${main}.exe" "${main}")) | 401 | "commands, so that you don't need to specify the -aI and -aO\n") |
| 190 | (put 'ada-prj-default 'debug_cmd | 402 | (widget-insert |
| 191 | (if is-windows "${cross_prefix}gdb ${main}.exe" | 403 | "switches on the command line\n\n") |
| 192 | "${cross_prefix}gdb ${main}")) | 404 | |
| 193 | 405 | (ada-prj-field 'check_cmd | |
| 194 | (let ((inhibit-read-only t)) | 406 | "Check syntax of a single file (menu Ada->Check File)" |
| 195 | (erase-buffer)) | 407 | "This command is run to check the syntax and semantics of a file. |
| 196 | 408 | The file name is added at the end of this command.") | |
| 197 | ;;; Overlay-lists is not defined on XEmacs | 409 | (ada-prj-field 'comp_cmd |
| 198 | (if (fboundp 'overlay-lists) | 410 | "Compiling a single file (menu Ada->Compile File)" |
| 199 | (let ((all (overlay-lists))) | 411 | "This command is run when the recompilation |
| 200 | ;; Delete all the overlays. | 412 | of a single file is needed. The file name is |
| 201 | (mapcar 'delete-overlay (car all)) | 413 | added at the end of this command.") |
| 202 | (mapcar 'delete-overlay (cdr all)))) | 414 | (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)" |
| 415 | "This command is run when you want to rebuild | ||
| 416 | your whole application. It is never issues | ||
| 417 | automatically and you will need to ask for it. | ||
| 418 | If remote_machine has been set, this command | ||
| 419 | will be executed on the remote machine.") | ||
| 420 | (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)" | ||
| 421 | "This command specifies how to run the | ||
| 422 | application, including any switch you need to | ||
| 423 | specify. If remote_machine has been set, this | ||
| 424 | command will be executed on the remote host.") | ||
| 425 | (ada-prj-field 'debug_cmd "Debugging the application" | ||
| 426 | "Specifies how to debug the application, possibly | ||
| 427 | remotely if remote_machine has been set. We | ||
| 428 | recommend the following debuggers: | ||
| 429 | > gdb | ||
| 430 | > gdbtk | ||
| 431 | > ddd --tty -fullname -toolbar") | ||
| 432 | ) | ||
| 433 | ) | ||
| 434 | |||
| 435 | |||
| 436 | (widget-insert "______________________________________________________________________\n\n ") | ||
| 437 | (widget-create 'push-button | ||
| 438 | :notify (lambda (&rest ignore) | ||
| 439 | (ada-xref-set-default-prj-values | ||
| 440 | 'ada-prj-current-values ada-prj-ada-buffer) | ||
| 441 | (ada-prj-display-page 1)) | ||
| 442 | "Reset to Default Values") | ||
| 443 | (widget-insert " ") | ||
| 444 | (widget-create 'push-button :notify (lambda (&rest ignore) (kill-buffer nil)) | ||
| 445 | "Cancel") | ||
| 446 | (widget-insert " ") | ||
| 447 | (widget-create 'push-button :notify (lambda (&rest ignore) (ada-prj-save)) | ||
| 448 | "Save") | ||
| 449 | (widget-insert "\n\n") | ||
| 450 | |||
| 451 | (widget-setup) | ||
| 452 | (beginning-of-buffer) | ||
| 453 | ) | ||
| 203 | 454 | ||
| 204 | (use-local-map (copy-keymap custom-mode-map)) | ||
| 205 | (local-set-key "\C-x\C-s" 'ada-prj-save) | ||
| 206 | 455 | ||
| 207 | (widget-insert " | 456 | (defun ada-customize (&optional new-file filename) |
| 208 | ---------------------------------------------------------------- | 457 | "Edit the project file associated with the current buffer. |
| 209 | -- Customize your Emacs Ada mode for the current application -- | 458 | If there is none or NEW-FILE is non-nil, make a new one. |
| 210 | ---------------------------------------------------------------- | 459 | If FILENAME is given, edit that file." |
| 211 | This buffer will allow you to create easily a project file for your application. | 460 | (interactive) |
| 212 | This file will tell Emacs where to find the ada sources, the cross-referencing | ||
| 213 | informations, how to compile and run your application, ... | ||
| 214 | |||
| 215 | Please use the RETURN key, or middle mouse button to activate the fields.\n\n") | ||
| 216 | |||
| 217 | ;; Reset Button | ||
| 218 | (widget-create 'push-button | ||
| 219 | :notify (lambda (&rest ignore) | ||
| 220 | (setq ada-prj-edit-use-default-values t) | ||
| 221 | (kill-buffer nil) | ||
| 222 | (ada-prj-customize) | ||
| 223 | (setq ada-prj-edit-use-default-values nil) | ||
| 224 | ) | ||
| 225 | "Reset to Default Values") | ||
| 226 | (widget-insert "\n") | ||
| 227 | 461 | ||
| 462 | (let ((ada-buffer (current-buffer)) | ||
| 463 | (inhibit-read-only t)) | ||
| 228 | 464 | ||
| 229 | ;; Create local variables with their initial value | 465 | (ada-require-project-file) |
| 230 | (setq ada-prj-widget-prj-dir | 466 | |
| 231 | (ada-prj-new 'ada-prj-widget-prj-dir nil "" prj-file | 467 | (switch-to-buffer "*Customize Ada Mode*") |
| 232 | "\nName and directory of the project file. | 468 | (kill-all-local-variables) |
| 233 | Put a new name here if you want to create a new project file\n")) | 469 | |
| 234 | 470 | (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer) | |
| 235 | (setq ada-prj-widget-src-dir | 471 | (ada-prj-initialize-values 'ada-prj-current-values ada-buffer filename) |
| 236 | (ada-prj-list 'ada-prj-widget-src-dir prj-file "src_dir" | ||
| 237 | (get 'ada-prj-default 'src_dir) | ||
| 238 | "\nYou should enter below all the directories where Emacs | ||
| 239 | will find your ada sources for the current application\n")) | ||
| 240 | |||
| 241 | (setq ada-prj-widget-obj-dir | ||
| 242 | (ada-prj-list 'ada-prj-widget-obj-dir prj-file "obj_dir" | ||
| 243 | (get 'ada-prj-default 'obj_dir) | ||
| 244 | "\nBelow are the directories where the object files generated | ||
| 245 | by the compiler will be found. This files are required for the cross-referencing | ||
| 246 | capabilities of the Emacs' Ada-mode.\n")) | ||
| 247 | |||
| 248 | (setq ada-prj-widget-comp-opt | ||
| 249 | (ada-prj-new 'ada-prj-widget-comp-opt prj-file "comp_opt" | ||
| 250 | (get 'ada-prj-default 'comp_opt) | ||
| 251 | "\nPut below the compiler switches.\n")) | ||
| 252 | |||
| 253 | (setq ada-prj-widget-bind-opt | ||
| 254 | (ada-prj-new 'ada-prj-widget-bind-opt prj-file "bind_opt" | ||
| 255 | (get 'ada-prj-default 'bind_opt) | ||
| 256 | "\nPut below the binder switches.\n")) | ||
| 257 | |||
| 258 | (setq ada-prj-widget-link-opt | ||
| 259 | (ada-prj-new 'ada-prj-widget-link-opt prj-file "link_opt" | ||
| 260 | (get 'ada-prj-default 'link_opt) | ||
| 261 | "\nPut below the linker switches.\n")) | ||
| 262 | |||
| 263 | (setq ada-prj-widget-main | ||
| 264 | (ada-prj-new 'ada-prj-widget-main prj-file "main" | ||
| 265 | (file-name-sans-extension old-name) | ||
| 266 | "\nPut below the name of the main program for your application\n")) | ||
| 267 | |||
| 268 | (setq ada-prj-widget-cross-prefix | ||
| 269 | (ada-prj-new 'ada-prj-widget-cross-prefix prj-file "cross_prefix" | ||
| 270 | (get 'ada-prj-default 'cross_prefix) | ||
| 271 | "\nIf you are using a cross compiler, you might want to | ||
| 272 | set the following variable so that the correct compiler is used by default\n")) | ||
| 273 | |||
| 274 | (setq ada-prj-widget-remote-machine | ||
| 275 | (ada-prj-new 'ada-prj-widget-remote-machine prj-file "remote_machine" | ||
| 276 | (get 'ada-prj-default 'remote_machine) | ||
| 277 | "\nName of the machine to log on before a compilation. | ||
| 278 | Leave an empty field if you want to compile on the local machine. | ||
| 279 | This will not work on Windows NT, since we only do a 'rsh' to the | ||
| 280 | remote machine and then issue the command. \n")) | ||
| 281 | |||
| 282 | (widget-insert "\n | ||
| 283 | ------------------------------------------------------------------------------- | ||
| 284 | / \\ !! Advanced Users !! : For the following commands, you may use | ||
| 285 | / | \\ a somewhat more complicated syntax to describe them. If you | ||
| 286 | / | \\ use some special fields, they will be replaced at run-time by | ||
| 287 | / | \\ the variables defined above. | ||
| 288 | / | \\ These special fields are : ${remote_machine} | ||
| 289 | / o \\ -aI${src_dir} -I${src_dir} -aO${obj_dir} ${comp_opt} | ||
| 290 | ------------- ${bind_opt} ${link_opt} ${main} ${cross_prefix} | ||
| 291 | |||
| 292 | The easiest way is to ignore this possibility. These fields are intended only | ||
| 293 | for user who really understand what `variable substitution' means. | ||
| 294 | -------------------------------------------------------------------------------\n") | ||
| 295 | |||
| 296 | (setq ada-prj-widget-comp-cmd | ||
| 297 | (ada-prj-new 'ada-prj-widget-comp-cmd prj-file "comp_cmd" | ||
| 298 | (get 'ada-prj-default 'comp_cmd) | ||
| 299 | "\nPut below the command used to compile ONE file. | ||
| 300 | The name of the file to compile will be added at the end of the command. | ||
| 301 | This command will also be used to check the file.\n")) | ||
| 302 | |||
| 303 | (setq ada-prj-widget-make-cmd | ||
| 304 | (ada-prj-new 'ada-prj-widget-make-cmd prj-file "make_cmd" | ||
| 305 | (get 'ada-prj-default 'make_cmd) | ||
| 306 | "\nPut below the command used to compile the whole application.\n")) | ||
| 307 | |||
| 308 | (setq ada-prj-widget-run-cmd | ||
| 309 | (ada-prj-new 'ada-prj-widget-run-cmd prj-file "run_cmd" | ||
| 310 | (get 'ada-prj-default 'run_cmd) | ||
| 311 | "\nPut below the command used to run your application.\n")) | ||
| 312 | |||
| 313 | (setq ada-prj-widget-debug-cmd | ||
| 314 | (ada-prj-new 'ada-prj-widget-run-cmd prj-file "debug_cmd" | ||
| 315 | (get 'ada-prj-default 'debug_cmd) | ||
| 316 | "\nPut below the command used to launch the debugger on your application.\n")) | ||
| 317 | |||
| 318 | ;; the two buttons to validate or cancel the modification | ||
| 319 | (widget-insert "\nWhen you have finish completing the above fields, choose one of the two buttons | ||
| 320 | below, to validate or cancel your modifications. | ||
| 321 | If you choose `OK', your settings will be saved to the file whose name is given above.\n") | ||
| 322 | |||
| 323 | (widget-create 'push-button | ||
| 324 | :notify (lambda (&rest ignore) (ada-prj-save)) | ||
| 325 | "OK") | ||
| 326 | |||
| 327 | (widget-insert " ") | ||
| 328 | (widget-create 'push-button | ||
| 329 | :notify (lambda (&rest ignore) | ||
| 330 | (kill-buffer nil)) | ||
| 331 | "Cancel") | ||
| 332 | (widget-insert "\n") | ||
| 333 | 472 | ||
| 473 | (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer) | ||
| 334 | 474 | ||
| 335 | ;; if it exists, kill the project file buffer | 475 | (use-local-map (copy-keymap custom-mode-map)) |
| 336 | (if (and prj-file | 476 | (local-set-key "\C-x\C-s" 'ada-prj-save) |
| 337 | (get-file-buffer prj-file)) | ||
| 338 | (kill-buffer (get-file-buffer prj-file))) | ||
| 339 | 477 | ||
| 340 | (widget-setup) | 478 | (make-local-variable 'widget-keymap) |
| 341 | (beginning-of-buffer) | 479 | (define-key widget-keymap "\C-x\C-s" 'ada-prj-save) |
| 342 | ) | ||
| 343 | ) | ||
| 344 | 480 | ||
| 481 | (ada-prj-display-page 1) | ||
| 482 | )) | ||
| 345 | 483 | ||
| 346 | ;; ---------------- Utilities -------------------------------- | 484 | ;; ---------------- Utilities -------------------------------- |
| 347 | 485 | ||
| 348 | (defun ada-prj-new (variable prj-file text default message) | 486 | (defun ada-prj-set-list (string ada-dir-list) |
| 349 | "Create a buffer-local variable with name VARIABLE. | ||
| 350 | If PRJ-FILE exists, read its value from that file, otherwise set it to | ||
| 351 | DEFAULT. | ||
| 352 | It also creates a widget in the current buffer to edit this variable, | ||
| 353 | which MESSAGE explaning what the variable is supposed to do. | ||
| 354 | TEXT is put just before the editable field, and should display the name | ||
| 355 | of the variable." | ||
| 356 | |||
| 357 | ;; create local variable | ||
| 358 | (make-local-variable variable) | ||
| 359 | (let ((value default) | ||
| 360 | (regexp (concat "^" text "=\\(.*\\)"))) | ||
| 361 | ;; if the project file exists | ||
| 362 | (if (and prj-file (not ada-prj-edit-use-default-values) | ||
| 363 | (file-readable-p prj-file)) | ||
| 364 | ;; find the value | ||
| 365 | (save-excursion | ||
| 366 | (find-file prj-file) | ||
| 367 | (beginning-of-buffer) | ||
| 368 | (if (re-search-forward regexp nil t) | ||
| 369 | (setq value (match-string 1))) | ||
| 370 | )) | ||
| 371 | ;; assign a new value to the variable | ||
| 372 | (setq variable value)) | ||
| 373 | |||
| 374 | (widget-insert message) | ||
| 375 | |||
| 376 | (widget-create 'editable-field | ||
| 377 | :format (if (string= text "") "%v" | ||
| 378 | (concat text "= %v")) | ||
| 379 | :keymap widget-keymap | ||
| 380 | variable)) | ||
| 381 | |||
| 382 | |||
| 383 | (defun ada-prj-list (variable prj-file text default message) | ||
| 384 | "Create a buffer-local list variable with name VARIABLE. | ||
| 385 | If PRJ-FILE exists, read its value from that file, otherwise set it to | ||
| 386 | DEFAULT. | ||
| 387 | It also creates a widget in the current buffer to edit this variable, | ||
| 388 | which MESSAGE explaning what the variable is supposed to do. | ||
| 389 | TEXT is put just before the editable field, and should display the name | ||
| 390 | of the variable." | ||
| 391 | |||
| 392 | ;; create local variable | ||
| 393 | (make-local-variable variable) | ||
| 394 | (let ((value nil) | ||
| 395 | (regexp (concat "^" text "=\\(.*\\)"))) | ||
| 396 | ;; if the project file exists | ||
| 397 | (if (and prj-file (not ada-prj-edit-use-default-values) | ||
| 398 | (file-readable-p prj-file)) | ||
| 399 | ;; find the value | ||
| 400 | (save-excursion | ||
| 401 | (find-file prj-file) | ||
| 402 | (goto-char (point-min)) | ||
| 403 | ;; for each line, add its value | ||
| 404 | (while | ||
| 405 | (re-search-forward regexp nil t) | ||
| 406 | (progn | ||
| 407 | (setq value (cons (match-string 1) value))) | ||
| 408 | ))) | ||
| 409 | |||
| 410 | ;; assign a new value to the variable | ||
| 411 | (setq variable | ||
| 412 | (if value (reverse value) default))) | ||
| 413 | |||
| 414 | (widget-insert message) | ||
| 415 | (widget-create 'editable-list | ||
| 416 | :entry-format (concat text "= %i %d %v") | ||
| 417 | :value variable | ||
| 418 | (list 'editable-field :keymap widget-keymap))) | ||
| 419 | |||
| 420 | (defsubst ada-prj-set-list (string ada-dir-list) | ||
| 421 | "Join the strings in ADA-DIR-LIST into a single string. Each name is put | 487 | "Join the strings in ADA-DIR-LIST into a single string. Each name is put |
| 422 | on a separate line that begins with STRING." | 488 | on a separate line that begins with STRING." |
| 423 | (mapconcat (lambda (x) | 489 | (mapconcat (lambda (x) (concat string "=" (file-name-as-directory x))) |
| 424 | (concat string "=" x | ||
| 425 | (unless (string= (substring x -1) "/") | ||
| 426 | "/"))) | ||
| 427 | ada-dir-list "\n")) | 490 | ada-dir-list "\n")) |
| 428 | 491 | ||
| 492 | |||
| 429 | (defun ada-prj-get-prj-dir (&optional ada-file) | 493 | (defun ada-prj-get-prj-dir (&optional ada-file) |
| 430 | "Returns the directory/name of the project file for ADA-FILE. | 494 | "Returns the directory/name of the project file for ADA-FILE. |
| 431 | If ADA-FILE is nil, returns the project file for the current buffer." | 495 | If ADA-FILE is nil, returns the project file for the current buffer." |
| @@ -434,31 +498,149 @@ If ADA-FILE is nil, returns the project file for the current buffer." | |||
| 434 | 498 | ||
| 435 | (save-excursion | 499 | (save-excursion |
| 436 | (set-buffer (get-file-buffer ada-file)) | 500 | (set-buffer (get-file-buffer ada-file)) |
| 437 | (if ada-prj-edit-use-default-values | 501 | |
| 438 | (concat (file-name-sans-extension ada-file) | 502 | (let ((prj-file (ada-prj-find-prj-file t))) |
| 439 | ada-project-file-extension) | 503 | (if (or (not prj-file) |
| 440 | 504 | (not (file-exists-p prj-file)) | |
| 441 | (let ((prj-file (ada-prj-find-prj-file t))) | 505 | ) |
| 442 | (if (or (not prj-file) | 506 | (setq prj-file |
| 443 | (not (file-exists-p prj-file)) | 507 | (concat (file-name-sans-extension ada-file) |
| 444 | ) | 508 | ada-project-file-extension))) |
| 445 | (setq prj-file | 509 | prj-file) |
| 446 | (concat (file-name-sans-extension ada-file) | 510 | )) |
| 447 | ada-project-file-extension))) | ||
| 448 | prj-file) | ||
| 449 | )) | ||
| 450 | ) | ||
| 451 | 511 | ||
| 512 | (defun ada-prj-field-modified (widget &rest dummy) | ||
| 513 | "Callback called each time the value of WIDGET is modified. Save the | ||
| 514 | change in ada-prj-current-values so that selecting another page and coming | ||
| 515 | back keeps the new value." | ||
| 516 | (set 'ada-prj-current-values | ||
| 517 | (plist-put ada-prj-current-values | ||
| 518 | (widget-get widget 'prj-field) | ||
| 519 | (widget-value widget)))) | ||
| 520 | |||
| 521 | (defun ada-prj-display-help (widget widget-modified event) | ||
| 522 | "An help button in WIDGET was clicked on. The parameters are so that | ||
| 523 | this function can be used as :notify for the widget." | ||
| 524 | (let ((text (widget-get widget 'prj-help))) | ||
| 525 | (if event | ||
| 526 | ;; If we have a mouse-event, popup a menu | ||
| 527 | (widget-choose "Help" | ||
| 528 | (mapcar (lambda (a) (cons a t)) | ||
| 529 | (split-string text "\n")) | ||
| 530 | event) | ||
| 531 | ;; Else display the help string just before the next group of | ||
| 532 | ;; variables | ||
| 533 | (momentary-string-display | ||
| 534 | (concat "*****Help*****\n" text "\n**************\n") | ||
| 535 | (save-excursion (forward-line) (beginning-of-line) (point))) | ||
| 536 | ))) | ||
| 537 | |||
| 538 | (defun ada-prj-show-value (widget widget-modified event) | ||
| 539 | (let ((value (plist-get ada-prj-current-values | ||
| 540 | (widget-get widget 'prj-field))) | ||
| 541 | (inhibit-read-only t)) | ||
| 542 | |||
| 543 | ;; If the other widget is already visible, delete it | ||
| 544 | (if (widget-get widget 'prj-other-widget) | ||
| 545 | (progn | ||
| 546 | (widget-delete (widget-get widget 'prj-other-widget)) | ||
| 547 | (widget-put widget 'prj-other-widget nil) | ||
| 548 | (widget-default-value-set widget "Show Value") | ||
| 549 | ) | ||
| 550 | |||
| 551 | ;; Else create it | ||
| 552 | (save-excursion | ||
| 553 | (mouse-set-point event) | ||
| 554 | (forward-line 1) | ||
| 555 | (beginning-of-line) | ||
| 556 | (widget-put widget 'prj-other-widget | ||
| 557 | (widget-create 'editable-list | ||
| 558 | :entry-format "%i%d %v" | ||
| 559 | :notify 'ada-prj-field-modified | ||
| 560 | :help-echo (widget-get widget 'prj-help) | ||
| 561 | :value value | ||
| 562 | (list 'editable-field | ||
| 563 | :keymap widget-keymap))) | ||
| 564 | (widget-default-value-set widget "Hide Value") | ||
| 565 | ) | ||
| 566 | ) | ||
| 567 | (widget-setup) | ||
| 568 | )) | ||
| 569 | |||
| 570 | (defun ada-prj-field (field text help-text &optional is-list is-paths after-text) | ||
| 571 | "Create a widget to edit FIELD in the current buffer. | ||
| 572 | TEXT is a short explanation of what the field means, whereas HELP-TEXT | ||
| 573 | is the text displayed when the user pressed the help button. | ||
| 574 | If IS-LIST is non-nil, the field contains a list. Otherwise, it contains | ||
| 575 | a single string. | ||
| 576 | if IS-PATHS is true, some special buttons are added to load paths,... | ||
| 577 | AFTER-TEXT is inserted just after the widget." | ||
| 578 | (let ((value (plist-get ada-prj-current-values field)) | ||
| 579 | (inhibit-read-only t) | ||
| 580 | widget) | ||
| 581 | (unless value | ||
| 582 | (set 'value | ||
| 583 | (if is-list '() ""))) | ||
| 584 | (widget-insert text) | ||
| 585 | (widget-insert ":") | ||
| 586 | (move-to-column 54 t) | ||
| 587 | (widget-put (widget-create 'push-button | ||
| 588 | :notify 'ada-prj-display-help | ||
| 589 | "Help") | ||
| 590 | 'prj-help | ||
| 591 | help-text) | ||
| 592 | (widget-insert (concat " (" (symbol-name field) ")\n")) | ||
| 593 | (if is-paths | ||
| 594 | (progn | ||
| 595 | (widget-create 'push-button | ||
| 596 | :notify | ||
| 597 | (list 'lambda '(&rest dummy) '(interactive) | ||
| 598 | (list 'ada-prj-load-from-file | ||
| 599 | (list 'quote field))) | ||
| 600 | "Load From File") | ||
| 601 | (widget-insert " ") | ||
| 602 | (widget-create 'push-button | ||
| 603 | :notify | ||
| 604 | (list 'lambda '(&rest dummy) '(interactive) | ||
| 605 | (list 'ada-prj-load-directory | ||
| 606 | (list 'quote field))) | ||
| 607 | "Load Recursive Directory") | ||
| 608 | (widget-insert "\n ${build_dir}\n"))) | ||
| 609 | (set 'widget | ||
| 610 | (if is-list | ||
| 611 | (if (< (length value) 15) | ||
| 612 | (widget-create 'editable-list | ||
| 613 | :entry-format "%i%d %v" | ||
| 614 | :notify 'ada-prj-field-modified | ||
| 615 | :help-echo help-text | ||
| 616 | :value value | ||
| 617 | (list 'editable-field :keymap widget-keymap)) | ||
| 618 | (let ((w (widget-create 'push-button | ||
| 619 | :notify 'ada-prj-show-value | ||
| 620 | "Show value"))) | ||
| 621 | (widget-insert "\n") | ||
| 622 | (widget-put w 'prj-field field) | ||
| 623 | (widget-put w 'prj-help help-text) | ||
| 624 | (widget-put w 'prj-other-widget nil) | ||
| 625 | w) | ||
| 626 | ) | ||
| 627 | (widget-create 'editable-field | ||
| 628 | :format "%v" | ||
| 629 | :notify 'ada-prj-field-modified | ||
| 630 | :help-echo help-text | ||
| 631 | :keymap widget-keymap | ||
| 632 | value))) | ||
| 633 | (widget-put widget 'prj-field field) | ||
| 634 | (if after-text | ||
| 635 | (widget-insert after-text)) | ||
| 636 | (widget-insert "\n") | ||
| 637 | )) | ||
| 452 | 638 | ||
| 453 | ;; Initializations for the package | ||
| 454 | (add-hook 'ada-mode-hook 'ada-prj-add-ada-menu) | ||
| 455 | 639 | ||
| 456 | ;; Set the keymap once and for all, so that the keys set by the user in his | 640 | ;; Set the keymap once and for all, so that the keys set by the user in his |
| 457 | ;; config file are not overwritten every time we open a new file. | 641 | ;; config file are not overwritten every time we open a new file. |
| 458 | (ada-prj-add-keymap) | 642 | (ada-prj-add-keymap) |
| 643 | (ada-prj-add-ada-menu) | ||
| 459 | 644 | ||
| 460 | (provide 'ada-prj) | 645 | (provide 'ada-prj) |
| 461 | ;;; package ada-prj.el ends here | 646 | ;;; package ada-prj.el ends here |
| 462 | |||
| 463 | |||
| 464 | |||