ada.el

早期freebsd实现

  (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.  exit statement 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 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 nbr the procedure/function keyword was found at."
  (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.
If starting after END-COMMENT-COLUMN, start a new line."
  (interactive)
  (end-of-line)
  (if (> (current-column) end-comment-column) (newline))
  (if (< (current-column) comment-column) (indent-to comment-column))
  (insert " -- "))

(defun ada-display-comment ()
"Inserts 3 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 adabind."
  (setq ada-bind-opts (read-string "-m and -i options for adabind: ")))

(defun ada-compile (ada-prefix-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 ada-prefix-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)))