X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/5614e8da43643ed500c8695cb223e4cfda8f3fc1..23a624ca1d40fa9cefd7229ac6152b79278a6517:/packages/ada-mode/ada-mode.el

diff --git a/packages/ada-mode/ada-mode.el b/packages/ada-mode/ada-mode.el
old mode 100755
new mode 100644
index 8f76749a0..c67a3eac5
--- a/packages/ada-mode/ada-mode.el
+++ b/packages/ada-mode/ada-mode.el
@@ -4,9 +4,10 @@
 ;;
 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
-;; Keywords FIXME: languages, ada ELPA broken for multiple keywords
-;; Version: 5.1.5
-;; package-requires: ((wisi "1.0.5") (cl-lib "0.4") (emacs "24.2"))
+;; Keywords: languages
+;;  ada
+;; Version: 5.1.7
+;; package-requires: ((wisi "1.1.0") (cl-lib "0.4") (emacs "24.2"))
 ;; url: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html
 ;;
 ;; (Gnu ELPA requires single digits between dots in versions)
@@ -167,7 +168,7 @@
 (defun ada-mode-version ()
   "Return Ada mode version."
   (interactive)
-  (let ((version-string "5.1.5"))
+  (let ((version-string "5.1.7"))
     ;; must match:
     ;; ada-mode.texi
     ;; README
@@ -304,31 +305,20 @@ Values defined by cross reference packages.")
 
 ;;;; keymap and menus
 
-(defvar ada-ret-binding nil)
-(defvar ada-lfd-binding nil)
+(defvar ada-ret-binding 'ada-indent-newline-indent)
+(defvar ada-lfd-binding 'newline-and-indent)
 
-(defun ada-case-activate-keys ()
+(defun ada-case-activate-keys (map)
   "Modify the key bindings for all the keys that should adjust casing."
-  (interactive)
-  ;; We can't use post-self-insert-hook for \n, \r, because they are
-  ;; not self-insert.
-
-  ;; The 'or ...' is there to be sure that the value will not be
-  ;; changed again when this is called more than once, since we
-  ;; are rebinding the keys.
-  (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M")))
-  (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j")))
-
+  ;; we could just put these in the keymap below, but this is easier.
   (mapc (function
 	 (lambda(key)
 	   (define-key
-	     ada-mode-map
+	     map
 	     (char-to-string key)
 	     'ada-case-adjust-interactive)))
 	'( ?_ ?% ?& ?* ?( ?) ?- ?= ?+
 	      ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))
-
-  (define-key ada-mode-map [return] 'ada-case-adjust-interactive)
   )
 
 (defvar ada-mode-map
@@ -336,7 +326,7 @@ Values defined by cross reference packages.")
     ;; C-c <letter> are reserved for users
 
     ;; global-map has C-x ` 'next-error
-    (define-key map [return] 	 'ada-indent-newline-indent)
+    (define-key map [return] 	 'ada-case-adjust-interactive)
     (define-key map "\C-c`" 	 'ada-show-secondary-error)
     (define-key map "\C-c;"      (lambda () (error "use M-; instead"))) ; comment-dwim
     (define-key map "\C-c<" 	 'ada-goto-declaration-start)
@@ -352,9 +342,11 @@ Values defined by cross reference packages.")
     (define-key map "\C-c\C-i" 	 'ada-indent-statement)
     (define-key map "\C-c\C-m"   'ada-build-set-make)
     (define-key map "\C-c\C-n" 	 'ada-next-statement-keyword)
+    (define-key map "\C-c\M-n" 	 'ada-next-placeholder)
     (define-key map "\C-c\C-o" 	 'ada-find-other-file)
     (define-key map "\C-c\M-o" 	 'ada-find-other-file-noset)
     (define-key map "\C-c\C-p" 	 'ada-prev-statement-keyword)
+    (define-key map "\C-c\M-p" 	 'ada-prev-placeholder)
     (define-key map "\C-c\C-q" 	 'ada-xref-refresh)
     (define-key map "\C-c\C-r" 	 'ada-show-references)
     (define-key map "\C-c\M-r" 	 'ada-build-run)
@@ -367,6 +359,8 @@ Values defined by cross reference packages.")
     (define-key map "\C-c\M-y"   'ada-case-create-partial-exception)
     (define-key map [C-down-mouse-3] 'ada-popup-menu)
 
+    (ada-case-activate-keys map)
+
     map
   )  "Local keymap used for Ada mode.")
 
@@ -383,6 +377,7 @@ Values defined by cross reference packages.")
      ["Find and select project ..."   ada-build-prompt-select-prj-file t]
      ["Select project ..."            ada-prj-select                   t]
      ["Show project"                  ada-prj-show                     t]
+     ["Show project search path"      ada-prj-show-path                t]
     )
     ("Build"
      ["Next compilation error"     next-error                t]
@@ -407,6 +402,8 @@ Values defined by cross reference packages.")
      ["Show overriding"               ada-show-overriding          t]
      ["Show overridden"               ada-show-overridden          t]
      ["Goto prev position"            ada-goto-previous-pos        t]
+     ["Next placeholder"              ada-next-placeholder    t]
+     ["Previous placeholder"          ada-prev-placeholder    t]
      )
     ("Edit"
      ["Expand skeleton"             ada-expand              t]
@@ -426,6 +423,7 @@ Values defined by cross reference packages.")
      ["Adjust case at point"        ada-case-adjust-at-point  t]
      ["Adjust case region"          ada-case-adjust-region    t]
      ["Adjust case buffer"          ada-case-adjust-buffer    t]
+     ["Show casing files list"      ada-case-show-files       t]
      )
     ("Misc"
      ["Show last parse error"         ada-show-parse-error         t]
@@ -433,7 +431,6 @@ Values defined by cross reference packages.")
      ["Refresh cross reference cache" ada-xref-refresh             t]
      ["Reset parser"                  ada-reset-parser             t]
      )))
-(ada-case-activate-keys)
 
 ;; This doesn't need to be buffer-local because there can be only one
 ;; popup menu at a time.
@@ -488,7 +485,7 @@ point is where the mouse button was clicked."
   (interactive "*")
   ;; point may be in the middle of a word, so insert newline first,
   ;; then go back and indent.
-  (newline)
+  (insert "\n")
   (forward-char -1)
   (funcall indent-line-function)
   (forward-char 1)
@@ -515,6 +512,28 @@ Function is called with no arguments.")
   (when ada-expand
     (funcall ada-expand)))
 
+(defvar ada-next-placeholder nil
+  ;; skeleton function
+  "Function to call to goto next placeholder.")
+
+(defun ada-next-placeholder ()
+  "Goto next placeholder.
+Placeholders are defined by the skeleton backend."
+  (interactive)
+  (when ada-next-placeholder
+    (funcall ada-next-placeholder)))
+
+(defvar ada-prev-placeholder nil
+  ;; skeleton function
+  "Function to call to goto previous placeholder.")
+
+(defun ada-prev-placeholder ()
+  "Goto previous placeholder.
+Placeholders are defined by the skeleton backend."
+  (interactive)
+  (when ada-prev-placeholder
+    (funcall ada-prev-placeholder)))
+
 ;;;; abbrev, align
 
 (defvar ada-mode-abbrev-table nil
@@ -609,8 +628,7 @@ Function is called with no arguments.")
   (ada-goto-open-paren)
   (funcall indent-line-function); so new list is indented properly
 
-  (let* ((inibit-modification-hooks t)
-	 (begin (point))
+  (let* ((begin (point))
 	 (delend (progn (forward-sexp) (point))); just after matching closing paren
 	 (end (progn (backward-char) (forward-comment (- (point))) (point))); end of last parameter-declaration
 	 (multi-line (> end (save-excursion (goto-char begin) (line-end-position))))
@@ -632,9 +650,9 @@ Function is called with no arguments.")
   "Function to scan a region, return a list of subprogram parameter declarations (in inverse declaration order).
 Function is called with two args BEGIN END (the region).
 Each parameter declaration is represented by a list
-'((identifier ...) in-p out-p not-null-p access-p constant-p protected-p type default)."
-  ;; mode is 'in | out | in out | [not null] access [constant | protected]'
-  ;; IMPROVEME: handle single-line trailing comments, or longer comments, in paramlist?
+'((identifier ...) aliased-p in-p out-p not-null-p access-p constant-p protected-p type default)."
+  ;; Summary of Ada syntax for a parameter specification:
+  ;; ... : [aliased] {[in] | out | in out | [null_exclusion] access [constant | protected]} ...
   )
 
 (defun ada-scan-paramlist (begin end)
@@ -649,12 +667,14 @@ Each parameter declaration is represented by a list
 	len
 	(ident-len 0)
 	(type-len 0)
+	(aliased-p nil)
 	(in-p nil)
 	(out-p nil)
 	(not-null-p nil)
 	(access-p nil)
 	ident-col
 	colon-col
+	in-col
 	out-col
 	type-col
 	default-col)
@@ -676,18 +696,19 @@ Each parameter declaration is represented by a list
 
       ;; we align the defaults after the types that have defaults, not after all types.
       ;; "constant", "protected" are treated as part of 'type'
-      (when (nth 8 param)
+      (when (nth 9 param)
 	(setq type-len
 	      (max type-len
-		   (+ (length (nth 7 param))
-		      (if (nth 5 param) 10 0); "constant "
-		      (if (nth 6 param) 10 0); protected
+		   (+ (length (nth 8 param))
+		      (if (nth 6 param) 10 0); "constant "
+		      (if (nth 7 param) 10 0); protected
 		      ))))
 
-      (setq in-p (or in-p (nth 1 param)))
-      (setq out-p (or out-p (nth 2 param)))
-      (setq not-null-p (or not-null-p (nth 3 param)))
-      (setq access-p (or access-p (nth 4 param)))
+      (setq aliased-p (or aliased-p (nth 1 param)))
+      (setq in-p (or in-p (nth 2 param)))
+      (setq out-p (or out-p (nth 3 param)))
+      (setq not-null-p (or not-null-p (nth 4 param)))
+      (setq access-p (or access-p (nth 5 param)))
       )
 
     (let ((space-before-p (save-excursion (skip-chars-backward " \t") (not (bolp))))
@@ -710,16 +731,19 @@ Each parameter declaration is represented by a list
     ;; compute columns.
     (setq ident-col (current-column))
     (setq colon-col (+ ident-col ident-len 1))
-    (setq out-col (+ colon-col (if in-p 5 0))); ": in "
+    (setq in-col
+	  (+ colon-col (if aliased-p 10 2))); ": aliased ..."
+    (setq out-col (+ in-col (if in-p 3 0))); ": [aliased] in "
     (setq type-col
-	  (+ colon-col
+	  (+ in-col
 	     (cond
-	      (not-null-p 18);    ": not null access "
-	      (access-p 9);        ": access"
-	      ((and in-p out-p) 9); ": in out "
-	      (out-p 6);           ": out "
-	      (in-p 5);            ": in "
-	      (t 2))));           ": "
+	      ;; 'not null' without access is part of the type
+	      ((and not-null-p access-p) 16); ": [aliased] not null access "
+	      (access-p 7);         ": [aliased] access "
+	      ((and in-p out-p) 7); ": [aliased] in out "
+	      (in-p 3);             ": [aliased] in "
+	      (out-p 4);            ": [aliased] out "
+	      (t 0))));             ": [aliased] "
 
     (setq default-col (+ 1 type-col type-len))
 
@@ -738,29 +762,42 @@ Each parameter declaration is represented by a list
       (insert ": ")
 
       (when (nth 1 param)
-	(insert "in "))
+	(insert "aliased "))
 
+      (indent-to in-col)
       (when (nth 2 param)
+	(insert "in "))
+
+      (when (nth 3 param)
 	(indent-to out-col)
 	(insert "out "))
 
-      (when (nth 3 param)
-	(insert "not null "))
+      (when (and (nth 4 param) ;; not null
+		 (nth 5 param)) ;; access
+	(insert "not null access"))
 
-      (when (nth 4 param)
-	(insert "access "))
+      (when (and (not (nth 4 param)) ;; not null
+		 (nth 5 param)) ;; access
+	(insert "access"))
 
       (indent-to type-col)
-      (when (nth 5 param)
-	(insert "constant "))
+
+      (when (and (nth 4 param) ;; not null
+		 (not (nth 5 param))) ;; access
+	(insert "not null "))
+
       (when (nth 6 param)
+	(insert "constant "))
+
+      (when (nth 7 param)
 	(insert "protected "))
-      (insert (nth 7 param)); type
 
-      (when (nth 8 param); default
+      (insert (nth 8 param)); type
+
+      (when (nth 9 param); default
 	(indent-to default-col)
 	(insert ":= ")
-	(insert (nth 8 param)))
+	(insert (nth 9 param)))
 
       (if (zerop i)
 	  (insert ")")
@@ -795,26 +832,29 @@ Each parameter declaration is represented by a list
       (insert " : ")
 
       (when (nth 1 param)
-	(insert "in "))
+	(insert "aliased "))
 
       (when (nth 2 param)
-	(insert "out "))
+	(insert "in "))
 
       (when (nth 3 param)
-	(insert "not null "))
+	(insert "out "))
 
       (when (nth 4 param)
-	(insert "access "))
+	(insert "not null "))
 
       (when (nth 5 param)
-	(insert "constant "))
+	(insert "access "))
+
       (when (nth 6 param)
+	(insert "constant "))
+      (when (nth 7 param)
 	(insert "protected "))
-      (insert (nth 7 param)); type
+      (insert (nth 8 param)); type
 
-      (when (nth 8 param); default
+      (when (nth 9 param); default
 	(insert " := ")
-	(insert (nth 8 param)))
+	(insert (nth 9 param)))
 
       (if (zerop i)
 	  (if (= (char-after) ?\;)
@@ -848,14 +888,26 @@ Each parameter declaration is represented by a list
 
 (defvar ada-case-full-exceptions '()
   "Alist of words (entities) that have special casing, built from
-`ada-case-exception-file' full word exceptions. Indexed by
+project file casing file list full word exceptions. Indexed by
 properly cased word; value is t.")
 
 (defvar ada-case-partial-exceptions '()
   "Alist of partial words that have special casing, built from
-`ada-case-exception-file' partial word exceptions. Indexed by
+project casing files list partial word exceptions. Indexed by
 properly cased word; value is t.")
 
+(defun ada-case-show-files ()
+  "Show current casing files list."
+  (interactive)
+  (if (ada-prj-get 'casing)
+      (progn
+	(pop-to-buffer (get-buffer-create "*casing files*"))
+	(erase-buffer)
+	(dolist (file (ada-prj-get 'casing))
+	  (insert (format "%s\n" file))))
+    (message "no casing files")
+    ))
+
 (defun ada-case-save-exceptions (full-exceptions partial-exceptions file-name)
   "Save FULL-EXCEPTIONS, PARTIAL-EXCEPTIONS to the file FILE-NAME."
   (with-temp-file (expand-file-name file-name)
@@ -885,18 +937,18 @@ Return (cons full-exceptions partial-exceptions)."
 		(progn
 		  (setq word (substring word 1))
 		  (unless (assoc-string word partial-exceptions t)
-		    (add-to-list 'partial-exceptions (cons word t))))
+		    (push (cons word t) partial-exceptions)))
 
 	      ;; full word exception
 	      (unless (assoc-string word full-exceptions t)
-		(add-to-list 'full-exceptions (cons word t))))
+		(push (cons word t) full-exceptions)))
 
 	    (forward-line 1))
 	  )
 	(cons full-exceptions partial-exceptions))
 
     ;; else file not readable; might be a new project with no
-    ;; exceptions yet, so just warn user, return empty pair
+    ;; exceptions yet, so just return empty pair
     (message "'%s' is not a readable file." file-name)
     '(nil . nil)
     ))
@@ -906,7 +958,7 @@ Return (cons full-exceptions partial-exceptions)."
 An item in both lists has the RESULT value."
   (dolist (item new)
     (unless (assoc-string (car item) result t)
-      (add-to-list 'result item)))
+      (push item result)))
   result)
 
 (defun ada-case-merge-all-exceptions (exceptions)
@@ -915,7 +967,7 @@ An item in both lists has the RESULT value."
   (setq ada-case-partial-exceptions (ada-case-merge-exceptions ada-case-partial-exceptions (cdr exceptions))))
 
 (defun ada-case-read-all-exceptions ()
-  "Read case exceptions from all files in `ada-case-exception-file',
+  "Read case exceptions from all files in project casing files,
 replacing current values of `ada-case-full-exceptions', `ada-case-partial-exceptions'."
   (interactive)
   (setq ada-case-full-exceptions '()
@@ -930,7 +982,7 @@ replacing current values of `ada-case-full-exceptions', `ada-case-partial-except
   "Add case exception WORD to EXCEPTIONS, replacing current entry, if any."
   (if (assoc-string word exceptions t)
       (setcar (assoc-string word exceptions t) word)
-    (add-to-list 'exceptions (cons word t)))
+    (push (cons word t) exceptions))
   exceptions)
 
 (defun ada-case-create-exception (&optional word file-name partial)
@@ -1008,6 +1060,7 @@ User is prompted to choose a file from project variable casing if it is a list."
 
 (defun ada-in-numeric-literal-p ()
   "Return t if point is after a prefix of a numeric literal."
+  ;; FIXME: this is actually a based numeric literal; excludes 1234
   (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)"))
 
 (defvar ada-keywords nil
@@ -1034,8 +1087,7 @@ User is prompted to choose a file from project variable casing if it is a list."
 	     (copy-marker (1+ end))))
 
       ;; upcase first char
-      (insert-char (upcase (following-char)) 1)
-      (delete-char 1)
+      (upcase-region (point) (1+ (point)))
 
       (goto-char next)
       (if (< (point) end)
@@ -1093,7 +1145,7 @@ Uses `ada-case-identifier', with exceptions defined in
   "Adjust the case of the word before point.
 When invoked interactively, TYPED-CHAR must be
 `last-command-event', and it must not have been inserted yet.
-If IN-COMMENT is non-nil, adjust case of words in comments."
+If IN-COMMENT is non-nil, adjust case of words in comments and strings as code."
   (when (not (bobp))
     (when (save-excursion
 	    (forward-char -1); back to last character in word
@@ -1139,16 +1191,25 @@ If IN-COMMENT is non-nil, adjust case of words in comments."
 
 (defun ada-case-adjust-at-point (&optional in-comment)
   "Adjust case of word at point, move to end of word.
-With prefix arg, adjust case even if in comment."
+With prefix arg, adjust case as code even if in comment;
+otherwise, capitalize words in comments."
   (interactive "P")
-  (when
-      (and (not (eobp))
-	   ;; we use '(syntax-after (point))' here, not '(char-syntax
-	   ;; (char-after))', because the latter does not respect
-	   ;; ada-syntax-propertize.
-	   (memq (syntax-class (syntax-after (point))) '(2 3)))
-    (skip-syntax-forward "w_"))
-  (ada-case-adjust nil in-comment))
+  (cond
+   ((and (not in-comment)
+	 (ada-in-string-or-comment-p))
+    (skip-syntax-backward "w_")
+    (capitalize-word 1))
+
+   (t
+    (when
+	(and (not (eobp))
+	     ;; we use '(syntax-after (point))' here, not '(char-syntax
+	     ;; (char-after))', because the latter does not respect
+	     ;; ada-syntax-propertize.
+	     (memq (syntax-class (syntax-after (point))) '(2 3)))
+      (skip-syntax-forward "w_"))
+    (ada-case-adjust nil in-comment))
+   ))
 
 (defun ada-case-adjust-region (begin end)
   "Adjust case of all words in region BEGIN END."
@@ -1232,7 +1293,7 @@ Optional PLIST defaults to `ada-prj-current-project'."
 
       ;; no project, just use default vars
       ;; must match code in ada-prj-default
-      (cl-case plist
+      (cl-case prop
 	(ada_compiler    ada-compiler)
 	(auto_case       ada-auto-case)
 	(case_keyword    ada-case-keyword)
@@ -1276,8 +1337,9 @@ Indexed by ada-xref-tool.  Called with one argument; the default
 project properties list. Function should add to the properties
 list and return it.")
 
-(defun ada-prj-default ()
+(defun ada-prj-default (&optional src-dir)
   "Return the default project properties list.
+If SRC-DIR is non-nil, use it as the default for src_dir.
 Include properties set via `ada-prj-default-compiler-alist',
 `ada-prj-default-xref-alist'."
 
@@ -1296,7 +1358,7 @@ Include properties set via `ada-prj-default-compiler-alist',
 			 (list ada-case-exception-file))
       'path_sep        path-separator;; prj variable so users can override it for their compiler
       'proc_env        process-environment
-      'src_dir         (list ".")
+      'src_dir         (list (if src-dir src-dir "."))
       'xref_tool       ada-xref-tool
       ))
 
@@ -1326,6 +1388,7 @@ list. Parser must modify or add to the property list and return it.")
 (defun ada-parse-prj-file (prj-file)
   "Read Emacs Ada or compiler-specific project file PRJ-FILE, set project properties in `ada-prj-alist'."
   ;; Not called ada-prj-parse-file for Ada mode 4.01 compatibility
+  ;; FIXME: use the right name, add an alias
   (let ((project (ada-prj-default))
 	(parser (cdr (assoc (file-name-extension prj-file) ada-prj-parser-alist))))
 
@@ -1429,9 +1492,9 @@ Return new value of PROJECT."
 	    (setq project (plist-put project 'case_strict (intern (match-string 2)))))
 
 	   ((string= (match-string 1) "casing")
-	    (add-to-list 'casing
-			 (expand-file-name
-			  (substitute-in-file-name (match-string 2)))))
+            (cl-pushnew (expand-file-name
+                         (substitute-in-file-name (match-string 2)))
+                        casing :test #'equal))
 
 	   ((string= (match-string 1) "el_file")
 	    (let ((file (expand-file-name (substitute-in-file-name (match-string 2)))))
@@ -1440,9 +1503,9 @@ Return new value of PROJECT."
 	      (load-file file)))
 
 	   ((string= (match-string 1) "src_dir")
-	    (add-to-list 'src_dir
-			 (file-name-as-directory
-			  (expand-file-name (match-string 2)))))
+            (cl-pushnew (file-name-as-directory
+                         (expand-file-name (match-string 2)))
+                        src_dir :test #'equal))
 
 	   ((string= (match-string 1) "xref_tool")
 	    (let ((xref (intern (match-string 2))))
@@ -1481,8 +1544,8 @@ Return new value of PROJECT."
       );; done reading file
 
     ;; process accumulated lists
-    (if casing (set 'project (plist-put project 'casing (reverse casing))))
-    (if src_dir (set 'project (plist-put project 'src_dir (reverse src_dir))))
+    (if casing (setq project (plist-put project 'casing (reverse casing))))
+    (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir))))
 
     (when parse-final-compiler
       ;; parse-final-compiler may reference the "current project", so
@@ -1499,9 +1562,6 @@ Return new value of PROJECT."
     project
     ))
 
-(defvar ada-project-search-path nil
-  "Search path for finding Ada project files")
-
 (defvar ada-select-prj-compiler nil
   "Alist of functions to call for compiler specific project file selection.
 Indexed by project variable ada_compiler.")
@@ -1549,7 +1609,6 @@ Indexed by project variable xref_tool.")
   (ada-case-read-all-exceptions)
 
   (setq compilation-search-path (ada-prj-get 'src_dir))
-  (setq ada-project-search-path (ada-prj-get 'prj_dir))
 
   (let ((func (cdr (assq (ada-prj-get 'ada_compiler) ada-select-prj-compiler))))
     (when func (funcall func)))
@@ -1560,6 +1619,19 @@ Indexed by project variable xref_tool.")
   ;; return 't', for decent display in message buffer when called interactively
   t)
 
+(defun ada-create-select-default-prj (&optional directory)
+  "Create a default project with src_dir set to DIRECTORY (default current directory), select it."
+  (let* ((dir (or directory default-directory))
+	 (prj-file (expand-file-name "default_.adp" dir))
+	 (project (ada-prj-default dir)))
+
+    (if (assoc prj-file ada-prj-alist)
+	(setcdr (assoc prj-file ada-prj-alist) project)
+      (add-to-list 'ada-prj-alist (cons prj-file project)))
+
+    (ada-select-prj-file prj-file)
+    ))
+
 (defun ada-prj-select ()
   "Select the current project file from the list of currently available project files."
   (interactive)
@@ -1571,6 +1643,16 @@ Indexed by project variable xref_tool.")
   (interactive)
   (message "current Emacs Ada mode project file: %s" ada-prj-current-file))
 
+(defvar ada-prj-show-path nil
+  ;; Supplied by compiler
+  "Function to show project search path used by compiler (and possibly xref tool)."
+  )
+
+(defun ada-prj-show-path ()
+  (interactive)
+  (when ada-prj-show-path
+    (funcall ada-prj-show-path)))
+
 (defvar ada-show-xref-tool-buffer nil
   ;; Supplied by xref tool
   "Function to show process buffer used by xref tool."
@@ -1597,7 +1679,7 @@ Indexed by project variable xref_tool.")
     (modify-syntax-entry ?\" "\"" table)
 
     ;; punctuation; operators etc
-    (modify-syntax-entry ?#  "w" table); based number - word syntax, since we don't need the number
+    (modify-syntax-entry ?#  "." table); based number - ada-wisi-number-literal-p requires this syntax
     (modify-syntax-entry ?&  "." table)
     (modify-syntax-entry ?*  "." table)
     (modify-syntax-entry ?+  "." table)
@@ -1656,10 +1738,10 @@ In particular, character constants are set to have string syntax."
 	       "\\|\\(--\\)"; 4: comment start
 	       )
 	      end t)
-	;; The help for syntax-propertize-extend-region-functions
-	;; implies that 'start end' will always include whole lines, in
-	;; which case we don't need
-	;; syntax-propertize-extend-region-functions
+	;; syntax-propertize-extend-region-functions is set to
+	;; syntax-propertize-wholelines by default. We assume no
+	;; coding standard will permit a character literal at the
+	;; start of a line (not preceded by whitespace).
 	(cond
 	 ((match-beginning 1)
 	  (put-text-property
@@ -1740,7 +1822,7 @@ found.")
   (funcall ada-file-name-from-ada-name ada-name))
 
 (defvar ada-ada-name-from-file-name nil
-  ;; depends on ada-compiler, per-project
+  ;; supplied by compiler
   "Function called with one parameter FILE-NAME, which is a library
 unit name; it should return the Ada name that should be found in FILE-NAME.")
 
@@ -1759,25 +1841,6 @@ unit name; it should return the Ada name that should be found in FILE-NAME.")
      ada-spec-suffixes)
     (error "parent '%s' not found; set project file?" ff-function-name))))
 
-(defun ada-ff-special-extract-separate ()
-  (let ((package-name (match-string 1)))
-    (save-excursion
-      (goto-char (match-end 0))
-      (when (eolp) (forward-char 1))
-      (skip-syntax-forward " ")
-      (looking-at
-       (concat "\\(function\\|package body\\|procedure\\|protected body\\|task body\\)\\s +"
-	       ada-name-regexp))
-      (setq ff-function-name (match-string 0))
-      )
-    (file-name-nondirectory
-     (or
-      (ff-get-file-name
-       compilation-search-path
-       (ada-file-name-from-ada-name package-name)
-       ada-body-suffixes)
-      (error "package '%s' not found; set project file?" package-name)))))
-
 (defun ada-ff-special-with ()
   (let ((package-name (match-string 1)))
     (setq ff-function-name (concat "^package\\s-+" package-name "\\([^_]\\|$\\)"))
@@ -1805,10 +1868,6 @@ unit name; it should return the Ada name that should be found in FILE-NAME.")
 		       ada-parent-name-regexp "\\(?:;\\|[ \t]+\\|$\\)")
 	       'ada-ff-special-extract-parent)
 
-	 ;; A "separate" clause.
-	 (cons (concat "^separate[ \t\n]*(" ada-name-regexp ")")
-	       'ada-ff-special-extract-separate)
-
 	 ;; A "with" clause. Note that it may refer to a procedure body, as well as a spec
 	 (cons (concat "^\\(?:limited[ \t]+\\)?\\(?:private[ \t]+\\)?with[ \t]+" ada-name-regexp)
 	       'ada-ff-special-with)
@@ -1832,6 +1891,30 @@ other file.")
   (when ada-which-function
     (funcall ada-which-function)))
 
+(defvar ada-on-context-clause nil
+  ;; supplied by indentation engine
+  "Function called with no parameters; it should return non-nil
+  if point is on a context clause.")
+
+(defun ada-on-context-clause ()
+  "See `ada-on-context-clause' variable."
+  (interactive)
+  (when ada-on-context-clause
+    (funcall ada-on-context-clause)))
+
+(defvar ada-goto-subunit-name nil
+  ;; supplied by indentation engine
+  "Function called with no parameters; if the current buffer
+  contains a subunit, move point to the subunit name (for
+  `ada-goto-declaration'), return t; otherwise leave point alone,
+  return nil.")
+
+(defun ada-goto-subunit-name ()
+  "See `ada-goto-subunit-name' variable."
+  (interactive)
+  (when ada-goto-subunit-name
+    (funcall ada-goto-subunit-name)))
+
 (defun ada-add-log-current-function ()
   "For `add-log-current-defun-function'; uses `ada-which-function'."
   ;; add-log-current-defun is typically called with point at the start
@@ -1907,12 +1990,12 @@ don't move to corresponding declaration."
   subprogram declaration, position point on the corresponding
   parent package specification.
 
-- If point is in the start line of a separate body,
-  position point on the corresponding separate stub declaration.
-
 - If point is in a context clause line, position point on the
   first package declaration that is mentioned.
 
+- If point is in a separate body, position point on the
+  corresponding specification.
+
 - If point is in a subprogram body or specification, position point
   on the corresponding specification or body.
 
@@ -1936,18 +2019,34 @@ the other file."
   (interactive "P")
   (ada-check-current-project (buffer-file-name))
 
-  (if mark-active
-      (progn
-	(setq ff-function-name (buffer-substring-no-properties (point) (mark)))
-	(ff-get-file
-	 compilation-search-path
-	 (ada-file-name-from-ada-name ff-function-name)
-	 ada-spec-suffixes
-	 other-window)
-	(deactivate-mark))
-
-    ;; else use name at point
+  (cond
+   (mark-active
+    (setq ff-function-name (buffer-substring-no-properties (point) (mark)))
+    (ff-get-file
+     compilation-search-path
+     (ada-file-name-from-ada-name ff-function-name)
+     ada-spec-suffixes
+     other-window)
+    (deactivate-mark))
+
+   ((and (not (ada-on-context-clause))
+	 (ada-goto-subunit-name))
+    (ada-goto-declaration other-window))
+
+   (t
     (ff-find-other-file other-window)))
+  )
+
+(defun ada-find-file (filename)
+  ;; we assume compliation-search-path is set, either by an
+  ;; ada-mode project, or by some other means.
+  ;; FIXME: option to filter with ada-*-suffixes?
+  (interactive (list (completing-read "File: "
+				      (apply-partially
+				       'locate-file-completion-table
+				       compilation-search-path nil))))
+  (find-file (locate-file filename compilation-search-path))
+  )
 
 (defvar ada-operator-re
   "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
@@ -1955,7 +2054,7 @@ the other file."
 
 (defun ada-identifier-at-point ()
   "Return the identifier around point, move point to start of
-identifier.  May be an Ada identifier or operator function name."
+identifier.  May be an Ada identifier or operator."
 
   (when (ada-in-comment-p)
     (error "Inside comment"))
@@ -1964,7 +2063,8 @@ identifier.  May be an Ada identifier or operator function name."
 
     (skip-chars-backward "a-zA-Z0-9_<>=+\\-\\*/&")
 
-    ;; Just in front of, or inside, a string => we could have an operator
+    ;; Just in front of, or inside, a string => we could have an
+    ;; operator function declaration.
     (cond
      ((ada-in-string-p)
       (cond
@@ -1983,7 +2083,7 @@ identifier.  May be an Ada identifier or operator function name."
 	   (looking-at (concat "\"\\(" ada-operator-re "\\)\"")))
       (setq identifier (concat "\"" (match-string-no-properties 1) "\"")))
 
-     ((looking-at "[a-zA-Z0-9_]+")
+     ((looking-at "[a-zA-Z0-9_]+\\|[+\\-*/&=<>]")
       (setq identifier (match-string-no-properties 0)))
 
      (t
@@ -2095,18 +2195,18 @@ buffer in another window."
   (when (null ada-xref-other-function)
     (error "no cross reference information available"))
 
-    (let ((target
-	   (funcall ada-xref-other-function
-		    (ada-identifier-at-point)
-		    (buffer-file-name)
-		    (line-number-at-pos)
-		    (1+ (current-column))
-		    )))
-
-      (ada-goto-source (nth 0 target)
-		       (nth 1 target)
-		       (nth 2 target)
-		       other-window)
+  (let ((target
+	 (funcall ada-xref-other-function
+		  (ada-identifier-at-point)
+		  (buffer-file-name)
+		  (line-number-at-pos)
+		  (1+ (current-column))
+		  )))
+
+    (ada-goto-source (nth 0 target)
+		     (nth 1 target)
+		     (nth 2 target)
+		     other-window)
     ))
 
 (defvar ada-xref-parent-function nil
@@ -2351,6 +2451,8 @@ Called with no parameters.")
   "See `ada-next-statement-keyword' variable."
   (interactive)
   (when ada-next-statement-keyword
+    (unless (region-active-p)
+      (push-mark))
     (funcall ada-next-statement-keyword)))
 
 (defvar ada-prev-statement-keyword nil
@@ -2364,6 +2466,8 @@ keyword in the previous statement or containing statement.")
   "See `ada-prev-statement-keyword' variable."
   (interactive)
   (when ada-prev-statement-keyword
+    (unless (region-active-p)
+      (push-mark))
     (funcall ada-prev-statement-keyword)))
 
 ;;;; code creation
@@ -2426,7 +2530,8 @@ The paragraph is indented on the first line."
 	   (not (looking-at "[ \t]*--")))
       (error "Not inside comment"))
 
-  (let* (indent from to
+  (let* ((inhibit-modification-hooks t) ;; don't run parser for font-lock; comment text is exposed
+	 indent from to
 	 (opos (point-marker))
 	 ;; we bind `fill-prefix' here rather than in ada-mode because
 	 ;; setting it in ada-mode causes indent-region to use it for
@@ -2492,7 +2597,13 @@ The paragraph is indented on the first line."
 	    (forward-line))
 	  ))
 
-    (goto-char opos)))
+    (goto-char opos)
+
+    ;; we disabled modification hooks, so font-lock will not run to
+    ;; re-fontify the comment prefix; do that here.
+    (when (memq 'jit-lock-after-change after-change-functions)
+      (jit-lock-after-change from to 0))
+    ))
 
 ;;;; support for font-lock.el
 
@@ -2522,148 +2633,10 @@ The paragraph is indented on the first line."
 
 (defun ada-font-lock-keywords ()
   "Return Ada mode value for `font-lock-keywords', depending on `ada-language-version'."
+   ;; Grammar actions set `font-lock-face' property for all
+   ;; non-keyword tokens that need it.
   (list
-
-   ;; keywords followed by a name that should be in function-name-face.
-   (list
-    (apply
-     'concat
-     (append
-      '("\\<\\("
-	"accept\\|"
-	"entry\\|"
-	"function\\|"
-	"package[ \t]+body\\|"
-	"package\\|"
-	"pragma\\|"
-	"procedure\\|"
-	"task[ \t]+body\\|"
-	"task[ \t]+type\\|"
-	"task\\|"
-	)
-      (when (member ada-language-version '(ada95 ada2005 ada2012))
-	'("\\|"
-	  "protected[ \t]+body\\|"
-	  "protected[ \t]+function\\|"
-	  "protected[ \t]+procedure\\|"
-	  "protected[ \t]+type\\|"
-	  "protected"
-	  ))
-      (list
-       "\\)\\>[ \t]*"
-       ada-name-regexp "?")))
-    '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t))
-
-   ;; keywords followed by a name that should be in type-face.
-   (list (concat
-	  "\\<\\("
-	  "access[ \t]+all\\|"
-	  "access[ \t]+constant\\|"
-	  "access\\|"
-	  "constant\\|"
-	  "in[ \t]+reverse\\|"; loop iterator
-	  "in[ \t]+not[ \t]+null\\|"
-	  "in[ \t]+out[ \t]+not[ \t]+null\\|"
-	  "in[ \t]+out\\|"
-	  "in\\|"
-	  ;; "return\\|" can't distinguish between 'function ... return <type>;' and 'return ...;'
-	  ;; An indentation engine can, so a rule for this is added there
-	  "of[ \t]+reverse\\|"
-	  "of\\|"
-	  "out\\|"
-	  "subtype\\|"
-	  "type"
-	  "\\)\\>[ \t]*"
-	  ada-name-regexp "?")
-	 '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
-
-   ;; Keywords not treated elsewhere. After above so it doesn't
-   ;; override fontication of second or third word in those patterns.
-   (list (concat
-   	  "\\<"
-   	  (regexp-opt
-   	   (append
-   	    '("abort" "abs" "accept" "all"
-   	      "and" "array" "at" "begin" "case" "declare" "delay" "delta"
-   	      "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
-   	      "generic" "if" "in" "limited" "loop" "mod" "not"
-   	      "null" "or" "others" "private" "raise"
-   	      "range" "record" "rem" "renames" "reverse"
-   	      "select" "separate" "task" "terminate"
-   	      "then" "when" "while" "xor")
-   	    (when (member ada-language-version '(ada95 ada2005 ada2012))
-   	      '("abstract" "aliased" "requeue" "tagged" "until"))
-   	    (when (member ada-language-version '(ada2005 ada2012))
-   	      '("interface" "overriding" "synchronized"))
-   	    (when (member ada-language-version '(ada2012))
-   	      '("some"))
-   	    )
-   	   t)
-   	  "\\>")
-   	 '(0 font-lock-keyword-face))
-
-   ;; object and parameter declarations; word after ":" should be in
-   ;; type-face if not already fontified or an exception.
-   (list (concat
-	  ":[ \t]*"
-	  ada-name-regexp
-	  "[ \t]*\\(=>\\)?")
-     '(1 (if (match-beginning 2)
-	     'default
-	   font-lock-type-face)
-	 nil t))
-
-   ;; keywords followed by a name that should be in function-name-face if not already fontified
-   (list (concat
-	  "\\<\\("
-	  "end"
-	  "\\)\\>[ \t]*"
-	  ada-name-regexp "?")
-     '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t))
-
-   ;; Keywords followed by a name that could be a type or a function (generic instantiation).
-   (list (concat
-	  "\\<\\("
-	  "new"
-	  "\\)\\>[ \t]*"
-	  ada-name-regexp "?[ \t]*\\((\\)?")
-	 '(1 font-lock-keyword-face)
-	 '(2 (if (match-beginning 3)
-		 font-lock-function-name-face
-	       font-lock-type-face)
-	     nil t))
-
-   ;; keywords followed by a name that should be in type-face if not already fontified (for subtypes)
-   ;; after "new" to handle "is new"
-   (list (concat
-	  "\\<\\("
-	  "is"
-	  "\\)\\>[ \t]*"
-	  ada-name-regexp "?")
-     '(1 font-lock-keyword-face) '(2 font-lock-type-face nil t))
-
-   ;; Keywords followed by a comma separated list of names which
-   ;; should be in constant-face, unless already fontified. Ada mode 4.01 used this.
-   (list (concat
-   	  "\\<\\("
-   	  "goto\\|"
-   	  "use\\|"
-   	  ;; don't need "limited" "private" here; they are matched separately
-   	  "with"; context clause
-   	  "\\)\\>[ \t]*"
-   	  "\\(\\(?:\\sw\\|[_., \t]\\)+\\>\\)?"; ada-name-regexp, plus ", \t"
-   	  )
-   	 '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t))
-
-   ;; statement labels
-   '("<<\\(\\sw+\\)>>" 1 font-lock-constant-face)
-
-   ;; based numberic literals
-   (list "\\([0-9]+#[0-9a-fA-F_]+#\\)" '(1 font-lock-constant-face t))
-
-   ;; numeric literals
-   (list "\\W\\([-+]?[0-9._]+\\)\\>" '(1 font-lock-constant-face))
-
+   (list (concat "\\<" (regexp-opt ada-keywords t) "\\>") '(0 font-lock-keyword-face))
    ))
 
 ;;;; ada-mode
@@ -2708,6 +2681,7 @@ The paragraph is indented on the first line."
 
   (set (make-local-variable 'require-final-newline) t)
 
+  ;; 'font-lock-defaults' is a confusing name; it's buffer local
   (setq font-lock-defaults
 	'(ada-font-lock-keywords
 	  nil t
@@ -2751,6 +2725,8 @@ The paragraph is indented on the first line."
 
   (easy-menu-add ada-mode-menu ada-mode-map)
 
+  (setq ada-case-strict (ada-prj-get 'case_strict))
+
   (run-mode-hooks 'ada-mode-hook)
 
   ;; If global-font-lock is not enabled, ada-syntax-propertize is
@@ -2772,10 +2748,11 @@ The paragraph is indented on the first line."
   ;; This means to fully set ada-mode interactively, user must
   ;; do M-x ada-mode M-; (hack-local-variables)
 
-  (when global-font-lock-mode
-    ;; This calls ada-font-lock-keywords, which depends on
-    ;; ada-language-version
-    (font-lock-refresh-defaults))
+  ;; fill-region-as-paragraph in ada-fill-comment-paragraph does not
+  ;; call syntax-propertize, so set comment syntax on
+  ;; ada-fill-comment-prefix. In post-local because user may want to
+  ;; set it per-file.
+  (put-text-property 0 2 'syntax-table '(11 . nil) ada-fill-comment-prefix)
 
   (cl-case ada-language-version
    (ada83
@@ -2798,6 +2775,11 @@ The paragraph is indented on the first line."
 		  ada-2005-keywords
 		  ada-2012-keywords))))
 
+  (when global-font-lock-mode
+    ;; This calls ada-font-lock-keywords, which depends on
+    ;; ada-keywords
+    (font-lock-refresh-defaults))
+
   (when ada-goto-declaration-start
     (set (make-local-variable 'beginning-of-defun-function) ada-goto-declaration-start))
 
@@ -2819,7 +2801,6 @@ The paragraph is indented on the first line."
 (unless (featurep 'ada-xref-tool)
   (cl-case ada-xref-tool
     ((nil 'gnat) (require 'ada-gnat-xref))
-    ('gnat_inspect (require 'gnat-inspect))
     ('gpr_query (require 'gpr-query))
     ))