refactor overlay

frontends/sdl2/text-buffer.lisp

@@ -111,15 +111,14 @@
 
 (defun make-cursor-overlay (point)
   (let ((overlay
-          (make-instance
-           'lem-core::temporary-overlay
-           :start point
-           :end (lem:with-point ((p point))
-                  (lem:character-offset p 1)
-                  p)
-           :attribute (if (typep point 'lem:fake-cursor)
-                          'lem:fake-cursor
-                          'lem:cursor))))
+          (lem-core::make-overlay point
+                                  (lem:with-point ((p point))
+                                    (lem:character-offset p 1)
+                                    p)
+                                  (if (typep point 'lem:fake-cursor)
+                                      'lem:fake-cursor
+                                      'lem:cursor)
+                                  :temporary t)))
     (lem:overlay-put overlay :cursor t)
     overlay))
 
@@ -194,7 +193,7 @@
             :when (overlay-within-point-p overlay point)
             :do (cond ((typep overlay 'lem-core::overlay-line-endings)
                        (setf line-end-overlay overlay))
-                      ((lem:overlay-get overlay :display-line)
+                      ((typep overlay 'lem-core::overlay-line)
                        (setf attributes
                              (lem-core::overlay-attributes attributes
                                                            0

src/display.lisp

@@ -128,20 +128,17 @@
   (when (and (variable-value 'highlight-line :default (current-buffer))
              (current-theme))
     (alexandria:when-let ((color (highlight-line-color)))
-      (let ((ov (make-instance 'temporary-overlay
-                               :start (buffer-point buffer)
-                               :end (buffer-point buffer)
-                               :attribute (make-attribute :background color))))
-        (overlay-put ov :display-line t)
-        ov))))
+      (make-overlay-line (buffer-point buffer)
+                         (make-attribute :background color)
+                         :temporary t))))
 
 (defun make-temporary-region-overlay-from-cursor (cursor)
   (let ((mark (cursor-mark cursor)))
     (when (mark-active-p mark)
-      (make-instance 'temporary-overlay
-                     :start cursor
-                     :end (mark-point mark)
-                     :attribute 'region))))
+      (make-overlay cursor
+                    (mark-point mark)
+                    'region
+                    :temporary t))))
 
 (defun get-window-overlays (window)
   (let* ((buffer (window-buffer window))
@@ -206,10 +203,10 @@
                      (draw-attribute-to-screen-line screen
                                                     (overlay-attribute overlay)
                                                     (calc-row start)
-                                                    (if (overlay-get overlay :display-line)
+                                                    (if (typep overlay 'overlay-line)
                                                         0
                                                         (point-charpos start))
-                                                    (if (overlay-get overlay :display-line)
+                                                    (if (typep overlay 'overlay-line)
                                                         nil
                                                         (point-charpos end))))
                     ((and (point<= view-point start)

src/ext/legit/peek-legit.lisp

@@ -310,8 +310,7 @@ Notes:
     (show-matched-line)))
 
 (defun highlight-matched-line (point)
-  (let ((overlay (make-overlay point point 'highlight)))
-    (overlay-put overlay :display-line t)
+  (let ((overlay (make-overlay-line point 'highlight)))
     (start-timer (make-timer (lambda ()
                                (delete-overlay overlay))
                              :name "highlight-matched-line")
@@ -367,9 +366,8 @@ Notes:
 (defvar *highlight-overlays* '())
 
 (defun set-highlight-overlay (point)
-  (let ((overlay (make-overlay point point (ensure-attribute 'match-line-attribute))))
+  (let ((overlay (make-overlay-line point (ensure-attribute 'match-line-attribute))))
     (push overlay *highlight-overlays*)
-    (overlay-put overlay :display-line t)
     (setf (buffer-value (point-buffer point) 'highlight-overlay) overlay)))
 
 (defun get-highlight-overlay (point)

src/ext/peek-source.lisp

@@ -197,8 +197,7 @@
     (show-matched-line)))
 
 (defun highlight-matched-line (point)
-  (let ((overlay (make-overlay point point 'highlight)))
-    (overlay-put overlay :display-line t)
+  (let ((overlay (make-overlay-line point 'highlight)))
     (start-timer (make-timer (lambda ()
                                (delete-overlay overlay))
                              :name "highlight-matched-line")
@@ -248,9 +247,8 @@
 (defvar *highlight-overlays* '())
 
 (defun set-highlight-overlay (point)
-  (let ((overlay (make-overlay point point (ensure-attribute 'match-line-attribute))))
+  (let ((overlay (make-overlay-line point (ensure-attribute 'match-line-attribute))))
     (push overlay *highlight-overlays*)
-    (overlay-put overlay :display-line t)
     (setf (buffer-value (point-buffer point) 'highlight-overlay) overlay)))
 
 (defun get-highlight-overlay (point)

src/ext/popup-menu.lisp

@@ -32,13 +32,7 @@
   (buffer-point (popup-menu-buffer popup-menu)))
 
 (defun make-focus-overlay (point focus-attribute)
-  (with-point ((start point)
-               (end point))
-    (line-start start)
-    (line-end end)
-    (let ((ov (make-overlay start end focus-attribute)))
-      (overlay-put ov :display-line t)
-      ov)))
+  (make-overlay-line point focus-attribute))
 
 (defun update-focus-overlay (popup-menu point)
   (delete-overlay (popup-menu-focus-overlay popup-menu))

src/internal-packages.lisp

@@ -415,6 +415,7 @@
    :overlay-buffer
    :make-overlay
    :make-overlay-line-endings
+   :make-overlay-line
    :delete-overlay
    :overlay-put
    :overlay-get

src/overlay.lisp

@@ -1,7 +1,10 @@
 (in-package :lem-core)
 
-(defclass <overlay> ()
-  ((start
+(defclass overlay ()
+  ((temporary
+    :initarg :temporary
+    :reader overlay-temporary-p)
+   (start
     :initarg :start
     :reader overlay-start
     :type point)
@@ -27,10 +30,6 @@
     :accessor overlay-alive-p
     :type boolean)))
 
-(defclass temporary-overlay (<overlay>) ())
-
-(defclass overlay (<overlay>) ())
-
 (defclass overlay-line-endings (overlay)
   ((offset :initarg :offset
            :initform 0
@@ -39,24 +38,28 @@
          :initform (alexandria:required-argument :text)
          :accessor overlay-line-endings-text)))
 
-(defmethod initialize-instance ((overlay <overlay>) &key &allow-other-keys)
+(defclass overlay-line (overlay)
+  ())
+
+(defmethod initialize-instance ((overlay overlay) &key &allow-other-keys)
   (let ((overlay (call-next-method)))
     (with-slots (start end attribute) overlay
       (when (point< end start) (rotatef start end))
       (setf attribute (ensure-attribute attribute t)))
+    (unless (overlay-temporary-p overlay)
+      (push overlay (buffer-value (overlay-buffer overlay) 'overlays)))
     overlay))
 
-(defmethod initialize-instance :after ((overlay overlay) &key &allow-other-keys)
-  (push overlay (buffer-value (overlay-buffer overlay) 'overlays)))
-
 (defun make-overlay (start end attribute
                      &key (start-point-kind :right-inserting)
-                          (end-point-kind :left-inserting))
+                          (end-point-kind :left-inserting)
+                          temporary)
   (make-instance 'overlay
                  :start (copy-point start start-point-kind)
                  :end (copy-point end end-point-kind)
                  :attribute attribute
-                 :buffer (point-buffer start)))
+                 :buffer (point-buffer start)
+                 :temporary temporary))
 
 (defun make-overlay-line-endings (start end attribute
                                   &key (start-point-kind :right-inserting)
@@ -71,10 +74,19 @@
                  :text text
                  :offset offset))
 
+(defun make-overlay-line (point attribute &key (temporary nil))
+  (with-point ((point point))
+    (make-instance 'overlay-line
+                   :start point
+                   :end point
+                   :attribute attribute
+                   :buffer (point-buffer point)
+                   :temporary temporary)))
+
 (defun delete-overlay (overlay)
   (check-type overlay overlay)
   (when (and (overlay-alive-p overlay)
-             (not (typep overlay 'temporary-overlay)))
+             (not (overlay-temporary-p overlay)))
     (delete-point (overlay-start overlay))
     (delete-point (overlay-end overlay))
     (let ((buffer (overlay-buffer overlay)))