DataMuseum.dk

Presents historical artifacts from the history of:

DKUUG/EUUG Conference tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DKUUG/EUUG Conference tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download
Index: T d

⟦3fac8179d⟧ TextFile

    Length: 51930 (0xcada)
    Types: TextFile
    Names: »dired-ada.el«

Derivation

└─⟦a05ed705a⟧ Bits:30007078 DKUUG GNU 2/12/89
    └─⟦dbcd4071d⟧ »./gnu-ada-1.05.tar.Z« 
        └─⟦999713de5⟧ 
            └─⟦this⟧ »dired-ada.el« 

TextFile

;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;
;; dired-ada.el --- Dired support for Verdix Ada.
;; Author          : Lynn Slater
;; Created On      : Fri May 27 09:13:58 1988
;; Last Modified By: Lynn Slater
;; Last Modified On: Tue Oct 18 07:03:19 1988
;; Update Count    : 188
;; Status          : General Public Release 1.05
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This file is part of GNU Emacs.
;; Copyright (C) 1988 Lynn Randolph Slater, Jr.
;; Copyright (C) 1988 Free Software Foundation, Inc.
;;
;; This file is distributed in the hope that it will be useful,
;; but without any warranty.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.
;;
;; Everyone is granted permission to copy, modify and redistribute
;; this file, but only under the conditions described in the
;; document "GNU Emacs copying permission notice".   An exact copy
;; of the document is supposed to have been given to you along with
;; this file so that you can know how you may redistribute it all.
;; It should be in a file named COPYING.  Among other things, the
;; copyright notice and this notice must be preserved on all copies.

;; Make this file dired-ada.el, byte-compile it in your path

