emacs: lisp/progmodes/ada-mode.el comparison

comparison lisp/progmodes/ada-mode.el @ 106903:257da94c161b

* ada-mode.el: Really fix bug#5400 (comment in r99362 was erroneous). (ada-matching-decl-start-re): Move into ada-goto-decl-start. (ada-goto-decl-start): Rename from ada-goto-matching-decl-start; callers changed. Delete RECURSIVE parameter; never used. Improve doc string. Improve comments in "is" portion. Handle null procedure declaration. (ada-move-to-end): Improve doc string.

author	Juanma Barranquero <lekktu@gmail.com>
date	Tue, 19 Jan 2010 00:10:57 +0100
parents	908cefda5ea2
children	368fd338fecd

comparison

equal deleted inserted replaced

-:1748839af981
+:257da94c161b
 	    (regexp-opt
 	     '("end" "loop" "select" "begin" "case" "do" "declare"
 	       "if" "task" "package" "procedure" "function" "record" "protected") t)
 	    "\\>"))
 "Regexp used in `ada-goto-matching-start'.")
-(defvar ada-matching-decl-start-re
-(eval-when-compile
-(concat "\\<"
-	    (regexp-opt
-	     '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
-	    "\\>"))
-"Regexp used in `ada-goto-matching-decl-start'.")
 (defvar ada-loop-start-re
 "\\<\\(for\\|while\\|loop\\)\\>"
 "Regexp for the start of a loop.")
 ;;---------------------------
 ((and (= (downcase (char-after)) ?b)
 	   (looking-at "begin\\>"))
 (save-excursion
-	(if (ada-goto-matching-decl-start t)
+	(if (ada-goto-decl-start t)
 	    (list (progn (back-to-indentation) (point)) 0)
 	  (ada-indent-on-previous-lines nil orgpoint orgpoint))))
 ;;---------------------------
 ;;   starting with i (is)
 	    (save-excursion
 	      (ada-goto-matching-start 0)
 	      (if (looking-at "\\<begin\\>")
 		  (progn
 		    (setq indent (list (point) 0))
-		    (if (ada-goto-matching-decl-start t)
+		    (if (ada-goto-decl-start t)
 			(list (progn (back-to-indentation) (point)) 0)
 		      indent))
 		(list (progn (back-to-indentation) (point)) 0)
 		)))
 	   ;;
 (if found
 	match-dat
 nil)))
 (defun ada-goto-next-non-ws (&optional limit skip-goto-label)
 "Skip to next non-whitespace character.
 Skips spaces, newlines and comments, and possibly goto labels.
 Return `point' if moved, nil if not.
 Stop the search at LIMIT.
 ;; named block without a `declare'; ada-goto-matching-start leaves
 ;; point at start of 'begin' for a block.
 (if (save-excursion
 	(ada-goto-previous-word)
 	(looking-at (concat "\\<" defun-name "\\> *:")))
-t                                 ; do nothing
+t                                 ; name matches
 ;; else
 ;;
 ;; 'accept' or 'package' ?
 ;;
 (unless (looking-at ada-subprog-start-re)
-(ada-goto-matching-decl-start))
+(ada-goto-decl-start))
 ;;
 ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
 ;;
 (save-excursion
 ;;
 (unless (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 recursive)
+(defun ada-goto-decl-start (&optional noerror)
-"Move point to the matching declaration start of the current 'begin'.
+"Move point to the declaration start of the current construct.
-If NOERROR is non-nil, it only returns nil if no match was found."
+If NOERROR is non-nil, return nil if no match was found;
+otherwise throw error."
 (let ((nest-count 1)
+(regexp (eval-when-compile
+(concat "\\<"
+(regexp-opt
+'("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
+"\\>")))
 	;;  first should be set to t if we should stop at the first
 	;;  "begin" we encounter.
-	(first (not recursive))
+	(first t)
 	(count-generic nil)
 	(stop-at-when nil)
 	)
 ;;  Ignore "when" most of the time, except if we are looking at the
 	(setq count-generic t))
 ;; search backward for interesting keywords
 (while (and
 	    (not (zerop nest-count))
-	    (ada-search-ignore-string-comment ada-matching-decl-start-re t))
+	    (ada-search-ignore-string-comment regexp t))
 ;;
 ;; calculate nest-depth
 ;;
 (cond
 ;;
 		   "\\<\\(declare\\|begin\\|end\\|procedure\\|function\\|task\\|package\\)\\>"
 		   t)
 		  (if (looking-at "end")
 		      (ada-goto-matching-start 1 noerror t)
-		    ;; (ada-goto-matching-decl-start noerror t)
 		    (setq loop-again nil)
 		    (unless (looking-at "begin")
 		      (setq nest-count (1+ nest-count))))
 		  ))
 ((looking-at "declare\\|generic")
 	(setq nest-count (1- nest-count))
 	(setq first t))
 ;;
 ((looking-at "is")
-	;; check if it is only a type definition, but not a protected
+;; look for things to ignore
-	;; type definition, which should be handled like a procedure.
+(if
-	(if (or (looking-at "is[ \t]+<>")
+(or
-		(save-excursion
+;; generic formal parameter
-		  (forward-comment -10000)
+(looking-at "is[ t]+<>")
-		  (forward-char -1)
+;; A type definition, or a case statement.  Note that the
-		  ;; Detect if we have a closing parenthesis (Could be
+;; goto-matching-start above on 'end record' leaves us at
-		  ;; either the end of subprogram parameters or (<>)
+;; 'record', not at 'type'.
-		  ;; in a type definition
+;;
-		  (if (= (char-after) ?\))
+;; We get to a case statement here by calling
-		      (progn
+;; 'ada-move-to-end' from inside a case statement; then
-			(forward-char 1)
+;; we are not ignoring 'when'.
-			(backward-sexp 1)
+(save-excursion
-			(forward-comment -10000)
+;; Skip type discriminants or case argument function call param list
-			))
+(forward-comment -10000)
-		  (skip-chars-backward "a-zA-Z0-9_.'")
+(forward-char -1)
-		  (ada-goto-previous-word)
+(if (= (char-after) ?\))
-		  (and
+(progn
-		   (looking-at "\\<\\(sub\\)?type\\|case\\>")
+(forward-char 1)
+(backward-sexp 1)
+(forward-comment -10000)
+))
+;; skip type or case argument name
+(skip-chars-backward "a-zA-Z0-9_.'")
+(ada-goto-previous-word)
+(and
+;; if it's a protected type, it's the decl start we
+;; are looking for; since we didn't see the 'end'
+;; above, we are inside it.
+(looking-at "\\<\\(sub\\)?type\\|case\\>")
 		   (save-match-data
 		     (ada-goto-previous-word)
 		     (not (looking-at "\\<protected\\>"))))
-		  ))                    ; end of `or'
+)                    ; end of type definition p
-	    (goto-char (match-beginning 0))
-	  (progn
+;; null procedure declaration
-	    (setq nest-count (1- nest-count))
+(save-excursion (ada-goto-next-word) (looking-at "\\<null\\>"))
-	    (setq first nil))))
+);; end or
+;; skip this construct
+nil
+;; this is the right "is"
+(setq nest-count (1- nest-count))
+(setq first nil)))
 ;;
 ((looking-at "new")
 	(if (save-excursion
 	      (ada-goto-previous-word)
 (defun ada-in-decl-p ()
 "Return t if point is inside a declarative part.
 Assumes point to be at the end of a statement."
 (or (ada-in-paramlist-p)
 (save-excursion
-	(ada-goto-matching-decl-start t))))
+	(ada-goto-decl-start t))))
 (defun ada-looking-at-semi-or ()
 "Return t if looking at an 'or' following a semicolon."
 (save-excursion
 		  ;;
 		  ;; on 'begin' => go on, according to user option
 		  ;;
 		  ada-move-to-declaration
 		  (looking-at "\\<begin\\>")
-		  (ada-goto-matching-decl-start)
+		  (ada-goto-decl-start)
 		  (setq pos (point))))
 	    )                           ; end of save-excursion
 	  ;; now really move to the found position
 ;; restore syntax-table
 (set-syntax-table previous-syntax-table))))
 (defun ada-move-to-end ()
-"Move point to the matching end of the block around point.
+"Move point to the end of the block around point.
 Moves to 'begin' if in a declarative part."
 (interactive)
 (let ((pos (point))
 	decl-start
 	(previous-syntax-table (syntax-table)))
 		(and (ada-goto-stmt-start)
 		     (looking-at "\\<accept\\>" )))
 	      (ada-goto-matching-end 0))
 	     ;; package start
 	     ((save-excursion
-		(setq decl-start (and (ada-goto-matching-decl-start t) (point)))
+		(setq decl-start (and (ada-goto-decl-start t) (point)))
 		(and decl-start (looking-at "\\<package\\>")))
 	      (ada-goto-matching-end 1))
 	     ;;  On a "declare" keyword
 	     ((save-excursion

Mercurial > emacs

comparison lisp/progmodes/ada-mode.el @ 106903:257da94c161b