view lisp/=ada.el @ 10219:d97313bb6f39

(bibtex-string, bibtex-preamble): Use forward-line. (sort-subr): Don't call autload for this--that's done in loaddefs.el. (bibtex-mode): Add autoload cookie. Changed keybinding for bibtex-print-help-message (from \C-ch to \C-c?). Therefore, describe-mode is not longer on \C-c?. Also, changed prefix \C-cn for bibtex-narrow functions to \C-c\C-r. (bibtex-string-files): Changed documentation. (bibtex-mode-map): Inscriptions of menu bar changed from "Entry Types" to "Entry-Types" and "Bibtex Edit" to "BibTeX-Edit". (bibtex-string-files): Changed documentation. (bibtex-mode): If environment variable BIBINPUTS isn't defined, string files are searched in the current directory. (bibtex-completion-candidates): Now buffer-local to allow evaluation of different bibtex-string-files in different buffers. (bibtex-autokey-edit-before-use, bibtex-clean-entry): New variable that determines, if the user is allowed to edit auto-generated reference keys before they are used. (bibtex-generate-autokey, bibtex-clean-entry): New function to generate an autokey if necessary. (bibtex-autokey-names, bibtex-autokey-name-change-strings, bibtex-autokey-name-length, bibtex-autokey-name-separator, bibtex-autokey-year-length, bibtex-autokey-titlewords, bibtex-autokey-title-terminators, bibtex-autokey-titlewords-stretch, bibtex-autokey-titleword-first-ignore, bibtex-autokey-titleword-abbrevs, bibtex-autokey-titleword-change-strings, bibtex-autokey-titleword-length, bibtex-autokey-titleword-separator, bibtex-autokey-name-year-separator, bibtex-autokey-year-title-separator): New variables related to bibtex-generate-autokey. (bibtex-find-entry-location): Optional second parameter maybedup to tell it that entering a duplicate entry isn't to report by an error but by the return value of the function (necessary for bibtex-clean-entry to find the correct position of an entry with an autogenerated key without disturbing the user with unwanted messages). (bibtex-help-message): New variable to avoid printing of help messages in the echo area. (assoc-of-regexp): New function to match an alist of regexps. (bibtex-string-files, bibtex-completion-candidates, bibtex-mode): New variables to allow bibtex-complete-string to work on strings initialized from a variable and from @String definitions in a list of files, too. (bibtex-predefined-strings, bibtex-entry-field-alist): Changed to user options. (bibtex-mode): Changed doc string. (many functions and variables): Changed documentation strings of variables and functions to hold a complete sentence in the first line. (bibtex-print-help-message): Now line dependent and reports if it is called outside a BibTeX field. (validate-bibtex-buffer): Completely rewritten to validate, if buffer is syntactically correct. (find-bibtex-duplicates): Moved into validate-bibtex-buffer. (ispell-abstract, bibtex-ispell-abstract, ispell-bibtex-entry, bibtex-ispell-entry, beginning-of-bibtex-entry, bibtex-beginning-of-entry, end-of-bibtex-entry, bibtex-end-of-entry, hide-bibtex-entry-bodies, bibtex-hide-entry-bodies, narrow-to-bibtex-entry, bibtex-narrow-to-entry, sort-bibtex-entries, bibtex-sort-entries, validate-bibtex-buffer, bibtex-validate-buffer, find-bibtex-entry-location, bibtex-find-entry-location): All interactive functions are renamed, so that any interface function begins with "bibtex-". Mapping: ispell-abstract --> bibtex-ispell-abstract ispell-bibtex-entry --> bibtex-ispell-entry beginning-of-bibtex-entry --> bibtex-beginning-of-entry end-of-bibtex-entry --> bibtex-end-of-entry hide-bibtex-entry-bodies --> bibtex-hide-entry-bodies narrow-to-bibtex-entry --> bibtex-narrow-to-entry sort-bibtex-entries --> bibtex-sort-entries validate-bibtex-buffer --> bibtex-validate-buffer find-bibtex-entry-location --> bibtex-find-entry-location (bibtex-maintain-sorted-entries, bibtex-sort-ignore-string-entries): Default is now t. (bibtex-complete-string): String list is built from additional string list bibtex-predefined-string and current strings in file. (string-equalp): Deleted and substituted by string-equal. (assoc-string-equalp): Renamed to assoc-ignore-case. (bibtex-entry): Reference key can be entered with completion. All reference keys that are defined in buffer and all labels that appear in crossreference entries are object to completion. (Entry types): Changed order of entries in menu "entry types". (bibtex-entry-field-alist): Changed order of entries slightly to be more conform with standard BibTeX style layouts. (bibtex-mode-map): Uniform keybindings for \C-c\C-e prefix (often used types on control keys, sometimes used types on normal keys, rarely used types on shift keys, almost never used types on meta keys). (bibtex-mode-map): Function narrow-to-bibtex-entry and counterpart widen and function hide-bibtex-entry-bodies and counterpart show-all bounded to appropriate local keys. (bibtex-abbrev-table): Deleted (bibtex-current-entry-label, put-string-on-kill-ring): Deleted (AUCTeX provides all the functionality needed for citation completion). (bibtex-enclosing-reference, bibtex-pop-previous, bibtex-pop-next, bibtex-clean-entry): Hacked for speed (bibtex-pop-previous and bibtex-pop-next were to slow for larger BibTeX files). (bibtex-pop-previous, bibtex-pop-next): Delimiters from previous or next entry are changed to actual delimters if necessary. (bibtex-entry): Fixed bug (False entry wasn't reported in error message if bibtex-entry was called with undefined reference name). (bibtex-entry-field-alist, bibtex-entry, bibtex-make-field, bibtex-next-field, bibtex-clean-entry): Every reference entry now contains a comment in addition to the name of the reference. This comment appears in the echo area if you start editing that field (after calling bibtex-next-field). (bibtex-include-OPTcrossref, bibtex-entry): Changed bibtex-include-OPTcrossref from single boolean variable to hold a list of reference names which should have a crossref field. (bibtex-complete-word): New function, which completes word fragment before point to the longest prefix of predefined strings in the buffer in the same way that ispell-complete-word operates for words found in the dictionary. (bibtex-reference-head): Start of bibtex-reference-head changed from "^[ \t]*\\(" to "^\\( \\|\t\\)*\\(" (bibtex-pop-previous and bibtex-pop-next didn't work, probably due to a bug in re-search-forward). (several functions): Added support for {} as field delimiters (better than '"' for accented characters. (bibtex-clean-entry): If optional field crossref is empty or missing, former optional fields (if bibtex-include-OPTcrossref was t) are necessary again. bibtex-clean-entry complains if they are empty but not if they are missing, so you can intenionally omit them, e. g. for a pseudo @Journal entry (needed for crossreferences) made out of an @article with missing non-optional fields. Menu bar entries aren't centered anymore.

;;; ada.el --- Ada editing support package in GNUlisp.  v1.0

;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.

;; Author: Vincent Broman <[e-mail]>
;; Keywords: languages

;; 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 2, 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; Created May 1987.
;; (borrows heavily from Mick Jordan's Modula-2 package for GNU,
;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)

;;; Code:

(defvar ada-mode-syntax-table nil
  "Syntax table in use in Ada-mode buffers.")

(let ((table (make-syntax-table)))
  (modify-syntax-entry ?_ "_" table)
  (modify-syntax-entry ?\# "_" table)
  (modify-syntax-entry ?\( "()" table)
  (modify-syntax-entry ?\) ")(" table)
  (modify-syntax-entry ?$ "." table)
  (modify-syntax-entry ?* "." table)
  (modify-syntax-entry ?/ "." table)
  (modify-syntax-entry ?+ "." table)
  (modify-syntax-entry ?- ". 12" table)
  (modify-syntax-entry ?= "." table)
  (modify-syntax-entry ?\& "." table)
  (modify-syntax-entry ?\| "." table)
  (modify-syntax-entry ?< "." table)
  (modify-syntax-entry ?> "." table)
  (modify-syntax-entry ?\[ "." table)
  (modify-syntax-entry ?\] "." table)
  (modify-syntax-entry ?\{ "." table)
  (modify-syntax-entry ?\} "." table)
  (modify-syntax-entry ?. "." table)
  (modify-syntax-entry ?\\ "." table)
  (modify-syntax-entry ?: "." table)
  (modify-syntax-entry ?\; "." table)
  (modify-syntax-entry ?\' "." table)
  (modify-syntax-entry ?\" "\"" table)
  (modify-syntax-entry ?\n ">" table)
  (setq ada-mode-syntax-table table))

;; Strings are a real pain in Ada because both ' and " can appear in a
;; non-string quote context (the former as an operator, the latter as a
;; character string).  We follow the least losing solution, in which only " is
;; a string quote.  Therefore a character string of the form '"' will throw
;; fontification off on the wrong track.

(defconst ada-font-lock-keywords-1
  (list
   ;;
   ;; Function, package (body), pragma, procedure, task (body) plus name.
   (list (concat "\\<\\("
		 "function\\|"
		 "p\\(ackage\\(\\|[ \t]+body\\)\\|r\\(agma\\|ocedure\\)\\)\\|"
		 "task\\(\\|[ \t]+body\\)"
		 "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
	 '(1 font-lock-keyword-face) '(6 font-lock-function-name-face nil t)))
  "For consideration as a value of `ada-font-lock-keywords'.
This does fairly subdued highlighting.")

(defconst ada-font-lock-keywords-2
  (append ada-font-lock-keywords-1
   (list
    ;;
    ;; Main keywords, except those treated specially below.
    (concat "\\<\\("
;    ("abort" "abs" "abstract" "accept" "access" "aliased" "all"
;     "and" "array" "at" "begin" "case" "declare" "delay" "delta"
;     "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
;     "generic" "if" "in" "is" "limited" "loop" "mod" "not"
;     "null" "or" "others" "private" "protected"
;     "range" "record" "rem" "renames" "requeue" "return" "reverse"
;     "select" "separate" "tagged" "task" "terminate" "then" "until"
;     "while" "xor")
	    "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|"
	    "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|"
	    "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|"
	    "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|"
	    "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|"
	    "o\\(r\\|thers\\)\\|pr\\(ivate\\|otected\\)\\|"
	    "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
	    "se\\(lect\\|parate\\)\\|"
	    "t\\(a\\(gged\\|sk\\)\\|erminate\\|hen\\)\\|until\\|while\\|xor"
	    "\\)\\>")
    ;;
    ;; Anything following end and not already fontified is a body name.
    '("\\<\\(end\\)\\>[ \t]*\\(\\sw+\\)?"
      (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
;    ;;
;    ;; Variable name plus optional keywords followed by a type name.  Slow.
;    (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:"
;		  "[ \t]*\\(constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*"
;		  "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
;	  '(1 font-lock-variable-name-face)
;	  '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t))
    ;;
    ;; Optional keywords followed by a type name.
    (list (concat ":[ \t]*\\<\\(constant\\|in\\|in[ \t]+out\\|out\\)\\>?[ \t]*"
		  "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
	  '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
    ;;
    ;; Keywords followed by a type or function name.
    (list (concat "\\<\\("
		  "new\\|of\\|subtype\\|type"
		  "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?")
	  '(1 font-lock-keyword-face)
	  '(2 (if (match-beginning 4)
		  font-lock-function-name-face
		font-lock-type-face) nil t))
    ;;
    ;; Keywords followed by a reference.
    (list (concat "\\<\\(goto\\|raise\\|use\\|when\\|with\\)\\>"
		  "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
	  '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
    ;;
    ;; Goto tags.
    '("<<\\(\\sw+\\(\\.\\sw*\\)*\\)>>" 1 font-lock-reference-face)
    ))
  "For consideration as a value of `ada-font-lock-keywords'.
This does a lot more highlighting.")

(defvar ada-font-lock-keywords ada-font-lock-keywords-1
  "Additional expressions to highlight in Ada mode.")

(defvar ada-mode-map nil
  "Keymap used in Ada mode.")

(let ((map (make-sparse-keymap)))
  (define-key map "\C-m" 'ada-newline)
  (define-key map "\C-?" 'backward-delete-char-untabify)
  (define-key map "\C-i" 'ada-tab)
  (define-key map "\C-c\C-i" 'ada-untab)
  (define-key map "\C-c<" 'ada-backward-to-same-indent)
  (define-key map "\C-c>" 'ada-forward-to-same-indent)
  (define-key map "\C-ch" 'ada-header)
  (define-key map "\C-c(" 'ada-paired-parens)
  (define-key map "\C-c-" 'ada-inline-comment)
  (define-key map "\C-c\C-a" 'ada-array)
  (define-key map "\C-cb" 'ada-exception-block)
  (define-key map "\C-cd" 'ada-declare-block)
  (define-key map "\C-c\C-e" 'ada-exception)
  (define-key map "\C-cc" 'ada-case)
  (define-key map "\C-c\C-k" 'ada-package-spec)
  (define-key map "\C-ck" 'ada-package-body)
  (define-key map "\C-c\C-p" 'ada-procedure-spec)
  (define-key map "\C-cp" 'ada-subprogram-body)
  (define-key map "\C-c\C-f" 'ada-function-spec)
  (define-key map "\C-cf" 'ada-for-loop)
  (define-key map "\C-cl" 'ada-loop)
  (define-key map "\C-ci" 'ada-if)
  (define-key map "\C-cI" 'ada-elsif)
  (define-key map "\C-ce" 'ada-else)
  (define-key map "\C-c\C-v" 'ada-private)
  (define-key map "\C-c\C-r" 'ada-record)
  (define-key map "\C-c\C-s" 'ada-subtype)
  (define-key map "\C-cs" 'ada-separate)
  (define-key map "\C-c\C-t" 'ada-type)
  (define-key map "\C-ct" 'ada-tabsize)
;;    (define-key map "\C-c\C-u" 'ada-use)
;;    (define-key map "\C-c\C-w" 'ada-with)
  (define-key map "\C-cw" 'ada-while-loop)
  (define-key map "\C-c\C-w" 'ada-when)
  (define-key map "\C-cx" 'ada-exit)
  (define-key map "\C-cC" 'ada-compile)
  (define-key map "\C-cB" 'ada-bind)
  (define-key map "\C-cE" 'ada-find-listing)
  (define-key map "\C-cL" 'ada-library-name)
  (define-key map "\C-cO" 'ada-options-for-bind)
  (setq ada-mode-map map))

(defvar ada-indent 4 "*Value is the number of columns to indent in Ada-Mode.")

(defvar ada-comment-end-column)

;;;###autoload
(defun ada-mode ()
"This is a mode intended to support program development in Ada.
Most control constructs and declarations of Ada can be inserted in the buffer
by typing Control-C followed by a character mnemonic for the construct.

\\<ada-mode-map>\\[ada-array] array         	\\[ada-exception-block]    exception block
\\[ada-exception]  exception      \\[ada-declare-block]    declare block
\\[ada-package-spec]  package spec   \\[ada-package-body]    package body
\\[ada-procedure-spec]  procedure spec \\[ada-subprogram-body]    proc/func body
\\[ada-function-spec]  func spec      \\[ada-for-loop]    for loop
                        \\[ada-if]    if
                        \\[ada-elsif]    elsif
                        \\[ada-else]    else
\\[ada-private]  private        \\[ada-loop]    loop
\\[ada-record]  record         \\[ada-case]    case
\\[ada-subtype]  subtype        \\[ada-separate]    separate
\\[ada-type]  type           \\[ada-tabsize]    tab spacing for indents
\\[ada-when]  when           \\[ada-while]    while
                        \\[ada-exit]    exit
\\[ada-paired-parens]    paired parens  \\[ada-inline-comment]    inline comment
                        \\[ada-header]    header spec
\\[ada-compile]    compile        \\[ada-bind]    bind
\\[ada-find-listing]    find error list
\\[ada-library-name]    name library   \\[ada-options-for-bind]    options for bind

\\[ada-backward-to-same-indent] and \\[ada-forward-to-same-indent] move backward and forward respectively to the next line
having the same (or lesser) level of indentation.

Variable `ada-indent' controls the number of spaces for indent/undent."
  (interactive)
  (kill-all-local-variables)
  (use-local-map ada-mode-map)
  (setq major-mode 'ada-mode)
  (setq mode-name "Ada")
  (make-local-variable 'comment-column)
  (setq comment-column 41)
  (make-local-variable 'ada-comment-end-column)
  (setq ada-comment-end-column 72)
  (set-syntax-table ada-mode-syntax-table)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "^$\\|" page-delimiter))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (setq paragraph-ignore-fill-prefix t)
;  (make-local-variable 'indent-line-function)
;  (setq indent-line-function 'c-indent-line)
  (make-local-variable 'require-final-newline)
  (setq require-final-newline t)
  (make-local-variable 'comment-start)
  (setq comment-start "--")
  (make-local-variable 'comment-end)
  (setq comment-end "")
  (make-local-variable 'comment-column)
  (setq comment-column 41)
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "--+ *")
  (make-local-variable 'comment-indent-function)
  (setq comment-indent-function 'c-comment-indent)
  (make-local-variable 'parse-sexp-ignore-comments)
  (setq parse-sexp-ignore-comments t)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(ada-font-lock-keywords nil t ((?\_ . "w"))))
  (run-hooks 'ada-mode-hook))

(defun ada-tabsize (s)
  "Changes spacing used for indentation.
The prefix argument is used as the new spacing."
  (interactive "p")
  (setq ada-indent s))

(defun ada-newline ()
  "Start new line and indent to current tab stop."
  (interactive)
  (let ((ada-cc (current-indentation)))
    (newline)
    (indent-to ada-cc)))

(defun ada-tab ()
  "Indent to next tab stop."
  (interactive)
  (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent)))

(defun ada-untab ()
  "Delete backwards to previous tab stop."
  (interactive)
  (backward-delete-char-untabify ada-indent nil))

(defun ada-go-to-this-indent (step indent-level)
  "Move point repeatedly by STEP lines until the current line has
given INDENT-LEVEL or less, or the start or end of the buffer is reached.
Ignore blank lines, statement labels and block or loop names."
  (while (and
	  (zerop (forward-line step))
	  (or (looking-at "^[ 	]*$")
	      (looking-at "^[ 	]*--")
	      (looking-at "^<<[A-Za-z0-9_]+>>")
	      (looking-at "^[A-Za-z0-9_]+:")
	      (> (current-indentation) indent-level)))
    nil))

(defun ada-backward-to-same-indent ()
  "Move point backwards to nearest line with same indentation or less.
If not found, point is left at the top of the buffer."
  (interactive)
  (ada-go-to-this-indent -1 (current-indentation))
  (back-to-indentation))

(defun ada-forward-to-same-indent ()
  "Move point forwards to nearest line with same indentation or less.
If not found, point is left at the start of the last line in the buffer."
  (interactive)
  (ada-go-to-this-indent 1 (current-indentation))
  (back-to-indentation))

(defun ada-array ()
  "Insert array type definition.  Uses the minibuffer to prompt
for component type and index subtypes."
  (interactive)
  (insert "array ()")
  (backward-char)
  (insert (read-string "index subtype[s]: "))
  (end-of-line)
  (insert " of ;")
  (backward-char)
  (insert (read-string "component-type: "))
  (end-of-line))

(defun ada-case ()
  "Build skeleton case statement.
Uses the minibuffer to prompt for the selector expression.
Also builds the first when clause."
  (interactive)
  (insert "case ")
  (insert (read-string "selector expression: ") " is")
  (ada-newline)
  (ada-newline)
  (insert "end case;")
  (end-of-line 0)
  (ada-tab)
  (ada-tab)
  (ada-when))

(defun ada-declare-block ()
  "Insert a block with a declare part.
Indent for the first declaration."
  (interactive)
  (let ((ada-block-name (read-string "[block name]: ")))
    (insert "declare")
    (cond
     ( (not (string-equal ada-block-name ""))
       (beginning-of-line)
       (open-line 1)
       (insert ada-block-name ":")
       (next-line 1)
       (end-of-line)))
    (ada-newline)
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (ada-newline)
    (if (string-equal ada-block-name "")
	(insert "end;")
      (insert "end " ada-block-name ";"))
    )
  (end-of-line -2)
  (ada-tab))

(defun ada-exception-block ()
  "Insert a block with an exception part.
Indent for the first line of code."
  (interactive)
  (let ((block-name (read-string "[block name]: ")))
    (insert "begin")
    (cond
     ( (not (string-equal block-name ""))
       (beginning-of-line)
       (open-line 1)
       (insert block-name ":")
       (next-line 1)
       (end-of-line)))
    (ada-newline)
    (ada-newline)
    (insert "exception")
    (ada-newline)
    (ada-newline)
    (cond
     ( (string-equal block-name "")
       (insert "end;"))
     ( t
       (insert "end " block-name ";")))
    )
  (end-of-line -2)
  (ada-tab))

(defun ada-exception ()
  "Insert an indented exception part into a block."
  (interactive)
  (ada-untab)
  (insert "exception")
  (ada-newline)
  (ada-tab))

(defun ada-else ()
  "Add an else clause inside an if-then-end-if clause."
  (interactive)
  (ada-untab)
  (insert "else")
  (ada-newline)
  (ada-tab))

(defun ada-exit ()
  "Insert an exit statement, prompting for loop name and condition."
  (interactive)
  (insert "exit")
  (let ((ada-loop-name (read-string "[name of loop to exit]: ")))
    (if (not (string-equal ada-loop-name "")) (insert " " ada-loop-name)))
  (let ((ada-exit-condition (read-string "[exit condition]: ")))
    (if (not (string-equal ada-exit-condition ""))
	(if (string-match "^ *[Ww][Hh][Ee][Nn] +" ada-exit-condition)
	    (insert " " ada-exit-condition)
	  (insert " when " ada-exit-condition))))
  (insert ";"))

(defun ada-when ()
  "Start a case statement alternative with a when clause."
  (interactive)
  (ada-untab)     ; we were indented in code for the last alternative.
  (insert "when ")
  (insert (read-string "'|'-delimited choice list: ") " =>")
  (ada-newline)
  (ada-tab))

(defun ada-for-loop ()
  "Build a skeleton for-loop statement, prompting for the loop parameters."
  (interactive)
  (insert "for ")
  (let* ((ada-loop-name (read-string "[loop name]: "))
	 (ada-loop-is-named (not (string-equal ada-loop-name ""))))
    (if ada-loop-is-named
	(progn
	  (beginning-of-line)
	  (open-line 1)
	  (insert ada-loop-name ":")
	  (next-line 1)
	  (end-of-line 1)))
    (insert (read-string "loop variable: ") " in ")
    (insert (read-string "range: ") " loop")
    (ada-newline)
    (ada-newline)
    (insert "end loop")
    (if ada-loop-is-named (insert " " ada-loop-name))
    (insert ";"))
  (end-of-line 0)
  (ada-tab))

(defun ada-header ()
  "Insert a comment block containing the module title, author, etc."
  (interactive)
  (insert "--\n--  Title: \t")
  (insert (read-string "Title: "))
  (insert "\n--  Created:\t" (current-time-string))
  (insert "\n--  Author: \t" (user-full-name))
  (insert "\n--\t\t<" (user-login-name) "@" (system-name) ">\n--\n"))

(defun ada-if ()
  "Insert skeleton if statment, prompting for a boolean-expression."
  (interactive)
  (insert "if ")
  (insert (read-string "condition: ") " then")
  (ada-newline)
  (ada-newline)
  (insert "end if;")
  (end-of-line 0)
  (ada-tab))

(defun ada-elsif ()
  "Add an elsif clause to an if statement, prompting for the boolean-expression."
  (interactive)
  (ada-untab)
  (insert "elsif ")
  (insert (read-string "condition: ") " then")
  (ada-newline)
  (ada-tab))

(defun ada-loop ()
  "Insert a skeleton loop statement.  The exit statement is added by hand."
  (interactive)
  (insert "loop ")
  (let* ((ada-loop-name (read-string "[loop name]: "))
	 (ada-loop-is-named (not (string-equal ada-loop-name ""))))
    (if ada-loop-is-named
	(progn
	  (beginning-of-line)
	  (open-line 1)
	  (insert ada-loop-name ":")
	  (forward-line 1)
	  (end-of-line 1)))
    (ada-newline)
    (ada-newline)
    (insert "end loop")
    (if ada-loop-is-named (insert " " ada-loop-name))
    (insert ";"))
  (end-of-line 0)
  (ada-tab))

(defun ada-package-spec ()
  "Insert a skeleton package specification."
  (interactive)
  (insert "package ")
  (let ((ada-package-name (read-string "package name: " )))
    (insert ada-package-name " is")
    (ada-newline)
    (ada-newline)
    (insert "end " ada-package-name ";")
    (end-of-line 0)
    (ada-tab)))

(defun ada-package-body ()
  "Insert a skeleton package body --  includes a begin statement."
  (interactive)
  (insert "package body ")
  (let ((ada-package-name (read-string "package name: " )))
    (insert ada-package-name " is")
    (ada-newline)
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (insert "end " ada-package-name ";")
    (end-of-line -1)
    (ada-tab)))

(defun ada-private ()
  "Undent and start a private section of a package spec. Reindent."
  (interactive)
  (ada-untab)
  (insert "private")
  (ada-newline)
  (ada-tab))

(defun ada-get-arg-list ()
  "Read from the user a procedure or function argument list.
Add parens unless arguments absent, and insert into buffer.
Individual arguments are arranged vertically if entered one at a time.
Arguments ending with `;' are presumed single and stacked."
  (insert " (")
  (let ((ada-arg-indent (current-column))
	(ada-args (read-string "[arguments]: ")))
    (if (string-equal ada-args "")
	(backward-delete-char 2)
      (progn
	(while (string-match ";$" ada-args)
	  (insert ada-args)
	  (newline)
	  (indent-to ada-arg-indent)
	  (setq ada-args (read-string "next argument: ")))
	(insert ada-args ")")))))

(defun ada-function-spec ()
  "Insert a function specification.  Prompts for name and arguments."
  (interactive)
  (insert "function ")
  (insert (read-string "function name: "))
  (ada-get-arg-list)
  (insert " return ")
  (insert (read-string "result type: ")))

(defun ada-procedure-spec ()
  "Insert a procedure specification, prompting for its name and arguments."
  (interactive)
  (insert "procedure ")
  (insert (read-string "procedure name: " ))
  (ada-get-arg-list))

(defun get-ada-subprogram-name ()
  "Return (without moving point or mark) a pair whose CAR is the name of
the function or procedure whose spec immediately precedes point, and whose
CDR is the column number where the procedure/function keyword was found."
  (save-excursion
    (let ((ada-proc-indent 0))
      (if (re-search-backward
  ;;;; Unfortunately, comments are not ignored in this string search.
	     "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t)
	  (if (or (looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>")
		  (looking-at "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>"))
	      (progn
		(setq ada-proc-indent (current-column))
		(forward-word 2)
		(let ((p2 (point)))
		  (forward-word -1)
		  (cons (buffer-substring (point) p2) ada-proc-indent)))
	      (get-ada-subprogram-name))
	   (cons "NAME?" ada-proc-indent)))))

(defun ada-subprogram-body ()
  "Insert frame for subprogram body.
Invoke right after `ada-function-spec' or `ada-procedure-spec'."
  (interactive)
  (insert " is")
  (let ((ada-subprogram-name-col (get-ada-subprogram-name)))
    (newline)
    (indent-to (cdr ada-subprogram-name-col))
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (ada-newline)
    (insert "end " (car ada-subprogram-name-col) ";"))
  (end-of-line -2)
  (ada-tab))

(defun ada-separate ()
  "Finish a body stub with `is separate'."
  (interactive)
  (insert " is")
  (ada-newline)
  (ada-tab)
  (insert "separate;")
  (ada-newline)
  (ada-untab))

;(defun ada-with ()
;  "Inserts a with clause, prompting for the list of units depended upon."
;  (interactive)
;  (insert "with ")
;  (insert (read-string "list of units depended upon: ") ";"))
;
;(defun ada-use ()
;  "Inserts a use clause, prompting for the list of packages used."
;  (interactive)
;  (insert "use ")
;  (insert (read-string "list of packages to use: ") ";"))

(defun ada-record ()
  "Insert a skeleton record type declaration."
  (interactive)
  (insert "record")
  (ada-newline)
  (ada-newline)
  (insert "end record;")
  (end-of-line 0)
  (ada-tab))

(defun ada-subtype ()
  "Start insertion of a subtype declaration, prompting for the subtype name."
  (interactive)
  (insert "subtype " (read-string "subtype name: ") " is ;")
  (backward-char)
  (message "insert subtype indication."))

(defun ada-type ()
  "Start insertion of a type declaration, prompting for the type name."
  (interactive)
  (insert "type " (read-string "type name: "))
  (let ((disc-part (read-string "discriminant specs: ")))
    (if (not (string-equal disc-part ""))
	(insert "(" disc-part ")")))
  (insert " is ")
  (message "insert type definition."))

(defun ada-while-loop ()
  (interactive)
  (insert "while ")
  (let* ((ada-loop-name (read-string "loop name: "))
	 (ada-loop-is-named (not (string-equal ada-loop-name ""))))
    (if ada-loop-is-named
	(progn
	  (beginning-of-line)
	  (open-line 1)
	  (insert ada-loop-name ":")
	  (next-line 1)
	  (end-of-line 1)))
    (insert (read-string "entry condition: ") " loop")
    (ada-newline)
    (ada-newline)
    (insert "end loop")
    (if ada-loop-is-named (insert " " ada-loop-name))
    (insert ";"))
  (end-of-line 0)
  (ada-tab))

(defun ada-paired-parens ()
  "Insert a pair of round parentheses, placing point between them."
  (interactive)
  (insert "()")
  (backward-char))

(defun ada-inline-comment ()
  "Start a comment after the end of the line, indented at least
`comment-column' spaces.  If starting after `end-comment-column',
start a new line."
  (interactive)
  (end-of-line)
  (if (> (current-column) ada-comment-end-column) (newline))
  (if (< (current-column) comment-column) (indent-to comment-column))
  (insert " -- "))

(defun ada-display-comment ()
"Inserts three comment lines, making a display comment."
  (interactive)
  (insert "--\n-- \n--")
  (end-of-line 0))

;; Much of this is specific to Ada-Ed

(defvar ada-lib-dir-name "lib" "*Current Ada program library directory.")
(defvar ada-bind-opts "" "*Options to supply for binding.")

(defun ada-library-name (ada-lib-name)
  "Specify name of Ada library directory for later compilations."
  (interactive "DName of Ada library directory: ")
  (setq ada-lib-dir-name ada-lib-name))

(defun ada-options-for-bind ()
  "Specify options, such as -m and -i, needed for `ada-bind'."
  (setq ada-bind-opts (read-string "-m and -i options for `ada-bind': ")))

(defun ada-compile (arg)
  "Save the current buffer and compile it into the current program library.
Initialize the library if a prefix arg is given."
  (interactive "P")
  (let* ((ada-init (if (null arg) "" "-n "))
	(ada-source-file (buffer-name)))
    (compile
     (concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file))))

(defun ada-find-listing ()
  "Find listing file for ada source in current buffer, using other window."
  (interactive)
  (find-file-other-window (concat (substring (buffer-name) 0 -4) ".lis"))
  (search-forward "*** ERROR"))

(defun ada-bind ()
  "Bind the current program library, using the current binding options."
  (interactive)
  (compile (concat "adabind " ada-bind-opts " " ada-lib-dir-name)))

;;; ada.el ends here