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