X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/790d13440166d9e79ee10a952aa47a87423f1d65..af721abd3ad489f98cc8f67ba15d4dc44d187a5d:/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 05360e0e1..9e0bdfcc6
--- a/packages/ada-mode/ada-mode.el
+++ b/packages/ada-mode/ada-mode.el
@@ -1,12 +1,13 @@
-;;; ada-mode.el --- major-mode for editing Ada sources
+;;; ada-mode.el --- major-mode for editing Ada sources  -*- lexical-binding:t -*-
 ;;
-;;; Copyright (C) 1994, 1995, 1997 - 2014  Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1997 - 2015  Free Software Foundation, Inc.
 ;;
 ;; 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.4
-;; package-requires: ((wisi "1.0.4") (cl-lib "0.4") (emacs "24.2"))
+;; Keywords: languages
+;;  ada
+;; Version: 5.1.8
+;; package-requires: ((wisi "1.1.1") (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,10 +168,10 @@
 (defun ada-mode-version ()
   "Return Ada mode version."
   (interactive)
-  (let ((version-string "5.1.4"))
+  (let ((version-string "5.1.8"))
     ;; must match:
     ;; ada-mode.texi
-    ;; README
+    ;; README-ada-mode
     ;; Version: above
     (if (called-interactively-p 'interactive)
 	(message version-string)
@@ -195,8 +196,7 @@ Non-nil means automatically change case of preceding word while typing.
 Casing of Ada keywords is done according to `ada-case-keyword',
 identifiers are Mixed_Case."
   :type  'boolean
-  :group 'ada
-  :safe  'booleanp)
+  :safe  #'booleanp)
 (make-variable-buffer-local 'ada-auto-case)
 
 (defcustom ada-case-exception-file nil
@@ -214,8 +214,8 @@ character, and end either at the end of the word or at a _
 character.  Characters after the first word are ignored, and not
 preserved when the list is written back to the file."
   :type  '(repeat (file))
-  :group 'ada
-  :safe  'listp)
+  ;; :safe  #'listp    ;FIXME: is '("~/.emacs" "~/.bashrc" "/etc/passwd") safe?
+  )
 
 (defcustom ada-case-keyword 'downcase-word
   "Buffer-local value that may override project variable `case_keyword'.
@@ -223,19 +223,27 @@ Global value is default for project variable `case_keyword'.
 Function to call to adjust the case of Ada keywords."
   :type '(choice (const downcase-word)
 		 (const upcase-word))
-  :group 'ada
-  :safe  'functionp)
+  ;; :safe #'functionp ; FIXME: `functionp' CANNOT be safe!
+  )
 (make-variable-buffer-local 'ada-case-keyword)
 
 (defcustom ada-case-identifier 'ada-mixed-case
   "Buffer-local value that may override project variable `case_keyword'.
 Global value is default for project variable `case_keyword'.
-Function to call to adjust the case of Ada keywords."
+Function to call to adjust the case of Ada keywords.
+Called with three args;
+start      - buffer pos of start of identifier
+end        - end of identifier
+force-case - if t, treat `ada-strict-case' as t"
   :type '(choice (const ada-mixed-case)
-		 (const downcase-region)
-		 (const upcase-region))
-  :group 'ada
-  :safe  'functionp)
+		 (const ada-lower-case)
+		 (const ada-upper-case))
+  ;; :safe #'functionp ; FIXME: `functionp' CANNOT be safe!
+  )
+;; we'd like to check that there are 3 args, since the previous
+;; release required 2 here. But there doesn't seem to be a way to
+;; access the arg count, which is only available for byte-compiled
+;; functions
 (make-variable-buffer-local 'ada-case-identifier)
 
 (defcustom ada-case-strict t
@@ -244,8 +252,7 @@ Global value is default for project variable `case_strict'.
 If non-nil, force Mixed_Case for identifiers.
 Otherwise, allow UPPERCASE for identifiers."
   :type 'boolean
-  :group 'ada
-  :safe  'booleanp)
+  :safe  #'booleanp)
 (make-variable-buffer-local 'ada-case-strict)
 
 (defcustom ada-language-version 'ada2012
@@ -256,36 +263,29 @@ indentation parser accepts."
 		 (const ada95)
 		 (const ada2005)
 		 (const ada2012))
-  :group 'ada
-  :safe  'symbolp)
+  :safe  #'symbolp)
 (make-variable-buffer-local 'ada-language-version)
 
 (defcustom ada-fill-comment-prefix "-- "
   "Comment fill prefix."
-  :type 'string
-  :group 'ada)
-(make-variable-buffer-local 'ada-language-version)
+  :type 'string)
 
 (defcustom ada-fill-comment-postfix " --"
   "Comment fill postfix."
-  :type 'string
-  :group 'ada)
-(make-variable-buffer-local 'ada-language-version)
+  :type 'string)
 
 (defcustom ada-prj-file-extensions '("adp" "prj")
   "List of Emacs Ada mode project file extensions.
 Used when searching for a project file.
 Any file with one of these extensions will be parsed by `ada-prj-parse-file-1'."
-  :type 'list
-  :group 'ada)
+  :type 'list)
 
 (defcustom ada-prj-file-ext-extra nil
   "List of secondary project file extensions.
 Used when searching for a project file that can be a primary or
 secondary project file (referenced from a primary).  The user
 must provide a parser for a file with one of these extensions."
-  :type 'list
-  :group 'ada)
+  :type 'list)
 
 ;;;;; end of user variables
 
@@ -304,31 +304,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,9 +325,11 @@ 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)
+    (define-key map "\C-c>" 	 'ada-goto-declaration-end)
     (define-key map "\C-c\M-`" 	 'ada-fix-compiler-error)
     (define-key map "\C-c\C-a" 	 'ada-align)
     (define-key map "\C-c\C-b" 	 'ada-make-subprogram-body)
@@ -350,9 +341,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)
@@ -365,6 +358,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.")
 
@@ -381,6 +376,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]
@@ -396,14 +392,18 @@ Values defined by cross reference packages.")
     ("Navigate"
      ["Other file"                    ada-find-other-file          t]
      ["Other file don't find decl"    ada-find-other-file-noset    t]
+     ["Find file in project"          ada-find-file                t]
      ["Goto declaration/body"         ada-goto-declaration         t]
      ["Goto next statement keyword"   ada-next-statement-keyword   t]
-     ["Goto prev statement keyword"   ada-next-statement-keyword   t]
+     ["Goto declaration start"        ada-goto-declaration-start   t]
+     ["Goto declaration end"          ada-goto-declaration-end     t]
      ["Show parent declarations"      ada-show-declaration-parents t]
      ["Show references"               ada-show-references          t]
      ["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]
@@ -423,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]
@@ -430,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.
@@ -459,7 +459,7 @@ Values defined by cross reference packages.")
     ["Other File"                  ada-find-other-file        t]
     ["Other file don't find decl"  ada-find-other-file-noset  t]))
 
-(defun ada-popup-menu (position)
+(defun ada-popup-menu (_position)
   "Pops up a `ada-context-menu', with `ada-context-menu-on-identifer' set appropriately.
 POSITION is the location the mouse was clicked on.
 Sets `ada-context-menu-last-point' to the current position before
@@ -485,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)
@@ -512,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
@@ -569,7 +591,7 @@ Function is called with no arguments.")
      "return\\|"
      "type\\|"
      "when"
-     "\\)\\>\\)"))
+     "\\)\\>[^_]\\)")) ;; in case "_" has punctuation syntax
   "See the variable `align-region-separate' for more information.")
 
 (defun ada-align ()
@@ -606,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))))
@@ -629,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)
@@ -646,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)
@@ -673,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))))
@@ -707,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))
 
