diff options
Diffstat (limited to 'lisp/=ada.el')
| -rw-r--r-- | lisp/=ada.el | 734 |
1 files changed, 0 insertions, 734 deletions
diff --git a/lisp/=ada.el b/lisp/=ada.el deleted file mode 100644 index bf7633bf82d..00000000000 --- a/lisp/=ada.el +++ /dev/null @@ -1,734 +0,0 @@ -;;; ada.el --- Ada editing support package in GNUlisp. v1.0 - -;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. - -;; Author: Vincent Broman <broman@bugs.nosc.mil> -;; 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 (if font-lock-maximum-decoration - ada-font-lock-keywords-2 - 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) - -(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 |