add walker.lisp (wip)

micros.asd

@@ -51,4 +51,7 @@
                              ))
                (:file "lsp-api")))
 
-
+(defsystem "micros/walker"
+  :serial t
+  :pathname "walker"
+  :components ((:file "walker")))

walker/example.lisp

@@ -0,0 +1,36 @@
+(block foo
+  (return-from foo 10)
+  (block foo
+    (return-from foo 20)
+    (return-from foo 30))
+  (return-from foo 40))
+
+(let* ((a 0)
+       (b a))
+  (let* ((a a)
+         (b a))
+    a)
+  a)
+
+(let ((a 1))
+  (let ((b a))
+    a
+    b))
+
+(let ((a 0)
+      (b 1))
+  (load-time-value a b)
+  (multiple-value-call 'f a b a)
+  (setq a b
+        b a)
+  (progn a b)
+  (multiple-value-prog1 a
+    b
+    a)
+  (unwind-protect a (the integer b) c))
+
+(lambda (x a b c &key (y x) z &aux (foo 10))
+  x
+  y
+  z
+  foo)

walker/lem.lisp

@@ -0,0 +1,48 @@
+(in-package :lem-user)
+
+(define-overlay-accessors highlight-overlays
+  :clear-function clear-highlight-overlays
+  :add-function add-highlight-overlays)
+
+(defun toplevel-form-p (point)
+  (start-line-p point))
+
+(defun compute-path-at-point (point)
+  (with-point ((point point))
+    (skip-chars-backward point #'syntax-symbol-char-p)
+    (loop :collect (loop :while (form-offset point -1) :count t)
+          :until (or (null (backward-up-list point t))
+                     (toplevel-form-p point)))))
+
+(defun form-at-point (point)
+  (with-point ((start point)
+               (end point))
+    (loop :while (backward-up-list start t))
+    (loop :while (forward-up-list end t))
+    (read-from-string (points-to-string start end))))
+
+(defun move-path (point path)
+  (loop :for n :in (reverse path)
+        :do (forward-down-list point t)
+            (form-offset point n))
+  (skip-whitespace-forward point))
+
+(defun highlight-symbol (point)
+  (with-point ((start point)
+               (end point))
+    (form-offset end 1)
+    (add-highlight-overlays (point-buffer point)
+                            (make-overlay start
+                                          end
+                                          (make-attribute :underline t :foreground "cyan")))))
+
+(define-command highlight () ()
+  (clear-highlight-overlays (current-buffer))
+  (let ((paths (micros/walker::collect-references (form-at-point (current-point))
+                                                  (compute-path-at-point (current-point)))))
+    (with-point ((start (current-point)))
+      (loop :while (backward-up-list start t))
+      (dolist (path paths)
+        (with-point ((point start))
+          (move-path point path)
+          (highlight-symbol point))))))