mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

shift click for save as... otherwise save

Browse source
This commit is contained in:
David Botton 2022-08-22 20:47:35 -04:00
parent 51b8d57d05
commit 241c9953a8
1 changed files with 52 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

90
tools/clog-builder.lisp
View file

@ -1516,7 +1516,7 @@ of controls and double click to select control."
(setf (advisory-title btn-redo) "redo") (setf (advisory-title btn-redo) "redo")
(setf (advisory-title btn-test) "test") (setf (advisory-title btn-test) "test")
(setf (advisory-title btn-rndr) "render to lisp") (setf (advisory-title btn-rndr) "render to lisp")
(setf (advisory-title btn-save) "save") (setf (advisory-title btn-save) "save - shift-click save as...")
(setf (advisory-title btn-load) "load") (setf (advisory-title btn-load) "load")
(setf (height btn-copy) "12px") (setf (height btn-copy) "12px")
(setf (height btn-paste) "12px") (setf (height btn-paste) "12px")
@ -1684,18 +1684,23 @@ of controls and double click to select control."
(window-focus win) (window-focus win)
(when fname (when fname
(open-file-name fname))))))) (open-file-name fname)))))))
(set-on-click btn-save (lambda (obj) (set-on-mouse-click btn-save
(when (equal file-name "") (lambda (obj data)
(setf file-name (format nil "~A~A.clog" (cond ((or (equal file-name "")
(current-project-dir app) (getf data :shift-key))
(attribute content "data-clog-name")))) (when (equal file-name "")
(server-file-dialog obj "Save Panel As.." file-name (setf file-name (format nil "~A~A.clog"
(lambda (fname) (current-project-dir app)
(window-focus win) (attribute content "data-clog-name"))))
(when fname (server-file-dialog obj "Save Panel As.." file-name
(setf file-name fname) (lambda (fname)
(save-panel fname content panel-id (bottom-panel box))) (window-focus win)
:initial-filename file-name)))) (when fname
(setf file-name fname)
(save-panel fname content panel-id (bottom-panel box)))
:initial-filename file-name)))
(t
(save-panel file-name content panel-id (bottom-panel box))))))
(set-on-click btn-test (set-on-click btn-test
(lambda (obj) (lambda (obj)
(do-eval obj (render-clog-code content (bottom-panel box)) (do-eval obj (render-clog-code content (bottom-panel box))
@ -1825,7 +1830,7 @@ of controls and double click to select control."
(setf (advisory-title btn-redo) "redo") (setf (advisory-title btn-redo) "redo")
(setf (advisory-title btn-test) "test") (setf (advisory-title btn-test) "test")
(setf (advisory-title btn-rndr) "render to lisp") (setf (advisory-title btn-rndr) "render to lisp")
(setf (advisory-title btn-save) "save") (setf (advisory-title btn-save) "save - shift-click save as...")
(setf (advisory-title btn-load) "load") (setf (advisory-title btn-load) "load")
(setf (advisory-title btn-sim) "start simulation") (setf (advisory-title btn-sim) "start simulation")
(setf (advisory-title btn-exp) "export as boot page") (setf (advisory-title btn-exp) "export as boot page")
@ -2002,18 +2007,23 @@ of controls and double click to select control."
(setf (title (html-document body)) (attribute content "data-clog-name")) (setf (title (html-document body)) (attribute content "data-clog-name"))
(setf (window-title win) (attribute content "data-clog-name")) (setf (window-title win) (attribute content "data-clog-name"))
(on-populate-control-list-win content :win win)))))) (on-populate-control-list-win content :win win))))))
(set-on-click btn-save (lambda (obj) (set-on-mouse-click btn-save
(when (equal file-name "") (lambda (obj data)
(setf file-name (format nil "~A~A.clog" (cond ((or (equal file-name "")
(current-project-dir app) (getf data :shift-key))
(attribute content "data-clog-name")))) (when (equal file-name "")
(server-file-dialog obj "Save Page As.." file-name (setf file-name (format nil "~A~A.clog"
(lambda (fname) (current-project-dir app)
(window-focus win) (attribute content "data-clog-name"))))
(when fname (server-file-dialog obj "Save Panel As.." file-name
(setf file-name fname) (lambda (fname)
(save-panel fname content panel-id (bottom-panel box))) (window-focus win)
:initial-filename file-name)))) (when fname
(setf file-name fname)
(save-panel fname content panel-id (bottom-panel box)))
:initial-filename file-name)))
(t
(save-panel file-name content panel-id (bottom-panel box))))))
(set-on-click btn-test (set-on-click btn-test
(lambda (obj) (lambda (obj)
(do-eval obj (render-clog-code content (bottom-panel box)) (do-eval obj (render-clog-code content (bottom-panel box))
@ -2253,7 +2263,7 @@ of controls and double click to select control."
(setf (advisory-title btn-del) "delete") (setf (advisory-title btn-del) "delete")
(setf (advisory-title btn-undo) "undo") (setf (advisory-title btn-undo) "undo")
(setf (advisory-title btn-redo) "redo") (setf (advisory-title btn-redo) "redo")
(setf (advisory-title btn-save) "save") (setf (advisory-title btn-save) "save - shift-click save as...")
(setf (advisory-title btn-load) "load") (setf (advisory-title btn-load) "load")
(setf (advisory-title btn-efrm) "evaluate form") (setf (advisory-title btn-efrm) "evaluate form")
(setf (advisory-title btn-esel) "evaluate selection") (setf (advisory-title btn-esel) "evaluate selection")
@ -2314,17 +2324,21 @@ of controls and double click to select control."
file-name)) file-name))
(lambda (fname) (lambda (fname)
(open-file-name fname)))))) (open-file-name fname))))))
(set-on-click btn-save (lambda (obj) (set-on-mouse-click btn-save
(server-file-dialog obj "Save Source As.." (if (equal file-name "") (lambda (obj data)
(current-project-dir app) (cond ((or (equal file-name "")
file-name) (getf data :shift-key))
(lambda (fname) (server-file-dialog obj "Save Source As.." (if (equal file-name "")
(window-focus win) (current-project-dir app)
(when fname file-name)
(setf file-name fname) (lambda (fname)
(setf (window-title win) fname) (window-focus win)
(write-file (text-value ace) fname))) (when fname
:initial-filename file-name))) (setf file-name fname)
(write-file (text-value ace) fname)))
:initial-filename file-name))
(t
(write-file (text-value ace) file-name)))))
(set-on-click btn-copy (lambda (obj) (set-on-click btn-copy (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:clipboard-copy ace))) (clog-ace:clipboard-copy ace)))