From: matthew_heaney@acm.org (Matthew Heaney)
Subject: - ada-mode V2.28.text (2/3) Re: EMACS Ada Mode Update?
Date: 1998/04/12
Date: 1998-04-12T00:00:00+00:00 [thread overview]
Message-ID: <matthew_heaney-ya023680001204981554290001@news.ni.net> (raw)
In-Reply-To: 352ed24b.2940538@news.ghg.net
---
(and (progn
(or (looking-at "[ \t]*\\<end\\>")
(backward-word 1))
(or (looking-at "[ \t]*\\<end\\>")
(backward-word 1))
(or (looking-at "[ \t]*\\<end\\>")
(error "not on end ...;")))
(ada-goto-matching-start 1)
(setq pos (point))
;;
;; on 'begin' => go on, according to user option
;;
ada-move-to-declaration
(looking-at "\\<begin\\>")
(ada-goto-matching-decl-start)
(setq pos (point))))
) ; end of save-excursion
;; now really move to the found position
(goto-char pos)
(message "searching for block start ... done"))
;;
;; restore syntax-table
;;
(set-syntax-table ada-mode-syntax-table))))
(defun ada-move-to-end ()
"Moves point to the matching end of the current block around point.
Moves to 'begin' if in a declarative part."
(interactive)
(let ((pos (point))
(decstart nil)
(packdecl nil))
(unwind-protect
(progn
(set-syntax-table ada-mode-symbol-syntax-table)
(message "searching for block end ...")
(save-excursion
(forward-char 1)
(cond
;; directly on 'begin'
((save-excursion
(ada-goto-previous-word)
(looking-at "\\<begin\\>"))
(ada-goto-matching-end 1))
;; on first line of defun declaration
((save-excursion
(and (ada-goto-stmt-start)
(looking-at "\\<function\\>\\|\\<procedure\\>" )))
(ada-search-ignore-string-comment "\\<begin\\>"))
;; on first line of task declaration
((save-excursion
(and (ada-goto-stmt-start)
(looking-at "\\<task\\>" )
(forward-word 1)
(ada-search-ignore-string-comment "[^ \n\t]")
(not (backward-char 1))
(looking-at "\\<body\\>")))
(ada-search-ignore-string-comment "\\<begin\\>"))
;; accept block start
((save-excursion
(and (ada-goto-stmt-start)
(looking-at "\\<accept\\>" )))
(ada-goto-matching-end 0))
;; package start
((save-excursion
(and (ada-goto-matching-decl-start t)
(looking-at "\\<package\\>")))
(ada-goto-matching-end 1))
;; inside a 'begin' ... 'end' block
((save-excursion
(ada-goto-matching-decl-start t))
(ada-search-ignore-string-comment "\\<begin\\>"))
;; (hopefully ;-) everything else
(t
(ada-goto-matching-end 1)))
(setq pos (point))
) ; end of save-excursion
;; now really move to the found position
(goto-char pos)
(message "searching for block end ... done"))
;;
;; restore syntax-table
;;
(set-syntax-table ada-mode-syntax-table))))
\f
;;;-----------------------------;;;
;;; Functions For Indentation ;;;
;;;-----------------------------;;;
;; ---- main functions for indentation
(defun ada-indent-region (beg end)
"Indents the region using `ada-indent-current' on each line."
(interactive "*r")
(goto-char beg)
(let ((block-done 0)
(lines-remaining (count-lines beg end))
(msg (format "indenting %4d lines %%4d lines remaining ..."
(count-lines beg end)))
(endmark (copy-marker end)))
;; catch errors while indenting
(condition-case err
(while (< (point) endmark)
(if (> block-done 9)
(progn (message msg lines-remaining)
(setq block-done 0)))
(if (looking-at "^$") nil
(ada-indent-current))
(forward-line 1)
(setq block-done (1+ block-done))
(setq lines-remaining (1- lines-remaining)))
;; show line number where the error occurred
(error
(error "line %d: %s" (1+ (count-lines (point-min) (point))) err) nil))
(message "indenting ... done")))
(defun ada-indent-newline-indent ()
"Indents the current line, inserts a newline and then indents the new line."
(interactive "*")
(ada-indent-current)
(newline)
(ada-indent-current))
(defun ada-indent-current ()
"Indents current line as Ada code.
This works by two steps:
1) It moves point to the end of the previous code line.
Then it calls the function to calculate the indentation for the
following line as if a newline would be inserted there.
The calculated column # is saved and the old position of point
is restored.
2) Then another function is called to calculate the indentation for
the current line, based on the previously calculated column #."
(interactive)
(unwind-protect
(progn
(set-syntax-table ada-mode-symbol-syntax-table)
(let ((line-end)
(orgpoint (point-marker))
(cur-indent)
(prev-indent)
(prevline t))
;;
;; first step
;;
(save-excursion
(if (ada-goto-prev-nonblank-line t)
;;
;; we are not in the first accessible line in the buffer
;;
(progn
;;(end-of-line)
;;(forward-char 1)
;; we are already at the BOL
(forward-line 1)
(setq line-end (point))
(setq prev-indent
(save-excursion
(funcall (ada-indent-function) line-end))))
(progn ; first line of buffer -> set indent
(beginning-of-line) ; to 0
(delete-horizontal-space)
(setq prevline nil))))
(if prevline
;;
;; we are not in the first accessible line in the buffer
;;
(progn
;;
;; second step
;;
(back-to-indentation)
(setq cur-indent (ada-get-current-indent prev-indent))
;; only reindent if indentation is different then the current
(if (= (current-column) cur-indent)
nil
(delete-horizontal-space)
(indent-to cur-indent))
;;
;; restore position of point
;;
(goto-char orgpoint)
(if (< (current-column) (current-indentation))
(back-to-indentation))))))
;;
;; restore syntax-table
;;
(set-syntax-table ada-mode-syntax-table)))
(defun ada-get-current-indent (prev-indent)
;; Returns the column # to indent the current line to.
;; PREV-INDENT is the indentation resulting from the previous lines.
(let ((column nil)
(pos nil)
(match-cons nil))
(cond
;;
;; in open parenthesis, but not in parameter-list
;;
((and
ada-indent-to-open-paren
(not (ada-in-paramlist-p))
(setq column (ada-in-open-paren-p)))
;; check if we have something like this (Table_Component_Type =>
;; Source_File_Record,)
(save-excursion
(if (and (ada-search-ignore-string-comment "[^ \t]" t nil)
(looking-at "\n")
(ada-search-ignore-string-comment "[^ \t\n]" t nil)
(looking-at ">"))
(setq column (+ ada-broken-indent column))))
column)
;;
;; end
;;
((looking-at "\\<end\\>")
(let ((label 0))
(save-excursion
(ada-goto-matching-start 1)
;;
;; found 'loop' => skip back to 'while' or 'for'
;; if 'loop' is not on a separate line
;;
(if (and
(looking-at "\\<loop\\>")
(save-excursion
(back-to-indentation)
(not (looking-at "\\<loop\\>"))))
(if (save-excursion
(and
(setq match-cons
(ada-search-ignore-string-comment
ada-loop-start-re t nil))
(not (looking-at "\\<loop\\>"))))
(progn
(goto-char (car match-cons))
(save-excursion
(beginning-of-line)
(if (looking-at ada-named-block-re)
(setq label (- ada-label-indent)))))))
(+ (current-indentation) label))))
;;
;; exception
;;
((looking-at "\\<exception\\>")
(save-excursion
(ada-goto-matching-start 1)
(current-indentation)))
;;
;; when
;;
((looking-at "\\<when\\>")
(save-excursion
(ada-goto-matching-start 1)
(+ (current-indentation) ada-when-indent)))
;;
;; else
;;
((looking-at "\\<else\\>")
(if (save-excursion
(ada-goto-previous-word)
(looking-at "\\<or\\>"))
prev-indent
(save-excursion
(ada-goto-matching-start 1 nil t)
(current-indentation))))
;;
;; elsif
;;
((looking-at "\\<elsif\\>")
(save-excursion
(ada-goto-matching-start 1 nil t)
(current-indentation)))
;;
;; then
;;
((looking-at "\\<then\\>")
(if (save-excursion
(ada-goto-previous-word)
(looking-at "\\<and\\>"))
prev-indent
(save-excursion
(ada-search-ignore-string-comment "\\<elsif\\>\\|\\<if\\>" t nil)
(+ (current-indentation) ada-stmt-end-indent))))
;;
;; loop
;;
((looking-at "\\<loop\\>")
(setq pos (point))
(save-excursion
(goto-char (match-end 0))
(ada-goto-stmt-start)
(if (looking-at "\\<loop\\>\\|\\<if\\>")
prev-indent
(progn
(if (not (looking-at ada-loop-start-re))
(ada-search-ignore-string-comment ada-loop-start-re
nil pos))
(if (looking-at "\\<loop\\>")
prev-indent
(+ (current-indentation) ada-stmt-end-indent))))))
;;
;; begin
;;
((looking-at "\\<begin\\>")
(save-excursion
(if (ada-goto-matching-decl-start t)
(current-indentation)
prev-indent)))
;;
;; is
;;
((looking-at "\\<is\\>")
(if (and
ada-indent-is-separate
(save-excursion
(goto-char (match-end 0))
(ada-goto-next-non-ws (save-excursion
(end-of-line)
(point)))
(looking-at "\\<abstract\\>\\|\\<separate\\>")))
(save-excursion
(ada-goto-stmt-start)
(+ (current-indentation) ada-indent))
(save-excursion
(ada-goto-stmt-start)
(+ (current-indentation) ada-stmt-end-indent))))
;;
;; record
;;
((looking-at "\\<record\\>")
(save-excursion
(ada-search-ignore-string-comment
"\\<\\(type\\|use\\)\\>" t nil)
(if (looking-at "\\<use\\>")
(ada-search-ignore-string-comment "\\<for\\>" t nil))
(+ (current-indentation) ada-indent-record-rel-type)))
;;
;; or as statement-start
;;
((ada-looking-at-semi-or)
(save-excursion
(ada-goto-matching-start 1)
(current-indentation)))
;;
;; private as statement-start
;;
((ada-looking-at-semi-private)
(save-excursion
(ada-goto-matching-decl-start)
(current-indentation)))
;;
;; new/abstract/separate
;;
((looking-at "\\<\\(new\\|abstract\\|separate\\)\\>")
(- prev-indent ada-indent (- ada-broken-indent)))
;;
;; return
;;
((looking-at "\\<return\\>")
(save-excursion
(forward-sexp -1)
(if (and (looking-at "(")
(save-excursion
(backward-sexp 2)
(looking-at "\\<function\\>")))
(1+ (current-column))
prev-indent)))
;;
;; do
;;
((looking-at "\\<do\\>")
(save-excursion
(ada-goto-stmt-start)
(+ (current-indentation) ada-stmt-end-indent)))
;;
;; package/function/procedure
;;
((and (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")
(save-excursion
(forward-char 1)
(ada-goto-stmt-start)
(looking-at "\\<\\(package\\|function\\|procedure\\)\\>")))
(save-excursion
;; look for 'generic'
(if (and (ada-goto-matching-decl-start t)
(looking-at "generic"))
(current-column)
prev-indent)))
;;
;; label
;;
((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*:[^=]")
(if (ada-in-decl-p)
prev-indent
(+ prev-indent ada-label-indent)))
;;
;; identifier and other noindent-statements
;;
((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*")
prev-indent)
;;
;; beginning of a parameter list
;;
((looking-at "(")
prev-indent)
;;
;; end of a parameter list
;;
((looking-at ")")
(save-excursion
(forward-char 1)
(backward-sexp 1)
(current-column)))
;;
;; comment
;;
((looking-at "--")
(if ada-indent-comment-as-code
prev-indent
(current-indentation)))
;;
;; unknown syntax - maybe this should signal an error ?
;;
(t
prev-indent))))
(defun ada-indent-function (&optional nomove)
;; Returns the function to calculate the indentation for the current
;; line according to the previous statement, ignoring the contents
;; of the current line after point. Moves point to the beginning of
;; the current statement, if NOMOVE is nil.
(let ((orgpoint (point))
(func nil))
;;
;; inside a parameter-list
;;
(if (ada-in-paramlist-p)
(setq func 'ada-get-indent-paramlist)
(progn
;;
;; move to beginning of current statement
;;
(if (not nomove)
(ada-goto-stmt-start))
;;
;; no beginning found => don't change indentation
;;
(if (and
(eq orgpoint (point))
(not nomove))
(setq func 'ada-get-indent-nochange)
(cond
;;
((and
ada-indent-to-open-paren
(ada-in-open-paren-p))
(setq func 'ada-get-indent-open-paren))
;;
((looking-at "\\<end\\>")
(setq func 'ada-get-indent-end))
;;
((looking-at ada-loop-start-re)
(setq func 'ada-get-indent-loop))
;;
((looking-at ada-subprog-start-re)
(setq func 'ada-get-indent-subprog))
;;
((looking-at ada-block-start-re)
(setq func 'ada-get-indent-block-start))
;;
((looking-at "\\<type\\>")
(setq func 'ada-get-indent-type))
;;
((looking-at "\\<\\(els\\)?if\\>")
(setq func 'ada-get-indent-if))
;;
((looking-at "\\<case\\>")
(setq func 'ada-get-indent-case))
;;
((looking-at "\\<when\\>")
(setq func 'ada-get-indent-when))
;;
((looking-at "--")
(setq func 'ada-get-indent-comment))
;;
((looking-at "[a-zA-Z0-9_]+[ \t\n]*:[^=]")
(setq func 'ada-get-indent-label))
;;
((looking-at "\\<separate\\>")
(setq func 'ada-get-indent-nochange))
(t
(setq func 'ada-get-indent-noindent))))))
func))
;; ---- functions to return indentation for special cases
(defun ada-get-indent-open-paren (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be behind an open parenthesis not yet closed.
(ada-in-open-paren-p))
(defun ada-get-indent-nochange (orgpoint)
;; Returns the indentation (column #) of the current line.
(save-excursion
(forward-line -1)
(current-indentation)))
(defun ada-get-indent-paramlist (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be inside a parameter-list.
(save-excursion
(ada-search-ignore-string-comment "[^ \t\n]" t nil t)
(cond
;;
;; in front of the first parameter
;;
((looking-at "(")
(goto-char (match-end 0))
(current-column))
;;
;; in front of another parameter
;;
((looking-at ";")
(goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
(ada-goto-next-non-ws)
(current-column))
;;
;; inside a parameter declaration
;;
(t
(goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
(ada-goto-next-non-ws)
(+ (current-column) ada-broken-indent)))))
(defun ada-get-indent-end (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be at the beginning of an end-statement.
;; Therefore it has to find the corresponding start. This can be a little
;; slow, if it has to search through big files with many nested blocks.
;; Signals an error if the corresponding block-start doesn't match.
(let ((defun-name nil)
(label 0)
(indent nil))
;;
;; is the line already terminated by ';' ?
;;
(if (save-excursion
(ada-search-ignore-string-comment ";" nil orgpoint))
;;
;; yes, look what's following 'end'
;;
(progn
(forward-word 1)
(ada-goto-next-non-ws)
(cond
;;
;; loop/select/if/case/record/select
;;
((looking-at "\\<\\(loop\\|select\\|if\\|case\\|record\\)\\>")
(save-excursion
(ada-check-matching-start
(buffer-substring (match-beginning 0)
(match-end 0)))
(if (looking-at "\\<\\(loop\\|record\\)\\>")
(progn
(forward-word 1)
(ada-goto-stmt-start)))
;; a label ? => skip it
(if (looking-at ada-named-block-re)
(progn
(setq label (- ada-label-indent))
(goto-char (match-end 0))
(ada-goto-next-non-ws)))
;; really looking-at the right thing ?
(or (looking-at (concat "\\<\\("
"loop\\|select\\|if\\|case\\|"
"record\\|while\\|type\\)\\>"))
(progn
(ada-search-ignore-string-comment
(concat "\\<\\("
"loop\\|select\\|if\\|case\\|"
"record\\|while\\|type\\)\\>")))
(backward-word 1))
(+ (current-indentation) label)))
;;
;; a named block end
;;
((looking-at ada-ident-re)
(setq defun-name (buffer-substring (match-beginning 0)
(match-end 0)))
(save-excursion
(ada-goto-matching-start 0)
(ada-check-defun-name defun-name)
(current-indentation)))
;;
;; a block-end without name
;;
((looking-at ";")
(save-excursion
(ada-goto-matching-start 0)
(if (looking-at "\\<begin\\>")
(progn
(setq indent (current-column))
(if (ada-goto-matching-decl-start t)
(current-indentation)
indent)))))
;;
;; anything else - should maybe signal an error ?
;;
(t
(+ (current-indentation) ada-broken-indent))))
(+ (current-indentation) ada-broken-indent))))
(defun ada-get-indent-case (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be at the beginning of a case-statement.
(let ((cur-indent (current-indentation))
(match-cons nil)
(opos (point)))
(cond
;;
;; case..is..when..=>
;;
((save-excursion
(setq match-cons (and
;; the `=>' must be after the keyword `is'.
(ada-search-ignore-string-comment
"\\<is\\>" nil orgpoint)
(ada-search-ignore-string-comment
"[ \t\n]+=>" nil orgpoint))))
(save-excursion
(goto-char (car match-cons))
(if (not (ada-search-ignore-string-comment "\\<when\\>" t opos))
(error "missing 'when' between 'case' and '=>'"))
(+ (current-indentation) ada-indent)))
;;
;; case..is..when
;;
((save-excursion
(setq match-cons (ada-search-ignore-string-comment
"\\<when\\>" nil orgpoint)))
(goto-char (cdr match-cons))
(+ (current-indentation) ada-broken-indent))
;;
;; case..is
;;
((save-excursion
(setq match-cons (ada-search-ignore-string-comment
"\\<is\\>" nil orgpoint)))
(+ (current-indentation) ada-when-indent))
;;
;; incomplete case
;;
(t
(+ (current-indentation) ada-broken-indent)))))
(defun ada-get-indent-when (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be at the beginning of an when-statement.
(let ((cur-indent (current-indentation)))
(if (ada-search-ignore-string-comment
"[ \t\n]+=>" nil orgpoint)
(+ cur-indent ada-indent)
(+ cur-indent ada-broken-indent))))
(defun ada-get-indent-if (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be at the beginning of an if-statement.
(let ((cur-indent (current-indentation))
(match-cons nil))
;;
;; if..then ?
;;
(if (ada-search-but-not
"\\<then\\>" "\\<and\\>[ \t\n]+\\<then\\>" nil orgpoint)
(progn
;;
;; 'then' first in separate line ?
;; => indent according to 'then'
;;
(if (save-excursion
(back-to-indentation)
(looking-at "\\<then\\>"))
(setq cur-indent (current-indentation)))
(forward-word 1)
;;
;; something follows 'then' ?
;;
(if (setq match-cons
(ada-search-ignore-string-comment
"[^ \t\n]" nil orgpoint))
(progn
(goto-char (car match-cons))
(+ ada-indent
(- cur-indent (current-indentation))
(funcall (ada-indent-function t) orgpoint)))
(+ cur-indent ada-indent)))
(+ cur-indent ada-broken-indent))))
(defun ada-get-indent-block-start (orgpoint)
;; Returns the indentation (column #) for the new line after
;; ORGPOINT. Assumes point to be at the beginning of a block start
;; keyword.
(let ((cur-indent (current-indentation))
(pos nil))
(cond
((save-excursion
(forward-word 1)
(setq pos (car (ada-search-ignore-string-comment
"[^ \t\n]" nil orgpoint))))
(goto-char pos)
(save-excursion
(funcall (ada-indent-function t) orgpoint)))
;;
;; nothing follows the block-start
;;
(t
(+ (current-indentation) ada-indent)))))
(defun ada-get-indent-subprog (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be at the beginning of a subprog-/package-declaration.
(let ((match-cons nil)
(cur-indent (current-indentation))
(foundis nil)
(addind 0)
(fstart (point)))
;;
;; is there an 'is' in front of point ?
;;
(if (save-excursion
(setq match-cons
(ada-search-ignore-string-comment
"\\<\\(is\\|do\\)\\>" nil orgpoint)))
;;
;; yes, then skip to its end
;;
(progn
(setq foundis t)
(goto-char (cdr match-cons)))
;;
;; no, then goto next non-ws, if there is one in front of point
;;
(progn
(if (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)
(ada-goto-next-non-ws)
(goto-char orgpoint))))
(cond
;;
;; nothing follows 'is'
;;
((and
foundis
(save-excursion
(not (ada-search-ignore-string-comment
"[^ \t\n]" nil orgpoint t))))
(+ cur-indent ada-indent))
;;
;; is abstract/separate/new ...
;;
((and
foundis
(save-excursion
(setq match-cons
(ada-search-ignore-string-comment
"\\<\\(separate\\|new\\|abstract\\)\\>"
nil orgpoint))))
(goto-char (car match-cons))
(ada-search-ignore-string-comment ada-subprog-start-re t)
(ada-get-indent-noindent orgpoint))
;;
;; something follows 'is'
;;
((and
foundis
(save-excursion
(ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
(ada-goto-next-non-ws)
(funcall (ada-indent-function t) orgpoint)))
;;
;; no 'is' but ';'
;;
((save-excursion
(ada-search-ignore-string-comment ";" nil orgpoint))
cur-indent)
;;
;; no 'is' or ';'
;;
(t
(+ cur-indent ada-broken-indent)))))
(defun ada-get-indent-noindent (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be at the beginning of a 'noindent statement'.
(let ((label 0))
(save-excursion
(beginning-of-line)
(if (looking-at ada-named-block-re)
(setq label (- ada-label-indent))))
(if (save-excursion
(ada-search-ignore-string-comment ";" nil orgpoint))
(+ (current-indentation) label)
(+ (current-indentation) ada-broken-indent label))))
(defun ada-get-indent-label (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be at the beginning of a label or variable declaration.
;; Checks the context to decide if it's a label or a variable declaration.
;; This check might be a bit slow.
(let ((match-cons nil)
(cur-indent (current-indentation)))
(goto-char (cdr (ada-search-ignore-string-comment ":")))
(cond
;;
;; loop label
;;
((save-excursion
(setq match-cons (ada-search-ignore-string-comment
ada-loop-start-re nil orgpoint)))
(goto-char (car match-cons))
(ada-get-indent-loop orgpoint))
;;
;; declare label
;;
((save-excursion
(setq match-cons (ada-search-ignore-string-comment
"\\<declare\\|begin\\>" nil orgpoint)))
(save-excursion
(goto-char (car match-cons))
(+ (current-indentation) ada-indent)))
;;
;; complete statement following colon
;;
((save-excursion
(ada-search-ignore-string-comment ";" nil orgpoint))
(if (ada-in-decl-p)
cur-indent ; variable-declaration
(- cur-indent ada-label-indent))) ; label
;;
;; broken statement
;;
((save-excursion
(ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
(if (ada-in-decl-p)
(+ cur-indent ada-broken-indent)
(+ cur-indent ada-broken-indent (- ada-label-indent))))
;;
;; nothing follows colon
;;
(t
(if (ada-in-decl-p)
(+ cur-indent ada-broken-indent) ; variable-declaration
(- cur-indent ada-label-indent)))))) ; label
(defun ada-get-indent-loop (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be at the beginning of a loop statement
;; or (unfortunately) also a for ... use statement.
(let ((match-cons nil)
(pos (point))
(label (save-excursion
(beginning-of-line)
(if (looking-at ada-named-block-re)
(- ada-label-indent)
0))))
(cond
;;
;; statement complete
;;
((save-excursion
(ada-search-ignore-string-comment ";" nil orgpoint))
(+ (current-indentation) label))
;;
;; simple loop
;;
((looking-at "loop\\>")
(+ (ada-get-indent-block-start orgpoint) label))
;;
;; 'for'- loop (or also a for ... use statement)
;;
((looking-at "for\\>")
(cond
;;
;; for ... use
;;
((save-excursion
(and
(goto-char (match-end 0))
(ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
(not (backward-char 1))
(not (zerop (skip-chars-forward "_a-zA-Z0-9'")))
(ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
(not (backward-char 1))
(looking-at "\\<use\\>")
;;
;; check if there is a 'record' before point
;;
(progn
(setq match-cons (ada-search-ignore-string-comment
"\\<record\\>" nil orgpoint))
t)))
(if match-cons
(goto-char (car match-cons)))
(+ (current-indentation) ada-indent))
;;
;; for..loop
;;
((save-excursion
(setq match-cons (ada-search-ignore-string-comment
"\\<loop\\>" nil orgpoint)))
(goto-char (car match-cons))
;;
;; indent according to 'loop', if it's first in the line;
;; otherwise to 'for'
;;
(if (not (save-excursion
(back-to-indentation)
(looking-at "\\<loop\\>")))
(goto-char pos))
(+ (current-indentation) ada-indent label))
;;
;; for-statement is broken
;;
(t
(+ (current-indentation) ada-broken-indent label))))
;;
;; 'while'-loop
;;
((looking-at "while\\>")
;;
;; while..loop ?
;;
(if (save-excursion
(setq match-cons (ada-search-ignore-string-comment
"\\<loop\\>" nil orgpoint)))
(progn
(goto-char (car match-cons))
;;
;; indent according to 'loop', if it's first in the line;
;; otherwise to 'while'.
;;
(if (not (save-excursion
(back-to-indentation)
(looking-at "\\<loop\\>")))
(goto-char pos))
(+ (current-indentation) ada-indent label))
(+ (current-indentation) ada-broken-indent label))))))
(defun ada-get-indent-type (orgpoint)
;; Returns the indentation (column #) for the new line after ORGPOINT.
;; Assumes point to be at the beginning of a type statement.
(let ((match-dat nil))
(cond
;;
;; complete record declaration
;;
((save-excursion
(and
(setq match-dat (ada-search-ignore-string-comment "\\<end\\>"
nil
orgpoint))
(ada-goto-next-non-ws)
(looking-at "\\<record\\>")
(forward-word 1)
(ada-goto-next-non-ws)
(looking-at ";")))
(goto-char (car match-dat))
(current-indentation))
;;
;; record type
;;
((save-excursion
(setq match-dat (ada-search-ignore-string-comment "\\<record\\>"
nil
orgpoint)))
(goto-char (car match-dat))
(+ (current-indentation) ada-indent))
;;
;; complete type declaration
;;
((save-excursion
(ada-search-ignore-string-comment ";" nil orgpoint))
(current-indentation))
;;
;; "type ... is", but not "type ... is ...", which is broken
;;
((save-excursion
(and
(ada-search-ignore-string-comment "\\<is\\>" nil orgpoint)
(not (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))))
(+ (current-indentation) ada-indent))
;;
;; broken statement
;;
(t
(+ (current-indentation) ada-broken-indent)))))
\f
;;; ---- support-functions for indentation
;;; ---- searching and matching
(defun ada-goto-stmt-start (&optional limit)
;; Moves point to the beginning of the statement that point is in or
;; after. Returns the new position of point. Beginnings are found
;; by searching for 'ada-end-stmt-re' and then moving to the
;; following non-ws that is not a comment. LIMIT is actually not
;; used by the indentation functions.
(let ((match-dat nil)
(orgpoint (point)))
(setq match-dat (ada-search-prev-end-stmt limit))
(if match-dat
;;
;; found a previous end-statement => check if anything follows
;;
(progn
(if (not
(save-excursion
(goto-char (cdr match-dat))
(ada-search-ignore-string-comment
"[^ \t\n]" nil orgpoint)))
;;
;; nothing follows => it's the end-statement directly in
;; front of point => search again
;;
(setq match-dat (ada-search-prev-end-stmt limit)))
;;
;; if found the correct end-statement => goto next non-ws
;;
(if match-dat
(goto-char (cdr match-dat)))
(ada-goto-next-non-ws))
;;
;; no previous end-statement => we are at the beginning of the
;; accessible part of the buffer
;;
(progn
(goto-char (point-min))
;;
;; skip to the very first statement, if there is one
;;
(if (setq match-dat
(ada-search-ignore-string-comment
"[^ \t\n]" nil orgpoint))
(goto-char (car match-dat))
(goto-char orgpoint))))
(point)))
(defun ada-search-prev-end-stmt (&optional limit)
;; Moves point to previous end-statement. Returns a cons cell whose
;; car is the beginning and whose cdr the end of the match.
;; End-statements are defined by 'ada-end-stmt-re'. Checks for
;; certain keywords if they follow 'end', which means they are no
;; end-statement there.
(let ((match-dat nil)
(pos nil)
(found nil))
;;
;; search until found or beginning-of-buffer
;;
(while
(and
(not found)
(setq match-dat (ada-search-ignore-string-comment ada-end-stmt-re
t
limit)))
(goto-char (car match-dat))
(if (not (ada-in-open-paren-p))
;;
;; check if there is an 'end' in front of the match
;;
(if (not (and
(looking-at
"\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
(save-excursion
(ada-goto-previous-word)
(looking-at "\\<\\(end\\|or\\|and\\)\\>"))))
(save-excursion
(goto-char (cdr match-dat))
(ada-goto-next-word)
(if (not (looking-at "\\<\\(separate\\|new\\)\\>"))
(setq found t)))
(forward-word -1)))) ; end of loop
(if found
match-dat
nil)))
(defun ada-goto-next-non-ws (&optional limit)
;; Skips whitespaces, newlines and comments to next non-ws
;; character. Signals an error if there is no more such character
;; and limit is nil.
(let ((match-cons nil))
(setq match-cons (ada-search-ignore-string-comment
"[^ \t\n]" nil limit t))
(if match-cons
(goto-char (car match-cons))
(if (not limit)
(error "no more non-ws")
nil))))
(defun ada-goto-stmt-end (&optional limit)
;; Moves point to the end of the statement that point is in or
;; before. Returns the new position of point or nil if not found.
(if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
(point)
nil))
(defun ada-goto-next-word (&optional backward)
;; Moves point to the beginning of the next word of Ada code.
;; If BACKWARD is non-nil, jump to the beginning of the previous word.
;; Returns the new position of point or nil if not found.
(let ((match-cons nil)
(orgpoint (point)))
(if (not backward)
(skip-chars-forward "_a-zA-Z0-9\\."))
(if (setq match-cons
(ada-search-ignore-string-comment "\\w" backward nil t))
;;
;; move to the beginning of the word found
;;
(progn
(goto-char (car match-cons))
(skip-chars-backward "_a-zA-Z0-9")
(point))
;;
;; if not found, restore old position of point
;;
(progn
(goto-char orgpoint)
'nil))))
(defun ada-goto-previous-word ()
;; Moves point to the beginning of the previous word of Ada code.
;; Returns the new position of point or nil if not found.
(ada-goto-next-word t))
(defun ada-check-matching-start (keyword)
;; Signals an error if matching block start is not KEYWORD.
;; Moves point to the matching block start.
(ada-goto-matching-start 0)
(if (not (looking-at (concat "\\<" keyword "\\>")))
(error "matching start is not '%s'" keyword)))
(defun ada-check-defun-name (defun-name)
;; Checks if the name of the matching defun really is DEFUN-NAME.
;; Assumes point to be already positioned by 'ada-goto-matching-start'.
;; Moves point to the beginning of the declaration.
;;
;; named block without a `declare'
;;
(if (save-excursion
(ada-goto-previous-word)
(looking-at (concat "\\<" defun-name "\\> *:")))
t ; do nothing
;;
;; 'accept' or 'package' ?
;;
(if (not (looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>"))
(ada-goto-matching-decl-start))
;;
;; 'begin' of 'procedure'/'function'/'task' or 'declare'
;;
(save-excursion
;;
;; a named 'declare'-block ?
;;
(if (looking-at "\\<declare\\>")
(ada-goto-stmt-start)
;;
;; no, => 'procedure'/'function'/'task'/'protected'
;;
(progn
(forward-word 2)
(backward-word 1)
;;
;; skip 'body' 'type'
;;
(if (looking-at "\\<\\(body\\|type\\)\\>")
(forward-word 1))
(forward-sexp 1)
(backward-sexp 1)))
;;
;; should be looking-at the correct name
;;
(if (not (looking-at (concat "\\<" defun-name "\\>")))
(error "matching defun has different name: %s"
(buffer-substring (point)
(progn (forward-sexp 1) (point))))))))
(defun ada-goto-matching-decl-start (&optional noerror nogeneric)
;; Moves point to the matching declaration start of the current 'begin'.
;; If NOERROR is non-nil, it only returns nil if no match was found.
(let ((nest-count 1)
(pos nil)
(first t)
(flag nil))
;;
;; search backward for interesting keywords
;;
(while (and
(not (zerop nest-count))
(ada-search-ignore-string-comment
(concat "\\<\\("
"is\\|separate\\|end\\|declare\\|new\\|begin\\|generic"
"\\)\\>") t))
;;
;; calculate nest-depth
;;
(cond
;;
((looking-at "end")
(ada-goto-matching-start 1 noerror)
(if (looking-at "begin")
(setq nest-count (1+ nest-count))))
;;
((looking-at "declare\\|generic")
(setq nest-count (1- nest-count))
(setq first nil))
;;
((looking-at "is")
;; check if it is only a type definition, but not a protected
;; type definition, which should be handled like a procedure.
(if (or (looking-at "is +<>")
(save-excursion
(ada-goto-previous-word)
(skip-chars-backward "a-zA-Z0-9_.'")
(if (save-excursion
(backward-char 1)
(looking-at ")"))
(progn
(forward-char 1)
(backward-sexp 1)
(skip-chars-backward "a-zA-Z0-9_.'")
))
(ada-goto-previous-word)
(and
(looking-at "\\<type\\>")
(save-match-data
(ada-goto-previous-word)
(not (looking-at "\\<protected\\>"))))
)); end of `or'
(goto-char (match-beginning 0))
(progn
(setq nest-count (1- nest-count))
(setq first nil))))
;;
((looking-at "new")
(if (save-excursion
(ada-goto-previous-word)
(looking-at "is"))
(goto-char (match-beginning 0))))
;;
((and first
(looking-at "begin"))
(setq nest-count 0)
(setq flag t))
;;
(t
(setq nest-count (1+ nest-count))
(setq first nil)))
) ;; end of loop
;; check if declaration-start is really found
(if (not
(and
(zerop nest-count)
(not flag)
(if (looking-at "is")
(ada-search-ignore-string-comment ada-subprog-start-re t)
(looking-at "declare\\|generic"))))
(if noerror nil
(error "no matching proc/func/task/declare/package/protected"))
t)))
(defun ada-goto-matching-start (&optional nest-level noerror gotothen)
;; Moves point to the beginning of a block-start. Which block
;; depends on the value of NEST-LEVEL, which defaults to zero. If
;; NOERROR is non-nil, it only returns nil if no matching start was
;; found. If GOTOTHEN is non-nil, point moves to the 'then'
;; following 'if'.
(let ((nest-count (if nest-level nest-level 0))
(found nil)
(pos nil))
;;
;; search backward for interesting keywords
;;
(while (and
(not found)
(ada-search-ignore-string-comment
(concat "\\<\\("
"end\\|loop\\|select\\|begin\\|case\\|do\\|"
"if\\|task\\|package\\|record\\|protected\\)\\>")
t))
;;
;; calculate nest-depth
;;
(cond
;; found block end => increase nest depth
((looking-at "end")
(setq nest-count (1+ nest-count)))
;; found loop/select/record/case/if => check if it starts or
;; ends a block
((looking-at "loop\\|select\\|record\\|case\\|if")
(setq pos (point))
(save-excursion
;;
;; check if keyword follows 'end'
;;
(ada-goto-previous-word)
(if (looking-at "\\<end\\> *[^;]")
;; it ends a block => increase nest depth
(progn
(setq nest-count (1+ nest-count))
(setq pos (point)))
;; it starts a block => decrease nest depth
(setq nest-count (1- nest-count))))
(goto-char pos))
;; found package start => check if it really is a block
((looking-at "package")
(save-excursion
(ada-search-ignore-string-comment "\\<is\\>")
(ada-goto-next-non-ws)
;; ignore it if it is only a declaration with 'new'
(if (not (looking-at "\\<new\\>"))
(setq nest-count (1- nest-count)))))
;; found task start => check if it has a body
((looking-at "task")
(save-excursion
(forward-word 1)
(ada-goto-next-non-ws)
;; ignore it if it has no body
(if (not (looking-at "\\<body\\>"))
(setq nest-count (1- nest-count)))))
;; all the other block starts
(t
(setq nest-count (1- nest-count)))) ; end of 'cond'
;; match is found, if nest-depth is zero
;;
(setq found (zerop nest-count))) ; end of loop
(if found
;;
;; match found => is there anything else to do ?
;;
(progn
(cond
;;
;; found 'if' => skip to 'then', if it's on a separate line
;; and GOTOTHEN is non-nil
;;
((and
gotothen
(looking-at "if")
(save-excursion
(ada-search-ignore-string-comment "\\<then\\>" nil nil)
(back-to-indentation)
(looking-at "\\<then\\>")))
(goto-char (match-beginning 0)))
;;
;; found 'do' => skip back to 'accept'
;;
((looking-at "do")
(if (not (ada-search-ignore-string-comment "\\<accept\\>" t nil))
(error "missing 'accept' in front of 'do'"))))
(point))
(if noerror
nil
(error "no matching start")))))
(defun ada-goto-matching-end (&optional nest-level noerror)
;; Moves point to the end of a block. Which block depends on the
;; value of NEST-LEVEL, which defaults to zero. If NOERROR is
;; non-nil, it only returns nil if found no matching start.
(let ((nest-count (if nest-level nest-level 0))
(found nil))
;;
;; search forward for interesting keywords
;;
(while (and
(not found)
(ada-search-ignore-string-comment
(concat "\\<\\(end\\|loop\\|select\\|begin\\|case\\|"
"if\\|task\\|package\\|record\\|do\\)\\>")))
;;
;; calculate nest-depth
;;
(backward-word 1)
(cond
;; found block end => decrease nest depth
((looking-at "\\<end\\>")
(setq nest-count (1- nest-count))
;; skip the following keyword
(if (progn
(skip-chars-forward "end")
(ada-goto-next-non-ws)
(looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
(forward-word 1)))
;; found package start => check if it really starts a block
((looking-at "\\<package\\>")
(ada-search-ignore-string-comment "\\<is\\>")
(ada-goto-next-non-ws)
;; ignore and skip it if it is only a 'new' package
(if (not (looking-at "\\<new\\>"))
(setq nest-count (1+ nest-count))
(skip-chars-forward "new")))
;; all the other block starts
(t
(setq nest-count (1+ nest-count))
(forward-word 1))) ; end of 'cond'
;; match is found, if nest-depth is zero
;;
(setq found (zerop nest-count))) ; end of loop
(if (not found)
(if noerror
nil
(error "no matching end"))
t)))
(defun ada-forward-sexp-ignore-comment ()
;; Skips one sexp forward, ignoring comments.
(while (looking-at "[ \t\n]*--")
(skip-chars-forward "[ \t\n]")
(end-of-line))
(forward-sexp 1))
(defun ada-search-ignore-string-comment
(search-re &optional backward limit paramlists)
;; Regexp-Search for SEARCH-RE, ignoring comments, strings and
;; parameter lists, if PARAMLISTS is nil. Returns a cons cell of
;; begin and end of match data or nil, if not found.
(let ((found nil)
(begin nil)
(end nil)
(pos nil)
(search-func
(if backward 're-search-backward
're-search-forward)))
;;
;; search until found or end-of-buffer
;;
(while (and (not found)
(funcall search-func search-re limit 1))
(setq begin (match-beginning 0))
(setq end (match-end 0))
(cond
;;
;; found in comment => skip it
;;
((ada-in-comment-p)
(if backward
(progn
(re-search-backward "--" nil 1)
(goto-char (match-beginning 0)))
(progn
(forward-line 1)
(beginning-of-line))))
;;
;; found in string => skip it
;;
((ada-in-string-p)
(if backward
(progn
(re-search-backward "\"" nil 1) ; "\"\\|#" don't treat #
(goto-char (match-beginning 0))))
(re-search-forward "\"" nil 1))
;;
;; found character constant => ignore it
;;
((save-excursion
(setq pos (- (point) (if backward 1 2)))
(and (char-after pos)
(= (char-after pos) ?')
(= (char-after (+ pos 2)) ?')))
())
;;
;; found a parameter-list but should ignore it => skip it
;;
((and (not paramlists)
(ada-in-paramlist-p))
(if backward
(ada-search-ignore-string-comment "(" t nil t)))
;;
;; directly in front of a comment => skip it, if searching forward
;;
((save-excursion
(goto-char begin)
(looking-at "--"))
(if (not backward)
(progn
(forward-line 1)
(beginning-of-line))))
;;
;; found what we were looking for
--- end of part 2 ---
next prev parent reply other threads:[~1998-04-12 0:00 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
1998-04-11 0:00 EMACS Ada Mode Update? Dave Retherford
1998-04-12 0:00 ` - ada-mode V2.28.text (3/3) " Matthew Heaney
1998-04-13 0:00 ` Stephen Leake
1998-04-12 0:00 ` Matthew Heaney [this message]
1998-04-12 0:00 ` - ada-mode V2.28.text (0/3) " Matthew Heaney
1998-04-12 0:00 ` - ada-mode V2.28.text (1/3) " Matthew Heaney
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox