From 8036651a36306d70e3224cec4424c9234463ab8e Mon Sep 17 00:00:00 2001 From: David Botton Date: Sun, 10 Jul 2022 21:52:58 -0400 Subject: [PATCH] prep for switch to use ace editor --- demos/03-demo.lisp | 164 +++++++++++++++---------------- source/clog-element-common.lisp | 16 ++- source/clog-element.lisp | 6 +- source/clog-form.lisp | 3 +- tools/clog-builder-settings.lisp | 5 +- tools/clog-builder.lisp | 6 +- 6 files changed, 101 insertions(+), 99 deletions(-) diff --git a/demos/03-demo.lisp b/demos/03-demo.lisp index 48cf03d..f657f0b 100644 --- a/demos/03-demo.lisp +++ b/demos/03-demo.lisp @@ -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 - "" - (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 "
+ :title "About" + :content "
-
CLOG
-
The Common Lisp Omnificent GUI
-

Demo 3
+
CLOG
+
The Common Lisp Omnificent GUI
+

Demo 3
(c) 2021 - David Botton

" - :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." diff --git a/source/clog-element-common.lisp b/source/clog-element-common.lisp index b24a6a3..23a4a11 100644 --- a/source/clog-element-common.lisp +++ b/source/clog-element-common.lisp @@ -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 ;; diff --git a/source/clog-element.lisp b/source/clog-element.lisp index db83f8d..72a7107 100644 --- a/source/clog-element.lisp +++ b/source/clog-element.lisp @@ -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 ;; ;;;;;;;;;;;;;;;;;;;; diff --git a/source/clog-form.lisp b/source/clog-form.lisp index 0295b73..fe23300 100644 --- a/source/clog-form.lisp +++ b/source/clog-form.lisp @@ -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 ;; diff --git a/tools/clog-builder-settings.lisp b/tools/clog-builder-settings.lisp index a37ada5..4ccc720 100644 --- a/tools/clog-builder-settings.lisp +++ b/tools/clog-builder-settings.lisp @@ -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" diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index d04b648..82501b2 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -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))