Added has-pin option on title bar

This commit is contained in:
David Botton 2021-02-19 14:29:54 -05:00
parent 90aa969fd1
commit 19adb38982
2 changed files with 33 additions and 30 deletions

View file

@ -476,7 +476,8 @@ The on-window-change clog-obj received is the new window"))
:documentation "Window body clog-element") :documentation "Window body clog-element")
(pinner (pinner
:accessor pinner :accessor pinner
:documentation "Window pinner clog-element") :initform nil
:documentation "Window pinner clog-element if created with has-pinner")
(closer (closer
:accessor closer :accessor closer
:documentation "Window closer clog-element") :documentation "Window closer clog-element")
@ -499,10 +500,10 @@ The on-window-change clog-obj received is the new window"))
:accessor last-y :accessor last-y
:initform nil :initform nil
:documentation "Last y before maximize") :documentation "Last y before maximize")
(pinned-p (pinnedp
:accessor pinned-p :accessor pinnedp
:initform nil :initform nil
:documentation "Returns true if this window is pinned and false otherwise") :documentation "True if this window is pinned and nil otherwise")
(keep-on-top (keep-on-top
:accessor keep-on-top :accessor keep-on-top
:initform nil :initform nil
@ -646,6 +647,7 @@ The on-window-change clog-obj received is the new window"))
content content
left top width height left top width height
maximize maximize
has-pinner
hidden hidden
client-movement client-movement
html-id) html-id)
@ -662,6 +664,7 @@ on-window-resize-done at end of resize."))
(width 300) (width 300)
(height 200) (height 200)
(maximize nil) (maximize nil)
(has-pinner nil)
(hidden nil) (hidden nil)
(client-movement nil) (client-movement nil)
(html-id nil)) (html-id nil))
@ -693,9 +696,7 @@ on-window-resize-done at end of resize."))
<div id='~A-title-bar' class='w3-container w3-black' <div id='~A-title-bar' class='w3-container w3-black'
style='flex-container;display:flex;align-items:stretch;'> style='flex-container;display:flex;align-items:stretch;'>
<span data-drag-obj='~A' data-drag-type='m' id='~A-title' <span data-drag-obj='~A' data-drag-type='m' id='~A-title'
style='flex-grow:9;user-select:none;cursor:move;'>~A</span> style='flex-grow:9;user-select:none;cursor:move;'>~A</span>~A
<span id='~A-pinner'
style='cursor:pointer;user-select:none;'>(Un)pin&nbsp;&nbsp;&nbsp;</span>
<span id='~A-closer' <span id='~A-closer'
style='cursor:pointer;user-select:none;'>&times;</span> style='cursor:pointer;user-select:none;'>&times;</span>
</div> </div>
@ -704,20 +705,25 @@ on-window-resize-done at end of resize."))
cursor:se-resize;opacity:0' cursor:se-resize;opacity:0'
class='w3-right' data-drag-obj='~A' data-drag-type='s'>+</div> class='w3-right' data-drag-obj='~A' data-drag-type='s'>+</div>
</div>" </div>"
top left width height (incf (last-z app)) ; outer div top left width height (incf (last-z app)) ; outer div
html-id html-id html-id ; title bar html-id html-id html-id ; title bar
title ; title title ; title
html-id ; pinner (if has-pinner ; pinner
html-id ; closer (format nil "<span id='~A-pinner'
html-id content ; body style='cursor:pointer;user-select:none;'>
html-id html-id) ; size (Un)pin&nbsp;&nbsp;&nbsp;</span>" html-id)
"")
html-id ; closer
html-id content ; body
html-id html-id) ; size
:clog-type 'clog-gui-window :clog-type 'clog-gui-window
:html-id html-id))) :html-id html-id)))
(setf (win-title win) (setf (win-title win)
(attach-as-child win (format nil "~A-title" html-id))) (attach-as-child win (format nil "~A-title" html-id)))
(setf (title-bar win) (setf (title-bar win)
(attach-as-child win (format nil "~A-title-bar" html-id))) (attach-as-child win (format nil "~A-title-bar" html-id)))
(setf (pinner win) (attach-as-child win (format nil "~A-pinner" html-id))) (when has-pinner
(setf (pinner win) (attach-as-child win (format nil "~A-pinner" html-id))))
(setf (closer win) (attach-as-child win (format nil "~A-closer" html-id))) (setf (closer win) (attach-as-child win (format nil "~A-closer" html-id)))
(setf (sizer win) (attach-as-child win (format nil "~A-sizer" html-id))) (setf (sizer win) (attach-as-child win (format nil "~A-sizer" html-id)))
(setf (content win) (attach-as-child win (format nil "~A-body" html-id))) (setf (content win) (attach-as-child win (format nil "~A-body" html-id)))
@ -734,9 +740,10 @@ 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)))
(set-on-click (pinner win) (lambda (obj) (when has-pinner
(declare (ignore obj)) (set-on-click (pinner win) (lambda (obj)
(window-toggle-pin win))) (declare (ignore obj))
(window-toggle-pin 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)
@ -904,17 +911,17 @@ cannot be moved, closed, resized, maximized or normalized. A new window is
always unpinned.")) always unpinned."))
(defmethod window-toggle-pin ((win clog-gui-window)) (defmethod window-toggle-pin ((win clog-gui-window))
(if (pinned-p win) (if (pinnedp win)
;; Toggle the pinned state of this window ;; Toggle the pinned state of this window
(progn (progn
(setf (pinned-p 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)))) (flet ((no-op (obj) (declare (ignore obj))))
(setf (pinned-p 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)

View file

@ -43,17 +43,13 @@
(setf (box-height movie) "100%"))) (setf (box-height movie) "100%")))
(defun on-file-pinned (obj) (defun on-file-pinned (obj)
(let ((win (create-gui-window obj :title "Pinned" (let ((win (create-gui-window obj :title "Pin me!"
:has-pinner t
:top 200 :top 200
:left 0 :left 0
:width 100 :width 200
:height 100))) :height 200)))
(flet ((can-not-do (obj)(declare (ignore obj))())) (create-div win :content "I can be pinned. Just click the pin on window bar.")))
(set-on-window-can-maximize win #'can-not-do)
(set-on-window-can-close win #'can-not-do)
(set-on-window-can-size win #'can-not-do))
(window-keep-on-top win)
(create-div win :content "I am pinned")))
(defun on-dlg-alert (obj) (defun on-dlg-alert (obj)
(alert-dialog obj "This is a modal alert box")) (alert-dialog obj "This is a modal alert box"))