@@ -735,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 ")")
@@ -792,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) ?\;)
@@ -845,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)
@@ -882,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)
     ))
@@ -903,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)
@@ -912,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 '()
@@ -927,9 +982,11 @@ 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)
 
+(defvar ada-prj-current-file)
+
 (defun ada-case-create-exception (&optional word file-name partial)
   "Define WORD as an exception for the casing system, save it in FILE-NAME.
 If PARTIAL is non-nil, create a partial word exception.  WORD
@@ -970,12 +1027,13 @@ list."
     (if (use-region-p)
 	(setq word (buffer-substring-no-properties (region-beginning) (region-end)))
       (save-excursion
-	(skip-syntax-backward "w_")
-	(setq word
-	      (buffer-substring-no-properties
-	       (point)
-	       (progn (skip-syntax-forward "w_") (point))
-	       )))))
+	(let ((syntax (if partial "w" "w_")))
+	  (skip-syntax-backward syntax)
+	  (setq word
+		(buffer-substring-no-properties
+		 (point)
+		 (progn (skip-syntax-forward syntax) (point))
+		 ))))))
 
   (let* ((exceptions (ada-case-read-exceptions file-name))
 	 (full-exceptions (car exceptions))
@@ -1005,7 +1063,8 @@ 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."
-  (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)"))
+  ;; FIXME: this is actually a based numeric literal; excludes 1234
+  (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)" (line-beginning-position)))
 
 (defvar ada-keywords nil
   "List of Ada keywords for current `ada-language-version'.")
@@ -1017,11 +1076,17 @@ User is prompted to choose a file from project variable casing if it is a list."
 	       (point))))
     (member (downcase word) ada-keywords)))
 
