move definitions

lem-project · Dec 30, 2023 · f3057e4 · f3057e4
1 parent f54779e
commit f3057e4
Show file tree

Hide file tree

Showing 5 changed files with 59 additions and 77 deletions.
diff --git a/frontends/ncurses/lem-ncurses.asd b/frontends/ncurses/lem-ncurses.asd
@@ -15,5 +15,5 @@
                (:file "drawing-object")
                (:file "view")
                (:file "input")
-               (:file "internal")
+               (:file "mainloop")
                (:file "ncurses")))
diff --git a/frontends/ncurses/internal.lisp → frontends/ncurses/mainloop.lisp b/frontends/ncurses/internal.lisp → frontends/ncurses/mainloop.lisp
@@ -1,17 +1,7 @@
-(defpackage :lem-ncurses/internal
-  (:use :cl
-        :lem
-        :lem-ncurses/style
-        :lem-ncurses/key
-        :lem-ncurses/view)
-  (:export
-   :*terminal-io-saved*
-   ;; ncurses-pdcurseswin32.lisp
-   :input-polling-interval))
-(in-package :lem-ncurses/internal)
-
-;; for mouse control
-(defparameter *terminal-io-saved* *terminal-io*)
+(defpackage :lem-ncurses/mainloop
+  (:use :cl :lem)
+  (:export :invoke))
+(in-package :lem-ncurses/mainloop)
 
 (define-condition exit (editor-condition)
   ((value
@@ -55,37 +45,3 @@
     (when (and (typep result 'exit)
                (exit-editor-value result))
       (format t "~&~A~%" (exit-editor-value result)))))
-
-(defun get-background-color ()
-  (lem-ncurses/term:background-mode))
-
-(defun update-foreground-color (color-name)
-  (lem-ncurses/term:term-set-foreground color-name))
-
-(defun update-background-color (color-name)
-  (lem-ncurses/term:term-set-background color-name))
-
-(defun update-cursor-shape (cursor-type)
-  (uiop:run-program `("printf"
-                      ,(format nil "~C[~D q"
-                               #\Esc
-                               (case cursor-type
-                                 (:box 2)
-                                 (:bar 5)
-                                 (:underline 4)
-                                 (otherwise 2))))
-                    :output :interactive
-                    :ignore-error-status t))
-
-(defun get-display-width ()
-  (max 5 charms/ll:*cols*))
-
-(defun get-display-height ()
-  (max 3 charms/ll:*lines*))
-
-(defun get-char-width ()
-  1)
-
-(defun update-display ()
-  (update-view (window-view (current-window)))
-  (charms/ll:doupdate))
diff --git a/frontends/ncurses/ncurses.lisp b/frontends/ncurses/ncurses.lisp
@@ -1,13 +1,11 @@
 (uiop:define-package :lem-ncurses
   (:use :cl)
-  (:use-reexport :lem-ncurses/internal)
-  (:use-reexport :lem-ncurses/config))
+  (:use-reexport :lem-ncurses/config)
+  (:export :*terminal-io-saved*
+           ;; ncurses-pdcurseswin32.lisp
+           :input-polling-interval))
 (in-package :lem-ncurses)
 
-;; popup window margin setting
-(setf lem/popup-window::*extra-right-margin* 1)
-(setf lem/popup-window::*extra-width-margin* 0)
-
 (pushnew :lem-ncurses *features*)
 
 (defclass ncurses (lem:implementation)
@@ -17,31 +15,30 @@
    :redraw-after-modifying-floating-window t))
 
 (defmethod lem-if:invoke ((implementation ncurses) function)
-  (lem-ncurses/internal::invoke function))
+  (lem-ncurses/mainloop:invoke function))
 
 (defmethod lem-if:get-background-color ((implementation ncurses))
-  (lem-ncurses/internal::get-background-color))
+  (lem-ncurses/term:background-color))
 
 (defmethod lem-if:update-background ((implementation ncurses) color-name)
-  (lem-ncurses/internal::update-background-color color-name))
+  (lem-ncurses/term:set-background color-name))
 
 (defmethod lem-if:update-foreground ((implementation ncurses) color-name)
-  (lem-ncurses/internal::update-foreground-color color-name))
+  (lem-ncurses/term:set-foreground color-name))
 
 (defmethod lem-if:update-cursor-shape ((implementation ncurses) cursor-type)
-  (lem-ncurses/internal::update-cursor-shape cursor-type))
+  (lem-ncurses/term:update-cursor-shape cursor-type))
 
 (defmethod lem-if:update-background ((implementation ncurses) color-name)
-  (lem-ncurses/internal::update-background-color color-name))
+  (lem-ncurses/term:set-background color-name))
 
 (defmethod lem-if:display-width ((implementation ncurses))
-  (lem-ncurses/internal::get-display-width))
+  (lem-ncurses/term:get-display-width))
 
 (defmethod lem-if:display-height ((implementation ncurses))
-  (lem-ncurses/internal::get-display-height))
+  (lem-ncurses/term:get-display-height))
 
-(defmethod lem-if:make-view
-    ((implementation ncurses) window x y width height use-modeline)
+(defmethod lem-if:make-view ((implementation ncurses) window x y width height use-modeline)
   (lem-ncurses/view:make-view window x y width height use-modeline))
 
 (defmethod lem-if:delete-view ((implementation ncurses) view)
@@ -60,7 +57,7 @@
   (lem-ncurses/view:redraw-view-after view))
 
 (defmethod lem-if:update-display ((implementation ncurses))
-  (lem-ncurses/internal::update-display))
+  (lem-ncurses/view:update-cursor (lem:window-view (lem:current-window))))
 
 (defmethod lem-if:clipboard-paste ((implementation ncurses))
   (lem-ncurses/clipboard:paste))
@@ -96,4 +93,11 @@
   (lem-ncurses/view:clear-to-end-of-window view y))
 
 (defmethod lem-if:get-char-width ((implementation ncurses))
-  (lem-ncurses/internal::get-char-width))
+  1)
+
+;; for mouse control
+(defparameter *terminal-io-saved* *terminal-io*)
+
+;; popup window margin setting
+(setf lem/popup-window::*extra-right-margin* 1)
+(setf lem/popup-window::*extra-width-margin* 0)
diff --git a/frontends/ncurses/term.lisp b/frontends/ncurses/term.lisp
@@ -1,17 +1,20 @@
 (defpackage :lem-ncurses/term
   (:use :cl)
   (:export :get-color-pair
-           :term-set-foreground
-           :term-set-background
-           :background-mode
+           :set-foreground
+           :set-background
+           :background-color
            :term-init
            :term-finalize
            :term-set-tty
            :term-set-color
            ;;win32 patch
            :get-mouse-mode
            :enable-mouse
-           :disable-mouse))
+           :disable-mouse
+           :update-cursor-shape
+           :get-display-width
+           :get-display-height))
 (in-package :lem-ncurses/term)
 
 (cffi:defcvar ("COLOR_PAIRS" *COLOR-PAIRS* :library charms/ll::libcurses) :int)
@@ -397,7 +400,7 @@
     (charms/ll:assume-default-colors fg-color
                                      bg-color)))
 
-(defun term-set-foreground (name)
+(defun set-foreground (name)
   (multiple-value-bind (fg found) (get-color name)
     (let ((bg (nth-value 1 (get-default-colors))))
       (cond (found
@@ -406,7 +409,7 @@
             (t
              (error "Undefined color: ~A" name))))))
 
-(defun term-set-background (name)
+(defun set-background (name)
   (multiple-value-bind (bg found) (get-color name)
     (let ((fg (nth-value 0 (get-default-colors))))
       (cond (found
@@ -415,7 +418,7 @@
             (t
              (error "Undefined color: ~A" name))))))
 
-(defun background-mode ()
+(defun background-color ()
   (let ((b (nth-value 1 (get-default-colors))))
     (cond ((= b -1) (lem:make-color 0 0 0))
           (t
@@ -493,3 +496,21 @@
     (setf *term-io* nil))
   (charms/ll:endwin)
   (charms/ll:delscreen charms/ll:*stdscr*))
+
+(defun update-cursor-shape (cursor-type)
+  (uiop:run-program `("printf"
+                      ,(format nil "~C[~D q"
+                               #\Esc
+                               (case cursor-type
+                                 (:box 2)
+                                 (:bar 5)
+                                 (:underline 4)
+                                 (otherwise 2))))
+                    :output :interactive
+                    :ignore-error-status t))
+
+(defun get-display-width ()
+  (max 5 charms/ll:*cols*))
+
+(defun get-display-height ()
+  (max 3 charms/ll:*lines*))
diff --git a/frontends/ncurses/view.lisp b/frontends/ncurses/view.lisp
@@ -19,7 +19,7 @@
            :render-line
            :render-line-on-modeline
            :clear-to-end-of-window
-           :update-view))
+           :update-cursor))
 (in-package :lem-ncurses/view)
 
 (defclass view ()
@@ -257,7 +257,7 @@
       (charms/ll:wmove win y 0)
       (charms/ll:wclrtobot win))))
 
-(defun update-view (view)
+(defun update-cursor (view)
   (let* ((window (view-window view))
          (cursor-x (last-print-cursor-x window))
          (cursor-y (last-print-cursor-y window))
@@ -269,4 +269,5 @@
           (t
            (charms/ll:curs-set 1)
            (charms/ll:wmove scrwin cursor-y cursor-x)))
-    (charms/ll:wnoutrefresh scrwin)))
+    (charms/ll:wnoutrefresh scrwin)
+    (charms/ll:doupdate)))