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