-(defun ada-mixed-case (start end)
+(defun ada-lower-case (start end _force-case-strict)
+  (downcase-region start end))
+
+(defun ada-upper-case (start end _force-case-strict)
+  (upcase-region start end))
+
+(defun ada-mixed-case (start end force-case-strict)
   "Adjust case of region START END to Mixed_Case."
   (let ((done nil)
 	next)
-    (if ada-case-strict
+    (if (or force-case-strict ada-case-strict)
 	(downcase-region start end))
     (goto-char start)
     (while (not done)
@@ -1031,8 +1096,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)
@@ -1040,7 +1104,7 @@ User is prompted to choose a file from project variable casing if it is a list."
 	(setq done t))
       )))
 
-(defun ada-case-adjust-identifier ()
+(defun ada-case-adjust-identifier (&optional force-case)
   "Adjust case of the previous word as an identifier.
 Uses `ada-case-identifier', with exceptions defined in
 `ada-case-full-exceptions', `ada-case-partial-exceptions'."
@@ -1063,7 +1127,7 @@ Uses `ada-case-identifier', with exceptions defined in
 	    (delete-region (point) end))
 
 	;; else apply ada-case-identifier
-	(funcall ada-case-identifier start end)
+	(funcall ada-case-identifier start end force-case)
 
 	;; apply partial-exceptions
 	(goto-char start)
@@ -1090,7 +1154,8 @@ 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,
+and treat `ada-case-strict' as t in code.."
   (when (not (bobp))
     (when (save-excursion
 	    (forward-char -1); back to last character in word
@@ -1122,7 +1187,7 @@ If IN-COMMENT is non-nil, adjust case of words in comments."
 	   (save-excursion
 	     (skip-syntax-backward "w_")
 	     (eq (char-before) ?')))
-	  (ada-case-adjust-identifier))
+	  (ada-case-adjust-identifier in-comment))
 
 	 ((and
 	   (not in-comment)
@@ -1130,22 +1195,31 @@ If IN-COMMENT is non-nil, adjust case of words in comments."
 	   (ada-after-keyword-p))
 	  (funcall ada-case-keyword -1))
 
-	 (t (ada-case-adjust-identifier))
+	 (t (ada-case-adjust-identifier in-comment))
 	 ))
       )))
 
 (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."
@@ -1229,7 +1303,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)
@@ -1273,8 +1347,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'."
 
@@ -1293,7 +1368,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
       ))
 
@@ -1323,6 +1398,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))))
 
@@ -1426,9 +1502,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)))))
@@ -1437,9 +1513,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))))
@@ -1478,8 +1554,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
@@ -1496,9 +1572,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.")
@@ -1546,7 +1619,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)))
@@ -1557,6 +1629,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)
@@ -1568,6 +1653,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."
@@ -1594,7 +1689,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)
@@ -1653,10 +1748,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
@@ -1733,15 +1828,17 @@ found.")
 
 (defun ada-file-name-from-ada-name (ada-name)
   "Return the filename in which ADA-NAME is found."
+  (ada-require-project-file)
   (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.")
 
 (defun ada-ada-name-from-file-name (file-name)
   "Return the ada-name that should be found in FILE-NAME."
+  (ada-require-project-file)
   (funcall ada-ada-name-from-file-name file-name))
 
 (defun ada-ff-special-extract-parent ()
@@ -1754,25 +1851,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 "\\([^_]\\|$\\)"))
@@ -1800,10 +1878,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)
@@ -1827,6 +1901,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
@@ -1869,10 +1967,22 @@ set."
   (when (null (car compilation-search-path))
     (error "no file search path defined; set project file?"))
 
