You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
382 lines
15 KiB
EmacsLisp
382 lines
15 KiB
EmacsLisp
;;; phpinspect-bmap.el --- PHP parsing and completion package -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2021 Free Software Foundation, Inc
|
|
|
|
;; Author: Hugo Thunnissen <devel@hugot.nl>
|
|
;; Keywords: php, languages, tools, convenience
|
|
;; Version: 0
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;;; Code:
|
|
|
|
(cl-defstruct (phpinspect-bmap (:constructor phpinspect-make-bmap))
|
|
(starts (make-hash-table :test #'eql
|
|
:size (floor (/ (point-max) 4))
|
|
:rehash-size 1.5))
|
|
(ends (make-hash-table :test #'eql
|
|
:size (floor (/ (point-max) 4))
|
|
:rehash-size 1.5))
|
|
(meta (make-hash-table :test #'eq
|
|
:size (floor (/ (point-max) 4))
|
|
:rehash-size 1.5))
|
|
(token-stack nil
|
|
:type list)
|
|
(overlays nil
|
|
:type list)
|
|
(last-token-start nil
|
|
:type integer))
|
|
|
|
(defsubst phpinspect-make-region (start end)
|
|
(list start end))
|
|
|
|
(defalias 'phpinspect-region-start #'car)
|
|
(defalias 'phpinspect-region-end #'cadr)
|
|
|
|
(defsubst phpinspect-region-size (region)
|
|
(- (phpinspect-region-end region) (phpinspect-region-start region)))
|
|
|
|
(defsubst phpinspect-region> (reg1 reg2)
|
|
(> (phpinspect-region-size reg1) (phpinspect-region-size reg2)))
|
|
|
|
(defsubst phpinspect-region< (reg1 reg2)
|
|
(< (phpinspect-region-size reg1) (phpinspect-region-size reg2)))
|
|
|
|
(defsubst phpinspect-region-overlaps-point (reg point)
|
|
(and (> (phpinspect-region-end reg) point)
|
|
(<= (phpinspect-region-start reg) point)))
|
|
|
|
(defsubst phpinspect-region-overlaps (reg1 reg2)
|
|
(or (phpinspect-region-reg2s-point reg1 (phpinspect-region-start reg2))
|
|
(phpinspect-region-reg2s-point reg1 (- (phpinspect-region-end reg2) 1))
|
|
(phpinspect-region-reg2s-point reg2 (phpinspect-region-start reg1))
|
|
(phpinspect-region-reg2s-point reg2 (- (phpinspect-region-end reg1) 1))))
|
|
|
|
(defsubst phpinspect-region-encloses (reg1 reg2)
|
|
(and (<= (phpinspect-region-start reg1) (phpinspect-region-start reg2))
|
|
(>= (phpinspect-region-end reg1) (phpinspect-region-end reg2))))
|
|
|
|
(defsubst phpinspect-make-meta (parent start end whitespace-before token &optional overlay right-siblings)
|
|
(list 'meta parent start end whitespace-before token overlay right-siblings))
|
|
|
|
(defsubst phpinspect-meta-parent (meta)
|
|
(cadr meta))
|
|
|
|
(gv-define-setter phpinspect-meta-end (end meta) `(setcar (cdddr ,meta) ,end))
|
|
(gv-define-setter phpinspect-meta-start (start meta) `(setcar (cddr ,meta) ,start))
|
|
(gv-define-setter phpinspect-meta-overlay (overlay meta) `(setcar (nthcdr 6 ,meta) ,overlay))
|
|
(gv-define-setter phpinspect-meta-parent (parent meta) `(setcar (cdr ,meta) ,parent))
|
|
(gv-define-setter phpinspect-meta-right-siblings (siblings meta) `(setcar (nthcdr 7 ,meta) ,siblings))
|
|
|
|
(defsubst phpinspect-meta-right-siblings (meta)
|
|
(car (nthcdr 7 meta)))
|
|
|
|
(defsubst phpinspect-meta-overlay (meta)
|
|
(car (nthcdr 6 meta)))
|
|
|
|
(defsubst phpinspect-meta-token (meta)
|
|
(car (nthcdr 5 meta)))
|
|
|
|
(defsubst phpinspect-meta-end (meta)
|
|
(cadddr meta))
|
|
|
|
(defsubst phpinspect-meta-whitespace-before (meta)
|
|
(car (cddddr meta)))
|
|
|
|
(defsubst phpinspect-meta-width (meta)
|
|
(- (phpinspect-meta-end meta) (phpinspect-meta-start meta)))
|
|
|
|
(defun phpinspect-meta-sort-width (meta1 meta2)
|
|
(< (phpinspect-meta-width meta1) (phpinspect-meta-width meta2)))
|
|
|
|
(defsubst phpinspect-meta-start (meta)
|
|
(caddr meta))
|
|
|
|
(defsubst phpinspect-meta-overlaps-point (meta point)
|
|
(and (> (phpinspect-meta-end meta) point)
|
|
(<= (phpinspect-meta-start meta) point)))
|
|
|
|
(defsubst phpinspect-meta-find-parent-matching-token (meta predicate)
|
|
(if (funcall predicate (phpinspect-meta-token meta))
|
|
meta
|
|
(catch 'found
|
|
(while (phpinspect-meta-parent meta)
|
|
(setq meta (phpinspect-meta-parent meta))
|
|
(when (funcall predicate (phpinspect-meta-token meta))
|
|
(throw 'found meta))))))
|
|
|
|
(gv-define-setter phpinspect-overlay-end (end overlay) `(setcar (cddr ,overlay) ,end))
|
|
(gv-define-setter phpinspect-overlay-start (start overlay) `(setcar (cdr ,overlay) ,start))
|
|
(gv-define-setter phpinspect-overlay-delta (delta overlay) `(setcar (cdddr ,overlay) ,delta))
|
|
|
|
(defsubst phpinspect-overlay-bmap (overlay)
|
|
(car (nthcdr 4 overlay)))
|
|
|
|
(defsubst phpinspect-overlay-delta (overlay)
|
|
(cadddr overlay))
|
|
|
|
(defsubst phpinspect-overlay-start (overlay)
|
|
(cadr overlay))
|
|
|
|
(defsubst phpinspect-overlay-end (overlay)
|
|
(caddr overlay))
|
|
|
|
(defsubst phpinspect-overlay-token-meta (overlay)
|
|
(car (nthcdr 5 overlay)))
|
|
|
|
(defsubst phpinspect-overlay-overlaps-point (overlay point)
|
|
(and (> (phpinspect-overlay-end overlay) point)
|
|
(<= (phpinspect-overlay-start overlay) point)))
|
|
|
|
(defmacro phpinspect-bmap-iterate-region (region place-and-bmap &rest body)
|
|
(declare (indent defun))
|
|
(let ((place (car place-and-bmap))
|
|
(bmap (gensym))
|
|
(bmap-stack (gensym))
|
|
(region-start (gensym))
|
|
(region-end (gensym)))
|
|
`(let ((,bmap)
|
|
(,bmap-stack (list ,(cadr place-and-bmap)))
|
|
(,region-start (car ,region))
|
|
(,region-end (cadr ,region)))
|
|
(while (setq ,bmap (pop ,bmap-stack))
|
|
(phpinspect-bmap-iterate (,place ,bmap)
|
|
(when (and (<= ,region-start
|
|
(phpinspect-meta-start ,place))
|
|
(>= ,region-end
|
|
(phpinspect-meta-end ,place)))
|
|
,@body))))))
|
|
|
|
(defmacro phpinspect-bmap-iterate (place-and-bmap &rest body)
|
|
(declare (indent defun))
|
|
(let ((place (car place-and-bmap))
|
|
(bmap (gensym))
|
|
(bmap-stack (gensym))
|
|
(_ignored (gensym))
|
|
(overlay-start (gensym))
|
|
(overlay-end (gensym)))
|
|
`(let ((,bmap-stack (list ,(cadr place-and-bmap)))
|
|
(,bmap))
|
|
(while (setq ,bmap (pop ,bmap-stack))
|
|
(if (phpinspect-overlay-p ,bmap)
|
|
(let ((,overlay-start (phpinspect-overlay-start ,bmap))
|
|
(,overlay-end (phpinspect-overlay-end ,bmap)))
|
|
(maphash (lambda (,_ignored ,place)
|
|
(setq ,place (phpinspect-overlay-wrap-meta ,bmap ,place))
|
|
(when (and (<= ,overlay-start
|
|
(phpinspect-meta-start ,place))
|
|
(>= ,overlay-end
|
|
(phpinspect-meta-end ,place)))
|
|
(if (phpinspect-meta-overlay ,place)
|
|
(push (phpinspect-meta-overlay ,place) ,bmap-stack)
|
|
,@body)))
|
|
(phpinspect-bmap-meta (phpinspect-overlay-bmap ,bmap))))
|
|
(maphash (lambda (,_ignored ,place)
|
|
(if (phpinspect-meta-overlay ,place)
|
|
(push (phpinspect-meta-overlay ,place) ,bmap-stack)
|
|
,@body))
|
|
(phpinspect-bmap-meta ,bmap)))))))
|
|
|
|
(defsubst phpinspect-bmap-register (bmap start end token &optional whitespace-before overlay)
|
|
(let* ((starts (phpinspect-bmap-starts bmap))
|
|
(ends (phpinspect-bmap-ends bmap))
|
|
(meta (phpinspect-bmap-meta bmap))
|
|
(last-token-start (phpinspect-bmap-last-token-start bmap))
|
|
(existing-end (gethash end ends))
|
|
(token-meta (phpinspect-make-meta nil start end whitespace-before token overlay)))
|
|
(unless whitespace-before
|
|
(setq whitespace-before ""))
|
|
|
|
(puthash start token-meta starts)
|
|
|
|
(if existing-end
|
|
(push token existing-end)
|
|
(puthash end (list token-meta) ends))
|
|
|
|
(puthash token token-meta meta)
|
|
|
|
(when (and last-token-start
|
|
(<= start last-token-start))
|
|
(let ((child)
|
|
(stack (phpinspect-bmap-token-stack bmap))
|
|
(right-siblings))
|
|
|
|
(while (and (car stack) (>= (phpinspect-meta-start (car stack))
|
|
start))
|
|
(setq child (pop stack))
|
|
(setf (phpinspect-meta-parent child) token-meta)
|
|
(when (phpinspect-meta-overlay child)
|
|
(setf (phpinspect-meta-parent
|
|
(phpinspect-overlay-token-meta
|
|
(phpinspect-meta-overlay child)))
|
|
token-meta))
|
|
|
|
(setf (phpinspect-meta-right-siblings child) right-siblings)
|
|
(when (phpinspect-meta-overlay child)
|
|
(setf (phpinspect-meta-right-siblings
|
|
(phpinspect-overlay-token-meta
|
|
(phpinspect-meta-overlay child)))
|
|
right-siblings))
|
|
(push (phpinspect-meta-token child) right-siblings))
|
|
|
|
(setf (phpinspect-bmap-token-stack bmap) stack)))
|
|
|
|
(setf (phpinspect-bmap-last-token-start bmap) start)
|
|
(push token-meta (phpinspect-bmap-token-stack bmap))))
|
|
|
|
(defsubst phpinspect-overlay-p (overlay)
|
|
(and (listp overlay)
|
|
(eq 'overlay (car overlay))))
|
|
|
|
(defsubst phpinspect-overlay-wrap-meta (overlay meta)
|
|
(when meta
|
|
(setq meta (cl-copy-list meta))
|
|
(setf (phpinspect-meta-start meta)
|
|
(+ (phpinspect-meta-start meta) (phpinspect-overlay-delta overlay)))
|
|
(setf (phpinspect-meta-end meta)
|
|
(+ (phpinspect-meta-end meta) (phpinspect-overlay-delta overlay)))
|
|
|
|
(when (phpinspect-meta-overlay meta)
|
|
(let ((meta-overlay (cl-copy-list (phpinspect-meta-overlay meta))))
|
|
(setf (phpinspect-overlay-start meta-overlay)
|
|
(+ (phpinspect-overlay-start meta-overlay)
|
|
(phpinspect-overlay-delta overlay)))
|
|
(setf (phpinspect-overlay-end meta-overlay)
|
|
(+ (phpinspect-overlay-end meta-overlay)
|
|
(phpinspect-overlay-delta overlay)))
|
|
(setf (phpinspect-overlay-delta meta-overlay)
|
|
(+ (phpinspect-overlay-delta meta-overlay)
|
|
(phpinspect-overlay-delta overlay)))
|
|
(setf (phpinspect-meta-overlay meta) meta-overlay)))
|
|
|
|
meta))
|
|
|
|
(cl-defmethod phpinspect-bmap-token-starting-at ((overlay (head overlay)) point)
|
|
(phpinspect-overlay-wrap-meta
|
|
overlay
|
|
(phpinspect-bmap-token-starting-at
|
|
(phpinspect-overlay-bmap overlay) (- point (phpinspect-overlay-delta overlay)))))
|
|
|
|
(cl-defmethod phpinspect-bmap-token-starting-at ((bmap phpinspect-bmap) point)
|
|
(let ((overlay (phpinspect-bmap-overlay-at-point bmap point)))
|
|
(if overlay
|
|
(phpinspect-bmap-token-starting-at overlay point)
|
|
(gethash point (phpinspect-bmap-starts bmap)))))
|
|
|
|
(cl-defmethod phpinspect-bmap-tokens-ending-at ((overlay (head overlay)) point)
|
|
(mapcar (lambda (meta) (phpinspect-overlay-wrap-meta overlay meta))
|
|
(phpinspect-bmap-tokens-ending-at
|
|
(phpinspect-overlay-bmap overlay) (- point (phpinspect-overlay-delta overlay)))))
|
|
|
|
(cl-defmethod phpinspect-bmap-tokens-ending-at ((bmap phpinspect-bmap) point)
|
|
(let ((overlay (phpinspect-bmap-overlay-at-point bmap point)))
|
|
(if overlay
|
|
(phpinspect-bmap-tokens-ending-at overlay point)
|
|
(gethash point (phpinspect-bmap-ends bmap)))))
|
|
|
|
(defsubst phpinspect-bmap-overlay-at-point (bmap point)
|
|
(catch 'found
|
|
(dolist (overlay (phpinspect-bmap-overlays bmap))
|
|
(when (phpinspect-overlay-overlaps-point overlay point)
|
|
(throw 'found overlay)))))
|
|
|
|
(defsubst phpinspect-bmap-tokens-overlapping (bmap point)
|
|
(let ((tokens))
|
|
(phpinspect-bmap-iterate (meta bmap)
|
|
(when (phpinspect-meta-overlaps-point meta point)
|
|
(push meta tokens)))
|
|
|
|
(sort tokens #'phpinspect-meta-sort-width)))
|
|
|
|
(cl-defmethod phpinspect-bmap-token-meta ((overlay (head overlay)) token)
|
|
(phpinspect-bmap-token-meta (phpinspect-overlay-bmap overlay) token))
|
|
|
|
(cl-defmethod phpinspect-bmap-token-meta ((bmap phpinspect-bmap) token)
|
|
(unless (phpinspect-probably-token-p token)
|
|
(error "Unexpected argument, expected `phpinspect-token-p'. Got invalid token %s" token))
|
|
|
|
(or (gethash token (phpinspect-bmap-meta bmap))
|
|
(let ((found?))
|
|
(catch 'found
|
|
(dolist (overlay (phpinspect-bmap-overlays bmap))
|
|
(when (setq found? (phpinspect-bmap-token-meta overlay token))
|
|
(throw 'found found?)))))))
|
|
|
|
(defsubst phpinspect-probably-token-p (token)
|
|
(and (listp token)
|
|
(keywordp (car token))))
|
|
|
|
(cl-defmethod phpinspect-bmap-last-token-before-point ((bmap phpinspect-bmap) point &optional limit)
|
|
"Search backward in BMAP for last token ending before POINT.
|
|
|
|
LIMIT is the maximum number of positions to check backward before
|
|
giving up. If not provided, this is 100."
|
|
(unless limit (setq limit 100))
|
|
(let* ((ending)
|
|
(point-limit (- point limit)))
|
|
(unless (hash-table-empty-p (phpinspect-bmap-ends bmap))
|
|
(while (not (or (<= point 0) (<= point point-limit)
|
|
(setq ending (phpinspect-bmap-tokens-ending-at bmap point))))
|
|
(setq point (- point 1)))
|
|
(car (last ending)))))
|
|
|
|
(cl-defmethod phpinspect-bmap-last-token-starting-before-point ((bmap phpinspect-bmap) point &optional limit)
|
|
(unless limit (setq limit 100))
|
|
(let* ((starting)
|
|
(point-limit (- point limit)))
|
|
(unless (hash-table-empty-p (phpinspect-bmap-starts bmap))
|
|
(while (not (or (<= point 0) (<= point point-limit)
|
|
(setq starting (phpinspect-bmap-token-starting-at bmap point))))
|
|
(setq point (- point 1)))
|
|
starting)))
|
|
|
|
(defsubst phpinspect-bmap-overlay (bmap bmap-overlay token-meta pos-delta &optional whitespace-before)
|
|
(let* ((overlays (phpinspect-bmap-overlays bmap))
|
|
(start (+ (phpinspect-meta-start token-meta) pos-delta))
|
|
(end (+ (phpinspect-meta-end token-meta) pos-delta))
|
|
(overlay `(overlay ,start ,end ,pos-delta ,bmap-overlay ,token-meta))
|
|
(before))
|
|
(phpinspect-bmap-register bmap start end (phpinspect-meta-token token-meta) whitespace-before overlay)
|
|
|
|
(if overlays
|
|
(progn
|
|
(catch 'break
|
|
(while (setq before (car overlays))
|
|
(if (> (phpinspect-overlay-start overlay) (phpinspect-overlay-end before))
|
|
(throw 'break nil)
|
|
(setq overlays (cdr overlays)))))
|
|
|
|
(if (and before (cdr overlays))
|
|
;; Append after
|
|
(progn
|
|
(setcdr overlays (cons overlay (cdr overlays))))
|
|
;; Append at end of overlay list
|
|
(nconc (phpinspect-bmap-overlays bmap) (list overlay))))
|
|
|
|
;; No exising overlays, overwrite
|
|
(push overlay (phpinspect-bmap-overlays bmap)))))
|
|
|
|
(defun phpinspect-bmap-make-location-resolver (bmap)
|
|
(lambda (token)
|
|
(let ((meta (phpinspect-bmap-token-meta bmap token)))
|
|
(if meta
|
|
(phpinspect-make-region (phpinspect-meta-start meta)
|
|
(phpinspect-meta-end meta))
|
|
(phpinspect-make-region 0 0)))))
|
|
|
|
(provide 'phpinspect-bmap)
|
|
;;; phpinspect-bmap.el ends here
|