Commit 0b702bc1 authored by Stephen Leake's avatar Stephen Leake Committed by Juanma Barranquero
Browse files

* 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.
parent 3d1bfa99
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.
......
......@@ -590,8 +590,25 @@ This variable defines several rules to use to align different lines.")
;; 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 @@ A new statement starts after these.")
"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 @@ Return the equivalent internal parameter list."
(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 @@ and the offset."
(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 @@ and the offset."
;; 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 INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
(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 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
((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 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
((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 @@ ORGPOINT is the limit position used in the calculation."
(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 @@ ORGPOINT is the limit position used in the calculation."
(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 @@ ORGPOINT is the limit position used in the calculation."
(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 @@ ORGPOINT is the limit position used in the calculation."
(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 @@ ORGPOINT is the limit position used in the calculation."
;; 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 @@ ORGPOINT is the limit position used in the calculation."
;; -- 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 @@ open parenthesis."
(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 @@ open parenthesis."
(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 @@ is the end of the match."
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 @@ Return the new position of point or nil if not found."
(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
;;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment