mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
password protect
This commit is contained in:
David Botton
parent
250d8129d2
commit
e443a34dc5
5 changed files with 224 additions and 195 deletions
|
|
@ -1914,6 +1914,7 @@ alert-dialog blocks till time-out reached or OK clicked."
|
|||
(rows 1)
|
||||
(placeholder-value "")
|
||||
(default-value "")
|
||||
is-password
|
||||
(left nil) (top nil)
|
||||
(width 300) (height 200)
|
||||
(client-movement nil)
|
||||
|
|
@ -1928,7 +1929,10 @@ result of on-input."
|
|||
(result nil)
|
||||
(body (connection-body obj))
|
||||
(inp (if (eql rows 1)
|
||||
(format nil "<input type='text' id='~A-input' size='~A' value='~A' placeholder='~A'>"
|
||||
(format nil "<input type='~A' id='~A-input' size='~A' value='~A' placeholder='~A'>"
|
||||
(if is-password
|
||||
"password"
|
||||
"text")
|
||||
html-id
|
||||
size
|
||||
(escape-string default-value :html t)
|
||||
|
|
|
|||
|
|
@ -10,6 +10,9 @@
|
|||
;; These are defaults, if the file preferences.lisp exists
|
||||
;; the values set there will be used instead
|
||||
|
||||
;; To passowrod protect use of the IDE set to a password or a function that
|
||||
;; returns a password.
|
||||
(defparameter *password-protect* nil)
|
||||
;; Open panels and files in new browser tabs by default
|
||||
(defparameter *open-external* nil)
|
||||
;; Use clog-popup and extend desktop to popups
|
||||
|
|
|
|||
|
|
@ -11,10 +11,10 @@
|
|||
;; Global Internal Config
|
||||
|
||||
(defparameter *app-mode* nil
|
||||
"If *app-mode* is t terminates the clog-builder process on exit of the all
|
||||
"If *app-mode* is t terminates the clog-builder process on exit of the all
|
||||
clog-builder window.")
|
||||
(defparameter *clogframe-mode* nil
|
||||
"If *clogframe-mode* is t no popup or tabs possible.")
|
||||
"If *clogframe-mode* is t no popup or tabs possible.")
|
||||
(defparameter *preferances-file* nil "Location of the preferance file")
|
||||
(defparameter *start-project* nil "Set the project to start with")
|
||||
(defparameter *start-dir* nil "Set the directory the dir win should start with")
|
||||
|
|
@ -334,6 +334,7 @@ clog-builder window.")
|
|||
(*menu-window-select-class* *builder-menu-window-select-class*)
|
||||
(*default-title-class* *builder-title-class*)
|
||||
(*default-border-class* *builder-border-class*)
|
||||
(safe t)
|
||||
(open-file (form-data-item (form-get-data body) "open-file"))
|
||||
(open-panel (form-data-item (form-get-data body) "open-panel"))
|
||||
(open-ext (form-data-item (form-get-data body) "open-ext")))
|
||||
|
|
@ -343,195 +344,204 @@ clog-builder window.")
|
|||
*standard-output*
|
||||
(make-instance 'console-out-stream :clog-obj body)))
|
||||
(setf (stdin app) (if clog-connection:*disable-clog-debugging*
|
||||
*standard-input*
|
||||
(make-instance 'console-in-stream :clog-obj body)))
|
||||
*standard-input*
|
||||
(make-instance 'console-in-stream :clog-obj body)))
|
||||
(clog-gui-initialize body :use-clog-debugger t :standard-output (stdout app))
|
||||
(add-class body *builder-window-desktop-class*)
|
||||
(with-clog-debugger (body :standard-output (stdout app))
|
||||
(when *builder-window-show-static-root-class*
|
||||
(setf (z-index (create-panel body :positioning :fixed
|
||||
:bottom 0 :right 0
|
||||
:class *builder-window-show-static-root-class*
|
||||
:content (format nil "static-root: ~A" clog:*static-root*)))
|
||||
-9999))
|
||||
(let* ((menu (create-gui-menu-bar body))
|
||||
(icon (create-gui-menu-icon menu :image-url img-clog-icon
|
||||
:on-click #'on-help-about-builder))
|
||||
(file (create-gui-menu-drop-down menu :content "Builder"))
|
||||
(src (create-gui-menu-drop-down menu :content "Project"))
|
||||
(tools (create-gui-menu-drop-down menu :content "Tools"))
|
||||
(opts (create-gui-menu-drop-down menu :content "Options"))
|
||||
(win (create-gui-menu-drop-down menu :content "Window"))
|
||||
(help (create-gui-menu-drop-down menu :content "Help")))
|
||||
(declare (ignore icon))
|
||||
;; Menu -> File
|
||||
(let ((exter (create-button file :content "-" :class *builder-menu-button-class*)))
|
||||
(flet ((exter-text ()
|
||||
(if *open-external*
|
||||
"open external tab"
|
||||
"open this tab")))
|
||||
(setf (text-value exter) (exter-text))
|
||||
(set-on-click exter (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf *open-external* (not *open-external*))
|
||||
(setf (text-value exter) (exter-text)))))
|
||||
(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 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 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)
|
||||
(create-gui-menu-item file :content "New CLOG Builder Window" :on-click
|
||||
(when *password-protect*
|
||||
(input-dialog body "Enter password:" (lambda (result)
|
||||
(unless (equal result (if (functionp *password-protect*)
|
||||
(funcall *password-protect* body)
|
||||
*password-protect*))
|
||||
(setf safe nil)
|
||||
(close-connection (window body))))
|
||||
:time-out 360 :title "Password"))
|
||||
(when safe
|
||||
(with-clog-debugger (body :standard-output (stdout app))
|
||||
(when *builder-window-show-static-root-class*
|
||||
(setf (z-index (create-panel body :positioning :fixed
|
||||
:bottom 0 :right 0
|
||||
:class *builder-window-show-static-root-class*
|
||||
:content (format nil "static-root: ~A" clog:*static-root*)))
|
||||
-9999))
|
||||
(let* ((menu (create-gui-menu-bar body))
|
||||
(icon (create-gui-menu-icon menu :image-url img-clog-icon
|
||||
:on-click #'on-help-about-builder))
|
||||
(file (create-gui-menu-drop-down menu :content "Builder"))
|
||||
(src (create-gui-menu-drop-down menu :content "Project"))
|
||||
(tools (create-gui-menu-drop-down menu :content "Tools"))
|
||||
(opts (create-gui-menu-drop-down menu :content "Options"))
|
||||
(win (create-gui-menu-drop-down menu :content "Window"))
|
||||
(help (create-gui-menu-drop-down menu :content "Help")))
|
||||
(declare (ignore icon))
|
||||
;; Menu -> File
|
||||
(let ((exter (create-button file :content "-" :class *builder-menu-button-class*)))
|
||||
(flet ((exter-text ()
|
||||
(if *open-external*
|
||||
"open external tab"
|
||||
"open this tab")))
|
||||
(setf (text-value exter) (exter-text))
|
||||
(set-on-click exter (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf *open-external* (not *open-external*))
|
||||
(setf (text-value exter) (exter-text)))))
|
||||
(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 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 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)
|
||||
(create-gui-menu-item file :content "New CLOG Builder Window" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "/builder"))))
|
||||
;; Menu -> Project
|
||||
(create-gui-menu-item src :content "Project Tree" :on-click 'on-project-tree)
|
||||
(create-gui-menu-item src :content "ASD Project Window" :on-click 'on-show-project)
|
||||
(create-gui-menu-item src :content "New Directory Tree" :on-click 'on-dir-tree)
|
||||
(create-gui-menu-item src :content "New Project from template" :on-click 'on-new-app-template)
|
||||
(create-gui-menu-item src :content "New System Source Browser" :on-click 'on-new-sys-browser)
|
||||
(create-gui-menu-item src :content "New Loaded ASDF System Browser" :on-click 'on-new-asdf-browser)
|
||||
;; Menu -> Tools
|
||||
(create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl)
|
||||
(create-gui-menu-item tools :content "CLOG Builder Console" :on-click 'on-open-console)
|
||||
(create-gui-menu-item tools :content "CLOG Probe Panel" :on-click 'on-probe-panel)
|
||||
(create-gui-menu-item tools :content "CLOG Object Scope" :on-click 'on-object-scope)
|
||||
(create-gui-menu-item tools :content "OS Pseudo Shell" :on-click 'on-shell)
|
||||
(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 "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) "/builder"))))
|
||||
;; Menu -> Project
|
||||
(create-gui-menu-item src :content "Project Tree" :on-click 'on-project-tree)
|
||||
(create-gui-menu-item src :content "ASD Project Window" :on-click 'on-show-project)
|
||||
(create-gui-menu-item src :content "New Directory Tree" :on-click 'on-dir-tree)
|
||||
(create-gui-menu-item src :content "New Project from template" :on-click 'on-new-app-template)
|
||||
(create-gui-menu-item src :content "New System Source Browser" :on-click 'on-new-sys-browser)
|
||||
(create-gui-menu-item src :content "New Loaded ASDF System Browser" :on-click 'on-new-asdf-browser)
|
||||
;; Menu -> Tools
|
||||
(create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl)
|
||||
(create-gui-menu-item tools :content "CLOG Builder Console" :on-click 'on-open-console)
|
||||
(create-gui-menu-item tools :content "CLOG Probe Panel" :on-click 'on-probe-panel)
|
||||
(create-gui-menu-item tools :content "CLOG Object Scope" :on-click 'on-object-scope)
|
||||
(create-gui-menu-item tools :content "OS Pseudo Shell" :on-click 'on-shell)
|
||||
(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 "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)
|
||||
(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))
|
||||
(setf *open-external-with-emacs* (not *open-external-with-emacs*))
|
||||
(setf (text-value exter) (exter-text))))))
|
||||
(create-gui-menu-item opts :content "Start SWANK Server Once" :on-click
|
||||
(lambda (obj)
|
||||
(let ((*default-title-class* *builder-title-class*)
|
||||
(*default-border-class* *builder-border-class*))
|
||||
(input-dialog obj "Port ID"
|
||||
(lambda (result)
|
||||
(swank:create-server :port (js-to-integer result) :dont-close nil)
|
||||
(let ((*default-title-class* *builder-title-class*)
|
||||
(*default-border-class* *builder-border-class*))
|
||||
(alert-dialog obj (format nil "Use slime-connect on emacs or on a REPL to port ~A"
|
||||
result)
|
||||
:title "SWANK Started (One time connect)")))
|
||||
:placeholder-value "4005" :default-value "4005" :title "Start SWANK Server"))))
|
||||
(create-gui-menu-item opts :content "Set *clog-debug-instance*"
|
||||
:on-click (lambda (obj)
|
||||
(setf *clog-debug-instance* (connection-body obj))
|
||||
(alert-toast obj "*clog-debug-instance*"
|
||||
"This window will be used for future default debug alerts."
|
||||
:color-class "w3-green"
|
||||
:time-out 2)))
|
||||
(create-gui-menu-item opts :content "Update CLOG Builder" :on-click 'on-update-clog)
|
||||
;; Menu -> Windows
|
||||
(create-gui-menu-item win :content "Maximize" :on-click
|
||||
(lambda (obj)
|
||||
(when (current-window obj)
|
||||
(window-maximize (current-window obj)))))
|
||||
(create-gui-menu-item win :content "Normalize" :on-click
|
||||
(lambda (obj)
|
||||
(when (current-window obj)
|
||||
(window-normalize (current-window obj)))))
|
||||
(create-gui-menu-item win :content "Maximize All" :on-click #'maximize-all-windows)
|
||||
(create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows)
|
||||
;; Menu -> Help
|
||||
(create-gui-menu-item help :content "CLOG Manual" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf *open-external-with-emacs* (not *open-external-with-emacs*))
|
||||
(setf (text-value exter) (exter-text))))))
|
||||
(create-gui-menu-item opts :content "Start SWANK Server Once" :on-click
|
||||
(lambda (obj)
|
||||
(let ((*default-title-class* *builder-title-class*)
|
||||
(*default-border-class* *builder-border-class*))
|
||||
(input-dialog obj "Port ID"
|
||||
(lambda (result)
|
||||
(swank:create-server :port (js-to-integer result) :dont-close nil)
|
||||
(let ((*default-title-class* *builder-title-class*)
|
||||
(*default-border-class* *builder-border-class*))
|
||||
(alert-dialog obj (format nil "Use slime-connect on emacs or on a REPL to port ~A"
|
||||
result)
|
||||
:title "SWANK Started (One time connect)")))
|
||||
:placeholder-value "4005" :default-value "4005" :title "Start SWANK Server"))))
|
||||
(create-gui-menu-item opts :content "Set *clog-debug-instance*"
|
||||
:on-click (lambda (obj)
|
||||
(setf *clog-debug-instance* (connection-body obj))
|
||||
(alert-toast obj "*clog-debug-instance*"
|
||||
"This window will be used for future default debug alerts."
|
||||
:color-class "w3-green"
|
||||
:time-out 2)))
|
||||
(create-gui-menu-item opts :content "Update CLOG Builder" :on-click 'on-update-clog)
|
||||
;; Menu -> Windows
|
||||
(create-gui-menu-item win :content "Maximize" :on-click
|
||||
(lambda (obj)
|
||||
(when (current-window obj)
|
||||
(window-maximize (current-window obj)))))
|
||||
(create-gui-menu-item win :content "Normalize" :on-click
|
||||
(lambda (obj)
|
||||
(when (current-window obj)
|
||||
(window-normalize (current-window obj)))))
|
||||
(create-gui-menu-item win :content "Maximize All" :on-click #'maximize-all-windows)
|
||||
(create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows)
|
||||
;; Menu -> Help
|
||||
(create-gui-menu-item help :content "CLOG Manual" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://rabbibotton.github.io/clog/clog-manual.html")))
|
||||
(create-gui-menu-item help :content "Learn CLOG" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://github.com/rabbibotton/clog/blob/main/LEARN.md")))
|
||||
(create-gui-menu-item help :content "Tutorials DIR" :on-click
|
||||
(lambda (obj)
|
||||
(on-dir-tree obj :dir (merge-pathnames "./tutorial/"
|
||||
(asdf:system-source-directory :clog)))))
|
||||
(create-gui-menu-item help :content "ParenScript Reference" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://parenscript.common-lisp.dev/")))
|
||||
(create-gui-menu-item help :content "L1sp Search" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "http://l1sp.org/html/")))
|
||||
(create-gui-menu-item help :content "Lisp in Y Minutes" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://learnxinyminutes.com/docs/common-lisp/")))
|
||||
(create-gui-menu-item help :content "Simplified Reference" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://jtra.cz/stuff/lisp/sclr/index.html")))
|
||||
(create-gui-menu-item help :content "Common Lisp Manual" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "http://clhs.lisp.se/")))
|
||||
(create-gui-menu-item help :content "W3.CSS Manual" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://www.w3schools.com/w3css/")))
|
||||
(create-gui-menu-item help :content "About CLOG Builder" :on-click #'on-help-about-builder)
|
||||
(create-gui-menu-window-select menu)
|
||||
(create-gui-menu-full-screen menu))
|
||||
(on-show-copy-history-win body)
|
||||
(cond
|
||||
(open-panel
|
||||
(if (equal open-panel " ")
|
||||
(setf open-panel nil)
|
||||
(setf (title (html-document body)) (file-namestring open-panel)))
|
||||
(cond ((equalp open-ext "t")
|
||||
(setf open-ext t))
|
||||
((equalp open-ext "custom")
|
||||
(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*
|
||||
(projects-load *start-project*))
|
||||
(on-project-tree body :project *start-project*)
|
||||
(when *start-dir*
|
||||
(handler-case
|
||||
(on-dir-tree 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-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))
|
||||
(open-window (window body) "https://rabbibotton.github.io/clog/clog-manual.html")))
|
||||
(create-gui-menu-item help :content "Learn CLOG" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://github.com/rabbibotton/clog/blob/main/LEARN.md")))
|
||||
(create-gui-menu-item help :content "Tutorials DIR" :on-click
|
||||
(lambda (obj)
|
||||
(on-dir-tree obj :dir (merge-pathnames "./tutorial/"
|
||||
(asdf:system-source-directory :clog)))))
|
||||
(create-gui-menu-item help :content "ParenScript Reference" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://parenscript.common-lisp.dev/")))
|
||||
(create-gui-menu-item help :content "L1sp Search" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "http://l1sp.org/html/")))
|
||||
(create-gui-menu-item help :content "Lisp in Y Minutes" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://learnxinyminutes.com/docs/common-lisp/")))
|
||||
(create-gui-menu-item help :content "Simplified Reference" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://jtra.cz/stuff/lisp/sclr/index.html")))
|
||||
(create-gui-menu-item help :content "Common Lisp Manual" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "http://clhs.lisp.se/")))
|
||||
(create-gui-menu-item help :content "W3.CSS Manual" :on-click
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(open-window (window body) "https://www.w3schools.com/w3css/")))
|
||||
(create-gui-menu-item help :content "About CLOG Builder" :on-click #'on-help-about-builder)
|
||||
(create-gui-menu-window-select menu)
|
||||
(create-gui-menu-full-screen menu))
|
||||
(on-show-copy-history-win body)
|
||||
(cond
|
||||
(open-panel
|
||||
(if (equal open-panel " ")
|
||||
(setf open-panel nil)
|
||||
(setf (title (html-document body)) (file-namestring open-panel)))
|
||||
(cond ((equalp open-ext "t")
|
||||
(setf open-ext t))
|
||||
((equalp open-ext "custom")
|
||||
(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*
|
||||
(projects-load *start-project*))
|
||||
(on-project-tree body :project *start-project*)
|
||||
(when *start-dir*
|
||||
(handler-case
|
||||
(on-dir-tree 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-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 (eq *clog-debug-instance* body)
|
||||
(setf *clog-debug-instance* nil))
|
||||
(when *app-mode*
|
||||
|
|
@ -545,12 +555,12 @@ clog-builder window.")
|
|||
(clog-builder :app t :port 0 :start-browser nil)
|
||||
(sleep 1))
|
||||
(let* ((open-loc (if (and (> (length open-file) 5)
|
||||
(equal (subseq open-file (- (length open-file) 5)) ".clog"))
|
||||
(equal (subseq open-file (- (length open-file) 5)) ".clog"))
|
||||
"/panel-editor?open-panel"
|
||||
"/source-editor?open-file"))
|
||||
(open-url (format nil "~A=~A"
|
||||
open-loc (if (or (eq open-file nil)
|
||||
(equal open-file ""))
|
||||
(equal open-file ""))
|
||||
"%20"
|
||||
open-file))))
|
||||
(format t "~%If browser does not start go to http://127.0.0.1:~A~A" clog:*clog-port* open-url)
|
||||
|
|
@ -633,9 +643,10 @@ PATHNAME. Current format is one native namestring per line."
|
|||
(setf pathname (truename pathname))
|
||||
(with-open-file (stream (system-index-file pathname)
|
||||
:direction :output
|
||||
:if-exists :overwrite)
|
||||
(dolist (system-file (local-project-system-files pathname))
|
||||
(let ((system-path (enough-namestring system-file pathname)))
|
||||
(write-line (native-namestring system-path) stream)))
|
||||
(probe-file stream)))
|
||||
:if-exists :nil)
|
||||
(when stream
|
||||
(dolist (system-file (local-project-system-files pathname))
|
||||
(let ((system-path (enough-namestring system-file pathname)))
|
||||
(write-line (native-namestring system-path) stream)))
|
||||
(probe-file stream))))
|
||||
|
||||
|
|
|
|||
|
|
@ -175,6 +175,13 @@
|
|||
(setf (title (html-document body)) "CLOG DB Admin")
|
||||
(clog-gui-initialize body)
|
||||
(add-class body "w3-blue-grey")
|
||||
(when *password-protect*
|
||||
(input-dialog body "Enter password:" (lambda (result)
|
||||
(unless (equal result (if (functionp *password-protect*)
|
||||
(funcall *password-protect* body)
|
||||
*password-protect*))
|
||||
(close-connection (window body))))
|
||||
:time-out 360 :title "Password"))
|
||||
(let* ((menu (create-gui-menu-bar body))
|
||||
(icon (create-gui-menu-icon menu :on-click #'on-help-about))
|
||||
(file (create-gui-menu-drop-down menu :content "Database"))
|
||||
|
|
|
|||
4
tools/preferences.lisp.sample
vendored
4
tools/preferences.lisp.sample
vendored
|
|
@ -23,6 +23,10 @@
|
|||
|
||||
;; CLOG Builder Desktop
|
||||
|
||||
;; To password protect use of the IDE set to a password or a function that
|
||||
;; returns a password (lambda clog-body)
|
||||
(setf *password-protect* nil)
|
||||
|
||||
;; Open panels and files in new browser tabs by default
|
||||
(setf *open-external* nil)
|
||||
;; Use clog-popup and extend desktop to popups
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue