switch to window if one exists instead of create new one

This commit is contained in:
David Botton 2022-09-14 18:19:23 -04:00
parent 55a9e112e7
commit b8fe23950e
2 changed files with 634 additions and 528 deletions

View file

@ -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 ;;
;;;;;;;;;;;;;;;;;;;;

View file

@ -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"