Mercurial > emacs

--- a/lisp/ChangeLog	Sun Jan 17 13:15:25 2010 +0100
+++ b/lisp/ChangeLog	Sun Jan 17 20:15:32 2010 +0100
@@ -1,3 +1,24 @@
+2010-01-17  Stephen Leake  <stephen_leake@member.fsf.org>
+
+	* progmodes/ada-mode.el: Fix bug#1920, bug#5400.
+	(ada-ident-re): Delete ., allow multibyte characters.
+	(ada-goto-label-re): New; matches goto labels.
+	(ada-block-label-re): New; matches block labels.
+	(ada-label-re): New; matches both.
+	(ada-named-block-re): Deleted; callers changed to use
+	`ada-block-label-re' instead.
+	(ada-get-current-indent, ada-get-indent-noindent, ada-get-indent-loop):
+	Use `ada-block-label-re'.
+	(ada-indent-on-previous-lines): Improve handling of goto labels.
+	(ada-get-indent-block-start): Special-case block label.
+	(ada-get-indent-label): Split into `ada-indent-block-label' and
+	`ada-indent-goto-label'.
+	(ada-goto-stmt-start, ada-goto-next-non-ws):
+	Optionally ignore goto labels.
+	(ada-goto-next-word): Simplify.
+	(ada-indent-newline-indent-conditional): Insert newline before
+	trying to fix indentation; doc fix.
+
 2010-01-17  Jay Belanger  <jay.p.belanger@gmail.com>

 	* calc/calc.el (calc-command-flags): Give it an initial value.
--- a/lisp/progmodes/ada-mode.el	Sun Jan 17 13:15:25 2010 +0100
+++ b/lisp/progmodes/ada-mode.el	Sun Jan 17 20:15:32 2010 +0100
@@ -590,8 +590,25 @@
 ;; FIXME: make this customizable

 (defconst ada-ident-re
-  "\\(\\sw\\|[_.]\\)+"
-  "Regexp matching Ada (qualified) identifiers.")
+  "[[:alpha:]]\\(?:[_[:alnum:]]\\)*"
+  ;; [:alnum:] matches any multibyte word constituent, as well as
+  ;; Latin-1 letters and numbers. This allows __ and trailing _;
+  ;; someone (emacs bug#1919) proposed [^\W_] to fix that, but \W does
+  ;; _not_ mean "not word constituent" inside a character alternative.
+  "Regexp matching an Ada identifier.")
+
+(defconst ada-goto-label-re
+  (concat "<<" ada-ident-re ">>")
+  "Regexp matching a goto label.")
+
+(defconst ada-block-label-re
+  (concat ada-ident-re "[ \t\n]*:[^=]")
+  "Regexp matching a block label.
+Note that this also matches a variable declaration.")
+
+(defconst ada-label-re
+  (concat "\\(?:" ada-block-label-re "\\)\\|\\(?:" ada-goto-label-re "\\)")
+  "Regexp matching a goto or block label.")

 ;;  "with" needs to be included in the regexp, to match generic subprogram parameters
 ;;  Similarly, we put '[not] overriding' on the same line with 'procedure' etc.
@@ -678,10 +695,6 @@
 				"protected" "task") t) "\\>"))
   "Regexp for the start of a subprogram.")

-(defvar ada-named-block-re
-  "[ \t]*\\(\\sw\\|_\\)+[ \t]*:[^=]"
-  "Regexp of the name of a block or loop.")
-
 (defvar ada-contextual-menu-on-identifier nil
   "Set to true when the right mouse button was clicked on an identifier.")

