aboutsummaryrefslogtreecommitdiff
path: root/old_ada/ada-prj.el
diff options
context:
space:
mode:
authorDaniel <[email protected]>2024-04-20 11:19:15 -0400
committerDaniel <[email protected]>2024-04-20 11:19:15 -0400
commit0172b10b8b0f352fdc45757abfe7fdf2a4d03960 (patch)
treeef5100d059c4dc06dfcb4844454cd1aaba1b0281 /old_ada/ada-prj.el
parentb139c8ff5cd3d784d3b462012a1911f00b6c4542 (diff)
rename old-ada dir
Diffstat (limited to 'old_ada/ada-prj.el')
-rw-r--r--old_ada/ada-prj.el682
1 files changed, 0 insertions, 682 deletions
diff --git a/old_ada/ada-prj.el b/old_ada/ada-prj.el
deleted file mode 100644
index d9fa77c..0000000
--- a/old_ada/ada-prj.el
+++ /dev/null
@@ -1,682 +0,0 @@
-;;; ada-prj.el --- GUI editing of project files for the ada-mode
-
-;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
-
-;; Author: Emmanuel Briot <[email protected]>
-;; Maintainer: Stephen Leake <[email protected]>
-;; Keywords: languages, ada, project file
-;; Package: ada-mode
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; 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-customize'.
-;; See the documentation of the Ada mode for more information on the project
-;; files.
-;; Internally, a project file is represented as a property list, with each
-;; field of the project file matching one property of the list.
-
-;;; Code:
-
-
-;; ----- Requirements -----------------------------------------------------
-
-(require 'cus-edit)
-(require 'ada-xref)
-
-(eval-when-compile
- (require 'ada-mode))
-(eval-when-compile (require 'cl-lib))
-
-;; ----- Buffer local variables -------------------------------------------
-
-(defvar ada-prj-current-values nil
- "Hold the current value of the fields, This is a property list.")
-(make-variable-buffer-local 'ada-prj-current-values)
-
-(defvar ada-prj-default-values nil
- "Hold the default value for the fields, This is a property list.")
-(make-variable-buffer-local 'ada-prj-default-values)
-
-(defvar ada-prj-ada-buffer nil
- "Indicates what Ada source file was being edited.")
-
-(defvar ada-old-cross-prefix nil
- "The cross-prefix associated with the currently loaded runtime library.")
-
-
-;; ----- Functions --------------------------------------------------------
-
-(defun ada-prj-new ()
- "Open a new project file."
- (interactive)
- (let* ((prj
- (if (and ada-prj-default-project-file
- (not (string= ada-prj-default-project-file "")))
- ada-prj-default-project-file
- "default.adp"))
- (filename (read-file-name "Project file: "
- (if prj "" nil)
- nil
- nil
- prj)))
- (if (not (string= (file-name-extension filename t) ".adp"))
- (error "File name extension for project files must be .adp"))
-
- (ada-customize nil filename)))
-
-(defun ada-prj-edit ()
- "Editing the project file associated with the current Ada buffer.
-If there is none, opens a new project file."
- (interactive)
- (if ada-prj-default-project-file
- (ada-customize)
- (ada-prj-new)))
-
-(defun ada-prj-initialize-values (symbol _ada-buffer filename)
- "Set SYMBOL to the property list of the project file FILENAME.
-If FILENAME is null, read the file associated with ADA-BUFFER.
-If no project file is found, return the default values."
-;; FIXME: rationalize arguments; make ada-buffer optional?
- (if (and filename
- (not (string= filename ""))
- (assoc filename ada-xref-project-files))
- (set symbol (copy-sequence (cdr (assoc filename ada-xref-project-files))))
-
- ;; Set default values (except for the file name if this was given
- ;; in the buffer
- (set symbol (ada-default-prj-properties))
- (if (and filename (not (string= filename "")))
- (set symbol (plist-put (eval symbol) 'filename filename)))
- ))
-
-
-(defun ada-prj-save-specific-option (field)
- "Return the string to print in the project file to save FIELD.
-If the current value of FIELD is the default value, return an empty string."
- (if (string= (plist-get ada-prj-current-values field)
- (plist-get ada-prj-default-values field))
- ""
- (concat (symbol-name field)
- "=" (plist-get ada-prj-current-values field) "\n")))
-
-(defun ada-prj-save ()
- "Save the edited project file."
- (interactive)
- (let ((file-name (or (plist-get ada-prj-current-values 'filename)
- (read-file-name "Save project as: ")))
- output)
- (setq output
- (concat
-
- ;; Save the fields that do not depend on the current buffer
- ;; only if they are different from the default value
-
- (ada-prj-save-specific-option 'comp_opt)
- (ada-prj-save-specific-option 'bind_opt)
- (ada-prj-save-specific-option 'link_opt)
- (ada-prj-save-specific-option 'gnatmake_opt)
- (ada-prj-save-specific-option 'gnatfind_opt)
- (ada-prj-save-specific-option 'cross_prefix)
- (ada-prj-save-specific-option 'remote_machine)
- (ada-prj-save-specific-option 'debug_cmd)
-
- ;; Always save the fields that depend on the current buffer
- "main=" (plist-get ada-prj-current-values 'main) "\n"
- "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n"
- (ada-prj-set-list "check_cmd"
- (plist-get ada-prj-current-values 'check_cmd)) "\n"
- (ada-prj-set-list "make_cmd"
- (plist-get ada-prj-current-values 'make_cmd)) "\n"
- (ada-prj-set-list "comp_cmd"
- (plist-get ada-prj-current-values 'comp_cmd)) "\n"
- (ada-prj-set-list "run_cmd"
- (plist-get ada-prj-current-values 'run_cmd)) "\n"
- (ada-prj-set-list "src_dir"
- (plist-get ada-prj-current-values 'src_dir)
- t) "\n"
- (ada-prj-set-list "obj_dir"
- (plist-get ada-prj-current-values 'obj_dir)
- t) "\n"
- (ada-prj-set-list "debug_pre_cmd"
- (plist-get ada-prj-current-values 'debug_pre_cmd))
- "\n"
- (ada-prj-set-list "debug_post_cmd"
- (plist-get ada-prj-current-values 'debug_post_cmd))
- "\n"
- ))
-
- (find-file file-name)
- (erase-buffer)
- (insert output)
- (save-buffer)
- ;; kill the project buffer
- (kill-buffer nil)
-
- ;; kill the editor buffer
- (kill-buffer "*Edit Ada Mode Project*")
-
- ;; automatically set the new project file as the active one
- (setq ada-prj-default-project-file file-name)
-
- ;; force Emacs to reread the project files
- (ada-reread-prj-file file-name)
- )
- )
-
-(defun ada-prj-load-from-file (symbol)
- "Load SYMBOL value from file.
-One item per line should be found in the file."
- (save-excursion
- (let ((file (read-file-name "File name: " nil nil t))
- (buffer (current-buffer))
- line
- list)
- (find-file file)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (setq line (buffer-substring-no-properties (point) (point-at-eol)))
- (cl-pushnew line list :test #'equal)
- (forward-line 1))
- (kill-buffer nil)
- (set-buffer buffer)
- (setq ada-prj-current-values
- (plist-put ada-prj-current-values
- symbol
- (append (plist-get ada-prj-current-values symbol)
- (reverse list)))))
- (ada-prj-display-page 2)))
-
-(defun ada-prj-subdirs-of (dir)
- "Return a list of all the subdirectories of DIR, recursively."
- (let ((subdirs (directory-files dir t "^[^.].*"))
- (dirlist (list dir)))
- (while subdirs
- (if (file-directory-p (car subdirs))
- (let ((sub (ada-prj-subdirs-of (car subdirs))))
- (if sub
- (setq dirlist (append sub dirlist)))))
- (setq subdirs (cdr subdirs)))
- dirlist))
-
-(defun ada-prj-load-directory (field &optional file-name)
- "Append to FIELD in the current project the subdirectories of FILE-NAME.
-If FILE-NAME is nil, ask the user for the name."
-
- ;; Do not use an external dialog for this, since it wouldn't allow
- ;; the user to select a directory
- (let ((use-dialog-box nil))
- (unless file-name
- (setq file-name (read-directory-name "Root directory: " nil nil t))))
-
- (setq ada-prj-current-values
- (plist-put ada-prj-current-values
- field
- (append (plist-get ada-prj-current-values field)
- (reverse (ada-prj-subdirs-of
- (expand-file-name file-name))))))
- (ada-prj-display-page 2))
-
-(defun ada-prj-display-page (tab-num)
- "Display page TAB-NUM in the notebook.
-The current buffer must be the project editing buffer."
-
- (let ((inhibit-read-only t))
- (erase-buffer))
-
- ;; Widget support in Emacs 21 requires that we clear the buffer first
- (if (and (not (featurep 'xemacs)) (>= emacs-major-version 21))
- (progn
- (setq widget-field-new nil
- widget-field-list nil)
- (mapc (lambda (x) (delete-overlay x)) (car (overlay-lists)))
- (mapc (lambda (x) (delete-overlay x)) (cdr (overlay-lists)))))
-
- ;; Display the tabs
-
- (widget-insert "\n Project configuration.\n
- ___________ ____________ ____________ ____________ ____________\n / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 1)) "General")
- (widget-insert " \\ / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 2)) "Paths")
- (widget-insert " \\ / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 3)) "Switches")
- (widget-insert " \\ / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 4)) "Ada Menu")
- (widget-insert " \\ / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 5)) "Debugger")
- (widget-insert " \\\n")
-
- ;; Display the currently selected page
-
- (cond
-
- ;;
- ;; First page (General)
- ;;
- ((= tab-num 1)
- (widget-insert "/ \\/______________\\/______________\\/______________\\/______________\\\n")
-
- (widget-insert "Project file name:\n")
- (widget-insert (plist-get ada-prj-current-values 'filename))
- (widget-insert "\n\n")
- (ada-prj-field 'casing "Casing Exceptions"
-"List of files that contain casing exception
-dictionaries. All these files contain one
-identifier per line, with a special casing.
-The first file has the highest priority."
- t nil
- (mapconcat (lambda(x)
- (concat " " x))
- (ada-xref-get-project-field 'casing)
- "\n")
- )
- (ada-prj-field 'main "Executable file name"
-"Name of the executable generated when you
-compile your application. This should include
-the full directory name, using ${build_dir} if
-you wish.")
- (ada-prj-field 'build_dir "Build directory"
- "Reference directory for relative paths in
-src_dir and obj_dir below. This is also the directory
-where the compilation is done.")
- (ada-prj-field 'remote_machine "Name of the remote machine (if any)"
-"If you want to remotely compile, debug and
-run your application, specify the name of a
-remote machine here. This capability requires
-the `rsh' protocol on the remote machine.")
- (ada-prj-field 'cross_prefix "Prefix used in for the cross tool chain"
-"When working on multiple cross targets, it is
-most convenient to specify the prefix of the
-tool chain here. For instance, on PowerPc
-vxworks, you would enter `powerpc-wrs-vxworks-'.
-To use JGNAT, enter `j'.")
- )
-
-
- ;;
- ;; Second page (Paths)
- ;;
- ((= tab-num 2)
- (if (not (equal (plist-get ada-prj-current-values 'cross_prefix)
- ada-old-cross-prefix))
- (progn
- (setq ada-old-cross-prefix
- (plist-get ada-prj-current-values 'cross_prefix))
- (ada-initialize-runtime-library ada-old-cross-prefix)))
-
-
- (widget-insert "/_____________\\/ \\/______________\\/______________\\/______________\\\n")
- (ada-prj-field 'src_dir "Source directories"
-"Enter the list of directories where your Ada
-sources can be found. These directories will be
-used for the cross-references and for the default
-compilation commands.
-Note that src_dir includes both the build directory
-and the standard runtime."
- t t
- (mapconcat (lambda(x)
- (concat " " x))
- ada-xref-runtime-library-specs-path
- "\n")
- )
- (widget-insert "\n\n")
-
- (ada-prj-field 'obj_dir "Object directories"
-"Enter the list of directories where the GNAT
-library files (ALI files) can be found. These
-files are used for cross-references and by the
-gnatmake command.
-Note that obj_dir includes both the build directory
-and the standard runtime."
- t t
- (mapconcat (lambda(x)
- (concat " " x))
- ada-xref-runtime-library-ali-path
- "\n")
- )
- (widget-insert "\n\n")
- )
-
- ;;
- ;; Third page (Switches)
- ;;
- ((= tab-num 3)
- (widget-insert "/_____________\\/______________\\/ \\/______________\\/______________\\\n")
- (ada-prj-field 'comp_opt "Switches for the compiler"
-"These switches are used in the default
-compilation commands, both for compiling a
-single file and rebuilding the whole project")
- (ada-prj-field 'bind_opt "Switches for the binder"
-"These switches are used in the default build
-command and are passed to the binder")
- (ada-prj-field 'link_opt "Switches for the linker"
-"These switches are used in the default build
-command and are passed to the linker")
- (ada-prj-field 'gnatmake_opt "Switches for gnatmake"
-"These switches are used in the default gnatmake
-command.")
- (ada-prj-field 'gnatfind_opt "Switches for gnatfind"
-"The command gnatfind is run every time the Ada/Goto/List_References menu.
-You should for instance add -a if you are working in an environment
-where most ALI files are write-protected, since otherwise they get
-ignored by gnatfind and you don't see the references within.")
- )
-
- ;;
- ;; Fourth page
- ;;
- ((= tab-num 4)
- (widget-insert "/_____________\\/______________\\/______________\\/ \\/______________\\\n")
- (widget-insert
-"All the fields below can use variable substitution. The syntax is ${name},
-where name is the name that appears after the Help buttons in this buffer. As
-a special case, ${current} is replaced with the name of the file currently
-edited, with directory name but no extension, whereas ${full_current} is
-replaced with the name of the current file with directory name and
-extension.\n")
- (widget-insert
-"The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are set to
-${src_dir} and ${obj_dir} before running the compilation commands, so that you
-don't need to specify the -aI and -aO switches on the command line\n")
- (widget-insert
-"You can reference any environment variable using the same ${...} syntax as
-above, and put the name of the variable between the quotes.\n\n")
- (ada-prj-field 'check_cmd
- "Check syntax of a single file (menu Ada->Check File)"
-"This command is run to check the syntax and semantics of a file.
-The file name is added at the end of this command." t)
- (ada-prj-field 'comp_cmd
- "Compiling a single file (menu Ada->Compile File)"
-"This command is run when the recompilation
-of a single file is needed. The file name is
-added at the end of this command." t)
- (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)"
-"This command is run when you want to rebuild
-your whole application. It is never issues
-automatically and you will need to ask for it.
-If remote_machine has been set, this command
-will be executed on the remote machine." t)
- (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)"
-"This command specifies how to run the
-application, including any switch you need to
-specify. If remote_machine has been set, this
-command will be executed on the remote host." t)
- )
-
- ;;
- ;; Fifth page
- ;;
- ((= tab-num 5)
- (widget-insert "/_____________\\/______________\\/______________\\/______________\\/ \\\n")
- (ada-prj-field 'debug_pre_cmd "Commands to execute before launching the
-debugger"
-"The following commands are executed one after the other before starting
-the debugger. These can be used to set up your environment." t)
-
- (ada-prj-field 'debug_cmd "Debugging the application"
-"Specifies how to debug the application, possibly
-remotely if remote_machine has been set. We
-recommend the following debuggers:
- > gdb
- > gvd --tty
- > ddd --tty -fullname -toolbar")
-
- (ada-prj-field 'debug_post_cmd "Commands to execute in the debugger"
-"The following commands are executed one in the debugger once it has been
-started. These can be used to initialize the debugger, for instance to
-connect to the target when working with cross-environments" t)
- )
-
- )
-
-
- (widget-insert "______________________________________________________________________\n\n ")
- (widget-create 'push-button
- :notify (lambda (&rest _ignore)
- (setq ada-prj-current-values (ada-default-prj-properties))
- (ada-prj-display-page 1))
- "Reset to Default Values")
- (widget-insert " ")
- (widget-create 'push-button :notify (lambda (&rest _ignore) (kill-buffer nil))
- "Cancel")
- (widget-insert " ")
- (widget-create 'push-button :notify (lambda (&rest _ignore) (ada-prj-save))
- "Save")
- (widget-insert "\n\n")
-
- (widget-setup)
- (with-no-warnings
- (beginning-of-buffer))
- )
-
-
-(defun ada-customize (&optional new-file filename)
- "Edit the project file associated with the current buffer.
-If there is none or NEW-FILE is non-nil, make a new one.
-If FILENAME is given, edit that file."
- (interactive)
-
- (let ((ada-buffer (current-buffer))
- (inhibit-read-only t))
-
- ;; We can only edit interactively the standard ada-mode project files. If
- ;; the user is using other formats for the project file (through hooks in
- ;; `ada-load-project-hook', we simply edit the file
-
- (if (and (not new-file)
- (or ada-prj-default-project-file filename)
- (string= (file-name-extension
- (or filename ada-prj-default-project-file))
- "gpr"))
- (progn
- (find-file ada-prj-default-project-file)
- (add-hook 'after-save-hook 'ada-reread-prj-file t t)
- )
-
- (if filename
- (ada-reread-prj-file filename)
- (if (not (string= ada-prj-default-project-file ""))
- (ada-reread-prj-file ada-prj-default-project-file)
- (ada-reread-prj-file)))
-
- (switch-to-buffer "*Edit Ada Mode Project*")
-
- (ada-prj-initialize-values 'ada-prj-current-values
- ada-buffer
- ada-prj-default-project-file)
-
- (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
-
- (use-local-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map custom-mode-map)
- (define-key map "\C-x\C-s" 'ada-prj-save)
- map))
-
- ;; FIXME: Not sure if this works!!
- (set (make-local-variable 'widget-keymap)
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-keymap)
- (define-key map "\C-x\C-s" 'ada-prj-save)
- map))
-
- (set (make-local-variable 'ada-old-cross-prefix)
- (ada-xref-get-project-field 'cross-prefix))
-
- (ada-prj-display-page 1)
- )))
-
-;; ---------------- Utilities --------------------------------
-
-(defun ada-prj-set-list (string ada-list &optional is-directory)
- "Prepend STRING to strings in ADA-LIST, return new-line separated string.
-If IS-DIRECTORY is non-nil, each element of ADA-LIST is explicitly
-converted to a directory name."
-
- (mapconcat (lambda (x) (concat string "="
- (if is-directory
- (file-name-as-directory x)
- x)))
- ada-list "\n"))
-
-
-(defun ada-prj-field-modified (widget &rest _dummy)
- "Callback for modification of WIDGET.
-Remaining args DUMMY are ignored.
-Save the change in `ada-prj-current-values' so that selecting
-another page and coming back keeps the new value."
- (setq ada-prj-current-values
- (plist-put ada-prj-current-values
- (widget-get widget ':prj-field)
- (widget-value widget))))
-
-(defun ada-prj-display-help (widget _widget-modified event)
- "Callback for help button in WIDGET.
-Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
- (let ((text (widget-get widget 'prj-help)))
- (if event
- ;; If we have a mouse-event, popup a menu
- (widget-choose "Help"
- (mapcar (lambda (a) (cons a t))
- (split-string text "\n"))
- event)
- ;; Else display the help string just before the next group of
- ;; variables
- (momentary-string-display
- (concat "*****Help*****\n" text "\n**************\n")
- (point-at-bol 2)))))
-
-(defun ada-prj-show-value (widget _widget-modified event)
- "Show the current field value in WIDGET.
-Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
- (let* ((field (widget-get widget ':prj-field))
- (value (plist-get ada-prj-current-values field))
- (inhibit-read-only t)
- w)
-
- ;; If the other widget is already visible, delete it
- (if (widget-get widget 'prj-other-widget)
- (progn
- (widget-delete (widget-get widget 'prj-other-widget))
- (widget-put widget 'prj-other-widget nil)
- (widget-put widget ':prj-field field)
- (widget-default-value-set widget "Show Value")
- )
-
- ;; Else create it
- (save-excursion
- (mouse-set-point event)
- (forward-line 1)
- (beginning-of-line)
- (setq w (widget-create 'editable-list
- :entry-format "%i%d %v"
- :notify 'ada-prj-field-modified
- :help-echo (widget-get widget 'prj-help)
- :value value
- (list 'editable-field :keymap widget-keymap)))
- (widget-put widget 'prj-other-widget w)
- (widget-put w ':prj-field field)
- (widget-put widget ':prj-field field)
- (widget-default-value-set widget "Hide Value")
- )
- )
- (widget-setup)
- ))
-
-(defun ada-prj-field (field text help-text &optional is-list is-paths after-text)
- "Create a widget to edit FIELD in the current buffer.
-TEXT is a short explanation of what the field means, whereas HELP-TEXT
-is the text displayed when the user pressed the help button.
-If IS-LIST is non-nil, the field contains a list. Otherwise, it contains
-a single string.
-If IS-PATHS is true, some special buttons are added to load paths,...
-AFTER-TEXT is inserted just after the widget."
- (let ((value (plist-get ada-prj-current-values field))
- (inhibit-read-only t)
- widget)
- (unless value
- (setq value
- (if is-list '() "")))
- (widget-insert text)
- (widget-insert ":")
- (move-to-column 54 t)
- (widget-put (widget-create 'push-button
- :notify 'ada-prj-display-help
- "Help")
- 'prj-help
- help-text)
- (widget-insert (concat " (" (symbol-name field) ")\n"))
- (if is-paths
- (progn
- (widget-create 'push-button
- :notify
- (list 'lambda '(&rest dummy) '(interactive)
- (list 'ada-prj-load-from-file
- (list 'quote field)))
- "Load From File")
- (widget-insert " ")
- (widget-create 'push-button
- :notify
- (list 'lambda '(&rest dummy) '(interactive)
- (list 'ada-prj-load-directory
- (list 'quote field)))
- "Load Recursive Directory")
- (widget-insert "\n ${build_dir}\n")))
-
- (setq widget
- (if is-list
- (if (< (length value) 15)
- (widget-create 'editable-list
- :entry-format "%i%d %v"
- :notify 'ada-prj-field-modified
- :help-echo help-text
- :value value
- (list 'editable-field :keymap widget-keymap))
-
- (let ((w (widget-create 'push-button
- :notify 'ada-prj-show-value
- "Show value")))
- (widget-insert "\n")
- (widget-put w 'prj-help help-text)
- (widget-put w 'prj-other-widget nil)
- w)
- )
- (widget-create 'editable-field
- :format "%v"
- :notify 'ada-prj-field-modified
- :help-echo help-text
- :keymap widget-keymap
- value)))
- (widget-put widget ':prj-field field)
- (if after-text
- (widget-insert after-text))
- (widget-insert "\n")
- ))
-
-
-(provide 'ada-prj)
-
-;;; ada-prj.el ends here