4.4BSD/usr/src/contrib/emacs-18.57/lisp/ada.elc

(setq auto-mode-alist (cons (cons "\\.ada$" (quote ada-mode)) auto-mode-alist))

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

(let ((table (make-syntax-table))) (modify-syntax-entry 95 "_" table) (modify-syntax-entry 35 "_" table) (modify-syntax-entry 40 "()" table) (modify-syntax-entry 41 ")(" table) (modify-syntax-entry 36 "." table) (modify-syntax-entry 42 "." table) (modify-syntax-entry 47 "." table) (modify-syntax-entry 43 "." table) (modify-syntax-entry 45 "." table) (modify-syntax-entry 61 "." table) (modify-syntax-entry 38 "." table) (modify-syntax-entry 124 "." table) (modify-syntax-entry 60 "." table) (modify-syntax-entry 62 "." table) (modify-syntax-entry 91 "." table) (modify-syntax-entry 93 "." table) (modify-syntax-entry 123 "." table) (modify-syntax-entry 125 "." table) (modify-syntax-entry 46 "." table) (modify-syntax-entry 92 "." table) (modify-syntax-entry 58 "." table) (modify-syntax-entry 59 "." table) (modify-syntax-entry 39 "." table) (modify-syntax-entry 34 "\"" table) (setq ada-mode-syntax-table table))

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

