From a696f63133e96bacb40346bb27db14c70e688f94 Mon Sep 17 00:00:00 2001 From: David Botton Date: Wed, 20 Mar 2024 15:48:56 -0400 Subject: [PATCH] added textual menu to source editor --- clean | 4 +- tools/clog-builder-files.lisp | 145 ++++++++++++++++++++++++---------- 2 files changed, 104 insertions(+), 45 deletions(-) diff --git a/clean b/clean index 06e1820..9d1ffb3 100755 --- a/clean +++ b/clean @@ -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" -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 delete-trailing-whitespace -f untabify -f whitespace-cleanup -f save-buffer -kill; done; rm -r *.fas rm -r *.fasl rm -r *~ diff --git a/tools/clog-builder-files.lisp b/tools/clog-builder-files.lisp index 9057b25..a06ec7f 100644 --- a/tools/clog-builder-files.lisp +++ b/tools/clog-builder-files.lisp @@ -54,7 +54,25 @@ :client-movement *client-side-movement*)) (box (create-panel-box-layout (window-content win) :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")) (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)) @@ -80,6 +98,9 @@ (last-date nil) (file-name "")) (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 (window-maximize win)) (when text @@ -129,10 +150,9 @@ (set-geometry status :units "" :width "" :height "20px" :bottom "0px" :left "0px" :right "0px") (setup-lisp-ace ace status) - (set-on-click btn-help - (lambda (obj) - (declare (ignore obj)) - (alert-dialog win + (labels ((on-help (obj) + (declare (ignore obj)) + (alert-dialog win " @@ -143,6 +163,8 @@
cmd/alt-,Configure editor
cmd/alt-. Launch system browser

Default Keybindings" :width 400 :height 300 :title "Help"))) + (set-on-click btn-help #'on-help) + (set-on-click m-helpk #'on-help)) (set-on-window-size-done win (lambda (obj) (declare (ignore obj)) @@ -187,11 +209,14 @@ (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) + (setf last-date (file-write-date file-name)) (sleep .5) (remove-class btn-save "w3-animate-top")))) - (flet ((save (obj data) + (flet ((save (obj data &key save-as) (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 "") (current-project-dir app) file-name) @@ -201,6 +226,7 @@ (setf file-name 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")) @@ -209,6 +235,7 @@ (cond ((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")) @@ -218,6 +245,7 @@ (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")))))))))) @@ -234,57 +262,88 @@ nil) (t t)))) - (set-on-mouse-click btn-save - (lambda (obj data) - (save obj data) - (setf is-dirty nil)))) + (set-on-mouse-click btn-save (lambda (obj data) + (save obj data))) + (set-on-click m-saveas (lambda (obj) + (save obj nil :save-as t))) + (set-on-click m-save (lambda (obj) + (save obj nil)))) (set-on-click btn-copy (lambda (obj) (declare (ignore obj)) (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) (declare (ignore obj)) (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) (declare (ignore obj)) (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) (declare (ignore obj)) (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) (declare (ignore obj)) (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) (declare (ignore obj)) (clog-ace:execute-command ace "redo"))) - (set-on-click btn-efrm (lambda (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)) - (tv (text-value ace)) - (lf nil) - (cp 0)) - (loop - (setf (values lf cp) (read-from-string tv nil nil :start cp)) - (unless lf (return nil)) - (when (> cp p) (return lf))) - (when lf - (let ((result (capture-eval lf - :clog-obj (connection-body obj) - :eval-in-package (text-value pac-line)))) - (on-open-file obj :title-class "w3-blue" :title "form eval" :text result)))))) - (set-on-click btn-esel (lambda (obj) - (let ((val (clog-ace:selected-text ace))) - (unless (equal val "") - (let ((result (capture-eval val :clog-obj obj - :eval-in-package (text-value pac-line)))) - (on-open-file obj :title-class "w3-blue" :title "selection eval" :text result)))))) - - (set-on-click btn-test (lambda (obj) - (let ((val (text-value ace))) - (unless (equal val "") - (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 m-redo (lambda (obj) + (declare (ignore obj)) + (clog-ace:execute-command ace "redo"))) + (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)) + (tv (text-value ace)) + (lf nil) + (cp 0)) + (loop + (setf (values lf cp) (read-from-string tv nil nil :start cp)) + (unless lf (return nil)) + (when (> cp p) (return lf))) + (when lf + (let ((result (capture-eval lf + :clog-obj (connection-body obj) + :eval-in-package (text-value pac-line)))) + (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 + :eval-in-package (text-value pac-line)))) + (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 + :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)))))))