mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

Support for CLOG console

Browse source
This commit is contained in:
David Botton 2024-04-05 15:19:08 -04:00
parent 5574801192
commit caf52fe44d
10 changed files with 127 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

2
source/clog-connection-websockets.lisp
View file

@ -116,7 +116,7 @@
(gethash event-id event-hash))))
(when event
(let* ((debug-hook (gethash "clog-debug" event-hash)))
(if debug-hook
(if (and debug-hook (not *disable-clog-debugging*))
(funcall debug-hook event data)
(funcall event data)))))
(handler-case

2
source/clog-connection.lisp
View file

@ -36,6 +36,7 @@ script."
(*verbose-output* variable)
(*break-on-error* variable)
(*disable-clog-debugging* variable)
(initialize function)
(random-port function)
@ -83,6 +84,7 @@ script."
(defvar *verbose-output* nil "Verbose server output (default false)")
(defvar *break-on-error* t "Allow invoking debugger (default true)")
(defvar *disable-clog-debugging* nil "When true turns off debug hooks")
(defvar *on-connect-handler* nil "New connection event handler.")

15
source/clog-gui.lisp
View file

@ -229,7 +229,9 @@
(let ((*debugger-hook* encapsulation))
(invoke-restart-interactively restart)))))))
(let* ((*query-io* (make-two-way-stream in-stream out-stream))
(*debugger-hook* #'my-debugger))
(*debugger-hook* (if clog-connection:*disable-clog-debugging*
*debugger-hook*
#'my-debugger)))
,@body)))))
;;;;;;;;;;;;;;;;;;;;;;;;;
@ -263,7 +265,7 @@ NOTE: use-clog-debugger should not be set for security issues
(load-css (html-document clog-body) jquery-ui-css))
(when jquery-ui
(load-script (html-document clog-body) jquery-ui))
(when use-clog-debugger
(when (and use-clog-debugger (not clog-connection:*disable-clog-debugging*))
(setf (connection-data-item clog-body "clog-debug") (lambda (event data)
(with-clog-debugger (clog-body)
(funcall event data))))))
@ -1076,10 +1078,12 @@ window-to-top-by-param or window-by-param."))
(defmethod window-focus ((obj clog-gui-window))
(let ((app (connection-data-item obj "clog-gui")))
(unless (keep-on-top obj)
(setf (z-index obj) (incf (last-z app))))
(when (last-z app)
(setf (z-index obj) (incf (last-z app)))))
(when (window-select app)
(setf (selectedp (window-select-item obj)) t))
(fire-on-window-change obj app)))
(fire-on-window-change obj app))
obj)
;;;;;;;;;;;;;;;;;;
;; window-close ;;
@ -1098,7 +1102,8 @@ the browser."))
(destroy (window-select-item obj)))
(remove-from-dom obj)
(fire-on-window-change nil app)
(fire-on-window-close obj))))
(fire-on-window-close obj)))
nil)
;;;;;;;;;;;;;;;;;;;;;;;;
;; window-maximized-p ;;

90
tools/clog-builder-eval.lisp
View file

