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

Merge pull request #28 from pankajgodbole/main

Browse source 
Added GUI window pin/unpin
This commit is contained in:
David Botton 2021-02-19 13:45:42 -05:00 • committed by GitHub
commit 61ea6e0a22
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 57 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

44
source/clog-gui.lisp
View file

@ -474,6 +474,9 @@ The on-window-change clog-obj received is the new window"))
(content
:accessor content
:documentation "Window body clog-element")
(pinner
:accessor pinner
:documentation "Window pinner clog-element")
(closer
:accessor closer
:documentation "Window closer clog-element")
@ -496,6 +499,10 @@ The on-window-change clog-obj received is the new window"))
:accessor last-y
:initform nil
:documentation "Last y before maximize")
(pinned-p
:accessor pinned-p
:initform nil
:documentation "Returns true if this window is pinned and false otherwise")
(keep-on-top
:accessor keep-on-top
:initform nil
@ -687,6 +694,8 @@ on-window-resize-done at end of resize."))
style='flex-container;display:flex;align-items:stretch;'>
<span data-drag-obj='~A' data-drag-type='m' id='~A-title'
style='flex-grow:9;user-select:none;cursor:move;'>~A</span>
<span id='~A-pinner'
style='cursor:pointer;user-select:none;'>(Un)pin&nbsp;&nbsp;&nbsp;</span>
<span id='~A-closer'
style='cursor:pointer;user-select:none;'>&times;</span>
</div>
@ -697,7 +706,9 @@ on-window-resize-done at end of resize."))
</div>"
top left width height (incf (last-z app)) ; outer div
html-id html-id html-id ; title bar
title html-id ; title
title ; title
html-id ; pinner
html-id ; closer
html-id content ; body
html-id html-id) ; size
:clog-type 'clog-gui-window
@ -706,6 +717,7 @@ on-window-resize-done at end of resize."))
(attach-as-child win (format nil "~A-title" html-id)))
(setf (title-bar win)
(attach-as-child win (format nil "~A-title-bar" html-id)))
(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 (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)))
@ -722,6 +734,9 @@ on-window-resize-done at end of resize."))
(set-on-double-click (win-title win) (lambda (obj)
(declare (ignore obj))
(window-toggle-maximize win)))
(set-on-click (pinner win) (lambda (obj)
(declare (ignore obj))
(window-toggle-pin win)))
(set-on-click (closer win) (lambda (obj)
(declare (ignore obj))
(when (fire-on-window-can-close win)
@ -879,6 +894,33 @@ on-window-resize-done at end of resize."))
(window-normalize obj)
(window-maximize obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; window-toggle-pinned ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric window-toggle-pin (clog-gui-window)
(:documentation "Toggle the pinned state of a CLOG-GUI-WINDOW. A pinned window
cannot be moved, closed, resized, maximized or normalized. A new window is
always unpinned."))
(defmethod window-toggle-pin ((win clog-gui-window))
(if (pinned-p win)
;; Toggle the pinned state of this window
(progn
(setf (pinned-p 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))))
(setf (pinned-p 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))))
;;;;;;;;;;;;;;;;;;;;;;;;
;; window-keep-on-top ;;
;;;;;;;;;;;;;;;;;;;;;;;;