mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-05 18:20:36 -08:00
prep for switch to use ace editor
This commit is contained in:
parent
df44aa8a96
commit
8036651a36
6 changed files with 101 additions and 99 deletions
|
|
@ -15,121 +15,121 @@
|
|||
|
||||
(defun read-file (infile)
|
||||
(with-open-file (instream infile :direction :input :if-does-not-exist nil)
|
||||
(when instream
|
||||
(when instream
|
||||
(let ((string (make-string (file-length instream))))
|
||||
(read-sequence string instream)
|
||||
string))))
|
||||
|
||||
(defun write-file (string outfile &key (action-if-exists :rename))
|
||||
(check-type action-if-exists (member nil :error :new-version :rename :rename-and-delete
|
||||
(check-type action-if-exists (member nil :error :new-version :rename :rename-and-delete
|
||||
:overwrite :append :supersede))
|
||||
(with-open-file (outstream outfile :direction :output :if-exists action-if-exists)
|
||||
(write-sequence string outstream)))
|
||||
|
||||
(defun capture-eval (form)
|
||||
(let ((result (make-array '(0) :element-type 'base-char
|
||||
:fill-pointer 0 :adjustable t))
|
||||
(eval-result))
|
||||
:fill-pointer 0 :adjustable t))
|
||||
(eval-result))
|
||||
(with-output-to-string (stream result)
|
||||
(let ((*standard-output* stream)
|
||||
(*error-output* stream))
|
||||
(setf eval-result (eval (read-from-string (format nil "(progn ~A)" form))))))
|
||||
(format nil "~A~%=>~A~%" result eval-result)))
|
||||
(*error-output* stream))
|
||||
(setf eval-result (eval (read-from-string (format nil "(progn ~A)" form))))))
|
||||
(format nil "~A~%=>~A~%" result eval-result)))
|
||||
|
||||
(defun do-ide-file-new (obj)
|
||||
(let ((win (create-gui-window obj :title "New window"
|
||||
:height 400
|
||||
:width 650)))
|
||||
:height 400
|
||||
:width 650)))
|
||||
(set-on-window-size win (lambda (obj)
|
||||
(js-execute obj
|
||||
(format nil "editor_~A.resize()" (html-id win)))))
|
||||
(js-execute obj
|
||||
(format nil "editor_~A.resize()" (html-id win)))))
|
||||
(set-on-window-size-done win (lambda (obj)
|
||||
(js-execute obj
|
||||
(format nil "editor_~A.resize()" (html-id win)))))
|
||||
(js-execute obj
|
||||
(format nil "editor_~A.resize()" (html-id win)))))
|
||||
(create-child win
|
||||
(format nil
|
||||
"<script>
|
||||
(format nil
|
||||
"<script>
|
||||
var editor_~A = ace.edit('~A-body');
|
||||
editor_~A.setTheme('ace/theme/xcode');
|
||||
editor_~A.session.setMode('ace/mode/lisp');
|
||||
editor_~A.session.setTabSize(3);
|
||||
editor_~A.focus();
|
||||
</script>"
|
||||
(html-id win) (html-id win)
|
||||
(html-id win)
|
||||
(html-id win)
|
||||
(html-id win)
|
||||
(html-id win)))))
|
||||
(html-id win) (html-id win)
|
||||
(html-id win)
|
||||
(html-id win)
|
||||
(html-id win)
|
||||
(html-id win)))))
|
||||
|
||||
(defun do-ide-file-open (obj)
|
||||
(server-file-dialog obj "Open..." "./"
|
||||
(lambda (fname)
|
||||
(when fname
|
||||
(do-ide-file-new obj)
|
||||
(setf (window-title (current-window obj)) fname)
|
||||
(js-execute obj
|
||||
(format nil
|
||||
"editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||
(html-id (current-window obj))
|
||||
(escape-string (read-file fname))
|
||||
(html-id (current-window obj))))))))
|
||||
(lambda (fname)
|
||||
(when fname
|
||||
(do-ide-file-new obj)
|
||||
(setf (window-title (current-window obj)) fname)
|
||||
(js-execute obj
|
||||
(format nil
|
||||
"editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||
(html-id (current-window obj))
|
||||
(escape-string (read-file fname))
|
||||
(html-id (current-window obj))))))))
|
||||
|
||||
(defun do-ide-file-save-as (obj)
|
||||
(let* ((cw (current-window obj))
|
||||
(dir (directory-namestring (window-title cw))))
|
||||
(dir (directory-namestring (window-title cw))))
|
||||
(when cw
|
||||
(server-file-dialog obj "Save As.." dir
|
||||
(lambda (fname)
|
||||
(window-focus cw)
|
||||
(when fname
|
||||
(setf (window-title cw) fname)
|
||||
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id cw)))
|
||||
fname)))
|
||||
:initial-filename (when (equal (window-title cw) "New Window")
|
||||
(window-title cw))))))
|
||||
(lambda (fname)
|
||||
(window-focus cw)
|
||||
(when fname
|
||||
(setf (window-title cw) fname)
|
||||
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id cw)))
|
||||
fname)))
|
||||
:initial-filename (when (equal (window-title cw) "New Window")
|
||||
(window-title cw))))))
|
||||
|
||||
(defun do-ide-file-save (obj)
|
||||
(if (equalp (window-title (current-window obj)) "New Window")
|
||||
(do-ide-file-save-as obj)
|
||||
(let* ((cw (current-window obj))
|
||||
(fname (window-title cw)))
|
||||
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id cw)))
|
||||
fname)
|
||||
(setf (window-title cw) "SAVED")
|
||||
(sleep 2)
|
||||
(setf (window-title cw) fname))))
|
||||
(fname (window-title cw)))
|
||||
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id cw)))
|
||||
fname)
|
||||
(setf (window-title cw) "SAVED")
|
||||
(sleep 2)
|
||||
(setf (window-title cw) fname))))
|
||||
|
||||
(defun do-ide-edit-copy (obj)
|
||||
(let ((cw (current-window obj)))
|
||||
(when cw
|
||||
(let ((app (connection-data-item obj "app-data")))
|
||||
(setf (copy-buf app) (js-query obj
|
||||
(format nil "editor_~A.execCommand('copy');~
|
||||
(setf (copy-buf app) (js-query obj
|
||||
(format nil "editor_~A.execCommand('copy');~
|
||||
navigator.clipboard.writeText(editor_~A.getCopyText());~
|
||||
editor_~A.getCopyText();"
|
||||
(html-id cw) (html-id cw) (html-id cw))))))))
|
||||
(html-id cw) (html-id cw) (html-id cw))))))))
|
||||
|
||||
(defun do-ide-edit-undo (obj)
|
||||
(let ((cw (current-window obj)))
|
||||
(when cw
|
||||
(do-ide-edit-copy obj)
|
||||
(js-execute obj (format nil "editor_~A.execCommand('undo')"
|
||||
(html-id cw))))))
|
||||
|
||||
(html-id cw))))))
|
||||
|
||||
(defun do-ide-edit-redo (obj)
|
||||
(let ((cw (current-window obj)))
|
||||
(when cw
|
||||
(js-execute obj (format nil "editor_~A.execCommand('redo')"
|
||||
(html-id cw))))))
|
||||
(html-id cw))))))
|
||||
|
||||
(defun do-ide-edit-cut (obj)
|
||||
(let ((cw (current-window obj)))
|
||||
(when cw
|
||||
(do-ide-edit-copy obj)
|
||||
(js-execute obj (format nil "editor_~A.execCommand('cut')"
|
||||
(html-id cw))))))
|
||||
(html-id cw))))))
|
||||
|
||||
(defun do-ide-edit-paste (obj)
|
||||
(let ((cw (current-window obj)))
|
||||
|
|
@ -139,38 +139,38 @@
|
|||
(js-execute obj (format nil "navigator.clipboard.readText().then(function(text) {~
|
||||
editor_~A.execCommand('paste', text)~
|
||||
})"
|
||||
(html-id cw))))))
|
||||
(html-id cw))))))
|
||||
|
||||
(defun do-ide-lisp-eval-file (obj)
|
||||
(let ((cw (current-window obj)))
|
||||
(when cw
|
||||
(let* ((form-string (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id (current-window obj)))))
|
||||
(result (capture-eval form-string)))
|
||||
|
||||
(do-ide-file-new obj)
|
||||
(setf cw (current-window obj))
|
||||
(js-execute obj (format nil "editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||
(html-id cw)
|
||||
(escape-string result)
|
||||
(html-id cw)))))))
|
||||
(html-id (current-window obj)))))
|
||||
(result (capture-eval form-string)))
|
||||
|
||||
(do-ide-file-new obj)
|
||||
(setf cw (current-window obj))
|
||||
(js-execute obj (format nil "editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||
(html-id cw)
|
||||
(escape-string result)
|
||||
(html-id cw)))))))
|
||||
|
||||
(defun do-ide-help-about (obj)
|
||||
(let ((about (create-gui-window obj
|
||||
:title "About"
|
||||
:content "<div class='w3-black'>
|
||||
:title "About"
|
||||
:content "<div class='w3-black'>
|
||||
<center><img src='/img/clogwicon.png'></center>
|
||||
<center>CLOG</center>
|
||||
<center>The Common Lisp Omnificent GUI</center></div>
|
||||
<div><p><center>Demo 3</center>
|
||||
<center>CLOG</center>
|
||||
<center>The Common Lisp Omnificent GUI</center></div>
|
||||
<div><p><center>Demo 3</center>
|
||||
<center>(c) 2021 - David Botton</center></p></div>"
|
||||
:hidden t
|
||||
:width 200
|
||||
:height 215)))
|
||||
:hidden t
|
||||
:width 200
|
||||
:height 215)))
|
||||
(window-center about)
|
||||
(setf (visiblep about) t)
|
||||
(set-on-window-can-size about (lambda (obj)
|
||||
(declare (ignore obj))()))))
|
||||
(declare (ignore obj))()))))
|
||||
|
||||
(defun on-new-window (body)
|
||||
(set-html-on-close body "Connection Lost")
|
||||
|
|
@ -185,12 +185,12 @@
|
|||
(load-script (html-document body) "https://cdnjs.cloudflare.com/ajax/libs/ace/1.6.0/ace.js")
|
||||
(add-class body "w3-teal")
|
||||
(let* ((menu (create-gui-menu-bar body))
|
||||
(icon (create-gui-menu-icon menu :on-click #'do-ide-help-about))
|
||||
(file (create-gui-menu-drop-down menu :content "File"))
|
||||
(edit (create-gui-menu-drop-down menu :content "Edit"))
|
||||
(lisp (create-gui-menu-drop-down menu :content "Lisp"))
|
||||
(wind (create-gui-menu-drop-down menu :content "Window"))
|
||||
(help (create-gui-menu-drop-down menu :content "Help")))
|
||||
(icon (create-gui-menu-icon menu :on-click #'do-ide-help-about))
|
||||
(file (create-gui-menu-drop-down menu :content "File"))
|
||||
(edit (create-gui-menu-drop-down menu :content "Edit"))
|
||||
(lisp (create-gui-menu-drop-down menu :content "Lisp"))
|
||||
(wind (create-gui-menu-drop-down menu :content "Window"))
|
||||
(help (create-gui-menu-drop-down menu :content "Help")))
|
||||
(declare (ignore icon))
|
||||
(create-gui-menu-item file :content "New" :on-click #'do-ide-file-new)
|
||||
(create-gui-menu-item file :content "Open" :on-click #'do-ide-file-open)
|
||||
|
|
@ -208,9 +208,9 @@
|
|||
(create-gui-menu-item help :content "About" :on-click #'do-ide-help-about)
|
||||
(create-gui-menu-full-screen menu))
|
||||
(set-on-before-unload (window body) (lambda(obj)
|
||||
(declare (ignore obj))
|
||||
;; return empty string to prevent nav off page
|
||||
"")))
|
||||
(declare (ignore obj))
|
||||
;; return empty string to prevent nav off page
|
||||
"")))
|
||||
|
||||
(defun start-demo ()
|
||||
"Start demo."
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue