lisp/progmodes/ada-prj.el

   1 ;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode
   2
   3 ;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: Emmanuel Briot <briot@gnat.com>
   6 ;; Ada Core Technologies's version:   $Revision: 1.30 $
   7 ;; Keywords: languages, ada, project file
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; This program 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 ;; This program 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
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26 ;;; This package provides a set of functions to easily edit the project
  27 ;;; files used by the ada-mode.
  28 ;;; The only function publicly available here is `ada-prj-customize'.
  29 ;;; Please ada-mode.el and its documentation for more information about the
  30 ;;; project files.
  31 ;;;
  32 ;;; You need Emacs >= 20.2 to run this package
  33
  34 ;; Code:
  35
  36
  37 ;; ----- Requirements -----------------------------------------------------
  38
  39 (require 'cus-edit)
  40
  41
  42 ;; ----- Buffer local variables -------------------------------------------
  43 ;; if non nil, then all the widgets will have the default values, instead
  44 ;; of reading them from the project file
  45 (make-variable-buffer-local (defvar ada-prj-edit-use-default-values nil))
  46
  47 ;; List of the default values used for the field in the project file
  48 ;; Mainly used to save only the modified fields into the file itself
  49 ;; The values are hold in the properties of this variable
  50 (make-variable-buffer-local (defvar ada-prj-default nil))
  51
  52 (make-variable-buffer-local (defvar ada-prj-widget-prj-dir nil))
  53 (make-variable-buffer-local (defvar ada-prj-widget-src-dir nil))
  54 (make-variable-buffer-local (defvar ada-prj-widget-obj-dir nil))
  55 (make-variable-buffer-local (defvar ada-prj-widget-main nil))
  56 (make-variable-buffer-local (defvar ada-prj-widget-comp-opt nil))
  57 (make-variable-buffer-local (defvar ada-prj-widget-bind-opt nil))
  58 (make-variable-buffer-local (defvar ada-prj-widget-link-opt nil))
  59 (make-variable-buffer-local (defvar ada-prj-widget-remote-machine nil))
  60 (make-variable-buffer-local (defvar ada-prj-widget-comp-cmd nil))
  61 (make-variable-buffer-local (defvar ada-prj-widget-make-cmd nil))
  62 (make-variable-buffer-local (defvar ada-prj-widget-run-cmd nil))
  63 (make-variable-buffer-local (defvar ada-prj-widget-debug-cmd nil))
  64 (make-variable-buffer-local (defvar ada-prj-widget-cross-prefix nil))
  65
  66 ;; ------ Functions -------------------------------------------------------
  67
  68 (defun ada-prj-add-ada-menu ()
  69   "Add a new submenu to the Ada menu."
  70   (interactive)
  71
  72   (if ada-xemacs
  73       (progn
  74         (add-menu-button '("Ada" "Project") ["New/Edit" ada-customize t] "Associate")
  75         )
  76     (let ((prj-menu (lookup-key ada-mode-map [menu-bar Ada Project])))
  77       (define-key prj-menu [New] '("New/Edit" . ada-customize)))
  78     ))
  79
  80 (defun ada-prj-add-keymap ()
  81   "Add new keybindings for ada-prj."
  82   (define-key ada-mode-map "\C-cu"  'ada-customize))
  83
  84 (defun ada-customize (&optional new-file)
  85   "Edit the project file associated with the current buffer.
  86 If there is none or NEW-FILE is non-nil, make a new one."
  87   (interactive)
  88   (if new-file
  89       (progn
  90         (setq ada-prj-edit-use-default-values t)
  91         (kill-local-variable 'ada-prj-prj-file)
  92         (ada-prj-customize)
  93         (setq ada-prj-edit-use-default-values nil))
  94     (ada-prj-customize)))
  95
  96 (defun ada-prj-save ()
  97   "Save the currently edited project file."
  98   (interactive)
  99   (let ((file-name (widget-value ada-prj-widget-prj-dir))
 100         value output)
 101     (setq output
 102           (concat
 103            (ada-prj-set-list "src_dir" (widget-value ada-prj-widget-src-dir))
 104            "\n"
 105            (ada-prj-set-list "obj_dir" (widget-value ada-prj-widget-obj-dir))
 106            "\n"
 107            (unless (string= (setq value (widget-value ada-prj-widget-comp-opt))
 108                             (get 'ada-prj-default 'comp_opt))
 109              (concat "comp_opt=" value "\n"))
 110            (unless (string= (setq value (widget-value ada-prj-widget-bind-opt))
 111                             (get 'ada-prj-default 'bind_opt))
 112              (concat "bind_opt=" value "\n"))
 113            (unless (string= (setq value (widget-value ada-prj-widget-link-opt))
 114                             (get 'ada-prj-default 'link_opt))
 115              (concat "link_opt=" value "\n"))
 116            (unless (string= (setq value (widget-value ada-prj-widget-main))
 117                             (get 'ada-prj-default 'main))
 118              (concat "main=" value "\n"))
 119            (unless (string= (setq value (widget-value ada-prj-widget-cross-prefix))
 120                             (get 'ada-prj-default 'cross-prefix))
 121              (concat "cross_prefix=" value "\n"))
 122            (unless (string= (setq value (widget-value ada-prj-widget-remote-machine))
 123                             (get 'ada-prj-default 'remote-machine))
 124              (concat "remote_machine=" value "\n"))
 125            (unless (string= (setq value (widget-value ada-prj-widget-comp-cmd))
 126                             (get 'ada-prj-default 'comp_cmd))
 127              (concat "comp_cmd=" value "\n"))
 128            (unless (string= (setq value (widget-value ada-prj-widget-make-cmd))
 129                             (get 'ada-prj-default 'make_cmd))
 130              (concat "make_cmd=" value "\n"))
 131            (unless (string= (setq value (widget-value ada-prj-widget-run-cmd))
 132                             (get 'ada-prj-default 'run_cmd))
 133              (concat "run_cmd=" value "\n"))
 134            (unless (string= (setq value (widget-value ada-prj-widget-debug-cmd))
 135                             (get 'ada-prj-default 'debug_cmd))
 136              (concat "debug_cmd=" value "\n"))
 137            ))
 138     (find-file file-name)
 139     (erase-buffer)
 140     (insert output)
 141     (save-buffer)
 142     ;; kill the project buffer
 143     (kill-buffer nil)
 144
 145     ;; kill the editor buffer
 146     (kill-buffer "*Customize Ada Mode*")
 147
 148     ;; automatically associates the current buffer with the
 149     ;; new project file
 150     (make-local-variable 'ada-prj-prj-file)
 151     (setq ada-prj-prj-file file-name)
 152
 153     ;; force emacs to reread the project files
 154     (ada-reread-prj-file t)
 155     )
 156   )
 157
 158 (defun ada-prj-customize ()
 159   "Edit the project file associated with the current Ada buffer."
 160   (let* ((old-name (buffer-file-name))
 161          prj-file)
 162
 163     (unless old-name
 164       (error
 165        "No file name given for this buffer ! You need to open a file first"))
 166
 167     ;;  Find the project file associated with the buffer
 168     (setq prj-file (ada-prj-get-prj-dir old-name))
 169
 170     (switch-to-buffer "*Customize Ada Mode*")
 171     (kill-all-local-variables)
 172
 173     ;;  Find the default values
 174     (setq ada-prj-default nil)
 175     (put 'ada-prj-default 'src_dir (list (file-name-directory old-name)))
 176     (put 'ada-prj-default 'obj_dir (list (file-name-directory old-name)))
 177     (put 'ada-prj-default 'comp_opt "")
 178     (put 'ada-prj-default 'bind_opt "")
 179     (put 'ada-prj-default 'link_opt "")
 180     (put 'ada-prj-default 'main     "")
 181     (put 'ada-prj-default 'cross_prefix "")
 182     (put 'ada-prj-default 'remote_machine "")
 183     (put 'ada-prj-default 'comp_cmd
 184          (concat "cd " (file-name-directory old-name) " && "
 185                  ada-prj-default-comp-cmd))
 186     (put 'ada-prj-default 'make_cmd
 187          (concat "cd " (file-name-directory old-name) " && "
 188                  ada-prj-default-make-cmd))
 189     (put 'ada-prj-default 'run_cmd (if is-windows "${main}.exe" "${main}"))
 190     (put 'ada-prj-default 'debug_cmd
 191          (if is-windows "${cross_prefix}gdb ${main}.exe"
 192            "${cross_prefix}gdb ${main}"))
 193
 194     (let ((inhibit-read-only t))
 195       (erase-buffer))
 196
 197     ;;; Overlay-lists is not defined on XEmacs
 198     (if (fboundp 'overlay-lists)
 199         (let ((all (overlay-lists)))
 200           ;; Delete all the overlays.
 201           (mapcar 'delete-overlay (car all))
 202           (mapcar 'delete-overlay (cdr all))))
 203
 204     (use-local-map (copy-keymap custom-mode-map))
 205     (local-set-key "\C-x\C-s" 'ada-prj-save)
 206
 207     (widget-insert "
 208 ----------------------------------------------------------------
 209 --  Customize your Emacs Ada mode for the current application --
 210 ----------------------------------------------------------------
 211 This buffer will allow you to create easily a project file for your application.
 212 This file will tell Emacs where to find the ada sources, the cross-referencing
 213 informations, how to compile and run your application, ...
 214
 215 Please use the RETURN key, or middle mouse button to activate the fields.\n\n")
 216
 217     ;; Reset Button
 218     (widget-create 'push-button
 219                    :notify (lambda (&rest ignore)
 220                              (setq ada-prj-edit-use-default-values t)
 221                              (kill-buffer nil)
 222                              (ada-prj-customize)
 223                              (setq ada-prj-edit-use-default-values nil)
 224                              )
 225                    "Reset to Default Values")
 226     (widget-insert "\n")
 227
 228
 229     ;;  Create local variables with their initial value
 230     (setq ada-prj-widget-prj-dir
 231           (ada-prj-new 'ada-prj-widget-prj-dir nil "" prj-file
 232                        "\nName and directory of the project file.
 233 Put a new name here if you want to create a new project file\n"))
 234
 235     (setq ada-prj-widget-src-dir
 236           (ada-prj-list 'ada-prj-widget-src-dir prj-file "src_dir"
 237                         (get 'ada-prj-default 'src_dir)
 238                         "\nYou should enter below all the directories where Emacs
 239 will find your ada sources for the current application\n"))
 240
 241     (setq ada-prj-widget-obj-dir
 242           (ada-prj-list 'ada-prj-widget-obj-dir prj-file "obj_dir"
 243                         (get 'ada-prj-default 'obj_dir)
 244                         "\nBelow are the directories where the object files generated
 245 by the compiler will be found. This files are required for the cross-referencing
 246 capabilities of the Emacs' Ada-mode.\n"))
 247
 248     (setq ada-prj-widget-comp-opt
 249           (ada-prj-new 'ada-prj-widget-comp-opt prj-file "comp_opt"
 250                        (get 'ada-prj-default 'comp_opt)
 251                        "\nPut below the compiler switches.\n"))
 252
 253     (setq ada-prj-widget-bind-opt
 254           (ada-prj-new 'ada-prj-widget-bind-opt prj-file "bind_opt"
 255                        (get 'ada-prj-default 'bind_opt)
 256                        "\nPut below the binder switches.\n"))
 257
 258     (setq ada-prj-widget-link-opt
 259           (ada-prj-new 'ada-prj-widget-link-opt prj-file "link_opt"
 260                        (get 'ada-prj-default 'link_opt)
 261                        "\nPut below the linker switches.\n"))
 262
 263     (setq ada-prj-widget-main
 264           (ada-prj-new 'ada-prj-widget-main prj-file "main"
 265                        (file-name-sans-extension old-name)
 266                        "\nPut below the name of the main program for your application\n"))
 267
 268     (setq ada-prj-widget-cross-prefix
 269           (ada-prj-new 'ada-prj-widget-cross-prefix prj-file "cross_prefix"
 270                        (get 'ada-prj-default 'cross_prefix)
 271                        "\nIf you are using a cross compiler, you might want to
 272 set the following variable so that the correct compiler is used by default\n"))
 273
 274     (setq ada-prj-widget-remote-machine
 275           (ada-prj-new 'ada-prj-widget-remote-machine prj-file "remote_machine"
 276                        (get 'ada-prj-default 'remote_machine)
 277                        "\nName of the machine to log on before a compilation.
 278 Leave an empty field if you want to compile on the local machine.
 279 This will not work on Windows NT, since we only do a 'rsh' to the
 280 remote machine and then issue the command. \n"))
 281
 282     (widget-insert "\n
 283 -------------------------------------------------------------------------------
 284       / \\        !! Advanced Users !! : For the following commands, you may use
 285      / | \\       a somewhat more complicated syntax to describe them. If you
 286     /  |  \\      use some special fields,  they will be replaced at run-time by
 287    /   |   \\     the variables defined above.
 288   /    |    \\    These special fields are : ${remote_machine}
 289  /     o     \\   -aI${src_dir} -I${src_dir} -aO${obj_dir} ${comp_opt}
 290  -------------   ${bind_opt}  ${link_opt} ${main} ${cross_prefix}
 291
 292 The easiest way is to ignore this possibility. These fields are intended only
 293 for user who really understand what `variable substitution' means.
 294 -------------------------------------------------------------------------------\n")
 295
 296     (setq ada-prj-widget-comp-cmd
 297           (ada-prj-new 'ada-prj-widget-comp-cmd prj-file "comp_cmd"
 298                        (get 'ada-prj-default 'comp_cmd)
 299                        "\nPut below the command used to compile ONE file.
 300 The name of the file to compile will be added at the end of the command.
 301 This command will also be used to check the file.\n"))
 302
 303     (setq ada-prj-widget-make-cmd
 304           (ada-prj-new 'ada-prj-widget-make-cmd prj-file "make_cmd"
 305                        (get 'ada-prj-default 'make_cmd)
 306                        "\nPut below the command used to compile the whole application.\n"))
 307
 308     (setq ada-prj-widget-run-cmd
 309           (ada-prj-new 'ada-prj-widget-run-cmd prj-file "run_cmd"
 310                        (get 'ada-prj-default 'run_cmd)
 311                        "\nPut below the command used to run your application.\n"))
 312
 313     (setq ada-prj-widget-debug-cmd
 314           (ada-prj-new 'ada-prj-widget-run-cmd prj-file "debug_cmd"
 315                        (get 'ada-prj-default 'debug_cmd)
 316                        "\nPut below the command used to launch the debugger on your application.\n"))
 317
 318     ;; the two buttons to validate or cancel the modification
 319     (widget-insert "\nWhen you have finish completing the above fields, choose one of the two buttons
 320 below, to validate or cancel your modifications.
 321 If you choose `OK', your settings will be saved to the file whose name is given above.\n")
 322
 323     (widget-create 'push-button
 324                    :notify (lambda (&rest ignore) (ada-prj-save))
 325                    "OK")
 326
 327     (widget-insert "   ")
 328     (widget-create 'push-button
 329                    :notify (lambda (&rest ignore)
 330                              (kill-buffer nil))
 331                    "Cancel")
 332     (widget-insert "\n")
 333
 334
 335     ;; if it exists, kill the project file buffer
 336     (if (and prj-file
 337              (get-file-buffer prj-file))
 338         (kill-buffer (get-file-buffer prj-file)))
 339
 340     (widget-setup)
 341     (beginning-of-buffer)
 342     )
 343   )
 344
 345
 346 ;; ---------------- Utilities --------------------------------
 347
 348 (defun ada-prj-new (variable prj-file text default message)
 349   "Create a buffer-local variable with name VARIABLE.
 350 If PRJ-FILE exists, read its value from that file, otherwise set it to
 351 DEFAULT.
 352 It also creates a widget in the current buffer to edit this variable,
 353 which MESSAGE explaning what the variable is supposed to do.
 354 TEXT is put just before the editable field, and should display the name
 355 of the variable."
 356
 357   ;; create local variable
 358   (make-local-variable variable)
 359   (let ((value  default)
 360         (regexp (concat "^" text "=\\(.*\\)")))
 361     ;; if the project file exists
 362     (if (and prj-file (not ada-prj-edit-use-default-values)
 363              (file-readable-p prj-file))
 364         ;; find the value
 365         (save-excursion
 366           (find-file prj-file)
 367           (beginning-of-buffer)
 368           (if (re-search-forward regexp nil t)
 369               (setq value (match-string 1)))
 370           ))
 371     ;; assign a new value to the variable
 372     (setq variable value))
 373
 374   (widget-insert message)
 375
 376   (widget-create 'editable-field
 377                  :format (if (string= text "")  "%v"
 378                            (concat text "= %v"))
 379                  :keymap widget-keymap
 380                  variable))
 381
 382
 383 (defun ada-prj-list (variable prj-file text default message)
 384   "Create a buffer-local list variable with name VARIABLE.
 385 If PRJ-FILE exists, read its value from that file, otherwise set it to
 386 DEFAULT.
 387 It also creates a widget in the current buffer to edit this variable,
 388 which MESSAGE explaning what the variable is supposed to do.
 389 TEXT is put just before the editable field, and should display the name
 390 of the variable."
 391
 392   ;; create local variable
 393   (make-local-variable variable)
 394   (let ((value nil)
 395         (regexp  (concat "^" text "=\\(.*\\)")))
 396     ;; if the project file exists
 397     (if (and prj-file (not ada-prj-edit-use-default-values)
 398              (file-readable-p prj-file))
 399         ;; find the value
 400         (save-excursion
 401           (find-file prj-file)
 402           (goto-char (point-min))
 403           ;; for each line, add its value
 404           (while
 405               (re-search-forward regexp nil t)
 406             (progn
 407               (setq value (cons (match-string 1) value)))
 408             )))
 409
 410     ;; assign a new value to the variable
 411     (setq variable
 412           (if value (reverse value) default)))
 413
 414   (widget-insert message)
 415   (widget-create 'editable-list
 416                  :entry-format (concat text "=  %i %d %v")
 417                  :value variable
 418                  (list 'editable-field :keymap widget-keymap)))
 419
 420 (defsubst ada-prj-set-list (string ada-dir-list)
 421   "Join the strings in ADA-DIR-LIST into a single string. Each name is put
 422 on a separate line that begins with STRING."
 423   (mapconcat (lambda (x)
 424                (concat string "=" x
 425                        (unless (string= (substring x -1) "/")
 426                          "/")))
 427              ada-dir-list "\n"))
 428
 429 (defun ada-prj-get-prj-dir (&optional ada-file)
 430   "Returns the directory/name of the project file for ADA-FILE.
 431 If ADA-FILE is nil, returns the project file for the current buffer."
 432   (unless ada-file
 433     (setq ada-file (buffer-file-name)))
 434
 435   (save-excursion
 436     (set-buffer (get-file-buffer ada-file))
 437     (if ada-prj-edit-use-default-values
 438         (concat (file-name-sans-extension ada-file)
 439                 ada-project-file-extension)
 440
 441       (let ((prj-file (ada-prj-find-prj-file t)))
 442         (if (or (not prj-file)
 443                 (not (file-exists-p prj-file))
 444                 )
 445             (setq prj-file
 446                   (concat (file-name-sans-extension ada-file)
 447                           ada-project-file-extension)))
 448         prj-file)
 449       ))
 450   )
 451
 452
 453 ;;  Initializations for the package
 454 (add-hook 'ada-mode-hook 'ada-prj-add-ada-menu)
 455
 456 ;;  Set the keymap once and for all, so that the keys set by the user in his
 457 ;;  config file are not overwritten every time we open a new file.
 458 (ada-prj-add-keymap)
 459
 460 (provide 'ada-prj)
 461 ;;; package ada-prj.el ends here
 462
 463
 464