;; History 		
;; 3-Oct-1988		Lynn Slater	
;;    Adopted to fit the new compile.el file
;; 13-Sep-1988		Lynn Slater	
;;    Made dired-ada mode variable have a different meaning
;;    Made dired-noselect be sensitive to existance of ada.lib
;;      Thanks to jclark@src.honeywell.com (Jeff Clark)
;; 13-Sep-1988		Lynn Slater	
;;    Added defvar of compilation-shell, etc. per comment by jclark
;;    Made dired-ada-mode use the same keymap as dired-mode
;;     except that the C-c sequences are changed

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This file creates VADS specific commands into the Ada development modes.
;; It supplies a form of dired that helps manage the VADS environment, and
;; it adds ADA vads commands into ada mode.
;;   Unlike a previous dired-ada implimentation, this version uses the
;; existing dired mode functions except where there is unresolvable
;; conflict. Thus, this is more like a minor mode to dired.
;;
;;   To enable this mode by default, (setq dired-ada-mode t) in your .emacs
;; file .
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'dired-ada)
(require 'compile)
(require 'shell)
;; As I cannot do (require 'dired), do an equivilent
(if (not (fboundp 'dired-do-deletions)) (load "dired"))
(require 'elec-ada)
(require 'ada-tag)

(defvar vads-ada-compilation-error-regexp
  "^/[a-zA-Z0-9\-\\./_]+, line [0-9]+"
  "Regular expression for filename/linenumber in error in VADS Ada compilation
  log.")
;;(setq vads-ada-compilation-error-regexp   "^/[a-zA-Z0-9\-\\./_]+, line [0-9]+")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These next variables can be set in the .emacs file -- lrs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar ada-programs-format "%s"
  "A format string used on all VADS ada related commands before execution.
   This is a crude way to do things like rsh'ing vads commands to another
   machine if you do not have a licence for your own CPU.
   Better ideas would be welcome.")

(defvar ada-main-unit-name ""
  "Name of main language unit last used to link with a.ld.")

(defvar ada-link-ld-options "" ;; lrs
  "Options to a.ld when linking.")

(defvar ada-link-unix-options "" ;; lrs
  "Options to Unix loader when linking.")

(defvar ada-compile-options "-v" ;; lrs
  "Options to ada when compiling.")

(defvar ada-make-options "-v"
  "Options passed to a.make.")

(defvar ada-ls-options "-v"
  "Options passed to a.ls.")

(defvar ada-du-options "-e -f -i"
  "Options passed to a.du.")

(defvar ada-tags-options "-t"
  "Options passed to a.tags.")

(defvar ada-tags-files "*.a"
  "Files passed to a.tags.")

(defvar ada-run-options ""
  "Options passed to run programs.")

(defvar ada-run-program "a.out"
  "The name of the program to be run by dired-ada-execute.")

(defvar ada-spec-suffix "-a.a"
  "Suffix presumed to exist on all Ada specification files.")

(defvar ada-body-suffix "-b.a"
  "Suffix presumed to exist on all Ada body files.")

(defun set-ada-options ()
  "Prompts for and resets all the ada options globals"
  (interactive)
  (setq ada-compile-options
	(read-string "New Ada compiler options: "
		     ada-compile-options))
  (setq ada-make-options
	(read-string "New Ada make options: "
		     ada-make-options))
  (setq ada-run-options
	(read-string "Run Command line arguments: "
		     ada-run-options))
  (setq ada-run-program
	(read-string "Name of Program to run: "
		     ada-run-options))
  (setq ada-main-unit-name
	(read-string "Name of main language unit: "
		     ada-main-unit-name))
  (setq ada-link-ld-options
	(read-string "a.ld option-string: "
		     ada-link-ld-options))
  (setq ada-link-unix-options
	(read-string "Unix linker option-string: "
		     ada-link-unix-options))
  (setq ada-du-options
	(read-string "New a.du options: "
		     ada-du-options))
  (setq ada-tags-files
	(read-string "Files to tag: "
		     ada-tags-files))
  (setq ada-tags-options
	(read-string "Options to a.tag: "
		     ada-tags-options))
  (setq ada-spec-suffix
	(read-string "Ada specification file suffix: "
		     ada-spec-suffix))
  (setq ada-body-suffix
	(read-string "Ada body file suffix: "
		     ada-body-suffix))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make the few changes to normal dired commands.  Each defun in this
;; section will be a defun to reintegrate every time a new emacs version is
;; released. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun dired-find-buffer (dirname)
  ;; This is a small change to a dired-mode command.
  ;; This version recognizes dired-ada-mode as well as dired-mode
  (let ((blist (buffer-list))
	found)
    (while blist
      (save-excursion
        (set-buffer (car blist))
	(if (and (or (eq major-mode 'dired-mode)
		     (eq major-mode 'dired-ada-mode))
		 (equal dired-directory dirname))
	    (setq found (car blist)
		  blist nil)
	  (setq blist (cdr blist)))))
    (or found
	(progn (if (string-match "/$" dirname)
		   (setq dirname (substring dirname 0 -1)))
	       (create-file-buffer (file-name-nondirectory dirname))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Start code compatable with existing dired code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dired-ada (dirname)
  "Manipulate Ada file directory DIRNAME.
Dired-Ada displays a list of files in DIRNAME.
You can move around in it with the usual commands.
You can delete files with commands similar to those in Dired mode.
You can also invoke many tools from the Verdix Ada toolset.
Type 'h' after entering dired-ada for more info."
  (interactive (list (read-file-name "Dired-Ada (directory): "
				     nil default-directory nil)))
  (switch-to-buffer (dired-ada-noselect dirname))
  (message  (substitute-command-keys
	     "Type 'h' for help with Dired-ada mode.")))

(defun dired-ada-other-window (dirname)
  "Manipulate Ada library directory DIRNAME.
Like M-x dired-ada but selects in another window."
  (interactive (list (read-file-name "Dired-Ada in other window (directory): "
				     nil default-directory nil)))
  (pop-to-buffer (dired-ada-noselect dirname))
  (message (substitute-command-keys
	     "Type 'h' or 'C-h m' for help with Dired-ada mode.")))

(defun dired-ada-noselect (dirname)
  "Like M-x dired-ada but returns the dired-ada buffer as value, does not select it."
  (or dirname (setq dirname default-directory))
  (if (string-match "./$" dirname)
      (setq dirname (substring dirname 0 -1)))
  (setq dirname (expand-file-name dirname))
  (and (not (string-match "/$" dirname))
       (file-directory-p dirname)
       (setq dirname (concat dirname "/")))
  (let ((buffer (dired-find-buffer dirname)))
    (save-excursion
      (set-buffer buffer)
      (dired-readin dirname buffer)
      (dired-move-to-filename)
      (dired-ada-mode dirname))
    buffer))

(defun dired-ada-revert (&optional arg arg2) 
  (let ((odot (point))
	(ofile (dired-get-filename t t))
	(buffer-read-only nil))
    (erase-buffer)
    (dired-readin dired-directory (current-buffer))
    (or (and ofile (re-search-forward (concat " " (regexp-quote ofile) "$") nil t))
	(goto-char odot))
    (beginning-of-line)))

(defun dired-ada-find-file ()
  "In dired, visit the file named on this line."
  ;; This differs from dired-find-file only in that browsed directories are
  ;; presumed to be in dired-ada mode
  (interactive)
  (if (save-excursion
	(beginning-of-line)
	(looking-at "  d"))
      (dired-ada (dired-get-filename))
    (find-file (dired-get-filename))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Define a general utility that will call all verdix commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun execute-ada-command (command &optional no-parse-errorsp silentp)
  "Runs a VADS command in the *compilation* buffer.
   Is like compile function but parses in ada and uses ada-programs-format"
  ;; enforces some ada conventions

  (let ((full-command ;;; on some systems, a.make, etc may not be defined.
		      ;;; Let the user automatically wrap the vads commands
		      ;;; in other unix commands. 
	 (format ada-programs-format command)))

    (if (not silentp) (save-some-buffers))
    (compile1 full-command "No More Verdix Ada Errors"  "Ada command "
	      (if no-parse-errorsp
		  'compilation-cannot-parse-errors
		'ada-compilation-parse-errors)
	      vads-ada-compilation-error-regexp)
    (message "VADS Ada command executing")))

;; define the new error message parsers

(defun ada-compilation-parse-errors ()
  "Parse the current buffer as VADS Ada compiler error messages.
This makes a list of error descriptors, compilation-error-list.
For each source-file, line-number pair in the buffer,
the source file is read in, and the text location is saved in compilation-error-list.
The function next-error, assigned to \\[next-error], takes the next error off the list
and visits its location."
  (setq compilation-error-list nil)
  (let (text-buffer
	last-filename last-linenum)
    ;; Don't reparse messages already seen at last parse.
    (goto-char compilation-parsing-end)
    ;; Don't parse the first two lines as error messages.
    ;; This matters for grep.
    (if (bobp)
	(forward-line 2))
    (while (re-search-forward vads-ada-compilation-error-regexp nil t)
      ;;(message "at %s" (point)) (sit-for 1)
      (let (linenum filename charpos	; SDL added charpos to remember
	    error-marker text-marker)	; character position of (Ada) error
	(setq charpos 1)		; always set to 1 unless we find
					; an Ada error
	;; Extract file name and line number from error message.
	(save-restriction
	  (narrow-to-region (match-beginning 0) (match-end 0))
	  (goto-char (point-max))
	  (skip-chars-backward "[0-9]")
	  ;; If it's a lint message, use the last file(linenum) on the line.
	  ;; Normally we use the first on the line.
	  (if (= (preceding-char) ?\()
	      (progn
		(narrow-to-region (point-min) (1+ (buffer-size)))
		(end-of-line)
		(re-search-backward compilation-error-regexp)
		(skip-chars-backward "^ \t\n")
		(narrow-to-region (point) (match-end 0))
		(goto-char (point-max))
		(skip-chars-backward "[0-9]")))
	  ;; Are we looking at a "filename-first" or "line-number-first" form?
	  (if (looking-at "[0-9]")
	      (progn
		(setq linenum (read (current-buffer)))
					; SDL: here is where we find the
					; character pos
		(save-excursion
		  (save-restriction
		    (widen)
		    (if (looking-at ", char ")
			(progn
			  (forward-char 7)
			  (let ((beg (point)))
			    (search-forward ":")
			    (backward-char 1)
			    (setq charpos 
				  (string-to-int
				   (buffer-substring beg (point))))
			    )))))

		(goto-char (point-min)))
	    ;; Line number at start, file name at end.
	    (progn
	      (goto-char (point-min))
	      (setq linenum (read (current-buffer)))
	      (goto-char (point-max))
	      (skip-chars-backward "^ \t\n")))
	  (setq filename (compilation-grab-filename)))
	;; Locate the erring file and line.
	(if (and (equal filename last-filename)
		 (= linenum last-linenum))
	    nil
	  (beginning-of-line 1)
	  (setq error-marker (point-marker))
	  ;; text-buffer gets the buffer containing this error's file.
	  (if (not (equal filename last-filename))
	      (setq text-buffer
		    (and (file-exists-p (setq last-filename filename))
			 (find-file-noselect filename))
		    last-linenum 0))
	  (if text-buffer
	      ;; Go to that buffer and find the erring line.
	      (save-excursion
		(set-buffer text-buffer)
		(if (zerop last-linenum)
		    (progn
		      (goto-char 1)
		      (setq last-linenum 1)))
		(forward-line (- linenum last-linenum))
					; SDL: here is where to set the 
					; right character pos
		(forward-char (- charpos 1))
					;
		(setq last-linenum linenum)
		(setq text-marker (point-marker))
		(setq compilation-error-list
		      (cons (list error-marker text-marker)
			    compilation-error-list)))))
	(forward-line 1))
      )
    (setq compilation-parsing-end (point-max)))
  (message "Parsing error messages...done")
  (setq compilation-error-list (nreverse compilation-error-list)))

(defun compilation-cannot-parse-errors ()
  "Prints a error message. Good when the errors are unparsable."
  (error "Do not know how to parse these kinds of errors."))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Ada specific things
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dired-ada-buffer  () ;; lrs
  "Invokes ada-dired on the directory of the current buffer."
  (interactive)
  (dired-ada default-directory))

(defun ada-command (command &optional no-parse-errorsp silentp)
  "Runs a VADS command in the *compilation* buffer.
   Is like compile function but parses in ada and uses ada-programs-format

   This is a good command to use when you have a script of verdix commands"
  (interactive (list (read-string "Ada command: " compile-command)))
  (setq compile-command command)
  (execute-ada-command compile-command no-parse-errorsp silentp))

(defun dired-ada-compile-file  (arg) ;; Verdix/VADS specific
  "Compile file pointed at by cursor, in verbose mode.
   If given an argument, will prompt for and reset the global
   ada-compile-options"       
  (interactive "P")
  (if arg;; reset the options
      (setq ada-compile-options
	    (read-string "New Ada compiler options: "
			 ada-compile-options)))
  (execute-ada-command (concat "ada " ada-compile-options " "
			       (dired-get-filename t))))

(defun buffer-file-name-nondirectory ()
  (file-name-nondirectory (buffer-file-name)))

(defun ada-compile-buffer  (arg) ;; Verdix/VADS specific
  "Compile Ada file visited by currently selected buffer.
   If given an argument, will prompt for and reset the global
   ada-compile-options"       
  (interactive "P")
  (if arg ;; reset the options
      (setq ada-compile-options
	    (read-string "New Ada compiler options: "
			 ada-compile-options)))
  (if (not (buffer-file-name)) (error "You must be in an Ada source buffer."))
  (execute-ada-command
    (concat "ada " ada-compile-options " " (buffer-file-name-nondirectory))))

(defun dired-ada-debug-object-file  () ;; Verdix/VADS specific
  "Runs a.db on the file in the current line."
  (interactive)
  (a-db (dired-get-filename)))

(defun dired-ada-initialize-library  (subordinate-name options) ;; Verdix/VADS specific
  "Make and initialize a Verdix library under the current directory with
  the library of the current directory as its parent." 
  ;; needs an option to remake the library after cleanup
  (interactive "sName of Subordinate Library: \nsa.mklib Options (\"-f\" \"-t target\" or \"-v\" are allowed): ")
  ;;(if (or (file-exists-p "GVAS_table") (file-exists-p "ada.lib")
  ;;  (file-exists-p "gnrx.lib"))
  ;;    (error "A VADS Library already exists!"))
  (execute-ada-command  (concat "a.mklib " options " " subordinate-name "
				.") t t)
  (sit-for 3) ;; pause for shell completion
  (dired-ada-revert)
  (beginning-of-buffer)
  (re-search-forward (concat " " (regexp-quote subordinate-name) "$"))
  (goto-char (1+ (match-beginning 0)))
  )

(defun dired-ada-cleanup-library  nil ;; Verdix/VADS specific
  "Reinitializes (a.cleanlib) the VADS library in the current directory."
  (interactive)
  (if (yes-or-no-p "This will erase the compilation order info, proceed? ")
      (execute-ada-command  "a.cleanlib -f " t t)
    (message "Command Aborted")
    ))

(defun dired-ada-execute  (program options)
  "Runs the current executable file"
  (interactive (list
		(setq ada-run-program
		      (read-string "Program to run: "
				   (if (eq major-mode 'dired-ada-mode)
				       (dired-get-filename t)
				     ada-run-program)))
						       
		(setq ada-run-options
		      (read-string "Run Command line arguments: "
				   ada-run-options))))
  (let ((file (file-name-nondirectory program)))
    (switch-to-buffer (concat "*run-" file "*"))
    (or (bolp) (newline))
    (insert "Current directory is " default-directory "\n")
    (make-shell (concat "run-" file) program nil
		ada-run-options)
    (shell-mode)
    )
  (delete-other-windows)
  )

(defun dired-ada-list (the-whole-lib-p) ;; Verdix/VADS specific
  "Runs a.ls to find out which Ada units are known to be in the current file.
   If called with an argument, runs a.ls on the entire VADS library.
   Uses the customizable variable ada-ls-options."
  (interactive "P")
  (execute-ada-command
    (if the-whole-lib-p
	(concat "a.ls " ada-ls-options)
      (concat "a.ls " ada-ls-options " -f " (dired-get-filename t))) t t))


(defun dired-ada-list-all () ;; Verdix/VADS specific
  "Runs a.ls on the entire VADS library."
  (interactive)
  (dired-ada-list t))

(defun dired-ada-path () ;; Verdix/VADS specific
  "Runs a.path on the library in the current directory"
  (interactive)
  (execute-ada-command "a.path -t" t t))

(defun ada-make-all  (arg) ;; Verdix/VADS specific
  "Runs a.make to make all files in dir.
   If given a universal arg, allows user to alter the make command
   before executing it."
  (interactive "P")
  (let ((command (concat "a.make "
			 ada-make-options
			 " -f *.a ")))
    (if arg (setq command (read-string "a.make command: " command)))
    (execute-ada-command command)))

(defun dired-ada-make-file  (arg) ;; Verdix/VADS specific
  "Runs a.make to make file pointed at by cursor up to date.
   If given a universal arg, allows user to alter the make command
   before executing it."
  (interactive "P")
    (let ((command (concat "a.make " ada-make-options " -f "
			   (dired-get-filename t))))
      (if arg (setq command (read-string "a.make command: " command)))
      (execute-ada-command command)))

(defun ada-make-buffer  (arg) ;; Verdix/VADS specific
  "Runs a.make to make file in currently selected buffer up to date.
   If given a universal arg, allows user to alter the make command
   before executing it."
  (interactive "P")
  (if (not (buffer-file-name))
      (error "You must be in an Ada source buffer."))
  (let ((command (concat "a.make "
			 ada-make-options
			 " -f " 
			 (buffer-file-name-nondirectory))))
    (if arg (setq command (read-string "a.make command: " command)))
    (execute-ada-command command)))

(defun ada-make-unit  (unit-name arg) ;; Verdix/VADS specific
  "Runs a.make to make an named ada unit up to date.
   If given a universal arg, allows user to alter the make command
   before executing it."
  (interactive (list
		(setq ada-main-unit-name
		      (read-string "Name of Ada unit to make: "
				   ada-main-unit-name))
		current-prefix-arg))
  (if arg
      (progn
	(setq ada-link-ld-options (read-string "a.ld option-string: "
					       ada-link-ld-options))
	(setq ada-link-unix-options (read-string "Unix linker option-string: "
						 ada-link-unix-options))))
  (let ((command (concat "a.make "
			 ada-make-options " " unit-name
			 " " ada-link-ld-options
			 " " ada-link-unix-options)))
    (if arg (setq command (read-string "a.make command: " command)))
    (execute-ada-command command)))

(defun dired-ada-library-dependencies  () ;; Verdix/VADS specific
  "Runs a.make to display all dependencies of the current file
The dependencies are displayed in Unix 'make' format."
  (interactive)
  (execute-ada-command (concat "a.make -D -f " (dired-get-filename t))
		       t))

(defun dired-ada-link () ;; Verdix/VADS specific
  "Runs the linker a.ld to create object file.  You are prompted for:
the name of the main language unit, the options to a.ld, and finally the
options to the Unix linker."
  (interactive)
  (setq ada-main-unit-name  (read-string "Name of main language unit: "
						  ada-main-unit-name))
  (setq ada-link-ld-options (read-string "a.ld option-string: "
					 ada-link-ld-options))
  (setq ada-link-unix-options (read-string "Unix linker option-string: "
					   ada-link-unix-options))
  (execute-ada-command (concat "a.ld "  ada-link-ld-options  " "  ada-main-unit-name " "
			       ada-link-unix-options) t t)
  )
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dired-ada-new-files  ()
  (interactive)
  (save-excursion
    (dired-safe-apply 'ada-new-files t))
  (dired-ada-revert);; update the directory
  (switch-to-buffer nil)
  ;;(revert-buffer) ;; broken!
  ;; (beginning-of-buffer)
  ;; (re-search-forward (concat " " (regexp-quote spec)))
  ;; (goto-char (match-beginning 0))
  (message "New files Created")
  )

(defun dired-safe-apply  (fcn args)
  "Protects a fcn from changing the dired-directory. This is a workaround
   for a emacs bug/unexplained bahavior. If args is T, calls interactively"
  (let ((dir dired-directory)
	(revert-fcn revert-buffer-function))
    (if (eq args t)
	(call-interactively fcn)
      (apply fcn args))
    (setq dired-directory dir)
    (if revert-fcn (setq revert-buffer-function revert-fcn))
    ))

(defun dired-ada-recompilation-order  nil ;; Verdix/VADS specific
  "Runs a.make on file pointed to by cursor,
to display recompilation order needed to make file up to date."
  (interactive)
  (execute-ada-command (concat "a.make -U -f " (dired-get-filename t))
		       t t))

(defun recompilation-order-ada-buffer  nil ;; no options? ;; Verdix/VADS specific
  "Runs a.make on file in currently selected buffer, to
display recompilation order needed to make file up to date."
  (interactive)
  (if (not (buffer-file-name))
      (error "You must be in an Ada source buffer."))
  (execute-ada-command (concat "a.make -U -f " (buffer-file-name-nondirectory)) t t))

(defun dired-ada-remove-file  nil ;; Verdix/VADS specific
  "Removes VADS units of current file from the VADS library."
  (interactive)
  (execute-ada-command (concat "a.rm " (dired-get-filename t)) t t))

(defun dired-ada-remove-library () ;; Verdix/VADS specific
  "Removes the VADS library and all related files from this directory"
  (interactive)
  (if (yes-or-no-p "Do you really want to remove all your Ada library files? ")
      (progn
	(message "please wait")
	(execute-ada-command "a.rmlib " t t)
	(sit-for 3);; pause for shell completion
	(dired-ada-revert)
	(message "lib removed, but the directory is still there")
	)
    (message "Command Aborted")
    ))

(defun dired-ada-disk-utilization  (arg &optional dir) ;; Verdix/VADS specific
  "Determines library disk utilization.
   If given an argument, will prompt for and reset the global
   ada-du-options"       
  (interactive "P")
  (if arg ;; reset the options
      (setq ada-du-options
	    (read-string "New a.du options: "
			 ada-du-options)))
  (execute-ada-command (concat "a.du " ada-du-options " " dir) t t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Define the Vads commands callable from in a buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ada-list-buffer ()
  "Runs a.ls to find out which Ada units are known to be in the current file.
   Uses the customizable variable ada-ls-options."
  (interactive)
  (execute-ada-command (concat "a.ls " ada-ls-options " -f "
			       (buffer-file-name-nondirectory)) t t))

(defun ada-remove-buffer ()
  "Removes VADS units of current file from the VADS library."
  (interactive)
  (execute-ada-command (concat "a.rm " (buffer-file-name-nondirectory)) t t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Incorperate tags
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dired-ada-make-tags-for-program  (filespec) ;; Verdix/VADS specific
  "Runs a.tags to create a tags file.
   Uses the global variable ada-tags-options."       
  (interactive (list (setq ada-tags-files (read-string "Files to tag: "
						       ada-tags-files))))
  (require 'tags-ada)
  (let ((curbuf (current-buffer)))
    (pop-to-buffer "*a.tags*")
    (erase-buffer)
    (set-mark-command nil)
    (message "Running a.tags, please wait...")
    (sit-for 0)
    (call-process "csh"
		  nil
		  t
		  t
		  "-c"
		  (concat "exec a.tags " ada-tags-options " " filespec))
    (message "a.tags complete")
    (pop-to-buffer curbuf))
  (visit-tags-table-ada "tags"))

(defun get-tags-for-ada-buffer ()
  "Gets the tags table in the current directory"
  (interactive)
  (visit-tags-table-ada (expand-file-name "tags" default-directory)))
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make a few highly specialized commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun extract-ada-recompilation-order (dir) ;; Verdix/VADS specific
  "presumes itself to be in a buffer with recompilation info in it."
  (if (not (= (aref dir (1- (length dir))) ?/))
      (setq dir (concat dir "/")))
  (beginning-of-buffer)
  (let ((fnames nil))
    (while;;(re-search-forward "^SOURCE FILE: *\\** *\\(/.*\.a\\)$" nil t)
	(re-search-forward "^SOURCE FILE: *\\** *\\([/a-zA-Z].*\.a\\)$" nil t)
      (let ((fname (buffer-substring (match-beginning 1)
				     (match-end 1))))
	
	(setq fnames (cons
		      (if (= (aref fname 0) ?/)
			  fname
		        (concat dir fname))
		      fnames))))
    (reverse fnames)))

(defun get-ada-recompilation-order (dir files) ;; Verdix/VADS specific
  "Runs a.make to get the recompilation order of all files in the library
   returns a list of the files."
  (save-excursion
    (let* ((buffer)
	   fnames)
      (if (and (get-buffer "*recompilation-order*")
	       (y-or-n-p "Reuse the old VADS compilation order results?"))
	  (progn
	    (setq buffer (get-buffer "*recompilation-order*"))
	    (set-buffer buffer)
	    )
	(progn
	  (setq buffer (get-buffer-create "*recompilation-order*"))
	  (set-buffer buffer)
	  (erase-buffer)
	  (message "Invoking a.make -U on all '.a' files")
	  (sit-for 0)
	  (let ((command (format "cd %s;pwd;a.make -U -All -f %s" dir files) t))
	    (insert command "\n")
	    (end-of-buffer)
	    (shell-command command t)
	    (message "a.make completed"))
	  (sit-for 0)
	  (set-buffer-modified-p nil)
	  ))	
      (setq fnames (extract-ada-recompilation-order dir))
      (if fnames
	  nil;;(kill-buffer buffer)
	(error "The a.make failed. Look at the *recompilation-order* buffer"))
      fnames
      )))

(defun ada-make-rebuild-script (script-file-name files);; Verdix/VADS specific
  "Makes a script called SCRIPT-FILE-NAME in the current directory that
   will reinitialize the VADS library and will compile all the files
   from this directory which had contributed units to the directory.
   I find this very useful insurance against the times VADS gets confused
   in its library management. Also, I always know that I can recreate
   my world from scratch.

   Future enhancement: make the shell script correctly set the a.paths as
   well." 
  (interactive
   (list
    (read-string "Name of the script file to be created: " "rebuild")
    (read-string "Files to include: " "*.a")))
  (save-some-buffers)
  (let* ((dir default-directory)
	 (dd default-directory)	 
	 dirpat1
	 dirpat2
	 dirpat3
	 pt
	 l)
    (if (get-buffer "*recompile*")
	(kill-buffer "*recompile*"))
    (if (and (boundp 'dired-directory) dired-directory)
	;; switch to buffer changes the local variables. This is a bug!
	(dired-safe-apply 'switch-to-buffer '("*recompile*"))
      (switch-to-buffer "*recompile*"))
    (insert "#!/bin/sh \n")
    (insert "# Recompilation commands to recreate the state of the Ada Library\n")
    (insert "#   as of ") (insert (current-time-string)) (insert "\n#\n")
    (insert "# This was made automatically by the emacs command ada-make-rebuild-script\n")
    (insert "#   running in the directory ") (insert dir)
    (insert " on the files ") (insert files)
    (insert "
# Those files not in this directory but on which the current files are
#    dependent have had their Ada compile commands printed. However, these
#    commands have been commented out (to the shell) by being prefixed with
#    '#->'. If you must recompile these files as well as the files in the
#    current directory, eliminate this prefix.\n")
    (insert "\n# Edit the next two lines if needed.\n")
    (insert "dir=")
    ;; we must change the dir to resolve all symbolic links
    (setq pt (point))
    (shell-command (format "cd %s;pwd" dir) t)
    (end-of-line)      
    (setq dir (concat (buffer-substring pt (point)) "/"))
    (insert "\n")

    (insert (format "options=\"%s\"\n" ada-compile-options))
    (insert "\n")
    (insert (format "cd $dir\n"))
    (insert (format "#a.cleanlib\n" ))
    (insert "echo 'Library paths are:'\n") 
    (insert (format "a.path -t\n" ))
    (insert "\n")

    (insert "<<Am waiting for Vads to finish, this may take awhile>>")
    (setq l (get-ada-recompilation-order dir files))
    (beginning-of-line)
    (kill-line 1)
    (message "Have gotten recompilation order from VADS")

    (setq dirpat1 (concat "^" (regexp-quote dir)))
    (setq dirpat2 (concat "^" (regexp-quote dd)))
    (setq dirpat3 (concat "^" (regexp-quote "/usr/vads5.5")))
    (while l
      (if (or (string-match dirpat1 (file-name-directory (car l)))
	      (string-match dirpat2 (file-name-directory (car l))))
	  (insert (format "echo \"<%s>\";ada $options $dir/%s\n"
			  (file-name-nondirectory (car l))
			  ;; Get the part after the dir match
			  (substring (car l) (match-end 0))
			  ;;(file-name-nondirectory (car l))
			  ))
	(if (not (string-match dirpat3 (file-name-directory (car l))))
	    (insert (format "#->echo \"<%s>\";ada $options %s\n"
			    (file-name-nondirectory (car l))
			    (car l)))
	  (message "Ignoring %s" (file-name-nondirectory (car l))) ))
      (setq l (cdr l)))

    (beginning-of-buffer)
    (setq script-file-name (expand-file-name script-file-name dir))
    (if (and (file-exists-p script-file-name)
	     (not (y-or-n-p
		   (format "'%s' already exists. Overwrite? "
			   script-file-name)
		   )))
	(error "OK, the buffer is built, but you must save it yourself."))
    (write-file script-file-name)
    (message "Am changing the mode of the new script")
    (shell-command (format "chmod u+x %s"
			   (expand-file-name script-file-name dir)) t)
    (message "The cleanup script has been built and saved in %s"
	     (buffer-file-name))))

;;(defun get-ada-recompilation-order (dir f) l2)
;;(shell-command (format "a.path -t" dir) t)

(defun rebuild-ada-library (script-file-name) ;; Verdix/VADS specific
  "Builds a VADS library reinitialization script and runs it.
   See ada-make-rebuild-script"
  (interactive "sName of the script file to be created: ")
  (ada-make-rebuild-script script-file-name)
  (execute-ada-command (concat "/bin/csh -fx " script-file-name)))

(defun ada-make-tar-commands () ;; Verdix/VADS specific
  "Makes a shell script and tar command to preserve the files in the
       current directory that were used to build the units in the current
       directory. Is probably buggy" 
  (interactive)
  (with-output-to-temp-buffer "*tar*"
    (let* ((dir default-directory)
	   (l (get-ada-recompilation-order dir)))
      (princ "# !/bin/csh\n")
      (princ "# Tar commands to preserve the state of the Ada Library\n")
      (princ "#   source files as of ") (princ (current-time-string)) (princ "\n\n")
      (princ "# This was made automatically by the emacs command ada-make-tar-commands\n")
      (princ "#   running in the directory ") (princ dir) (princ ".\n")
      (princ "# Files on which the current files are dependent but not in this directory\n")
      (princ "#   were ignored.\n")
      (princ "\n")
      (princ (format "cd %s\n" dir))
      (princ "\ntar -cvf temp ")
      (while l
	(if (equal dir (file-name-directory (car l)))
	    (princ (format " %s" (car l))))
	(setq l (cdr l)))
      (princ "\n")
      ))
  (message "now save the other buffer somewhere"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Define the dired-ada mode itself
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar dired-ada-mode-map nil "Local keymap for dired-ada-mode buffers.")
(defvar dired-ada-specific-mode-map nil
  "Local keymap used in dired-ada-mode, holds the ada specific things like
   compile, make, etc..")

(defun dired-ada-mode (dirname)
  ;; Please see comment after this string
  "Mode for working with (Verdix) Ada library directories.

In dired, you are \"editing\" a list of the files in a directory.
You can move using the usual cursor motion commands.
Letters no longer insert themselves.
Instead, type d to flag a file for Deletion.
Type u to Unflag a file (remove its D flag).
  Type Rubout to back up one line and unflag.
Type x to eXecute the deletions requested.
Type f to Find the current line's file
  (or Dired it, if it is a directory).
Type o to find file or dired directory in Other window.
Type # to flag temporary files (names beginning with #) for Deletion.
Type ~ to flag backup files (names ending with ~) for Deletion.
Type . to flag numerical backups for Deletion.
  (Spares dired-kept-versions or its numeric argument.)
Type r to rename a file.
Type c to copy a file.
Type v to view a file in View mode, returning to Dired when done.
Type g to read the directory again.  This discards all deletion-flags.
Space and Rubout can be used to move down and up by lines.
Also: C -- compress this file.  U -- uncompress this file.
      B -- byte compile this file.
 M, G, O -- change file's mode, group or owner.

Verdix Environment Commands
  Library Management:
    Make and initialize a Verdix library under the   'C-c i'
      current directory with this lib as its parent.
    Print the VADS library search path               'C-c p'
    List all the VADS units in the library           'C-c C-l'
    Report on disk utilization of the library        'C-c u'
    Run a.make to make directory up to date          'M-x ada-make-all'
    Run a.ld to link an object file                  'C-c k'
    Reinitialize (a.cleanlib) the VADS library.      'C-c C-c'
    Make a script to rebuild the library          'M-x ada-make-rebuild-script'
         Run the script as well                      'M-x rebuild-ada-library'
    Remove the VADS library from this directory  'M-x dired-ada-remove-library'
  File and source management:
    Make a new Ada spec or body file                 'C-c n'
    Make new Ada spec and body files                 'C-c C-n'
    Load the already created tags file               'C-c C-t'
    Create/Update and load a tags file (via a.tags)  'C-c t'
    Run a.db (Verdix debugger) interactively         'C-c C-d'
      or                                             'M-x a-db'
  Single File Commands (also available in Ada Mode):
    Show recompilation order for file                'C-c r'
    Compile a file                                   'C-c c'
    Run a.make to make file up to date               'C-c m'
    Run a.make to make unit up to date               'C-c RET'
    List the VADS  units made from the current file  'C-c l'
    Remove VADS units made from the current file     'C-c C-r'
    Show dependencies of this file                   'C-c d'
       (in Unix 'make' format)
    Run the current executeable file                 'C-c x'
    Pretty Print the file                            <Not Yet Implimented>

When visiting an Ada source file, invoke mode help by typing 'C-c ?'.
This help will also let you know how to use the tags and online help facility.

---------------------- Customizations ------------------
These variables may be set in your .emacs file.
  ada-main-unit-name    (Default: \"\")
       Name of main language unit last used to link with a.ld.
  ada-compile-options            (Default: \"-v\")
       Options to ada compiler
  ada-make-options               (Default: \"-v\")
       Options to ada make
  ada-link-ld-options            (Default: \"\")
       Options to a.ld when linking.
  ada-link-unix-options          (Default: \"\")
       Options to Unix loader when linking.
  ada-ls-options                 (Default: \"-v\")
       Options passed to a.ls.
  ada-du-options                 (Default: \"-e -f -i\")
       Options passed to a.du.
  ada-run-options                (Default: \"\")
       Options pased to run programs
  ada-run-program                (Default: \"a.out\")
       The name of the program to be run by dired-ada-execute.
  ada-spec-suffix                (Default: \"-a.a\")
       Suffix presumed to exist on all Ada specification files.
  ada-body-suffix                (Default: \"-b.a\")
       Suffix presumed to exist on all Ada body files.
  ada-tags-options               (Default \"-t\")
       Options passed to a.tags.
  ada-tags-files                 (Default \"*.a\")
       Files passed to a.tags.
These can also be set interactively by 'M-x set-ada-options'.

---------------------- Future Enhancements -------------
    NON-VADS SYSTEMS! Please Help!
    Integration if Ian Baton's SCCS support
    Automatic making of compressed tar backups
    a.which? (should find and load the source/body (if univ arg).)
    a.which lookup and interactive prompting. You give me a substring,
       I will give you the choices.
    Pretty printing
    General VADS command execute
    mouse support

---------------------- Known Bugs ----------------------
Pretty print command not yet implimented.

---------------------- Support --------------------------
For help, training, questions, or other support, contact Lynn Slater
at extension 4482 or send a mail message to lrs@esl.

---- Summary of Ada Mode Special Commands under C-c ----

C-c             dired-ada-cleanup-library
C-d             dired-ada-debug-object-file
C-l             dired-ada-list-all
RET             ada-make-unit
C-n             dired-ada-new-files
C-r             dired-ada-remove-file
C-t             get-tags-for-ada-buffer
c               dired-ada-compile-file
d               dired-ada-library-dependencies
i               dired-ada-initialize-library
k               dired-ada-link
l               dired-ada-list
m               dired-ada-make-file
n               ada-new-file
p               dired-ada-path
r               dired-ada-recompilation-order
t               dired-ada-make-tags-for-program
u               dired-ada-disk-utilization
x               dired-ada-execute


----------- Summary of Normal Dired Commands  -----------

C-d             dired-flag-file-deleted
C-n             dired-next-line
C-p             dired-previous-line
SPC             dired-next-line
#               dired-flag-auto-save-files
-               negative-argument
.               dired-clean-directory
0 .. 9          digit-argument
?               dired-summary
B               dired-byte-recompile
C               dired-compress
D               dired-flag-matching-files
G               dired-chgrp
M               dired-chmod
O               dired-chown
U               dired-unflag-all-files
c               dired-copy-file
d               dired-flag-file-deleted
e .. f          dired-find-file
g               revert-buffer
h               describe-mode
n               dired-next-line
o               dired-find-file-other-window
p               dired-previous-line
r               dired-rename-file
u               dired-unflag
v               dired-view-file
x               dired-do-deletions
~               dired-flag-backup-files
DEL             dired-backup-unflag "
  ;;
  ;; I have a design tradeoff.  I want mode help to be complete, fast, and
  ;; general. The more complete, the longer, and thus the slower if \\[]
  ;; forms are used.  My cop-out solution is to have a complete and fast, but
  ;; not customizable mode help followed by a complete, slow, and general
  ;; mode help. When I make changes to dired, I delete the above string, 
  ;; reevaluate this fcn, go into dired-ada, get mode help, turn quotes into
  ;; \quotes, and insert the result as a string above.  I also insert it into
  ;; the ada-cmds file. Wasn't that obvious? :->
  ;;
  ;; Ideally, I would like to calculate the best documentation and 
  ;; (setf (documentation 'dired-ada-mode) ...), but this is not allowed.
  ;;
  "Mode for working with (Verdix) Ada library directories.

In dired, you are \"editing\" a list of the files in a directory.
You can move using the usual cursor motion commands.
Letters no longer insert themselves.
Instead, type d to flag a file for Deletion.
Type u to Unflag a file (remove its D flag).
  Type Rubout to back up one line and unflag.
Type x to eXecute the deletions requested.
Type f to Find the current line's file
  (or Dired it, if it is a directory).
Type o to find file or dired directory in Other window.
Type # to flag temporary files (names beginning with #) for Deletion.
Type ~ to flag backup files (names ending with ~) for Deletion.
Type . to flag numerical backups for Deletion.
  (Spares dired-kept-versions or its numeric argument.)
Type r to rename a file.
Type c to copy a file.
Type v to view a file in View mode, returning to Dired when done.
Type g to read the directory again.  This discards all deletion-flags.
Space and Rubout can be used to move down and up by lines.
Also: C -- compress this file.  U -- uncompress this file.
      B -- byte compile this file.
 M, G, O -- change file's mode, group or owner.

Verdix Environment Commands
  Library Management:
    Make and initialize a Verdix library under the   '\\[dired-ada-initialize-library]'
      current directory with this lib as its parent.
    Print the VADS library search path               '\\[dired-ada-path]'
    List all the VADS units in the library           '\\[dired-ada-list-all]'
    Report on disk utilization of the library        '\\[dired-ada-disk-utilization]'
    Run a.make to make directory up to date          '\\[ada-make-all]'
    Run a.ld to link an object file                  '\\[dired-ada-link]'
    Reinitialize (a.cleanlib) the VADS library.      '\\[dired-ada-cleanup-library]'
    Make a script to rebuild the library          '\\[ada-make-rebuild-script]'
         Run the script as well                      '\\[rebuild-ada-library]'
    Remove the VADS library from this directory  '\\[dired-ada-remove-library]'
  File and source management:
    Make a new Ada spec or body file                 '\\[ada-new-file]'
    Make new Ada spec and body files                 '\\[dired-ada-new-files]'
    Load the already created tags file               '\\[get-tags-for-ada-buffer]'
    Create/Update and load a tags file (via a.tags)  '\\[dired-ada-make-tags-for-program]'
    Run a.db (Verdix debugger) interactively         '\\[dired-ada-debug-object-file]'
      or                                             '\\[a-db]'
  Single File Commands (also available in Ada Mode):
    Show recompilation order for file                '\\[dired-ada-recompilation-order]'
    Compile a file                                   '\\[dired-ada-compile-file]'
    Run a.make to make file up to date               '\\[dired-ada-make-file]'
    Run a.make to make unit up to date               '\\[ada-make-unit]'
    List the VADS  units made from the current file  '\\[dired-ada-list]'
    Remove VADS units made from the current file     '\\[dired-ada-remove-file]'
    Show dependencies of this file                   '\\[dired-ada-library-dependencies]'
       (in Unix 'make' format)
    Run the current executeable file                 '\\[dired-ada-execute]'
    Pretty Print the file                            <Not Yet Implimented>

When visiting an Ada source file, invoke mode help by typing \\<ada-mode-map>'\\[describe-mode]'.
This help will also let you know how to use the tags and online help facility.

---------------------- Customizations ------------------
These variables may be set in your .emacs file.
  ada-main-unit-name    (Default: \"\")
       Name of main language unit last used to link with a.ld.
  ada-compile-options            (Default: \"-v\")
       Options to ada compiler
  ada-make-options               (Default: \"-v\")
       Options to ada make
  ada-link-ld-options            (Default: \"\")
       Options to a.ld when linking.
  ada-link-unix-options          (Default: \"\")
       Options to Unix loader when linking.
  ada-ls-options                 (Default: \"-v\")
       Options passed to a.ls.
  ada-du-options                 (Default: \"-e -f -i\")
       Options passed to a.du.
  ada-run-options                (Default: \"\")
       Options pased to run programs
  ada-run-program                (Default: \"a.out\")
       The name of the program to be run by dired-ada-execute.
  ada-spec-suffix                (Default: \"-a.a\")
       Suffix presumed to exist on all Ada specification files.
  ada-body-suffix                (Default: \"-b.a\")
       Suffix presumed to exist on all Ada body files.
  ada-tags-options               (Default \"-t\")
       Options passed to a.tags.
  ada-tags-files                 (Default \"*.a\")
       Files passed to a.tags.
These can also be set interactively by '\\[set-ada-options]'.

---------------------- Future Enhancements -------------
    NON-VADS SYSTEMS! Please Help!
    Integration if Ian Baton's SCCS support
    Automatic making of compressed tar backups
    a.which? (should find and load the source/body (if univ arg).)
    a.which lookup and interactive prompting. You give me a substring,
       I will give you the choices.
    Pretty printing
    General VADS command execute
    mouse support

---------------------- Known Bugs ----------------------
Pretty print command not yet implimented.

---------------------- Support --------------------------
For help, training, questions, or other support, contact Lynn Slater
at extension 4482 or send a mail message to lrs@esl.

---- Summary of Ada Mode Special Commands under C-c ----
\\{dired-ada-specific-mode-map}

----------- Summary of Normal Dired Commands  -----------
\\{dired-mode-map}
"
  (kill-all-local-variables)    
  (make-local-variable 'revert-buffer-function)
  (setq revert-buffer-function 'dired-ada-revert)
  (setq major-mode 'dired-ada-mode)
  (setq mode-name "Dired-Ada")
  ;; make our recursive finds always be in ada mode
  (make-local-variable 'ada-dired)
  (setq ada-dired t)
  
  (make-local-variable 'dired-directory)
  (setq dired-directory dirname)
  (setq default-directory 
	(if (file-directory-p dirname)
	    dirname (file-name-directory dirname)))
  (setq case-fold-search nil)
  (setq mode-line-format
	(concat "--Directory " dirname
		"      %M   %[(%m)%]----%p--%-"))

  (if (not dired-ada-specific-mode-map)
      (progn
	(setq dired-ada-specific-mode-map (make-keymap))
	;; Ada mode specific bindings
	(define-key dired-ada-specific-mode-map "\C-t" 'get-tags-for-ada-buffer)
	(define-key dired-ada-specific-mode-map "\C-r" 'dired-ada-remove-file)
	(define-key dired-ada-specific-mode-map "\C-m" 'ada-make-unit)
	;;(define-key dired-ada-specific-mode-map "\C-m" 'ada-make-all)
	(define-key dired-ada-specific-mode-map "\C-n" 'dired-ada-new-files)
	(define-key dired-ada-specific-mode-map "\C-l"  'dired-ada-list-all)
	(define-key dired-ada-specific-mode-map "\C-d" 'dired-ada-debug-object-file)
	(define-key dired-ada-specific-mode-map "\C-c" 'dired-ada-cleanup-library)

	(define-key dired-ada-specific-mode-map "x" 'dired-ada-execute)
	(define-key dired-ada-specific-mode-map "u" 'dired-ada-disk-utilization)
	(define-key dired-ada-specific-mode-map "t" 'dired-ada-make-tags-for-program)
	(define-key dired-ada-specific-mode-map "r" 'dired-ada-recompilation-order)
	(define-key dired-ada-specific-mode-map "p" 'dired-ada-path)
	(define-key dired-ada-specific-mode-map "n" 'ada-new-file)
	(define-key dired-ada-specific-mode-map "m" 'dired-ada-make-file)
	(define-key dired-ada-specific-mode-map "l" 'dired-ada-list)
	(define-key dired-ada-specific-mode-map "k" 'dired-ada-link)
	(define-key dired-ada-specific-mode-map "i" 'dired-ada-initialize-library)
	(define-key dired-ada-specific-mode-map "d" 'dired-ada-library-dependencies)
	(define-key dired-ada-specific-mode-map "c" 'dired-ada-compile-file)
	))

  (if (not dired-ada-mode-map)
      (progn
	;; The following line incorperates into dired-ada-mode the current
	;; state of dired-mode, including local changes.  Just be sure to
	;; install your local changes before loading this file, or to
	;; install the changes into both mode maps.
	(setq dired-ada-mode-map (copy-keymap dired-mode-map))
        (define-key dired-ada-mode-map "\C-c" dired-ada-specific-mode-map)
	))
  (setq buffer-read-only t)
  (use-local-map dired-ada-mode-map))

\f


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; make dired-ada be a minor mode
;;  Find-file uses dired-noselect
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar dired-ada-mode nil
  "If non nil, ALL directories are read in dired-ada mode even if they do
   not have by an ada.lib")

(if (not (fboundp 'dired-noselect-normal))
    (progn ;; wrap the old function
      (fset 'dired-noselect-normal
	    (symbol-function 'dired-noselect))))

(defun dired-noselect (dirname)
  "Like M-x dired but returns the dired buffer as value, does not select it.
   The buffer is either in dired-mode or dired-ada-mode depending upon the
   value of the dired-ada-mode variable and the existance of ada.lib."
  (funcall
    (if (or dired-ada-mode
	    (file-exists-p (expand-file-name "ada.lib" dirname)))
	'dired-ada-noselect 'dired-noselect-normal)
    dirname))

(defun ada-dired-mode ()
  "Makes directories be read in in dired-mode by default"
  (interactive)
  (setq dired-ada-mode (not dired-ada-mode))
  (message "Dired-ada mode is %s" (if dired-ada-mode "On" "Off")))

\f


(defun dired-ada-summary ()
  (interactive)
  (message
   "c-ompile, d-elete, f-ind, l-ink, m-ake, o-ther window, h-elp"))

(autoload 'dired-ada-menu-activate "dired-ada-menu"
	  "Activates the dired-ada menu of VADS & other functions")

(autoload 'visit-tags-table-ada "tags-ada"
	  "Loads the tags file and massages it for Emacs."
	  t)

(autoload 'goto-ada-tag "tags-ada"
	  "Given a Verdix Ada tag, locates it in a file."
	  t)

(autoload 'tags-ada-continue-search "tags-ada"
	  "Search for next occurrence of Ada tag in current file."
	  t)

(autoload 'a-db "a-db"
	  "Run a.db on program FILE in buffer *ada-db-FILE*."
	  t)