@ -1,7 +1,79 @@
(in-package :clog-tools)
(defun on-open-console (obj)
(let ((app (connection-data-item obj "builder-app-data")))
(if (console-win app)
(window-focus (console-win app))
(let* ((win (on-open-file obj :title "Console")))
(set-on-window-close win (lambda (obj)
(setf (console-win app) nil)))
(setf (console-win app) win)))))
;;;;;;;;;;;;;;;;;;;;;;;;
;; console-out-stream ;;
;;;;;;;;;;;;;;;;;;;;;;;;
(defclass console-out-stream (trivial-gray-streams:fundamental-character-output-stream)
((clog-obj :reader clog-obj :initarg :clog-obj)
(win :accessor win :initform nil)
(ace :accessor ace :initform nil))
(:documentation "console-in-stream and console-out-stream when used together
provide an interactive console.)"))
(defmethod trivial-gray-streams:stream-write-char ((stream console-out-stream) character)
(unless (win stream)
(setf (win stream) (on-open-console (clog-obj stream))))
(unless (ace stream)
(setf (ace stream) (window-param (win stream))))
(js-execute (ace stream) (format nil "~A.insert(String.fromCharCode(~A))"
(clog-ace::js-ace (ace stream))
(char-code character)))
(js-execute (ace stream) (format nil "~A.renderer.scrollToLine(Number.POSITIVE_INFINITY)"
(clog-ace::js-ace (ace stream)))))
(defmethod trivial-gray-streams:stream-line-column ((stream console-out-stream))
nil)
;;;;;;;;;;;;;;;;;;;;;;;
;; console-in-stream ;;
;;;;;;;;;;;;;;;;;;;;;;;
(defclass console-in-stream (trivial-gray-streams:fundamental-character-input-stream)
((clog-obj :reader obj :initarg :clog-obj)
(buffer :accessor buffer-of :initform "")
(index :accessor index :initform 0))
(:documentation "console-in-stream and console-out-stream when used together
provide an interactive console.)"))
(defmethod trivial-gray-streams:stream-read-char ((stream console-in-stream))
(when (eql (index stream) (length (buffer-of stream)))
(setf (buffer-of stream) "")
(setf (index stream) 0))
(when (eql (index stream) 0)
(let ((sem (bordeaux-threads:make-semaphore)))
(input-dialog (obj stream) "Console Input:"
(lambda (result)
(setf (buffer-of stream) (format nil "~A~A~%" (buffer-of stream) result))
(bordeaux-threads:signal-semaphore sem))
:modal nil)
(bordeaux-threads:wait-on-semaphore sem)))
(when (< (index stream) (length (buffer-of stream)))
(prog1
(char (buffer-of stream) (index stream))
(incf (index stream)))))
(defmethod trivial-gray-streams:stream-unread-char ((stream console-in-stream) character)
(decf (index stream)))
(defmethod trivial-gray-streams:stream-line-column ((stream console-in-stream))
nil)
;; Lisp code evaluation utilities
(defun capture-eval (form &key (clog-obj nil) (eval-in-package "clog-user"))
(defun capture-eval (form &key (capture-console t)
(capture-result t)
(clog-obj nil)
(eval-in-package "clog-user"))
"Capture lisp evaluaton of FORM."
(let ((result (make-array '(0) :element-type 'base-char
:fill-pointer 0 :adjustable t))
@ -24,14 +96,22 @@
(with-output-to-string (s r)
(print form s))
(setf form r)))
(let* ((*query-io* (make-two-way-stream in-stream out-stream))
(*standard-output* stream)
(*error-output* stream)
(*debugger-hook* #'my-debugger)
(let* ((st (if capture-console
stream
(make-instance 'console-out-stream :clog-obj clog-obj)))
(*query-io* (make-two-way-stream in-stream out-stream))
(*standard-output* st)
(*standard-input* (make-instance 'console-in-stream :clog-obj clog-obj))
(*error-output* st)
(*debugger-hook* (if clog-connection:*disable-clog-debugging*
*debugger-hook*
#'my-debugger))
(*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*)
(*package* (find-package (string-upcase eval-in-package))))
(setf eval-result (eval (read-from-string (format nil "(progn ~A)" form))))
(unless capture-result
(format st "~%=>~A~%" eval-result))
(values
(format nil "~A~%=>~A~%" result eval-result)
*package*))))))))

6
tools/clog-builder-files.lisp
View file

@ -54,7 +54,8 @@
(when win
(when regex
(js-execute win (format nil "~A.find('~A',{caseSensitive:false,regExp:true})"
(clog-ace::js-ace (window-param win)) regex))))
(clog-ace::js-ace (window-param win)) regex)))
win)
(unless win
(let* ((app (connection-data-item obj "builder-app-data"))
(*menu-bar-class* *builder-menu-bar-class*)
@ -454,4 +455,5 @@
(set-on-click btn-test (lambda (obj)
(eval-file obj)))
(set-on-click m-test (lambda (obj)
(eval-file obj))))))))
(eval-file obj))))
win))))

12
tools/clog-builder-projects.lisp
View file

