mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
prep for switch to use ace editor
This commit is contained in:
David Botton
parent
df44aa8a96
commit
8036651a36
6 changed files with 101 additions and 99 deletions
|
|
@ -28,108 +28,108 @@
|
|||
|
||||
(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))))))
|
||||
(*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)))
|
||||
(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)))))))
|
||||
(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."
|
||||
|
|
|
|||
|
|
@ -483,9 +483,8 @@ place-inside-bottom-of CLOG-OBJ."))
|
|||
(defmethod text-value ((obj clog-meter))
|
||||
(property obj "value"))
|
||||
|
||||
(defmethod set-text-value ((obj clog-meter) value)
|
||||
(defmethod (setf text-value) (value (obj clog-meter))
|
||||
(setf (property obj "value") value))
|
||||
(defsetf text-value set-text-value)
|
||||
|
||||
;;;;;;;;;;
|
||||
;; high ;;
|
||||
|
|
@ -592,7 +591,7 @@ place-inside-bottom-of CLOG-OBJ."))
|
|||
|
||||
(defmethod create-progress-bar ((obj clog-obj) &key (value 0)
|
||||
(maximum 100)
|
||||
(style nil)
|
||||
(style nil)
|
||||
(hidden nil)
|
||||
(class nil)
|
||||
(html-id nil)
|
||||
|
|
@ -602,10 +601,10 @@ place-inside-bottom-of CLOG-OBJ."))
|
|||
(when class
|
||||
(format nil " class='~A'"
|
||||
(escape-string class :html t)))
|
||||
(when (or hidden style)
|
||||
(format nil " style='~@[~a~]~@[~a~]'"
|
||||
(when hidden "visibility:hidden;")
|
||||
style)))
|
||||
(when (or hidden style)
|
||||
(format nil " style='~@[~a~]~@[~a~]'"
|
||||
(when hidden "visibility:hidden;")
|
||||
style)))
|
||||
:clog-type 'clog-progress-bar
|
||||
:html-id html-id
|
||||
:auto-place auto-place))
|
||||
|
|
@ -628,9 +627,8 @@ place-inside-bottom-of CLOG-OBJ."))
|
|||
(defmethod text-value ((obj clog-progress-bar))
|
||||
(property obj "value"))
|
||||
|
||||
(defmethod set-text-value ((obj clog-progress-bar) value)
|
||||
(defmethod (setf text-value) (value (obj clog-progress-bar))
|
||||
(setf (property obj "value") value))
|
||||
(defsetf text-value set-text-value)
|
||||
|
||||
;;;;;;;;;;;;;
|
||||
;; maximum ;;
|
||||
|
|
|
|||
|
|
@ -484,16 +484,14 @@ Additionally for forms get/setf the value."))
|
|||
(jquery-query obj (format nil "contents().not(~A.children()).text()"
|
||||
(jquery obj))))
|
||||
|
||||
(defgeneric set-text-value (clog-element value)
|
||||
(defgeneric (setf text-value) (value clog-element)
|
||||
(:documentation "Set text-value to VALUE for CLOG-ELEMENT"))
|
||||
|
||||
(defmethod set-text-value ((obj clog-element) value)
|
||||
(defmethod (setf text-value) (value (obj clog-element))
|
||||
(jquery-execute obj
|
||||
(format nil "contents().not(~A.children()).get(0).nodeValue='~A'"
|
||||
(jquery obj) (escape-string value))))
|
||||
|
||||
(defsetf text-value set-text-value)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;
|
||||
;; text-direction ;;
|
||||
;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
|
|
@ -438,9 +438,8 @@ have this set true ever. Autofocus on element when form loaded."))
|
|||
(defmethod text-value ((obj clog-form-element))
|
||||
(property obj "value"))
|
||||
|
||||
(defmethod set-text-value ((obj clog-form-element) value)
|
||||
(defmethod (setf text-value) (value (obj clog-form-element))
|
||||
(setf (property obj "value") value))
|
||||
(defsetf text-value set-text-value)
|
||||
|
||||
;;;;;;;;;;;;;;;;;
|
||||
;; radio-value ;;
|
||||
|
|
|
|||
|
|
@ -333,7 +333,10 @@
|
|||
|
||||
(defparameter *props-text*
|
||||
`((:name "text"
|
||||
:setf clog:text-value)))
|
||||
:get ,(lambda (control)
|
||||
(text-value control))
|
||||
:set ,(lambda (control obj)
|
||||
(setf (text-value control) (text obj))))))
|
||||
|
||||
(defparameter *props-css*
|
||||
`((:name "css classes"
|
||||
|
|
|
|||
|
|
@ -796,7 +796,11 @@ not a temporary attached one when using select-control."
|
|||
(setf editor td2)
|
||||
(setf (editablep td2) (funcall (fourth item) control td1 td2)))
|
||||
(t
|
||||
(setf editor (create-text-area td2))
|
||||
;; (setf editor (clog-ace:create-clog-ace-element td2))
|
||||
;; (setf (clog-ace:theme editor) "ace/theme/xcode")
|
||||
;; (setf (clog-ace:mode editor) "ace/mode/lisp")
|
||||
;; (setf (clog-ace:tab-size editor) 2)
|
||||
(setf editor (create-text-area td2))
|
||||
(setf (spellcheckp editor) nil)
|
||||
(setf (width editor) "95%"))) ; leave space for scroll bar
|
||||
(setf (text-value editor) (second item))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue