Mercurial > emacs
changeset 25901:9f327fa7ac10
New file.
Easy editing of project files for the ada-mode
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Thu, 07 Oct 1999 14:31:47 +0000 |
parents | f14be0689a02 |
children | 92828b88cfcc |
files | lisp/progmodes/ada-prj.el |
diffstat | 1 files changed, 459 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/progmodes/ada-prj.el Thu Oct 07 14:31:47 1999 +0000 @@ -0,0 +1,459 @@ +;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode + +;; Copyright (C) 1998, 1999 Ada Core Technologies, Inc + +;; Author: Emmanuel Briot <briot@gnat.com> +;; Ada Core Technologies's version: $Revision: 1.30 $ +;; Keywords: languages, ada, project file + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: +;;; This package provides a set of functions to easily edit the project +;;; files used by the ada-mode. +;;; The only function publicly available here is `ada-prj-customize'. +;;; Please ada-mode.el and its documentation for more information about the +;;; project files. +;;; +;;; You need Emacs >= 20.2 to run this package + +;; Code: + + +;; ----- Requirements ----------------------------------------------------- + +(require 'cus-edit) + + +;; ----- Buffer local variables ------------------------------------------- +;; if non nil, then all the widgets will have the default values, instead +;; of reading them from the project file +(make-variable-buffer-local (defvar ada-prj-edit-use-default-values nil)) + +;; List of the default values used for the field in the project file +;; Mainly used to save only the modified fields into the file itself +;; The values are hold in the properties of this variable +(make-variable-buffer-local (defvar ada-prj-default nil)) + +(make-variable-buffer-local (defvar ada-prj-widget-prj-dir nil)) +(make-variable-buffer-local (defvar ada-prj-widget-src-dir nil)) +(make-variable-buffer-local (defvar ada-prj-widget-obj-dir nil)) +(make-variable-buffer-local (defvar ada-prj-widget-main nil)) +(make-variable-buffer-local (defvar ada-prj-widget-comp-opt nil)) +(make-variable-buffer-local (defvar ada-prj-widget-bind-opt nil)) +(make-variable-buffer-local (defvar ada-prj-widget-link-opt nil)) +(make-variable-buffer-local (defvar ada-prj-widget-remote-machine nil)) +(make-variable-buffer-local (defvar ada-prj-widget-comp-cmd nil)) +(make-variable-buffer-local (defvar ada-prj-widget-make-cmd nil)) +(make-variable-buffer-local (defvar ada-prj-widget-run-cmd nil)) +(make-variable-buffer-local (defvar ada-prj-widget-debug-cmd nil)) +(make-variable-buffer-local (defvar ada-prj-widget-cross-prefix nil)) + +;; ------ Functions ------------------------------------------------------- + +(defun ada-prj-add-ada-menu () + "Add a new submenu to the Ada menu" + (interactive) + + (if ada-xemacs + (progn + (add-menu-button '("Ada" "Project") ["New/Edit" ada-customize t] "Associate") + ) + (let ((prj-menu (lookup-key ada-mode-map [menu-bar Ada Project]))) + (define-key prj-menu [New] '("New/Edit" . ada-customize))) + )) + +(defun ada-prj-add-keymap () + "Add new keybindings for ada-prj" + (define-key ada-mode-map "\C-cu" 'ada-customize)) + +(defun ada-customize (&optional new-file) + "Edit the project file associated with the current buffer, or +a new one if none is found" + (interactive) + (if new-file + (progn + (setq ada-prj-edit-use-default-values t) + (kill-local-variable 'ada-prj-prj-file) + (ada-prj-customize) + (setq ada-prj-edit-use-default-values nil)) + (ada-prj-customize))) + +(defun ada-prj-save () + "save the edited project file" + (interactive) + (let ((file-name (widget-value ada-prj-widget-prj-dir)) + value output) + (setq output + (concat + (ada-prj-set-list "src_dir" (widget-value ada-prj-widget-src-dir)) + "\n" + (ada-prj-set-list "obj_dir" (widget-value ada-prj-widget-obj-dir)) + "\n" + (unless (string= (setq value (widget-value ada-prj-widget-comp-opt)) + (get 'ada-prj-default 'comp_opt)) + (concat "comp_opt=" value "\n")) + (unless (string= (setq value (widget-value ada-prj-widget-bind-opt)) + (get 'ada-prj-default 'bind_opt)) + (concat "bind_opt=" value "\n")) + (unless (string= (setq value (widget-value ada-prj-widget-link-opt)) + (get 'ada-prj-default 'link_opt)) + (concat "link_opt=" value "\n")) + (unless (string= (setq value (widget-value ada-prj-widget-main)) + (get 'ada-prj-default 'main)) + (concat "main=" value "\n")) + (unless (string= (setq value (widget-value ada-prj-widget-cross-prefix)) + (get 'ada-prj-default 'cross-prefix)) + (concat "cross_prefix=" value "\n")) + (unless (string= (setq value (widget-value ada-prj-widget-remote-machine)) + (get 'ada-prj-default 'remote-machine)) + (concat "remote_machine=" value "\n")) + (unless (string= (setq value (widget-value ada-prj-widget-comp-cmd)) + (get 'ada-prj-default 'comp_cmd)) + (concat "comp_cmd=" value "\n")) + (unless (string= (setq value (widget-value ada-prj-widget-make-cmd)) + (get 'ada-prj-default 'make_cmd)) + (concat "make_cmd=" value "\n")) + (unless (string= (setq value (widget-value ada-prj-widget-run-cmd)) + (get 'ada-prj-default 'run_cmd)) + (concat "run_cmd=" value "\n")) + (unless (string= (setq value (widget-value ada-prj-widget-debug-cmd)) + (get 'ada-prj-default 'debug_cmd)) + (concat "debug_cmd=" value "\n")) + )) + (find-file file-name) + (erase-buffer) + (insert output) + (save-buffer) + ;; kill the project buffer + (kill-buffer nil) + + ;; kill the editor buffer + (kill-buffer "*Customize Ada Mode*") + + ;; automatically associates the current buffer with the + ;; new project file + (make-local-variable 'ada-prj-prj-file) + (setq ada-prj-prj-file file-name) + + ;; force emacs to reread the project files + (ada-reread-prj-file t) + ) + ) + +(defun ada-prj-customize () + "Edit the project file whose name is given by prj-file." + (let* ((old-name (buffer-file-name)) + prj-file) + + (unless old-name + (error + "No file name given for this buffer ! You need to open a file first")) + + ;; Find the project file associated with the buffer + (setq prj-file (ada-prj-get-prj-dir old-name)) + + (switch-to-buffer "*Customize Ada Mode*") + (kill-all-local-variables) + + ;; Find the default values + (setq ada-prj-default nil) + (put 'ada-prj-default 'src_dir (list (file-name-directory old-name))) + (put 'ada-prj-default 'obj_dir (list (file-name-directory old-name))) + (put 'ada-prj-default 'comp_opt "") + (put 'ada-prj-default 'bind_opt "") + (put 'ada-prj-default 'link_opt "") + (put 'ada-prj-default 'main "") + (put 'ada-prj-default 'cross_prefix "") + (put 'ada-prj-default 'remote_machine "") + (put 'ada-prj-default 'comp_cmd + (concat "cd " (file-name-directory old-name) " && " + ada-prj-default-comp-cmd)) + (put 'ada-prj-default 'make_cmd + (concat "cd " (file-name-directory old-name) " && " + ada-prj-default-make-cmd)) + (put 'ada-prj-default 'run_cmd (if is-windows "${main}.exe" "${main}")) + (put 'ada-prj-default 'debug_cmd + (if is-windows "${cross_prefix}gdb ${main}.exe" + "${cross_prefix}gdb ${main}")) + + (let ((inhibit-read-only t)) + (erase-buffer)) + + ;;; Overlay-lists is not defined on XEmacs + (if (fboundp 'overlay-lists) + (let ((all (overlay-lists))) + ;; Delete all the overlays. + (mapcar 'delete-overlay (car all)) + (mapcar 'delete-overlay (cdr all)))) + + (use-local-map widget-keymap) + (local-set-key "\C-x\C-s" 'ada-prj-save) + + (widget-insert " +---------------------------------------------------------------- +-- Customize your emacs ada mode for the current application -- +---------------------------------------------------------------- +This buffer will allow you to create easily a project file for your application. +This file will tell emacs where to find the ada sources, the cross-referencing +informations, how to compile and run your application, ... + +Please use the RETURN key, or middle mouse button to activate the fields.\n\n") + + ;; Reset Button + (widget-create 'push-button + :notify (lambda (&rest ignore) + (setq ada-prj-edit-use-default-values t) + (kill-buffer nil) + (ada-prj-customize) + (setq ada-prj-edit-use-default-values nil) + ) + "Reset to Default Values") + (widget-insert "\n") + + + ;; Create local variables with their initial value + (setq ada-prj-widget-prj-dir + (ada-prj-new 'ada-prj-widget-prj-dir nil "" prj-file + "\nName and directory of the project file. +Put a new name here if you want to create a new project file\n")) + + (setq ada-prj-widget-src-dir + (ada-prj-list 'ada-prj-widget-src-dir prj-file "src_dir" + (get 'ada-prj-default 'src_dir) + "\nYou should enter below all the directories where emacs +will find your ada sources for the current application\n")) + + (setq ada-prj-widget-obj-dir + (ada-prj-list 'ada-prj-widget-obj-dir prj-file "obj_dir" + (get 'ada-prj-default 'obj_dir) + "\nBelow are the directories where the object files generated +by the compiler will be found. This files are required for the cross-referencing +capabilities of the emacs ada-mode.\n")) + + (setq ada-prj-widget-comp-opt + (ada-prj-new 'ada-prj-widget-comp-opt prj-file "comp_opt" + (get 'ada-prj-default 'comp_opt) + "\nPut below the compiler switches.\n")) + + (setq ada-prj-widget-bind-opt + (ada-prj-new 'ada-prj-widget-bind-opt prj-file "bind_opt" + (get 'ada-prj-default 'bind_opt) + "\nPut below the binder switches.\n")) + + (setq ada-prj-widget-link-opt + (ada-prj-new 'ada-prj-widget-link-opt prj-file "link_opt" + (get 'ada-prj-default 'link_opt) + "\nPut below the linker switches.\n")) + + (setq ada-prj-widget-main + (ada-prj-new 'ada-prj-widget-main prj-file "main" + (file-name-sans-extension old-name) + "\nPut below the name of the main program for your application\n")) + + (setq ada-prj-widget-cross-prefix + (ada-prj-new 'ada-prj-widget-cross-prefix prj-file "cross_prefix" + (get 'ada-prj-default 'cross_prefix) + "\nIf you are using a cross compiler, you might want to +set the following variable so that the correct compiler is used by default\n")) + + (setq ada-prj-widget-remote-machine + (ada-prj-new 'ada-prj-widget-remote-machine prj-file "remote_machine" + (get 'ada-prj-default 'remote_machine) + "\nName of the machine to log on before a compilation. +Leave an empty field if you want to compile on the local machine. +This will not work on Windows NT, since we only do a 'rsh' to the +remote machine and then issue the command. \n")) + + (widget-insert "\n +------------------------------------------------------------------------------- + / \\ !! Advanced Users !! : For the following commands, you may use + / | \\ a somewhat more complicated syntax to describe them. If you + / | \\ use some special fields, they will be replaced at run-time by + / | \\ the variables defined above. + / | \\ These special fields are : ${remote_machine} + / o \\ -aI${src_dir} -I${src_dir} -aO${obj_dir} ${comp_opt} + ------------- ${bind_opt} ${link_opt} ${main} ${cross_prefix} + +The easiest way is to ignore this possibility. These fields are intended only +for user who really understand what `variable substitution' means. +-------------------------------------------------------------------------------\n") + + (setq ada-prj-widget-comp-cmd + (ada-prj-new 'ada-prj-widget-comp-cmd prj-file "comp_cmd" + (get 'ada-prj-default 'comp_cmd) + "\nPut below the command used to compile ONE file. +The name of the file to compile will be added at the end of the command. +This command will also be used to check the file.\n")) + + (setq ada-prj-widget-make-cmd + (ada-prj-new 'ada-prj-widget-make-cmd prj-file "make_cmd" + (get 'ada-prj-default 'make_cmd) + "\nPut below the command used to compile the whole application.\n")) + + (setq ada-prj-widget-run-cmd + (ada-prj-new 'ada-prj-widget-run-cmd prj-file "run_cmd" + (get 'ada-prj-default 'run_cmd) + "\nPut below the command used to run your application.\n")) + + (setq ada-prj-widget-debug-cmd + (ada-prj-new 'ada-prj-widget-run-cmd prj-file "debug_cmd" + (get 'ada-prj-default 'debug_cmd) + "\nPut below the command used to launch the debugger on your application.\n")) + + ;; the two buttons to validate or cancel the modification + (widget-insert "\nWhen you have finish completing the above fields, choose one of the two buttons +below, to validate or cancel your modifications. +If you choose `OK', your settings will be saved to the file whose name is given above.\n") + + (widget-create 'push-button + :notify (lambda (&rest ignore) (ada-prj-save)) + "OK") + + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (kill-buffer nil)) + "Cancel") + (widget-insert "\n") + + + ;; if it exists, kill the project file buffer + (if (and prj-file + (get-file-buffer prj-file)) + (kill-buffer (get-file-buffer prj-file))) + + (widget-setup) + (beginning-of-buffer) + ) + ) + + +;; ---------------- Utilities -------------------------------- + +(defun ada-prj-new (variable prj-file text default message) + "Create a buffer-local text variable, whose value is either read in +the prj-file or default +Then adds a text field (with MESSAGE), and returns the created widget" + + ;; create local variable + (make-local-variable variable) + (let ((value default) + (regexp (concat "^" text "=\\(.*\\)"))) + ;; if the project file exists + (if (and prj-file (not ada-prj-edit-use-default-values) + (file-readable-p prj-file)) + ;; find the value + (save-excursion + (find-file prj-file) + (beginning-of-buffer) + (if (re-search-forward regexp nil t) + (setq value (match-string 1))) + )) + ;; assign a new value to the variable + (setq variable value)) + + (widget-insert message) + + (widget-create 'editable-field + :format (if (string= text "") "%v" + (concat text "= %v")) + :keymap widget-keymap + variable)) + + +(defun ada-prj-list (variable prj-file text default message) + "Create a buffer-local list variable, whose value is either read in +the prj-file or default +Then adds a list widget (with MESSAGE), and returns the created widget" + + ;; create local variable + (make-local-variable variable) + (let ((value nil) + (regexp (concat "^" text "=\\(.*\\)"))) + ;; if the project file exists + (if (and prj-file (not ada-prj-edit-use-default-values) + (file-readable-p prj-file)) + ;; find the value + (save-excursion + (find-file prj-file) + (goto-char (point-min)) + ;; for each line, add its value + (while + (re-search-forward regexp nil t) + (progn + (setq value (cons (match-string 1) value))) + ))) + + ;; assign a new value to the variable + (setq variable + (if value (reverse value) default))) + + (widget-insert message) + (widget-create 'editable-list + :entry-format (concat text "= %i %d %v") + :value variable + (list 'editable-field :keymap widget-keymap))) + +(defun ada-prj-set-list (string ada-dir-list) + "Creates a single string of blank-separated directory names" + (mapconcat (lambda (x) + (concat string "=" + x + (unless (string= + (substring x -1) + "/") + "/"))) + ada-dir-list "\n")) + +(defun ada-prj-get-prj-dir (&optional ada-file) + "returns a string which is the directory/name of the prj file. +If no-standard-prj is t, do not use the default algorithm, just +use a default name" + (unless ada-file + (setq ada-file (buffer-file-name))) + + (save-excursion + (set-buffer (get-file-buffer ada-file)) + (if ada-prj-edit-use-default-values + (concat (file-name-sans-extension ada-file) + ada-project-file-extension) + + (let ((prj-file (ada-prj-find-prj-file t))) + (if (or (not prj-file) + (not (file-exists-p prj-file)) + ) + (setq prj-file + (concat (file-name-sans-extension ada-file) + ada-project-file-extension))) + prj-file) + )) + ) + + +;; Initializations for the package +(add-hook 'ada-mode-hook 'ada-prj-add-ada-menu) + +;; Set the keymap once and for all, so that the keys set by the user in his +;; config file are not overwritten every time we open a new file. +(ada-prj-add-keymap) + +(provide 'ada-prj) +;;; package ada-prj.el ends here + + +