mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

better handling pinned and on top

Browse source
This commit is contained in:
David Botton 2024-03-22 14:53:32 -04:00
parent 204a03618b
commit d44dfc9f6e
2 changed files with 54 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

47
source/clog-gui.lisp
View file

@ -59,6 +59,7 @@
(window-maximize generic-function) (window-maximize generic-function)
(window-normalize generic-function) (window-normalize generic-function)
(window-toggle-maximize generic-function) (window-toggle-maximize generic-function)
(window-toggle-pinned generic-function)
(window-keep-on-top generic-function) (window-keep-on-top generic-function)
(window-make-modal generic-function) (window-make-modal generic-function)
(window-end-modal generic-function) (window-end-modal generic-function)
@ -826,7 +827,7 @@ use jquery-ui to move/resize and will not work on mobile and touch events
are limitted to clicks. When client-movement is t only on-window-move is fired are limitted to clicks. When client-movement is t only on-window-move is fired
once at start of drag and on-window-move-done at end of drag and once at start of drag and on-window-move-done at end of drag and
on-window-resize at start of resize and on-window-resize-done at end of resize. on-window-resize at start of resize and on-window-resize-done at end of resize.
If has-pinner a toggle wil appear on title bar to allow pinning the window in If has-pinner a toggle will appear on title bar to allow pinning the window in
place, if keep-on-top t then when pinned also will keep-on-top. If had-pinned place, if keep-on-top t then when pinned also will keep-on-top. If had-pinned
is nil and keep-on-top t then the window will be set to keep-on-top always. is nil and keep-on-top t then the window will be set to keep-on-top always.
window-param is a general parameter for identifiying the window to use with window-param is a general parameter for identifiying the window to use with
@ -929,7 +930,7 @@ window-to-top-by-param or window-by-param."))
(if has-pinner (if has-pinner
(set-on-click (pinner win) (lambda (obj) (set-on-click (pinner win) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(window-toggle-pin win keep-on-top))) (window-toggle-pinned win :keep-on-top keep-on-top)))
(when keep-on-top (when keep-on-top
(window-keep-on-top win))) (window-keep-on-top win)))
(set-on-click (closer win) (lambda (obj) (set-on-click (closer win) (lambda (obj)
@ -1128,48 +1129,56 @@ the browser."))
;; window-toggle-pinned ;; ;; window-toggle-pinned ;;
;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric window-toggle-pin (clog-gui-window keep-on-top) (defgeneric window-toggle-pinned (clog-gui-window &key state keep-on-top)
(:documentation "Toggle the pinned state of a CLOG-GUI-WINDOW. A pinned (:documentation "Toggle the pinned state of a CLOG-GUI-WINDOW. A pinned
window cannot be moved, closed, resized, maximized or normalized and if window cannot be moved, closed, resized, maximized or normalized. A new
keep-on-top t when pinned is always on top. A new window is always unpinned.")) window is always unpinned. If keep-on-top the keep-on-top state is toggled
to match the pinned state. :state forces state. Returns new state"))
(defmethod window-toggle-pin ((win clog-gui-window) keep-on-top) (defmethod window-toggle-pinned ((win clog-gui-window) &key (state :toggle)
(if (pinnedp win) keep-on-top)
(if (or (eq state nil)
(and (eq state :toggle)
(pinnedp win)))
(progn (progn
(when (pinner win) (when (pinner win)
(setf (inner-html (pinner win)) "☐")) (setf (inner-html (pinner win)) "☐"))
(when keep-on-top (when keep-on-top
(setf (keep-on-top win) nil) (window-keep-on-top win :state nil))
(window-focus win))
(setf (pinnedp win) nil) (setf (pinnedp win) nil)
(set-on-window-can-close win nil) (set-on-window-can-close win nil)
(set-on-window-can-size win nil) (set-on-window-can-size win nil)
(set-on-window-can-move win nil) (set-on-window-can-move win nil)
(set-on-window-can-maximize win nil) (set-on-window-can-maximize win nil)
(set-on-window-can-normalize win nil)) (set-on-window-can-normalize win nil)
(flet ((no-op (obj) (declare (ignore obj)))) nil)
(flet ((no-op (obj) (declare (ignore obj)) nil))
(when (pinner win) (when (pinner win)
(setf (inner-html (pinner win)) "☑")) (setf (inner-html (pinner win)) "☑"))
(when keep-on-top (when keep-on-top
(setf (keep-on-top win) t) (window-keep-on-top win))
(setf (z-index win) 1))
(setf (pinnedp win) t) (setf (pinnedp win) t)
(set-on-window-can-close win #'no-op) (set-on-window-can-close win #'no-op)
(set-on-window-can-size win #'no-op) (set-on-window-can-size win #'no-op)
(set-on-window-can-move win #'no-op) (set-on-window-can-move win #'no-op)
(set-on-window-can-maximize win #'no-op) (set-on-window-can-maximize win #'no-op)
(set-on-window-can-normalize win #'no-op)))) (set-on-window-can-normalize win #'no-op)
t)))
;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;
;; window-keep-on-top ;; ;; window-keep-on-top ;;
;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric window-keep-on-top (clog-gui-window) (defgeneric window-keep-on-top (clog-gui-window &key state)
(:documentation "Set CLOG-GUI-WINDOW to stay on top. Use window-focus to undue.")) (:documentation "Set CLOG-GUI-WINDOW to stay on top based on state (default t)."))
(defmethod window-keep-on-top ((obj clog-gui-window)) (defmethod window-keep-on-top ((obj clog-gui-window) &key (state t))
(setf (keep-on-top obj) t) (cond (state
(setf (z-index obj) 1)) (setf (keep-on-top obj) t)
(setf (z-index obj) 1))
(t
(setf (keep-on-top obj) nil)
(window-focus obj))))
;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;
;; window-make-modal ;; ;; window-make-modal ;;

27
tutorial/22-tutorial.lisp
View file

@ -50,7 +50,29 @@
:source "https://www.w3schools.com/html/mov_bbb.mp4"))) :source "https://www.w3schools.com/html/mov_bbb.mp4")))
(set-geometry movie :units "%" :width 100 :height 100))) (set-geometry movie :units "%" :width 100 :height 100)))
(defun on-file-on-top (obj)
(let ((win (create-gui-window obj :title "Pin me!"
:has-pinner nil
:keep-on-top t
:top 200
:left 0
:width 200
:height 200)))
(create-div (window-content win)
:content "I am always on top")))
(defun on-file-pinned (obj) (defun on-file-pinned (obj)
(let ((win (create-gui-window obj :title "Pin me!"
:has-pinner t
:keep-on-top nil
:top 200
:left 0
:width 200
:height 200)))
(create-div (window-content win)
:content "I can be pinned but do not stay on top. Just click the pin on window bar.")))
(defun on-file-pinned-on-top (obj)
(let ((win (create-gui-window obj :title "Pin me!" (let ((win (create-gui-window obj :title "Pin me!"
:has-pinner t :has-pinner t
:keep-on-top t :keep-on-top t
@ -58,7 +80,8 @@
:left 0 :left 0
:width 200 :width 200
:height 200))) :height 200)))
(create-div win :content "I can be pinned. Just click the pin on window bar."))) (create-div (window-content win)
:content "I can be pinned and stay on top. Just click the pin on window bar.")))
(defun on-file-pop-tab (obj) (defun on-file-pop-tab (obj)
(let ((pop (open-clog-popup obj))) (let ((pop (open-clog-popup obj)))
@ -170,7 +193,9 @@
(tmp (create-gui-menu-item file :content "Browse" :on-click 'on-file-browse)) (tmp (create-gui-menu-item file :content "Browse" :on-click 'on-file-browse))
(tmp (create-gui-menu-item file :content "Drawing" :on-click 'on-file-drawing)) (tmp (create-gui-menu-item file :content "Drawing" :on-click 'on-file-drawing))
(tmp (create-gui-menu-item file :content "Movie" :on-click 'on-file-movies)) (tmp (create-gui-menu-item file :content "Movie" :on-click 'on-file-movies))
(tmp (create-gui-menu-item file :content "Always on Top" :on-click 'on-file-on-top))
(tmp (create-gui-menu-item file :content "Pinned" :on-click 'on-file-pinned)) (tmp (create-gui-menu-item file :content "Pinned" :on-click 'on-file-pinned))
(tmp (create-gui-menu-item file :content "Pinned and on Always Top" :on-click 'on-file-pinned-on-top))
(tmp (create-gui-menu-item file :content "Popup Browser Tab" :on-click 'on-file-pop-tab)) (tmp (create-gui-menu-item file :content "Popup Browser Tab" :on-click 'on-file-pop-tab))
(tmp (create-gui-menu-item file :content "Popup Browser Window" :on-click 'on-file-pop-win)) (tmp (create-gui-menu-item file :content "Popup Browser Window" :on-click 'on-file-pop-win))
(win (create-gui-menu-drop-down menu :content "Window")) (win (create-gui-menu-drop-down menu :content "Window"))