X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/32b1a27f286c7d588ef3c49559d3ecd08d1ef154..36045ff3301341130c1e2048a0fa73ec72fc68bf:/lisp/progmodes/ada-mode.el diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index ec5504e471..95f9f6babf 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1,7 +1,7 @@ ;;; ada-mode.el --- major-mode for editing Ada sources ;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Rolf Ebert ;; Markus Heritsch @@ -128,7 +128,6 @@ (require 'which-func nil t) (require 'compile nil t) -(defvar compile-auto-highlight) (defvar ispell-check-comments) (defvar skeleton-further-elements) @@ -136,7 +135,7 @@ "Return Ada mode version." (interactive) (let ((version-string "4.00")) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message version-string) version-string))) @@ -233,6 +232,10 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or (defcustom ada-clean-buffer-before-saving t "*Non-nil means remove trailing spaces and untabify the buffer before saving." :type 'boolean :group 'ada) +(make-obsolete-variable 'ada-clean-buffer-before-saving + "use the `write-file-functions' hook." + "23.2") + (defcustom ada-indent 3 "*Size of Ada indentation. @@ -254,7 +257,7 @@ Note that indentation is calculated only if `ada-indent-comment-as-code' is t. For instance: A := 1; -- A multi-line comment - -- aligned if ada-indent-align-comments is t" + -- aligned if `ada-indent-align-comments' is t" :type 'boolean :group 'ada) (defcustom ada-indent-comment-as-code t @@ -587,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. @@ -657,28 +677,16 @@ A new statement starts after these.") "\\>")) "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.") (defvar ada-subprog-start-re (eval-when-compile - (concat "\\<" (regexp-opt '("accept" "entry" "function" "package" "procedure" + (concat "\\<" (regexp-opt '("accept" "entry" "function" "overriding" "package" "procedure" "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.") @@ -718,7 +726,7 @@ displaying the menu if point was on an identifier." (defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?") (defconst ada-imenu-subprogram-menu-re - (concat "^[ \t]*\\(procedure\\|function\\)[ \t\n]+" + (concat "^[ \t]*\\(overriding[ \t]*\\)?\\(procedure\\|function\\)[ \t\n]+" "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)" ada-imenu-comment-re "\\)[ \t\n]*" @@ -726,7 +734,7 @@ displaying the menu if point was on an identifier." (defvar ada-imenu-generic-expression (list - (list nil ada-imenu-subprogram-menu-re 2) + (list nil ada-imenu-subprogram-menu-re 3) (list "*Specs*" (concat "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)" @@ -794,8 +802,9 @@ the 4 file locations can be clicked on and jumped to." (compilation-find-file (point-marker) (match-string 1) "./") (set-buffer file) - (if (stringp line) - (goto-line (string-to-number line))) + (when (stringp line) + (goto-char (point-min)) + (forward-line (1- (string-to-number line)))) (setq source (point-marker))) @@ -1008,6 +1017,9 @@ If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'." (line-beginning-position) (point)))) (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result))) +(defsubst ada-in-numeric-literal-p () + "Return t if point is after a prefix of a numeric literal." + (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)")) ;;------------------------------------------------------------------ ;; Contextual menus @@ -1106,48 +1118,7 @@ the file name." ;;;###autoload (defun ada-mode () - "Ada mode is the major mode for editing Ada code. - -Bindings are as follows: (Note: 'LFD' is control-j.) -\\{ada-mode-map} - - Indent line '\\[ada-tab]' - Indent line, insert newline and indent the new line. '\\[newline-and-indent]' - - Re-format the parameter-list point is in '\\[ada-format-paramlist]' - Indent all lines in region '\\[ada-indent-region]' - - Adjust case of identifiers and keywords in region '\\[ada-adjust-case-region]' - Adjust case of identifiers and keywords in buffer '\\[ada-adjust-case-buffer]' - - Fill comment paragraph, justify and append postfix '\\[fill-paragraph]' - - Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]' - Next package '\\[ada-next-package]' Previous package '\\[ada-previous-package]' - - Goto matching start of current 'end ...;' '\\[ada-move-to-start]' - Goto end of current block '\\[ada-move-to-end]' - -Comments are handled using standard GNU Emacs conventions, including: - Start a comment '\\[indent-for-comment]' - Comment region '\\[comment-region]' - Uncomment region '\\[ada-uncomment-region]' - Continue comment on next line '\\[indent-new-comment-line]' - -If you use imenu.el: - Display index-menu of functions and procedures '\\[imenu]' - -If you use find-file.el: - Switch to other file (Body <-> Spec) '\\[ff-find-other-file]' - or '\\[ff-mouse-find-other-file] - Switch to other file in other window '\\[ada-ff-other-window]' - or '\\[ff-mouse-find-other-file-other-window] - If you use this function in a spec and no body is available, it gets created with body stubs. - -If you use ada-xref.el: - Goto declaration: '\\[ada-point-and-xref]' on the identifier - or '\\[ada-goto-declaration]' with point on the identifier - Complete identifier: '\\[ada-complete-identifier]'." + "Ada mode is the major mode for editing Ada code." (interactive) (kill-all-local-variables) @@ -1201,7 +1172,6 @@ If you use ada-xref.el: ;; We just substitute our own functions to go to the error. (add-hook 'compilation-mode-hook (lambda() - (set (make-local-variable 'compile-auto-highlight) 40) ;; FIXME: This has global impact! -stef (define-key compilation-minor-mode-map [mouse-2] 'ada-compile-mouse-goto-error) @@ -1343,14 +1313,6 @@ If you use ada-xref.el: (set-syntax-table ada-mode-syntax-table) - (if ada-clean-buffer-before-saving - (progn - ;; remove all spaces at the end of lines in the whole buffer. - (add-hook 'local-write-file-hooks 'delete-trailing-whitespace) - ;; convert all tabs to the correct number of spaces. - (add-hook 'local-write-file-hooks - (lambda () (untabify (point-min) (point-max)))))) - (set (make-local-variable 'skeleton-further-elements) '((< '(backward-delete-char-untabify (min ada-indent (current-column)))))) @@ -1647,6 +1609,8 @@ If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." (eq (char-syntax (char-before)) ?w) ;; if in a string or a comment (not (ada-in-string-or-comment-p)) + ;; if in a numeric literal + (not (ada-in-numeric-literal-p)) ) (if (save-excursion (forward-word -1) @@ -1669,7 +1633,7 @@ ARG is the prefix the user entered with \\[universal-argument]." (interactive "P") (if ada-auto-case - (let ((lastk last-command-char) + (let ((lastk last-command-event) (previous-syntax-table (syntax-table))) (unwind-protect @@ -1703,9 +1667,9 @@ ARG is the prefix the user entered with \\[universal-argument]." ;; Else, no auto-casing (cond - ((eq last-command-char ?\n) + ((eq last-command-event ?\n) (funcall ada-lfd-binding)) - ((eq last-command-char ?\r) + ((eq last-command-event ?\r) (funcall ada-ret-binding)) (t (self-insert-command (prefix-numeric-value arg)))) @@ -2154,10 +2118,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 () @@ -2381,8 +2353,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' => @@ -2501,7 +2473,7 @@ and the offset." ((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)))) @@ -2523,7 +2495,7 @@ and the offset." (list (progn (back-to-indentation) (point)) 'ada-indent)) (save-excursion (ada-goto-stmt-start) - (if (looking-at "\\") + (if (looking-at "\\") (list (progn (back-to-indentation) (point)) 0) (list (progn (back-to-indentation) (point)) 'ada-indent))))) @@ -2672,27 +2644,31 @@ and the offset." (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")) (save-excursion ;; Go up until we find either a generic section, or the end of the - ;; previous subprogram/package + ;; previous subprogram/package, or 'overriding' for this function/procedure (let (found) (while (and (not found) (ada-search-ignore-string-comment - "\\<\\(generic\\|end\\|begin\\|package\\|procedure\\|function\\)\\>" t)) + "\\<\\(generic\\|end\\|begin\\|overriding\\|package\\|procedure\\|function\\)\\>" t)) ;; avoid "with procedure"... in generic parts (save-excursion (forward-word -1) (setq found (not (looking-at "with")))))) - (if (looking-at "generic") - (list (progn (back-to-indentation) (point)) 0) - (ada-indent-on-previous-lines nil orgpoint orgpoint)))) + (cond + ((looking-at "\\") + (list (progn (back-to-indentation) (point)) 0)) + + (t + (ada-indent-on-previous-lines nil orgpoint orgpoint))))) ;;--------------------------------- ;; 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)))) @@ -2717,9 +2693,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)) @@ -2745,6 +2722,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)) ;; @@ -2760,17 +2743,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 @@ -2822,7 +2796,7 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation." (t (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) (ada-goto-next-non-ws) - (list (point) 0))))) + (list (point) 'ada-broken-indent))))) (defun ada-get-indent-end (orgpoint) "Calculate the indentation when point is just before an end statement. @@ -2840,12 +2814,15 @@ ORGPOINT is the limit position used in the calculation." (forward-word 1) (ada-goto-next-non-ws) (cond - ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>") + ;; + ;; loop/select/if/case/return + ;; + ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|return\\)\\>") (save-excursion (ada-check-matching-start (match-string 0))) (list (save-excursion (back-to-indentation) (point)) 0)) ;; - ;; loop/select/if/case/record/select + ;; record ;; ((looking-at "\\") (save-excursion @@ -2875,7 +2852,7 @@ ORGPOINT is the limit position used in the calculation." (if (looking-at "\\") (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) @@ -3000,6 +2977,10 @@ ORGPOINT is the limit position used in the calculation." (car (ada-search-ignore-string-comment "\\" 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))))) @@ -3095,10 +3076,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) @@ -3127,7 +3108,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) @@ -3159,6 +3140,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." @@ -3167,8 +3158,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)))) @@ -3188,7 +3179,7 @@ ORGPOINT is the limit position used in the calculation." (setq pos (ada-get-indent-block-start orgpoint)) (if (equal label 0) pos - (list (+ (car pos) label) (cdr pos)))) + (list (+ (car pos) label) (cadr pos)))) ;; ;; 'for'- loop (or also a for ... use statement) @@ -3326,7 +3317,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 @@ -3344,7 +3335,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 @@ -3366,7 +3357,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))) @@ -3427,19 +3418,25 @@ is the end of the match." match-dat 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) @@ -3466,9 +3463,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 ;; @@ -3503,13 +3498,13 @@ Moves point to the beginning of the declaration." (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' ;; @@ -3542,14 +3537,20 @@ Moves point to the beginning of the declaration." (buffer-substring (point) (progn (forward-sexp 1) (point)))))))) -(defun ada-goto-matching-decl-start (&optional noerror recursive) - "Move point to the matching declaration start of the current 'begin'. -If NOERROR is non-nil, it only returns nil if no match was found." +(defun ada-goto-decl-start (&optional noerror) + "Move point to the declaration start of the current construct. +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) ) @@ -3573,7 +3574,7 @@ If NOERROR is non-nil, it only returns nil if no match was found." ;; 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 ;; @@ -3606,7 +3607,6 @@ If NOERROR is non-nil, it only returns nil if no match was found." (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") @@ -3634,34 +3634,50 @@ If NOERROR is non-nil, it only returns nil if no match was found." (setq first t)) ;; ((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[ \t]+<>") - (save-excursion - (forward-comment -10000) - (forward-char -1) - - ;; Detect if we have a closing parenthesis (Could be - ;; either the end of subprogram parameters or (<>) - ;; in a type definition - (if (= (char-after) ?\)) - (progn - (forward-char 1) - (backward-sexp 1) - (forward-comment -10000) - )) - (skip-chars-backward "a-zA-Z0-9_.'") - (ada-goto-previous-word) - (and - (looking-at "\\<\\(sub\\)?type\\|case\\>") + ;; look for things to ignore + (if + (or + ;; generic formal parameter + (looking-at "is[ t]+<>") + + ;; A type definition, or a case statement. Note that the + ;; goto-matching-start above on 'end record' leaves us at + ;; 'record', not at 'type'. + ;; + ;; We get to a case statement here by calling + ;; 'ada-move-to-end' from inside a case statement; then + ;; we are not ignoring 'when'. + (save-excursion + ;; Skip type discriminants or case argument function call param list + (forward-comment -10000) + (forward-char -1) + (if (= (char-after) ?\)) + (progn + (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 "\\")))) - )) ; end of `or' - (goto-char (match-beginning 0)) - (progn - (setq nest-count (1- nest-count)) - (setq first nil)))) + ) ; end of type definition p + + ;; null procedure declaration + (save-excursion (ada-goto-next-word) (looking-at "\\")) + );; end or + ;; skip this construct + nil + ;; this is the right "is" + (setq nest-count (1- nest-count)) + (setq first nil))) ;; ((looking-at "new") @@ -3897,13 +3913,12 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'." (goto-char (match-beginning 0))) ;; - ;; found 'do' => skip back to 'accept' + ;; found 'do' => skip back to 'accept' or 'return' ;; ((looking-at "do") (unless (ada-search-ignore-string-comment - "accept" t nil nil - 'word-search-backward) - (error "Missing 'accept' in front of 'do'")))) + "\\" t) + (error "Missing 'accept' or 'return' in front of 'do'")))) (point)) (if noerror @@ -4117,7 +4132,7 @@ Point is moved at the beginning of the SEARCH-RE." 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 () @@ -4153,7 +4168,7 @@ Return nil if the private is part of the package name, as in (defun ada-in-paramlist-p () - "Return t if point is inside a parameter-list." + "Return t if point is inside the parameter-list of a declaration, but not a subprogram call or aggregate." (save-excursion (and (ada-search-ignore-string-comment "(\\|)" t nil t) @@ -4184,13 +4199,13 @@ Return nil if the private is part of the package name, as in ;; right keyword two words before parenthesis ? ;; Type is in this list because of discriminants + ;; pragma is not, because the syntax is that of a subprogram call. (looking-at (eval-when-compile (concat "\\<\\(" "procedure\\|function\\|body\\|" "task\\|entry\\|accept\\|" "access[ \t]+procedure\\|" "access[ \t]+function\\|" - "pragma\\|" "type\\)\\>")))))) (defun ada-search-ignore-complex-boolean (regexp backwardp) @@ -4411,7 +4426,7 @@ of the region. Otherwise, operate only on the current line." ;; ada-move-to-declaration (looking-at "\\") - (ada-goto-matching-decl-start) + (ada-goto-decl-start) (setq pos (point)))) ) ; end of save-excursion @@ -4423,7 +4438,7 @@ of the region. Otherwise, operate only on the current line." (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)) @@ -4473,7 +4488,7 @@ Moves to 'begin' if in a declarative part." (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 "\\"))) (ada-goto-matching-end 1)) @@ -4609,6 +4624,8 @@ Moves to 'begin' if in a declarative part." (define-key ada-mode-extra-map "u" 'ada-prj-edit) + (define-key ada-mode-map "\C-xnd" 'ada-narrow-to-defun); override narrow-to-defun + ;; The templates, defined in ada-stmt.el (let ((map (make-sparse-keymap))) @@ -5101,7 +5118,7 @@ Since the search can be long, the results are cached." ;; Get the function name, but not the properties, or this changes ;; the face in the modeline on Emacs 21 - (setq func-name (match-string-no-properties 2)) + (setq func-name (match-string-no-properties 3)) (if (and (not (ada-in-comment-p)) (not (save-excursion (goto-char (match-end 0))