@ -60,12 +60,10 @@
(setf clog:*clog-debug* (lambda (event data)
(with-clog-debugger (panel :title val)
(funcall event data))))
(let ((result (capture-eval (format nil "(~A)" val) :clog-obj panel
:eval-in-package "clog-user")))
(clog-web-alert (connection-body panel) "Result"
(format nil "~&result: ~A" result)
:color-class "w3-green"
:time-out 3)))))
(capture-eval (format nil "(~A)" val) :clog-obj panel
:capture-console nil
:capture-result nil
:eval-in-package "clog-user"))))
(defun projects-entry-point-change (panel)
(let* ((sys (text-value (project-list panel)))
@ -197,7 +195,7 @@
(setf (disabledp (run-button panel)) nil))
(t
(alert-toast panel "Warning" "Missing :defsystem-depends-on (:clog)"
:color-class "w3-yellow" :time-out 2))))
:color-class "w3-yellow" :time-out 1))))
(t (c)
(declare (ignore c))
(add-select-option (designtime-list panel) "" "Missing /tools")

11
tools/clog-builder.lisp
View file

@ -32,6 +32,10 @@ clog-builder window.")
:accessor copy-history-win
:initform nil
:documentation "Copy history window")
(console-win
:accessor console-win
:initform nil
:documentation "Console window")
(next-panel-id
:accessor next-panel-id
:initform 0
@ -333,7 +337,7 @@ clog-builder window.")
(setf (z-index (create-panel body :positioning :fixed
:bottom 0 :left 0
:class *builder-window-show-static-root-class*
:content (format nil "static-root: ~A" clog::*static-root*)))
:content (format nil "static-root: ~A" clog:*static-root*)))
-9999))
(let* ((menu (create-gui-menu-bar body))
(icon (create-gui-menu-icon menu :image-url img-clog-icon
@ -422,9 +426,8 @@ clog-builder window.")
(open-window (window body) "https://github.com/rabbibotton/clog/blob/main/LEARN.md")))
(create-gui-menu-item help :content "Tutorials DIR" :on-click
(lambda (obj)
(declare (ignore obj))
(on-dir-win obj :dir (setf static-root (merge-pathnames "./tutorial/"
(asdf:system-source-directory :clog))))))
(on-dir-win obj :dir (merge-pathnames "./tutorial/"
(asdf:system-source-directory :clog)))))
(create-gui-menu-item help :content "ParenScript Reference" :on-click
(lambda (obj)
(declare (ignore obj))

4
tools/panel-clog-builder-repl.clog vendored
View file

@ -1,5 +1,7 @@
<data id="I3868707672" data-in-package="clog-tools" data-custom-slots="" data-clog-next-id="4" data-clog-title="clog-builder-repl"></data><input type="TEXT" value="clog-user" data-clog-type="input" data-clog-name="package-div" style="box-sizing: content-box; position: absolute; inset: 0px 0px 338.5px; height: 25px;" placeholder="Current Package" class="w3-black"><div style="--pixel-density:1; --char-width:7.20312; box-sizing: content-box; position: absolute; inset: 30px 0px 0px;" class="terminal" data-clog-type="clog-terminal" data-clog-composite-control="t" data-clog-terminal-prompt="> " data-clog-terminal-greetings="CLOG Builder REPL" data-clog-name="terminal" data-on-command="(multiple-value-bind (result new-package)
<data id="I3921332613" data-in-package="clog-tools" data-custom-slots="" data-clog-next-id="4" data-clog-title="clog-builder-repl"></data><input type="TEXT" value="clog-user" data-clog-type="input" data-clog-name="package-div" style="box-sizing: content-box; position: absolute; inset: 0px 0px 338.5px; height: 25px;" placeholder="Current Package" class="w3-black"><div style="--pixel-density: 1; --char-width: 6.60156; box-sizing: content-box; position: absolute; inset: 30px 0px 0px;" class="terminal" data-clog-type="clog-terminal" data-clog-composite-control="t" data-clog-terminal-prompt="> " data-clog-terminal-greetings="CLOG Builder REPL" data-clog-name="terminal" data-on-command="(multiple-value-bind (result new-package)
(capture-eval data :clog-obj panel
:capture-console nil
:capture-result nil
:eval-in-package (text-value (package-div panel)))
(setf (text-value (package-div panel))
(string-downcase (package-name new-package)))

10
tools/panel-clog-builder-repl.lisp
View file

@ -1,3 +1,4 @@
;;;; CLOG Builder generated code - modify original .clog file and rerender
(in-package :clog-tools)
(defclass clog-builder-repl (clog:clog-panel)
((terminal :reader terminal) (package-div :reader package-div)))
@ -6,15 +7,15 @@
(let ((panel
(change-class
(clog:create-div clog-obj :content
"<input type=\"TEXT\" value=\"clog-user\" style=\"box-sizing: content-box; position: absolute; inset: 0px 0px 338.5px; height: 25px;\" placeholder=\"Current Package\" class=\"w3-black\" id=\"CLOGB3868707662\" data-clog-name=\"package-div\"><div style=\"--pixel-density:1; --char-width:7.20312; box-sizing: content-box; position: absolute; inset: 30px 0px 0px;\" class=\"terminal\" id=\"CLOGB3868707661\" data-clog-name=\"terminal\"></div>"
"<input type=\"TEXT\" value=\"clog-user\" style=\"box-sizing: content-box; position: absolute; inset: 0px 0px 338.5px; height: 25px;\" placeholder=\"Current Package\" class=\"w3-black\" id=\"CLOGB3921332482\" data-clog-name=\"package-div\"><div style=\"--pixel-density: 1; --char-width: 6.60156; box-sizing: content-box; position: absolute; inset: 30px 0px 0px;\" class=\"terminal\" id=\"CLOGB3921332483\" data-clog-name=\"terminal\"></div>"
:hidden hidden :class class :html-id html-id
:auto-place auto-place)
'clog-builder-repl)))
(setf (slot-value panel 'terminal)
(attach-as-child clog-obj "CLOGB3868707661" :clog-type
(attach-as-child clog-obj "CLOGB3921332483" :clog-type
'clog-terminal:clog-terminal-element :new-id t))
(setf (slot-value panel 'package-div)
(attach-as-child clog-obj "CLOGB3868707662" :clog-type
(attach-as-child clog-obj "CLOGB3921332482" :clog-type
'clog:clog-form-element :new-id t))
(let ((target (terminal panel)))
(declare (ignorable target))
@ -26,7 +27,8 @@
(declare (ignorable target data))
(multiple-value-bind (result new-package)
(capture-eval data :clog-obj panel
:eval-in-package
:capture-console nil :capture-result
nil :eval-in-package
(text-value (package-div panel)))
(setf (text-value (package-div panel))
(string-downcase

3
tools/preferences.lisp.sample vendored
View file

@ -36,6 +36,9 @@
enableBasicAutocompletion: true,
enableLiveAutocompletion : true")
;; Disable clog gui debugging
(setf clog-connection:*disable-clog-debugging* nil)
;; Builder Look and Feel
(setf *builder-window-desktop-class* "w3-blue-grey")