From e45ca1ea9ac868cfdacaf2d8079991995d5a65bd Mon Sep 17 00:00:00 2001 From: David Botton Date: Wed, 17 Apr 2024 23:51:34 -0400 Subject: [PATCH] save status indicator --- tools/clog-builder-files.lisp | 207 ++++++------- tools/clog-builder.lisp | 540 +++++++++++++++++----------------- 2 files changed, 377 insertions(+), 370 deletions(-) diff --git a/tools/clog-builder-files.lisp b/tools/clog-builder-files.lisp index 50bcd37..8e968fe 100644 --- a/tools/clog-builder-files.lisp +++ b/tools/clog-builder-files.lisp @@ -19,7 +19,7 @@ (defun write-file (string outfile &key clog-obj (action-if-exists :rename)) "Write local file named OUTFILE" (check-type action-if-exists (member nil :error :new-version :rename :rename-and-delete - :overwrite :append :supersede)) + :overwrite :append :supersede)) (handler-case (with-open-file (outstream outfile :direction :output :if-exists action-if-exists) (when outstream @@ -48,8 +48,8 @@ (clog-gui-initialize pop :parent-desktop-obj obj) (add-class pop *builder-window-desktop-class*) (if open-file - (setf (title (html-document pop)) (file-namestring open-file)) - (setf (title (html-document pop)) "CLOG Builder Source Editor")) + (setf (title (html-document pop)) (file-namestring open-file)) + (setf (title (html-document pop)) "CLOG Builder Source Editor")) (on-open-file pop :open-file open-file :maximized t)) (on-open-file obj :open-file open-file))) (open-window (window (connection-body obj)) @@ -63,13 +63,13 @@ :name "_blank")))))) (defun on-open-file (obj &key open-file - (title "New Source Editor") - text - (title-class *builder-title-class*) - lisp-package - regex - (editor-use-console-for-evals *editor-use-console-for-evals*) - maximized) + (title "New Source Editor") + text + (title-class *builder-title-class*) + lisp-package + regex + (editor-use-console-for-evals *editor-use-console-for-evals*) + maximized) "Open a new text editor" (let ((win (window-to-top-by-title obj open-file))) (when win @@ -90,9 +90,9 @@ (*default-title-class* *builder-title-class*) (*default-border-class* *builder-border-class*) (win (create-gui-window obj :title title - :title-class title-class - :width 700 :height 480 - :client-movement *client-side-movement*)) + :title-class title-class + :width 700 :height 480 + :client-movement *client-side-movement*)) (box (create-panel-box-layout (window-content win) :left-width 0 :right-width 0 :top-height 66 :bottom-height 0)) @@ -199,17 +199,17 @@ (setf (positioning ace) :absolute) (setf (positioning status) :absolute) (set-geometry pac-line :units "" :top "20px" :left "0px" - :right "0px" :height "22px" :width "100%") + :right "0px" :height "22px" :width "100%") (setf (place-holder pac-line) "Current Package") (if lisp-package (setf (text-value pac-line) lisp-package) (setf (text-value pac-line) "clog-user")) (setf (current-editor-is-lisp app) "clog-user") (set-geometry ace :units "" :width "" :height "" - :top "22px" :bottom "20px" :left "0px" :right "0px") + :top "22px" :bottom "20px" :left "0px" :right "0px") (clog-ace:resize ace) (set-geometry status :units "" :width "" :height "20px" - :bottom "0px" :left "0px" :right "0px") + :bottom "0px" :left "0px" :right "0px") (setup-lisp-ace ace status) (labels ((on-help (obj) (declare (ignore obj)) @@ -232,7 +232,14 @@ (lambda (obj) (declare (ignore obj)) (clog-ace:resize ace))) - (labels ((open-file-name (fname) + (labels ((set-is-dirty (status) + (cond (status + (setf is-dirty t) + (set-outline btn-save :yellow :solid :thin)) + (t + (setf is-dirty nil) + (set-outline btn-save :green :solid :thin)))) + (open-file-name (fname) (window-focus win) (handler-case (when fname @@ -242,14 +249,14 @@ (let ((c (or (read-file fname :clog-obj obj) ""))) (cond ((or (equalp (pathname-type fname) "lisp") (equalp (pathname-type fname) "asd")) - (setf (clog-ace:mode ace) "ace/mode/lisp") - (setf (text-value pac-line) (get-package-from-string c)) - (setf lisp-file t) - (setf (current-editor-is-lisp app) (text-value pac-line))) + (setf (clog-ace:mode ace) "ace/mode/lisp") + (setf (text-value pac-line) (get-package-from-string c)) + (setf lisp-file t) + (setf (current-editor-is-lisp app) (text-value pac-line))) (t - (setf lisp-file nil) - (setf (current-editor-is-lisp app) nil) - (setf (clog-ace:mode ace) (clog-ace:get-mode-from-extension ace fname)))) + (setf lisp-file nil) + (setf (current-editor-is-lisp app) nil) + (setf (clog-ace:mode ace) (clog-ace:get-mode-from-extension ace fname)))) (setf (clog-ace:text-value ace) c))) (error (condition) (unless text @@ -261,7 +268,7 @@ file-name)) (lambda (fname) (open-file-name fname) - (setf is-dirty nil))))) + (set-is-dirty nil))))) (when (and open-file (not (equalp open-file " ")) (not (equalp open-file ""))) @@ -273,17 +280,17 @@ (set-on-click m-load (lambda (obj) (load-file obj))) (set-on-click m-revert (lambda (obj) (declare (ignore obj)) - (setf is-dirty nil) - (open-file-name file-name)))) + (set-is-dirty nil) + (open-file-name file-name))) (set-on-input ace (lambda (obj) (declare (ignore obj)) - (setf is-dirty t))) + (set-is-dirty t))) (set-on-event ace "clog-save-ace" (lambda (obj) (unless (equal file-name "") (add-class btn-save "w3-animate-top") (write-file (text-value ace) file-name :clog-obj obj) - (setf is-dirty nil) + (set-is-dirty nil) (setf last-date (file-write-date file-name)) (sleep .5) (remove-class btn-save "w3-animate-top")))) @@ -291,40 +298,40 @@ (cond ((or (equal file-name "") (getf data :shift-key) save-as) - (server-file-dialog obj "Save Source As.." (if (equal file-name "") - (current-project-dir app) - file-name) - (lambda (fname) - (window-focus win) - (when fname - (setf file-name fname) - (setf (window-title win) fname) - (add-class btn-save "w3-animate-top") - (write-file (text-value ace) fname :clog-obj obj) - (setf is-dirty nil) - (setf last-date (file-write-date fname)) - (sleep .5) - (remove-class btn-save "w3-animate-top")) - :initial-filename file-name))) + (server-file-dialog obj "Save Source As.." (if (equal file-name "") + (current-project-dir app) + file-name) + (lambda (fname) + (window-focus win) + (when fname + (setf file-name fname) + (setf (window-title win) fname) + (add-class btn-save "w3-animate-top") + (write-file (text-value ace) fname :clog-obj obj) + (set-is-dirty nil) + (setf last-date (file-write-date fname)) + (sleep .5) + (remove-class btn-save "w3-animate-top")) + :initial-filename file-name))) (t - (cond ((or (not (probe-file file-name)) - (eql last-date (file-write-date file-name))) - (add-class btn-save "w3-animate-top") - (write-file (text-value ace) file-name :clog-obj obj) - (setf is-dirty nil) - (setf last-date (file-write-date file-name)) - (sleep .5) - (remove-class btn-save "w3-animate-top")) - (t - (confirm-dialog obj "File changed on file system. Save?" - (lambda (result) - (when result - (add-class btn-save "w3-animate-top") - (write-file (text-value ace) file-name :clog-obj obj) - (setf is-dirty nil) - (setf last-date (file-write-date file-name)) - (sleep .5) - (remove-class btn-save "w3-animate-top")))))))))) + (cond ((or (not (probe-file file-name)) + (eql last-date (file-write-date file-name))) + (add-class btn-save "w3-animate-top") + (write-file (text-value ace) file-name :clog-obj obj) + (set-is-dirty nil) + (setf last-date (file-write-date file-name)) + (sleep .5) + (remove-class btn-save "w3-animate-top")) + (t + (confirm-dialog obj "File changed on file system. Save?" + (lambda (result) + (when result + (add-class btn-save "w3-animate-top") + (write-file (text-value ace) file-name :clog-obj obj) + (set-is-dirty nil) + (setf last-date (file-write-date file-name)) + (sleep .5) + (remove-class btn-save "w3-animate-top")))))))))) (when m-emacs (set-on-click m-emacs (lambda (obj) (when is-dirty @@ -340,16 +347,16 @@ (set-on-window-can-close win (lambda (obj) (cond (is-dirty - (confirm-dialog obj "Save File?" - (lambda (result) - (setf is-dirty nil) - (when result - (save obj nil)) - (window-close win)) - :ok-text "Yes" :cancel-text "No") - nil) + (confirm-dialog obj "Save File?" + (lambda (result) + (set-is-dirty nil) + (when result + (save obj nil)) + (window-close win)) + :ok-text "Yes" :cancel-text "No") + nil) (t - t)))) + t)))) (set-on-mouse-click btn-save (lambda (obj data) (save obj data))) (set-on-click m-saveas (lambda (obj) @@ -408,21 +415,21 @@ (clog-ace:execute-command ace "redo"))) (set-on-click m-desc (lambda (obj) (let ((r (make-array '(0) :element-type 'base-char - :fill-pointer 0 :adjustable t))) + :fill-pointer 0 :adjustable t))) (with-output-to-string (s r) (let ((*standard-output* s)) (describe (find-symbol (string-upcase (clog-ace:selected-text ace)) (string-upcase (text-value pac-line))))) (on-open-file obj :title-class "w3-purple" :title "describe selection" - :text r))))) + :text r))))) (set-on-click m-apro (lambda (obj) (let ((r (make-array '(0) :element-type 'base-char - :fill-pointer 0 :adjustable t))) + :fill-pointer 0 :adjustable t))) (with-output-to-string (s r) (let ((*standard-output* s)) (apropos (clog-ace:selected-text ace))) (on-open-file obj :title-class "w3-purple" :title "apropos selection" - :text r))))) + :text r))))) (set-on-click m-brws (lambda (obj) (declare (ignore obj)) (on-new-sys-browser ace :search (clog-ace:selected-text ace)))) @@ -442,17 +449,17 @@ (set-on-click m-ppr (lambda (obj) (declare (ignore obj)) (let ((r (make-array '(0) :element-type 'base-char - :fill-pointer 0 :adjustable t))) + :fill-pointer 0 :adjustable t))) (with-output-to-string (s r) (with-input-from-string (n (text-value ace)) (let ((*standard-output* s)) (indentify:indentify n)))) (setf (text-value ace) r) - (setf is-dirty t)))) + (set-is-dirty t)))) (set-on-click m-pprs (lambda (obj) (declare (ignore obj)) (let ((r (make-array '(0) :element-type 'base-char - :fill-pointer 0 :adjustable t))) + :fill-pointer 0 :adjustable t))) (with-output-to-string (s r) (with-input-from-string (n (clog-ace:selected-text ace)) (let ((*standard-output* s)) @@ -460,19 +467,19 @@ (js-execute ace (format nil "~A.insert('~A',true)" (clog-ace::js-ace ace) (escape-string r))) - (setf is-dirty t)))) + (set-is-dirty t)))) (set-on-event-with-data ace "clog-adjust-tabs" (lambda (obj data) (declare (ignore obj)) (let ((r (make-array '(0) :element-type 'base-char - :fill-pointer 0 :adjustable t))) + :fill-pointer 0 :adjustable t))) (with-output-to-string (s r) (with-input-from-string (n data) (let ((*standard-output* s)) (indentify:indentify n)))) (loop (multiple-value-bind (start end) - (ppcre:scan "(^.*)\\n" r) + (ppcre:scan "(^.*)\\n" r) (unless start (return)) (setf r (subseq r end)))) @@ -481,14 +488,14 @@ (js-execute ace (format nil "~A.insert('~A',true)" (clog-ace::js-ace ace) (escape-string r))) - (setf is-dirty t))))) + (set-is-dirty t))))) (labels ((eval-form (obj) (let ((p (parse-integer - (js-query obj - (format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);" - (clog-ace::js-ace ace) - (clog-ace::js-ace ace))) - :junk-allowed t)) + (js-query obj + (format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);" + (clog-ace::js-ace ace) + (clog-ace::js-ace ace))) + :junk-allowed t)) (tv (text-value ace)) (lf nil) (cp 0)) @@ -503,28 +510,28 @@ :clog-obj (connection-body obj) :eval-in-package (text-value pac-line)))) (if editor-use-console-for-evals - (on-open-console obj) - (on-open-file obj :title-class "w3-blue" :title "form eval" :text result)))))) + (on-open-console obj) + (on-open-file obj :title-class "w3-blue" :title "form eval" :text result)))))) (eval-selection (obj) (let ((val (clog-ace:selected-text ace))) (unless (equal val "") (let ((result (capture-eval val :clog-obj obj - :capture-console (not editor-use-console-for-evals) - :capture-result (not editor-use-console-for-evals) - :eval-in-package (text-value pac-line)))) + :capture-console (not editor-use-console-for-evals) + :capture-result (not editor-use-console-for-evals) + :eval-in-package (text-value pac-line)))) (if editor-use-console-for-evals - (on-open-console obj) - (on-open-file obj :title-class "w3-blue" :title "selection eval" :text result)))))) + (on-open-console obj) + (on-open-file obj :title-class "w3-blue" :title "selection eval" :text result)))))) (eval-file (obj) (let ((val (text-value ace))) (unless (equal val "") (let ((result (capture-eval val :clog-obj obj - :capture-console (not editor-use-console-for-evals) - :capture-result (not editor-use-console-for-evals) - :eval-in-package (text-value pac-line)))) + :capture-console (not editor-use-console-for-evals) + :capture-result (not editor-use-console-for-evals) + :eval-in-package (text-value pac-line)))) (if editor-use-console-for-evals - (on-open-console obj) - (on-open-file obj :title-class "w3-blue" :title "file eval" :text result))))))) + (on-open-console obj) + (on-open-file obj :title-class "w3-blue" :title "file eval" :text result))))))) (set-on-click btn-esel (lambda (obj) (eval-selection obj))) (set-on-click m-esel (lambda (obj) @@ -537,4 +544,4 @@ (eval-file obj))) (set-on-click m-test (lambda (obj) (eval-file obj)))) - win)))) + win))))) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 9259fbb..0e8aaf9 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -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") @@ -25,113 +25,113 @@ clog-builder window.") (defclass builder-app-data () ((stdout - :accessor stdout - :initform nil - :documentation "The standard-output for this instance") + :accessor stdout + :initform nil + :documentation "The standard-output for this instance") (copy-buf - :accessor copy-buf - :initform nil - :documentation "Copy buffer") + :accessor copy-buf + :initform nil + :documentation "Copy buffer") (copy-history-win - :accessor copy-history-win - :initform nil - :documentation "Copy history window") + :accessor copy-history-win + :initform nil + :documentation "Copy history window") (console-win - :accessor console-win - :initform nil - :documentation "Console window") + :accessor console-win + :initform nil + :documentation "Console window") (next-panel-id - :accessor next-panel-id - :initform 0 - :documentation "Next new panel id") + :accessor next-panel-id + :initform 0 + :documentation "Next new panel id") (current-control - :accessor current-control - :initform nil - :documentation "Current selected control") + :accessor current-control + :initform nil + :documentation "Current selected control") (select-tool - :accessor select-tool - :initform nil - :documentation "Select tool") + :accessor select-tool + :initform nil + :documentation "Select tool") (properties-list - :accessor properties-list - :initform nil - :documentation "Property list in properties window") + :accessor properties-list + :initform nil + :documentation "Property list in properties window") (current-project - :accessor current-project - :initform *start-project* - :documentation "Current Project") + :accessor current-project + :initform *start-project* + :documentation "Current Project") (current-project-dir - :accessor current-project-dir - :initform "" - :documentation "Current Project") + :accessor current-project-dir + :initform "" + :documentation "Current Project") (project-win - :accessor project-win - :initform nil - :documentation "Project window") + :accessor project-win + :initform nil + :documentation "Project window") (control-properties-win - :accessor control-properties-win - :initform nil - :documentation "Current control properties window") + :accessor control-properties-win + :initform nil + :documentation "Current control properties window") (events-list - :accessor events-list - :initform nil - :documentation "Event list in events window") + :accessor events-list + :initform nil + :documentation "Event list in events window") (event-editor - :accessor event-editor - :initform nil - :documentation "Editor in events window") + :accessor event-editor + :initform nil + :documentation "Editor in events window") (events-js-list - :accessor events-js-list - :initform nil - :documentation "JS Event list in events window") + :accessor events-js-list + :initform nil + :documentation "JS Event list in events window") (event-js-editor - :accessor event-js-editor - :initform nil - :documentation "JS Editor in events window") + :accessor event-js-editor + :initform nil + :documentation "JS Editor in events window") (events-ps-list - :accessor events-ps-list - :initform nil - :documentation "ParenScript Event list in events window") + :accessor events-ps-list + :initform nil + :documentation "ParenScript Event list in events window") (event-ps-editor - :accessor event-ps-editor - :initform nil - :documentation "PS Editor in events window") + :accessor event-ps-editor + :initform nil + :documentation "PS Editor in events window") (auto-complete-configured - :accessor auto-complete-configured - :initform nil - :documentation "Auto complete is setup once per instance") + :accessor auto-complete-configured + :initform nil + :documentation "Auto complete is setup once per instance") (current-editor-is-lisp - :accessor current-editor-is-lisp - :initform nil - :documentation "Turn or off swank autocomplete") + :accessor current-editor-is-lisp + :initform nil + :documentation "Turn or off swank autocomplete") (control-events-win - :accessor control-events-win - :initform nil - :documentation "Current control events window") + :accessor control-events-win + :initform nil + :documentation "Current control events window") (control-js-events-win - :accessor control-js-events-win - :initform nil - :documentation "Current control events window") + :accessor control-js-events-win + :initform nil + :documentation "Current control events window") (control-ps-events-win - :accessor control-ps-events-win - :initform nil - :documentation "Current control events window") + :accessor control-ps-events-win + :initform nil + :documentation "Current control events window") (controls-win - :accessor controls-win - :initform nil - :documentation "Current controls window") + :accessor controls-win + :initform nil + :documentation "Current controls window") (control-list-win - :accessor control-list-win - :initform nil - :documentation "Current control list window") + :accessor control-list-win + :initform nil + :documentation "Current control list window") (control-pallete-win - :accessor control-pallete-win - :initform nil - :documentation "Current control pallete window") + :accessor control-pallete-win + :initform nil + :documentation "Current control pallete window") (control-lists - :accessor control-lists - :initform (make-hash-table* :test #'equalp) - :documentation "Panel -> Control List - hash table"))) + :accessor control-lists + :initform (make-hash-table* :test #'equalp) + :documentation "Panel -> Control List - hash table"))) ;; Show windows @@ -145,8 +145,8 @@ clog-builder window.") (setf (hiddenp (copy-history-win app)) nil) (window-focus (copy-history-win app))) (let* ((win (create-gui-window obj :title "Copy History" - :height 400 :width 600 - :has-pinner t :client-movement *client-side-movement*))) + :height 400 :width 600 + :has-pinner t :client-movement *client-side-movement*))) (window-center win) (setf (hiddenp win) t) (setf (overflow (window-content win)) :scroll) @@ -190,7 +190,7 @@ clog-builder window.") (let* ((*default-title-class* *builder-title-class*) (*default-border-class* *builder-border-class*) (win (create-gui-window obj :title "New Application Template" - :width 500 :height 400)) + :width 500 :height 400)) (ct (create-clog-templates (window-content win)))) (window-center win) (setf (win ct) win) @@ -204,7 +204,7 @@ clog-builder window.") (let* ((*default-title-class* *builder-title-class*) (*default-border-class* *builder-border-class*) (win (create-gui-window obj :title "Convert Images to Data" - :width 450 :height 200))) + :width 450 :height 200))) (create-image-to-data (window-content win)) (window-center win))) @@ -215,7 +215,7 @@ clog-builder window.") (params (form-multipart-data body))) (create-div body :content params) (destructuring-bind (stream fname content-type) - (form-data-item params "filename") + (form-data-item params "filename") (create-div body :content (format nil "filename = ~A - " fname)) (let ((s (flexi-streams:make-flexi-stream stream)) (pic-data "")) @@ -234,9 +234,9 @@ clog-builder window.") (let* ((*default-title-class* *builder-title-class*) (*default-border-class* *builder-border-class*) (win (create-gui-window obj :title "Thread Viewer" - :top 40 :left 225 - :width 600 :height 400 - :client-movement *client-side-movement*))) + :top 40 :left 225 + :width 600 :height 400 + :client-movement *client-side-movement*))) (create-thread-list (window-content win)))) (defun on-show-callers (body) @@ -248,12 +248,12 @@ clog-builder window.") (when result (handler-case (on-open-file body :title (format nil "Callers of ~A" result) - :title-class *builder-show-callers-class* - :text (swank::list-callers (read-from-string result))) + :title-class *builder-show-callers-class* + :text (swank::list-callers (read-from-string result))) (t (c) (on-open-file body :title "Error - Callers" - :title-class "w3-red" - :text c)))))))) + :title-class "w3-red" + :text c)))))))) (defun on-show-callees (body) "Open callees window" @@ -264,28 +264,28 @@ clog-builder window.") (when result (handler-case (on-open-file body :title (format nil "Callees of ~A" result) - :title-class *builder-show-callees-class* - :text (swank::list-callees (read-from-string result))) + :title-class *builder-show-callees-class* + :text (swank::list-callees (read-from-string result))) (t (c) (on-open-file body :title "Error - Callees" - :title-class "w3-red" - :text c)))))))) + :title-class "w3-red" + :text c)))))))) (defun on-opts-edit (body) (let ((pref (read-file (format nil "~A.sample" *preferances-file*)))) (unless pref - (setf pref ";; No sample preferances file found")) + (setf pref ";; No sample preferances file found")) (on-open-file body :open-file *preferances-file* - :lisp-package "clog-tools" - :text pref - :title *preferances-file*))) + :lisp-package "clog-tools" + :text pref + :title *preferances-file*))) (defun on-update-clog (body) (if *app-mode* (alert-dialog body "Results of update will apear when completed. You may need to press ENTER on OS console window." - :title "CLOG Update") + :title "CLOG Update") (alert-toast body "CLOG Update" "Results of update will apear when completed." @@ -293,11 +293,11 @@ clog-builder window.") (let ((results (capture-eval "(ql:update-all-dists :prompt nil)" :clog-obj body))) (if *app-mode* (on-open-file body :title "CLOG Updated - Close builder, rerun make/update and rerun." - :title-class "w3-green w3-animate-top" - :text results) + :title-class "w3-green w3-animate-top" + :text results) (on-open-file body :title "CLOG Updated - Close builder, rerun (ql:quickload :clog/tools)(clog-tools:clog-builder)" - :title-class "w3-green w3-animate-top" - :text results)))) + :title-class "w3-green w3-animate-top" + :text results)))) (defun on-open-file-window (body) (on-new-builder body)) @@ -330,167 +330,167 @@ clog-builder window.") (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 :left 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)) - ;; 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 "CLOG Builder Console" :on-click 'on-open-console) - (create-gui-menu-item tools :content "OS Shell" :on-click 'on-shell) - (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)) - (setf *open-external-with-emacs* (not *open-external-with-emacs*)) - (setf (text-value exter) (exter-text)))))) - (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-win 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-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)) - :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 *builder-window-show-static-root-class* + (setf (z-index (create-panel body :positioning :fixed + :bottom 0 :left 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)) + ;; 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 "CLOG Builder Console" :on-click 'on-open-console) + (create-gui-menu-item tools :content "OS Shell" :on-click 'on-shell) + (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)) + (setf *open-external-with-emacs* (not *open-external-with-emacs*)) + (setf (text-value exter) (exter-text)))))) + (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-win 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-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)) + :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)) @@ -501,7 +501,7 @@ clog-builder window.") (uiop:quit)))) (defun clog-builder (&key (port 8080) (start-browser t) - app project dir static-root system clogframe) + app project dir static-root system clogframe) "Start clog-builder. When PORT is 0 choose a random port. When APP is t, shutdown applicatoin on termination of first window. If APP eq :BATCH then must specific default project :PROJECT and it will be batch rerendered