X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/abab0678161b2c8cd92d285589ae53bb2b191884..23a624ca1d40fa9cefd7229ac6152b79278a6517:/packages/wisi/wisi.el diff --git a/packages/wisi/wisi.el b/packages/wisi/wisi.el index d4cd8e6df..6f06f549c 100755 --- a/packages/wisi/wisi.el +++ b/packages/wisi/wisi.el @@ -3,7 +3,11 @@ ;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc. ;; ;; Author: Stephen Leake -;; Version: 1.0.5 +;; Maintainer: Stephen Leake +;; Keywords: parser +;; indentation +;; navigation +;; Version: 1.1.0 ;; package-requires: ((cl-lib "0.4") (emacs "24.2")) ;; URL: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html ;; @@ -25,7 +29,7 @@ ;;; Commentary: -;;;; History: first experimental version Oct 2012 +;;;; History: see NEWS-wisi.text ;; ;;;; indentation algorithm overview ;; @@ -67,6 +71,21 @@ ;; the edit point if the change involves anything other than ;; whitespace. ;; +;;; Handling parse errors: +;; +;; When a parse fails, the cache information before the failure point +;; is only partly correct, and there is no cache informaiton after the +;; failure point. +;; +;; However, in the case where a parse previously succeeded, and the +;; current parse fails due to editing, we keep the preceding cache +;; information by setting wisi-cache-max to the edit point in +;; wisi-before change; the parser does not apply actions before that +;; point. +;; +;; This allows navigation and indentation in the text preceding the +;; edit point, and saves some time. +;; ;;;; comparison to the SMIE parser ;; ;; The central problem to be solved in building the SMIE parser is @@ -131,6 +150,15 @@ ;; that in functions that return tokens in the form wisi-parse ;; expects. ;; +;;;; lexer +;; +;; The lexer is `wisi-forward-token'. It relies on syntax properties, +;; so syntax-propertize must be called on the text to be lexed before +;; wisi-forward-token is called. In general, it is hard to determine +;; an appropriate end-point for syntax-propertize, other than +;; point-max. So we call (syntax-propertize point-max) in wisi-setup, +;; and also call syntax-propertize in wisi-after-change. +;; ;;;; code style ;; ;; 'wisi' was originally short for "wisent indentation engine", but @@ -151,6 +179,13 @@ (require 'wisi-compat-24.2) ;;) +(defcustom wisi-font-lock-size-threshold 100000 + "Max size (in characters) for using wisi parser results for syntax highlighting." + :type 'integer + :group 'wisi + :safe 'integerp) +(make-variable-buffer-local 'wisi-font-lock-size-threshold) + ;;;; lexer (defvar-local wisi-class-list nil) @@ -164,18 +199,38 @@ "Cons '(delim . character) where 'character' escapes quotes in strings delimited by 'delim'.") (defvar-local wisi-string-single-term nil) ;; string delimited by single quotes (defvar-local wisi-symbol-term nil) +(defvar-local wisi-number-term nil) +(defvar-local wisi-number-p nil) + +(defun wisi-number-p (token-text) + "Return t if TOKEN-TEXT plus text after point matches the +syntax for a real literal; otherwise nil. point is after +TOKEN-TEXT; move point to just past token." + ;; typical literals: + ;; 1234 + ;; 1234.5678 + ;; 1234.5678e+99 + ;; + (let ((end (point))) + ;; starts with a simple integer + (when (string-match "^[0-9]+" token-text) + (when (looking-at "\\.[0-9]+") + ;; real number + (goto-char (setq end (match-end 0))) + (when (looking-at "[Ee][+-][0-9]+") + ;; exponent + (goto-char (setq end (match-end 0))))) + + t + ))) -(defun wisi-forward-token (&optional text-only) +(defun wisi-forward-token () "Move point forward across one token, skipping leading whitespace and comments. -Return the corresponding token, in a format determined by TEXT-ONLY: -TEXT-ONLY t: text -TEXT-ONLY nil: (token text start . end) -where: +Return the corresponding token, in format: (token start . end) where: + `token' is a token symbol (not string) from `wisi-punctuation-table', `wisi-keyword-table', `wisi-string-double-term', `wisi-string-double-term' or `wisi-symbol-term'. -`text' is the token text from the buffer - `start, end' are the character positions in the buffer of the start and end of the token text. @@ -189,7 +244,6 @@ If at end of buffer, returns `wisent-eoi-term'." token-id token-text) (cond ((eobp) - (setq token-text "") (setq token-id wisent-eoi-term)) ((eq syntax 1) @@ -201,8 +255,7 @@ If at end of buffer, returns `wisent-eoi-term'." (setq temp-text (buffer-substring-no-properties start (point))) (setq temp-id (car (rassoc temp-text wisi-punctuation-table))) (when temp-id - (setq token-text temp-text - token-id temp-id + (setq token-id temp-id next-point (point))) (if (or (eobp) @@ -218,39 +271,51 @@ If at end of buffer, returns `wisent-eoi-term'." (setq token-id (symbol-value (intern-soft token-text wisi-keyword-table)))) ((eq syntax 7) - ;; string quote, either single or double. we assume point is before the start quote, not the end quote + ;; string quote, either single or double. we assume point is + ;; before the start quote, not the end quote (let ((delim (char-after (point))) (forward-sexp-function nil)) - (forward-sexp) - ;; point is now after the end quote; check for an escaped quote - (while (or - (and wisi-string-quote-escape-doubled - (eq (char-after (point)) delim)) - (and (eq delim (car wisi-string-quote-escape)) - (eq (char-before (1- (point))) (cdr wisi-string-quote-escape)))) - (forward-sexp)) - (setq token-text (buffer-substring-no-properties start (point))) - (setq token-id (if (= delim ?\") wisi-string-double-term wisi-string-single-term)))) + (condition-case err + (progn + (forward-sexp) + + ;; point is now after the end quote; check for an escaped quote + (while (or + (and wisi-string-quote-escape-doubled + (eq (char-after (point)) delim)) + (and (eq delim (car wisi-string-quote-escape)) + (eq (char-before (1- (point))) (cdr wisi-string-quote-escape)))) + (forward-sexp)) + (setq token-id (if (= delim ?\") wisi-string-double-term wisi-string-single-term))) + (scan-error + ;; Something screwed up; we should not get here if + ;; syntax-propertize works properly. + (error "wisi-forward-token: forward-sexp failed %s" err) + )))) (t ;; assuming word syntax (skip-syntax-forward "w_'") (setq token-text (buffer-substring-no-properties start (point))) (setq token-id (or (symbol-value (intern-soft (downcase token-text) wisi-keyword-table)) - wisi-symbol-term))) + (and (functionp wisi-number-p) + (funcall wisi-number-p token-text) + (setq token-text (buffer-substring-no-properties start (point))) + wisi-number-term) + wisi-symbol-term)) + ) );; cond (unless token-id - (error (wisi-error-msg "unrecognized token '%s'" (buffer-substring-no-properties start (point))))) + (signal 'wisi-parse-error + (wisi-error-msg "unrecognized token '%s'" (buffer-substring-no-properties start (point))))) - (if text-only - token-text - (cons token-id (cons token-text (cons start (point))))) + (cons token-id (cons start (point))) )) (defun wisi-backward-token () "Move point backward across one token, skipping whitespace and comments. -Return (nil text start . end) - same structure as +Return (nil start . end) - same structure as wisi-forward-token, but does not look up symbol." (forward-comment (- (point))) ;; skips leading whitespace, comment, trailing whitespace. @@ -273,7 +338,7 @@ wisi-forward-token, but does not look up symbol." (if (zerop (skip-syntax-backward ".")) (skip-syntax-backward "w_'"))) ) - (cons nil (cons (buffer-substring-no-properties (point) end) (cons (point) end))) + (cons nil (cons (point) end)) )) ;;;; token info cache @@ -317,12 +382,9 @@ wisi-forward-token, but does not look up symbol." prev ;; marker at previous motion token in statement; nil if none next ;; marker at next motion token in statement; nil if none - end ;; marker at token at end of current statement + end ;; marker at token at end of current statement ) -(defvar-local wisi-cache-max 0 - "Maximimum position in buffer where wisi token cache is valid.") - (defvar-local wisi-parse-table nil) (defvar-local wisi-parse-failed nil @@ -331,21 +393,36 @@ wisi-forward-token, but does not look up symbol." (defvar-local wisi-parse-try nil "Non-nil when parse is needed - cleared when parse succeeds.") -(defvar-local wisi-change-need-invalidate nil) +(defvar-local wisi-change-need-invalidate nil + "When non-nil, buffer position to invalidate from. +Used in before/after change functions.") -(defvar wisi-end-caches nil +(defvar-local wisi-end-caches nil "List of buffer positions of caches in current statement that need wisi-cache-end set.") -(defun wisi-invalidate-cache() - "Invalidate the wisi token cache for the current buffer. -Also invalidate the Emacs syntax cache." +(defun wisi-delete-cache (after) + (with-silent-modifications + (remove-text-properties after (point-max) '(wisi-cache nil)) + ;; We don't remove 'font-lock-face; that's annoying to the user, + ;; since they won't be restored until a parse for some other + ;; reason, and they are likely to be right anyway. + )) + +(defun wisi-invalidate-cache(&optional after) + "Invalidate parsing caches for the current buffer from AFTER to end of buffer." (interactive) - (setq wisi-cache-max 0) + (if (not after) + (setq after (point-min)) + (setq after + (save-excursion + (goto-char after) + (line-beginning-position)))) + (when (> wisi-debug 0) (message "wisi-invalidate %s:%d" (current-buffer) after)) + (setq wisi-cache-max after) (setq wisi-parse-try t) - (setq wisi-end-caches nil) - (syntax-ppss-flush-cache (point-min)) - (with-silent-modifications - (remove-text-properties (point-min) (point-max) '(wisi-cache)))) + (syntax-ppss-flush-cache after) + (wisi-delete-cache after) + ) (defun wisi-before-change (begin end) "For `before-change-functions'." @@ -363,96 +440,182 @@ Also invalidate the Emacs syntax cache." (add-hook 'after-change-functions 'wisi-after-change nil t)) ) - (save-excursion - ;; don't invalidate parse for whitespace, string, or comment changes - (let (;; (info "(elisp)Parser State") - (state (syntax-ppss begin))) - ;; syntax-ppss has moved point to "begin". - (cond - ((or - (nth 3 state); in string - (nth 4 state)); in comment - ;; FIXME: check that entire range is in comment or string - (setq wisi-change-need-invalidate nil)) + (setq wisi-change-need-invalidate nil) - ((progn - (skip-syntax-forward " " end);; does not skip newline - (eq (point) end)) - (setq wisi-change-need-invalidate nil)) + (when (> end begin) + (save-excursion + ;; (info "(elisp)Parser State") + (let* ((begin-state (syntax-ppss begin)) + (end-state (syntax-ppss end)) + ;; syntax-ppss has moved point to "end". + (word-end (progn (skip-syntax-forward "w_")(point)))) + + ;; Remove grammar face from word(s) containing change region; + ;; might be changing to/from a keyword. See + ;; test/ada_mode-interactive_common.adb Obj_1 + (goto-char begin) + (skip-syntax-backward "w_") + (with-silent-modifications + (remove-text-properties (point) word-end '(font-lock-face nil fontified nil))) + + (if (<= wisi-cache-max begin) + ;; Change is in unvalidated region; either the parse was + ;; failing, or there is more than one top-level grammar + ;; symbol in buffer. + (when wisi-parse-failed + ;; The parse was failing, probably due to bad syntax; this + ;; change may have fixed it, so try reparse. + (setq wisi-parse-try t)) + + ;; else change is in validated region + ;; + ;; don't invalidate parse for whitespace, string, or comment changes + (cond + ((and + (nth 3 begin-state); in string + (nth 3 end-state))) + ;; no easy way to tell if there is intervening non-string + + ((and + (nth 4 begin-state); in comment + (nth 4 end-state)) + ;; too hard to detect case where there is intervening + ;; code; no easy way to go to end of comment if not + ;; newline + ) + + ;; Deleting whitespace generally does not require parse, but + ;; deleting all whitespace between two words does; check that + ;; there is whitespace on at least one side of the deleted + ;; text. + ;; + ;; We are not in a comment (checked above), so treat + ;; comment end as whitespace in case it is newline, except + ;; deleting a comment end at begin means commenting the + ;; current line; requires parse. + ((and + (eq (car (syntax-after begin)) 0) ; whitespace + (memq (car (syntax-after (1- end))) '(0 12)) ; whitespace, comment end + (or + (memq (car (syntax-after (1- begin))) '(0 12)) + (memq (car (syntax-after end)) '(0 12))) + (progn + (goto-char begin) + (skip-syntax-forward " >" end) + (eq (point) end)))) - (t (setq wisi-change-need-invalidate t)) - )))) + (t + (setq wisi-change-need-invalidate + (progn + ;; note that because of the checks above, this never + ;; triggers a parse, so it's fast + (goto-char begin) + (wisi-goto-statement-start) + (point)))) + ))) + )) + ) (defun wisi-after-change (begin end length) "For `after-change-functions'." - ;; begin . end is range of text being inserted (may be empty) + ;; begin . end is range of text being inserted (empty if equal); + ;; length is the size of the deleted text. ;; (syntax-ppss-flush-cache begin) is in before-change-functions - (cond - (wisi-parse-failed - ;; The parse was failing, probably due to bad syntax; this change - ;; may have fixed it, so try reparse. - (setq wisi-parse-try t) - - ;; remove 'wisi-cache on inserted text, which could have caches - ;; from before the failed parse, and are in any case invalid. - (with-silent-modifications - (remove-text-properties begin end '(wisi-cache))) - ) + (syntax-propertize end) ;; see comments above on "lexer" re syntax-propertize - ((>= wisi-cache-max begin) - ;; The parse had succeeded past the start of the inserted - ;; text. - (save-excursion - (let ((need-invalidate t) - ;; (info "(elisp)Parser State") - (state (syntax-ppss begin))) - ;; syntax-ppss has moved point to "begin". + ;; Remove caches on inserted text, which could have caches from + ;; before the failed parse (or another buffer), and are in any case + ;; invalid. No point in removing 'fontified; that's handled by + ;; jit-lock. + + (with-silent-modifications + (remove-text-properties begin end '(wisi-cache nil font-lock-face nil))) + + ;; Also remove grammar face from word(s) containing change region; + ;; might be changing to/from a keyword. See + ;; test/ada_mode-interactive_common.adb Obj_1 + (save-excursion + ;; (info "(elisp)Parser State") + (let ((need-invalidate wisi-change-need-invalidate) + begin-state end-state word-end) + (when (> end begin) + (setq begin-state (syntax-ppss begin)) + (setq end-state (syntax-ppss end)) + ;; syntax-ppss has moved point to "end". + (skip-syntax-forward "w_") + (setq word-end (point)) + (goto-char begin) + (skip-syntax-backward "w_") + (with-silent-modifications + (remove-text-properties (point) word-end '(font-lock-face nil fontified nil)))) + + (if (<= wisi-cache-max begin) + ;; Change is in unvalidated region + (when wisi-parse-failed + ;; The parse was failing, probably due to bad syntax; this + ;; change may have fixed it, so try reparse. + (setq wisi-parse-try t)) + + ;; Change is in validated region (cond (wisi-change-need-invalidate ;; wisi-before change determined the removed text alters the ;; parse - nil) + ) + + ((= end begin) + (setq need-invalidate nil)) + + ((and + (nth 3 begin-state); in string + (nth 3 end-state)) + ;; no easy way to tell if there is intervening non-string + (setq need-invalidate nil)) ((or - (nth 3 state); in string - (nth 4 state)); in comment - ;; FIXME: insert newline in comment to create non-comment!? - ;; or paste a chunk of code - ;; => check that all of change region is comment or string + (nth 4 begin-state) + (nth 4 end-state)); in comment + ;; no easy way to detect intervening code (setq need-invalidate nil) ;; no caches to remove ) - ((progn - (skip-syntax-forward " " end);; does not skip newlines - (eq (point) end)) + ;; Adding whitespace generally does not require parse, but in + ;; the middle of word it does; check that there was + ;; whitespace on at least one side of the inserted text. + ;; + ;; We are not in a comment (checked above), so treat + ;; comment end as whitespace in case it is newline + ((and + (or + (memq (car (syntax-after (1- begin))) '(0 12)); whitespace, comment end + (memq (car (syntax-after end)) '(0 12))) + (progn + (goto-char begin) + (skip-syntax-forward " >" end) + (eq (point) end))) (setq need-invalidate nil)) - (t nil) + (t + (setq need-invalidate + (progn + (goto-char begin) + ;; note that because of the checks above, this never + ;; triggers a parse, so it's fast + (wisi-goto-statement-start) + (point)))) ) (if need-invalidate - ;; The inserted or deleted text could alter the parse; - ;; wisi-invalidate-cache removes all 'wisi-cache. - (wisi-invalidate-cache) + (wisi-invalidate-cache need-invalidate) - ;; else move cache-max by the net change length. We don't - ;; need to delete 'wisi-cache in the inserted text, because - ;; if there were any it would not pass the above. + ;; else move cache-max by the net change length. (setq wisi-cache-max - (+ wisi-cache-max (- end begin length)))) - ) - )) - - (t - ;; parse never attempted, or only done to before BEGIN. Just - ;; remove 'wisi-cache - (with-silent-modifications - (remove-text-properties begin end '(wisi-cache))) - ) - )) + (+ wisi-cache-max (- end begin length))) ) + )) + )) (defun wisi-get-cache (pos) "Return `wisi-cache' struct from the `wisi-cache' text property at POS. @@ -466,6 +629,7 @@ If accessing cache at a marker for a token as set by `wisi-cache-tokens', POS mu (when (string-match ":\\([0-9]+\\):\\([0-9]+\\):" wisi-parse-error-msg) (let ((line (string-to-number (match-string 1 wisi-parse-error-msg))) (col (string-to-number (match-string 2 wisi-parse-error-msg)))) + (push-mark) (goto-char (point-min)) (forward-line (1- line)) (forward-char col)))) @@ -473,15 +637,24 @@ If accessing cache at a marker for a token as set by `wisi-cache-tokens', POS mu (defun wisi-show-parse-error () "Show last wisi-parse error." (interactive) - (if wisi-parse-failed - (progn - (message wisi-parse-error-msg) - (wisi-goto-error)) - (message "parse succeeded"))) + (cond + (wisi-parse-failed + (wisi-goto-error) + (message wisi-parse-error-msg)) + + (wisi-parse-try + (message "need parse")) + + (t + (message "parse succeeded")) + )) + +(defvar wisi-post-parse-succeed-hook nil + "Hook run after parse succeeds.") (defun wisi-validate-cache (pos) "Ensure cached data is valid at least up to POS in current buffer." - (let ((msg (format "wisi: parsing %s:%d ..." (buffer-name) (line-number-at-pos)))) + (let ((msg (when (> wisi-debug 0) (format "wisi: parsing %s:%d ..." (buffer-name) (line-number-at-pos pos))))) (when (and wisi-parse-try (< wisi-cache-max pos)) (when (> wisi-debug 0) @@ -489,24 +662,33 @@ If accessing cache at a marker for a token as set by `wisi-cache-tokens', POS mu (setq wisi-parse-try nil) (setq wisi-parse-error-msg nil) - (save-excursion - (goto-char wisi-cache-max) - (if (> wisi-debug 1) - ;; let debugger stop in wisi-parse - (progn + (setq wisi-end-caches nil) + + (if (> wisi-debug 1) + ;; let debugger stop in wisi-parse + (progn + (save-excursion (wisi-parse wisi-parse-table 'wisi-forward-token) (setq wisi-cache-max (point)) (setq wisi-parse-failed nil)) - ;; else capture errors from bad syntax, so higher level functions can try to continue - (condition-case err - (progn + (run-hooks 'wisi-post-parse-succeed-hook)) + + ;; else capture errors from bad syntax, so higher level + ;; functions can try to continue and/or we don't bother the + ;; user. + (condition-case err + (progn + (save-excursion (wisi-parse wisi-parse-table 'wisi-forward-token) (setq wisi-cache-max (point)) (setq wisi-parse-failed nil)) - (wisi-parse-error - (setq wisi-parse-failed t) - (setq wisi-parse-error-msg (cdr err))) - ))) + (run-hooks 'wisi-post-parse-succeed-hook)) + (wisi-parse-error + ;; delete caches past wisi-cache-max added by failed parse + (wisi-delete-cache wisi-cache-max) + (setq wisi-parse-failed t) + (setq wisi-parse-error-msg (cdr err))) + )) (if wisi-parse-error-msg ;; error (when (> wisi-debug 0) @@ -518,12 +700,22 @@ If accessing cache at a marker for a token as set by `wisi-cache-tokens', POS mu (message "%s done" msg))) ))) +(defun wisi-fontify-region (begin end) + "For `jit-lock-functions'." + (when (< (point-max) wisi-font-lock-size-threshold) + (wisi-validate-cache end))) + (defun wisi-get-containing-cache (cache) "Return cache from (wisi-cache-containing CACHE)." (let ((containing (wisi-cache-containing cache))) (and containing (wisi-get-cache (1- containing))))) +(defun wisi-cache-region (cache) + "Return region designated by cache. +Point must be at cache." + (cons (point) (+ (point) (wisi-cache-last cache)))) + (defun wisi-cache-text (cache) "Return property-less buffer substring designated by cache. Point must be at cache." @@ -554,29 +746,33 @@ delete from `wisi-end-caches'." ;; keep byte-compiler happy; `wisi-tokens' is bound in action created ;; by wisi-semantic-action -(defun wisi-statement-action (&rest pairs) +(defun wisi-statement-action (pairs) "Cache information in text properties of tokens. Intended as a grammar non-terminal action. -PAIRS is of the form [TOKEN-NUMBER CLASS] ... where TOKEN-NUMBER -is the (1 indexed) token number in the production, CLASS is the wisi class of -that token. Use in a grammar action as: - (wisi-statement-action 1 'statement-start 7 'statement-end)" +PAIRS is a vector of the form [TOKEN-NUMBER CLASS TOKEN-NUMBER +CLASS ...] where TOKEN-NUMBER is the (1 indexed) token number in +the production, CLASS is the wisi class of that token. Use in a +grammar action as: + (wisi-statement-action [1 'statement-start 7 'statement-end])" (save-excursion (let ((first-item t) first-keyword-mark - (override-start nil)) - (while pairs - (let* ((number (1- (pop pairs))) - (region (cddr (nth number wisi-tokens)));; wisi-tokens is let-bound in wisi-parse-reduce - (token (car (nth number wisi-tokens))) - (class (pop pairs)) + (override-start nil) + (i 0)) + (while (< i (length pairs)) + (let* ((number (1- (aref pairs i))) + (region (cdr (aref wisi-tokens number)));; wisi-tokens is let-bound in wisi-parse-reduce + (token (car (aref wisi-tokens number))) + (class (aref pairs (setq i (1+ i)))) (mark ;; Marker one char into token, so indent-line-to ;; inserts space before the mark, not after (when region (copy-marker (1+ (car region))))) cache) + (setq i (1+ i)) + (unless (memq class wisi-class-list) (error "%s not in wisi-class-list" class)) @@ -592,7 +788,8 @@ that token. Use in a grammar action as: ;; ;; statement : label_opt simple_statement ;; - ;; override nonterm, class and containing + ;; override nonterm, class, containing + ;; set end only if not set yet (due to failed parse) (progn (cl-case (wisi-cache-class cache) (block-start @@ -611,7 +808,13 @@ that token. Use in a grammar action as: (setf (wisi-cache-class cache) (or override-start class))) ) (setf (wisi-cache-nonterm cache) $nterm) - (setf (wisi-cache-containing cache) first-keyword-mark)) + (setf (wisi-cache-containing cache) first-keyword-mark) + (unless (wisi-cache-end cache) + (if wisi-end-caches + (push (car region) wisi-end-caches) + (setq wisi-end-caches (list (car region))) + )) + ) ;; else create new cache (with-silent-modifications @@ -655,25 +858,25 @@ that token. Use in a grammar action as: "Set containing marks in all tokens in CONTAINED-TOKEN with null containing mark to marker pointing to CONTAINING-TOKEN. If CONTAINING-TOKEN is empty, the next token number is used." ;; wisi-tokens is is bound in action created by wisi-semantic-action - (let* ((containing-region (cddr (nth (1- containing-token) wisi-tokens))) - (contained-region (cddr (nth (1- contained-token) wisi-tokens)))) + (let* ((containing-region (cdr (aref wisi-tokens (1- containing-token)))) + (contained-region (cdr (aref wisi-tokens (1- contained-token))))) (unless containing-region ;; (signal 'wisi-parse-error (wisi-error-msg "wisi-containing-action: containing-region '%s' is empty. grammar error; bad action" - (nth 1 (nth (1- containing-token) wisi-tokens))))) + (wisi-token-text (aref wisi-tokens (1- containing-token)))))) (unless (or (not contained-region) ;; contained-token is empty (wisi-get-cache (car containing-region))) (signal 'wisi-parse-error (wisi-error-msg "wisi-containing-action: containing-token '%s' has no cache. grammar error; missing action" - (nth 1 (nth (1- containing-token) wisi-tokens))))) + (wisi-token-text (aref wisi-tokens (1- containing-token)))))) (while (not containing-region) ;; containing-token is empty; use next - (setq containing-region (cddr (nth containing-token wisi-tokens)))) + (setq containing-region (cdr (aref wisi-tokens containing-token)))) (when contained-region ;; nil when empty production, may not contain any caches @@ -700,28 +903,48 @@ If CONTAINING-TOKEN is empty, the next token number is used." (setq cache (wisi-backward-cache))) )))))) -(defun wisi-motion-action (&rest token-numbers) +(defun wisi-match-class-token (cache class-tokens) + "Return t if CACHE matches CLASS-TOKENS. +CLASS-TOKENS is a vector [number class token_id class token_id ...]. +number is ignored." + (let ((i 1) + (done nil) + (result nil) + class token) + (while (and (not done) + (< i (length class-tokens))) + (setq class (aref class-tokens i)) + (setq token (aref class-tokens (setq i (1+ i)))) + (setq i (1+ i)) + (when (and (eq class (wisi-cache-class cache)) + (eq token (wisi-cache-token cache))) + (setq result t + done t)) + ) + result)) + +(defun wisi-motion-action (token-numbers) "Set prev/next marks in all tokens given by TOKEN-NUMBERS. -Each TOKEN-NUMBERS is one of: +TOKEN-NUMBERS is a vector with each element one of: number: the token number; mark that token -list (number token_id): -list (number (token_id token_id)): - mark all tokens with token_id in the nonterminal given by the number." +vector [number class token_id]: +vector [number class token_id class token_id ...]: + mark all tokens in number nonterminal matching (class token_id) with nil prev/next." (save-excursion (let (prev-keyword-mark prev-cache cache - mark) - (while token-numbers - (let ((token-number (pop token-numbers)) - target-token + mark + (i 0)) + (while (< i (length token-numbers)) + (let ((token-number (aref token-numbers i)) region) + (setq i (1+ i)) (cond ((numberp token-number) - (setq target-token nil) - (setq region (cddr (nth (1- token-number) wisi-tokens))) + (setq region (cdr (aref wisi-tokens (1- token-number)))) (when region (setq cache (wisi-get-cache (car region))) (setq mark (copy-marker (1+ (car region)))) @@ -736,30 +959,29 @@ list (number (token_id token_id)): (setq prev-cache cache) )) - ((listp token-number) - ;; token-number may contain 0, 1, or more token_id; token_id may be a list + ((vectorp token-number) + ;; token-number may contain 0, 1, or more 'class token_id' pairs ;; the corresponding region may be empty ;; there must have been a prev keyword - (setq target-token (cadr token-number)) - (when (not (listp target-token)) - (setq target-token (list target-token))) - (setq token-number (car token-number)) - (setq region (cddr (nth (1- token-number) wisi-tokens))) + (setq region (cdr (aref wisi-tokens (1- (aref token-number 0))))) (when region ;; not an empty token + ;; We must search for all targets at the same time, to + ;; get the motion order right. (goto-char (car region)) - (while (wisi-forward-find-token target-token (cdr region) t) - (setq cache (wisi-get-cache (point))) - (setq mark (copy-marker (1+ (point)))) - - (when (null (wisi-cache-prev cache)) - (setf (wisi-cache-prev cache) prev-keyword-mark) - (setf (wisi-cache-next prev-cache) mark) - (setq prev-keyword-mark mark) - (setq prev-cache cache)) - - (wisi-forward-token);; don't find same token again - )) - ) + (setq cache (or (wisi-get-cache (point)) + (wisi-forward-cache))) + (while (< (point) (cdr region)) + (when (wisi-match-class-token cache token-number) + (when (null (wisi-cache-prev cache)) + (setf (wisi-cache-prev cache) prev-keyword-mark)) + (when (null (wisi-cache-next cache)) + (setq mark (copy-marker (1+ (point)))) + (setf (wisi-cache-next prev-cache) mark) + (setq prev-keyword-mark mark) + (setq prev-cache cache))) + + (setq cache (wisi-forward-cache)) + ))) (t (error "unexpected token-number %s" token-number)) @@ -768,6 +990,142 @@ list (number (token_id token_id)): )) ))) +(defun wisi-extend-action (number) + "Extend text of cache at token NUMBER to cover all of token NUMBER. +Also override token with new token." + (let* ((token-region (aref wisi-tokens (1- number)));; wisi-tokens is let-bound in wisi-parse-reduce + (token (car token-region)) + (region (cdr token-region)) + cache) + + (when region + (setq cache (wisi-get-cache (car region))) + (setf (wisi-cache-last cache) (- (cdr region) (car region))) + (setf (wisi-cache-token cache) token) + ) + )) + +(defun wisi-face-action-1 (face region &optional no-override) + "Apply FACE to REGION. If NO-OVERRIDE is non-nil, don't override existing face." + (when region + ;; We allow overriding a face property, because we don't want to + ;; delete them in wisi-invalidate (see comments there). On the + ;; other hand, it can be an error, so keep this debug + ;; code. However, note that font-lock-face properties must be + ;; removed first, or the buffer must be fresh (never parsed). + ;; + ;; Grammar sets no-override when a higher-level production might + ;; override a face in a lower-level production; that's not an + ;; error. + (let (cur-face + (do-set t)) + (when (or no-override + (> wisi-debug 1)) + (setq cur-face (get-text-property (car region) 'font-lock-face)) + (if cur-face + (if no-override + (setq do-set nil) + (message "%s:%d overriding face %s with %s on '%s'" + (buffer-file-name) + (line-number-at-pos (car region)) + face + cur-face + (buffer-substring-no-properties (car region) (cdr region)))) + + )) + (when do-set + (with-silent-modifications + (add-text-properties + (car region) (cdr region) + (list + 'font-lock-face face + 'fontified t)))) + ))) + +(defun wisi-face-action (pairs &optional no-override) + "Cache face information in text properties of tokens. +Intended as a grammar non-terminal action. + +PAIRS is a vector of the form [token-number face token-number face ...] +token-number may be an integer, or a vector [integer token_id token_id ...] + +For an integer token-number, apply face to the first cached token +in the range covered by wisi-tokens[token-number]. If there are +no cached tokens, apply face to entire wisi-tokens[token-number] +region. + +For a vector token-number, apply face to the first cached token +in the range matching one of token_id covered by +wisi-tokens[token-number]. + +If NO-OVERRIDE is non-nil, don't override existing face." + (let (number region face (tokens nil) cache (i 0) (j 1)) + (while (< i (length pairs)) + (setq number (aref pairs i)) + (setq face (aref pairs (setq i (1+ i)))) + (cond + ((integerp number) + (setq region (cdr (aref wisi-tokens (1- number))));; wisi-tokens is let-bound in wisi-parse-reduce + (when region + (save-excursion + (goto-char (car region)) + (setq cache (or (wisi-get-cache (point)) + (wisi-forward-cache))) + (if (< (point) (cdr region)) + (when cache + (wisi-face-action-1 face (wisi-cache-region cache) no-override)) + + ;; no caches in region; just apply face to region + (wisi-face-action-1 face region no-override)) + ))) + + ((vectorp number) + (setq region (cdr (aref wisi-tokens (1- (aref number 0))))) + (when region + (while (< j (length number)) + (setq tokens (cons (aref number j) tokens)) + (setq j (1+ j))) + (save-excursion + (goto-char (car region)) + (setq cache (wisi-forward-find-token tokens (cdr region) t)) + ;; might be looking for IDENTIFIER in name, but only have "*". + (when cache + (wisi-face-action-1 face (wisi-cache-region cache) no-override)) + ))) + ) + (setq i (1+ i)) + + ))) + +(defun wisi-face-list-action (pairs &optional no-override) + "Cache face information in text properties of tokens. +Intended as a grammar non-terminal action. + +PAIRS is a vector of the form [token-number face token-number face ...] +token-number is an integer. Apply face to all cached tokens +in the range covered by wisi-tokens[token-number]. + +If NO-OVERRIDE is non-nil, don't override existing face." + (let (number region face cache (i 0)) + (while (< i (length pairs)) + (setq number (aref pairs i)) + (setq face (aref pairs (setq i (1+ i)))) + (setq region (cdr (aref wisi-tokens (1- number))));; wisi-tokens is let-bound in wisi-parse-reduce + (when region + (save-excursion + (goto-char (car region)) + (setq cache (or (wisi-get-cache (point)) + (wisi-forward-cache))) + (while (<= (point) (cdr region)) + (when cache + (wisi-face-action-1 face (wisi-cache-region cache) no-override)) + (setq cache (wisi-forward-cache)) + ))) + + (setq i (1+ i)) + + ))) + ;;;; motion (defun wisi-backward-cache () "Move point backward to the beginning of the first token preceding point that has a cache. @@ -882,7 +1240,7 @@ If LIMIT (a buffer position) is reached, throw an error." "If not at a cached token, move forward to next cache. Otherwise move to cache-next, or next cache if nil. Return cache found." - (wisi-validate-cache (point-max)) + (wisi-validate-cache (point-max)) ;; ensure there is a next cache to move to (let ((cache (wisi-get-cache (point)))) (if cache (let ((next (wisi-cache-next cache))) @@ -898,7 +1256,7 @@ Return cache found." (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-max)) + (wisi-validate-cache (point)) (let ((cache (wisi-get-cache (point)))) (if cache (let ((prev (wisi-cache-prev cache))) @@ -909,7 +1267,8 @@ cache. Otherwise move to cache-prev, or prev cache if nil." )) (defun wisi-goto-containing (cache &optional error) - "Move point to containing token for CACHE, return cache at that point." + "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 ((markerp (wisi-cache-containing cache)) (goto-char (1- (wisi-cache-containing cache))) @@ -933,7 +1292,7 @@ Return cache for paren, or nil if no containing paren." "Move point to containing ancestor of CACHE that has class block-start or statement-start. Return start cache." (when - ;; cache nil at bob + ;; cache nil at bob, or on cache in partially parsed statement (while (and cache (not (memq (wisi-cache-class cache) '(block-start statement-start)))) (setq cache (wisi-goto-containing cache))) @@ -943,10 +1302,20 @@ Return start cache." (defun wisi-goto-end-1 (cache) (goto-char (1- (wisi-cache-end cache)))) -(defun wisi-goto-end () +(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)) + (let ((cache (wisi-get-cache (point)))) + (unless cache + (setq cache (wisi-backward-cache))) + (wisi-goto-start cache))) + +(defun wisi-goto-statement-end () "Move point to token at end of statement point is in or before." (interactive) - (wisi-validate-cache (point-max)) + (wisi-validate-cache (point)) (let ((cache (or (wisi-get-cache (point)) (wisi-forward-cache)))) (when (wisi-cache-end cache) @@ -1001,9 +1370,7 @@ of CACHE with class statement-start or block-start." (defun wisi-indent-statement () "Indent region given by `wisi-goto-start' on cache at or before point, then wisi-cache-end." - ;; force reparse, in case parser got confused - (let ((wisi-parse-try t)) - (wisi-validate-cache (point))) + (wisi-validate-cache (point)) (save-excursion (let ((cache (or (wisi-get-cache (point)) @@ -1040,27 +1407,41 @@ correct. Must leave point at indentation of current line.") "Indent current line using the wisi indentation engine." (interactive) - (let* ((savep (point)) - (indent - (or (save-excursion - (wisi-validate-cache (point)) - (back-to-indentation) - (when (>= (point) savep) (setq savep nil)) - (if wisi-parse-failed - (progn - ;; parse failed. Assume user is editing; indent to previous line, fix it after parse succeeds - (setq wisi-indent-failed t) - (forward-line -1);; safe at bob - (back-to-indentation) - (current-column)) - - ;; else parse succeeded - (when wisi-indent-failed - (setq wisi-indent-failed nil) - (run-hooks 'wisi-post-parse-fail-hook)) - (with-demoted-errors - (or (run-hook-with-args-until-success 'wisi-indent-calculate-functions) 0)) - ))))) + (let ((savep (point)) + indent) + (save-excursion + (back-to-indentation) + (when (>= (point) savep) (setq savep nil)) + + (when (>= (point) wisi-cache-max) + (wisi-validate-cache (line-end-position))) ;; include at lease the first token on this line + + (if (> (point) wisi-cache-max) + ;; parse failed + (progn + ;; no indent info at point. Assume user is + ;; editing; indent to previous line, fix it + ;; after parse succeeds + (setq wisi-indent-failed t) + (forward-line -1);; safe at bob + (back-to-indentation) + (setq indent (current-column))) + + ;; parse succeeded + (when wisi-indent-failed + ;; previous parse failed + (setq wisi-indent-failed nil) + (run-hooks 'wisi-post-parse-fail-hook)) + + (when (> (point) wisi-cache-max) + (error "wisi-post-parse-fail-hook invalidated parse.")) + + (setq indent + (with-demoted-errors + (or (run-hook-with-args-until-success 'wisi-indent-calculate-functions) 0)) + ) + )) + (if savep ;; point was inside line text; leave it there (save-excursion (indent-line-to indent)) @@ -1094,6 +1475,11 @@ correct. Must leave point at indentation of current line.") (message "previous %s" (wisi-backward-cache))) )) +(defun wisi-show-cache-max () + (interactive) + (push-mark) + (goto-char wisi-cache-max)) + ;;;;; setup (defun wisi-setup (indent-calculate post-parse-fail class-list keyword-table token-table parse-table) @@ -1103,6 +1489,10 @@ correct. Must leave point at indentation of current line.") (setq wisi-string-single-term (car (symbol-value (intern-soft "string-single" token-table)))) (setq wisi-symbol-term (car (symbol-value (intern-soft "symbol" token-table)))) + (let ((numbers (cadr (symbol-value (intern-soft "number" token-table))))) + (setq wisi-number-term (car numbers)) + (setq wisi-number-p (cdr numbers))) + (setq wisi-punctuation-table (symbol-value (intern-soft "punctuation" token-table))) (setq wisi-punctuation-table-max-length 0) (let (fail) @@ -1135,8 +1525,10 @@ correct. Must leave point at indentation of current line.") (add-hook 'before-change-functions 'wisi-before-change nil t) (add-hook 'after-change-functions 'wisi-after-change nil t) - ;; WORKAROUND: sometimes the first time font-lock is run, - ;; syntax-propertize is not run properly, so we run it here + (when (functionp 'jit-lock-register) + (jit-lock-register 'wisi-fontify-region)) + + ;; see comments on "lexer" above re syntax-propertize (syntax-propertize (point-max)) (wisi-invalidate-cache)