X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/0771ac6f5eeaad1965fe7759aeb9a6544eab2adb..f10533854f4c7bb54247a11981191bf37b70cb36:/packages/wisi/wisi.el diff --git a/packages/wisi/wisi.el b/packages/wisi/wisi.el index a748f6268..bb49f655e 100644 --- a/packages/wisi/wisi.el +++ b/packages/wisi/wisi.el @@ -1,13 +1,13 @@ ;;; wisi.el --- Utilities for implementing an indentation/navigation engine using a generalized LALR parser -*- lexical-binding:t -*- ;; -;; Copyright (C) 2012 - 2015 Free Software Foundation, Inc. +;; Copyright (C) 2012 - 2016 Free Software Foundation, Inc. ;; ;; Author: Stephen Leake ;; Maintainer: Stephen Leake ;; Keywords: parser ;; indentation ;; navigation -;; Version: 1.1.1 +;; Version: 1.1.2 ;; package-requires: ((cl-lib "0.4") (emacs "24.2")) ;; URL: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html ;; @@ -158,6 +158,7 @@ ;; 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. +;; FIXME: no longer needed in Emacs 25? (email from Stefan Monnier) ;; ;;;; code style ;; @@ -196,7 +197,7 @@ (defvar-local wisi-string-quote-escape-doubled nil "Non-nil if a string delimiter is escaped by doubling it (as in Ada).") (defvar-local wisi-string-quote-escape nil - "Cons '(delim . character) where 'character' escapes quotes in strings delimited by 'delim'.") + "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) @@ -289,10 +290,10 @@ If at end of buffer, returns `wisent-eoi-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) + (signal 'wisi-parse-error (format "wisi-forward-token: forward-sexp failed %s" err)) )))) - (t ;; assuming word or symbol syntax + (t ;; assuming word or symbol syntax; includes numbers (skip-syntax-forward "w_'") (setq token-text (buffer-substring-no-properties start (point))) (setq token-id @@ -442,6 +443,12 @@ Used in before/after change functions.") (wisi-delete-cache after) ) +;; To see the effects of wisi-before-change, wisi-after-change, you need: +;; (global-font-lock-mode 0) +;; (setq jit-lock-functions nil) +;; +;; otherwise jit-lock runs and overrides them + (defun wisi-before-change (begin end) "For `before-change-functions'." ;; begin . end is range of text being deleted @@ -562,6 +569,8 @@ Used in before/after change functions.") (setq begin-state (syntax-ppss begin)) (setq end-state (syntax-ppss end)) ;; syntax-ppss has moved point to "end". + + ;; extend fontification over new text, (skip-syntax-forward "w_") (setq word-end (point)) (goto-char begin) @@ -592,7 +601,7 @@ Used in before/after change functions.") ;; no easy way to tell if there is intervening non-string (setq need-invalidate nil)) - ((or + ((and (nth 4 begin-state) (nth 4 end-state)); in comment ;; no easy way to detect intervening code @@ -644,7 +653,8 @@ If accessing cache at a marker for a token as set by `wisi-cache-tokens', POS mu (defun wisi-goto-error () "Move point to position in last error message (if any)." - (when (string-match ":\\([0-9]+\\):\\([0-9]+\\):" wisi-parse-error-msg) + (when (and wisi-parse-error-msg + (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) @@ -679,7 +689,9 @@ If accessing cache at a marker for a token as set by `wisi-cache-tokens', POS mu (when (> wisi-debug 0) (message msg)) + ;; Don't keep retrying failed parse until text changes again. (setq wisi-parse-try nil) + (setq wisi-parse-error-msg nil) (setq wisi-end-caches nil) @@ -762,8 +774,10 @@ delete from `wisi-end-caches'." ))) (defvar wisi-tokens nil) -;; keep byte-compiler happy; `wisi-tokens' is bound in action created -;; by wisi-semantic-action +(defvar $nterm nil) +;; keep byte-compiler happy; `wisi-tokens' and `$nterm' are bound in +;; action created by wisi-semantic-action, and in module parser. +;; FIXME: $nterm should have wisi- prefix (defun wisi-statement-action (pairs) "Cache information in text properties of tokens. @@ -773,7 +787,7 @@ 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])" + (wisi-statement-action [1 \\='statement-start 7 \\='statement-end])" (save-excursion (let ((first-item t) first-keyword-mark @@ -842,7 +856,7 @@ grammar action as: (1+ (car region)) 'wisi-cache (wisi-cache-create - :nonterm $nterm;; $nterm defined in wisi-semantic-action + :nonterm $nterm :token token :last (- (cdr region) (car region)) :class (or override-start class) @@ -856,8 +870,7 @@ grammar action as: (when first-item (setq first-item nil) (when (or override-start - ;; FIXME: why block-middle here? - (memq class '(block-middle block-start statement-start))) + (memq class '(block-start statement-start))) (setq override-start nil) (setq first-keyword-mark mark))) @@ -1009,57 +1022,50 @@ vector [number class token_id class 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)) +(defun wisi-extend-action (first last) + "Extend text of cache at token FIRST to cover all tokens thru LAST." + (let* ((first-region (cdr (aref wisi-tokens (1- first))));; wisi-tokens is let-bound in wisi-parse-reduce + (last-region (cdr (aref wisi-tokens (1- last)))) 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) + (when first-region + (setq cache (wisi-get-cache (car first-region))) + (setf (wisi-cache-last cache) (- (cdr last-region) (car first-region))) ) )) -(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." +(defun wisi-face-action-1 (face region &optional override-no-error) + "Apply FACE to REGION. +If OVERRIDE-NO-ERROR is non-nil, don't report an error for overriding an 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). + ;; code. However, to validly report errors, note that + ;; font-lock-face properties must be removed first, or the buffer + ;; must be fresh (never parsed), and wisi-debug must be > 1. ;; - ;; 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'" + ;; Grammar sets override-no-error when a higher-level production might + ;; override a face in a lower-level production. + (when (> wisi-debug 1) + (let ((cur-face (get-text-property (car region) 'font-lock-face))) + (when cur-face + (unless override-no-error + (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)))) - ))) + ))) + (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. @@ -1361,14 +1367,28 @@ Return start cache." (defun wisi-comment-indent () "For `comment-indent-function'. Indent single line comment to the comment on the previous line." - ;; This should only be called by comment-indent-new-line or - ;; fill-comment-paragraph, so there will be a preceding comment line - ;; that we can trust. - (save-excursion - (forward-comment -1) - (if (looking-at comment-start) - (current-column) - (error "wisi-comment-indent called after non-comment")))) + (or + (save-excursion + (forward-comment -1) + (when (looking-at comment-start) + ;; There is a preceding comment line. + (current-column))) + + ;; Probably called from `comment-indent'; either to insert a new + ;; comment, or to indent the first line of an existing one. In + ;; either case, the comment may be after code on the same line. + (save-excursion + (let ((start-col (current-column))) + (back-to-indentation) + (if (looking-at comment-start) + ;; An existing comment alone on a line. Return nil, so + ;; `comment-indent' will call `indent-according-to-mode' + nil + + ;; A comment after code on the same line; point was at the + ;; comment start, so assume it is already correct. + start-col))) + )) (defun wisi-indent-current (offset) "Return indentation OFFSET relative to indentation of current line." @@ -1475,6 +1495,13 @@ correct. Must leave point at indentation of current line.") (wisi-invalidate-cache) (wisi-validate-cache (point-max))) +(defun wisi-lex-buffer () + (interactive) + (syntax-propertize (point-max)) + (goto-char (point-min)) + (while (not (eq wisent-eoi-term (car (wisi-forward-token))))) + ) + (defun wisi-show-cache () "Show cache at point." (interactive)