;;; As this demo uses eval do not run over the internet. ;;; This app gives access to its users your local files. (defpackage #:clog-user (:use #:cl #:clog) (:export start-demo)) (in-package :clog-user) (defclass app-data () ((body :accessor body :documentation "Top level access to browser window") (copy-buf :accessor copy-buf :initform "" :documentation "Copy buffer"))) (defun read-file (infile) (with-open-file (instream infile :direction :input :if-does-not-exist nil) (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 :overwrite :append :supersede)) (with-open-file (outstream outfile :direction :output :if-exists action-if-exists) (write-sequence string outstream))) (defun get-file-name (obj title on-file-name) (let* ((app (connection-data-item obj "app-data")) (win (create-gui-window obj :title title :left (- (/ (width (body app)) 2) 200) :width 400 :height 360)) (box (create-div (window-content win) :class "w3-panel")) (form (create-form box)) (dirs (create-select form)) (files (create-select form)) (input (create-form-element form :input :label (create-label form :content "File Name:"))) (ok (create-button form :content " OK "))) (setf (size dirs) 4) (setf (box-width dirs) "100%") (setf (size files) 8) (setf (box-width files) "100%") (setf (box-width input) "100%") (flet ((populate-dirs (dir) (setf (inner-html dirs) "") (add-select-option dirs (format nil "~A" dir) ".") (setf (value input) dir) (unless (or (equalp dir "/") (equalp dir #P"/")) (add-select-option dirs (format nil "~A../" dir) "..")) (dolist (item (uiop:subdirectories dir)) (add-select-option dirs item item))) (populate-files (dir) (setf (inner-html files) "") (dolist (item (uiop:directory-files dir)) (add-select-option files item (file-namestring item)))) (caret-at-end () (focus input) (js-execute win (format nil "~A.setSelectionRange(~A.value.length,~A.value.length)" (clog::script-id input) (clog::script-id input) (clog::script-id input))))) (populate-dirs "./") (populate-files "./") (set-on-change files (lambda (obj) (setf (value input) (value files)) (caret-at-end))) (set-on-change dirs (lambda (obj) (setf (value input) (value dirs)) (caret-at-end) (populate-files (value dirs)))) (set-on-double-click dirs (lambda (obj) (populate-dirs (truename (value dirs))))) (set-on-double-click files (lambda (obj) (click ok)))) (set-on-click ok (lambda (obj) (declare (ignore obj)) (window-close win) (funcall on-file-name (value input)))))) (defun capture-eval (form) (let ((result (make-array '(0) :element-type 'base-char :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))) (defun do-ide-file-new (obj) (let ((win (create-gui-window obj :title "New window" :height 400 :width 650))) (set-on-window-size win (lambda (obj) (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))))) (create-child win (format nil "" (html-id win) (html-id win) (html-id win) (html-id win) (html-id win) (html-id win))))) (defun do-ide-file-open (obj) (get-file-name obj "Open..." (lambda (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))) (when cw (get-file-name obj "Save As.." (lambda (fname) (setf (window-title cw) fname) (write-file (js-query obj (format nil "editor_~A.getValue()" (html-id cw))) fname)))))) (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)))) (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)))))) (defun do-ide-edit-redo (obj) (let ((cw (current-window obj))) (when cw (do-ide-edit-copy obj) (js-execute obj (format nil "editor_~A.execCommand('redo')" (html-id cw)))))) (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');~ navigator.clipboard.writeText(editor_~A.getCopyText());~ editor_~A.getCopyText();" (html-id cw) (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)))))) (defun do-ide-edit-paste (obj) (let ((cw (current-window obj))) (when cw (let ((app (connection-data-item obj "app-data"))) ;; Note this methods uses the global clip buffer and not (copy-buf app) ;; on copy and paste we set both the global and local buffer. (js-execute obj (format nil "navigator.clipboard.readText().then(function(text) {~ editor_~A.execCommand('paste', text)~ })" (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))))))) (defun do-ide-help-about (obj) (let* ((app (connection-data-item obj "app-data")) (about (create-gui-window obj :title "About" :content "