code.delx.au - gnu-emacs/blob - lisp/progmodes/ada-prj.el

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