(let ((map (make-sparse-keymap))) (define-key map "
" (quote ada-newline)) (define-key map "" (quote backward-delete-char-untabify)) (define-key map "	" (quote ada-tab)) (define-key map "	" (quote ada-untab)) (define-key map "<" (quote ada-backward-to-same-indent)) (define-key map ">" (quote ada-forward-to-same-indent)) (define-key map "h" (quote ada-header)) (define-key map "(" (quote ada-paired-parens)) (define-key map "-" (quote ada-inline-comment)) (define-key map "
" (quote ada-array)) (define-key map "b" (quote ada-exception-block)) (define-key map "d" (quote ada-declare-block)) (define-key map "" (quote ada-exception)) (define-key map "c" (quote ada-case)) (define-key map "" (quote ada-package-spec)) (define-key map "k" (quote ada-package-body)) (define-key map "" (quote ada-procedure-spec)) (define-key map "p" (quote ada-subprogram-body)) (define-key map "" (quote ada-function-spec)) (define-key map "f" (quote ada-for-loop)) (define-key map "l" (quote ada-loop)) (define-key map "i" (quote ada-if)) (define-key map "I" (quote ada-elsif)) (define-key map "e" (quote ada-else)) (define-key map "" (quote ada-private)) (define-key map "" (quote ada-record)) (define-key map "" (quote ada-subtype)) (define-key map "s" (quote ada-separate)) (define-key map "" (quote ada-type)) (define-key map "t" (quote ada-tabsize)) (define-key map "w" (quote ada-while-loop)) (define-key map "" (quote ada-when)) (define-key map "x" (quote ada-exit)) (define-key map "C" (quote ada-compile)) (define-key map "B" (quote ada-bind)) (define-key map "E" (quote ada-find-listing)) (define-key map "L" (quote ada-library-name)) (define-key map "O" (quote ada-options-for-bind)) (setq ada-mode-map map))

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

(defun ada-mode nil "\
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.

C-c C-a  array         	C-c b    exception block
C-c C-e  exception      C-c d    declare block
C-c C-k  package spec   C-c k    package body
C-c C-p  procedure spec C-c p    proc/func body
C-c C-f  func spec      C-c f    for loop
                        C-c i    if
                        C-c I    elsif
                        C-c e    else
C-c C-v  private        C-c l    loop
C-c C-r  record         C-c c    case
C-c C-s  subtype        C-c s    separate
C-c C-t  type           C-c t    tab spacing for indents
C-c C-w  when           C-c w    while
                        C-c x    exit
C-c (    paired parens  C-c -    inline comment
                        C-c h    header sec
C-c C    compile        C-c B    bind
C-c E    find error list
C-c L    name library   C-c O    options for bind

C-c < and C-c > 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.

\\{ada-mode-map}
" (interactive) (byte-code "ÑˆÒ ˆÓ!ˆÔ‰ˆÕ‰ˆÖÃ!ˆ×‰ˆÖÄ!ˆØ‰ˆÙ
!ˆÖÆ!ˆÚP‰ˆÖÈ!ˆ‰ˆÖÉ!ˆÊ‰	ˆÖË!ˆÊ‰ˆÖÌ!ˆÛ‰ˆÖÍ!ˆÜ‰
ˆÖÃ!ˆ×‰ˆÖÎ!ˆÝ‰ˆÖÏ!ˆÞ‰ˆÖÐ!ˆÊ‰ˆßà!‡" [ada-mode-map major-mode mode-name comment-column end-comment-column ada-mode-syntax-table paragraph-start page-delimiter paragraph-separate paragraph-ignore-fill-prefix t require-final-newline comment-start comment-end comment-start-skip comment-indent-hook parse-sexp-ignore-comments nil kill-all-local-variables use-local-map ada-mode "Ada" make-local-variable 41 72 set-syntax-table "^$\\|" "--" "
" "--+ *" c-comment-indent run-hooks ada-mode-hook] 17))

(defun ada-tabsize (s) "\
changes spacing used for indentation. Reads spacing from minibuffer." (interactive "nnew indentation spacing: ") (byte-code "ˆ	‰‡" [ada-indent s nil] 2))

(defun ada-newline nil "\
Start new line and indent to current tab stop." (interactive) (byte-code "ÁˆÂ à ˆj)‡" [ada-cc nil current-indentation newline] 3))

(defun ada-tab nil "\
Indent to next tab stop." (interactive) (byte-code "ÁˆÂÃÄ \"T\"j‡" [ada-indent nil * / current-indentation] 5))

(defun ada-untab nil "\
Delete backwards to previous tab stop." (interactive) (byte-code "ÁˆÂÁ\"‡" [ada-indent nil backward-delete-char-untabify] 3))

(defun ada-go-to-this-indent (step indent-level) "\
Move point repeatedly by <step> lines till the current line
has given indent-level or less, or the start/end of the buffer is hit.
Ignore blank lines, statement labels, block/loop names." (byte-code "ÃÄ!!…$ÅÆ!†$ÅÇ!†$ÅÈ!†$ÅÉ!†$Ê 	V…,ˆ‚‡" [step indent-level nil zerop forward-line looking-at "^[ 	]*$" "^[ 	]*--" "^<<[A-Za-z0-9_]+>>" "^[A-Za-z0-9_]+:" current-indentation] 9))

(defun ada-backward-to-same-indent nil "\
Move point backwards to nearest line with same indentation or less.
If not found, point is left at top of buffer." (interactive) (byte-code "ÀˆÁÂà \"ˆÄ ‡" [nil ada-go-to-this-indent -1 current-indentation back-to-indentation] 4))

(defun ada-forward-to-same-indent nil "\
Move point forwards to nearest line with same indentation or less.
If not found, point is left at start of last line in buffer." (interactive) (byte-code "ÀˆÁÂà \"ˆÄ ‡" [nil ada-go-to-this-indent 1 current-indentation back-to-indentation] 4))

(defun ada-array nil "\
Insert array type definition, prompting for component type,
leaving the user to type in the index subtypes." (interactive) (byte-code "ÀˆÁcˆÂ ˆÃÄ!cˆÅ ˆÆcˆÂ ˆÃÇ!cˆÅ ‡" [nil "array ()" backward-char read-string "index subtype[s]: " end-of-line " of ;" "component-type: "] 7))

(defun ada-case nil "\
Build skeleton case statment, prompting for the selector expression.
starts up the first when clause, too." (interactive) (byte-code "ÀˆÁcˆÂÃÄ!Å\"ˆÆ ˆÆ ˆÇcˆÈÉ!ˆÊ ˆÊ ˆË ‡" [nil "case " insert read-string "selector expression: " " is" ada-newline "end case;" end-of-line 0 ada-tab ada-when] 9))

(defun ada-declare-block nil "\
Insert a block with a declare part and indent for the 1st declaration." (interactive) (byte-code "ÁˆÂÃ!ÄcˆÅÆ\"?…#Ç ˆÈÉ!ˆÊË\"ˆÌÉ!ˆÍ ˆÎ ˆÎ ˆÏcˆÎ ˆÎ ˆÅÆ\"ƒ?Ðc‚DÊÑÒ#)ˆÍÓ!ˆÔ ‡" [ada-block-name nil read-string "[block name]: " "declare" string-equal "" beginning-of-line open-line 1 insert ":" next-line end-of-line ada-newline "begin" "end;" "end " ";" -2 ada-tab] 16))

(defun ada-exception-block nil "\
Insert a block with an exception part and indent for the 1st line of code." (interactive) (byte-code "ˆÃÄ!ÅcˆÆÇ\"?…#È ˆÉÊ!ˆËÌ\"ˆÍÊ!ˆÎ ˆÏ ˆÏ ˆÐcˆÏ ˆÏ ˆÆÇ\"ƒ?Ñc‚DËÒÓ#)ˆÎÔ!ˆÕ ‡" [block-name t nil read-string "[block name]: " "begin" string-equal "" beginning-of-line open-line 1 insert ":" next-line end-of-line ada-newline "exception" "end;" "end " ";" -2 ada-tab] 16))

(defun ada-exception nil "\
Undent and insert an exception part into a block. Reindent." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃ ˆÄ ‡" [nil ada-untab "exception" ada-newline ada-tab] 4))

(defun ada-else nil "\
Add an else clause inside an if-then-end-if clause." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃ ˆÄ ‡" [nil ada-untab "else" ada-newline ada-tab] 4))

(defun ada-exit nil "\
Insert an exit statement, prompting for loop name and condition." (interactive) (byte-code "ˆÃcˆÄÅ!ÆÇ\"?…ÈÉ\")ˆÄÊ!Æ	Ç\"?…5ËÌ	\"ƒ1ÈÉ	\"‚5ÈÍ	\")ˆÎc‡" [ada-loop-name ada-exit-condition nil "exit" read-string "[name of loop to exit]: " string-equal "" insert " " "[exit condition]: " string-match "^ *[Ww][Hh][Ee][Nn] +" " when " ";"] 10))

(defun ada-when nil "\
Start a case statement alternative with a when clause." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃÄÅ!Æ\"ˆÇ ˆÈ ‡" [nil ada-untab "when " insert read-string "'|'-delimited choice list: " " =>" ada-newline ada-tab] 6))

(defun ada-for-loop nil "\
Build a skeleton for-loop statement, prompting for the loop parameters." (interactive) (byte-code "ˆÃcˆÄÅ!ÆÇ\"?	…&È ˆÉÊ!ˆËÌ\"ˆÍÊ!ˆÎÊ!ˆËÄÏ!Ð\"ˆËÄÑ!Ò\"ˆÓ ˆÓ ˆÔcˆ	…FËÕ\"ˆÖc*ˆÎ×!ˆØ ‡" [ada-loop-name ada-loop-is-named nil "for " read-string "[loop name]: " string-equal "" beginning-of-line open-line 1 insert ":" next-line end-of-line "loop variable: " " in " "range: " " loop" ada-newline "end loop" " " ";" 0 ada-tab] 17))

(defun ada-header nil "\
Insert a comment block containing the module title, author, etc." (interactive) (byte-code "ÀˆÁcˆÂÃ!cˆÄÅÆ \"ˆÄÇÈ \"ˆÄÉÊ ËÌ Í%‡" [nil "--
--  Title: 	" read-string "Title: " insert "
--  Created:	" current-time-string "
--  Author: 	" user-full-name "
--		<" user-login-name "@" system-name ">
--
"] 13))

(defun ada-if nil "\
Insert skeleton if statment, prompting for a boolean-expression." (interactive) (byte-code "ÀˆÁcˆÂÃÄ!Å\"ˆÆ ˆÆ ˆÇcˆÈÉ!ˆÊ ‡" [nil "if " insert read-string "condition: " " then" ada-newline "end if;" end-of-line 0 ada-tab] 7))

(defun ada-elsif nil "\
Add an elsif clause to an if statement, prompting for the boolean-expression." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃÄÅ!Æ\"ˆÇ ˆÈ ‡" [nil ada-untab "elsif " insert read-string "condition: " " then" ada-newline ada-tab] 6))

(defun ada-loop nil "\
insert a skeleton loop statement.  exit statement added by hand." (interactive) (byte-code "ˆÃcˆÄÅ!ÆÇ\"?	…&È ˆÉÊ!ˆËÌ\"ˆÍÊ!ˆÎÊ!ˆÏ ˆÏ ˆÐcˆ	…8ËÑ\"ˆÒc*ˆÎÓ!ˆÔ ‡" [ada-loop-name ada-loop-is-named nil "loop " read-string "[loop name]: " string-equal "" beginning-of-line open-line 1 insert ":" forward-line end-of-line ada-newline "end loop" " " ";" 0 ada-tab] 13))

(defun ada-package-spec nil "\
Insert a skeleton package specification." (interactive) (byte-code "ÁˆÂcˆÃÄ!ÅÆ\"ˆÇ ˆÇ ˆÅÈÉ#ˆÊË!ˆÌ )‡" [ada-package-name nil "package " read-string "package name: " insert " is" ada-newline "end " ";" end-of-line 0 ada-tab] 8))

(defun ada-package-body nil "\
Insert a skeleton package body --  includes a begin statement." (interactive) (byte-code "ÁˆÂcˆÃÄ!ÅÆ\"ˆÇ ˆÇ ˆÈcˆÇ ˆÅÉÊ#ˆËÌ!ˆÍ )‡" [ada-package-name nil "package body " read-string "package name: " insert " is" ada-newline "begin" "end " ";" end-of-line -1 ada-tab] 9))

(defun ada-private nil "\
Undent and start a private section of a package spec. Reindent." (interactive) (byte-code "ÀˆÁ ˆÂcˆÃ ˆÄ ‡" [nil ada-untab "private" ada-newline ada-tab] 4))

(defun ada-get-arg-list nil "\
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." (byte-code "ÂcˆiÃÄ!Å	Æ\"ƒÇÈ!‚4ÉÊ	\"…/	cˆË ˆjˆÃÌ!‰ˆ‚ˆÍ	Î\"*‡" [ada-arg-indent ada-args " (" read-string "[arguments]: " string-equal "" backward-delete-char 2 string-match ";$" newline "next argument: " insert ")"] 9))

(defun ada-function-spec nil "\
Insert a function specification.  Prompts for name and arguments." (interactive) (byte-code "ÀˆÁcˆÂÃ!cˆÄ ˆÅcˆÂÆ!c‡" [nil "function " read-string "function name: " ada-get-arg-list " return " "result type: "] 4))

(defun ada-procedure-spec nil "\
Insert a procedure specification, prompting for its name and arguments." (interactive) (byte-code "ÀˆÁcˆÂÃ!cˆÄ ‡" [nil "procedure " read-string "procedure name: " ada-get-arg-list] 3))

(defun get-ada-subprogram-name nil "\
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." (byte-code "ŠÄÅÆÁÂ#ƒ4ÇÈ!†ÇÉ!ƒ/i‰ˆÊË!ˆ`ÊÌ!ˆÍ`\"B)‚1Î ‚7ÏB))‡" [ada-proc-indent nil t p2 0 re-search-backward "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>" "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>" forward-word 2 -1 buffer-substring get-ada-subprogram-name "NAME?"] 9))

(defun ada-subprogram-body nil "\
Insert frame for subprogram body.
Invoke right after ada-function-spec or ada-procedure-spec." (interactive) (byte-code "ÁˆÂcˆÃ Ä ˆAjˆÅ ˆÆcˆÅ ˆÅ ˆÇÈ@É#)ˆÊË!ˆÌ ‡" [ada-subprogram-name-col nil " is" get-ada-subprogram-name newline ada-newline "begin" insert "end " ";" end-of-line -2 ada-tab] 9))

(defun ada-separate nil "\
Finish a body stub with 'is separate'." (interactive) (byte-code "ÀˆÁcˆÂ ˆÃ ˆÄcˆÂ ˆÅ ‡" [nil " is" ada-newline ada-tab "separate;" ada-untab] 5))

(defun ada-record nil "\
Insert a skeleton record type declaration." (interactive) (byte-code "ÀˆÁcˆÂ ˆÂ ˆÃcˆÄÅ!ˆÆ ‡" [nil "record" ada-newline "end record;" end-of-line 0 ada-tab] 5))

(defun ada-subtype nil "\
Start insertion of a subtype declaration, prompting for the subtype name." (interactive) (byte-code "ÀˆÁÂÃÄ!Å#ˆÆ ˆÇÈ!‡" [nil insert "subtype " read-string "subtype name: " " is ;" backward-char message "insert subtype indication."] 5))

(defun ada-type nil "\
Start insertion of a type declaration, prompting for the type name." (interactive) (byte-code "ÁˆÂÃÄÅ!\"ˆÄÆ!ÇÈ\"?…ÂÉÊ#)ˆËcˆÌÍ!‡" [disc-part nil insert "type " read-string "type name: " "discriminant specs: " string-equal "" "(" ")" " is " message "insert type definition."] 8))

(defun ada-while-loop nil (interactive) (byte-code "ˆÃcˆÄÅ!ÆÇ\"?	…&È ˆÉÊ!ˆËÌ\"ˆÍÊ!ˆÎÊ!ˆËÄÏ!Ð\"ˆÑ ˆÑ ˆÒcˆ	…?ËÓ\"ˆÔc*ˆÎÕ!ˆÖ ‡" [ada-loop-name ada-loop-is-named nil "while " read-string "loop name: " string-equal "" beginning-of-line open-line 1 insert ":" next-line end-of-line "entry condition: " " loop" ada-newline "end loop" " " ";" 0 ada-tab] 15))

(defun ada-paired-parens nil "\
Insert a pair of round parentheses, placing point between them." (interactive) (byte-code "ÀˆÁcˆÂ ‡" [nil "()" backward-char] 2))

(defun ada-inline-comment nil "\
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) (byte-code "ˆà ˆiV…
Ä ˆi	W…	jˆÅc‡" [end-comment-column comment-column nil end-of-line newline " -- "] 4))

(defun ada-display-comment nil "\
Inserts 3 comment lines, making a display comment." (interactive) (byte-code "ÀˆÁcˆÂÃ!‡" [nil "--
-- 
--" end-of-line 0] 2))

(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: ") (byte-code "ˆ	‰‡" [ada-lib-dir-name ada-lib-name nil] 2))

(defun ada-options-for-bind nil "\
Specify options, such as -m and -i, needed for adabind." (byte-code "ÁÂ!‰‡" [ada-bind-opts read-string "-m and -i options for adabind: "] 3))

(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") (byte-code "Ĉ	?ƒÅ‚ÆÇ ÈÉÊËÌ
&!*‡" [ada-init ada-prefix-arg ada-source-file ada-lib-dir-name nil "" "-n " buffer-name compile concat "adacomp " "-l " " "] 9))

(defun ada-find-listing nil "\
Find listing file for ada source in current buffer, using other window." (interactive) (byte-code "ÀˆÁ ÃÄOÅP!ˆÆÇ!‡" [nil find-file-other-window buffer-name 0 -4 ".lis" search-forward "*** ERROR"] 5))

(defun ada-bind nil "\
Bind the current program library, using the current binding options." (interactive) (byte-code "ˆÃÄÅ	R!‡" [ada-bind-opts ada-lib-dir-name nil compile "adabind " " "] 5))