@@ -2108,10 +2121,18 @@

 (defun ada-indent-newline-indent-conditional ()
   "Insert a newline and indent it.
-The original line is indented first if `ada-indent-after-return' is non-nil."
+The original line is re-indented if `ada-indent-after-return' is non-nil."
   (interactive "*")
-  (if ada-indent-after-return (ada-indent-current))
+  ;; If at end of buffer (entering brand new code), some indentation
+  ;; fails.  For example, a block label requires whitespace following
+  ;; the : to be recognized.  So we do the newline first, then
+  ;; go back and indent the original line.
   (newline)
+  (if ada-indent-after-return
+      (progn
+        (forward-char -1)
+        (ada-indent-current)
+        (forward-char 1)))
   (ada-indent-current))

 (defun ada-justified-indent-current ()
@@ -2335,8 +2356,8 @@
 		      (progn
 			(goto-char (car match-cons))
 			(save-excursion
-			  (beginning-of-line)
-			  (if (looking-at ada-named-block-re)
+			  (back-to-indentation)
+			  (if (looking-at ada-block-label-re)
 			      (setq label (- ada-label-indent))))))))

 	    ;; found 'record' =>
@@ -2648,8 +2669,9 @@
      ;; label
      ;;---------------------------------

-     ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
+     ((looking-at ada-label-re)
       (if (ada-in-decl-p)
+          ;; ada-block-label-re matches variable declarations
 	  (ada-indent-on-previous-lines nil orgpoint orgpoint)
 	(append (ada-indent-on-previous-lines nil orgpoint orgpoint)
 		'(ada-label-indent))))
@@ -2674,9 +2696,10 @@
     (if (ada-in-paramlist-p)
 	(ada-get-indent-paramlist)

-      ;; move to beginning of current statement
+      ;; Move to beginning of current statement. If already at a
+      ;; statement start, move to beginning of enclosing statement.
       (unless nomove
-	(ada-goto-stmt-start))
+	(ada-goto-stmt-start t))

       ;; no beginning found => don't change indentation
       (if (and (eq oldpoint (point))
@@ -2702,6 +2725,12 @@
 	 ((looking-at ada-block-start-re)
 	  (ada-get-indent-block-start orgpoint))
 	 ;;
+	 ((looking-at ada-block-label-re) ; also variable declaration
+	  (ada-get-indent-block-label orgpoint))
+	 ;;
+	 ((looking-at ada-goto-label-re)
+	  (ada-get-indent-goto-label orgpoint))
+	 ;;
 	 ((looking-at "\\(sub\\)?type\\>")
 	  (ada-get-indent-type orgpoint))
 	 ;;
@@ -2717,17 +2746,8 @@
 	 ((looking-at "when\\>")
 	  (ada-get-indent-when orgpoint))
 	 ;;
-	 ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
-	  (ada-get-indent-label orgpoint))
-	 ;;
 	 ((looking-at "separate\\>")
 	  (ada-get-indent-nochange))
-
-	 ;; A label
-	 ((looking-at "<<")
-	  (list (+ (save-excursion (back-to-indentation) (point))
-		   (- ada-label-indent))))
-
 	 ;;
 	 ((looking-at "with\\>\\|use\\>")
 	  ;;  Are we still in that statement, or are we in fact looking at
@@ -2960,6 +2980,10 @@
 		(car (ada-search-ignore-string-comment "\\<type\\>" t)))
 	      'ada-indent)))

+     ;; Special case for label:
+     ((looking-at ada-block-label-re)
+      (list (- (save-excursion (back-to-indentation) (point)) ada-label-indent) 'ada-indent))
+
      ;; nothing follows the block-start
      (t
       (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
@@ -3055,10 +3079,10 @@
 	(list (save-excursion (back-to-indentation) (point))
 	      'ada-broken-decl-indent))

-       ;;  This one is called in every over case when indenting a line at the
+       ;;  This one is called in every other case when indenting a line at the
        ;;  top level
        (t
-	(if (looking-at ada-named-block-re)
+	(if (looking-at (concat "[ \t]*" ada-block-label-re))
 	    (setq label (- ada-label-indent))

 	  (let (p)
@@ -3087,7 +3111,7 @@
 	  (list (+ (save-excursion (back-to-indentation) (point)) label)
 		'ada-broken-indent)))))))

-(defun ada-get-indent-label (orgpoint)
+(defun ada-get-indent-block-label (orgpoint)
   "Calculate the indentation when before a label or variable declaration.
 ORGPOINT is the limit position used in the calculation."
   (let ((match-cons nil)
@@ -3119,6 +3143,16 @@
      (t
       (list cur-indent '(- ada-label-indent))))))

+(defun ada-get-indent-goto-label (orgpoint)
+  "Calculate the indentation when at a goto label."
+  (search-forward ">>")
+  (ada-goto-next-non-ws)
+  (if (>= (point) orgpoint)
+      ;; labeled statement is the one we need to indent
+      (list (- (point) ada-label-indent))
+    ;; else indentation is indent for labeled statement
+    (ada-indent-on-previous-lines t orgpoint)))
+
 (defun ada-get-indent-loop (orgpoint)
   "Calculate the indentation when just before a loop or a for ... use.
 ORGPOINT is the limit position used in the calculation."
@@ -3127,8 +3161,8 @@

 	;; If looking at a named block, skip the label
 	(label (save-excursion
-		 (beginning-of-line)
-		 (if (looking-at ada-named-block-re)
+		 (back-to-indentation)
+		 (if (looking-at ada-block-label-re)
 		     (- ada-label-indent)
 		   0))))

@@ -3286,7 +3320,7 @@
 ;; -- searching and matching
 ;; -----------------------------------------------------------

-(defun ada-goto-stmt-start ()
+(defun ada-goto-stmt-start (&optional ignore-goto-label)
   "Move point to the beginning of the statement that point is in or after.
 Return the new position of point.
 As a special case, if we are looking at a closing parenthesis, skip to the
@@ -3304,7 +3338,7 @@
 	  (progn
 	    (unless (save-excursion
 		      (goto-char (cdr match-dat))
-		      (ada-goto-next-non-ws orgpoint))
+		      (ada-goto-next-non-ws orgpoint ignore-goto-label))
 	      ;;
 	      ;; nothing follows => it's the end-statement directly in
 	      ;;                    front of point => search again
@@ -3326,7 +3360,7 @@
 	(goto-char (point-min))
 	;;
 	;; skip to the very first statement, if there is one
-	  ;;
+	;;
 	(unless (ada-goto-next-non-ws orgpoint)
 	  (goto-char orgpoint))))
     (point)))
@@ -3388,18 +3422,25 @@
       nil)))


-(defun ada-goto-next-non-ws (&optional limit)
-  "Skip white spaces, newlines and comments to next non-ws character.
+(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.
 Do not call this function from within a string."
   (unless limit
     (setq limit (point-max)))
   (while (and (<= (point) limit)
-	      (progn (forward-comment 10000)
-		     (if (and (not (eobp))
-			      (save-excursion (forward-char 1)
-					      (ada-in-string-p)))
-			 (progn (forward-sexp 1) t)))))
+	      (or (progn (forward-comment 10000)
+                         (if (and (not (eobp))
+                                  (save-excursion (forward-char 1)
+                                                  (ada-in-string-p)))
+                             (progn (forward-sexp 1) t)))
+                  (and skip-goto-label
+                       (looking-at ada-goto-label-re)
+                       (progn
+                         (goto-char (match-end 0))
+                         t)))))
   (if (< (point) limit)
       (point)
     nil)
@@ -3426,9 +3467,7 @@
     (unless backward
       (skip-syntax-forward "w"))
     (if (setq match-cons
-	     (if backward
-		 (ada-search-ignore-string-comment "\\w" t nil t)
-	       (ada-search-ignore-string-comment "\\w" nil nil t)))
+              (ada-search-ignore-string-comment "\\w" backward nil t))
 	;;
 	;; move to the beginning of the word found
 	;;