mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 10:40:45 -08:00
clog-gui-initialize can be set with use-clog-debugger
This commit is contained in:
David Botton
parent
eca4c2dd43
commit
9eef74a803
4 changed files with 182 additions and 164 deletions
|
|
@ -47,7 +47,9 @@
|
||||||
"Aborting this old connection since receiving a reconnection request.")
|
"Aborting this old connection since receiving a reconnection request.")
|
||||||
(t (c)
|
(t (c)
|
||||||
(when *verbose-output*
|
(when *verbose-output*
|
||||||
(format t "Failed to close the old connection when establishing reconnection. This can be normal: The old connection could probably don't work for the client, so the client is requesting to reconnect.~%Condition - ~A.~&"
|
(format t "Failed to close the old connection when establishing reconnection. ~
|
||||||
|
This can be normal: The old connection could probably don't work for the client, ~
|
||||||
|
so the client is requesting to reconnect.~%Condition - ~A.~&"
|
||||||
c))))
|
c))))
|
||||||
(setf (gethash id *connection-ids*) connection)
|
(setf (gethash id *connection-ids*) connection)
|
||||||
(setf (gethash connection *connections*) id))
|
(setf (gethash connection *connections*) id))
|
||||||
|
|
@ -113,7 +115,10 @@
|
||||||
(event (when event-hash
|
(event (when event-hash
|
||||||
(gethash event-id event-hash))))
|
(gethash event-id event-hash))))
|
||||||
(when event
|
(when event
|
||||||
(funcall event data)))
|
(let* ((debug-hook (gethash "clog-debug" event-hash)))
|
||||||
|
(if debug-hook
|
||||||
|
(funcall debug-hook event data)
|
||||||
|
(funcall event data)))))
|
||||||
(handler-case
|
(handler-case
|
||||||
(let* ((event-hash (get-connection-data connection-id))
|
(let* ((event-hash (get-connection-data connection-id))
|
||||||
(event (when event-hash
|
(event (when event-hash
|
||||||
|
|
|
||||||
|
|
@ -218,12 +218,16 @@
|
||||||
(defun clog-gui-initialize (clog-body &key
|
(defun clog-gui-initialize (clog-body &key
|
||||||
(body-left-offset 0)
|
(body-left-offset 0)
|
||||||
(body-right-offset 0)
|
(body-right-offset 0)
|
||||||
|
(use-clog-debugger nil)
|
||||||
(w3-css-url "/css/w3.css")
|
(w3-css-url "/css/w3.css")
|
||||||
(jquery-ui-css "/css/jquery-ui.css")
|
(jquery-ui-css "/css/jquery-ui.css")
|
||||||
(jquery-ui "/js/jquery-ui.js"))
|
(jquery-ui "/js/jquery-ui.js"))
|
||||||
"Initializes clog-gui and installs a clog-gui object on connection.
|
"Initializes clog-gui and installs a clog-gui object on connection.
|
||||||
If W3-CSS-URL has not been loaded before is installed unless is nil.
|
If W3-CSS-URL has not been loaded before is installed unless is nil.
|
||||||
BODY-LEFT-OFFSET and BODY-RIGHT-OFFSET limit width on maximize."
|
BODY-LEFT-OFFSET and BODY-RIGHT-OFFSET limit width on maximize. If
|
||||||
|
use-clog-debugger then a graphical debugger is set for all events.
|
||||||
|
NOTE: use-clog-debugger should not be set for security issues
|
||||||
|
on non-secure environments."
|
||||||
(let ((app (create-clog-gui clog-body)))
|
(let ((app (create-clog-gui clog-body)))
|
||||||
(setf (body-left-offset app) body-left-offset)
|
(setf (body-left-offset app) body-left-offset)
|
||||||
(setf (body-right-offset app) body-right-offset))
|
(setf (body-right-offset app) body-right-offset))
|
||||||
|
|
@ -237,7 +241,12 @@ BODY-LEFT-OFFSET and BODY-RIGHT-OFFSET limit width on maximize."
|
||||||
(when jquery-ui-css
|
(when jquery-ui-css
|
||||||
(load-css (html-document clog-body) jquery-ui-css))
|
(load-css (html-document clog-body) jquery-ui-css))
|
||||||
(when jquery-ui
|
(when jquery-ui
|
||||||
(load-script (html-document clog-body) jquery-ui)))
|
(load-script (html-document clog-body) jquery-ui))
|
||||||
|
(when use-clog-debugger
|
||||||
|
(setf (connection-data-item clog-body "clog-debug")
|
||||||
|
(lambda (event data)
|
||||||
|
(with-clog-debugger (clog-body)
|
||||||
|
(funcall event data))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Implementation - Menus
|
;; Implementation - Menus
|
||||||
|
|
|
||||||
|
|
@ -57,6 +57,9 @@ the same as the clog directy this overides the relative paths used in them.")
|
||||||
(setf (connection-data-item body "clog-path") path)
|
(setf (connection-data-item body "clog-path") path)
|
||||||
(setf (connection-data-item body "clog-body") body)
|
(setf (connection-data-item body "clog-body") body)
|
||||||
(setf (connection-data-item body "clog-sync") (bordeaux-threads:make-lock))
|
(setf (connection-data-item body "clog-sync") (bordeaux-threads:make-lock))
|
||||||
|
;; clog-debug is called for every with (event data)
|
||||||
|
;; see clog-gui:clog-gui-initialize
|
||||||
|
(setf (connection-data-item body "clog-debug") nil)
|
||||||
(funcall on-new-window body))
|
(funcall on-new-window body))
|
||||||
(put-br (html-document body) "No route to on-new-window")))))
|
(put-br (html-document body) "No route to on-new-window")))))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -326,171 +326,172 @@ clog-builder window.")
|
||||||
(open-ext (form-data-item (form-get-data body) "open-ext")))
|
(open-ext (form-data-item (form-get-data body) "open-ext")))
|
||||||
(setf (connection-data-item body "builder-app-data") app)
|
(setf (connection-data-item body "builder-app-data") app)
|
||||||
(setf (title (html-document body)) "CLOG Builder")
|
(setf (title (html-document body)) "CLOG Builder")
|
||||||
(clog-gui-initialize body)
|
(clog-gui-initialize body :use-clog-debugger t)
|
||||||
(add-class body *builder-window-desktop-class*)
|
(add-class body *builder-window-desktop-class*)
|
||||||
(when *builder-window-show-static-root-class*
|
(with-clog-debugger (body)
|
||||||
(setf (z-index (create-panel body :positioning :fixed
|
(when *builder-window-show-static-root-class*
|
||||||
:bottom 0 :left 0
|
(setf (z-index (create-panel body :positioning :fixed
|
||||||
:class *builder-window-show-static-root-class*
|
:bottom 0 :left 0
|
||||||
:content (format nil "static-root: ~A" clog::*static-root*)))
|
:class *builder-window-show-static-root-class*
|
||||||
-9999))
|
:content (format nil "static-root: ~A" clog::*static-root*)))
|
||||||
(let* ((menu (create-gui-menu-bar body))
|
-9999))
|
||||||
(icon (create-gui-menu-icon menu :image-url img-clog-icon
|
(let* ((menu (create-gui-menu-bar body))
|
||||||
:on-click #'on-help-about-builder))
|
(icon (create-gui-menu-icon menu :image-url img-clog-icon
|
||||||
(file (create-gui-menu-drop-down menu :content "Builder"))
|
:on-click #'on-help-about-builder))
|
||||||
(src (create-gui-menu-drop-down menu :content "Project"))
|
(file (create-gui-menu-drop-down menu :content "Builder"))
|
||||||
(tools (create-gui-menu-drop-down menu :content "Tools"))
|
(src (create-gui-menu-drop-down menu :content "Project"))
|
||||||
(opts (create-gui-menu-drop-down menu :content "Options"))
|
(tools (create-gui-menu-drop-down menu :content "Tools"))
|
||||||
(win (create-gui-menu-drop-down menu :content "Window"))
|
(opts (create-gui-menu-drop-down menu :content "Options"))
|
||||||
(help (create-gui-menu-drop-down menu :content "Help")))
|
(win (create-gui-menu-drop-down menu :content "Window"))
|
||||||
(declare (ignore icon))
|
(help (create-gui-menu-drop-down menu :content "Help")))
|
||||||
;; Menu -> File
|
(declare (ignore icon))
|
||||||
(let ((exter (create-button file :content "-" :class *builder-menu-button-class*)))
|
;; Menu -> File
|
||||||
(flet ((exter-text ()
|
(let ((exter (create-button file :content "-" :class *builder-menu-button-class*)))
|
||||||
(if *open-external*
|
(flet ((exter-text ()
|
||||||
"open external tab"
|
(if *open-external*
|
||||||
"open this tab")))
|
"open external tab"
|
||||||
(setf (text-value exter) (exter-text))
|
"open this tab")))
|
||||||
(set-on-click exter (lambda (obj)
|
(setf (text-value exter) (exter-text))
|
||||||
(declare (ignore obj))
|
(set-on-click exter (lambda (obj)
|
||||||
(setf *open-external* (not *open-external*))
|
(declare (ignore obj))
|
||||||
(setf (text-value exter) (exter-text)))))
|
(setf *open-external* (not *open-external*))
|
||||||
(create-gui-menu-item file :content "New CLOG Panel Editor" :on-click
|
(setf (text-value exter) (exter-text)))))
|
||||||
|
(create-gui-menu-item file :content "New CLOG Panel Editor" :on-click
|
||||||
|
(lambda (obj)
|
||||||
|
(if *open-external*
|
||||||
|
(on-new-builder-panel-ext obj)
|
||||||
|
(on-new-builder-panel obj))))
|
||||||
|
(create-gui-menu-item file :content "New Source Editor" :on-click
|
||||||
|
(lambda (obj)
|
||||||
|
(if *open-external*
|
||||||
|
(on-open-file-ext obj)
|
||||||
|
(on-open-file obj))))
|
||||||
|
(create-gui-menu-item file :content "New CLOG Panel Popup Editor" :on-click 'on-new-builder-page)
|
||||||
|
(create-gui-menu-item file :content "New HTML Panel Popup Editor" :on-click 'on-new-builder-basic-page)
|
||||||
|
(create-gui-menu-item file :content "New Custom Boot Panel External Editor" :on-click 'on-new-builder-custom-page))
|
||||||
|
;; Menu -> Source
|
||||||
|
(create-gui-menu-item src :content "Project Window" :on-click 'on-show-project)
|
||||||
|
(create-gui-menu-item src :content "Directory Window" :on-click 'on-dir-win)
|
||||||
|
(create-gui-menu-item src :content "New Project Template" :on-click 'on-new-app-template)
|
||||||
|
(create-gui-menu-item src :content "New System Browser" :on-click 'on-new-sys-browser)
|
||||||
|
(create-gui-menu-item src :content "New ASDF System Browser" :on-click 'on-new-asdf-browser)
|
||||||
|
;; Menu -> Tools
|
||||||
|
(create-gui-menu-item tools :content "List Callers" :on-click 'on-show-callers)
|
||||||
|
(create-gui-menu-item tools :content "List Callees" :on-click 'on-show-callees)
|
||||||
|
(create-gui-menu-item tools :content "Thread Viewer" :on-click 'on-show-thread-viewer)
|
||||||
|
(create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl)
|
||||||
|
(create-gui-menu-item tools :content "Copy/Cut History" :on-click 'on-show-copy-history-win)
|
||||||
|
(unless *clogframe-mode*
|
||||||
|
(create-gui-menu-item tools :content "Image to HTML Data" :on-click 'on-image-to-data))
|
||||||
|
(create-gui-menu-item tools :content "Launch DB Admin" :on-click
|
||||||
(lambda (obj)
|
(lambda (obj)
|
||||||
(if *open-external*
|
|
||||||
(on-new-builder-panel-ext obj)
|
|
||||||
(on-new-builder-panel obj))))
|
|
||||||
(create-gui-menu-item file :content "New Source Editor" :on-click
|
|
||||||
(lambda (obj)
|
|
||||||
(if *open-external*
|
|
||||||
(on-open-file-ext obj)
|
|
||||||
(on-open-file obj))))
|
|
||||||
(create-gui-menu-item file :content "New CLOG Panel Popup Editor" :on-click 'on-new-builder-page)
|
|
||||||
(create-gui-menu-item file :content "New HTML Panel Popup Editor" :on-click 'on-new-builder-basic-page)
|
|
||||||
(create-gui-menu-item file :content "New Custom Boot Panel External Editor" :on-click 'on-new-builder-custom-page))
|
|
||||||
;; Menu -> Source
|
|
||||||
(create-gui-menu-item src :content "Project Window" :on-click 'on-show-project)
|
|
||||||
(create-gui-menu-item src :content "Directory Window" :on-click 'on-dir-win)
|
|
||||||
(create-gui-menu-item src :content "New Project Template" :on-click 'on-new-app-template)
|
|
||||||
(create-gui-menu-item src :content "New System Browser" :on-click 'on-new-sys-browser)
|
|
||||||
(create-gui-menu-item src :content "New ASDF System Browser" :on-click 'on-new-asdf-browser)
|
|
||||||
;; Menu -> Tools
|
|
||||||
(create-gui-menu-item tools :content "List Callers" :on-click 'on-show-callers)
|
|
||||||
(create-gui-menu-item tools :content "List Callees" :on-click 'on-show-callees)
|
|
||||||
(create-gui-menu-item tools :content "Thread Viewer" :on-click 'on-show-thread-viewer)
|
|
||||||
(create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl)
|
|
||||||
(create-gui-menu-item tools :content "Copy/Cut History" :on-click 'on-show-copy-history-win)
|
|
||||||
(unless *clogframe-mode*
|
|
||||||
(create-gui-menu-item tools :content "Image to HTML Data" :on-click 'on-image-to-data))
|
|
||||||
(create-gui-menu-item tools :content "Launch DB Admin" :on-click
|
|
||||||
(lambda (obj)
|
|
||||||
(declare (ignore obj))
|
|
||||||
(open-window (window body) "/dbadmin")))
|
|
||||||
;; Menu -> Options
|
|
||||||
(create-gui-menu-item opts :content "Edit preferences.lisp" :on-click 'on-opts-edit)
|
|
||||||
(let ((exter (create-button opts :content "-" :class *builder-menu-button-class*)))
|
|
||||||
(flet ((exter-text ()
|
|
||||||
(if *open-external-with-emacs*
|
|
||||||
"open external files in emacs"
|
|
||||||
"open all files in builder")))
|
|
||||||
(setf (text-value exter) (exter-text))
|
|
||||||
(set-on-click exter (lambda (obj)
|
|
||||||
(declare (ignore obj))
|
(declare (ignore obj))
|
||||||
(setf *open-external-with-emacs* (not *open-external-with-emacs*))
|
(open-window (window body) "/dbadmin")))
|
||||||
(setf (text-value exter) (exter-text))))))
|
;; Menu -> Options
|
||||||
(create-gui-menu-item opts :content "Update CLOG Builder" :on-click 'on-update-clog)
|
(create-gui-menu-item opts :content "Edit preferences.lisp" :on-click 'on-opts-edit)
|
||||||
;; Menu -> Windows
|
(let ((exter (create-button opts :content "-" :class *builder-menu-button-class*)))
|
||||||
(create-gui-menu-item win :content "Maximize" :on-click
|
(flet ((exter-text ()
|
||||||
(lambda (obj)
|
(if *open-external-with-emacs*
|
||||||
(when (current-window obj)
|
"open external files in emacs"
|
||||||
(window-maximize (current-window obj)))))
|
"open all files in builder")))
|
||||||
(create-gui-menu-item win :content "Normalize" :on-click
|
(setf (text-value exter) (exter-text))
|
||||||
(lambda (obj)
|
(set-on-click exter (lambda (obj)
|
||||||
(when (current-window obj)
|
(declare (ignore obj))
|
||||||
(window-normalize (current-window obj)))))
|
(setf *open-external-with-emacs* (not *open-external-with-emacs*))
|
||||||
(create-gui-menu-item win :content "Maximize All" :on-click #'maximize-all-windows)
|
(setf (text-value exter) (exter-text))))))
|
||||||
(create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows)
|
(create-gui-menu-item opts :content "Update CLOG Builder" :on-click 'on-update-clog)
|
||||||
;; Menu -> Help
|
;; Menu -> Windows
|
||||||
(create-gui-menu-item help :content "CLOG Manual" :on-click
|
(create-gui-menu-item win :content "Maximize" :on-click
|
||||||
(lambda (obj)
|
(lambda (obj)
|
||||||
(declare (ignore obj))
|
(when (current-window obj)
|
||||||
(open-window (window body) "https://rabbibotton.github.io/clog/clog-manual.html")))
|
(window-maximize (current-window obj)))))
|
||||||
(create-gui-menu-item help :content "Learn CLOG" :on-click
|
(create-gui-menu-item win :content "Normalize" :on-click
|
||||||
(lambda (obj)
|
(lambda (obj)
|
||||||
(declare (ignore obj))
|
(when (current-window obj)
|
||||||
(open-window (window body) "https://github.com/rabbibotton/clog/blob/main/LEARN.md")))
|
(window-normalize (current-window obj)))))
|
||||||
(create-gui-menu-item help :content "Tutorials DIR" :on-click
|
(create-gui-menu-item win :content "Maximize All" :on-click #'maximize-all-windows)
|
||||||
(lambda (obj)
|
(create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows)
|
||||||
(declare (ignore obj))
|
;; Menu -> Help
|
||||||
(on-dir-win obj :dir (setf static-root (merge-pathnames "./tutorial/"
|
(create-gui-menu-item help :content "CLOG Manual" :on-click
|
||||||
(asdf:system-source-directory :clog))))))
|
(lambda (obj)
|
||||||
(create-gui-menu-item help :content "ParenScript Reference" :on-click
|
(declare (ignore obj))
|
||||||
(lambda (obj)
|
(open-window (window body) "https://rabbibotton.github.io/clog/clog-manual.html")))
|
||||||
(declare (ignore obj))
|
(create-gui-menu-item help :content "Learn CLOG" :on-click
|
||||||
(open-window (window body) "https://parenscript.common-lisp.dev/")))
|
(lambda (obj)
|
||||||
(create-gui-menu-item help :content "L1sp Search" :on-click
|
(declare (ignore obj))
|
||||||
(lambda (obj)
|
(open-window (window body) "https://github.com/rabbibotton/clog/blob/main/LEARN.md")))
|
||||||
(declare (ignore obj))
|
(create-gui-menu-item help :content "Tutorials DIR" :on-click
|
||||||
(open-window (window body) "http://l1sp.org/html/")))
|
(lambda (obj)
|
||||||
(create-gui-menu-item help :content "Lisp in Y Minutes" :on-click
|
(declare (ignore obj))
|
||||||
(lambda (obj)
|
(on-dir-win obj :dir (setf static-root (merge-pathnames "./tutorial/"
|
||||||
(declare (ignore obj))
|
(asdf:system-source-directory :clog))))))
|
||||||
(open-window (window body) "https://learnxinyminutes.com/docs/common-lisp/")))
|
(create-gui-menu-item help :content "ParenScript Reference" :on-click
|
||||||
(create-gui-menu-item help :content "Simplified Reference" :on-click
|
(lambda (obj)
|
||||||
(lambda (obj)
|
(declare (ignore obj))
|
||||||
(declare (ignore obj))
|
(open-window (window body) "https://parenscript.common-lisp.dev/")))
|
||||||
(open-window (window body) "https://jtra.cz/stuff/lisp/sclr/index.html")))
|
(create-gui-menu-item help :content "L1sp Search" :on-click
|
||||||
(create-gui-menu-item help :content "Common Lisp Manual" :on-click
|
(lambda (obj)
|
||||||
(lambda (obj)
|
(declare (ignore obj))
|
||||||
(declare (ignore obj))
|
(open-window (window body) "http://l1sp.org/html/")))
|
||||||
(open-window (window body) "http://clhs.lisp.se/")))
|
(create-gui-menu-item help :content "Lisp in Y Minutes" :on-click
|
||||||
(create-gui-menu-item help :content "W3.CSS Manual" :on-click
|
(lambda (obj)
|
||||||
(lambda (obj)
|
(declare (ignore obj))
|
||||||
(declare (ignore obj))
|
(open-window (window body) "https://learnxinyminutes.com/docs/common-lisp/")))
|
||||||
(open-window (window body) "https://www.w3schools.com/w3css/")))
|
(create-gui-menu-item help :content "Simplified Reference" :on-click
|
||||||
(create-gui-menu-item help :content "About CLOG Builder" :on-click #'on-help-about-builder)
|
(lambda (obj)
|
||||||
(create-gui-menu-window-select menu)
|
(declare (ignore obj))
|
||||||
(create-gui-menu-full-screen menu))
|
(open-window (window body) "https://jtra.cz/stuff/lisp/sclr/index.html")))
|
||||||
(on-show-copy-history-win body)
|
(create-gui-menu-item help :content "Common Lisp Manual" :on-click
|
||||||
(cond
|
(lambda (obj)
|
||||||
(open-panel
|
(declare (ignore obj))
|
||||||
(if (equal open-panel " ")
|
(open-window (window body) "http://clhs.lisp.se/")))
|
||||||
(setf open-panel nil)
|
(create-gui-menu-item help :content "W3.CSS Manual" :on-click
|
||||||
(setf (title (html-document body)) (file-namestring open-panel)))
|
(lambda (obj)
|
||||||
(cond ((equalp open-ext "t")
|
(declare (ignore obj))
|
||||||
(setf open-ext t))
|
(open-window (window body) "https://www.w3schools.com/w3css/")))
|
||||||
((equalp open-ext "custom")
|
(create-gui-menu-item help :content "About CLOG Builder" :on-click #'on-help-about-builder)
|
||||||
(setf open-ext :custom)))
|
(create-gui-menu-window-select menu)
|
||||||
(on-new-builder-panel body :open-file open-panel :open-ext open-ext))
|
(create-gui-menu-full-screen menu))
|
||||||
(open-file
|
(on-show-copy-history-win body)
|
||||||
(if (equal open-file " ")
|
(cond
|
||||||
(setf open-file nil)
|
(open-panel
|
||||||
(setf (title (html-document body)) (file-namestring open-file)))
|
(if (equal open-panel " ")
|
||||||
(on-open-file body :open-file open-file :maximized t))
|
(setf open-panel nil)
|
||||||
(t
|
(setf (title (html-document body)) (file-namestring open-panel)))
|
||||||
(when *start-project*
|
(cond ((equalp open-ext "t")
|
||||||
(projects-load *start-project*))
|
(setf open-ext t))
|
||||||
(on-show-project body :project *start-project*)
|
((equalp open-ext "custom")
|
||||||
(when *start-dir*
|
(setf open-ext :custom)))
|
||||||
|
(on-new-builder-panel body :open-file open-panel :open-ext open-ext))
|
||||||
|
(open-file
|
||||||
|
(if (equal open-file " ")
|
||||||
|
(setf open-file nil)
|
||||||
|
(setf (title (html-document body)) (file-namestring open-file)))
|
||||||
|
(on-open-file body :open-file open-file :maximized t))
|
||||||
|
(t
|
||||||
(when *start-project*
|
(when *start-project*
|
||||||
(set-geometry (current-window body) :top 38 :left 5 :right "" :height "" :bottom 22)
|
(projects-load *start-project*))
|
||||||
|
(on-show-project body :project *start-project*)
|
||||||
|
(when *start-dir*
|
||||||
|
(when *start-project*
|
||||||
|
(set-geometry (current-window body) :top 38 :left 5 :right "" :height "" :bottom 22)
|
||||||
|
(set-geometry (current-window body) :height (height (current-window body))
|
||||||
|
:bottom (bottom (current-window body))))
|
||||||
|
(handler-case
|
||||||
|
(on-dir-win body :dir *start-dir*)
|
||||||
|
(error (msg)
|
||||||
|
(alert-toast body "Directory Error" (format nil "Unable to open directory ~A. ~A" *start-dir* msg))
|
||||||
|
(setf *start-dir* nil)))
|
||||||
|
(set-geometry (current-window body) :top 38 :left "" :right 5 :height "" :bottom 22)
|
||||||
(set-geometry (current-window body) :height (height (current-window body))
|
(set-geometry (current-window body) :height (height (current-window body))
|
||||||
:bottom (bottom (current-window body))))
|
:bottom (bottom (current-window body))))))
|
||||||
(handler-case
|
(set-on-before-unload (window body) (lambda(obj)
|
||||||
(on-dir-win body :dir *start-dir*)
|
(declare (ignore obj))
|
||||||
(error (msg)
|
;; return empty string to prevent nav off page
|
||||||
(alert-toast body "Directory Error" (format nil "Unable to open directory ~A. ~A" *start-dir* msg))
|
"")))
|
||||||
(setf *start-dir* nil)))
|
(when *app-mode*
|
||||||
(set-geometry (current-window body) :top 38 :left "" :right 5 :height "" :bottom 22)
|
(incf *app-mode*))
|
||||||
(set-geometry (current-window body) :height (height (current-window body))
|
(run body))
|
||||||
:bottom (bottom (current-window body))))))
|
|
||||||
(set-on-before-unload (window body) (lambda(obj)
|
|
||||||
(declare (ignore obj))
|
|
||||||
;; return empty string to prevent nav off page
|
|
||||||
"")))
|
|
||||||
(when *app-mode*
|
|
||||||
(incf *app-mode*))
|
|
||||||
(run body)
|
|
||||||
(when *app-mode*
|
(when *app-mode*
|
||||||
(decf *app-mode*)
|
(decf *app-mode*)
|
||||||
(when (<= *app-mode* 0)
|
(when (<= *app-mode* 0)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue