lisp/progmodes/ada-prj.el

   1 ;;; ada-prj.el --- GUI editing of project files for the ada-mode
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
   4 ;;   2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Emmanuel Briot <briot@gnat.com>
   7 ;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
   8 ;; Keywords: languages, ada, project file
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;;; This package provides a set of functions to easily edit the project
  28 ;;; files used by the ada-mode.
  29 ;;; The only function publicly available here is `ada-customize'.
  30 ;;; See the documentation of the Ada mode for more information on the project
  31 ;;; files.
  32 ;;; Internally, a project file is represented as a property list, with each
  33 ;;; field of the project file matching one property of the list.
  34
  35
  36 ;;; History:
  37 ;;
  38
  39 ;;; Code:
  40
  41
  42 ;; ----- Requirements -----------------------------------------------------
  43
  44 (require 'cus-edit)
  45 (require 'ada-xref)
  46
  47 (eval-when-compile
  48    (require 'ada-mode))
  49
  50 ;; ----- Buffer local variables -------------------------------------------
  51
  52 (defvar ada-prj-current-values nil
  53   "Hold the current value of the fields, This is a property list.")
  54 (make-variable-buffer-local 'ada-prj-current-values)
  55
  56 (defvar ada-prj-default-values nil
  57   "Hold the default value for the fields, This is a property list.")
  58 (make-variable-buffer-local 'ada-prj-default-values)
  59
  60 (defvar ada-prj-ada-buffer nil
  61   "Indicates what Ada source file was being edited.")
  62
  63 (defvar ada-old-cross-prefix nil
  64   "The cross-prefix associated with the currently loaded runtime library.")
  65
  66
  67 ;; ----- Functions --------------------------------------------------------
  68
  69 (defun ada-prj-new ()
  70   "Open a new project file."
  71   (interactive)
  72   (let* ((prj
  73           (if (and ada-prj-default-project-file
  74                    (not (string= ada-prj-default-project-file "")))
  75               ada-prj-default-project-file
  76             "default.adp"))
  77          (filename (read-file-name "Project file: "
  78                                    (if prj "" nil)
  79                                    nil
  80                                    nil
  81                                    prj)))
  82     (if (not (string= (file-name-extension filename t) ".adp"))
  83         (error "File name extension for project files must be .adp"))
  84
  85     (ada-customize nil filename)))
  86
  87 (defun ada-prj-edit ()
  88   "Editing the project file associated with the current Ada buffer.
  89 If there is none, opens a new project file"
  90   (interactive)
  91   (if ada-prj-default-project-file
  92       (ada-customize)
  93     (ada-prj-new)))
  94
  95 (defun ada-prj-initialize-values (symbol ada-buffer filename)
  96   "Set SYMBOL to the property list of the project file FILENAME.
  97 If FILENAME is null, read the file associated with ADA-BUFFER. If no
  98 project file is found, returns the default values."
  99 ;; FIXME: rationalize arguments; make ada-buffer optional?
 100   (if (and filename
 101            (not (string= filename ""))
 102            (assoc filename ada-xref-project-files))
 103       (set symbol (copy-sequence (cdr (assoc filename ada-xref-project-files))))
 104
 105     ;;  Set default values (except for the file name if this was given
 106     ;;  in the buffer
 107     (ada-xref-set-default-prj-values symbol ada-buffer)
 108     (if (and filename (not (string= filename "")))
 109         (set symbol (plist-put (eval symbol) 'filename filename)))
 110     ))
 111
 112
 113 (defun ada-prj-save-specific-option (field)
 114   "Return the string to print in the project file to save FIELD.
 115 If the current value of FIELD is the default value, returns an empty string."
 116   (if (string= (plist-get ada-prj-current-values field)
 117                (plist-get ada-prj-default-values field))
 118       ""
 119     (concat (symbol-name field)
 120             "=" (plist-get ada-prj-current-values field) "\n")))
 121
 122 (defun ada-prj-save ()
 123   "Save the edited project file."
 124   (interactive)
 125   (let ((file-name (plist-get ada-prj-current-values 'filename))
 126         output)
 127     (set 'output
 128          (concat
 129
 130           ;;  Save the fields that do not depend on the current buffer
 131           ;;  only if they are different from the default value
 132
 133           (ada-prj-save-specific-option 'comp_opt)
 134           (ada-prj-save-specific-option 'bind_opt)
 135           (ada-prj-save-specific-option 'link_opt)
 136           (ada-prj-save-specific-option 'gnatmake_opt)
 137           (ada-prj-save-specific-option 'gnatfind_opt)
 138           (ada-prj-save-specific-option 'cross_prefix)
 139           (ada-prj-save-specific-option 'remote_machine)
 140           (ada-prj-save-specific-option 'debug_cmd)
 141
 142           ;;  Always save the fields that depend on the current buffer
 143           "main="      (plist-get ada-prj-current-values 'main) "\n"
 144           "main_unit=" (plist-get ada-prj-current-values 'main_unit) "\n"
 145           "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n"
 146           (ada-prj-set-list "check_cmd"
 147                             (plist-get ada-prj-current-values 'check_cmd)) "\n"
 148           (ada-prj-set-list "make_cmd"
 149                             (plist-get ada-prj-current-values 'make_cmd)) "\n"
 150           (ada-prj-set-list "comp_cmd"
 151                             (plist-get ada-prj-current-values 'comp_cmd)) "\n"
 152           (ada-prj-set-list "run_cmd"
 153                             (plist-get ada-prj-current-values 'run_cmd)) "\n"
 154           (ada-prj-set-list "src_dir"
 155                             (plist-get ada-prj-current-values 'src_dir)
 156                             t) "\n"
 157           (ada-prj-set-list "obj_dir"
 158                             (plist-get ada-prj-current-values 'obj_dir)
 159                             t) "\n"
 160           (ada-prj-set-list "debug_pre_cmd"
 161                             (plist-get ada-prj-current-values 'debug_pre_cmd))
 162           "\n"
 163           (ada-prj-set-list "debug_post_cmd"
 164                             (plist-get ada-prj-current-values 'debug_post_cmd))
 165           "\n"
 166           ))
 167
 168     (find-file file-name)
 169     (erase-buffer)
 170     (insert output)
 171     (save-buffer)
 172     ;; kill the project buffer
 173     (kill-buffer nil)
 174
 175     ;; kill the editor buffer
 176     (kill-buffer "*Edit Ada Mode Project*")
 177
 178     ;; automatically set the new project file as the active one
 179     (set 'ada-prj-default-project-file file-name)
 180
 181     ;; force Emacs to reread the project files
 182     (ada-reread-prj-file file-name)
 183     )
 184   )
 185
 186 (defun ada-prj-load-from-file (symbol)
 187   "Load SYMBOL value from file. One item per line should be found in the file."
 188   (save-excursion
 189     (let ((file (read-file-name "File name: " nil nil t))
 190           (buffer (current-buffer))
 191           line
 192           list)
 193       (find-file file)
 194       (widen)
 195       (goto-char (point-min))
 196       (while (not (eobp))
 197         (set 'line (buffer-substring-no-properties
 198                     (point) (save-excursion (end-of-line) (point))))
 199         (add-to-list 'list line)
 200         (forward-line 1)
 201         )
 202       (kill-buffer nil)
 203       (set-buffer buffer)
 204       (set 'ada-prj-current-values
 205            (plist-put ada-prj-current-values
 206                       symbol
 207                       (append (plist-get ada-prj-current-values symbol)
 208                               (reverse list))))
 209       )
 210     (ada-prj-display-page 2)
 211   ))
 212
 213 (defun ada-prj-subdirs-of (dir)
 214   "Return a list of all the subdirectories of DIR, recursively."
 215   (let ((subdirs (directory-files dir t "^[^.].*"))
 216         (dirlist (list dir)))
 217     (while subdirs
 218       (if (file-directory-p (car subdirs))
 219           (let ((sub (ada-prj-subdirs-of (car subdirs))))
 220             (if sub
 221                 (set 'dirlist (append sub dirlist)))))
 222       (set 'subdirs (cdr subdirs)))
 223     dirlist))
 224
 225 (defun ada-prj-load-directory (field &optional file-name)
 226   "Append to FIELD in the current project the subdirectories of FILE-NAME.
 227 If FILE-NAME is nil, ask the user for the name."
 228
 229   ;;  Do not use an external dialog for this, since it wouldn't allow
 230   ;;  the user to select a directory
 231   (let ((use-dialog-box nil))
 232     (unless file-name
 233       (set 'file-name (read-file-name "Root directory: " nil nil t))))
 234
 235   (set 'ada-prj-current-values
 236        (plist-put ada-prj-current-values
 237                   field
 238                   (append (plist-get ada-prj-current-values field)
 239                           (reverse (ada-prj-subdirs-of
 240                                     (expand-file-name file-name))))))
 241   (ada-prj-display-page 2))
 242
 243 (defun ada-prj-display-page (tab-num)
 244   "Display page TAB-NUM in the notebook.
 245 The current buffer must be the project editing buffer."
 246
 247   (let ((inhibit-read-only t))
 248     (erase-buffer))
 249
 250   ;;  Widget support in Emacs 21 requires that we clear the buffer first
 251   (if (and (not (featurep 'xemacs)) (>= emacs-major-version 21))
 252       (progn
 253         (setq widget-field-new  nil
 254               widget-field-list nil)
 255         (mapc (lambda (x) (delete-overlay x)) (car (overlay-lists)))
 256         (mapc (lambda (x) (delete-overlay x)) (cdr (overlay-lists)))))
 257
 258   ;;  Display the tabs
 259
 260   (widget-insert "\n               Project configuration.\n
 261   ___________    ____________    ____________    ____________    ____________\n / ")
 262   (widget-create 'push-button :notify
 263                  (lambda (&rest dummy) (ada-prj-display-page 1)) "General")
 264   (widget-insert " \\  /   ")
 265   (widget-create 'push-button :notify
 266                  (lambda (&rest dummy) (ada-prj-display-page 2)) "Paths")
 267   (widget-insert "  \\  / ")
 268   (widget-create 'push-button :notify
 269                  (lambda (&rest dummy) (ada-prj-display-page 3)) "Switches")
 270   (widget-insert " \\  / ")
 271   (widget-create 'push-button :notify
 272                  (lambda (&rest dummy) (ada-prj-display-page 4)) "Ada Menu")
 273   (widget-insert " \\  / ")
 274   (widget-create 'push-button :notify
 275                  (lambda (&rest dummy) (ada-prj-display-page 5)) "Debugger")
 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")
 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     )
 327
 328
 329    ;;
 330    ;;  Second page (Paths)
 331    ;;
 332    ((= tab-num 2)
 333     (if (not (equal (plist-get ada-prj-current-values 'cross_prefix)
 334                     ada-old-cross-prefix))
 335         (progn
 336           (setq ada-old-cross-prefix
 337                 (plist-get ada-prj-current-values 'cross_prefix))
 338           (ada-initialize-runtime-library ada-old-cross-prefix)))
 339
 340
 341     (widget-insert "/_____________\\/              \\/______________\\/______________\\/______________\\\n")
 342     (ada-prj-field 'src_dir  "Source directories"
 343 "Enter the list of directories where your Ada
 344 sources can be found. These directories will be
 345 used for the cross-references and for the default
 346 compilation commands.
 347 Note that src_dir includes both the build directory
 348 and the standard runtime."
 349       t t
 350       (mapconcat (lambda(x)
 351                    (concat "           " x))
 352                  ada-xref-runtime-library-specs-path
 353                  "\n")
 354       )
 355     (widget-insert "\n\n")
 356
 357     (ada-prj-field 'obj_dir  "Object directories"
 358 "Enter the list of directories where the GNAT
 359 library files (ALI files) can be found. These
 360 files are used for cross-references and by the
 361 gnatmake command.
 362 Note that obj_dir includes both the build directory
 363 and the standard runtime."
 364       t t
 365       (mapconcat (lambda(x)
 366                    (concat "           " x))
 367                  ada-xref-runtime-library-ali-path
 368                  "\n")
 369       )
 370     (widget-insert "\n\n")
 371     )
 372
 373    ;;
 374    ;;  Third page (Switches)
 375    ;;
 376    ((= tab-num 3)
 377     (widget-insert "/_____________\\/______________\\/              \\/______________\\/______________\\\n")
 378     (ada-prj-field 'comp_opt "Switches for the compiler"
 379 "These switches are used in the default
 380 compilation commands, both for compiling a
 381 single file and rebuilding the whole project")
 382     (ada-prj-field 'bind_opt "Switches for the binder"
 383 "These switches are used in the default build
 384 command and are passed to the binder")
 385     (ada-prj-field 'link_opt "Switches for the linker"
 386 "These switches are used in the default build
 387 command and are passed to the linker")
 388     (ada-prj-field 'gnatmake_opt "Switches for gnatmake"
 389 "These switches are used in the default gnatmake
 390 command.")
 391     (ada-prj-field 'gnatfind_opt "Switches for gnatfind"
 392 "The command gnatfind is run every time the Ada/Goto/List_References menu.
 393 You should for instance add -a if you are working in an environment
 394 where most ALI files are write-protected, since otherwise they get
 395 ignored by gnatfind and you don't see the references within.")
 396     )
 397
 398    ;;
 399    ;;  Fourth page
 400    ;;
 401    ((= tab-num 4)
 402     (widget-insert "/_____________\\/______________\\/______________\\/              \\/______________\\\n")
 403     (widget-insert
 404 "All the fields below can use variable substitution The syntax is ${name},
 405 where name is the name that appears after the Help buttons in this buffer. As
 406 a special case, ${current} is replaced with the name of the file currently
 407 edited, with directory name but no extension, whereas ${full_current} is
 408 replaced with the name of the current file with directory name and
 409 extension.\n")
 410     (widget-insert
 411 "The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are set to
 412 ${src_dir} and ${obj_dir} before running the compilation commands, so that you
 413 don't need to specify the -aI and -aO switches on the command line\n")
 414     (widget-insert
 415 "You can reference any environment variable using the same ${...} syntax as
 416 above, and put the name of the variable between the quotes.\n\n")
 417     (ada-prj-field 'check_cmd
 418       "Check syntax of a single file (menu Ada->Check File)"
 419 "This command is run to check the syntax and semantics of a file.
 420 The file name is added at the end of this command." t)
 421     (ada-prj-field 'comp_cmd
 422       "Compiling a single file (menu Ada->Compile File)"
 423 "This command is run when the recompilation
 424 of a single file is needed. The file name is
 425 added at the end of this command." t)
 426     (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)"
 427 "This command is run when you want to rebuild
 428 your whole application. It is never issues
 429 automatically and you will need to ask for it.
 430 If remote_machine has been set, this command
 431 will be executed on the remote machine." t)
 432     (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)"
 433 "This command specifies how to run the
 434 application, including any switch you need to
 435 specify. If remote_machine has been set, this
 436 command will be executed on the remote host." t)
 437     )
 438
 439    ;;
 440    ;;  Fifth page
 441    ;;
 442    ((= tab-num 5)
 443     (widget-insert "/_____________\\/______________\\/______________\\/______________\\/              \\\n")
 444     (ada-prj-field 'debug_pre_cmd "Commands to execute before launching the
 445 debugger"
 446 "The following commands are executed one after the other before starting
 447 the debugger. These can be used to set up your environment." t)
 448
 449     (ada-prj-field 'debug_cmd "Debugging the application"
 450 "Specifies how to debug the application, possibly
 451 remotely if remote_machine has been set. We
 452 recommend the following debuggers:
 453   > gdb
 454   > gvd --tty
 455   > ddd --tty -fullname -toolbar")
 456
 457     (ada-prj-field 'debug_post_cmd "Commands to execute in the debugger"
 458 "The following commands are executed one in the debugger once it has been
 459 started. These can be used to initialize the debugger, for instance to
 460 connect to the target when working with cross-environments" t)
 461     )
 462
 463    )
 464
 465
 466   (widget-insert "______________________________________________________________________\n\n       ")
 467   (widget-create 'push-button
 468                  :notify (lambda (&rest ignore)
 469                            (ada-xref-set-default-prj-values
 470                             'ada-prj-current-values ada-prj-ada-buffer)
 471                            (ada-prj-display-page 1))
 472                  "Reset to Default Values")
 473   (widget-insert "         ")
 474   (widget-create 'push-button :notify (lambda (&rest ignore) (kill-buffer nil))
 475                  "Cancel")
 476   (widget-insert "         ")
 477   (widget-create 'push-button :notify (lambda (&rest ignore) (ada-prj-save))
 478                  "Save")
 479   (widget-insert "\n\n")
 480
 481   (widget-setup)
 482   (with-no-warnings
 483     (beginning-of-buffer))
 484   )
 485
 486
 487 (defun ada-customize (&optional new-file filename)
 488   "Edit the project file associated with the current buffer.
 489 If there is none or NEW-FILE is non-nil, make a new one.
 490 If FILENAME is given, edit that file."
 491   (interactive)
 492
 493   (let ((ada-buffer (current-buffer))
 494         (inhibit-read-only t))
 495
 496     ;;  We can only edit interactively the standard ada-mode project files. If
 497     ;;  the user is using other formats for the project file (through hooks in
 498     ;;  `ada-load-project-hook', we simply edit the file
 499
 500     (if (and (not new-file)
 501              (or ada-prj-default-project-file filename)
 502              (string= (file-name-extension
 503                        (or filename ada-prj-default-project-file))
 504                       "gpr"))
 505         (progn
 506           (find-file ada-prj-default-project-file)
 507           (add-hook 'after-save-hook 'ada-reread-prj-file t t)
 508           )
 509
 510       (if filename
 511           (ada-reread-prj-file filename)
 512         (if (not (string= ada-prj-default-project-file ""))
 513             (ada-reread-prj-file ada-prj-default-project-file)
 514           (ada-reread-prj-file)))
 515
 516       ;;  Else start the interactive editor
 517       (switch-to-buffer "*Edit Ada Mode Project*")
 518
 519       (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer)
 520       (ada-prj-initialize-values 'ada-prj-current-values
 521                                  ada-buffer
 522                                  ada-prj-default-project-file)
 523
 524       (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
 525
 526       (use-local-map (copy-keymap custom-mode-map))
 527       (local-set-key "\C-x\C-s" 'ada-prj-save)
 528
 529       (make-local-variable 'widget-keymap)
 530       (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)
 531
 532       (set (make-local-variable 'ada-old-cross-prefix)
 533            (ada-xref-get-project-field 'cross-prefix))
 534
 535       (ada-prj-display-page 1)
 536       )))
 537
 538 ;; ---------------- Utilities --------------------------------
 539
 540 (defun ada-prj-set-list (string ada-list &optional is-directory)
 541   "Prepend STRING to strings in ADA-LIST, return new-line separated string.
 542 If IS-DIRECTORY is non-nil, each element of ADA-LIST is explicitly
 543 converted to a directory name."
 544
 545   (mapconcat (lambda (x) (concat string "="
 546                                  (if is-directory
 547                                      (file-name-as-directory x)
 548                                    x)))
 549              ada-list "\n"))
 550
 551
 552 (defun ada-prj-field-modified (widget &rest dummy)
 553   "Callback for modification of WIDGET.
 554 Remaining args DUMMY are ignored.
 555 Save the change in `ada-prj-current-values' so that selecting
 556 another page and coming back keeps the new value."
 557   (set 'ada-prj-current-values
 558        (plist-put ada-prj-current-values
 559                   (widget-get widget ':prj-field)
 560                   (widget-value widget))))
 561
 562 (defun ada-prj-display-help (widget widget-modified event)
 563   "Callback for help button in WIDGET.
 564 Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
 565   (let ((text (widget-get widget 'prj-help)))
 566     (if event
 567         ;;  If we have a mouse-event, popup a menu
 568         (widget-choose "Help"
 569                        (mapcar (lambda (a) (cons a t))
 570                                (split-string text "\n"))
 571                        event)
 572       ;;  Else display the help string just before the next group of
 573       ;;  variables
 574       (momentary-string-display
 575        (concat "*****Help*****\n" text "\n**************\n")
 576        (save-excursion (forward-line) (beginning-of-line) (point)))
 577       )))
 578
 579 (defun ada-prj-show-value (widget widget-modified event)
 580   "Show the current field value in WIDGET.
 581 Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
 582   (let* ((field (widget-get widget ':prj-field))
 583          (value (plist-get ada-prj-current-values field))
 584          (inhibit-read-only t)
 585          w)
 586
 587     ;;  If the other widget is already visible, delete it
 588     (if (widget-get widget 'prj-other-widget)
 589         (progn
 590           (widget-delete (widget-get widget 'prj-other-widget))
 591           (widget-put widget 'prj-other-widget nil)
 592           (widget-put widget ':prj-field field)
 593           (widget-default-value-set widget "Show Value")
 594           )
 595
 596       ;;  Else create it
 597       (save-excursion
 598         (mouse-set-point event)
 599         (forward-line 1)
 600         (beginning-of-line)
 601         (setq w (widget-create 'editable-list
 602                                :entry-format "%i%d %v"
 603                                :notify 'ada-prj-field-modified
 604                                :help-echo (widget-get widget 'prj-help)
 605                                :value value
 606                                (list 'editable-field :keymap widget-keymap)))
 607         (widget-put widget 'prj-other-widget w)
 608         (widget-put w ':prj-field field)
 609         (widget-put widget ':prj-field field)
 610         (widget-default-value-set widget "Hide Value")
 611         )
 612       )
 613     (widget-setup)
 614     ))
 615
 616 (defun ada-prj-field (field text help-text &optional is-list is-paths after-text)
 617   "Create a widget to edit FIELD in the current buffer.
 618 TEXT is a short explanation of what the field means, whereas HELP-TEXT
 619 is the text displayed when the user pressed the help button.
 620 If IS-LIST is non-nil, the field contains a list. Otherwise, it contains
 621 a single string.
 622 if IS-PATHS is true, some special buttons are added to load paths,...
 623 AFTER-TEXT is inserted just after the widget."
 624   (let ((value (plist-get ada-prj-current-values field))
 625         (inhibit-read-only t)
 626         widget)
 627     (unless value
 628       (set 'value
 629            (if is-list  '() "")))
 630     (widget-insert text)
 631     (widget-insert ":")
 632     (move-to-column 54 t)
 633     (widget-put (widget-create 'push-button
 634                                :notify 'ada-prj-display-help
 635                                "Help")
 636                 'prj-help
 637                 help-text)
 638     (widget-insert (concat "  (" (symbol-name field) ")\n"))
 639     (if is-paths
 640         (progn
 641           (widget-create 'push-button
 642                          :notify
 643                          (list 'lambda '(&rest dummy) '(interactive)
 644                                (list 'ada-prj-load-from-file
 645                                      (list 'quote field)))
 646                          "Load From File")
 647           (widget-insert "      ")
 648           (widget-create 'push-button
 649                          :notify
 650                          (list 'lambda '(&rest dummy) '(interactive)
 651                                (list 'ada-prj-load-directory
 652                                      (list 'quote field)))
 653                          "Load Recursive Directory")
 654           (widget-insert "\n           ${build_dir}\n")))
 655
 656     (set 'widget
 657          (if is-list
 658              (if (< (length value) 15)
 659                  (widget-create 'editable-list
 660                                 :entry-format "%i%d %v"
 661                                 :notify 'ada-prj-field-modified
 662                                 :help-echo help-text
 663                                 :value value
 664                                 (list 'editable-field :keymap widget-keymap))
 665
 666                (let ((w (widget-create 'push-button
 667                                        :notify 'ada-prj-show-value
 668                                        "Show value")))
 669                  (widget-insert "\n")
 670                  (widget-put w 'prj-help  help-text)
 671                  (widget-put w 'prj-other-widget nil)
 672                  w)
 673                )
 674            (widget-create 'editable-field
 675                           :format "%v"
 676                           :notify 'ada-prj-field-modified
 677                           :help-echo help-text
 678                           :keymap widget-keymap
 679                           value)))
 680     (widget-put widget ':prj-field field)
 681     (if after-text
 682         (widget-insert after-text))
 683     (widget-insert "\n")
 684     ))
 685
 686
 687 (provide 'ada-prj)
 688
 689 ;; arch-tag: 65978c77-816e-49c6-896e-6905605d1b4c
 690 ;;; ada-prj.el ends here