From f70161128d69fd5d52eb05d7fdfd259e1e83f0cb Mon Sep 17 00:00:00 2001 From: cxxxr Date: Mon, 20 Nov 2023 01:31:47 +0900 Subject: [PATCH 1/5] add highlight.lisp --- extensions/lisp-mode/highlight.lisp | 71 ++++++++++++++++++++++++++ extensions/lisp-mode/lem-lisp-mode.asd | 1 + 2 files changed, 72 insertions(+) create mode 100644 extensions/lisp-mode/highlight.lisp diff --git a/extensions/lisp-mode/highlight.lisp b/extensions/lisp-mode/highlight.lisp new file mode 100644 index 000000000..666ede6a0 --- /dev/null +++ b/extensions/lisp-mode/highlight.lisp @@ -0,0 +1,71 @@ +(defpackage :lem-lisp-mode/highlight + (:use :cl :lem :lem-lisp-mode/internal)) +(in-package :lem-lisp-mode/highlight) + +(defvar *timer*) + +(define-attribute highlight-attribute + (t :underline t :foreground "cyan")) + +(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-string-at-point (point) + (with-point ((start point) + (end point)) + (loop :while (backward-up-list start t)) + (loop :while (forward-up-list end t)) + (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 'highlight-attribute)))) + +(define-command lisp-highlight () () + (clear-highlight-overlays (current-buffer)) + (lisp-eval-async `(micros/walker:highlight ,(form-string-at-point (current-point)) + ',(compute-path-at-point (current-point)) + ,(buffer-package (current-buffer))) + (lambda (result) + (alexandria:destructuring-ecase result + ((:read-error message) + (declare (ignore message))) + ((:error message) + (log:error message)) + ((:ok paths) + (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))))))))) + +(defun init-highlight-timer () + (let ((timer (make-idle-timer 'lisp-highlight :name "lisp-show" + :handle-function 'stop-highlight-timer))) + (setf *timer* timer) + (start-timer timer 100 t))) + +(defun stop-highlight-timer () + (when *timer* + (stop-timer *timer*) + (setf *timer* nil))) diff --git a/extensions/lisp-mode/lem-lisp-mode.asd b/extensions/lisp-mode/lem-lisp-mode.asd index ea057094b..6638d37cb 100644 --- a/extensions/lisp-mode/lem-lisp-mode.asd +++ b/extensions/lisp-mode/lem-lisp-mode.asd @@ -44,6 +44,7 @@ (:file "macroexpand") (:file "test-runner") (:file "utopian") + (:file "highlight") (:file "package"))) (defsystem "lem-lisp-mode/v2" From a7f11788a155f3065c3dce9ca0411179cbe69fcc Mon Sep 17 00:00:00 2001 From: cxxxr Date: Mon, 20 Nov 2023 01:32:17 +0900 Subject: [PATCH 2/5] update micros --- qlfile.lock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/qlfile.lock b/qlfile.lock index e6a58d885..a9819489f 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -5,7 +5,7 @@ ("micros" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/micros.git") - :version "git-ed264a27262baeed493cdde338873bf4afc3721c")) + :version "git-dee94bbc35912958512ee1841d6f42c74a642d65")) ("lem-mailbox" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/lem-mailbox.git") From 269f9af0c53e396bf08734c9fe0d38c5e247ba39 Mon Sep 17 00:00:00 2001 From: cxxxr Date: Mon, 20 Nov 2023 01:36:52 +0900 Subject: [PATCH 3/5] add experimental/lisp-toggle-highlight command --- extensions/lisp-mode/highlight.lisp | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/extensions/lisp-mode/highlight.lisp b/extensions/lisp-mode/highlight.lisp index 666ede6a0..e37812dc6 100644 --- a/extensions/lisp-mode/highlight.lisp +++ b/extensions/lisp-mode/highlight.lisp @@ -2,7 +2,7 @@ (:use :cl :lem :lem-lisp-mode/internal)) (in-package :lem-lisp-mode/highlight) -(defvar *timer*) +(defvar *timer* nil) (define-attribute highlight-attribute (t :underline t :foreground "cyan")) @@ -60,7 +60,8 @@ (highlight-symbol point))))))))) (defun init-highlight-timer () - (let ((timer (make-idle-timer 'lisp-highlight :name "lisp-show" + (let ((timer (make-idle-timer 'lisp-highlight + :name "lisp-highlight" :handle-function 'stop-highlight-timer))) (setf *timer* timer) (start-timer timer 100 t))) @@ -69,3 +70,8 @@ (when *timer* (stop-timer *timer*) (setf *timer* nil))) + +(define-command experimental/lisp-toggle-highlight () () + (if *timer* + (stop-highlight-timer) + (init-highlight-timer))) From 2032acef9af0f86b1ad7cc5dc2e93cb0c669d1fc Mon Sep 17 00:00:00 2001 From: cxxxr Date: Wed, 29 Nov 2023 22:58:21 +0900 Subject: [PATCH 4/5] fix argument --- extensions/lisp-mode/highlight.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extensions/lisp-mode/highlight.lisp b/extensions/lisp-mode/highlight.lisp index e37812dc6..bb3853656 100644 --- a/extensions/lisp-mode/highlight.lisp +++ b/extensions/lisp-mode/highlight.lisp @@ -64,7 +64,7 @@ :name "lisp-highlight" :handle-function 'stop-highlight-timer))) (setf *timer* timer) - (start-timer timer 100 t))) + (start-timer timer 100 :repeat t))) (defun stop-highlight-timer () (when *timer* From eb3d7f8546e38e70040a9cb975dd7c3d1690c7cc Mon Sep 17 00:00:00 2001 From: cxxxr Date: Wed, 29 Nov 2023 22:59:19 +0900 Subject: [PATCH 5/5] do not highlight on space --- extensions/lisp-mode/highlight.lisp | 33 +++++++++++++++-------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/extensions/lisp-mode/highlight.lisp b/extensions/lisp-mode/highlight.lisp index bb3853656..2757ca6cd 100644 --- a/extensions/lisp-mode/highlight.lisp +++ b/extensions/lisp-mode/highlight.lisp @@ -42,22 +42,23 @@ (define-command lisp-highlight () () (clear-highlight-overlays (current-buffer)) - (lisp-eval-async `(micros/walker:highlight ,(form-string-at-point (current-point)) - ',(compute-path-at-point (current-point)) - ,(buffer-package (current-buffer))) - (lambda (result) - (alexandria:destructuring-ecase result - ((:read-error message) - (declare (ignore message))) - ((:error message) - (log:error message)) - ((:ok paths) - (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))))))))) + (unless (syntax-space-char-p (character-at (current-point))) + (lisp-eval-async `(micros/walker:highlight ,(form-string-at-point (current-point)) + ',(compute-path-at-point (current-point)) + ,(buffer-package (current-buffer))) + (lambda (result) + (alexandria:destructuring-ecase result + ((:read-error message) + (declare (ignore message))) + ((:error message) + (log:error message)) + ((:ok paths) + (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)))))))))) (defun init-highlight-timer () (let ((timer (make-idle-timer 'lisp-highlight