;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
-;; Version: 1.0.5
+;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
+;; Keywords: parser
+;; indentation
+;; navigation
+;; Version: 1.0.6
;; package-requires: ((cl-lib "0.4") (emacs "24.2"))
;; URL: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html
;;
;;; Commentary:
-;;;; History: first experimental version Oct 2012
+;;;; History: see NEWS-wisi.text
;;
;;;; indentation algorithm overview
;;
;; 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
(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-text (buffer-substring-no-properties start (point)))
+ (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_'")
);; 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
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
+ face ;; for font-lock. only set when regexp font-lock can't handle it
)
-(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
(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-invalidate-cache(&optional after)
+ "Invalidate parsing caches for the current buffer from AFTER to end of buffer.
+Caches are the Emacs syntax cache, the wisi token cache, and the wisi parser cache."
(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))
+ (syntax-ppss-flush-cache after)
(with-silent-modifications
- (remove-text-properties (point-min) (point-max) '(wisi-cache))))
+ (remove-text-properties after (point-max) '(wisi-cache nil))))
(defun wisi-before-change (begin end)
"For `before-change-functions'."
(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))
-
- ((progn
- (skip-syntax-forward " " end);; does not skip newline
- (eq (point) end))
- (setq wisi-change-need-invalidate nil))
-
- (t (setq wisi-change-need-invalidate t))
- ))))
+ (setq wisi-change-need-invalidate nil)
+
+ (when (and (> end begin)
+ (>= wisi-cache-max begin))
+
+ (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))
+
+ (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
+ )
+
+ ((progn
+ (skip-syntax-forward " " end);; does not skip newline
+ (eq (point) end)))
+
+ (t
+ (setq wisi-change-need-invalidate
+ (progn
+ (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)
;; (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)
+ (syntax-propertize end) ;; see comments above on "lexer" re syntax-propertize
- ;; 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)))
- )
+ ;; 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 (or another buffer), and are in
+ ;; any case invalid.
+ (with-silent-modifications
+ (remove-text-properties begin end '(wisi-cache)))
+
+ (cond
((>= wisi-cache-max begin)
;; The parse had succeeded past the start of the inserted
;; text.
(save-excursion
- (let ((need-invalidate t)
+ (let (need-invalidate
;; (info "(elisp)Parser State")
(state (syntax-ppss begin)))
;; syntax-ppss has moved point to "begin".
(wisi-change-need-invalidate
;; wisi-before change determined the removed text alters the
;; parse
- nil)
+ (setq need-invalidate wisi-change-need-invalidate))
+
+ ((= end begin)
+ (setq need-invalidate nil))
((or
(nth 3 state); in string
(eq (point) end))
(setq need-invalidate nil))
- (t nil)
+ (t
+ (setq need-invalidate begin))
)
(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
+ ;; remove caches
(with-silent-modifications
(remove-text-properties begin end '(wisi-cache)))
)
(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
+ (message wisi-parse-error-msg)
+ (wisi-goto-error))
+
+ (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)
(setq wisi-parse-try nil)
(setq wisi-parse-error-msg nil)
+ (setq wisi-end-caches nil)
+
(save-excursion
- (goto-char wisi-cache-max)
(if (> wisi-debug 1)
;; let debugger stop in wisi-parse
(progn
(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
+ (setq wisi-parse-failed nil)
+ (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
(wisi-parse wisi-parse-table 'wisi-forward-token)
(setq wisi-cache-max (point))
- (setq wisi-parse-failed nil))
+ (setq wisi-parse-failed nil)
+ (run-hooks 'wisi-post-parse-succeed-hook))
(wisi-parse-error
(setq wisi-parse-failed t)
(setq wisi-parse-error-msg (cdr err)))
(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."
;;
;; 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
(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
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."
+list (number class token_id):
+list (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
mark)
(while token-numbers
(let ((token-number (pop token-numbers))
- target-token
+ class-tokens target-class target-token
region)
(cond
((numberp token-number)
- (setq target-token nil)
(setq region (cddr (nth (1- token-number) wisi-tokens)))
(when region
(setq cache (wisi-get-cache (car region)))
))
((listp token-number)
- ;; token-number may contain 0, 1, or more token_id; token_id may be a list
+ ;; 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 class-tokens (cdr token-number))
(setq token-number (car token-number))
(setq region (cddr (nth (1- token-number) wisi-tokens)))
(when region ;; not an empty token
- (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
+ (while class-tokens
+ (setq target-class (pop class-tokens))
+ (setq target-token (list (pop class-tokens)))
+ (goto-char (car region))
+ (while (setq cache (wisi-forward-find-token target-token (cdr region) t))
+ (when (eq target-class (wisi-cache-class cache))
+ (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)))
+
+ (wisi-forward-token);; don't find same token again
))
- )
+ ))
(t
(error "unexpected token-number %s" token-number))
))
)))
+(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 (nth (1- number) wisi-tokens));; wisi-tokens is let-bound in wisi-parse-reduce
+ (token (car token-region))
+ (region (cddr 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 (&rest pairs)
+ "Cache face information in text properties of tokens.
+Intended as a grammar non-terminal action.
+
+PAIRS is of the form [TOKEN-NUMBER fase] ..."
+ (while pairs
+ (let* ((number (1- (pop pairs)))
+ (region (cddr (nth number wisi-tokens)));; wisi-tokens is let-bound in wisi-parse-reduce
+ (face (pop pairs))
+ cache)
+
+ (when region
+ (setq cache (wisi-get-cache (car region)))
+ (unless cache
+ (error "wisi-face-action on non-cache"))
+ (setf (wisi-cache-face cache) face)
+ (when (boundp 'jit-lock-mode)
+ (jit-lock-refontify (car region) (cdr region))))
+ )))
+
;;;; motion
(defun wisi-backward-cache ()
"Move point backward to the beginning of the first token preceding point that has a cache.
"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)))
(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)))
))
(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)))
(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)
(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))
"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 (point))
+ (when (and (not wisi-parse-failed)
+ wisi-indent-failed)
+ (setq wisi-indent-failed nil)
+ (run-hooks 'wisi-post-parse-fail-hook)))
+
+ (if (> (point) wisi-cache-max)
+ (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)))
+
+ (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))
(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
+ ;; see comments on "lexer" above re syntax-propertize
(syntax-propertize (point-max))
(wisi-invalidate-cache)