mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-05 18:20:36 -08:00
added textual menu to source editor
This commit is contained in:
David Botton
parent
37da492e64
commit
a696f63133
2 changed files with 104 additions and 45 deletions
4
clean
vendored
4
clean
vendored
|
|
@ -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 *~
|
||||
|
|
|
|||
|
|
@ -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
|
||||
"<table>
|
||||
<tr><td>cmd/alt-,</td><td>Configure editor</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>"
|
||||
: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)))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue