;;; wisi.el --- Utilities for implementing an indentation/navigation engine using a generalized LALR parser -*- lexical-binding:t -*-
;;
;; Copyright (C) 2012 - 2019  Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@stephe-leake.org>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: parser
;;  indentation
;;  navigation
;; Version: 2.2.1
;; package-requires: ((emacs "25.0") (seq "2.20"))
;; URL: http://stephe-leake.org/ada/wisitoken.html
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
;;

;;; Commentary:

;;;; History: see NEWS-wisi.text
;;
;;;; Design:
;;
;; 'wisi' was originally short for "wisent indentation engine", but
;; now is just a name. wisi was developed to support Emacs ada-mode
;; 5.0 indentation, font-lock, and navigation, which are parser based.
;;
;; The approach to indenting a given token is to parse the buffer,
;; computing a delta indent at each parse action.
;;
;; The parser actions also cache face and navigation information
;; as text properties on tokens in statements.
;;
;; The three reasons to run the parser (indent, face, navigate) occur
;; at different times (user indent, font-lock, user navigate), so only
;; the relevant parser actions are run.
;;
;; Parsing can be noticeably slow in large files, so sometimes we do a
;; partial parse, and keep a list of parsed regions.
;;
;; Since we have a cache (the text properties), we need to consider
;; when to invalidate it.  Ideally, we invalidate only when a change
;; to the buffer would change the result of a parse that crosses that
;; change, or starts after that change.  Changes in whitespace
;; (indentation and newlines) do not affect an Ada parse.  Other
;; languages are sensitive to newlines (Bash for example) or
;; indentation (Python).  Adding comments does not change a parse,
;; unless code is commented out.
;;
;; For navigate, we expect fully accurate results, and can tolerate
;; one initial delay, so we always parse the entire file.
;;
;; For font-lock, we only parse the portion of the file requested by
;; font-lock, so we keep a list of regions, and edit that list when
;; the buffer is changed..
;;
;; For indenting, we expect fast results, and can tolerate some
;; inaccuracy until the editing is done, so we allow partial parse. We
;; cache the indent for each line in a text property on the newline
;; char preceding the line. `wisi-indent-region' sets the cache on all
;; the lines computed (part of the buffer in large files), but
;; performs the indent only on the lines in the indent
;; region. Subsequent calls to `wisi-indent-region' apply the cached
;; indents. Non-whitespace edits to the buffer invalidate the indent
;; caches in the edited region and after. Since we can do partial
;; parse, we keep a list of parsed regions.
;;
;; See `wisi--post-change' for the details of what we check for
;; invalidating.
;;
;;;; Choice of grammar compiler and parser
;;
;; There are two other parsing engines available in Emacs:
;;
;; - SMIE
;;
;;   We don't use this because it is designed to parse small snippets
;;   of code. For Ada indentation, we always need to parse the entire
;;   buffer.
;;
;; - semantic
;;
;;   The Ada grammar as given in the Ada language reference manual is
;;   not LALR(1). So we use a generalized parser. In addition, the
;;   semantic lexer is more complex, and gives different information
;;   than we need. Finally, the semantic parser does not support error
;;   correction, and thus fails in most editing situations.
;;
;; We use the WisiToken tool wisi-bnf-generate to compile BNF or EBNF
;; to Ada source, See ada-mode.info and wisi.info for more information
;; on the developer tools used for ada-mode and wisi.
;;
;;; Code:

(require 'cl-lib)
(require 'compile)
(require 'seq)
(require 'semantic/lex)
(require 'wisi-parse-common)
(require 'wisi-fringe)
(require 'xref)

(defcustom wisi-size-threshold most-positive-fixnum
  "Max size (in characters) for using wisi parser results for anything."
  :type 'integer
  :group 'wisi
  :safe 'integerp)
(make-variable-buffer-local 'wisi-size-threshold)

(defcustom wisi-indent-context-lines 0
  "Minimum number of lines before point to include in a parse for indent.
Increasing this will give better results when in the middle of a
deeply nested statement, but worse in some situations."
  :type 'integer
  :group 'wisi
  :safe 'integerp)

(defvar wisi-inhibit-parse nil
  "When non-nil, don't run the parser.
Language code can set this non-nil when syntax is known to be
invalid temporarily, or when making lots of changes.")

(defcustom wisi-disable-face nil
  "When non-nil, `wisi-setup' does not enable use of parser for font-lock.
Useful when debugging parser or parser actions."
  :type 'boolean
  :group 'wisi
  :safe 'booleanp)

(defconst wisi-error-buffer-name "*wisi syntax errors*"
  "Name of buffer for displaying syntax errors.")

(defvar wisi-error-buffer nil
  "Buffer for displaying syntax errors.")

(defun wisi-safe-marker-pos (pos)
  "Return an integer buffer position from POS, an integer or marker"
  (cond
   ((markerp pos)
    (marker-position pos))

   (t pos)))

;;;; token info cache

(defvar-local wisi-parse-failed nil
  "Non-nil when last parse failed - cleared when parse succeeds.")

(defvar-local wisi--parse-try
  (list
   (cons 'face t)
   (cons 'navigate t)
   (cons 'indent t))
  "Non-nil when parse is needed because text has changed - cleared when parse succeeds.")

(defun wisi-parse-try (&optional parse-action)
  (cdr (assoc (or parse-action wisi--parse-action) wisi--parse-try)))

(defun wisi-set-parse-try (value &optional parse-action)
  (setcdr (assoc (or parse-action wisi--parse-action) wisi--parse-try) value))

(defvar-local wisi--last-parse-region
  (list
   (cons 'face nil)
   (cons 'navigate nil)
   (cons 'indent nil))
  "Last region on which parse was requested.")

(defun wisi-last-parse-region (&optional parse-action)
  (cdr (assoc (or parse-action wisi--parse-action) wisi--last-parse-region)))

(defun wisi-set-last-parse-region (begin end parse-action)
  (setcdr (assoc parse-action wisi--last-parse-region) (cons begin end)))

(defvar-local wisi--cached-regions
  (list
   (cons 'face nil)
   (cons 'navigate nil)
   (cons 'indent nil))
  "Alist of lists of regions in buffer where parser text properties are valid.
Regions in a list are in random order.")

(defun wisi--contained-region (begin end region)
  "Non-nil if BEGIN and END (buffer positions) are both contained in REGION (a cons of positions)."
  ;; We assume begin < end
  (and (<= (car region) begin)
       (<= end (cdr region))))

(defun wisi--contained-pos (pos region)
  "Non-nil if POS (a buffer position) is contained in REGION (a cons of positions)."
  (and (<= (car region) pos)
       (<= pos (cdr region))))

(defun wisi-cache-covers-region (begin end &optional parse-action)
  "Non-nil if BEGIN END is contained in a parsed region."
  (let ((region-list (cdr (assoc (or parse-action wisi--parse-action) wisi--cached-regions)))
	region)
    (while (and region-list
		(marker-buffer (caar region-list)) ;; this can fail after editing during ediff-regions.
		(marker-buffer (cdar region-list))
		(not (wisi--contained-region begin end (car region-list))))
      (pop region-list))

    (when region-list
      ;; return a nice value for verbosity in wisi-validate-cache
      (setq region (car region-list))
      (cons (marker-position (car region)) (marker-position (cdr region))))))

(defun wisi-cache-covers-pos (parse-action pos)
  "Non-nil if POS is contained in a PARSE-ACTION parsed region."
  (let ((region-list (cdr (assoc parse-action wisi--cached-regions))))
    (while (and region-list
		(not (wisi--contained-pos pos (car region-list))))
      (pop region-list))

    (when region-list
      t)))

(defun wisi-cache-contains-pos (parse-action pos)
  "Non-nil if POS is at or before the end of any PARSE-ACTION parsed region."
  (let ((region-list (cdr (assoc parse-action wisi--cached-regions)))
	result)
    (while (and (not result) region-list)
      (when (<= pos (cdr (car region-list)))
	(setq result t))
      (pop region-list))

    result))

(defun wisi-cache-set-region (region)
  "Set the cached region list for `wisi--parse-action' to REGION."
  (setcdr (assoc wisi--parse-action wisi--cached-regions)
	  (list (cons (copy-marker (car region))
		      (copy-marker (cdr region))))))

(defun wisi-cache-add-region (region)
  "Add REGION to the cached region list for `wisi--parse-action'."
  (push (cons (copy-marker (car region))
	      (copy-marker (cdr region)))
	(cdr (assoc wisi--parse-action wisi--cached-regions))))

(defun wisi-cache-delete-regions-after (parse-action pos)
  "Delete any PARSE-ACTION parsed region at or after POS.
Truncate any region that overlaps POS."
  (let ((region-list (cdr (assoc parse-action wisi--cached-regions)))
	result)
    (while (and (not result) region-list)
      (cond
       ((and (> pos (car (car region-list)))
	     (<= pos (cdr (car region-list))))
	;; region contains POS; keep truncated
	(push (cons (car (car region-list)) (copy-marker pos)) result))

       ((> pos (car (car region-list)))
	;; region is entirely before POS; keep
	(push (car region-list) result))

       ;; else region is entirely after POS; delete
       )

      (pop region-list))
    (setcdr (assoc parse-action wisi--cached-regions) result)
    ))

(defun wisi--delete-face-cache (after)
  (with-silent-modifications
    (remove-text-properties after (point-max) '(font-lock-face nil)))
  (if (= after (point-min))
      (setcdr (assoc 'face wisi--cached-regions) nil)
    (wisi-cache-delete-regions-after 'face after)))

(defun wisi--delete-navigate-cache (after)
  (with-silent-modifications
    ;; This text property is 'wisi-cache', not 'wisi-navigate', for
    ;; historical reasons.
    (remove-text-properties after (point-max) '(wisi-cache nil wisi-name nil)))
  (if (= after (point-min))
      (setcdr (assoc 'navigate wisi--cached-regions) nil)
    (wisi-cache-delete-regions-after 'navigate after)))

(defun wisi--delete-indent-cache (after)
  (with-silent-modifications
    (remove-text-properties after (point-max) '(wisi-indent nil)))
  (if (= after (point-min))
      (setcdr (assoc 'indent wisi--cached-regions) nil)
    (wisi-cache-delete-regions-after 'indent after)))

(defun wisi-invalidate-cache (action after)
  "Invalidate ACTION caches for the current buffer from AFTER to end of buffer."
  (cond
   ((= after (point-min))
    (cond
     ((eq 'face action)
      (wisi--delete-face-cache after))

     ((eq 'navigate action)
      (wisi--delete-navigate-cache after))

     ((eq 'indent action)
      (wisi--delete-indent-cache after))
     ))

   ((wisi-cache-contains-pos action after)
    (when (> wisi-debug 0) (message "wisi-invalidate-cache %s:%s:%d" action (current-buffer) after))
    (cond
     ((eq 'face action)
      (wisi--delete-face-cache after))

     ((eq 'navigate action)
      (when (wisi-cache-covers-pos 'navigate after)
	;; We goto statement start to ensure that motion within nested
	;; structures is properly done (ie prev/next on ’elsif’ is not
	;; set by wisi-motion-action if already set by a lower level
	;; statement). We don’t do it for ’face or ’indent, because that
	;; might require a parse, and they don’t care about nested
	;; structures.
	(save-excursion
	  (goto-char after)

	  ;; This is copied from ‘wisi-goto-statement-start’; we can’t
	  ;; call that because it would call ‘wisi-validate-cache’,
	  ;; which would call ‘wisi-invalidate-cache’; infinite loop.
	  ;; If this needed a navigate parse to succeed, we would not
	  ;; get here.
	  (let ((cache (or (wisi-get-cache (point))
			   (wisi-backward-cache))))
	    (cond
	     ((null cache)
	      ;; at bob
	      nil)

	     ((eq 'statement-end (wisi-cache-class cache))
	      ;; If the change did affect part of a structure statement,
	      ;; this is a lower level statement. Otherwise, we are
	      ;; invalidating more than necessary; not a problem.
	      (wisi-goto-start cache)
	      (setq cache (wisi-backward-cache))
	      (when cache ;; else bob
		(wisi-goto-start cache)))

	     (t
	      (wisi-goto-start cache))
	     ))

	  (setq after (point))))
      (wisi--delete-navigate-cache after))

     ((eq 'indent action)
      ;; The indent cache is stored on newline before line being
      ;; indented. We delete that, because changing text on a line can
      ;; change the indent of that line.
      (setq after
	    (save-excursion
	      (goto-char after)
	      (line-beginning-position)))
      (wisi--delete-indent-cache (max 1 (1- after))))
     )
    )))

(defun wisi-reset-parser ()
  "Force a parse."
  (interactive)
  (syntax-ppss-flush-cache (point-min)) ;; necessary after edit during ediff-regions
  (wisi-invalidate-cache 'indent (point-min))
  (wisi-invalidate-cache 'face (point-min))
  (wisi-invalidate-cache 'navigate (point-min))
  (wisi-set-parse-try t 'indent)
  (wisi-set-parse-try t 'face)
  (wisi-set-parse-try t 'navigate)
  (wisi-set-last-parse-region (point-min) (point-min) 'indent)
  (wisi-set-last-parse-region (point-min) (point-min) 'face)
  (wisi-set-last-parse-region (point-min) (point-min) 'navigate)
  (wisi-fringe-clean))

;; wisi--change-* keep track of buffer modifications.
;; If wisi--change-end comes before wisi--change-beg, it means there were
;; no modifications.
(defvar-local wisi--change-beg most-positive-fixnum
  "First position where a change may have taken place.")

(defvar-local wisi--change-end nil
  "Marker pointing to the last position where a change may have taken place.")

(defvar-local wisi--deleted-syntax nil
  "Worst syntax class of characters deleted in changes.
One of:
nil - no deletions since reset
0   - only whitespace or comment deleted
2   - some other syntax deleted

Set by `wisi-before-change', used and reset by `wisi--post-change'.")

(defvar-local wisi-indenting-p nil
  "Non-nil when `wisi-indent-region' is actively indenting.
Used to ignore whitespace changes in before/after change hooks.")

(defvar-local wisi--last-parse-action nil
  "Value of `wisi--parse-action' when `wisi-validate-cache' was last run.")

(defun wisi-before-change (begin end)
  "For `before-change-functions'."
  ;; begin . (1- end) is range of text being deleted
  (unless wisi-indenting-p
    ;; We set wisi--change-beg, -end even if only inserting, so we
    ;; don't have to do it again in wisi-after-change.
    (setq wisi--change-beg (min wisi--change-beg begin))

    (cond
     ((null wisi--change-end)
      (setq wisi--change-end (copy-marker end)))

     ((> end wisi--change-end)
      ;; `buffer-base-buffer' deals with edits in indirect buffers
      ;; created by ediff-regions-*
      (set-marker wisi--change-end end (buffer-base-buffer)))
     )

    (unless (= begin end)
      (cond
       ((or (null wisi--deleted-syntax)
	    (= 0 wisi--deleted-syntax))
	(save-excursion
	  (if (or (nth 4 (syntax-ppss begin)) ; in comment, moves point to begin
		  (= end (skip-syntax-forward " " end)));; whitespace
	      (setq wisi--deleted-syntax 0)
	    (setq wisi--deleted-syntax 2))))

       (t
	;; wisi--deleted-syntax is 2; no change.
	)
       ))))

(defun wisi-after-change (begin end _length)
  "For `after-change-functions'"
  ;; begin . end is range of text being inserted (empty if equal);
  ;; length is the size of the deleted text.

  ;; Remove caches on inserted text, which could have caches from
  ;; anywhere, and are in any case invalid.

  ;; If the insertion changes a word that has wisi fontification,
  ;; remove fontification from the entire word, so it is all
  ;; refontified consistently.

  (let (word-begin word-end)
    (save-excursion
      (goto-char end)
      (skip-syntax-forward "w_")
      (setq word-end (point))
      (goto-char begin)
      (skip-syntax-backward "w_")
      (setq word-begin (point)))
    (if (get-text-property word-begin 'font-lock-face)
	(with-silent-modifications
	  (remove-text-properties
	   word-begin word-end
	   '(font-lock-face nil wisi-cache nil wisi-indent nil fontified nil)))

      ;; No point in removing
      ;; 'fontified here; that's already handled by jit-lock.
      (with-silent-modifications
	(remove-text-properties
	 begin end
	 '(font-lock-face nil wisi-cache nil wisi-indent nil))))
    ))

(defun wisi--post-change (begin end)
  "Update wisi text properties for changes in region BEG END."
  ;; (syntax-ppss-flush-cache begin) is in before-change-functions

  (save-excursion
    (let ((need-invalidate t)
	  (done nil)
	  ;; non-nil if require a parse because the syntax may have
	  ;; changed.

	  (begin-state (syntax-ppss begin))
	  (end-state (syntax-ppss end)))
	  ;; (info "(elisp)Parser State")
	  ;; syntax-ppss has moved point to "end"; might be eob.

      ;; consider deletion
      (cond
       ((null wisi--deleted-syntax)
	;; no deletions
	)

       ((= 0 wisi--deleted-syntax)
	;; Only deleted whitespace; may have joined two words
	(when
	    (and (= begin end) ;; no insertions
		 (or
		  (= (point-min) begin)
		  (= 0 (syntax-class (syntax-after (1- begin))))
		  (= (point-max) end)
		  (= 0 (syntax-class (syntax-after end)))))
	  ;; More whitespace on at least one side of deletion; did not
	  ;; join two words.
	  (setq need-invalidate nil)
	  (setq done t)
	  ))

       (t
	;; wisi--deleted-syntax is 2; need invalidate and parse for all
	;; parse actions
	(setq done t)
	))

      (setq wisi--deleted-syntax nil)

      (unless done
	;; consider insertion
	(cond
	 ((= begin end)
	  ;; no insertions
	  nil)

	 ((and
	   (nth 3 begin-state);; in string
	   (nth 3 end-state)
	   (= (nth 8 begin-state) (nth 8 end-state)));; no intervening non-string
	  (setq need-invalidate nil))

	 ((and
	   (nth 4 begin-state) ;; in comment
	   (nth 4 end-state)
	   (= (nth 8 begin-state) (nth 8 end-state))) ;; no intervening non-comment

	  (if (and
	       (= 11 (car (syntax-after begin)))
	       (progn (goto-char begin)
		      (skip-syntax-backward "<")
		      (not (= (point) begin))))

	      ;; Either inserted last char of a multi-char comment
	      ;; start, or inserted extra comment-start chars.
	      (setq need-invalidate begin)
	    (setq need-invalidate nil)))

	 ((and
	   (or
	    (= (point-min) begin)
	    (= 0 (syntax-class (syntax-after (1- begin)))); whitespace
	    (= (point-max) end)
	    (= 0 (syntax-class (syntax-after end))))
	   (progn
	     (goto-char begin)
	     (= (- end begin) (skip-syntax-forward " " end))
	     ))
	  ;; Inserted only whitespace, there is more whitespace on at
	  ;; least one side, and we are not in a comment or string
	  ;; (checked above).  This may affect indentation, but not
	  ;; the indentation cache.
	  (setq need-invalidate nil))
	 ))

      (when need-invalidate
	(wisi-set-parse-try t 'face)
	(wisi-set-parse-try t 'navigate)
	(wisi-set-parse-try t 'indent)

	(wisi-invalidate-cache 'face begin)
	(wisi-invalidate-cache 'navigate begin)
	(wisi-invalidate-cache 'indent begin))
      )))

(defun wisi-goto-error ()
  "Move point to position in last error message (if any)."
  (cond
   ((wisi-parser-parse-errors wisi--parser)
    (let ((data (car (wisi-parser-parse-errors wisi--parser))))
      (cond
       ((wisi--parse-error-pos data)
	(push-mark)
	(goto-char (wisi--parse-error-pos data)))

       ((string-match ":\\([0-9]+\\):\\([0-9]+\\):" (wisi--parse-error-message data))
	(let* ((msg (wisi--parse-error-message data))
	       (line (string-to-number (match-string 1 msg)))
	       (col (string-to-number (match-string 2 msg))))
	  (push-mark)
	  (goto-char (point-min))
	  (condition-case nil
	      (progn
		;; line can be wrong if parser screws up, or user edits buffer
		(forward-line (1- line))
		(forward-char col))
	    (error
	     ;; just stay at eob.
	     nil))))
       )))
   ((wisi-parser-lexer-errors wisi--parser)
    (push-mark)
    (goto-char (wisi--lexer-error-pos (car (wisi-parser-lexer-errors wisi--parser)))))
   ))

(defun wisi-show-parse-error ()
  "Show current wisi-parse errors."
  (interactive)
  (cond
   ((or (wisi-parser-lexer-errors wisi--parser)
	(wisi-parser-parse-errors wisi--parser))
    (if (and (= 1 (+ (length (wisi-parser-lexer-errors wisi--parser))
		     (length (wisi-parser-parse-errors wisi--parser))))
	     (or (and (wisi-parser-parse-errors wisi--parser)
		      (not (wisi--parse-error-repair (car (wisi-parser-parse-errors wisi--parser)))))
		 (and (wisi-parser-lexer-errors wisi--parser)
		      (not (wisi--lexer-error-inserted (car (wisi-parser-lexer-errors wisi--parser)))))))
	;; There is exactly one error; if there is error correction
	;; information, use a ’compilation’ buffer, so
	;; *-fix-compiler-error will call
	;; wisi-repair-error. Otherwise, just position cursor at
	;; error.
	(progn
	  (wisi-goto-error)
	  (message (or (and (wisi-parser-parse-errors wisi--parser)
			    (wisi--parse-error-message (car (wisi-parser-parse-errors wisi--parser))))
		       (and (wisi-parser-lexer-errors wisi--parser)
			    (wisi--lexer-error-message (car (wisi-parser-lexer-errors wisi--parser)))))
		   ))

      ;; else show all errors in a ’compilation’ buffer
      (setq wisi-error-buffer (get-buffer-create wisi-error-buffer-name))

      (let ((lexer-errs (nreverse (cl-copy-seq (wisi-parser-lexer-errors wisi--parser))))
	    (parse-errs (nreverse (cl-copy-seq (wisi-parser-parse-errors wisi--parser))))
	    (dir default-directory))
	(with-current-buffer wisi-error-buffer
	  (setq window-size-fixed nil)
	  (compilation-mode)
	  (setq-local compilation-search-path (list dir))
	  (setq default-directory dir)
	  (setq next-error-last-buffer (current-buffer))
	  (setq buffer-read-only nil)
	  (erase-buffer)
	  ;; compilation-nex-error-function assumes there is not an
	  ;; error at point-min, so we need a comment.
	  (insert "wisi syntax errors")
	  (newline)
	  (dolist (err lexer-errs)
	    (insert (wisi--lexer-error-message err))
	    (put-text-property (line-beginning-position) (1+ (line-beginning-position)) 'wisi-error-data err)
	    (newline 2))
	  (dolist (err parse-errs)
	    (insert (wisi--parse-error-message err))
	    (put-text-property (line-beginning-position) (1+ (line-beginning-position)) 'wisi-error-data err)
	    (newline 2))
	  (compilation--flush-parse (point-min) (point-max))
	  (compilation--ensure-parse (point-max))
	  (when compilation-filter-hook
	    (let ((compilation-filter-start (point-min)))
	      (run-hooks 'compilation-filter-hook)))

	  (setq buffer-read-only t)
	  (goto-char (point-min)))

	(let ((win (display-buffer
		    wisi-error-buffer
		    (cons #'display-buffer-at-bottom
			  (list (cons 'window-height #'shrink-window-if-larger-than-buffer))))))
	  (set-window-dedicated-p win t))

	(with-current-buffer wisi-error-buffer
	  (setq window-size-fixed t))
	(next-error))
      ))

   ((wisi-parse-try wisi--last-parse-action)
    (message "need parse"))

   (t
    (message "parse succeeded"))
   ))

(defun wisi-kill-parser ()
  "Kill the background process running the parser for the current buffer.
Usefull if the parser appears to be hung."
  (interactive)
  (wisi-parse-kill wisi--parser)
  ;; also force re-parse
  (dolist (parse-action '(face navigate indent))
    (wisi-set-parse-try t parse-action)
    (wisi-invalidate-cache parse-action (point-min)))
  )

(defun wisi-partial-parse-p (begin end)
  (and (wisi-process--parser-p wisi--parser)
       (not (and (= begin (point-min))
		 (= end (point-max))))
       (>= (point-max) wisi-partial-parse-threshold)))

(defun wisi--run-parse (begin parse-end)
  "Run the parser, on at least region BEGIN PARSE-END."
  (unless (or (buffer-narrowed-p)
	      (= (point-min) (point-max))) ;; some parsers can’t handle an empty buffer.
    (let* ((partial-parse-p (wisi-partial-parse-p begin parse-end))
	   (msg (when (> wisi-debug 0)
		  (format "wisi: %sparsing %s %s:%d %d %d ..."
			  (if partial-parse-p "partial " "")
			  wisi--parse-action
			  (buffer-name)
			  begin
			  (if (markerp parse-end) (marker-position parse-end) parse-end)
			  (line-number-at-pos begin))))
	   (parsed-region nil))

      (when msg
	(message msg))

      (setq wisi--last-parse-action wisi--parse-action)
      (wisi-set-last-parse-region begin parse-end wisi--parse-action)

      (unless (eq wisi--parse-action 'face)
	(when (buffer-live-p wisi-error-buffer)
	  (with-current-buffer wisi-error-buffer
	    (setq buffer-read-only nil)
	    (erase-buffer)
	    (setq buffer-read-only t))))

      (condition-case-unless-debug err
	  (save-excursion
	    (if partial-parse-p
	      (let ((send-region (wisi-parse-expand-region wisi--parser begin parse-end)))
		(setq parsed-region (wisi-parse-current wisi--parser (car send-region) (cdr send-region) parse-end))
		(wisi-cache-add-region parsed-region))

	      ;; parse full buffer
	      (setq parsed-region (cons (point-min) (point-max)))
	      (wisi-cache-set-region (wisi-parse-current wisi--parser (point-min) (point-max) (point-max))))

	    (when (> wisi-debug 0) (message "... parsed %s" parsed-region))
	    (setq wisi-parse-failed nil))
	(wisi-parse-error
	 (cl-ecase wisi--parse-action
	   (face
	    ;; Caches set by failed elisp parse are ok, but some parse
	    ;; failures return 'nil' in parse-region.
	    (when (cdr parsed-region)
	      (wisi--delete-face-cache (cdr parsed-region))))

	   (navigate
	    ;; elisp parse partially resets caches
	    (wisi--delete-navigate-cache (point-min)))

	   (indent
	    ;; parse does not set caches; see `wisi-indent-region'
	    nil))
	 (setq wisi-parse-failed t)
	 ;; parser should have stored this error message in parser-error-msgs
	 )
	(error
	 ;; parser failed for other reason
	 (setq wisi-parse-failed t)
	 (signal (car err) (cdr err)))
	)

      (unless partial-parse-p
	(wisi-fringe-display-errors
	 (append
	  (seq-map (lambda (err) (wisi--lexer-error-pos err)) (wisi-parser-lexer-errors wisi--parser))
	  (seq-map (lambda (err) (wisi--parse-error-pos err)) (wisi-parser-parse-errors wisi--parser)))))

      (when (> wisi-debug 1)
	(if (or (wisi-parser-lexer-errors wisi--parser)
		(wisi-parser-parse-errors wisi--parser))
	    (progn
	      (message "%s error" msg)
	      (wisi-goto-error)
	      (error (or (and (wisi-parser-lexer-errors wisi--parser)
			      (wisi--lexer-error-message (car (wisi-parser-lexer-errors wisi--parser))))
			 (and (wisi-parser-parse-errors wisi--parser)
			      (wisi--parse-error-message (car (wisi-parser-parse-errors wisi--parser))))
			 )))

	  ;; no error
	  (message "%s done" msg))
	))))

(defun wisi--check-change ()
  "Process `wisi--change-beg', `wisi--change-end'.
`wisi--parse-action' must be bound."
  (when (and wisi--change-beg
	     wisi--change-end
	     (or (integerp wisi--change-beg)
		 (marker-buffer wisi--change-beg)) ;; this can fail after editing during ediff-regions.
	     (or (integerp wisi--change-end)
		 (marker-buffer wisi--change-end))
	     (<= wisi--change-beg wisi--change-end))
    (wisi--post-change wisi--change-beg (marker-position wisi--change-end))
    (setq wisi--change-beg most-positive-fixnum)
    (move-marker wisi--change-end (point-min))
    ))

(defun wisi-validate-cache (begin end error-on-fail parse-action)
  "Ensure cached data for PARSE-ACTION is valid in region BEGIN END in current buffer."
  (if (and (not wisi-inhibit-parse)
	   (< (point-max) wisi-size-threshold))
      (let ((wisi--parse-action parse-action))
	(wisi--check-change)

	;; Now we can rely on wisi-cache-covers-region.
	;;
	;; If the last parse failed but was partial, and we are trying
	;; a different region, it may succeed. Otherwise, don't keep
	;; retrying a failed parse until the text changes again.
	(cond
	 ((and (not wisi-parse-failed)
	       (wisi-cache-covers-region begin end))
	  (when (> wisi-debug 0)
	    (message "parse %s skipped: cache-covers-region %s %s.%s"
		     parse-action
		     (wisi-cache-covers-region begin end)
		     begin end)))

	 ((and wisi-parse-failed
	       (equal (cons begin end) (wisi-last-parse-region parse-action))
	       (not (wisi-parse-try parse-action)))
	  (when (> wisi-debug 0)
	    (message "parse %s skipped: parse-failed" parse-action)))

	 (t
	  (progn
	    (wisi-set-parse-try nil)
	    (wisi--run-parse begin end))))

	;; We want this error even if we did not try to parse; it means
	;; the parse results are not valid.
	(when (and error-on-fail wisi-parse-failed)
	  (error "parse %s failed" parse-action))
	)
    (when (> wisi-debug 0)
      (message "parse %s skipped inihibit-parse %s wisi-size-threshold %d"
	       parse-action
	       wisi-inhibit-parse
	       wisi-size-threshold))))

(defun wisi-fontify-region (begin end)
  "For `jit-lock-functions'."
  (wisi-validate-cache begin end nil 'face))

(defun wisi-get-containing-cache (cache)
  "Return cache from (wisi-cache-containing CACHE)."
  (when cache
    (let ((containing (wisi-cache-containing cache)))
      (and containing
	   (wisi-get-cache containing)))))

(defun wisi-cache-text (cache)
  "Return property-less buffer substring designated by cache.
Point must be at cache."
  (buffer-substring-no-properties (point) (+ (point) (wisi-cache-last cache))))

;;;; navigation

(defun wisi-forward-find-class (class limit)
  "Search at point or forward for a token that has a cache with CLASS.
Return cache, or nil if at end of buffer.
If LIMIT (a buffer position) is reached, throw an error."
  (let ((cache (or (wisi-get-cache (point))
		   (wisi-forward-cache))))
    (while (not (eq class (wisi-cache-class cache)))
      (setq cache (wisi-forward-cache))
      (when (>= (point) limit)
	(error "cache with class %s not found" class)))
    cache))

(defun wisi-forward-find-cache-token (ids limit)
  "Search forward for a cache with token in IDS (a list of token ids).
Return cache, or nil if at LIMIT or end of buffer."
  (let ((cache (wisi-forward-cache)))
    (while (and (< (point) limit)
		(not (eobp))
		(not (memq (wisi-cache-token cache) ids)))
      (setq cache (wisi-forward-cache)))
    cache))

(defun wisi-forward-find-nonterm (nonterm limit)
  "Search forward for a token that has a cache with NONTERM.
NONTERM may be a list; stop on any cache that has a member of the list.
Return cache, or nil if at end of buffer.
If LIMIT (a buffer position) is reached, throw an error."
  (let ((nonterm-list (cond
		       ((listp nonterm) nonterm)
		       (t (list nonterm))))
	(cache (wisi-forward-cache)))
    (while (not (memq (wisi-cache-nonterm cache) nonterm-list))
      (setq cache (wisi-forward-cache))
      (when (>= (point) limit)
	(error "cache with nonterm %s not found" nonterm)))
    cache))

(defun wisi-goto-cache-next (cache)
  (goto-char (wisi-cache-next cache))
  (wisi-get-cache (point))
  )

(defun wisi-forward-statement-keyword ()
  "If not at a cached token, move forward to next
cache. Otherwise move to cache-next, or cache-end, or next cache
if both nil.  Return cache found."
  (unless (eobp)
    (wisi-validate-cache (point-min) (point-max) t 'navigate)
    (let ((cache (wisi-get-cache (point))))
      (if (and cache
	       (not (eq (wisi-cache-class cache) 'statement-end)))
	  (let ((next (or (wisi-cache-next cache)
			  (wisi-cache-end cache))))
	    (if next
		(goto-char next)
	      (wisi-forward-cache)))
	(wisi-forward-cache))
      )
    (wisi-get-cache (point))
    ))

(defun wisi-backward-statement-keyword ()
  "If not at a cached token, move backward to prev
cache. Otherwise move to cache-prev, or prev cache if nil."
  (wisi-validate-cache (point-min) (point-max) t 'navigate)
  (let ((cache (wisi-get-cache (point)))
	prev)
    (when cache
      (setq prev (wisi-cache-prev cache))
      (unless prev
	(unless (eq 'statement-start (wisi-cache-class cache))
	  (setq prev (wisi-cache-containing cache)))))
    (if prev
	(goto-char prev)
      (wisi-backward-cache))
  ))

(defun wisi-forward-sexp (&optional arg)
  "For `forward-sexp-function'."
  (interactive "^p")
  (or arg (setq arg 1))
  (cond
   ((and (> arg 0) (= 4 (syntax-class (syntax-after (point)))))  ;; on open paren
    (let ((forward-sexp-function nil))
      (forward-sexp arg)))

   ((and (< arg 0) (= 5 (syntax-class (syntax-after (1- (point)))))) ;; after close paren
    (let ((forward-sexp-function nil))
      (forward-sexp arg)))

   ((and (> arg 0) (= 7 (syntax-class (syntax-after (point)))))  ;; on (open) string quote
    (let ((forward-sexp-function nil))
      (forward-sexp arg)))

   ((and (< arg 0) (= 7 (syntax-class (syntax-after (1- (point)))))) ;; after (close) string quote
    (let ((forward-sexp-function nil))
      (forward-sexp arg)))

   (t
    (dotimes (_i (abs arg))
      (if (> arg 0)
	  (wisi-forward-statement-keyword)
	(wisi-backward-statement-keyword))))
   ))

(defun wisi-goto-containing (cache &optional error)
  "Move point to containing token for CACHE, return cache at that point.
If ERROR, throw error when CACHE has no container; else return nil."
  (cond
   ((and (markerp (wisi-cache-containing cache))

	 (not (= (wisi-cache-containing cache) (point))))
    ;; This check is only needed if some cache points to itself as a
    ;; container. Apparently that happend once that I caught in the
    ;; debugger; emacs hung because we got here in the font-lock
    ;; timer.

    (goto-char (wisi-cache-containing cache))
    (wisi-get-cache (point)))
   (t
    (when error
      (error "already at outermost containing token")))
   ))

(defun wisi-goto-containing-paren (cache)
  "Move point to just after the open-paren containing CACHE.
Return cache for paren, or nil if no containing paren."
  (while (and cache
	      (not (eq (wisi-cache-class cache) 'open-paren)))
    (setq cache (wisi-goto-containing cache)))
  (when cache
    (forward-char 1))
  cache)

(defun wisi-goto-start (cache)
  "Move point to containing ancestor of CACHE that has class statement-start.
Return start cache."
  ;; cache nil at bob, or on cache in partially parsed statement
  (while (and cache
	      (not (eq (wisi-cache-class cache) 'statement-start)))
    (setq cache (wisi-goto-containing cache)))
  cache)

(defun wisi-goto-end-1 (cache)
  (goto-char (wisi-cache-end cache)))

(defun wisi-goto-statement-start ()
  "Move point to token at start of statement point is in or after.
Return start cache."
  (interactive)
  (wisi-validate-cache (point-min) (point-max) t 'navigate)
  (wisi-goto-start (or (wisi-get-cache (point))
		       (wisi-backward-cache))))

(defun wisi-goto-statement-end ()
  "Move point to token at end of statement point is in or before."
  (interactive)
  (wisi-validate-cache (point-min) (point-max) t 'navigate)
  (let ((cache (or (wisi-get-cache (point))
		   (wisi-forward-cache))))
    (when (wisi-cache-end cache)
      ;; nil when cache is statement-end
      (wisi-goto-end-1 cache))
    ))

(defun wisi-next-statement-cache (cache)
  "Move point to CACHE-next, return cache; error if nil."
  (when (not (markerp (wisi-cache-next cache)))
    (error "no next statement cache"))
  (goto-char (wisi-cache-next cache))
  (wisi-get-cache (point)))

(defun wisi-prev-statement-cache (cache)
  "Move point to CACHE-prev, return cache; error if nil."
  (when (not (markerp (wisi-cache-prev cache)))
    (error "no prev statement cache"))
  (goto-char (wisi-cache-prev cache))
  (wisi-get-cache (point)))

;;;; indentation

(defun wisi-comment-indent ()
  "For `comment-indent-function'. Indent single line comment to
the comment on the previous line."
  ;; Called from `comment-indent', either to insert a new comment, or
  ;; to indent the first line of an existing one.  In either case, the
  ;; comment may be after code on the same line.  For an existing
  ;; comment, point is at the start of the starting delimiter.
  (or
   (save-excursion
     ;; Check for a preceding comment line; fail if comment follows code.
     (when (forward-comment -1)
       ;; For the case:
       ;;
       ;; code;-- comment
       ;;
       ;; point is on '--', and 'forward-comment' does not move point,
       ;; returns nil.
       (when (looking-at comment-start)
         (current-column))))

   (save-excursion
     (back-to-indentation)
     (if (looking-at comment-start)
         ;; An existing comment, no code preceding comment, and
         ;; no comment on preceding line. Return nil, so
         ;; `comment-indent' will call `indent-according-to-mode'
         nil

       ;; A comment after code on the same line.
       comment-column))
   ))

(defun wisi-indent-statement ()
  "Indent region given by `wisi-goto-start', `wisi-cache-end'."
  (interactive)
  (wisi-validate-cache (point-min) (point-max) t 'navigate)

  (save-excursion
    (let ((cache (or (wisi-get-cache (point))
		     (wisi-backward-cache))))
      (when cache
	;; can be nil if in header comment
	(let ((start (progn (wisi-goto-start cache) (point)))
	      (end (if (wisi-cache-end cache)
			 ;; nil when cache is statement-end
			 (wisi-cache-end cache)
		       (point))))
	  (indent-region start end)
	  ))
      )))

(defvar-local wisi-indent-calculate-functions nil
  "Functions to compute indentation special cases.
Called with point at current indentation of a line; return
indentation column, or nil if function does not know how to
indent that line. Run after parser indentation, so other lines
are indented correctly.")

(defvar-local wisi-post-indent-fail-hook
  "Function to reindent portion of buffer.
Called from `wisi-indent-region' when a parse succeeds after
failing; assumes user was editing code that is now syntactically
correct. Must leave point at indentation of current line.")

(defvar-local wisi-indent-failed nil
  "Non-nil when wisi-indent-region fails due to parse failing; cleared when indent succeeds.")

(defvar-local wisi-indent-region-fallback 'wisi-indent-region-fallback-default
  "Function to compute indent for lines in region when wisi parse fails.
Called with BEGIN END.")

(defun wisi-indent-region-fallback-default (begin end)
  ;; Assume there is no indent info at point; user is editing. Indent
  ;; to previous lines.
  (goto-char begin)
  (forward-line -1);; safe at bob
  (back-to-indentation)
  (let ((col (current-column)))
    (while (and (not (eobp))
		(< (point) end))
      (forward-line 1)
      (indent-line-to col)
      (when (bobp)
	;; single line in buffer; terminate loop
	(goto-char (point-max))))))

(defun wisi-list-memq (a b)
  "Return non-nil if any member of A is a memq of B."
  (let ((temp (copy-sequence a))
	result)
    (while (and (not result)
		temp)
      (when (memq (pop temp) b)
	(setq result t)))
    result))

(defun wisi--get-cached-indent (begin end)
  "Return cached indent for point (must be bol), after correcting
for parse errors. BEGIN, END is the parsed region."
  (let ((indent (get-text-property (1- (point)) 'wisi-indent)))
    (if indent
	(when (and (wisi-partial-parse-p begin end)
		   (< 0 (length (wisi-parser-parse-errors wisi--parser))))
	  (dolist (err (wisi-parser-parse-errors wisi--parser))
	    (dolist (repair (wisi--parse-error-repair err))
	      ;; point is at bol; error pos may be at first token on same line.
	      (save-excursion
		(back-to-indentation)
		(when (>= (point) (wisi--parse-error-repair-pos repair))
		  (setq indent (max 0 (wisi-parse-adjust-indent wisi--parser indent repair))))
		))))
      ;; parse did not compute indent for point. Assume the error will
      ;; go away soon as the user edits the code, so just return 0.
      (if (= wisi-debug 0)
	  (setq indent 0)
	(error "nil indent for line %d" (line-number-at-pos (point)))))

    indent))

(defun wisi-indent-region (begin end &optional indent-blank-lines)
  "For `indent-region-function', using the wisi indentation engine.
If INDENT-BLANK-LINES is non-nil, also indent blank lines (for use as
`indent-line-function')."
  (when (< 0 wisi-debug)
    (message "wisi-indent-region %d %d"
	     (wisi-safe-marker-pos begin)
	     (wisi-safe-marker-pos end)))

  (let ((wisi--parse-action 'indent)
	(parse-required nil)
	(end-mark (copy-marker end))
	(prev-indent-failed wisi-indent-failed))

    (wisi--check-change)

    ;; BEGIN is inclusive; END is exclusive.
    (save-excursion
      (goto-char begin)
      (setq begin (line-beginning-position))

      (when (bobp) (forward-line))
      (while (and (not parse-required)
		  (or (and (= begin end) (= (point) end))
		      (< (point) end))
		  (not (eobp)))
	(unless (get-text-property (1- (point)) 'wisi-indent)
	  (setq parse-required t))
	(forward-line))
      )

    ;; A parse either succeeds and sets the indent cache on all
    ;; lines in the parsed region, or fails and leaves valid caches
    ;; untouched.
    (when (and parse-required
	       (or (not wisi-parse-failed)
		   (wisi-parse-try 'indent)))

      (wisi-set-parse-try nil)
      (wisi--run-parse begin end)

      ;; If there were errors corrected, the indentation is
      ;; potentially ambiguous; see
      ;; test/ada_mode-interactive_2.adb. Or it was a partial parse,
      ;; where errors producing bad indent are pretty much expected.
      (unless (wisi-partial-parse-p begin end)
	(setq wisi-indent-failed (< 0 (+ (length (wisi-parser-lexer-errors wisi--parser))
					 (length (wisi-parser-parse-errors wisi--parser))))))
      )

    (if wisi-parse-failed
	(progn
	  ;; primary indent failed
	  (setq wisi-indent-failed t)
	  (when (functionp wisi-indent-region-fallback)
	    (when (< 0 wisi-debug)
	      (message "wisi-indent-region fallback"))
	    (funcall wisi-indent-region-fallback begin end)))

      (save-excursion
	;; Apply cached indents.
	(goto-char begin)
	(let ((wisi-indenting-p t))
	  (while (and (not (eobp))
		      (or (and (= begin end) (= (point) end))
			  (< (point) end-mark))) ;; end-mark is exclusive
	    (when (or indent-blank-lines (not (eolp)))
	      ;; ’indent-region’ doesn’t indent an empty line; ’indent-line’ does
	      (let ((indent (if (bobp) 0 (wisi--get-cached-indent begin end))))
		    (indent-line-to indent))
	      )
	    (forward-line 1))

	  ;; Run wisi-indent-calculate-functions
	  (when wisi-indent-calculate-functions
	    (goto-char begin)
	    (while (and (not (eobp))
			(< (point) end-mark))
	      (back-to-indentation)
	      (let ((indent
		     (run-hook-with-args-until-success 'wisi-indent-calculate-functions)))
		(when indent
		  (indent-line-to indent)))

	      (forward-line 1)))
	  )

	(when
	    (and prev-indent-failed
		 (not wisi-indent-failed))
	  ;; Previous parse failed or indent was potentially
	  ;; ambiguous, this one is not.
	  (goto-char end-mark)
	  (when (< 0 wisi-debug)
	    (message "wisi-indent-region post-parse-fail-hook"))
	  (run-hooks 'wisi-post-indent-fail-hook))
	))
    ))

(defun wisi-indent-line ()
  "For `indent-line-function'."
  (let ((savep (copy-marker (point)))
	(to-indent nil))
    (back-to-indentation)
    (when (>= (point) savep)
      (setq to-indent t))

    (wisi-indent-region (line-beginning-position (- wisi-indent-context-lines)) (1+ (line-end-position)) t)

    (goto-char savep)
    (when to-indent (back-to-indentation))
    ))

(defun wisi-repair-error-1 (data)
  "Repair error reported in DATA (a ’wisi--parse-error’ or ’wisi--lexer-error’)"
  (let ((wisi--parse-action 'navigate))
    (cond
     ((wisi--lexer-error-p data)
      (goto-char (1+ (wisi--lexer-error-pos data)))
      (insert (wisi--lexer-error-inserted data)))
     ((wisi--parse-error-p data)
      (dolist (repair (wisi--parse-error-repair data))
	(when (< 0 (length (wisi--parse-error-repair-deleted repair)))
	  (delete-region (car (wisi--parse-error-repair-deleted-region repair))
			 (cdr (wisi--parse-error-repair-deleted-region repair))))
	(dolist (id (wisi--parse-error-repair-inserted repair))
	  (insert (cdr (assoc id (wisi-parser-repair-image wisi--parser))))
	  (insert " "))
	))
     )))

(defun wisi-repair-error ()
  "Repair the current error."
  (interactive)
  (let ((wisi-inhibit-parse t)) ;; don’t let the error list change while we are processing it.
    (if (= 1 (+ (length (wisi-parser-lexer-errors wisi--parser))
		(length (wisi-parser-parse-errors wisi--parser))))
	(progn
	  (wisi-goto-error)
	  (wisi-repair-error-1 (or (car (wisi-parser-lexer-errors wisi--parser))
				   (car (wisi-parser-parse-errors wisi--parser)))))
      (if (buffer-live-p wisi-error-buffer)
	  (let ((err
		 (with-current-buffer wisi-error-buffer
		   (get-text-property (point) 'wisi-error-data))))
	    (wisi-repair-error-1 err))
	(error "no current error found")
	))))

(defun wisi-repair-errors (&optional beg end)
  "Repair errors reported by last parse.
If non-nil, only repair errors in BEG END region."
  (interactive)
  (let ((wisi-inhibit-parse t)) ;; don’t let the error list change while we are processing it.
    (dolist (data (wisi-parser-lexer-errors wisi--parser))
      (when (or (null beg)
		(and (not (= 0 (wisi--lexer-error-inserted data)))
		     (wisi--lexer-error-pos data)
		     (<= beg (wisi--lexer-error-pos data))
		     (<= (wisi--lexer-error-pos data) end)))
	(wisi-repair-error-1 data)))

    (dolist (data (wisi-parser-parse-errors wisi--parser))
      (when (or (null beg)
		(and (wisi--parse-error-pos data)
		     (<= beg (wisi--parse-error-pos data))
		     (<= (wisi--parse-error-pos data) end)))
	(wisi-repair-error-1 data)))
    ))

;;; xref integration
(defconst wisi-xref-ident-regexp "\\([^<]*\\)\\(?:<\\([0-9]+\\)>\\)?"
  "Match line number encoded into identifier by `wisi-xref-identifier-at-point'.")

(defun wisi-xref-ident-make (identifier &optional other-function)
  (let* ((t-prop (get-text-property 0 'xref-identifier identifier))
	 ;; If t-prop is non-nil: identifier is from
	 ;; identifier-at-point, the desired location is the ’other’
	 ;; (spec/body).
	 ;;
	 ;; If t-prop is nil: identifier is from prompt/completion,
	 ;; the line number may be included in the identifier
	 ;; wrapped in <>, and the desired file is the current file.
	 (ident
	  (if t-prop
	      (substring-no-properties identifier 0 nil)
	    (string-match wisi-xref-ident-regexp identifier)
	    (match-string 1 identifier)
	    ))
	 (file
	  (if t-prop
	      (plist-get t-prop ':file)
	    (buffer-file-name)))
	 (line
	  (if t-prop
	      (plist-get t-prop ':line)
	    (when (match-string 2 identifier)
	      (string-to-number (match-string 2 identifier)))))
	 (column
	  (if t-prop
	      (plist-get t-prop ':column)
	    0))
	 )

    (if t-prop
	(funcall other-function ident file line column)

      (list (xref-make ident (xref-make-file-location file (or line 1) column)))
      )))

(defun wisi-xref-identifier-at-point ()
  (let ((ident (thing-at-point 'symbol)))
    (when ident
      (put-text-property
       0 1
       'xref-identifier
       (list ':file (buffer-file-name)
	     ':line (line-number-at-pos)
	     ':column (current-column))
       ident)
      ident)))

(defun wisi-next-name-region ()
  "Return the next region at or after point with text property 'wisi-name'."
  (let* ((begin
	  (if (get-text-property (point) 'wisi-name)
	      (point)
	    (next-single-property-change (point) 'wisi-name)))
	 (end (next-single-property-change begin 'wisi-name)))
    (cons begin end)))

(defun wisi-prev-name-region ()
  "Return the prev region at or before point with text property 'wisi-name'."
  (let* ((end
	  (if (get-text-property (point) 'wisi-name)
	      (point)
	    (previous-single-property-change (point) 'wisi-name)))
	 (begin (previous-single-property-change end 'wisi-name)))
    (cons begin end)))

(defun wisi-next-name ()
  "Return the text at or after point with text property 'wisi-name'."
  (let ((region (wisi-next-name-region)))
    (buffer-substring-no-properties (car region) (cdr region))))

(defun wisi-prev-name ()
  "Return the text at or before point with text property 'wisi-name'."
  (let ((region (wisi-prev-name-region)))
    (buffer-substring-no-properties (car region) (cdr region))))

(defun wisi-xref-identifier-completion-table ()
  (wisi-validate-cache (point-min) (point-max) t 'navigate)
  (let ((table nil)
	(pos (point-min))
	end-pos)
    (while (setq pos (next-single-property-change pos 'wisi-name))
      ;; We can’t store location data in a string text property -
      ;; it does not survive completion. So we include the line
      ;; number in the identifier string. This also serves to
      ;; disambiguate overloaded identifiers.
      (setq end-pos (next-single-property-change pos 'wisi-name))
      (push
       (format "%s<%d>"
	       (buffer-substring-no-properties pos end-pos)
	       (line-number-at-pos pos))
       table)
      (setq pos end-pos)
      )
    table))

;;;; debugging

(defun wisi-show-region (string)
  (interactive "Mregion: ")
  (when (not (= ?\( (aref string 0)))
    (setq string (concat "(" string ")")))

  (let ((region (read string)))
    (cond
     ((consp (cdr region))
      ;; region is a list; (begin end)
      (set-mark  (nth 0 region))
      (goto-char (nth 1 region)))

     ((consp region)
      ;; region is a cons; (begin . end)
      (set-mark  (car region))
      (goto-char (cdr region)))
     )))

(defun wisi-debug-keys ()
  "Add debug key definitions to `global-map'."
  (interactive)
  (define-key global-map "\M-h" 'wisi-show-containing-or-previous-cache)
  (define-key global-map "\M-i" 'wisi-show-indent)
  (define-key global-map "\M-j" 'wisi-show-cache)
  )

(defun wisi-parse-buffer (&optional parse-action begin end)
  (interactive)
  (unless parse-action
    (setq parse-action (wisi-read-parse-action)))
  (if (use-region-p)
      (progn
	(setq begin (region-beginning))
	(setq end   (region-end)))

    (unless begin (setq begin (point-min)))
    (unless end (setq end (point-max))))

  (wisi-set-parse-try t parse-action)
  (wisi-invalidate-cache parse-action begin)

  (cl-ecase parse-action
    (face
     (with-silent-modifications
       (remove-text-properties
	begin end
	(list
	 'font-lock-face nil
	 'fontified nil)))
     (wisi-validate-cache begin end t parse-action)
     (when (fboundp 'font-lock-ensure) (font-lock-ensure))) ;; emacs < 25

    (navigate
     (wisi-validate-cache begin end t parse-action))

    (indent
     (wisi-indent-region begin end))
    ))

(defun wisi-time (func count &optional report-wait-time)
  "call FUNC COUNT times, show total time"
  (interactive "afunction \nncount ")

  (let ((start-time (float-time))
	(start-gcs gcs-done)
	(cum-wait-time 0.0)
        (i 0)
        diff-time
	diff-gcs)
    (while (not (eq (1+ count) (setq i (1+ i))))
      (save-excursion
        (funcall func))
      (when report-wait-time
	(setq cum-wait-time (+ cum-wait-time (wisi-process--parser-total-wait-time wisi--parser)))))
    (setq diff-time (- (float-time) start-time))
    (setq diff-gcs (- gcs-done start-gcs))
    (if report-wait-time
	(progn
	  (message "Total %f seconds, %d gcs; per iteration %f seconds %d gcs %d responses %f wait"
		   diff-time
		   diff-gcs
		   (/ diff-time count)
		   (/ (float diff-gcs) count)
		   (wisi-process--parser-response-count wisi--parser)
		   (/ cum-wait-time count)))

      (message "Total %f seconds, %d gcs; per iteration %f seconds %d gcs"
	       diff-time
	       diff-gcs
	       (/ diff-time count)
	       (/ (float diff-gcs) count))
      ))
  nil)

(defun wisi-time-indent-middle-line-cold-cache (count &optional report-wait-time)
  (goto-char (point-min))
  (forward-line (1- (/ (count-lines (point-min) (point-max)) 2)))
  (let ((cum-wait-time 0.0))
    (wisi-time
     (lambda ()
       (wisi-set-parse-try t 'indent)
       (wisi-invalidate-cache 'indent (point-min))
       (wisi-indent-line)
       (when (wisi-process--parser-p wisi--parser)
	 (setq cum-wait-time (+ cum-wait-time (wisi-process--parser-total-wait-time wisi--parser)))))
     count
     report-wait-time)
    ))

(defun wisi-time-indent-middle-line-warm-cache (count)
  (wisi-set-parse-try t 'indent)
  (wisi-invalidate-cache 'indent (point-min))
  (goto-char (point-min))
  (forward-line (/ (count-lines (point-min) (point-max)) 2))
  (wisi-indent-line)
  (wisi-time #'wisi-indent-line count))

(defun wisi-show-indent ()
  "Show indent cache for current line."
  (interactive)
  (message "%s" (get-text-property (1- (line-beginning-position)) 'wisi-indent)))

(defun wisi-show-cache ()
  "Show wisi text properties at point."
  (interactive)
  (message "%s:%s:%s:%s"
	   (wisi-get-cache (point))
	   (get-text-property (point) 'face)
	   (get-text-property (point) 'font-lock-face)
	   (get-text-property (point) 'wisi-name)
	   ))

(defun wisi-show-containing-or-previous-cache ()
  (interactive)
  (let ((cache (wisi-get-cache (point))))
    (if cache
	(message "containing %s" (wisi-goto-containing cache t))
      (message "previous %s" (wisi-backward-cache)))
    ))

;;;;; setup

(cl-defun wisi-setup (&key indent-calculate post-indent-fail parser)
  "Set up a buffer for parsing files with wisi."
  (when wisi--parser
    (wisi-kill-parser))

  (setq wisi--parser parser)
  (setq wisi--cached-regions
	(list
	 (cons 'face nil)
	 (cons 'navigate nil)
	 (cons 'indent nil)))

  (setq wisi--parse-try
	(list
	 (cons 'face t)
	 (cons 'navigate t)
	 (cons 'indent t)))

  (setq wisi--last-parse-region
	(list
	 (cons 'face nil)
	 (cons 'navigate nil)
	 (cons 'indent nil)))

  ;; file local variables may have added opentoken, gnatprep
  (setq wisi-indent-calculate-functions (append wisi-indent-calculate-functions indent-calculate))
  (set (make-local-variable 'indent-line-function) #'wisi-indent-line)
  (set (make-local-variable 'indent-region-function) #'wisi-indent-region)
  (set (make-local-variable 'forward-sexp-function) #'wisi-forward-sexp)

  (setq wisi-post-indent-fail-hook post-indent-fail)
  (setq wisi-indent-failed nil)

  (add-hook 'before-change-functions #'wisi-before-change 'append t)
  (add-hook 'after-change-functions #'wisi-after-change nil t)
  (setq wisi--change-end (copy-marker (point-min) t))

  ;; See comments above on syntax-propertize.
  (when (< emacs-major-version 25) (syntax-propertize (point-max)))

  ;; In Emacs >= 26, ‘run-mode-hooks’ (in the major mode function)
  ;; runs ‘hack-local-variables’ after ’*-mode-hooks’; we need
  ;; ‘wisi-post-local-vars’ to run after ‘hack-local-variables’.
  (add-hook 'hack-local-variables-hook 'wisi-post-local-vars nil t)
  )

(defun wisi-post-local-vars ()
  "See wisi-setup."
  (setq hack-local-variables-hook (delq 'wisi-post-local-vars hack-local-variables-hook))

  (unless wisi-disable-face
    (jit-lock-register #'wisi-fontify-region)))


(provide 'wisi)
;;; wisi.el ends here
