hugo
/
phpinspect.el
1
1
Fork 0
Code Issues 12 Pull Requests Projects Releases Wiki Activity

Initial (probably) working implementation of incremental parsing

Browse Source
WIP-incremental-parsing
Hugo Thunnissen 10 months ago
parent f3a5e1d658
commit 93f6c702c5
7 changed files with 764 additions and 215 deletions
Show Stats Download Patch File Download Diff File

160
phpinspect-buffer.el
Unescape Escape View File

@ -24,28 +24,13 @@
;;; Code:
(require 'phpinspect-tree)
(require 'phpinspect-edtrack)
(defvar-local phpinspect-current-buffer nil
"An instance of `phpinspect-buffer' local to the active
buffer. This variable is only set for buffers where
`phpinspect-mode' is active. Also see `phpinspect-buffer'.")
(cl-defstruct (phpinspect-token-metadata (:constructor phpinspect-make-token-metadata))
"An object that represents the metadata associated with a parsed token."
(token nil
:type phpinspect-token
:documentation
"The token that metadata is associated with.")
(region nil
:type phpinspect-region
:documentation
"The region that token occupies.")
(tree nil
:type phpinspect-tree)
(handler nil
:type phpinspect-handler
:documentation
"The handler that was used to parse token. (see `phpinspect-defhandler')"))
(cl-defstruct (phpinspect-buffer (:constructor phpinspect-make-buffer))
"An object containing phpinspect related metadata linked to an
@ -57,110 +42,75 @@ emacs buffer."
:type phpinspect-tree
:documentation
"A tree containing metadata associated with tokens.")
(metadata-map (make-hash-table :test 'eq :size 3000 :rehash-size 2.0)
:type hash-table
:documentation
"A map containing metadata associated with tokens.")
(edit-tracker (phpinspect-make-edit-tracker)
:type phpinspect-edit-tracker))
(edit-tracker (phpinspect-make-edtrack)
:type phpinspect-edtrack)
(whitespace nil
:type string
:documentation
"Whitespace parsed before the next token to be parsed"))
(cl-defmethod phpinspect-buffer-register-whitespace
((buffer phpinspect-buffer) (whitespace string))
(setf (phpinspect-buffer-whitespace buffer) whitespace))
(cl-defmethod phpinspect-buffer-parse ((buffer phpinspect-buffer))
"Parse the PHP code in the the emacs buffer that this object is
linked with."
(with-current-buffer (phpinspect-buffer-buffer buffer)
(let ((tree (phpinspect-make-tree :start (point-min)
:end (point-max))))
(setf (phpinspect-buffer-tree buffer) tree)
(setf (phpinspect-buffer-metadata-map buffer)
(make-hash-table :test 'eq :size 3000 :rehash-size 1.5))
(let ((parsed (phpinspect-parse-current-buffer)))
;; Set tree root to the child containing the root parsed token.
(setq tree (seq-elt (phpinspect-tree-children tree) 0))
(setf (phpinspect-tree-parent tree) nil)
(setf (phpinspect-buffer-tree buffer) tree)
;; return
parsed))))
;; (cl-defmethod phpinspect-buffer-parse-incrementally ((buffer phpinspect-buffer) &optional edits)
;; (let* ((edits (or edits (phpinspect-edit-tracker-edits
;; (phpinspect-buffer-edit-tracker buffer))))
;; (edit (phpinspect-queue-dequeue edits)))
(let* ((tree (phpinspect-make-tree :start (point-min)
:end (+ 1 (point-max))))
(buffer-tree (phpinspect-buffer-tree buffer))
(ctx (phpinspect-make-pctx
:tree tree
:incremental t
:previous-tree (unless (phpinspect-tree-empty-p buffer-tree) buffer-tree)
:edtrack (phpinspect-buffer-edit-tracker buffer))))
(phpinspect-with-parse-context ctx
(let ((parsed (phpinspect-parse-current-buffer)))
;; Set tree root to the child containing the root parsed token.
(setq tree (seq-elt (phpinspect-tree-children tree) 0))
(setf (phpinspect-tree-parent tree) nil)
(setf (phpinspect-buffer-tree buffer) tree)
(setf (phpinspect-edtrack-edits (phpinspect-buffer-edit-tracker buffer))
(phpinspect-make-ll))
;; return
parsed)))))
(cl-defmethod phpinspect-buffer-register-edit
((buffer phpinspect-buffer) (start integer) (end integer) (pre-change-length integer))
(let ((contents (buffer-substring start end)))
(phpinspect-edit-tracker-register
(phpinspect-buffer-edit-tracker buffer) start end pre-change-length contents)))
(cl-defmethod phpinspect-buffer-queue-full-parse ((buffer phpinspect-buffer))
(phpinspect--log "Attempted to queue full parse"))
(defmacro phpinspect-buffer-with-tree (buffer tree &rest body)
(declare (indent 2))
(let ((tree-store-sym (gensym)))
`(unwind-protect
(let ((,tree-store-sym (phpinspect-buffer-tree ,buffer)))
(setf (phpinspect-buffer-tree ,buffer ,tree))
,@body)
(setf (phpinspect-buffer-tree buffer) ,tree-store-sym))))
(cl-defmethod phpinspect-buffer-set-token-metadata
((buffer phpinspect-buffer) token (metadata phpinspect-token-metadata))
"Set the METADATA associated with TOKEN that was parsed in BUFFER"
(setf (phpinspect-token-metadata-token metadata) token)
(let ((metadata-existing (gethash token (phpinspect-buffer-metadata-map buffer))))
(if metadata-existing
(setf (gv-deref metadata-existing) metadata)
(progn
(setq metadata-ref (gv-ref metadata))
(puthash token metadata-ref (phpinspect-buffer-metadata-map buffer))
(let* ((region (phpinspect-token-metadata-region metadata))
(tree-node
(phpinspect-tree-insert (phpinspect-buffer-tree buffer)
(phpinspect-region-start region)
(phpinspect-region-end region)
metadata)))
(setf (phpinspect-token-metadata-tree metadata) tree-node))))))
(let* ((edit
(phpinspect-edtrack-register-edit
(phpinspect-buffer-edit-tracker buffer) start end pre-change-length))
(region (phpinspect-make-region (phpinspect-edit-original-start edit)
(phpinspect-edit-original-end edit)))
(tainted (phpinspect-tree-traverse-overlapping
(phpinspect-buffer-tree buffer) region)))
(dolist (meta tainted)
(phpinspect-tree-traverse (node (phpinspect-meta-tree meta))
(when (phpinspect-tree-overlaps node region)
(setf (phpinspect-meta-tainted (phpinspect-tree-value node)) t))))))
(cl-defmethod phpinspect-buffer--register-token
((buffer phpinspect-buffer) token start end handler)
(let* ((meta (phpinspect-make-meta
:token token
:handler handler
:whitespace-before (phpinspect-buffer-whitespace buffer)))
(node (phpinspect-tree-insert
(phpinspect-buffer-tree buffer) start end meta)))
(setf (phpinspect-meta-tree meta) node)
(setf (phpinspect-buffer-whitespace buffer) "")))
(cl-defmethod phpinspect-buffer-get-token-metadata ((buffer phpinspect-buffer) token)
(let ((ref (gethash token (phpinspect-buffer-metadata-map buffer))))
(when ref (gv-deref ref))))
nil)
(cl-defmethod phpinspect-buffer-token-location ((buffer phpinspect-buffer) token)
(phpinspect-token-metadata-region (phpinspect-buffer-get-token-metadata buffer token)))
(cl-defmethod phpinspect-buffer-tokens-enclosing-point ((buffer phpinspect-buffer) point)
(mapcar #'phpinspect-token-metadata-token
(phpinspect-tree-traverse-overlappig (phpinspect-buffer-tree buffer) point)))
(cl-defstruct (phpinspect-edit-tracker (:constructor phpinspect-make-edit-tracker))
(edits (phpinspect-make-queue)))
(cl-defstruct (phpinspect-edit (:constructor phpinspect-make-edit))
(contents ""
:type string
:documentation "The contents of the edit")
(region nil
:type phpinspect-region
:documentation
"The region in which the edit took place")
(delta 0
:type integer
:documentation
"The change in width of the edit region"))
(cl-defmethod phpinspect-edit-tracker-register
((tracker phpinspect-edit-tracker) (start integer) (end integer)
(pre-change-length integer) (contents string))
(phpinspect-queue-enqueue
(phpinspect-edit-tracker-edits tracker)
(phpinspect-make-edit :region (phpinspect-make-region start end)
:delta (- (- end start) pre-change-length)
:contents contents)))
(phpinspect-tree-traverse-overlapping (phpinspect-buffer-tree buffer) point))
(provide 'phpinspect-buffer)

224
phpinspect-edtrack.el
Unescape Escape View File

@ -0,0 +1,224 @@
(cl-defstruct (phpinspect-edtrack (:constructor phpinspect-make-edtrack))
(edits (phpinspect-make-ll)
:documentation "Sorted list of edits in buffer"))
(cl-defstruct (phpinspect-edit (:constructor phpinspect-make-edit))
(list nil
:type phpinspect-llnode)
(original-start 0
:type integer)
(local-delta 0
:type integer)
(length 0))
;; (cl-defmethod phpinspect-edtrack-edit-in-original-region
;; ((tracker phpinspect-edtrack) (start integer) (end integer))
;; (condition-case found
;; (seq-doseq (edit (phpinspect-edtrack-edits tracker))
;; (when (phpinspect-edit-overlaps-original edit start end)
;; (throw edit
;; (first-overlapper (seq-find overlap-test edits))
;; (overlappers (when first-overlapper
;; (seq-take-while overlap-test
;; (phpinspect-ll-link edits first-overlapper)))))
;; (when overlappers
;; (phpinspect-edit-merge edit ,@overlappers)
;; (let (
;; (phpinspect-slice-detach
(defsubst phpinspect-edit-link (edit)
(phpinspect-ll-link (phpinspect-edit-list edit) edit))
(defsubst phpinspect-edit--left-delta (edit)
(let ((left (phpinspect-llnode-left (phpinspect-edit-link edit))))
(if left (phpinspect-edit-delta (phpinspect-llnode-value left)) 0)))
(cl-defmethod phpinspect-edit-start ((edit phpinspect-edit))
(+ (phpinspect-edit-original-start edit) (phpinspect-edit--left-delta edit)))
(cl-defmethod phpinspect-edit-delta ((edit phpinspect-edit))
(+ (phpinspect-edit--left-delta edit) (phpinspect-edit-local-delta edit)))
(cl-defmethod phpinspect-edit-end ((edit phpinspect-edit))
(+ (phpinspect-edit-start edit) (phpinspect-edit-length edit)))
(cl-defmethod phpinspect-edit-overlaps-point ((edit phpinspect-edit) (point integer))
(and (> (phpinspect-edit-end edit) point)
(<= (phpinspect-edit-start edit) point)))
(cl-defmethod phpinspect-edit-before-point ((edit phpinspect-edit) (point integer))
(< (phpinspect-edit-end edit) point))
(cl-defmethod phpinspect-edit-before-original-point ((edit phpinspect-edit) (point integer))
(< (phpinspect-edit-original-end edit) point))
(defsubst phpinspect-edit-overlaps (edit start end)
(let ((region (phpinspect-make-region start end)))
(or (phpinspect-edit-overlaps-point edit start)
(phpinspect-edit-overlaps-point edit (- end 1))
(phpinspect-region-overlaps-point region (phpinspect-edit-start edit))
(phpinspect-region-overlaps-point region (- (phpinspect-edit-end edit) 1)))))
(defsubst phpinspect-edit-original-end (edit)
(+ (phpinspect-edit-original-start edit)
(- (phpinspect-edit-length edit) (phpinspect-edit-local-delta edit))))
(cl-defmethod phpinspect-edit-overlaps-original-point (edit point)
(and (> (phpinspect-edit-original-end edit) point)
(<= (phpinspect-edit-original-start edit) point)))
(defsubst phpinspect-edit-overlaps-original (edit start end)
(let ((region (phpinspect-make-region start end)))
(or (phpinspect-edit-overlaps-original-point edit start)
(phpinspect-edit-overlaps-original-point edit (- end 1))
(phpinspect-region-overlaps-point region (phpinspect-edit-original-start edit))
(phpinspect-region-overlaps-point region (- (phpinspect-edit-original-end edit) 1)))))
(cl-defmethod phpinspect-edit-merge ((edit phpinspect-edit) (other phpinspect-edit))
(let* ((start (phpinspect-edit-original-start edit))
(length (phpinspect-edit-length edit))
(delta (phpinspect-edit-local-delta edit))
(start-difference (- (phpinspect-edit-original-start other) start))
(length-delta (- (+ (phpinspect-edit-length other) start-difference) length)))
(when (< start-difference 0)
(setq start (- start start-difference)))
(when (> length-delta 0)
(setq length (+ length length-delta)))
(setq delta (+ delta (phpinspect-edit-local-delta other)))
(setf (phpinspect-edit-local-delta edit) delta)
(setf (phpinspect-edit-original-start edit) start)
(setf (phpinspect-edit-length edit) length)))
(cl-defmethod phpinspect-edtrack-register-edit
((tracker phpinspect-edtrack) (start integer) (end integer) (pre-change-length integer))
(let* ((overlap-test (lambda (edit) (phpinspect-edit-overlaps edit start end)))
(edits (phpinspect-edtrack-edits tracker))
(first-overlap)
(last-overlap)
(edit-before)
(new-edit))
(catch 'break
(seq-doseq (edit edits)
(cond
((phpinspect-edit-overlaps edit start end)
(if first-overlap
(setq last-overlap edit)
(setq first-overlap edit)))
((phpinspect-edit-before-point edit start)
(setq edit-before edit))
(last-overlap
(throw 'break)))))
(if edit-before
(setq new-edit (phpinspect-make-edit
:original-start (- start (phpinspect-edit-delta edit-before))
:local-delta (- (- end start) pre-change-length)
:list edits
:length (- end start)))
(setq new-edit (phpinspect-make-edit
:original-start start
:local-delta (- (- end start) pre-change-length)
:list edits
:length (- end start))))
(if first-overlap
(if last-overlap
(let ((overlappers (phpinspect-slice-detach
(phpinspect-make-slice
:start (phpinspect-edit-link first-overlap)
:end (phpinspect-edit-link last-overlap)))))
(seq-doseq (overlap overlapper)
(phpinspect-edit-merge new-edit overlapper))
(if edit-before
(phpinspect-ll-insert-right (phpinspect-edit-link edit-before) new-edit)
(phpinspect-ll-push new-edit edits)))
(let ((link (phpinspect-edit-link first-overlap)))
(phpinspect-edit-merge new-edit first-overlap)
(phpinspect-ll-relink link new-edit)))
(if edit-before
(phpinspect-ll-insert-right (phpinspect-edit-link edit-before) new-edit)
(phpinspect-ll-push new-edit edits)))
;; Return
new-edit))
(defsubst phpinspect-edtrack--last-edit-before-point (edtrack point)
(let ((found))
(catch 'break
(seq-doseq (edit (phpinspect-edtrack-edits edtrack))
(if (phpinspect-edit-before-point edit point)
(setq found edit)
(when found
(throw 'break nil)))))
found))
(defsubst phpinspect-edtrack--last-edit-before-original-point (edtrack point)
(let ((found))
(catch 'break
(seq-doseq (edit (phpinspect-edtrack-edits edtrack))
(if (phpinspect-edit-before-original-point edit point)
(setq found edit)
(when found
(throw 'break nil)))))
found))
(defsubst phpinspect-point-inside-edit-err-p (err)
(and (listp err)
(eq 'phpinspect-point-inside-edit-err (car err))))
(cl-defmethod phpinspect-edtrack-original-position-at-point
((tracker phpinspect-edtrack) (point integer))
(let ((edit-before (phpinspect-edtrack--last-edit-before-point tracker point)))
(when edit-before
(setq point (- point (phpinspect-edit-delta edit-before)))
(let ((next-edit-link (phpinspect-llnode-right (phpinspect-edit-link edit-before))))
(when (and next-edit-link
(phpinspect-edit-overlaps-original-point
(phpinspect-llnode-value next-edit-link)
point))
(throw 'phpinspect-point-inside-edit
`(phpinspect-point-inside-edit-err
"Point is inside an edited region, cannot accurately determine original location")))))
point))
(cl-defmethod phpinspect-edtrack-current-position-at-point
((tracker phpinspect-edtrack) (point integer))
(let ((edit-before (phpinspect-edtrack--last-edit-before-original-point tracker point)))
(when edit-before
(let ((next-edit-link (phpinspect-llnode-right (phpinspect-edit-link edit-before))))
(when (and next-edit-link
(phpinspect-edit-overlaps-original-point
(phpinspect-llnode-value next-edit-link)
point))
(throw 'phpinspect-point-inside-edit
`(phpinspect-point-inside-edit-err
"Point is inside an edited region, cannot accurately determine current location"))
(setq point (+ point (phpinspect-edit-delta edit-before)))))))
;; Return
point)
(defsubst phpinspect-edit-to-string (edit)
(format "original-start: %d, length: %d, local-delta: %d"
(phpinspect-edit-original-start edit)
(phpinspect-edit-length edit)
(phpinspect-edit-local-delta edit)))
(provide 'phpinspect-edtrack)

282
phpinspect-parser.el
Unescape Escape View File

@ -23,6 +23,9 @@
;;; Code:
(require 'phpinspect-tree)
(require 'phpinspect-edtrack)
(defvar phpinspect-parser-obarray (obarray-make)
"An obarray containing symbols for all phpinspect (sub)parsers.")
@ -50,7 +53,11 @@
(documentation (intern handler-name phpinspect-handler-obarray))))
(pop-to-buffer (current-buffer))))
(defsubst phpinspect--strip-last-char (string)
(defsubst phpinspect--strip-word-end-space (string)
(when phpinspect-current-buffer
(phpinspect-buffer-register-whitespace
phpinspect-current-buffer
(substring string (- (length string) 1) (length string))))
(substring string 0 (- (length string) 1)))
(defsubst phpinspect-munch-token-without-attribs (string token-keyword)
@ -201,8 +208,13 @@ Type can be any of the token types returned by
(or (phpinspect-token-type-p token :array)
(phpinspect-incomplete-array-p token)))
(defsubst phpinspect-incomplete-root-p (token)
(and (phpinspect-root-p token)
(seq-find #'phpinspect-incomplete-token-p (cdr token))))
(defsubst phpinspect-incomplete-token-p (token)
(or (phpinspect-incomplete-class-p token)
(or (phpinspect-incomplete-root-p token)
(phpinspect-incomplete-class-p token)
(phpinspect-incomplete-block-p token)
(phpinspect-incomplete-list-p token)
(phpinspect-incomplete-array-p token)
@ -346,9 +358,14 @@ parser function is then returned in byte-compiled form."
(unless parser-symbol
(error "Phpinspect: No parser found by name %s" name))
(or (symbol-function parser-symbol)
(defalias parser-symbol
(phpinspect-parser-compile (symbol-value parser-symbol))))))
(if (and phpinspect-parse-context
(phpinspect-pctx-incremental phpinspect-parse-context))
(let ((func (phpinspect-parser-compile-incremental (symbol-value parser-symbol))))
(lambda (&rest arguments)
(apply func phpinspect-parse-context arguments)))
(or (symbol-function parser-symbol)
(defalias parser-symbol
(phpinspect-parser-compile (symbol-value parser-symbol)))))))
(defun phpinspect-purge-parser-cache ()
"Unset functions in `phpinspect-parser-obarray`.
@ -360,6 +377,23 @@ have any effect."
(interactive)
(obarray-map #'fmakunbound phpinspect-parser-obarray))
(defmacro phpinspect-pctx-save-whitespace (pctx &rest body)
(declare (indent 1))
(let ((save-sym (gensym)))
`(let ((,save-sym (phpinspect-pctx-whitespace-before ,pctx)))
(unwind-protect
(progn
(setf (phpinspect-pctx-whitespace-before ,pctx) nil)
,@body)
(setf (phpinspect-pctx-whitespace-before ,pctx) ,save-sym)))))
;; (defmacro phpinspect-pctx-save-whitespace-when-active (&rest body)
;; `(if phpinspect-current-pctx
;; (phpinspect-pctx-save-whitespace phpinspect-current-pctx
;; ,@body)
;; (progn
;; ,@body)))
(defun phpinspect-make-parser-function (tree-type handler-list &optional delimiter-predicate)
"Create a parser function using the handlers by names defined in HANDLER-LIST.
@ -390,10 +424,9 @@ token is \";\", which marks the end of a statement in PHP."
(delimiter-predicate (if (symbolp delimiter-predicate)
`(quote ,delimiter-predicate)
delimiter-predicate)))
`(lambda (buffer max-point &optional continue-condition)
`(lambda (buffer max-point &optional continue-condition &rest _ignored)
(with-current-buffer buffer
(let ((tokens)
(root-start (point))
(delimiter-predicate (when (functionp ,delimiter-predicate) ,delimiter-predicate)))
(while (and (< (point) max-point)
(if continue-condition (funcall continue-condition) t)
@ -403,35 +436,183 @@ token is \";\", which marks the end of a statement in PHP."
(cond ,@(mapcar
(lambda (handler)
`((looking-at ,(plist-get (symbol-value handler) 'regexp))
(let ((start-position (point))
(token (funcall ,(symbol-function handler)
(let ((token (funcall ,(symbol-function handler)
(match-string 0)
max-point)))
(when token
(if (null tokens)
(setq tokens (list token))
(progn
(nconc tokens (list token))))
(phpinspect-set-token-metadata-when-current-buffer
token start-position (point) ,handler)))))
(nconc tokens (list token))))))))
handlers)
(t (forward-char))))
(push ,tree-type tokens)
(phpinspect-set-token-metadata-when-current-buffer tokens root-start (point) nil)
;; Return
tokens)))))
(defsubst phpinspect-set-token-metadata-when-current-buffer (token start end handler)
"When parsing within a buffer that has`phpinspect-current-buffer` set,update
the token metadata maps. Usually, this variable is set when `phpinspect-mode` is
active."
(when phpinspect-current-buffer
(phpinspect-buffer-set-token-metadata
phpinspect-current-buffer token (phpinspect-make-token-metadata
:region (phpinspect-make-region start end)
:handler handler))))
;; (defsubst phpinspect-tree-incremental-insert (tree node)
;; (let* ((meta (phpinspect-tree-value tree))
;; (token (when (phpinspect-meta-p meta) (phpinspect-meta-token meta)))
;; (node-meta (phpinspect-tree-value node)))
;; (if token
(cl-defstruct (phpinspect-meta (:constructor phpinspect-make-meta))
"An object that represents the metadata associated with a parsed token."
(token nil
:type phpinspect-token
:documentation
"The token that metadata is associated with.")
(whitespace-before ""
:type string
:documentation
"Whitespace parsed before this token")
(tree nil
:type phpinspect-tree)
(tainted nil
:type bool
:documentation
"Whether or not the text of this token has been changed in the buffer")
(handler nil
:type phpinspect-handler
:documentation
"The handler that was used to parse token. (see `phpinspect-defhandler')"))
(defsubst phpinspect-meta-start (meta)
(phpinspect-tree-start (phpinspect-meta-tree meta)))
(defsubst phpinspect-meta-end (meta)
(phpinspect-tree-end (phpinspect-meta-tree meta)))
(defvar phpinspect-parse-context nil
"An instance of `phpinspect-pctx' that is used when
parsing. Usually used in combination with
`phpinspect-with-parse-context'")
(defmacro phpinspect-with-parse-context (ctx &rest body)
(declare (indent 1))
(let ((old-ctx phpinspect-parse-context))
`(unwind-protect
(progn
(setq phpinspect-parse-context ,ctx)
,@body)
(setq phpinspect-parse-context ,old-ctx))))
(cl-defstruct (phpinspect-pctx (:constructor phpinspect-make-pctx))
"Parser Context"
(incremental nil)
(edtrack nil
:type phpinspect-edtrack)
(tree nil
:type phpinspect-tree)
(previous-tree nil
:type phpinspect-tree)
(whitespace-before ""
:type string))
(cl-defmethod phpinspect-pctx-register-token
((pctx phpinspect-pctx) token start end handler)
(let* ((meta (phpinspect-make-meta
:token token
:handler handler
:whitespace-before (phpinspect-pctx-whitespace-before pctx)))
(node (phpinspect-tree-insert
(phpinspect-pctx-tree pctx) start end meta)))
(setf (phpinspect-meta-tree meta) node)
(setf (phpinspect-pctx-whitespace-before pctx) "")
meta))
(cl-defmethod phpinspect-pctx-register-whitespace
((pctx phpinspect-pctx) (whitespace string))
(setf (phpinspect-pctx-whitespace-before pctx) whitespace))
(defun phpinspect-make-incremental-parser-function (tree-type handler-list &optional delimiter-predicate)
"Like `phpinspect-make-parser-function', but returned function is able to reuse an already parsed tree."
(let ((handlers (mapcar
(lambda (handler-name)
(let* ((handler-name (symbol-name handler-name))
(handler (intern-soft handler-name phpinspect-handler-obarray)))
(if handler
handler
(error "No handler found by name \"%s\"" handler-name))))
handler-list))
(delimiter-predicate (if (symbolp delimiter-predicate)
`(quote ,delimiter-predicate)
delimiter-predicate)))
`(lambda (context buffer max-point &optional continue-condition root)
(with-current-buffer buffer
(let ((tokens)
(root-start (point))
(edtrack (phpinspect-pctx-edtrack context))
(current-tree (phpinspect-pctx-tree context))
(previous-tree (phpinspect-pctx-previous-tree context))
(delimiter-predicate (when (functionp ,delimiter-predicate) ,delimiter-predicate)))
(phpinspect-pctx-save-whitespace context
(while (and (< (point) max-point)
(if continue-condition (funcall continue-condition) t)
(not (if delimiter-predicate
(funcall delimiter-predicate (car (last tokens)))
nil)))
(cond ,@(mapcar
(lambda (handler)
`((looking-at ,(plist-get (symbol-value handler) 'regexp))
(let* ((match (match-string 0))
(start-position (point))
(original-position
(when previous-tree
(catch 'phpinspect-point-inside-edit
(phpinspect-edtrack-original-position-at-point edtrack start-position))))
(existing-node)
(existing-meta)
(current-end-position)
(token))
(unless (or (not previous-tree) (phpinspect-point-inside-edit-err-p original-position))
(setq existing-node (phpinspect-tree-find-node-starting-at previous-tree original-position))
(when existing-node
(setq existing-meta (phpinspect-tree-value existing-node)
current-end-position
(catch 'phpinspect-point-inside-edit
(phpinspect-edtrack-current-position-at-point
edtrack (phpinspect-tree-end existing-node))))))
(if (and existing-node
(not (or (phpinspect-root-p (phpinspect-meta-token existing-meta))
(phpinspect-meta-tainted existing-meta)
(phpinspect-point-inside-edit-err-p current-end-position))))
(progn
(setq existing-node (phpinspect-tree-detach existing-node))
(setq token (phpinspect-meta-token existing-meta))
(setf (phpinspect-tree-start existing-node) start-position)
(setf (phpinspect-tree-end existing-node) current-end-position)
(goto-char current-end-position)
(phpinspect-tree-insert-node current-tree existing-node))
(progn
(setq token (funcall ,(symbol-function handler) match max-point))
(when token
(phpinspect-pctx-register-token context token start-position (point) ,handler))))
(when token
(if (null tokens)
(setq tokens (list token))
(progn
(nconc tokens (list token))))))))
handlers)
(t (forward-char)))))
(push ,tree-type tokens)
(when root
(phpinspect-pctx-register-token context tokens root-start (point) nil))
;; Return
tokens)))))
;; (defsubst phpinspect-register-token-when-current-buffer (token start end handler)
;; "When parsing within a buffer that has`phpinspect-current-buffer` set,update
;; the token metadata maps. Usually, this variable is set when `phpinspect-mode` is
;; active."
;; (when phpinspect-current-buffer
;; (phpinspect-buffer--register-token
;; phpinspect-current-buffer token start end handler)))
(cl-defstruct (phpinspect-parser (:constructor phpinspect-make-parser))
@ -458,7 +639,10 @@ parsed token. When the predicate returns a non-nil value, the parser stops
executing.")
(func nil
:type function
:documentation "The parser function."))
:documentation "The parser function.")
(incremental-func nil
:type function
:documentation "Incemental parser function"))
(cl-defmethod phpinspect-parser-compile ((parser phpinspect-parser))
"Create/return parser function."
@ -470,6 +654,16 @@ executing.")
(phpinspect-parser-handlers parser)
(phpinspect-parser-delimiter-predicate parser))))))
(cl-defmethod phpinspect-parser-compile-incremental ((parser phpinspect-parser))
"Like `phpinspect-parser-compile', but for an incremental version of the parser function."
(or (phpinspect-parser-incremental-func parser)
(setf (phpinspect-parser-incremental-func parser)
(byte-compile
(phpinspect-make-incremental-parser-function
(intern (concat ":" (phpinspect-parser-tree-keyword parser)))
(phpinspect-parser-handlers parser)
(phpinspect-parser-delimiter-predicate parser))))))
(defmacro phpinspect-defparser (name &rest parameters)
(declare (indent 1))
`(set (intern ,(symbol-name name) phpinspect-parser-obarray)
@ -575,11 +769,10 @@ executing.")
(while (not (or (= max-point (point)) (looking-at "\\*/")))
(forward-char))
(point)))
(comment-contents (buffer-substring region-start region-end))
(parser (phpinspect-get-parser-func 'doc-block))
(doc-block (with-temp-buffer
(insert comment-contents)
(goto-char (point-min))
(doc-block (save-restriction
(goto-char region-start)
(narrow-to-region region-start region-end)
(funcall parser (current-buffer) (point-max)))))
(forward-char 2)
doc-block))
@ -598,7 +791,9 @@ executing.")
(phpinspect-defhandler whitespace (whitespace &rest _ignored)
"Handler that discards whitespace"
(regexp "[[:blank:]]+")
(regexp "[[:blank:]\n]+")
(when phpinspect-current-buffer
(phpinspect-buffer-register-whitespace phpinspect-current-buffer whitespace))
(forward-char (length whitespace)))
(phpinspect-defhandler equals (equals &rest _ignored)
@ -624,7 +819,7 @@ executing.")
(phpinspect-defhandler use-keyword (start-token max-point)
"Handler for the use keyword and tokens that might follow to give it meaning"
(regexp (concat "use" (phpinspect--word-end-regex)))
(setq start-token (phpinspect--strip-last-char start-token))
(setq start-token (phpinspect--strip-word-end-space start-token))
(forward-char (length start-token))
(let ((parser (phpinspect-get-parser-func 'use)))
@ -656,7 +851,7 @@ executing.")
either a block has been parsed or another namespace keyword has
been encountered."
(regexp (concat "namespace" (phpinspect--word-end-regex)))
(setq start-token (phpinspect--strip-last-char start-token))
(setq start-token (phpinspect--strip-word-end-space start-token))
(forward-char (length start-token))
(funcall (phpinspect-get-parser-func 'namespace)
(current-buffer)
@ -671,7 +866,7 @@ executing.")
(phpinspect-defhandler const-keyword (start-token max-point)
"Handler for the const keyword."
(regexp (concat "const" (phpinspect--word-end-regex)))
(setq start-token (phpinspect--strip-last-char start-token))
(setq start-token (phpinspect--strip-word-end-space start-token))
(forward-char (length start-token))
(let* ((parser (phpinspect-get-parser-func 'const))
(token (funcall parser (current-buffer) max-point)))
@ -827,11 +1022,14 @@ nature like argument lists"
(phpinspect-defhandler function-keyword (start-token max-point)
"Handler for the function keyword and tokens that follow to give it meaning"
(regexp (concat "function" (phpinspect--word-end-regex)))
(setq start-token (phpinspect--strip-last-char start-token))
(setq start-token (phpinspect--strip-word-end-space start-token))
(let* ((parser (phpinspect-get-or-create-declaration-parser))
(continue-condition (lambda () (not (char-equal (char-after) ?{))))
(declaration (funcall parser (current-buffer) max-point continue-condition)))
(if (phpinspect-end-of-token-p (car (last declaration)))
(continue-condition (lambda () (not (or (char-equal (char-after) ?{)
(char-equal (char-after) ?})))))
(declaration (funcall parser (current-buffer) max-point continue-condition 'root)))
(if (or (phpinspect-end-of-token-p (car (last declaration)))
(not (looking-at (phpinspect-handler-regexp 'block))))
(list :function declaration)
(list :function
declaration
@ -862,7 +1060,7 @@ nature like argument lists"
(concat word (phpinspect--word-end-regex)))
(list "public" "private" "protected")
"\\|"))
(setq start-token (phpinspect--strip-last-char start-token))
(setq start-token (phpinspect--strip-word-end-space start-token))
(forward-char (length start-token))
(funcall (phpinspect-get-parser-func
(cond ((string= start-token "public") 'scope-public)
@ -879,7 +1077,7 @@ nature like argument lists"
(phpinspect-defhandler static-keyword (start-token max-point)
"Handler for the static keyword"
(regexp (concat "static" (phpinspect--word-end-regex)))
(setq start-token (phpinspect--strip-last-char start-token))
(setq start-token (phpinspect--strip-word-end-space start-token))
(forward-char (length start-token))
(funcall (phpinspect-get-parser-func 'static)
(current-buffer)
@ -921,11 +1119,12 @@ nature like argument lists"
the properties of the class"
(regexp (concat "\\(abstract\\|final\\|class\\|interface\\|trait\\)"
(phpinspect--word-end-regex)))
(setq start-token (phpinspect--strip-last-char start-token))
(setq start-token (phpinspect--strip-word-end-space start-token))
(list :class (funcall (phpinspect-get-or-create-declaration-parser)
(current-buffer)
max-point
(lambda () (not (char-equal (char-after) ?{))))
(lambda () (not (char-equal (char-after) ?{)))
'root)
(funcall (phpinspect-handler 'class-block)
(char-to-string (char-after)) max-point)))
@ -944,8 +1143,7 @@ the properties of the class"
(re-search-forward "<\\?php\\|<\\?" nil t)
(funcall (phpinspect-get-parser-func 'root)
(current-buffer)
point))))
point nil 'root))))
(provide 'phpinspect-parser)
;;; phpinspect-parser.el ends here

107
phpinspect-tree.el
Unescape Escape View File

@ -46,8 +46,7 @@ functionalities."
:type integer)
(end 0
:type integer)
(value nil
:type value))
(value nil))
(cl-defstruct (phpinspect-llnode (:constructor phpinspect-make-ll))
"A linked list implementation.
@ -352,23 +351,25 @@ belongs to. Return resulting linked list."
(cl-defmethod phpinspect-llnode-is-tail ((list phpinspect-llnode))
(not (phpinspect-llnode-right list)))
(cl-defmethod seq-empty-p ((list phpinspect-llnode))
(and (not (phpinspect-llnode-value list))
(phpinspect-llnode-is-tail list)))
(cl-defmethod phpinspect-tree-overlaps ((tree phpinspect-tree) (point integer))
(and (> (phpinspect-tree-end tree) point)
(<= (phpinspect-tree-start tree) point)))
(cl-defmethod phpinspect-tree-overlaps ((tree1 phpinspect-tree) (tree2 phpinspect-tree))
(and
(or (phpinspect-tree-overlaps tree1 (phpinspect-tree-start tree2))
(phpinspect-tree-overlaps tree1 (- (phpinspect-tree-end tree2) 1))
(phpinspect-tree-overlaps tree2 (phpinspect-tree-start tree1))
(phpinspect-tree-overlaps tree2 (- (phpinspect-tree-end tree1) 1)))))
(or (phpinspect-tree-overlaps tree1 (phpinspect-tree-start tree2))
(phpinspect-tree-overlaps tree1 (- (phpinspect-tree-end tree2) 1))
(phpinspect-tree-overlaps tree2 (phpinspect-tree-start tree1))
(phpinspect-tree-overlaps tree2 (- (phpinspect-tree-end tree1) 1))))
(cl-defmethod phpinspect-tree-overlaps ((tree phpinspect-tree) region)
(and
(or (phpinspect-tree-overlaps tree (phpinspect-region-start region))
(phpinspect-tree-overlaps tree (- (phpinspect-region-end region) 1))
(phpinspect-region-overlaps-point region (phpinspect-tree-start tree))
(phpinspect-region-overlaps-point region (- (phpinspect-tree-end tree) 1)))))
(or (phpinspect-tree-overlaps tree (phpinspect-region-start region))
(phpinspect-tree-overlaps tree (- (phpinspect-region-end region) 1))
(phpinspect-region-overlaps-point region (phpinspect-tree-start tree))
(phpinspect-region-overlaps-point region (- (phpinspect-tree-end tree) 1))))
(cl-defmethod phpinspect-tree-starts-after ((tree phpinspect-tree) (point integer))
(> (phpinspect-tree-start tree) point))
@ -415,7 +416,7 @@ belongs to. Return resulting linked list."
(seq-take-while (lambda (child) (phpinspect-tree-overlaps child region))
(phpinspect-ll-link children first-overlapper)))))
(defsubst phpinspect-tree-is-empty (tree)
(defsubst phpinspect-tree-empty-p (tree)
(and (= 0 (phpinspect-tree-start tree))
(= 0 (phpinspect-tree-end tree))))
@ -423,7 +424,7 @@ belongs to. Return resulting linked list."
"Insert a new NODE into TREE.
Returns the newly inserted node."
(cond ((phpinspect-tree-is-empty tree)
(cond ((phpinspect-tree-empty-p tree)
(phpinspect-tree-switch-attributes node tree)
;; Return
@ -448,6 +449,14 @@ Returns the newly inserted node."
overlappers))
(insert-after-link))
(unless (= (seq-length enclosed) overlap-count)
;; (seq-doseq (lap overlappers)
;; (message "overlaps: %s (%d,%d) with %s (%d,%d)"
;; (phpinspect-meta-token (phpinspect-tree-value lap))
;; (phpinspect-tree-start lap)
;; (phpinspect-tree-end lap)
;; (phpinspect-meta-token (phpinspect-tree-value node))
;; (phpinspect-tree-start node)
;; (phpinspect-tree-end node)))
(throw 'phpinspect-tree-conflict
"Node overlaps multiple children, but does not enclose them all"))
@ -460,6 +469,9 @@ Returns the newly inserted node."
;; we can safely push to the tree's children
(phpinspect-ll-push node (phpinspect-tree-children tree)))
(setf (phpinspect-tree-parent node) tree)
(seq-doseq (child enclosed)
(setf (phpinspect-tree-parent child) node))
(setf (phpinspect-tree-children node) enclosed))))
;; ELSE: No overlap, node can safely be added as child
@ -487,6 +499,7 @@ Returns the newly inserted node."
(progn
(phpinspect-ll-relink
(phpinspect-ll-link (phpinspect-tree-children parent) tree) node)
(setf (phpinspect-tree-parent node) parent)
(phpinspect-tree-insert-node node tree)
;; Return
@ -504,9 +517,15 @@ Returns the newly inserted node."
;; stored in.
tree))))
(t (throw 'phpinspect-tree-conflict
(format "Tree does not enclose or get enclosed. \nTree: %s \n\nPerspective parent: %s" node tree)))))
(cl-defmethod phpinspect-tree-traverse-overlappig ((tree phpinspect-tree) (point integer))
(format "Tree does not enclose or get enclosed. \nTree: (%d,%d,%s) \n\nPerspective parent: (%d,%d,%s)"
(phpinspect-tree-start tree)
(phpinspect-tree-end tree)
(if (phpinspect-tree-parent tree) "non-root" "root")
(phpinspect-tree-start node)
(phpinspect-tree-end node)
(if (phpinspect-tree-parent node) "non-root" "root"))))))
(cl-defmethod phpinspect-tree-traverse-overlapping ((tree phpinspect-tree) (point integer))
"Traverse TREE for intervals overlapping POINT.
Returns list of values from overlapping trees, sorted by interval
@ -516,9 +535,28 @@ width with the smallest interval as car."
(seq-find (lambda (child) (phpinspect-tree-overlaps child point))
(phpinspect-tree-children tree))))
(if overlapper
`(,@(phpinspect-tree-traverse-overlappig overlapper point) ,(phpinspect-tree-value tree))
`(,@(phpinspect-tree-traverse-overlapping overlapper point) ,(phpinspect-tree-value tree))
`(,(phpinspect-tree-value tree))))))
(cl-defmethod phpinspect-tree-traverse-overlapping ((tree phpinspect-tree) region)
"Traverse TREE for intervals overlapping POINT.
Returns list of values from overlapping trees, sorted by interval
width with the smallest interval as car."
(when (phpinspect-tree-overlaps tree region)
(let* ((overlappers (phpinspect-tree-find-overlapping-children
tree
(phpinspect-region-start region)
(phpinspect-region-end region))))
(if overlappers
(let ((all-overlappers))
(seq-doseq (overlapper overlappers)
(setq all-overlappers
(append all-overlappers (phpinspect-tree-traverse-overlapping overlapper region))))
`(,@all-overlappers ,(phpinspect-tree-value tree)))
`(,(phpinspect-tree-value tree))))))
(cl-defmethod phpinspect-tree-widen-after-point
((tree phpinspect-tree) (point integer) (delta integer) &optional fn)
"Widens all nodes of TREE that start or end after POINT by DELTA.
@ -553,6 +591,14 @@ with its value as argument."
(seq-doseq (child children)
(phpinspect-tree-widen-after-point child point)))))
(cl-defmethod phpinspect-tree-find-node-starting-at ((tree phpinspect-tree) (point integer))
(if (= (phpinspect-tree-start tree) point)
tree
(catch 'found
(seq-doseq (child (phpinspect-tree-children tree))
(when (phpinspect-tree-overlaps tree point)
(let ((found? (phpinspect-tree-find-node-starting-at child point)))
(when found? (throw 'found found?))))))))
(cl-defmethod phpinspect-tree-find-smallest-overlapping-set ((tree phpinspect-tree) region)
"Traverse TREE for smallest set of intervals overlapping REGION,
@ -597,17 +643,36 @@ collectively have the smallest width."
"Insert a new interval from START to END linked to VALUE into TREE.
Returns the newly created and inserted node."
(let ((node (phpinspect-make-tree :start start :end end :value value)))
(let ((node (phpinspect-make-tree :start start
:end end
:value value)))
(phpinspect-tree-insert-node tree node)))
(cl-defmethod phpinspect-tree-detach ((tree phpinspect-tree))
"Detach tree from parent."
"Detach tree from parent without renewing its value map."
(let ((parent (phpinspect-tree-parent tree)))
(when parent
(let ((parent-link (phpinspect-ll-link (phpinspect-tree-children parent)
tree)))
;; (unless parent-link
;; (message "No parent link for node %s, parent: %s"
;; (phpinspect-meta-token (phpinspect-tree-value tree)) (phpinspect-tree-value parent)))
(phpinspect-llnode-detach parent-link)
(setf (phpinspect-tree-parent tree) nil)))))
(setf (phpinspect-tree-parent tree) nil)))
tree))
(defmacro phpinspect-tree-traverse (place-and-tree &rest body)
(declare (indent defun))
(let ((stack (gensym))
(child (gensym))
(children (gensym)))
`(let ((,stack (list ,(cadr place-and-tree))))
(while (setq ,(car place-and-tree) (pop ,stack))
,@body
(let ((,children (phpinspect-tree-children ,(car place-and-tree))))
(unless (seq-empty-p ,children)
(seq-doseq (,child ,children)
(push ,child ,stack))))))))
(defsubst phpinspect-make-region (start end)
(list start end))

7
test/phpinspect-test.el
Unescape Escape View File

@ -634,6 +634,13 @@ class Thing
(should (equal '((:variable "wat") (:object-attrib "call"))
(phpinspect--assignment-from (car result))))))
(ert-deftest phpinspect-parse-function-missing-open-block ()
(let ((parsed (phpinspect-parse-string "function bla() echo 'Hello'}")))
(should (equal '(:root (:function
(:declaration (:word "function") (:word "bla") (:list)
(:word "echo") (:word "Hello"))))
parsed))))
(load-file (concat phpinspect-test-directory "/test-worker.el"))
(load-file (concat phpinspect-test-directory "/test-autoload.el"))

156
test/test-buffer.el
Unescape Escape View File

@ -27,38 +27,6 @@
(require 'phpinspect-parser)
(require 'phpinspect-buffer)
(ert-deftest phpinspect-buffer-parse-token-metadata ()
"Confirm that the metadata map of `phpinspect-current-buffer' is
populated when the variable is set and the data in it is accurate."
(let* ((parsed)
(class))
(with-temp-buffer
(insert-file-contents (concat phpinspect-test-php-file-directory "/NamespacedClass.php"))
(setq phpinspect-current-buffer
(phpinspect-make-buffer :buffer (current-buffer)))
(setq parsed (phpinspect-buffer-parse phpinspect-current-buffer))
(let* ((class (seq-find #'phpinspect-class-p
(seq-find #'phpinspect-namespace-p parsed)))
(class-meta (phpinspect-buffer-get-token-metadata
phpinspect-current-buffer class))
(class-region (phpinspect-token-metadata-region class-meta))
(classname-meta (phpinspect-buffer-get-token-metadata
phpinspect-current-buffer (car (cddadr class))))
(classname-region (phpinspect-token-metadata-region classname-meta)))
(should class)
(should class-region)
(should classname-region)
(should (eq class (phpinspect-token-metadata-token class-meta)))
;; Character position of the start of the class token.
(should (= 611 (phpinspect-region-start class-region)))
(should (= 2367 (phpinspect-region-end class-region)))
(should (= 617 (phpinspect-region-start classname-region)))
(should (= 634 (phpinspect-region-end classname-region)))))))
(ert-deftest phpinspect-buffer-region-lookups ()
(let* ((parsed)
(class))
@ -70,25 +38,20 @@ populated when the variable is set and the data in it is accurate."
(let* ((class (seq-find #'phpinspect-class-p
(seq-find #'phpinspect-namespace-p parsed)))
(class-meta (phpinspect-buffer-get-token-metadata
phpinspect-current-buffer class))
(class-region (phpinspect-token-metadata-region class-meta))
(classname-meta (phpinspect-buffer-get-token-metadata
phpinspect-current-buffer (car (cddadr class))))
(classname-region (phpinspect-token-metadata-region classname-meta)))
(classname (car (cddadr class))))
;; Root node should be the root parsed token
(should (eq parsed (phpinspect-token-metadata-token
(should (eq parsed (phpinspect-meta-token
(phpinspect-tree-value (phpinspect-buffer-tree
phpinspect-current-buffer)))))
(let ((tokens (phpinspect-buffer-tokens-enclosing-point
phpinspect-current-buffer 617)))
(should (eq (phpinspect-token-metadata-token classname-meta)
(car tokens)))
(should (phpinspect-declaration-p (cadr tokens)))
(should (eq (phpinspect-token-metadata-token class-meta)
(caddr tokens))))))))
(should (eq classname
(phpinspect-meta-token (car tokens))))
(should (phpinspect-declaration-p (phpinspect-meta-token (cadr tokens))))
(should (eq class (phpinspect-meta-token (caddr tokens)))))))))
(ert-deftest phpinspect-parse-buffer-no-current ()
"Confirm that the parser is still functional with
@ -101,3 +64,108 @@ populated when the variable is set and the data in it is accurate."
(setq parsed (phpinspect-parse-current-buffer)))
(should (cdr parsed))))
(ert-deftest phpinspect-edit-merge ()
(let ((edit (phpinspect-make-edit :original-start 10
:local-delta 2
:length 5)))
(phpinspect-edit-merge edit (phpinspect-make-edit
:original-start 12
:local-delta -3
:length 5))
(should (= -1 (phpinspect-edit-local-delta edit)))
(should (= 7 (phpinspect-edit-length edit)))
(should (= 10 (phpinspect-edit-original-start edit)))))
(ert-deftest phpinspect-edtrack-register-edit ()
(let ((edtrack (phpinspect-make-edtrack)))
(phpinspect-edtrack-register-edit edtrack 5 10 10)
(phpinspect-edtrack-register-edit edtrack 15 22 7)
(phpinspect-edtrack-register-edit edtrack 100 200 150)
(should (= 30 (phpinspect-edtrack-original-position-at-point edtrack 25)))
(should (= 4 (phpinspect-edtrack-original-position-at-point edtrack 4)))
(should (= 260 (phpinspect-edtrack-original-position-at-point edtrack 205)))))
(ert-deftest phpinspect-buffer-register-edit ()
(let ((buffer (phpinspect-make-buffer)))
(with-temp-buffer
(insert-file-contents (concat phpinspect-test-php-file-directory "/NamespacedClass.php"))
(setq phpinspect-current-buffer buffer)
(setf (phpinspect-buffer-buffer buffer) (current-buffer))
(phpinspect-buffer-parse buffer))
;; "Deletes" first curly brace of __construct function block
(phpinspect-buffer-register-edit buffer 1036 1036 1)
(let* ((region (phpinspect-make-region 1036 1037))
(tainted
(phpinspect-tree-find-smallest-overlapping-set
(phpinspect-buffer-tree buffer) region)))
(dolist (meta tainted)
(should (phpinspect-meta-tainted meta))
(phpinspect-tree-traverse (node (phpinspect-meta-tree meta))
(when (phpinspect-tree-overlaps node region)
(should (phpinspect-meta-tainted (phpinspect-tree-value node)))))))))
(cl-defstruct (phpinspect-document (:constructor phpinspect-make-document))
(buffer (get-buffer-create
(generate-new-buffer-name " **phpinspect-document** shadow buffer") t)
:type buffer
:documentation
"A hidden buffer with a reference version of the document."))
(cl-defmethod phpinspect-document-apply-edit
((document phpinspect-document) start end delta contents)
(with-current-buffer (phpinspect-document-buffer document)
(goto-char start)
(delete-region (point) (- end delta))
(insert contents)))
(cl-defmethod phpinspect-document-set-contents
((document phpinspect-document) (contents string))
(with-current-buffer (phpinspect-document-buffer document)
(erase-buffer)
(insert contents)))
(cl-defmethod phpinspect-document-contents ((document phpinspect-document))
(with-current-buffer (phpinspect-document-buffer document)
(buffer-string)))
(ert-deftest phpinspect-buffer-parse-incrementally ()
(let* ((document (phpinspect-make-document))
(buffer (phpinspect-make-buffer
:buffer (phpinspect-document-buffer document)))
(parsed))
(phpinspect-document-set-contents document "<?php function Hello() { echo 'Hello World!'; if ($name) { echo 'Hello ' . $name . '!';} }")
(setq parsed (phpinspect-buffer-parse buffer))
(should parsed)
(let ((hello (car (phpinspect-buffer-tokens-enclosing-point buffer 18)))
(hello1)
(hello2))
(should (equal '(:word "Hello") (phpinspect-meta-token hello)))
(should parsed)
;; Delete function block opening brace
(phpinspect-document-apply-edit document 24 24 -1 "")
(should (string= "<?php function Hello() echo 'Hello World!'; if ($name) { echo 'Hello ' . $name . '!';} }"
(phpinspect-document-contents document)))
(phpinspect-buffer-register-edit buffer 24 24 1)
(setq parsed (phpinspect-buffer-parse buffer))
(should parsed)
(setq hello1 (car (phpinspect-buffer-tokens-enclosing-point buffer 18)))
(should (eq hello hello1))
(phpinspect-document-apply-edit document 24 25 1 "{")
(should (string= "<?php function Hello() { echo 'Hello World!'; if ($name) { echo 'Hello ' . $name . '!';} }"
(phpinspect-document-contents document)))
(phpinspect-buffer-register-edit buffer 24 25 0)
(setq parsed (phpinspect-buffer-parse buffer))
(should parsed)
(setq hello2 (car (phpinspect-buffer-tokens-enclosing-point buffer 18)))
(should (eq hello hello2)))))

43
test/test-tree.el
Unescape Escape View File

@ -275,16 +275,21 @@ the start of the list."
(ert-deftest phpinspect-tree-insert-nested ()
(let ((tree (phpinspect-make-tree :start 0 :end 500))
(node1 (phpinspect-make-tree :start 9 :end 200))
(node2 (phpinspect-make-tree :start 20 :end 200))
(node3 (phpinspect-make-tree :start 9 :end 20))
(node4 (phpinspect-make-tree :start 21 :end 44)))
(node4 (phpinspect-make-tree :start 21 :end 44))
(node1 (phpinspect-make-tree :start 9 :end 200)))
(should (phpinspect-tree-parent (phpinspect-tree-insert-node tree node1)))
(should (phpinspect-tree-parent(phpinspect-tree-insert-node tree node2)))
(should (phpinspect-tree-parent (phpinspect-tree-insert-node tree node3)))
(should (phpinspect-tree-parent (phpinspect-tree-insert-node tree node4)))
(should (phpinspect-ll-link (phpinspect-tree-children (phpinspect-tree-parent node1)) node1))
(should (phpinspect-ll-link (phpinspect-tree-children (phpinspect-tree-parent node2)) node2))
(should (phpinspect-ll-link (phpinspect-tree-children (phpinspect-tree-parent node3)) node3))
(should (phpinspect-ll-link (phpinspect-tree-children (phpinspect-tree-parent node4)) node4))
(should (= 0 (phpinspect-tree-start tree)))
(should (= 500 (phpinspect-tree-end tree)))
@ -336,9 +341,25 @@ the node iteself if it has been stored intact)."
(phpinspect-tree-insert-node tree node3)
(phpinspect-tree-insert-node tree node4)
(setq result (phpinspect-tree-traverse-overlappig tree 22))
(setq result (phpinspect-tree-traverse-overlapping tree 22))
(should (equal '("node4" "node2" "node1" "tree") result))))
(ert-deftest phpinspect-tree-traverse-overlapping-region ()
(let ((tree (phpinspect-make-tree :start 0 :end 500 :value "tree"))
(node1 (phpinspect-make-tree :start 9 :end 200 :value "node1"))
(node2 (phpinspect-make-tree :start 20 :end 200 :value "node2"))
(node3 (phpinspect-make-tree :start 9 :end 20 :value "node3"))
(node4 (phpinspect-make-tree :start 21 :end 44 :value "node4"))
(result))
(phpinspect-tree-insert-node tree node1)
(phpinspect-tree-insert-node tree node2)
(phpinspect-tree-insert-node tree node3)
(phpinspect-tree-insert-node tree node4)
(setq result (phpinspect-tree-traverse-overlapping tree (phpinspect-make-region 18 22)))
(should (equal '("node3" "node4" "node2" "node1" "tree") result))))
(ert-deftest phpinspect-tree-find-smallest-overlapping-set ()
(let ((tree (phpinspect-make-tree :start 0 :end 500 :value "tree"))
(node1 (phpinspect-make-tree :start 9 :end 200 :value "node1"))
@ -357,6 +378,22 @@ the node iteself if it has been stored intact)."
tree (phpinspect-make-region 24 55)))
(should (equal '("node4" "node3") result))))
(ert-deftest phpinspect-tree-find-node-starting-at ()
(let ((tree (phpinspect-make-tree :start 0 :end 500 :value "tree"))
(node1 (phpinspect-make-tree :start 9 :end 200 :value "node1"))
(node2 (phpinspect-make-tree :start 20 :end 200 :value "node2"))
(node3 (phpinspect-make-tree :start 44 :end 60 :value "node3"))
(node4 (phpinspect-make-tree :start 21 :end 44 :value "node4"))
(result))
(phpinspect-tree-insert-node tree node1)
(phpinspect-tree-insert-node tree node2)
(phpinspect-tree-insert-node tree node3)
(phpinspect-tree-insert-node tree node4)
(setq result (phpinspect-tree-find-node-starting-at tree 44))
(should (eq node3 result))
(should-not (phpinspect-tree-find-node-starting-at tree 45))))
(ert-deftest phpinspect-tree-overlaps-point ()
(let ((tree (phpinspect-make-tree :start 5 :end 10)))
(should (phpinspect-tree-overlaps tree 5))

Write Preview
Loading…
Cancel
Save