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-normalize generic-function)
(window-toggle-maximize generic-function)
(window-toggle-pinned generic-function)
(window-keep-on-top generic-function)
(window-make-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
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.
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
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
@ -929,7 +930,7 @@ window-to-top-by-param or window-by-param."))
(if has-pinner
(set-on-click (pinner win) (lambda (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
(window-keep-on-top win)))
(set-on-click (closer win) (lambda (obj)
@ -1128,48 +1129,56 @@ the browser."))
;; 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
window cannot be moved, closed, resized, maximized or normalized and if
keep-on-top t when pinned is always on top. A new window is always unpinned."))
window cannot be moved, closed, resized, maximized or normalized. A new
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)
(if (pinnedp win)
(defmethod window-toggle-pinned ((win clog-gui-window) &key (state :toggle)
keep-on-top)
(if (or (eq state nil)
(and (eq state :toggle)
(pinnedp win)))
(progn
(when (pinner win)
(setf (inner-html (pinner win)) "☐"))
(when keep-on-top
(setf (keep-on-top win) nil)
(window-focus win))
(window-keep-on-top win :state nil))
(setf (pinnedp win) nil)
(set-on-window-can-close win nil)
(set-on-window-can-size win nil)
(set-on-window-can-move win nil)
(set-on-window-can-maximize win nil)
(set-on-window-can-normalize win nil))
(flet ((no-op (obj) (declare (ignore obj))))
(set-on-window-can-normalize win nil)
nil)
(flet ((no-op (obj) (declare (ignore obj)) nil))
(when (pinner win)
(setf (inner-html (pinner win)) "☑"))
(when keep-on-top
(setf (keep-on-top win) t)
(setf (z-index win) 1))
(window-keep-on-top win))
(setf (pinnedp win) t)
(set-on-window-can-close win #'no-op)
(set-on-window-can-size win #'no-op)
(set-on-window-can-move 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 ;;
;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric window-keep-on-top (clog-gui-window)
(:documentation "Set CLOG-GUI-WINDOW to stay on top. Use window-focus to undue."))
(defgeneric window-keep-on-top (clog-gui-window &key state)
(:documentation "Set CLOG-GUI-WINDOW to stay on top based on state (default t)."))
(defmethod window-keep-on-top ((obj clog-gui-window))
(setf (keep-on-top obj) t)
(setf (z-index obj) 1))
(defmethod window-keep-on-top ((obj clog-gui-window) &key (state t))
(cond (state
(setf (keep-on-top obj) t)
(setf (z-index obj) 1))
(t
(setf (keep-on-top obj) nil)
(window-focus obj))))
;;;;;;;;;;;;;;;;;;;;;;;
;; window-make-modal ;;

27
tutorial/22-tutorial.lisp
View file

@ -50,7 +50,29 @@
:source "https://www.w3schools.com/html/mov_bbb.mp4")))
(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)
(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!"
:has-pinner t
:keep-on-top t
@ -58,7 +80,8 @@
:left 0
:width 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)
(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 "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 "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 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 Window" :on-click 'on-file-pop-win))
(win (create-gui-menu-drop-down menu :content "Window"))