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