]> code.delx.au - gnu-emacs-elpa/blob - packages/wisi/wisi.el
Fix some quoting problems in doc strings
[gnu-emacs-elpa] / packages / wisi / wisi.el
1 ;;; wisi.el --- Utilities for implementing an indentation/navigation engine using a generalized LALR parser -*- lexical-binding:t -*-
2 ;;
3 ;; Copyright (C) 2012 - 2016 Free Software Foundation, Inc.
4 ;;
5 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
6 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
7 ;; Keywords: parser
8 ;; indentation
9 ;; navigation
10 ;; Version: 1.1.2
11 ;; package-requires: ((cl-lib "0.4") (emacs "24.2"))
12 ;; URL: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html
13 ;;
14 ;; This file is part of GNU Emacs.
15 ;;
16 ;; GNU Emacs is free software: you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation, either version 3 of the License, or
19 ;; (at your option) any later version.
20 ;;
21 ;; GNU Emacs is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
25 ;;
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;;
29
30 ;;; Commentary:
31
32 ;;;; History: see NEWS-wisi.text
33 ;;
34 ;;;; indentation algorithm overview
35 ;;
36 ;; This design is inspired in part by experience writing a SMIE
37 ;; indentation engine for Ada, and the wisent parser.
38 ;;
39 ;; The general approach to indenting a given token is to find the
40 ;; start of the statement it is part of, or some other relevant point
41 ;; in the statement, and indent relative to that. So we need a parser
42 ;; that lets us find statement indent points from arbitrary places in
43 ;; the code.
44 ;;
45 ;; For example, the grammar for Ada as represented by the EBNF in LRM
46 ;; Annex P is not LALR(1), so we use a generalized LALR(1) parser (see
47 ;; wisi-parse, wisi-compile).
48 ;;
49 ;; The parser actions cache indentation and other information as text
50 ;; properties of tokens in statements.
51 ;;
52 ;; An indentation engine moves text in the buffer, as does user
53 ;; editing, so we can't rely on character positions remaining
54 ;; constant. So the parser actions use markers to store
55 ;; positions. Text properties also move with the text.
56 ;;
57 ;; The stored information includes a marker at each statement indent
58 ;; point. Thus, the indentation algorithm is: find the previous token
59 ;; with cached information, and either indent from it, or fetch from
60 ;; it the marker for a previous statement indent point, and indent
61 ;; relative to that.
62 ;;
63 ;; Since we have a cache (the text properties), we need to consider
64 ;; when to invalidate it. Ideally, we invalidate only when a change to
65 ;; the buffer would change the result of a parse that crosses that
66 ;; change, or starts after that change. Changes in whitespace
67 ;; (indentation and newlines) do not affect an Ada parse. Other
68 ;; languages are sensitive to newlines (Bash for example) or
69 ;; indentation (Python). Adding comments does not change a parse,
70 ;; unless code is commented out. For now we invalidate the cache after
71 ;; the edit point if the change involves anything other than
72 ;; whitespace.
73 ;;
74 ;;; Handling parse errors:
75 ;;
76 ;; When a parse fails, the cache information before the failure point
77 ;; is only partly correct, and there is no cache informaiton after the
78 ;; failure point.
79 ;;
80 ;; However, in the case where a parse previously succeeded, and the
81 ;; current parse fails due to editing, we keep the preceding cache
82 ;; information by setting wisi-cache-max to the edit point in
83 ;; wisi-before change; the parser does not apply actions before that
84 ;; point.
85 ;;
86 ;; This allows navigation and indentation in the text preceding the
87 ;; edit point, and saves some time.
88 ;;
89 ;;;; comparison to the SMIE parser
90 ;;
91 ;; The central problem to be solved in building the SMIE parser is
92 ;; grammar precedence conflicts; the general solution is refining
93 ;; keywords so that each new keyword can be assigned a unique
94 ;; precedence. This means ad hoc code must be written to determine the
95 ;; correct refinement for each language keyword from the surrounding
96 ;; tokens. In effect, for a complex language like Ada, the knowledge
97 ;; of the language grammar is mostly embedded in the refinement code;
98 ;; only a small amount is in the refined grammar. Implementing a SMIE
99 ;; parser for a new language involves the same amount of work as the
100 ;; first language.
101 ;;
102 ;; Using a generalized LALR parser avoids that particular problem;
103 ;; assuming the language is already defined by a grammar, it is only a
104 ;; matter of a format change to teach the wisi parser the
105 ;; language. The problem in a wisi indentation engine is caching the
106 ;; output of the parser in a useful way, since we can't start the
107 ;; parser from arbitrary places in the code (as we can with the SMIE
108 ;; parser). A second problem is determining when to invalidate the
109 ;; cache. But these problems are independent of the language being
110 ;; parsed, so once we have one wisi indentation engine working,
111 ;; adapting it to new languages should be quite simple.
112 ;;
113 ;; The SMIE parser does not find the start of each statement, only the
114 ;; first language keyword in each statement; additional code must be
115 ;; written to find the statement start and indent points. The wisi
116 ;; parser finds the statement start and indent points directly.
117 ;;
118 ;; In SMIE, it is best if each grammar rule is a complete statement,
119 ;; so forward-sexp will traverse the entire statement. If nested
120 ;; non-terminals are used, forward-sexp may stop inside one of the
121 ;; nested non-terminals. This problem does not occur with the wisi
122 ;; parser.
123 ;;
124 ;; A downside of the wisi parser is conflicts in the grammar; they can
125 ;; be much more difficult to resolve than in the SMIE parser. The
126 ;; generalized parser helps by handling conflicts, but it does so by
127 ;; running multiple parsers in parallel, persuing each choice in the
128 ;; conflict. If the conflict is due to a genuine ambiguity, both paths
129 ;; will succeed, which causes the parse to fail, since it is not clear
130 ;; which set of text properties to store. Even if one branch
131 ;; ultimately fails, running parallel parsers over large sections of
132 ;; code is slow. Finally, this approach can lead to exponential growth
133 ;; in the number of parsers. So grammar conflicts must still be
134 ;; analyzed and minimized.
135 ;;
136 ;; In addition, the complete grammar must be specified; in smie, it is
137 ;; often possible to specify a subset of the grammar.
138 ;;
139 ;;;; grammar compiler and parser
140 ;;
141 ;; Since we are using a generalized LALR(1) parser, we cannot use any
142 ;; of the wisent grammar functions. We use OpenToken wisi-generate
143 ;; to compile BNF to Elisp source (similar to
144 ;; semantic-grammar-create-package), and wisi-compile-grammar to
145 ;; compile that to the parser table.
146 ;;
147 ;; Semantic provides a complex lexer, more complicated than we need
148 ;; for indentation. So we use the elisp lexer, which consists of
149 ;; `forward-comment', `skip-syntax-forward', and `scan-sexp'. We wrap
150 ;; that in functions that return tokens in the form wisi-parse
151 ;; expects.
152 ;;
153 ;;;; lexer
154 ;;
155 ;; The lexer is `wisi-forward-token'. It relies on syntax properties,
156 ;; so syntax-propertize must be called on the text to be lexed before
157 ;; wisi-forward-token is called. In general, it is hard to determine
158 ;; an appropriate end-point for syntax-propertize, other than
159 ;; point-max. So we call (syntax-propertize point-max) in wisi-setup,
160 ;; and also call syntax-propertize in wisi-after-change.
161 ;; FIXME: no longer needed in Emacs 25? (email from Stefan Monnier)
162 ;;
163 ;;;; code style
164 ;;
165 ;; 'wisi' was originally short for "wisent indentation engine", but
166 ;; now is just a name.
167 ;;
168 ;; not using lexical-binding because we support Emacs 23
169 ;;
170 ;;;;;
171
172 ;;; Code:
173
174 (require 'cl-lib)
175 (require 'wisi-parse)
176
177 ;; WORKAROUND: for some reason, this condition doesn't work in batch mode!
178 ;; (when (and (= emacs-major-version 24)
179 ;; (= emacs-minor-version 2))
180 (require 'wisi-compat-24.2)
181 ;;)
182
183 (defcustom wisi-size-threshold 100000
184 "Max size (in characters) for using wisi parser results for syntax highlighting and file navigation."
185 :type 'integer
186 :group 'wisi
187 :safe 'integerp)
188 (make-variable-buffer-local 'wisi-size-threshold)
189
190 ;;;; lexer
191
192 (defvar-local wisi-class-list nil)
193 (defvar-local wisi-keyword-table nil)
194 (defvar-local wisi-punctuation-table nil)
195 (defvar-local wisi-punctuation-table-max-length 0)
196 (defvar-local wisi-string-double-term nil);; string delimited by double quotes
197 (defvar-local wisi-string-quote-escape-doubled nil
198 "Non-nil if a string delimiter is escaped by doubling it (as in Ada).")
199 (defvar-local wisi-string-quote-escape nil
200 "Cons (delim . character) where `character' escapes quotes in strings delimited by `delim'.")
201 (defvar-local wisi-string-single-term nil) ;; string delimited by single quotes
202 (defvar-local wisi-symbol-term nil)
203 (defvar-local wisi-number-term nil)
204 (defvar-local wisi-number-p nil)
205
206 (defun wisi-number-p (token-text)
207 "Return t if TOKEN-TEXT plus text after point matches the
208 syntax for a real literal; otherwise nil. Point is after
209 TOKEN-TEXT; move point to just past token."
210 ;; Typical literals:
211 ;; 1234
212 ;; 1234.5678
213 ;; _not_ including non-decimal base, or underscores (see ada-wisi-number-p)
214 ;;
215 ;; Starts with a simple integer
216 (when (string-match "^[0-9]+$" token-text)
217 (when (looking-at "\\.[0-9]+")
218 ;; real number
219 (goto-char (match-end 0))
220 (when (looking-at "[Ee][+-][0-9]+")
221 ;; exponent
222 (goto-char (match-end 0))))
223
224 t
225 ))
226
227 (defun wisi-forward-token ()
228 "Move point forward across one token, skipping leading whitespace and comments.
229 Return the corresponding token, in format: (token start . end) where:
230
231 `token' is a token symbol (not string) from `wisi-punctuation-table',
232 `wisi-keyword-table', `wisi-string-double-term', `wisi-string-double-term' or `wisi-symbol-term'.
233
234 `start, end' are the character positions in the buffer of the start
235 and end of the token text.
236
237 If at end of buffer, returns `wisent-eoi-term'."
238 (forward-comment (point-max))
239 ;; skips leading whitespace, comment, trailing whitespace.
240
241 (let ((start (point))
242 ;; (info "(elisp)Syntax Table Internals" "*info elisp syntax*")
243 (syntax (syntax-class (syntax-after (point))))
244 token-id token-text)
245 (cond
246 ((eobp)
247 (setq token-id wisent-eoi-term))
248
249 ((eq syntax 1)
250 ;; punctuation. Find the longest matching string in wisi-punctuation-table
251 (forward-char 1)
252 (let ((next-point (point))
253 temp-text temp-id done)
254 (while (not done)
255 (setq temp-text (buffer-substring-no-properties start (point)))
256 (setq temp-id (car (rassoc temp-text wisi-punctuation-table)))
257 (when temp-id
258 (setq token-id temp-id
259 next-point (point)))
260 (if (or
261 (eobp)
262 (= (- (point) start) wisi-punctuation-table-max-length))
263 (setq done t)
264 (forward-char 1))
265 )
266 (goto-char next-point)))
267
268 ((memq syntax '(4 5)) ;; open, close parenthesis
269 (forward-char 1)
270 (setq token-text (buffer-substring-no-properties start (point)))
271 (setq token-id (symbol-value (intern-soft token-text wisi-keyword-table))))
272
273 ((eq syntax 7)
274 ;; string quote, either single or double. we assume point is
275 ;; before the start quote, not the end quote
276 (let ((delim (char-after (point)))
277 (forward-sexp-function nil))
278 (condition-case err
279 (progn
280 (forward-sexp)
281
282 ;; point is now after the end quote; check for an escaped quote
283 (while (or
284 (and wisi-string-quote-escape-doubled
285 (eq (char-after (point)) delim))
286 (and (eq delim (car wisi-string-quote-escape))
287 (eq (char-before (1- (point))) (cdr wisi-string-quote-escape))))
288 (forward-sexp))
289 (setq token-id (if (= delim ?\") wisi-string-double-term wisi-string-single-term)))
290 (scan-error
291 ;; Something screwed up; we should not get here if
292 ;; syntax-propertize works properly.
293 (signal 'wisi-parse-error (format "wisi-forward-token: forward-sexp failed %s" err))
294 ))))
295
296 (t ;; assuming word or symbol syntax; includes numbers
297 (skip-syntax-forward "w_'")
298 (setq token-text (buffer-substring-no-properties start (point)))
299 (setq token-id
300 (or (symbol-value (intern-soft (downcase token-text) wisi-keyword-table))
301 (and (functionp wisi-number-p)
302 (funcall wisi-number-p token-text)
303 (setq token-text (buffer-substring-no-properties start (point)))
304 wisi-number-term)
305 wisi-symbol-term))
306 )
307 );; cond
308
309 (unless token-id
310 (signal 'wisi-parse-error
311 (wisi-error-msg "unrecognized token '%s'" (buffer-substring-no-properties start (point)))))
312
313 (cons token-id (cons start (point)))
314 ))
315
316 (defun wisi-backward-token ()
317 "Move point backward across one token, skipping whitespace and comments.
318 Does _not_ handle numbers with wisi-number-p; just sees lower-level syntax.
319 Return (nil start . end) - same structure as
320 wisi-forward-token, but does not look up symbol."
321 (forward-comment (- (point)))
322 ;; skips leading whitespace, comment, trailing whitespace.
323
324 ;; (info "(elisp)Syntax Table Internals" "*info elisp syntax*")
325 (let ((end (point))
326 (syntax (syntax-class (syntax-after (1- (point))))))
327 (cond
328 ((bobp) nil)
329
330 ((eq syntax 1)
331 ;; punctuation. Find the longest matching string in wisi-punctuation-table
332 (backward-char 1)
333 (let ((next-point (point))
334 temp-text done)
335 (while (not done)
336 (setq temp-text (buffer-substring-no-properties (point) end))
337 (when (car (rassoc temp-text wisi-punctuation-table))
338 (setq next-point (point)))
339 (if (or
340 (bobp)
341 (= (- end (point)) wisi-punctuation-table-max-length))
342 (setq done t)
343 (backward-char 1))
344 )
345 (goto-char next-point))
346 )
347
348 ((memq syntax '(4 5)) ;; open, close parenthesis
349 (backward-char 1))
350
351 ((eq syntax 7)
352 ;; a string quote. we assume we are after the end quote, not the start quote
353 (let ((forward-sexp-function nil))
354 (forward-sexp -1)))
355
356 (t ;; assuming word or symbol syntax
357 (if (zerop (skip-syntax-backward "."))
358 (skip-syntax-backward "w_'")))
359 )
360 (cons nil (cons (point) end))
361 ))
362
363 ;;;; token info cache
364 ;;
365 ;; the cache stores the results of parsing as text properties on
366 ;; keywords, for use by the indention and motion engines.
367
368 (cl-defstruct
369 (wisi-cache
370 (:constructor wisi-cache-create)
371 (:copier nil))
372 nonterm;; nonterminal from parse (set by wisi-statement-action)
373
374 token
375 ;; terminal symbol from wisi-keyword-table or
376 ;; wisi-punctuation-table, or lower-level nonterminal from parse
377 ;; (set by wisi-statement-action)
378
379 last ;; pos of last char in token, relative to first (0 indexed)
380
381 class
382 ;; arbitrary lisp symbol, used for indentation and navigation.
383 ;; some classes are defined by wisi:
384 ;;
385 ;; 'block-middle - a block keyword (ie: if then else end), not at the start of a statement
386 ;;
387 ;; 'block-start - a block keyword at the start of a statement
388 ;;
389 ;; 'statement-start - the start of a statement
390 ;;
391 ;; 'open-paren
392 ;;
393 ;; others are language-specific
394
395 containing
396 ;; Marker at the containing keyword for this token.
397 ;; A containing keyword is an indent point; the start of a
398 ;; statement, or 'begin', 'then' or 'else' for a block of
399 ;; statements, etc.
400 ;; nil only for first token in buffer
401
402 prev ;; marker at previous motion token in statement; nil if none
403 next ;; marker at next motion token in statement; nil if none
404 end ;; marker at token at end of current statement
405 )
406
407 (defvar-local wisi-parse-table nil)
408
409 (defvar-local wisi-parse-failed nil
410 "Non-nil when a recent parse has failed - cleared when parse succeeds.")
411
412 (defvar-local wisi-parse-try nil
413 "Non-nil when parse is needed - cleared when parse succeeds.")
414
415 (defvar-local wisi-change-need-invalidate nil
416 "When non-nil, buffer position to invalidate from.
417 Used in before/after change functions.")
418
419 (defvar-local wisi-end-caches nil
420 "List of buffer positions of caches in current statement that need wisi-cache-end set.")
421
422 (defun wisi-delete-cache (after)
423 (with-silent-modifications
424 (remove-text-properties after (point-max) '(wisi-cache nil))
425 ;; We don't remove 'font-lock-face; that's annoying to the user,
426 ;; since they won't be restored until a parse for some other
427 ;; reason, and they are likely to be right anyway.
428 ))
429
430 (defun wisi-invalidate-cache(&optional after)
431 "Invalidate parsing caches for the current buffer from AFTER to end of buffer."
432 (interactive)
433 (if (not after)
434 (setq after (point-min))
435 (setq after
436 (save-excursion
437 (goto-char after)
438 (line-beginning-position))))
439 (when (> wisi-debug 0) (message "wisi-invalidate %s:%d" (current-buffer) after))
440 (setq wisi-cache-max after)
441 (setq wisi-parse-try t)
442 (syntax-ppss-flush-cache after)
443 (wisi-delete-cache after)
444 )
445
446 ;; To see the effects of wisi-before-change, wisi-after-change, you need:
447 ;; (global-font-lock-mode 0)
448 ;; (setq jit-lock-functions nil)
449 ;;
450 ;; otherwise jit-lock runs and overrides them
451
452 (defun wisi-before-change (begin end)
453 "For `before-change-functions'."
454 ;; begin . end is range of text being deleted
455
456 ;; If jit-lock-after-change is before wisi-after-change in
457 ;; after-change-functions, it might use any invalid caches in the
458 ;; inserted text.
459 ;;
460 ;; So we check for that here, and ensure it is after
461 ;; wisi-after-change, which deletes the invalid caches
462 (when (boundp 'jit-lock-mode)
463 (when (memq 'wisi-after-change (memq 'jit-lock-after-change after-change-functions))
464 (setq after-change-functions (delete 'wisi-after-change after-change-functions))
465 (add-hook 'after-change-functions 'wisi-after-change nil t))
466 )
467
468 (setq wisi-change-need-invalidate nil)
469
470 (when (> end begin)
471 (save-excursion
472 ;; (info "(elisp)Parser State")
473 (let* ((begin-state (syntax-ppss begin))
474 (end-state (syntax-ppss end))
475 ;; syntax-ppss has moved point to "end".
476 (word-end (progn (skip-syntax-forward "w_")(point))))
477
478 ;; Remove grammar face from word(s) containing change region;
479 ;; might be changing to/from a keyword. See
480 ;; test/ada_mode-interactive_common.adb Obj_1
481 (goto-char begin)
482 (skip-syntax-backward "w_")
483 (with-silent-modifications
484 (remove-text-properties (point) word-end '(font-lock-face nil fontified nil)))
485
486 (if (<= wisi-cache-max begin)
487 ;; Change is in unvalidated region; either the parse was
488 ;; failing, or there is more than one top-level grammar
489 ;; symbol in buffer.
490 (when wisi-parse-failed
491 ;; The parse was failing, probably due to bad syntax; this
492 ;; change may have fixed it, so try reparse.
493 (setq wisi-parse-try t))
494
495 ;; else change is in validated region
496 ;;
497 ;; don't invalidate parse for whitespace, string, or comment changes
498 (cond
499 ((and
500 (nth 3 begin-state); in string
501 (nth 3 end-state)))
502 ;; no easy way to tell if there is intervening non-string
503
504 ((and
505 (nth 4 begin-state); in comment
506 (nth 4 end-state))
507 ;; too hard to detect case where there is intervening
508 ;; code; no easy way to go to end of comment if not
509 ;; newline
510 )
511
512 ;; Deleting whitespace generally does not require parse, but
513 ;; deleting all whitespace between two words does; check that
514 ;; there is whitespace on at least one side of the deleted
515 ;; text.
516 ;;
517 ;; We are not in a comment (checked above), so treat
518 ;; comment end as whitespace in case it is newline, except
519 ;; deleting a comment end at begin means commenting the
520 ;; current line; requires parse.
521 ((and
522 (eq (car (syntax-after begin)) 0) ; whitespace
523 (memq (car (syntax-after (1- end))) '(0 12)) ; whitespace, comment end
524 (or
525 (memq (car (syntax-after (1- begin))) '(0 12))
526 (memq (car (syntax-after end)) '(0 12)))
527 (progn
528 (goto-char begin)
529 (skip-syntax-forward " >" end)
530 (eq (point) end))))
531
532 (t
533 (setq wisi-change-need-invalidate
534 (progn
535 (goto-char begin)
536 ;; note that because of the checks above, this never
537 ;; triggers a parse, so it's fast
538 (wisi-goto-statement-start)
539 (point))))
540 )))
541 ))
542 )
543
544 (defun wisi-after-change (begin end length)
545 "For `after-change-functions'."
546 ;; begin . end is range of text being inserted (empty if equal);
547 ;; length is the size of the deleted text.
548
549 ;; (syntax-ppss-flush-cache begin) is in before-change-functions
550
551 (syntax-propertize end) ;; see comments above on "lexer" re syntax-propertize
552
553 ;; Remove caches on inserted text, which could have caches from
554 ;; before the failed parse (or another buffer), and are in any case
555 ;; invalid. No point in removing 'fontified; that's handled by
556 ;; jit-lock.
557
558 (with-silent-modifications
559 (remove-text-properties begin end '(wisi-cache nil font-lock-face nil)))
560
561 ;; Also remove grammar face from word(s) containing change region;
562 ;; might be changing to/from a keyword. See
563 ;; test/ada_mode-interactive_common.adb Obj_1
564 (save-excursion
565 ;; (info "(elisp)Parser State")
566 (let ((need-invalidate wisi-change-need-invalidate)
567 begin-state end-state word-end)
568 (when (> end begin)
569 (setq begin-state (syntax-ppss begin))
570 (setq end-state (syntax-ppss end))
571 ;; syntax-ppss has moved point to "end".
572
573 ;; extend fontification over new text,
574 (skip-syntax-forward "w_")
575 (setq word-end (point))
576 (goto-char begin)
577 (skip-syntax-backward "w_")
578 (with-silent-modifications
579 (remove-text-properties (point) word-end '(font-lock-face nil fontified nil))))
580
581 (if (<= wisi-cache-max begin)
582 ;; Change is in unvalidated region
583 (when wisi-parse-failed
584 ;; The parse was failing, probably due to bad syntax; this
585 ;; change may have fixed it, so try reparse.
586 (setq wisi-parse-try t))
587
588 ;; Change is in validated region
589 (cond
590 (wisi-change-need-invalidate
591 ;; wisi-before change determined the removed text alters the
592 ;; parse
593 )
594
595 ((= end begin)
596 (setq need-invalidate nil))
597
598 ((and
599 (nth 3 begin-state); in string
600 (nth 3 end-state))
601 ;; no easy way to tell if there is intervening non-string
602 (setq need-invalidate nil))
603
604 ((and
605 (nth 4 begin-state)
606 (nth 4 end-state)); in comment
607 ;; no easy way to detect intervening code
608 (setq need-invalidate nil)
609 ;; no caches to remove
610 )
611
612 ;; Adding whitespace generally does not require parse, but in
613 ;; the middle of word it does; check that there was
614 ;; whitespace on at least one side of the inserted text.
615 ;;
616 ;; We are not in a comment (checked above), so treat
617 ;; comment end as whitespace in case it is newline
618 ((and
619 (or
620 (memq (car (syntax-after (1- begin))) '(0 12)); whitespace, comment end
621 (memq (car (syntax-after end)) '(0 12)))
622 (progn
623 (goto-char begin)
624 (skip-syntax-forward " >" end)
625 (eq (point) end)))
626 (setq need-invalidate nil))
627
628 (t
629 (setq need-invalidate
630 (progn
631 (goto-char begin)
632 ;; note that because of the checks above, this never
633 ;; triggers a parse, so it's fast
634 (wisi-goto-statement-start)
635 (point))))
636 )
637
638 (if need-invalidate
639 (wisi-invalidate-cache need-invalidate)
640
641 ;; else move cache-max by the net change length.
642 (setq wisi-cache-max
643 (+ wisi-cache-max (- end begin length))) )
644 ))
645 ))
646
647 (defun wisi-get-cache (pos)
648 "Return `wisi-cache' struct from the `wisi-cache' text property at POS.
649 If accessing cache at a marker for a token as set by `wisi-cache-tokens', POS must be (1- mark)."
650 (get-text-property pos 'wisi-cache))
651
652 (defvar-local wisi-parse-error-msg nil)
653
654 (defun wisi-goto-error ()
655 "Move point to position in last error message (if any)."
656 (when (and wisi-parse-error-msg
657 (string-match ":\\([0-9]+\\):\\([0-9]+\\):" wisi-parse-error-msg))
658 (let ((line (string-to-number (match-string 1 wisi-parse-error-msg)))
659 (col (string-to-number (match-string 2 wisi-parse-error-msg))))
660 (push-mark)
661 (goto-char (point-min))
662 (forward-line (1- line))
663 (forward-char col))))
664
665 (defun wisi-show-parse-error ()
666 "Show last wisi-parse error."
667 (interactive)
668 (cond
669 (wisi-parse-failed
670 (wisi-goto-error)
671 (message wisi-parse-error-msg))
672
673 (wisi-parse-try
674 (message "need parse"))
675
676 (t
677 (message "parse succeeded"))
678 ))
679
680 (defvar wisi-post-parse-succeed-hook nil
681 "Hook run after parse succeeds.")
682
683 (defun wisi-validate-cache (pos)
684 "Ensure cached data is valid at least up to POS in current buffer."
685 (let ((msg (when (> wisi-debug 0) (format "wisi: parsing %s:%d ..." (buffer-name) (line-number-at-pos pos)))))
686 ;; If wisi-cache-max = pos, then there is no cache at pos; need parse
687 (when (and wisi-parse-try
688 (<= wisi-cache-max pos))
689 (when (> wisi-debug 0)
690 (message msg))
691
692 ;; Don't keep retrying failed parse until text changes again.
693 (setq wisi-parse-try nil)
694
695 (setq wisi-parse-error-msg nil)
696 (setq wisi-end-caches nil)
697
698 (if (> wisi-debug 1)
699 ;; let debugger stop in wisi-parse
700 (progn
701 (save-excursion
702 (wisi-parse wisi-parse-table 'wisi-forward-token)
703 (setq wisi-cache-max (point))
704 (setq wisi-parse-failed nil))
705 (run-hooks 'wisi-post-parse-succeed-hook))
706
707 ;; else capture errors from bad syntax, so higher level
708 ;; functions can try to continue and/or we don't bother the
709 ;; user.
710 (condition-case err
711 (progn
712 (save-excursion
713 (wisi-parse wisi-parse-table 'wisi-forward-token)
714 (setq wisi-cache-max (point))
715 (setq wisi-parse-failed nil))
716 (run-hooks 'wisi-post-parse-succeed-hook))
717 (wisi-parse-error
718 ;; delete caches past wisi-cache-max added by failed parse
719 (wisi-delete-cache wisi-cache-max)
720 (setq wisi-parse-failed t)
721 (setq wisi-parse-error-msg (cdr err)))
722 ))
723 (if wisi-parse-error-msg
724 ;; error
725 (when (> wisi-debug 0)
726 (message "%s error" msg)
727 (wisi-goto-error)
728 (error wisi-parse-error-msg))
729 ;; no msg; success
730 (when (> wisi-debug 0)
731 (message "%s done" msg)))
732 )))
733
734 (defun wisi-fontify-region (_begin end)
735 "For `jit-lock-functions'."
736 (when (< (point-max) wisi-size-threshold)
737 (wisi-validate-cache end)))
738
739 (defun wisi-get-containing-cache (cache)
740 "Return cache from (wisi-cache-containing CACHE)."
741 (let ((containing (wisi-cache-containing cache)))
742 (and containing
743 (wisi-get-cache (1- containing)))))
744
745 (defun wisi-cache-region (cache)
746 "Return region designated by cache.
747 Point must be at cache."
748 (cons (point) (+ (point) (wisi-cache-last cache))))
749
750 (defun wisi-cache-text (cache)
751 "Return property-less buffer substring designated by cache.
752 Point must be at cache."
753 (buffer-substring-no-properties (point) (+ (point) (wisi-cache-last cache))))
754
755 ;;;; parse actions
756
757 (defun wisi-set-end (start-mark end-mark)
758 "Set END-MARK on all caches in `wisi-end-caches' in range START-MARK END-MARK,
759 delete from `wisi-end-caches'."
760 (let ((i 0)
761 pos cache)
762 (while (< i (length wisi-end-caches))
763 (setq pos (nth i wisi-end-caches))
764 (setq cache (wisi-get-cache pos))
765
766 (if (and (>= pos start-mark)
767 (< pos end-mark))
768 (progn
769 (setf (wisi-cache-end cache) end-mark)
770 (setq wisi-end-caches (delq pos wisi-end-caches)))
771
772 ;; else not in range
773 (setq i (1+ i)))
774 )))
775
776 (defvar wisi-tokens nil)
777 (defvar $nterm nil)
778 ;; keep byte-compiler happy; `wisi-tokens' and `$nterm' are bound in
779 ;; action created by wisi-semantic-action, and in module parser.
780 ;; FIXME: $nterm should have wisi- prefix
781
782 (defun wisi-statement-action (pairs)
783 "Cache information in text properties of tokens.
784 Intended as a grammar non-terminal action.
785
786 PAIRS is a vector of the form [TOKEN-NUMBER CLASS TOKEN-NUMBER
787 CLASS ...] where TOKEN-NUMBER is the (1 indexed) token number in
788 the production, CLASS is the wisi class of that token. Use in a
789 grammar action as:
790 (wisi-statement-action [1 \\='statement-start 7 \\='statement-end])"
791 (save-excursion
792 (let ((first-item t)
793 first-keyword-mark
794 (override-start nil)
795 (i 0))
796 (while (< i (length pairs))
797 (let* ((number (1- (aref pairs i)))
798 (region (cdr (aref wisi-tokens number)));; wisi-tokens is let-bound in wisi-parse-reduce
799 (token (car (aref wisi-tokens number)))
800 (class (aref pairs (setq i (1+ i))))
801 (mark
802 ;; Marker one char into token, so indent-line-to
803 ;; inserts space before the mark, not after
804 (when region (copy-marker (1+ (car region)))))
805 cache)
806
807 (setq i (1+ i))
808
809 (unless (memq class wisi-class-list)
810 (error "%s not in wisi-class-list" class))
811
812 (if region
813 (progn
814 (if (setq cache (wisi-get-cache (car region)))
815 ;; We are processing a previously set non-terminal; ie generic_formal_part in
816 ;;
817 ;; generic_package_declaration : generic_formal_part package_specification SEMICOLON
818 ;; (wisi-statement-action 1 'block-start 2 'block-middle 3 'statement-end)
819 ;;
820 ;; or simple_statement in
821 ;;
822 ;; statement : label_opt simple_statement
823 ;;
824 ;; override nonterm, class, containing
825 ;; set end only if not set yet (due to failed parse)
826 (progn
827 (cl-case (wisi-cache-class cache)
828 (block-start
829 (setf (wisi-cache-class cache)
830 (cond
831 ((eq override-start nil)
832 (cond
833 ((memq class '(block-start statement-start)) 'block-start)
834 (t 'block-middle)))
835
836 ((memq override-start '(block-start statement-start)) 'block-start)
837
838 (t (error "unexpected override-start"))
839 )))
840 (t
841 (setf (wisi-cache-class cache) (or override-start class)))
842 )
843 (setf (wisi-cache-nonterm cache) $nterm)
844 (setf (wisi-cache-containing cache) first-keyword-mark)
845 (unless (wisi-cache-end cache)
846 (if wisi-end-caches
847 (push (car region) wisi-end-caches)
848 (setq wisi-end-caches (list (car region)))
849 ))
850 )
851
852 ;; else create new cache
853 (with-silent-modifications
854 (put-text-property
855 (car region)
856 (1+ (car region))
857 'wisi-cache
858 (wisi-cache-create
859 :nonterm $nterm
860 :token token
861 :last (- (cdr region) (car region))
862 :class (or override-start class)
863 :containing first-keyword-mark)
864 ))
865 (if wisi-end-caches
866 (push (car region) wisi-end-caches)
867 (setq wisi-end-caches (list (car region)))
868 ))
869
870 (when first-item
871 (setq first-item nil)
872 (when (or override-start
873 (memq class '(block-start statement-start)))
874 (setq override-start nil)
875 (setq first-keyword-mark mark)))
876
877 (when (eq class 'statement-end)
878 (wisi-set-end (1- first-keyword-mark) (copy-marker (1+ (car region)))))
879 )
880
881 ;; region is nil when a production is empty; if the first
882 ;; token is a start, override the class on the next token.
883 (when (and first-item
884 (memq class '(block-middle block-start statement-start)))
885 (setq override-start class)))
886 ))
887 )))
888
889 (defun wisi-containing-action (containing-token contained-token)
890 "Set containing marks in all tokens in CONTAINED-TOKEN with null containing mark to marker pointing to CONTAINING-TOKEN.
891 If CONTAINING-TOKEN is empty, the next token number is used."
892 ;; wisi-tokens is is bound in action created by wisi-semantic-action
893 (let* ((containing-region (cdr (aref wisi-tokens (1- containing-token))))
894 (contained-region (cdr (aref wisi-tokens (1- contained-token)))))
895
896 (unless containing-region ;;
897 (signal 'wisi-parse-error
898 (wisi-error-msg
899 "wisi-containing-action: containing-region '%s' is empty. grammar error; bad action"
900 (wisi-token-text (aref wisi-tokens (1- containing-token))))))
901
902 (unless (or (not contained-region) ;; contained-token is empty
903 (wisi-get-cache (car containing-region)))
904 (signal 'wisi-parse-error
905 (wisi-error-msg
906 "wisi-containing-action: containing-token '%s' has no cache. grammar error; missing action"
907 (wisi-token-text (aref wisi-tokens (1- containing-token))))))
908
909 (while (not containing-region)
910 ;; containing-token is empty; use next
911 (setq containing-region (cdr (aref wisi-tokens containing-token))))
912
913 (when contained-region
914 ;; nil when empty production, may not contain any caches
915 (save-excursion
916 (goto-char (cdr contained-region))
917 (let ((cache (wisi-backward-cache))
918 (mark (copy-marker (1+ (car containing-region)))))
919 (while cache
920
921 ;; skip blocks that are already marked
922 (while (and (>= (point) (car contained-region))
923 (markerp (wisi-cache-containing cache)))
924 (goto-char (1- (wisi-cache-containing cache)))
925 (setq cache (wisi-get-cache (point))))
926
927 (if (or (and (= (car containing-region) (car contained-region))
928 (<= (point) (car contained-region)))
929 (< (point) (car contained-region)))
930 ;; done
931 (setq cache nil)
932
933 ;; else set mark, loop
934 (setf (wisi-cache-containing cache) mark)
935 (setq cache (wisi-backward-cache)))
936 ))))))
937
938 (defun wisi-match-class-token (cache class-tokens)
939 "Return t if CACHE matches CLASS-TOKENS.
940 CLASS-TOKENS is a vector [number class token_id class token_id ...].
941 number is ignored."
942 (let ((i 1)
943 (done nil)
944 (result nil)
945 class token)
946 (while (and (not done)
947 (< i (length class-tokens)))
948 (setq class (aref class-tokens i))
949 (setq token (aref class-tokens (setq i (1+ i))))
950 (setq i (1+ i))
951 (when (and (eq class (wisi-cache-class cache))
952 (eq token (wisi-cache-token cache)))
953 (setq result t
954 done t))
955 )
956 result))
957
958 (defun wisi-motion-action (token-numbers)
959 "Set prev/next marks in all tokens given by TOKEN-NUMBERS.
960 TOKEN-NUMBERS is a vector with each element one of:
961
962 number: the token number; mark that token
963
964 vector [number class token_id]:
965 vector [number class token_id class token_id ...]:
966 mark all tokens in number nonterminal matching (class token_id) with nil prev/next."
967 (save-excursion
968 (let (prev-keyword-mark
969 prev-cache
970 cache
971 mark
972 (i 0))
973 (while (< i (length token-numbers))
974 (let ((token-number (aref token-numbers i))
975 region)
976 (setq i (1+ i))
977 (cond
978 ((numberp token-number)
979 (setq region (cdr (aref wisi-tokens (1- token-number))))
980 (when region
981 (setq cache (wisi-get-cache (car region)))
982 (setq mark (copy-marker (1+ (car region))))
983
984 (when (and prev-keyword-mark
985 cache
986 (null (wisi-cache-prev cache)))
987 (setf (wisi-cache-prev cache) prev-keyword-mark)
988 (setf (wisi-cache-next prev-cache) mark))
989
990 (setq prev-keyword-mark mark)
991 (setq prev-cache cache)
992 ))
993
994 ((vectorp token-number)
995 ;; token-number may contain 0, 1, or more 'class token_id' pairs
996 ;; the corresponding region may be empty
997 ;; there must have been a prev keyword
998 (setq region (cdr (aref wisi-tokens (1- (aref token-number 0)))))
999 (when region ;; not an empty token
1000 ;; We must search for all targets at the same time, to
1001 ;; get the motion order right.
1002 (goto-char (car region))
1003 (setq cache (or (wisi-get-cache (point))
1004 (wisi-forward-cache)))
1005 (while (< (point) (cdr region))
1006 (when (wisi-match-class-token cache token-number)
1007 (when (null (wisi-cache-prev cache))
1008 (setf (wisi-cache-prev cache) prev-keyword-mark))
1009 (when (null (wisi-cache-next cache))
1010 (setq mark (copy-marker (1+ (point))))
1011 (setf (wisi-cache-next prev-cache) mark)
1012 (setq prev-keyword-mark mark)
1013 (setq prev-cache cache)))
1014
1015 (setq cache (wisi-forward-cache))
1016 )))
1017
1018 (t
1019 (error "unexpected token-number %s" token-number))
1020 )
1021
1022 ))
1023 )))
1024
1025 (defun wisi-extend-action (first last)
1026 "Extend text of cache at token FIRST to cover all tokens thru LAST."
1027 (let* ((first-region (cdr (aref wisi-tokens (1- first))));; wisi-tokens is let-bound in wisi-parse-reduce
1028 (last-region (cdr (aref wisi-tokens (1- last))))
1029 cache)
1030
1031 (when first-region
1032 (setq cache (wisi-get-cache (car first-region)))
1033 (setf (wisi-cache-last cache) (- (cdr last-region) (car first-region)))
1034 )
1035 ))
1036
1037 (defun wisi-face-action-1 (face region &optional override-no-error)
1038 "Apply FACE to REGION.
1039 If OVERRIDE-NO-ERROR is non-nil, don't report an error for overriding an existing face."
1040 (when region
1041 ;; We allow overriding a face property, because we don't want to
1042 ;; delete them in wisi-invalidate (see comments there). On the
1043 ;; other hand, it can be an error, so keep this debug
1044 ;; code. However, to validly report errors, note that
1045 ;; font-lock-face properties must be removed first, or the buffer
1046 ;; must be fresh (never parsed), and wisi-debug must be > 1.
1047 ;;
1048 ;; Grammar sets override-no-error when a higher-level production might
1049 ;; override a face in a lower-level production.
1050 (when (> wisi-debug 1)
1051 (let ((cur-face (get-text-property (car region) 'font-lock-face)))
1052 (when cur-face
1053 (unless override-no-error
1054 (message "%s:%d overriding face %s with %s on '%s'"
1055 (buffer-file-name)
1056 (line-number-at-pos (car region))
1057 face
1058 cur-face
1059 (buffer-substring-no-properties (car region) (cdr region))))
1060
1061 )))
1062 (with-silent-modifications
1063 (add-text-properties
1064 (car region) (cdr region)
1065 (list
1066 'font-lock-face face
1067 'fontified t)))
1068 ))
1069
1070 (defun wisi-face-action (pairs &optional no-override)
1071 "Cache face information in text properties of tokens.
1072 Intended as a grammar non-terminal action.
1073
1074 PAIRS is a vector of the form [token-number face token-number face ...]
1075 token-number may be an integer, or a vector [integer token_id token_id ...]
1076
1077 For an integer token-number, apply face to the first cached token
1078 in the range covered by wisi-tokens[token-number]. If there are
1079 no cached tokens, apply face to entire wisi-tokens[token-number]
1080 region.
1081
1082 For a vector token-number, apply face to the first cached token
1083 in the range matching one of token_id covered by
1084 wisi-tokens[token-number].
1085
1086 If NO-OVERRIDE is non-nil, don't override existing face."
1087 (let (number region face (tokens nil) cache (i 0) (j 1))
1088 (while (< i (length pairs))
1089 (setq number (aref pairs i))
1090 (setq face (aref pairs (setq i (1+ i))))
1091 (cond
1092 ((integerp number)
1093 (setq region (cdr (aref wisi-tokens (1- number))));; wisi-tokens is let-bound in wisi-parse-reduce
1094 (when region
1095 (save-excursion
1096 (goto-char (car region))
1097 (setq cache (or (wisi-get-cache (point))
1098 (wisi-forward-cache)))
1099 (if (< (point) (cdr region))
1100 (when cache
1101 (wisi-face-action-1 face (wisi-cache-region cache) no-override))
1102
1103 ;; no caches in region; just apply face to region
1104 (wisi-face-action-1 face region no-override))
1105 )))
1106
1107 ((vectorp number)
1108 (setq region (cdr (aref wisi-tokens (1- (aref number 0)))))
1109 (when region
1110 (while (< j (length number))
1111 (setq tokens (cons (aref number j) tokens))
1112 (setq j (1+ j)))
1113 (save-excursion
1114 (goto-char (car region))
1115 (setq cache (wisi-forward-find-token tokens (cdr region) t))
1116 ;; might be looking for IDENTIFIER in name, but only have "*".
1117 (when cache
1118 (wisi-face-action-1 face (wisi-cache-region cache) no-override))
1119 )))
1120 )
1121 (setq i (1+ i))
1122
1123 )))
1124
1125 (defun wisi-face-list-action (pairs &optional no-override)
1126 "Cache face information in text properties of tokens.
1127 Intended as a grammar non-terminal action.
1128
1129 PAIRS is a vector of the form [token-number face token-number face ...]
1130 token-number is an integer. Apply face to all cached tokens
1131 in the range covered by wisi-tokens[token-number].
1132
1133 If NO-OVERRIDE is non-nil, don't override existing face."
1134 (let (number region face cache (i 0))
1135 (while (< i (length pairs))
1136 (setq number (aref pairs i))
1137 (setq face (aref pairs (setq i (1+ i))))
1138 (setq region (cdr (aref wisi-tokens (1- number))));; wisi-tokens is let-bound in wisi-parse-reduce
1139 (when region
1140 (save-excursion
1141 (goto-char (car region))
1142 (setq cache (or (wisi-get-cache (point))
1143 (wisi-forward-cache)))
1144 (while (<= (point) (cdr region))
1145 (when cache
1146 (wisi-face-action-1 face (wisi-cache-region cache) no-override))
1147 (setq cache (wisi-forward-cache))
1148 )))
1149
1150 (setq i (1+ i))
1151
1152 )))
1153
1154 ;;;; motion
1155 (defun wisi-backward-cache ()
1156 "Move point backward to the beginning of the first token preceding point that has a cache.
1157 Returns cache, or nil if at beginning of buffer."
1158 (let (cache pos)
1159 (setq pos (previous-single-property-change (point) 'wisi-cache))
1160 ;; There are three cases:
1161 ;;
1162 ;; 1) caches separated by non-cache chars: 'if ... then'
1163 ;; pos is before 'f', cache is on 'i'
1164 ;;
1165 ;; 2) caches not separated: ');'
1166 ;; pos is before ';', cache is on ';'
1167 ;;
1168 ;; 3) at bob; pos is nil
1169 ;;
1170 (if pos
1171 (progn
1172 (setq cache (get-text-property pos 'wisi-cache))
1173 (if cache
1174 ;; case 2
1175 (goto-char pos)
1176 ;; case 1
1177 (setq cache (get-text-property (1- pos) 'wisi-cache))
1178 (goto-char (1- pos))))
1179 ;; at bob
1180 (goto-char (point-min))
1181 (setq cache nil))
1182 cache
1183 ))
1184
1185 (defun wisi-forward-cache ()
1186 "Move point forward to the beginning of the first token after point that has a cache.
1187 Returns cache, or nil if at end of buffer."
1188 (let (cache pos)
1189 (when (get-text-property (point) 'wisi-cache)
1190 ;; on a cache; get past it
1191 (goto-char (1+ (point))))
1192
1193 (setq cache (get-text-property (point) 'wisi-cache))
1194 (if cache
1195 nil
1196
1197 (setq pos (next-single-property-change (point) 'wisi-cache))
1198 (if pos
1199 (progn
1200 (goto-char pos)
1201 (setq cache (get-text-property pos 'wisi-cache)))
1202 ;; at eob
1203 (goto-char (point-max))
1204 (setq cache nil))
1205 )
1206 cache
1207 ))
1208
1209 (defun wisi-forward-find-class (class limit)
1210 "Search forward for a token that has a cache with CLASS.
1211 Return cache, or nil if at end of buffer.
1212 If LIMIT (a buffer position) is reached, throw an error."
1213 (let ((cache (wisi-forward-cache)))
1214 (while (not (eq class (wisi-cache-class cache)))
1215 (setq cache (wisi-forward-cache))
1216 (when (>= (point) limit)
1217 (error "cache with class %s not found" class)))
1218 cache))
1219
1220 (defun wisi-forward-find-token (token limit &optional noerror)
1221 "Search forward for a token that has a cache with TOKEN.
1222 If point is at a matching token, return that token.
1223 TOKEN may be a list; stop on any cache that has a member of the list.
1224 Return cache, or nil if at end of buffer.
1225 If LIMIT (a buffer position) is reached, then if NOERROR is nil, throw an
1226 error, if non-nil, return nil."
1227 (let ((token-list (cond
1228 ((listp token) token)
1229 (t (list token))))
1230 (cache (wisi-get-cache (point)))
1231 (done nil))
1232 (while (not (or done
1233 (and cache
1234 (memq (wisi-cache-token cache) token-list))))
1235 (setq cache (wisi-forward-cache))
1236 (when (>= (point) limit)
1237 (if noerror
1238 (progn
1239 (setq done t)
1240 (setq cache nil))
1241 (error "cache with token %s not found" token))))
1242 cache))
1243
1244 (defun wisi-forward-find-nonterm (nonterm limit)
1245 "Search forward for a token that has a cache with NONTERM.
1246 NONTERM may be a list; stop on any cache that has a member of the list.
1247 Return cache, or nil if at end of buffer.
1248 If LIMIT (a buffer position) is reached, throw an error."
1249 (let ((nonterm-list (cond
1250 ((listp nonterm) nonterm)
1251 (t (list nonterm))))
1252 (cache (wisi-forward-cache)))
1253 (while (not (memq (wisi-cache-nonterm cache) nonterm-list))
1254 (setq cache (wisi-forward-cache))
1255 (when (>= (point) limit)
1256 (error "cache with nonterm %s not found" nonterm)))
1257 cache))
1258
1259 (defun wisi-goto-cache-next (cache)
1260 (goto-char (1- (wisi-cache-next cache)))
1261 (wisi-get-cache (point))
1262 )
1263
1264 (defun wisi-forward-statement-keyword ()
1265 "If not at a cached token, move forward to next
1266 cache. Otherwise move to cache-next, or next cache if nil.
1267 Return cache found."
1268 (wisi-validate-cache (point-max)) ;; ensure there is a next cache to move to
1269 (let ((cache (wisi-get-cache (point))))
1270 (if cache
1271 (let ((next (wisi-cache-next cache)))
1272 (if next
1273 (goto-char (1- next))
1274 (wisi-forward-token)
1275 (wisi-forward-cache)))
1276 (wisi-forward-cache))
1277 )
1278 (wisi-get-cache (point))
1279 )
1280
1281 (defun wisi-backward-statement-keyword ()
1282 "If not at a cached token, move backward to prev
1283 cache. Otherwise move to cache-prev, or prev cache if nil."
1284 (wisi-validate-cache (point))
1285 (let ((cache (wisi-get-cache (point))))
1286 (if cache
1287 (let ((prev (wisi-cache-prev cache)))
1288 (if prev
1289 (goto-char (1- prev))
1290 (wisi-backward-cache)))
1291 (wisi-backward-cache))
1292 ))
1293
1294 (defun wisi-goto-containing (cache &optional error)
1295 "Move point to containing token for CACHE, return cache at that point.
1296 If ERROR, throw error when CACHE has no container; else return nil."
1297 (cond
1298 ((markerp (wisi-cache-containing cache))
1299 (goto-char (1- (wisi-cache-containing cache)))
1300 (wisi-get-cache (point)))
1301 (t
1302 (when error
1303 (error "already at outermost containing token")))
1304 ))
1305
1306 (defun wisi-goto-containing-paren (cache)
1307 "Move point to just after the open-paren containing CACHE.
1308 Return cache for paren, or nil if no containing paren."
1309 (while (and cache
1310 (not (eq (wisi-cache-class cache) 'open-paren)))
1311 (setq cache (wisi-goto-containing cache)))
1312 (when cache
1313 (forward-char 1))
1314 cache)
1315
1316 (defun wisi-goto-start (cache)
1317 "Move point to containing ancestor of CACHE that has class block-start or statement-start.
1318 Return start cache."
1319 (when
1320 ;; cache nil at bob, or on cache in partially parsed statement
1321 (while (and cache
1322 (not (memq (wisi-cache-class cache) '(block-start statement-start))))
1323 (setq cache (wisi-goto-containing cache)))
1324 )
1325 cache)
1326
1327 (defun wisi-goto-end-1 (cache)
1328 (goto-char (1- (wisi-cache-end cache))))
1329
1330 (defun wisi-goto-statement-start ()
1331 "Move point to token at start of statement point is in or after.
1332 Return start cache."
1333 (interactive)
1334 (wisi-validate-cache (point))
1335 (let ((cache (wisi-get-cache (point))))
1336 (unless cache
1337 (setq cache (wisi-backward-cache)))
1338 (wisi-goto-start cache)))
1339
1340 (defun wisi-goto-statement-end ()
1341 "Move point to token at end of statement point is in or before."
1342 (interactive)
1343 (wisi-validate-cache (point))
1344 (let ((cache (or (wisi-get-cache (point))
1345 (wisi-forward-cache))))
1346 (when (wisi-cache-end cache)
1347 ;; nil when cache is statement-end
1348 (wisi-goto-end-1 cache))
1349 ))
1350
1351 (defun wisi-next-statement-cache (cache)
1352 "Move point to CACHE-next, return cache; error if nil."
1353 (when (not (markerp (wisi-cache-next cache)))
1354 (error "no next statement cache"))
1355 (goto-char (1- (wisi-cache-next cache)))
1356 (wisi-get-cache (point)))
1357
1358 (defun wisi-prev-statement-cache (cache)
1359 "Move point to CACHE-next, return cache; error if nil."
1360 (when (not (markerp (wisi-cache-prev cache)))
1361 (error "no prev statement cache"))
1362 (goto-char (1- (wisi-cache-prev cache)))
1363 (wisi-get-cache (point)))
1364
1365 ;;;; indentation
1366
1367 (defun wisi-comment-indent ()
1368 "For `comment-indent-function'. Indent single line comment to
1369 the comment on the previous line."
1370 (or
1371 (save-excursion
1372 (forward-comment -1)
1373 (when (looking-at comment-start)
1374 ;; There is a preceding comment line.
1375 (current-column)))
1376
1377 ;; Probably called from `comment-indent'; either to insert a new
1378 ;; comment, or to indent the first line of an existing one. In
1379 ;; either case, the comment may be after code on the same line.
1380 (save-excursion
1381 (let ((start-col (current-column)))
1382 (back-to-indentation)
1383 (if (looking-at comment-start)
1384 ;; An existing comment alone on a line. Return nil, so
1385 ;; `comment-indent' will call `indent-according-to-mode'
1386 nil
1387
1388 ;; A comment after code on the same line; point was at the
1389 ;; comment start, so assume it is already correct.
1390 start-col)))
1391 ))
1392
1393 (defun wisi-indent-current (offset)
1394 "Return indentation OFFSET relative to indentation of current line."
1395 (+ (current-indentation) offset)
1396 )
1397
1398 (defun wisi-indent-paren (offset)
1399 "Return indentation OFFSET relative to preceding open paren."
1400 (save-excursion
1401 (goto-char (nth 1 (syntax-ppss)))
1402 (+ (current-column) offset)))
1403
1404 (defun wisi-indent-start (offset cache)
1405 "Return indentation of OFFSET relative to containing ancestor
1406 of CACHE with class statement-start or block-start."
1407 (wisi-goto-start cache)
1408 (+ (current-indentation) offset))
1409
1410 (defun wisi-indent-statement ()
1411 "Indent region given by `wisi-goto-start' on cache at or before point, then wisi-cache-end."
1412 (wisi-validate-cache (point))
1413
1414 (save-excursion
1415 (let ((cache (or (wisi-get-cache (point))
1416 (wisi-backward-cache))))
1417 (when cache
1418 ;; can be nil if in header comment
1419 (let ((start (progn (wisi-goto-start cache) (point)))
1420 (end (progn
1421 (when (wisi-cache-end cache)
1422 ;; nil when cache is statement-end
1423 (goto-char (1- (wisi-cache-end cache))))
1424 (point))))
1425 (indent-region start end)
1426 ))
1427 )))
1428
1429 (defvar-local wisi-indent-calculate-functions nil
1430 "Functions to calculate indentation. Each called with point
1431 before a token at the beginning of a line (at current
1432 indentation); return indentation column for that token, or
1433 nil. May move point. Calling stops when first function returns
1434 non-nil.")
1435
1436 (defvar-local wisi-post-parse-fail-hook
1437 "Function to reindent portion of buffer.
1438 Called from `wisi-indent-line' when a parse succeeds after
1439 failing; assumes user was editing code that is now syntactically
1440 correct. Must leave point at indentation of current line.")
1441
1442 (defvar-local wisi-indent-failed nil
1443 "Non-nil when wisi-indent-line fails due to parse failing; cleared when indent succeeds.")
1444
1445 (defun wisi-indent-line ()
1446 "Indent current line using the wisi indentation engine."
1447 (interactive)
1448
1449 (let ((savep (point))
1450 indent)
1451 (save-excursion
1452 (back-to-indentation)
1453 (when (>= (point) savep) (setq savep nil))
1454
1455 (when (>= (point) wisi-cache-max)
1456 (wisi-validate-cache (line-end-position))) ;; include at lease the first token on this line
1457
1458 (if (> (point) wisi-cache-max)
1459 ;; parse failed
1460 (progn
1461 ;; no indent info at point. Assume user is
1462 ;; editing; indent to previous line, fix it
1463 ;; after parse succeeds
1464 (setq wisi-indent-failed t)
1465 (forward-line -1);; safe at bob
1466 (back-to-indentation)
1467 (setq indent (current-column)))
1468
1469 ;; parse succeeded
1470 (when wisi-indent-failed
1471 ;; previous parse failed
1472 (setq wisi-indent-failed nil)
1473 (run-hooks 'wisi-post-parse-fail-hook))
1474
1475 (when (> (point) wisi-cache-max)
1476 (error "wisi-post-parse-fail-hook invalidated parse."))
1477
1478 (setq indent
1479 (with-demoted-errors
1480 (or (run-hook-with-args-until-success 'wisi-indent-calculate-functions) 0))
1481 )
1482 ))
1483
1484 (if savep
1485 ;; point was inside line text; leave it there
1486 (save-excursion (indent-line-to indent))
1487 ;; point was before line text; move to start of text
1488 (indent-line-to indent))
1489 ))
1490
1491 ;;;; debug
1492 (defun wisi-parse-buffer ()
1493 (interactive)
1494 (syntax-propertize (point-max))
1495 (wisi-invalidate-cache)
1496 (wisi-validate-cache (point-max)))
1497
1498 (defun wisi-lex-buffer ()
1499 (interactive)
1500 (syntax-propertize (point-max))
1501 (goto-char (point-min))
1502 (while (not (eq wisent-eoi-term (car (wisi-forward-token)))))
1503 )
1504
1505 (defun wisi-show-cache ()
1506 "Show cache at point."
1507 (interactive)
1508 (message "%s" (wisi-get-cache (point))))
1509
1510 (defun wisi-show-token ()
1511 "Move forward across one keyword, show token_id."
1512 (interactive)
1513 (let ((token (wisi-forward-token)))
1514 (message "%s" (car token))))
1515
1516 (defun wisi-show-containing-or-previous-cache ()
1517 (interactive)
1518 (let ((cache (wisi-get-cache (point))))
1519 (if cache
1520 (message "containing %s" (wisi-goto-containing cache t))
1521 (message "previous %s" (wisi-backward-cache)))
1522 ))
1523
1524 (defun wisi-show-cache-max ()
1525 (interactive)
1526 (push-mark)
1527 (goto-char wisi-cache-max))
1528
1529 ;;;;; setup
1530
1531 (defun wisi-setup (indent-calculate post-parse-fail class-list keyword-table token-table parse-table)
1532 "Set up a buffer for parsing files with wisi."
1533 (setq wisi-class-list class-list)
1534 (setq wisi-string-double-term (car (symbol-value (intern-soft "string-double" token-table))))
1535 (setq wisi-string-single-term (car (symbol-value (intern-soft "string-single" token-table))))
1536 (setq wisi-symbol-term (car (symbol-value (intern-soft "symbol" token-table))))
1537
1538 (let ((numbers (cadr (symbol-value (intern-soft "number" token-table)))))
1539 (setq wisi-number-term (car numbers))
1540 (setq wisi-number-p (cdr numbers)))
1541
1542 (setq wisi-punctuation-table (symbol-value (intern-soft "punctuation" token-table)))
1543 (setq wisi-punctuation-table-max-length 0)
1544 (let (fail)
1545 (dolist (item wisi-punctuation-table)
1546 (when item ;; default matcher can be nil
1547
1548 ;; check that all chars used in punctuation tokens have punctuation syntax
1549 (mapc (lambda (char)
1550 (when (not (= ?. (char-syntax char)))
1551 (setq fail t)
1552 (message "in %s, %c does not have punctuation syntax"
1553 (car item) char)))
1554 (cdr item))
1555
1556 (when (< wisi-punctuation-table-max-length (length (cdr item)))
1557 (setq wisi-punctuation-table-max-length (length (cdr item)))))
1558 )
1559 (when fail
1560 (error "aborting due to punctuation errors")))
1561
1562 (setq wisi-keyword-table keyword-table)
1563 (setq wisi-parse-table parse-table)
1564
1565 (setq wisi-indent-calculate-functions indent-calculate)
1566 (set (make-local-variable 'indent-line-function) 'wisi-indent-line)
1567
1568 (setq wisi-post-parse-fail-hook post-parse-fail)
1569 (setq wisi-indent-failed nil)
1570
1571 (add-hook 'before-change-functions 'wisi-before-change nil t)
1572 (add-hook 'after-change-functions 'wisi-after-change nil t)
1573
1574 (when (functionp 'jit-lock-register)
1575 (jit-lock-register 'wisi-fontify-region))
1576
1577 ;; see comments on "lexer" above re syntax-propertize
1578 (syntax-propertize (point-max))
1579
1580 (wisi-invalidate-cache)
1581 )
1582
1583 (provide 'wisi)
1584 ;;; wisi.el ends here