mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-23 07:19:15 +00:00
*** empty log message ***
This commit is contained in:
parent
26cbfa53f6
commit
c8a628964c
109
lisp/ada.el
109
lisp/ada.el
@ -168,8 +168,9 @@ Variable ada-indent controls the number of spaces for indent/undent.
|
|||||||
(run-hooks 'ada-mode-hook))
|
(run-hooks 'ada-mode-hook))
|
||||||
|
|
||||||
(defun ada-tabsize (s)
|
(defun ada-tabsize (s)
|
||||||
"changes spacing used for indentation. Reads spacing from minibuffer."
|
"Changes spacing used for indentation.
|
||||||
(interactive "nnew indentation spacing: ")
|
Reads spacing from minibuffer."
|
||||||
|
(interactive "nNew indentation spacing: ")
|
||||||
(setq ada-indent s))
|
(setq ada-indent s))
|
||||||
|
|
||||||
(defun ada-newline ()
|
(defun ada-newline ()
|
||||||
@ -190,9 +191,9 @@ Variable ada-indent controls the number of spaces for indent/undent.
|
|||||||
(backward-delete-char-untabify ada-indent nil))
|
(backward-delete-char-untabify ada-indent nil))
|
||||||
|
|
||||||
(defun ada-go-to-this-indent (step indent-level)
|
(defun ada-go-to-this-indent (step indent-level)
|
||||||
"Move point repeatedly by <step> lines till the current line
|
"Move point repeatedly by STEP lines until the current line has
|
||||||
has given indent-level or less, or the start/end of the buffer is hit.
|
given INDENT-LEVEL or less, or the start or end of the buffer is reached.
|
||||||
Ignore blank lines, statement labels, block/loop names."
|
Ignore blank lines, statement labels and block or loop names."
|
||||||
(while (and
|
(while (and
|
||||||
(zerop (forward-line step))
|
(zerop (forward-line step))
|
||||||
(or (looking-at "^[ ]*$")
|
(or (looking-at "^[ ]*$")
|
||||||
@ -204,21 +205,21 @@ Ignore blank lines, statement labels, block/loop names."
|
|||||||
|
|
||||||
(defun ada-backward-to-same-indent ()
|
(defun ada-backward-to-same-indent ()
|
||||||
"Move point backwards to nearest line with same indentation or less.
|
"Move point backwards to nearest line with same indentation or less.
|
||||||
If not found, point is left at top of buffer."
|
If not found, point is left at the top of the buffer."
|
||||||
(interactive)
|
(interactive)
|
||||||
(ada-go-to-this-indent -1 (current-indentation))
|
(ada-go-to-this-indent -1 (current-indentation))
|
||||||
(back-to-indentation))
|
(back-to-indentation))
|
||||||
|
|
||||||
(defun ada-forward-to-same-indent ()
|
(defun ada-forward-to-same-indent ()
|
||||||
"Move point forwards to nearest line with same indentation or less.
|
"Move point forwards to nearest line with same indentation or less.
|
||||||
If not found, point is left at start of last line in buffer."
|
If not found, point is left at the start of the last line in the buffer."
|
||||||
(interactive)
|
(interactive)
|
||||||
(ada-go-to-this-indent 1 (current-indentation))
|
(ada-go-to-this-indent 1 (current-indentation))
|
||||||
(back-to-indentation))
|
(back-to-indentation))
|
||||||
|
|
||||||
(defun ada-array ()
|
(defun ada-array ()
|
||||||
"Insert array type definition, prompting for component type,
|
"Insert array type definition. Uses the minibuffer to prompt
|
||||||
leaving the user to type in the index subtypes."
|
for component type and index subtypes."
|
||||||
(interactive)
|
(interactive)
|
||||||
(insert "array ()")
|
(insert "array ()")
|
||||||
(backward-char)
|
(backward-char)
|
||||||
@ -230,8 +231,9 @@ leaving the user to type in the index subtypes."
|
|||||||
(end-of-line))
|
(end-of-line))
|
||||||
|
|
||||||
(defun ada-case ()
|
(defun ada-case ()
|
||||||
"Build skeleton case statment, prompting for the selector expression.
|
"Build skeleton case statement.
|
||||||
starts up the first when clause, too."
|
Uses the minibuffer to prompt for the selector expression.
|
||||||
|
Also builds the first when clause."
|
||||||
(interactive)
|
(interactive)
|
||||||
(insert "case ")
|
(insert "case ")
|
||||||
(insert (read-string "selector expression: ") " is")
|
(insert (read-string "selector expression: ") " is")
|
||||||
@ -244,57 +246,59 @@ starts up the first when clause, too."
|
|||||||
(ada-when))
|
(ada-when))
|
||||||
|
|
||||||
(defun ada-declare-block ()
|
(defun ada-declare-block ()
|
||||||
"Insert a block with a declare part and indent for the 1st declaration."
|
"Insert a block with a declare part.
|
||||||
|
Indent for the first declaration."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((ada-block-name (read-string "[block name]: ")))
|
(let ((ada-block-name (read-string "[block name]: ")))
|
||||||
(insert "declare")
|
(insert "declare")
|
||||||
(cond
|
(cond
|
||||||
( (not (string-equal ada-block-name ""))
|
( (not (string-equal ada-block-name ""))
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(open-line 1)
|
(open-line 1)
|
||||||
(insert ada-block-name ":")
|
(insert ada-block-name ":")
|
||||||
(next-line 1)
|
(next-line 1)
|
||||||
(end-of-line)))
|
(end-of-line)))
|
||||||
(ada-newline)
|
(ada-newline)
|
||||||
(ada-newline)
|
(ada-newline)
|
||||||
(insert "begin")
|
(insert "begin")
|
||||||
(ada-newline)
|
(ada-newline)
|
||||||
(ada-newline)
|
(ada-newline)
|
||||||
(if (string-equal ada-block-name "")
|
(if (string-equal ada-block-name "")
|
||||||
(insert "end;")
|
(insert "end;")
|
||||||
(insert "end " ada-block-name ";"))
|
(insert "end " ada-block-name ";"))
|
||||||
)
|
)
|
||||||
(end-of-line -2)
|
(end-of-line -2)
|
||||||
(ada-tab))
|
(ada-tab))
|
||||||
|
|
||||||
(defun ada-exception-block ()
|
(defun ada-exception-block ()
|
||||||
"Insert a block with an exception part and indent for the 1st line of code."
|
"Insert a block with an exception part.
|
||||||
|
Indent for the first line of code."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((block-name (read-string "[block name]: ")))
|
(let ((block-name (read-string "[block name]: ")))
|
||||||
(insert "begin")
|
(insert "begin")
|
||||||
(cond
|
(cond
|
||||||
( (not (string-equal block-name ""))
|
( (not (string-equal block-name ""))
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(open-line 1)
|
(open-line 1)
|
||||||
(insert block-name ":")
|
(insert block-name ":")
|
||||||
(next-line 1)
|
(next-line 1)
|
||||||
(end-of-line)))
|
(end-of-line)))
|
||||||
(ada-newline)
|
(ada-newline)
|
||||||
(ada-newline)
|
(ada-newline)
|
||||||
(insert "exception")
|
(insert "exception")
|
||||||
(ada-newline)
|
(ada-newline)
|
||||||
(ada-newline)
|
(ada-newline)
|
||||||
(cond
|
(cond
|
||||||
( (string-equal block-name "")
|
( (string-equal block-name "")
|
||||||
(insert "end;"))
|
(insert "end;"))
|
||||||
( t
|
( t
|
||||||
(insert "end " block-name ";")))
|
(insert "end " block-name ";")))
|
||||||
)
|
)
|
||||||
(end-of-line -2)
|
(end-of-line -2)
|
||||||
(ada-tab))
|
(ada-tab))
|
||||||
|
|
||||||
(defun ada-exception ()
|
(defun ada-exception ()
|
||||||
"Undent and insert an exception part into a block. Reindent."
|
"Insert an indented exception part into a block."
|
||||||
(interactive)
|
(interactive)
|
||||||
(ada-untab)
|
(ada-untab)
|
||||||
(insert "exception")
|
(insert "exception")
|
||||||
@ -384,7 +388,7 @@ starts up the first when clause, too."
|
|||||||
(ada-tab))
|
(ada-tab))
|
||||||
|
|
||||||
(defun ada-loop ()
|
(defun ada-loop ()
|
||||||
"insert a skeleton loop statement. exit statement added by hand."
|
"Insert a skeleton loop statement. exit statement added by hand."
|
||||||
(interactive)
|
(interactive)
|
||||||
(insert "loop ")
|
(insert "loop ")
|
||||||
(let* ((ada-loop-name (read-string "[loop name]: "))
|
(let* ((ada-loop-name (read-string "[loop name]: "))
|
||||||
@ -439,10 +443,10 @@ starts up the first when clause, too."
|
|||||||
(ada-tab))
|
(ada-tab))
|
||||||
|
|
||||||
(defun ada-get-arg-list ()
|
(defun ada-get-arg-list ()
|
||||||
"Read from user a procedure or function argument list.
|
"Read from the user a procedure or function argument list.
|
||||||
Add parens unless arguments absent, and insert into buffer.
|
Add parens unless arguments absent, and insert into buffer.
|
||||||
Individual arguments are arranged vertically if entered one-at-a-time.
|
Individual arguments are arranged vertically if entered one at a time.
|
||||||
Arguments ending with ';' are presumed single and stacked."
|
Arguments ending with `;' are presumed single and stacked."
|
||||||
(insert " (")
|
(insert " (")
|
||||||
(let ((ada-arg-indent (current-column))
|
(let ((ada-arg-indent (current-column))
|
||||||
(ada-args (read-string "[arguments]: ")))
|
(ada-args (read-string "[arguments]: ")))
|
||||||
@ -473,9 +477,9 @@ Arguments ending with ';' are presumed single and stacked."
|
|||||||
(ada-get-arg-list))
|
(ada-get-arg-list))
|
||||||
|
|
||||||
(defun get-ada-subprogram-name ()
|
(defun get-ada-subprogram-name ()
|
||||||
"Return (without moving point or mark) a pair whose CAR is
|
"Return (without moving point or mark) a pair whose CAR is the name of
|
||||||
the name of the function or procedure whose spec immediately precedes point,
|
the function or procedure whose spec immediately precedes point, and whose
|
||||||
and whose CDR is the column nbr the procedure/function keyword was found at."
|
CDR is the column number where the procedure/function keyword was found."
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let ((ada-proc-indent 0))
|
(let ((ada-proc-indent 0))
|
||||||
(if (re-search-backward
|
(if (re-search-backward
|
||||||
@ -494,7 +498,7 @@ and whose CDR is the column nbr the procedure/function keyword was found at."
|
|||||||
|
|
||||||
(defun ada-subprogram-body ()
|
(defun ada-subprogram-body ()
|
||||||
"Insert frame for subprogram body.
|
"Insert frame for subprogram body.
|
||||||
Invoke right after ada-function-spec or ada-procedure-spec."
|
Invoke right after `ada-function-spec' or `ada-procedure-spec'."
|
||||||
(interactive)
|
(interactive)
|
||||||
(insert " is")
|
(insert " is")
|
||||||
(let ((ada-subprogram-name-col (get-ada-subprogram-name)))
|
(let ((ada-subprogram-name-col (get-ada-subprogram-name)))
|
||||||
@ -509,7 +513,7 @@ Invoke right after ada-function-spec or ada-procedure-spec."
|
|||||||
(ada-tab))
|
(ada-tab))
|
||||||
|
|
||||||
(defun ada-separate ()
|
(defun ada-separate ()
|
||||||
"Finish a body stub with 'is separate'."
|
"Finish a body stub with `is separate'."
|
||||||
(interactive)
|
(interactive)
|
||||||
(insert " is")
|
(insert " is")
|
||||||
(ada-newline)
|
(ada-newline)
|
||||||
@ -585,8 +589,9 @@ Invoke right after ada-function-spec or ada-procedure-spec."
|
|||||||
(backward-char))
|
(backward-char))
|
||||||
|
|
||||||
(defun ada-inline-comment ()
|
(defun ada-inline-comment ()
|
||||||
"Start a comment after the end of the line, indented at least COMMENT-COLUMN.
|
"Start a comment after the end of the line, indented at least
|
||||||
If starting after END-COMMENT-COLUMN, start a new line."
|
`comment-column' spaces. If starting after `end-comment-column',
|
||||||
|
start a new line."
|
||||||
(interactive)
|
(interactive)
|
||||||
(end-of-line)
|
(end-of-line)
|
||||||
(if (> (current-column) end-comment-column) (newline))
|
(if (> (current-column) end-comment-column) (newline))
|
||||||
@ -594,30 +599,30 @@ If starting after END-COMMENT-COLUMN, start a new line."
|
|||||||
(insert " -- "))
|
(insert " -- "))
|
||||||
|
|
||||||
(defun ada-display-comment ()
|
(defun ada-display-comment ()
|
||||||
"Inserts 3 comment lines, making a display comment."
|
"Inserts three comment lines, making a display comment."
|
||||||
(interactive)
|
(interactive)
|
||||||
(insert "--\n-- \n--")
|
(insert "--\n-- \n--")
|
||||||
(end-of-line 0))
|
(end-of-line 0))
|
||||||
|
|
||||||
;; Much of this is specific to Ada-Ed
|
;; Much of this is specific to Ada-Ed
|
||||||
|
|
||||||
(defvar ada-lib-dir-name "lib" "*Current ada program library directory.")
|
(defvar ada-lib-dir-name "lib" "*Current Ada program library directory.")
|
||||||
(defvar ada-bind-opts "" "*Options to supply for binding.")
|
(defvar ada-bind-opts "" "*Options to supply for binding.")
|
||||||
|
|
||||||
(defun ada-library-name (ada-lib-name)
|
(defun ada-library-name (ada-lib-name)
|
||||||
"Specify name of ada library directory for later compilations."
|
"Specify name of Ada library directory for later compilations."
|
||||||
(interactive "Dname of ada library directory: ")
|
(interactive "DName of Ada library directory: ")
|
||||||
(setq ada-lib-dir-name ada-lib-name))
|
(setq ada-lib-dir-name ada-lib-name))
|
||||||
|
|
||||||
(defun ada-options-for-bind ()
|
(defun ada-options-for-bind ()
|
||||||
"Specify options, such as -m and -i, needed for adabind."
|
"Specify options, such as -m and -i, needed for `ada-bind'."
|
||||||
(setq ada-bind-opts (read-string "-m and -i options for adabind: ")))
|
(setq ada-bind-opts (read-string "-m and -i options for `ada-bind': ")))
|
||||||
|
|
||||||
(defun ada-compile (ada-prefix-arg)
|
(defun ada-compile (arg)
|
||||||
"Save the current buffer and compile it into the current program library.
|
"Save the current buffer and compile it into the current program library.
|
||||||
Initialize the library if a prefix arg is given."
|
Initialize the library if a prefix arg is given."
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(let* ((ada-init (if (null ada-prefix-arg) "" "-n "))
|
(let* ((ada-init (if (null arg) "" "-n "))
|
||||||
(ada-source-file (buffer-name)))
|
(ada-source-file (buffer-name)))
|
||||||
(compile
|
(compile
|
||||||
(concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file))))
|
(concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file))))
|
||||||
|
Loading…
Reference in New Issue
Block a user