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

added textual menu to source editor

Browse source
This commit is contained in:
David Botton 2024-03-20 15:48:56 -04:00
parent 37da492e64
commit a696f63133
2 changed files with 104 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

4
clean vendored
View file

@ -1,5 +1,5 @@
for file in "*.lisp"; do emacs -batch $file -l "~/.emacs.d/init.el" -f mark-whole-buffer -f untabify -f whitespace-cleanup -f save-buffer -kill; done; for file in "*.lisp"; do emacs -batch $file -l "~/.emacs.d/init.el" -f mark-whole-buffer -f delete-trailing-whitespace -f untabify -f whitespace-cleanup -f save-buffer -kill; done;
for file in "*.lisp"; do emacs -batch $file -l "~/.emacs" -f mark-whole-buffer -f untabify -f whitespace-cleanup -f save-buffer -kill; done; for file in "*.lisp"; do emacs -batch $file -l "~/.emacs" -f mark-whole-buffer -f delete-trailing-whitespace -f untabify -f whitespace-cleanup -f save-buffer -kill; done;
rm -r *.fas rm -r *.fas
rm -r *.fasl rm -r *.fasl
rm -r *~ rm -r *~

145
tools/clog-builder-files.lisp
View file

@ -54,7 +54,25 @@
:client-movement *client-side-movement*)) :client-movement *client-side-movement*))
(box (create-panel-box-layout (window-content win) (box (create-panel-box-layout (window-content win)
:left-width 0 :right-width 0 :left-width 0 :right-width 0
:top-height 33 :bottom-height 0)) :top-height 66 :bottom-height 0))
(menu (create-gui-menu-bar (top-panel box) :main-menu nil))
(m-file (create-gui-menu-drop-down menu :content "File"))
(m-load (create-gui-menu-item m-file :content "load"))
(m-save (create-gui-menu-item m-file :content "save (cmd/ctrl-s)"))
(m-saveas (create-gui-menu-item m-file :content "save as.."))
(m-edit (create-gui-menu-drop-down menu :content "Edit"))
(m-undo (create-gui-menu-item m-edit :content "undo"))
(m-redo (create-gui-menu-item m-edit :content "redo"))
(m-copy (create-gui-menu-item m-edit :content "copy"))
(m-paste (create-gui-menu-item m-edit :content "paste"))
(m-cut (create-gui-menu-item m-edit :content "cut"))
(m-del (create-gui-menu-item m-edit :content "delete"))
(m-lisp (create-gui-menu-drop-down menu :content "Lisp"))
(m-efrm (create-gui-menu-item m-lisp :content "Evaluate Form"))
(m-esel (create-gui-menu-item m-lisp :content "Evaluate Selection"))
(m-test (create-gui-menu-item m-lisp :content "Evaluate All"))
(m-help (create-gui-menu-drop-down menu :content "Help"))
(m-helpk (create-gui-menu-item m-help :content "Keyboard Help"))
(tool-bar (create-div (top-panel box) :class "w3-center")) (tool-bar (create-div (top-panel box) :class "w3-center"))
(btn-class "w3-button w3-white w3-border w3-border-black w3-ripple") (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple")
(btn-copy (create-img tool-bar :alt-text "copy" :url-src img-btn-copy :class btn-class)) (btn-copy (create-img tool-bar :alt-text "copy" :url-src img-btn-copy :class btn-class))
@ -80,6 +98,9 @@
(last-date nil) (last-date nil)
(file-name "")) (file-name ""))
(declare (ignore spacer1 spacer2)) (declare (ignore spacer1 spacer2))
(add-class menu "w3-small")
(setf (overflow (top-panel box)) :visible) ; let menus leave the top panel
(setf (z-index m-file) 10) ; fix for ace editor gutter overlapping menu
(when maximized (when maximized
(window-maximize win)) (window-maximize win))
(when text (when text
@ -129,10 +150,9 @@
(set-geometry status :units "" :width "" :height "20px" (set-geometry status :units "" :width "" :height "20px"
:bottom "0px" :left "0px" :right "0px") :bottom "0px" :left "0px" :right "0px")
(setup-lisp-ace ace status) (setup-lisp-ace ace status)
(set-on-click btn-help (labels ((on-help (obj)
(lambda (obj) (declare (ignore obj))
(declare (ignore obj)) (alert-dialog win
(alert-dialog win
"<table> "<table>
<tr><td>cmd/alt-,</td><td>Configure editor</td></tr> <tr><td>cmd/alt-,</td><td>Configure editor</td></tr>
<tr><td>cmd/alt-.</td><td> Launch system browser</td></tr> <tr><td>cmd/alt-.</td><td> Launch system browser</td></tr>
@ -143,6 +163,8 @@
</table><p><a target='_blank' href='https://github.com/ajaxorg/ace/wiki/Default-Keyboard-Shortcuts'>Default Keybindings</a>" </table><p><a target='_blank' href='https://github.com/ajaxorg/ace/wiki/Default-Keyboard-Shortcuts'>Default Keybindings</a>"
:width 400 :height 300 :width 400 :height 300
:title "Help"))) :title "Help")))
(set-on-click btn-help #'on-help)
(set-on-click m-helpk #'on-help))
(set-on-window-size-done win (set-on-window-size-done win
(lambda (obj) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
@ -187,11 +209,14 @@
(unless (equal file-name "") (unless (equal file-name "")
(add-class btn-save "w3-animate-top") (add-class btn-save "w3-animate-top")
(write-file (text-value ace) file-name :clog-obj obj) (write-file (text-value ace) file-name :clog-obj obj)
(setf is-dirty nil)
(setf last-date (file-write-date file-name))
(sleep .5) (sleep .5)
(remove-class btn-save "w3-animate-top")))) (remove-class btn-save "w3-animate-top"))))
(flet ((save (obj data) (flet ((save (obj data &key save-as)
(cond ((or (equal file-name "") (cond ((or (equal file-name "")
(getf data :shift-key)) (getf data :shift-key)
save-as)
(server-file-dialog obj "Save Source As.." (if (equal file-name "") (server-file-dialog obj "Save Source As.." (if (equal file-name "")
(current-project-dir app) (current-project-dir app)
file-name) file-name)
@ -201,6 +226,7 @@
(setf file-name fname) (setf file-name fname)
(add-class btn-save "w3-animate-top") (add-class btn-save "w3-animate-top")
(write-file (text-value ace) fname :clog-obj obj) (write-file (text-value ace) fname :clog-obj obj)
(setf is-dirty nil)
(setf last-date (file-write-date fname)) (setf last-date (file-write-date fname))
(sleep .5) (sleep .5)
(remove-class btn-save "w3-animate-top")) (remove-class btn-save "w3-animate-top"))
@ -209,6 +235,7 @@
(cond ((eql last-date (file-write-date file-name)) (cond ((eql last-date (file-write-date file-name))
(add-class btn-save "w3-animate-top") (add-class btn-save "w3-animate-top")
(write-file (text-value ace) file-name :clog-obj obj) (write-file (text-value ace) file-name :clog-obj obj)
(setf is-dirty nil)
(setf last-date (file-write-date file-name)) (setf last-date (file-write-date file-name))
(sleep .5) (sleep .5)
(remove-class btn-save "w3-animate-top")) (remove-class btn-save "w3-animate-top"))
@ -218,6 +245,7 @@
(when result (when result
(add-class btn-save "w3-animate-top") (add-class btn-save "w3-animate-top")
(write-file (text-value ace) file-name :clog-obj obj) (write-file (text-value ace) file-name :clog-obj obj)
(setf is-dirty nil)
(setf last-date (file-write-date file-name)) (setf last-date (file-write-date file-name))
(sleep .5) (sleep .5)
(remove-class btn-save "w3-animate-top")))))))))) (remove-class btn-save "w3-animate-top"))))))))))
@ -234,57 +262,88 @@
nil) nil)
(t (t
t)))) t))))
(set-on-mouse-click btn-save (set-on-mouse-click btn-save (lambda (obj data)
(lambda (obj data) (save obj data)))
(save obj data) (set-on-click m-saveas (lambda (obj)
(setf is-dirty nil)))) (save obj nil :save-as t)))
(set-on-click m-save (lambda (obj)
(save obj nil))))
(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)))
(set-on-click m-copy (lambda (obj)
(declare (ignore obj))
(clog-ace:clipboard-copy ace)))
(set-on-click btn-cut (lambda (obj) (set-on-click btn-cut (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:clipboard-cut ace))) (clog-ace:clipboard-cut ace)))
(set-on-click m-cut (lambda (obj)
(declare (ignore obj))
(clog-ace:clipboard-cut ace)))
(set-on-click btn-paste (lambda (obj) (set-on-click btn-paste (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:clipboard-paste ace))) (clog-ace:clipboard-paste ace)))
(set-on-click m-paste (lambda (obj)
(declare (ignore obj))
(clog-ace:clipboard-paste ace)))
(set-on-click btn-del (lambda (obj) (set-on-click btn-del (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:execute-command ace "del"))) (clog-ace:execute-command ace "del")))
(set-on-click m-del (lambda (obj)
(declare (ignore obj))
(clog-ace:execute-command ace "del")))
(set-on-click btn-undo (lambda (obj) (set-on-click btn-undo (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:execute-command ace "undo"))) (clog-ace:execute-command ace "undo")))
(set-on-click m-undo (lambda (obj)
(declare (ignore obj))
(clog-ace:execute-command ace "undo")))
(set-on-click btn-redo (lambda (obj) (set-on-click btn-redo (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:execute-command ace "redo"))) (clog-ace:execute-command ace "redo")))
(set-on-click btn-efrm (lambda (obj) (set-on-click m-redo (lambda (obj)
(let ((p (parse-integer (declare (ignore obj))
(js-query obj (clog-ace:execute-command ace "redo")))
(format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);" (labels ((eval-form (obj)
(clog-ace::js-ace ace) (let ((p (parse-integer
(clog-ace::js-ace ace))) (js-query obj
:junk-allowed t)) (format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);"
(tv (text-value ace)) (clog-ace::js-ace ace)
(lf nil) (clog-ace::js-ace ace)))
(cp 0)) :junk-allowed t))
(loop (tv (text-value ace))
(setf (values lf cp) (read-from-string tv nil nil :start cp)) (lf nil)
(unless lf (return nil)) (cp 0))
(when (> cp p) (return lf))) (loop
(when lf (setf (values lf cp) (read-from-string tv nil nil :start cp))
(let ((result (capture-eval lf (unless lf (return nil))
:clog-obj (connection-body obj) (when (> cp p) (return lf)))
:eval-in-package (text-value pac-line)))) (when lf
(on-open-file obj :title-class "w3-blue" :title "form eval" :text result)))))) (let ((result (capture-eval lf
(set-on-click btn-esel (lambda (obj) :clog-obj (connection-body obj)
(let ((val (clog-ace:selected-text ace))) :eval-in-package (text-value pac-line))))
(unless (equal val "") (on-open-file obj :title-class "w3-blue" :title "form eval" :text result)))))
(let ((result (capture-eval val :clog-obj obj (eval-selection (obj)
:eval-in-package (text-value pac-line)))) (let ((val (clog-ace:selected-text ace)))
(on-open-file obj :title-class "w3-blue" :title "selection eval" :text result)))))) (unless (equal val "")
(let ((result (capture-eval val :clog-obj obj
(set-on-click btn-test (lambda (obj) :eval-in-package (text-value pac-line))))
(let ((val (text-value ace))) (on-open-file obj :title-class "w3-blue" :title "selection eval" :text result)))))
(unless (equal val "") (eval-file (obj)
(let ((result (capture-eval val :clog-obj obj (let ((val (text-value ace)))
:eval-in-package (text-value pac-line)))) (unless (equal val "")
(on-open-file obj :title-class "w3-blue" :title "file eval" :text result))))))))) (let ((result (capture-eval val :clog-obj obj
:eval-in-package (text-value pac-line))))
(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)
(eval-selection obj)))
(set-on-click btn-efrm (lambda (obj)
(eval-form obj)))
(set-on-click m-efrm (lambda (obj)
(eval-form obj)))
(set-on-click btn-test (lambda (obj)
(eval-file obj)))
(set-on-click m-test (lambda (obj)
(eval-file obj)))))))