From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,8a40deae6830f183
X-Google-Attributes: gid103376,public
From: matthew_heaney@acm.org (Matthew Heaney)
Subject: - ada-mode V2.28.text (2/3) Re: EMACS Ada Mode Update?
Date: 1998/04/12
Message-ID: <matthew_heaney-ya023680001204981554290001@news.ni.net>
X-Deja-AN: 343426872
Content-Transfer-Encoding: 8bit
References: <352ed24b.2940538@news.ghg.net>
Content-Type: text/plain; charset=ISO-8859-1
Organization: Network Intensive
Mime-Version: 1.0
Newsgroups: comp.lang.ada
Date: 1998-04-12T00:00:00+00:00
List-Id: <comp.lang.ada>


---
	     (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))))


;;;-----------------------------;;;
;;;  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)))))


;;; ---- 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 ---