mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 10:40:45 -08:00
switch to window if one exists instead of create new one
This commit is contained in:
parent
55a9e112e7
commit
b8fe23950e
2 changed files with 634 additions and 528 deletions
|
|
@ -39,6 +39,10 @@
|
|||
(menu-bar generic-function)
|
||||
(menu-bar-height generic-function)
|
||||
(window-collection generic-function)
|
||||
(window-to-top-by-title generic-function)
|
||||
(window-to-top-by-param generic-function)
|
||||
(window-by-title generic-function)
|
||||
(window-by-param generic-function)
|
||||
(maximize-all-windows generic-function)
|
||||
(normalize-all-windows generic-function)
|
||||
(set-on-window-change generic-function)
|
||||
|
|
@ -47,6 +51,7 @@
|
|||
(clog-gui-window class)
|
||||
(create-gui-window generic-function)
|
||||
(window-title generic-function)
|
||||
(window-param generic-function)
|
||||
(window-content generic-function)
|
||||
(window-focus generic-function)
|
||||
(window-close generic-function)
|
||||
|
|
@ -250,6 +255,80 @@ create-gui-menu-bar."))
|
|||
(let ((app (connection-data-item obj "clog-gui")))
|
||||
(windows app)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; window-to-top-by-title ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric window-to-top-by-title (clog-obj title)
|
||||
(:documentation "Bring window with TITLE to top and return
|
||||
window or nil if not found"))
|
||||
|
||||
(defmethod window-to-top-by-title ((obj clog-obj) title)
|
||||
(let ((app (connection-data-item obj "clog-gui"))
|
||||
(r nil))
|
||||
(maphash (lambda (key value)
|
||||
(declare (ignore key))
|
||||
(when (equalp (window-title value) title)
|
||||
(window-focus value)
|
||||
(setf r key)))
|
||||
(windows app))
|
||||
r))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; window-to-top-by-param ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric window-to-top-by-param (clog-obj param)
|
||||
(:documentation "Bring window with PARAM to top and return
|
||||
window or nil if not found"))
|
||||
|
||||
(defmethod window-to-top-by-param ((obj clog-obj) param)
|
||||
(let ((app (connection-data-item obj "clog-gui"))
|
||||
(r nil))
|
||||
(maphash (lambda (key value)
|
||||
(declare (ignore key))
|
||||
(when (equalp (win-param value) param)
|
||||
(window-focus value)
|
||||
(setf r key)))
|
||||
(windows app))
|
||||
r))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;; window-by-title ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric window-by-title (clog-obj title)
|
||||
(:documentation "Bring window with TITLE to top and return
|
||||
window or nil if not found"))
|
||||
|
||||
(defmethod window-by-title ((obj clog-obj) title)
|
||||
(let ((app (connection-data-item obj "clog-gui"))
|
||||
(r nil))
|
||||
(maphash (lambda (key value)
|
||||
(declare (ignore key))
|
||||
(when (equalp (window-title value) title)
|
||||
(setf r key)))
|
||||
(windows app))
|
||||
r))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;; window-by-param ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric window-by-param (clog-obj param)
|
||||
(:documentation "Bring window with PARAM to top and return
|
||||
window or nil if not found"))
|
||||
|
||||
(defmethod window-by-param ((obj clog-obj) param)
|
||||
(let ((app (connection-data-item obj "clog-gui"))
|
||||
(r nil))
|
||||
(maphash (lambda (key value)
|
||||
(declare (ignore key))
|
||||
(when (equalp (win-param value) param)
|
||||
(setf r key)))
|
||||
(windows app))
|
||||
r))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; maximize-all-windows ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -498,6 +577,10 @@ The on-window-change clog-obj received is the new window"))
|
|||
((win-title
|
||||
:accessor win-title
|
||||
:documentation "Window title clog-element")
|
||||
(win-param
|
||||
:accessor win-param
|
||||
:initform nil
|
||||
:documentation "Window specific parameter")
|
||||
(title-bar
|
||||
:accessor title-bar
|
||||
:documentation "Window title-bar clog-element")
|
||||
|
|
@ -678,6 +761,7 @@ The on-window-change clog-obj received is the new window"))
|
|||
maximize
|
||||
has-pinner
|
||||
keep-on-top
|
||||
window-param
|
||||
hidden
|
||||
client-movement
|
||||
border-class
|
||||
|
|
@ -690,7 +774,8 @@ 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 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."))
|
||||
the window will be set to keep-on-top always. window-param is a general parameter
|
||||
for identifiying the window to use with window-to-top-by-param or window-by-param."))
|
||||
|
||||
(defmethod create-gui-window ((obj clog-obj) &key (title "New Window")
|
||||
(content "")
|
||||
|
|
@ -701,6 +786,7 @@ the window will be set to keep-on-top always."))
|
|||
(maximize nil)
|
||||
(has-pinner nil)
|
||||
(keep-on-top nil)
|
||||
(window-param nil)
|
||||
(hidden nil)
|
||||
(client-movement nil)
|
||||
(border-class "w3-card-4 w3-white w3-border")
|
||||
|
|
@ -760,6 +846,7 @@ the window will be set to keep-on-top always."))
|
|||
:html-id html-id)))
|
||||
(setf (win-title win)
|
||||
(attach-as-child win (format nil "~A-title" html-id)))
|
||||
(setf (win-param win) window-param)
|
||||
(setf (title-bar win)
|
||||
(attach-as-child win (format nil "~A-title-bar" html-id)))
|
||||
(when has-pinner
|
||||
|
|
@ -844,6 +931,22 @@ the window will be set to keep-on-top always."))
|
|||
(setf (inner-html (window-select-item obj)) value))
|
||||
(setf (inner-html (win-title obj)) value))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
;; window-param ;;
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric window-param (clog-gui-window)
|
||||
(:documentation "Get/setf window param"))
|
||||
|
||||
(defmethod window-param ((obj clog-gui-window))
|
||||
(win-param obj))
|
||||
|
||||
(defgeneric (setf window-param) (value clog-gui-window)
|
||||
(:documentation "Set window param"))
|
||||
|
||||
(defmethod (setf window-param) (value (obj clog-gui-window))
|
||||
(setf (win-param obj) value))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;
|
||||
;; window-content ;;
|
||||
;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
|
|
@ -1739,6 +1739,7 @@ It parse the string TEXT without using READ functions."
|
|||
|
||||
(defun on-new-builder-panel (obj &key (open-file nil))
|
||||
"Open new panel"
|
||||
(unless (window-to-top-by-param obj open-file)
|
||||
(let* ((app (connection-data-item obj "builder-app-data"))
|
||||
(win (create-gui-window obj :top 40 :left 225
|
||||
:width 645 :height 430
|
||||
|
|
@ -1952,6 +1953,7 @@ It parse the string TEXT without using READ functions."
|
|||
(clrhash (get-control-list app panel-id))
|
||||
(on-populate-loaded-window content :win win)
|
||||
(setf (window-title win) (attribute content "data-clog-name"))
|
||||
(setf (window-param win) fname)
|
||||
(on-populate-control-list-win content :win win)))
|
||||
(when open-file
|
||||
(open-file-name open-file))
|
||||
|
|
@ -2066,7 +2068,7 @@ It parse the string TEXT without using READ functions."
|
|||
(declare (ignore obj))
|
||||
(unless in-simulation
|
||||
(when (drop-new-control app content data :win win)
|
||||
(incf-next-id content)))))))
|
||||
(incf-next-id content))))))))
|
||||
|
||||
(defun on-attach-builder-custom (body)
|
||||
"New custom builder page has attached"
|
||||
|
|
@ -2555,6 +2557,7 @@ It parse the string TEXT without using READ functions."
|
|||
|
||||
(defun on-open-file (obj &key open-file (title "New Source Editor") text (title-class "w3-black"))
|
||||
"Open a new text editor"
|
||||
(unless (window-to-top-by-title obj open-file)
|
||||
(let* ((app (connection-data-item obj "builder-app-data"))
|
||||
(win (create-gui-window obj :title title
|
||||
:title-class title-class
|
||||
|
|
@ -2774,7 +2777,7 @@ It parse the string TEXT without using READ functions."
|
|||
(unless (equal val "")
|
||||
(let ((result (capture-eval val :clog-obj obj
|
||||
:eval-in-package (text-value pac-line))))
|
||||
(on-open-file obj :title-class "w3-blue" :title "file eval" :text result))))))))
|
||||
(on-open-file obj :title-class "w3-blue" :title "file eval" :text result)))))))))
|
||||
|
||||
(defun on-repl (obj)
|
||||
"Open a REPL"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue