[Emacs-diffs] /srv/bzr/emacs/trunk r99362: * progmodes/ada-mode.el: Fix bug#1920, bug#5400.

[Juanma Barranquero]

------------------------------------------------------------
revno: 99362
author: Stephen Leake <address@hidden>
committer: Juanma Barranquero <address@hidden>
branch nick: trunk
timestamp: Sun 2010-01-17 20:15:32 +0100
message:
  * 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.
modified:
  lisp/ChangeLog
  lisp/progmodes/ada-mode.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-01-17 05:08:35 +0000
+++ b/lisp/ChangeLog    2010-01-17 19:15:32 +0000
@@ -1,3 +1,24 @@
+2010-01-17  Stephen Leake  <address@hidden>
+
+       * 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  <address@hidden>
 
        * calc/calc.el (calc-command-flags): Give it an initial value.

=== modified file 'lisp/progmodes/ada-mode.el'
--- a/lisp/progmodes/ada-mode.el        2010-01-14 12:57:07 +0000
+++ b/lisp/progmodes/ada-mode.el        2010-01-17 19:15:32 +0000
@@ -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
        ;;