-  (unless (string= file-name
-		   (locate-file (file-name-nondirectory file-name)
-				compilation-search-path))
-    (error "current file not part of current project; wrong project?")))
+  ;; file-truename handles symbolic links
+  (let* ((visited-file (file-truename file-name))
+         (found-file (locate-file (file-name-nondirectory visited-file)
+				  compilation-search-path)))
+    (unless found-file
+      (error "current file not part of current project; wrong project?"))
+
+    (setq found-file (file-truename found-file))
+
+    ;; (nth 10 (file-attributes ...)) is the inode; required when hard
+    ;; links are present.
+    (let* ((visited-file-inode (nth 10 (file-attributes visited-file)))
+           (found-file-inode (nth 10 (file-attributes found-file))))
+      (unless (equal visited-file-inode found-file-inode)
+        (error "%s (opened) and %s (found in project) are two different files"
+               file-name found-file)))))
 
 (defun ada-find-other-file-noset (other-window)
   "Same as `ada-find-other-file', but preserve point in the other file,
@@ -1880,7 +1990,7 @@ don't move to corresponding declaration."
   (interactive "P")
   (ada-find-other-file other-window t))
 
-(defun ada-find-other-file (other-window &optional no-set-point)
+(defun ada-find-other-file (other-window &optional _no-set-point)
   "Move to the corresponding declaration in another file.
 
 - If region is active, assume it contains a package name;
@@ -1890,12 +2000,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.
 
@@ -1919,18 +2029,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\\|<=\\|<\\|>=\\|>"
@@ -1938,41 +2064,41 @@ 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"))
 
-  (let (identifier)
+  (skip-chars-backward "a-zA-Z0-9_<>=+\\-\\*/&")
 
-    (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
-     ((ada-in-string-p)
-      (cond
 
-       ((and (= (char-before) ?\")
-	     (progn
-	       (forward-char -1)
-	       (looking-at (concat "\"\\(" ada-operator-re "\\)\""))))
-	(setq identifier (concat "\"" (match-string-no-properties 1) "\"")))
+     ((and (= (char-before) ?\")
+           (progn
+             (forward-char -1)
+             (looking-at (concat "\"\\(" ada-operator-re "\\)\""))))
+      (concat "\"" (match-string-no-properties 1) "\""))
 
-       (t
-	(error "Inside string or character constant"))
-       ))
+     (t
+      (error "Inside string or character constant"))
+     ))
 
-     ((and (= (char-after) ?\")
-	   (looking-at (concat "\"\\(" ada-operator-re "\\)\"")))
-      (setq identifier (concat "\"" (match-string-no-properties 1) "\"")))
+   ((and (= (char-after) ?\")
+         (looking-at (concat "\"\\(" ada-operator-re "\\)\"")))
+    (concat "\"" (match-string-no-properties 1) "\""))
 
-     ((looking-at "[a-zA-Z0-9_]+")
-      (setq identifier (match-string-no-properties 0)))
+   ((looking-at "[a-zA-Z0-9_]+\\|[+\\-*/&=<>]")
+    (match-string-no-properties 0))
 
-     (t
-      (error "No identifier around"))
-     )))
+   (t
+    (error "No identifier around"))
+   ))
 
+;; FIXME: use find-tag-marker-ring, ring-insert, pop-tag-mark (see xref.el)
 (defvar ada-goto-pos-ring '()
   "List of positions selected by navigation functions. Used
 to go back to these positions.")
@@ -2078,18 +2204,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
@@ -2284,6 +2410,7 @@ parameters.")
 
 (defun ada-goto-declaration-start ()
   "Call `ada-goto-declaration-start'."
+  (interactive)
   (when ada-goto-declaration-start
     (funcall ada-goto-declaration-start)))
 
@@ -2333,6 +2460,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
@@ -2346,6 +2475,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
@@ -2408,7 +2539,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
@@ -2474,7 +2606,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
 
@@ -2504,148 +2642,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
@@ -2690,6 +2690,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
@@ -2733,6 +2734,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
@@ -2754,10 +2757,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
@@ -2780,6 +2784,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))
 
@@ -2800,9 +2809,8 @@ 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))
+    ((nil gnat) (require 'ada-gnat-xref))
+    (gpr_query (require 'gpr-query))
     ))
 
 (unless (featurep 'ada-compiler)