mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2026-01-04 00:02:57 -08:00
Code Issues Projects Releases Wiki Activity

pinning keep-on-top optional

Browse source
This commit is contained in:
David Botton 2021-02-21 12:05:32 -05:00
parent 9bf04093e1
commit 9bea142c58
2 changed files with 28 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

35
source/clog-gui.lisp
View file

@ -648,6 +648,7 @@ The on-window-change clog-obj received is the new window"))
left top width height left top width height
maximize maximize
has-pinner has-pinner
keep-on-top
hidden hidden
client-movement client-movement
html-id) html-id)
@ -655,7 +656,10 @@ The on-window-change clog-obj received is the new window"))
use jquery-ui to move/resize and will not work on mobile. When client-movement use jquery-ui to move/resize and will not work on mobile. When client-movement
is t only on-window-move is fired once at start of drag and on-window-move-done 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 at end of drag and on-window-resize at start of resize and
on-window-resize-done at end of resize.")) on-window-resize-done at end of resize. If has-pinner a toggle wil 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."))
(defmethod create-gui-window ((obj clog-obj) &key (title "New Window") (defmethod create-gui-window ((obj clog-obj) &key (title "New Window")
(content "") (content "")
@ -665,6 +669,7 @@ on-window-resize-done at end of resize."))
(height 200) (height 200)
(maximize nil) (maximize nil)
(has-pinner nil) (has-pinner nil)
(keep-on-top nil)
(hidden nil) (hidden nil)
(client-movement nil) (client-movement nil)
(html-id nil)) (html-id nil))
@ -740,10 +745,12 @@ on-window-resize-done at end of resize."))
(set-on-double-click (win-title win) (lambda (obj) (set-on-double-click (win-title win) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(window-toggle-maximize win))) (window-toggle-maximize win)))
(when 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)))) (window-toggle-pin win keep-on-top)))
(when keep-on-top
(window-keep-on-top win)))
(set-on-click (closer win) (lambda (obj) (set-on-click (closer win) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (fire-on-window-can-close win) (when (fire-on-window-can-close win)
@ -907,18 +914,19 @@ the browser."))
;; window-toggle-pinned ;; ;; window-toggle-pinned ;;
;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric window-toggle-pin (clog-gui-window) (defgeneric window-toggle-pin (clog-gui-window 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 is window cannot be moved, closed, resized, maximized or normalized and if
always on top. A new window is always unpinned.")) keep-on-top t when pinned is always on top. A new window is always unpinned."))
(defmethod window-toggle-pin ((win clog-gui-window)) (defmethod window-toggle-pin ((win clog-gui-window) keep-on-top)
(if (pinnedp win) (if (pinnedp win)
(progn (progn
(when (pinner win) (when (pinner win)
(setf (inner-html (pinner win)) "☐")) (setf (inner-html (pinner win)) "☐"))
(setf (keep-on-top win) nil) (when keep-on-top
(window-focus win) (setf (keep-on-top win) 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)
@ -928,8 +936,9 @@ always on top. A new window is always unpinned."))
(flet ((no-op (obj) (declare (ignore obj)))) (flet ((no-op (obj) (declare (ignore obj))))
(when (pinner win) (when (pinner win)
(setf (inner-html (pinner win)) "☑")) (setf (inner-html (pinner win)) "☑"))
(setf (keep-on-top win) t) (when keep-on-top
(setf (z-index win) 1) (setf (keep-on-top win) t)
(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)

11
tutorial/22-tutorial.lisp
View file

@ -44,11 +44,12 @@
(defun on-file-pinned (obj) (defun on-file-pinned (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
:top 200 :keep-on-top t
:left 0 :top 200
:width 200 :left 0
:height 200))) :width 200
:height 200)))
(create-div win :content "I can be pinned. Just click the pin on window bar."))) (create-div win :content "I can be pinned. Just click the pin on window bar.")))
(defun on-dlg-alert (obj) (defun on-dlg-alert (obj)