mirror of
https://github.com/rabbibotton/clog.git
synced 2026-03-15 03:01:42 -07:00
save status indicator
This commit is contained in:
David Botton
parent
dd99a8a30c
commit
e45ca1ea9a
2 changed files with 377 additions and 370 deletions
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue