From cfb8c99b47e771ade2da54f452fcdd5cc07350db Mon Sep 17 00:00:00 2001 From: David Botton Date: Tue, 16 Feb 2021 14:50:08 -0500 Subject: [PATCH] file dialog moved to clog-gui --- clog-gui.lisp | 75 +++++++++++++++++++++++++++++++++++++ clog.lisp | 5 ++- demos/03-demo.lisp | 93 ++++++++++++---------------------------------- 3 files changed, 102 insertions(+), 71 deletions(-) diff --git a/clog-gui.lisp b/clog-gui.lisp index b24568d..95d786d 100644 --- a/clog-gui.lisp +++ b/clog-gui.lisp @@ -926,3 +926,78 @@ on-window-resize-done at end of resize.")) (defmethod fire-on-window-move-done ((obj clog-gui-window)) (when (on-window-move-done obj) (funcall (on-window-move-done obj) obj))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - Dialog Boxes +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun server-file-dialog (obj title initial-dir on-file-name + &key (left nil) (top nil) (width 400) (height 360) + (initial-filename nil)) + "Create a local file dialog box called TITLE using INITIAL-DIR on server +machine, upon close ON-FILE-NAME called with filename or nil if failure." + (let* ((win (create-gui-window obj + :title title + :top top + :left left + :width width + :height height)) + (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) (truename 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 initial-dir) + (populate-files initial-dir) + (when initial-filename + (setf (value input) (truename initial-filename)) + (caret-at-end)) + (set-on-change files (lambda (obj) + (declare (ignore obj)) + (setf (value input) (truename (value files))) + (caret-at-end))) + (set-on-change dirs (lambda (obj) + (declare (ignore obj)) + (setf (value input) (value dirs)) + (caret-at-end) + (populate-files (value dirs)))) + (set-on-double-click dirs + (lambda (obj) + (declare (ignore obj)) + (populate-dirs (truename (value dirs))))) + (set-on-double-click files (lambda (obj) + (declare (ignore obj)) + (click ok)))) + (set-on-window-close win (lambda (obj) + (declare (ignore obj)) + (funcall on-file-name nil))) + (set-on-click ok (lambda (obj) + (declare (ignore obj)) + (set-on-window-close win nil) + (window-close win) + (funcall on-file-name (value input)))))) diff --git a/clog.lisp b/clog.lisp index 1b59e82..da0c0eb 100644 --- a/clog.lisp +++ b/clog.lisp @@ -693,7 +693,10 @@ embedded in a native template application.)" (set-on-window-move generic-function) (set-on-window-size generic-function) (set-on-window-move-done generic-function) - (set-on-window-size-done generic-function)) + (set-on-window-size-done generic-function) + + "CLOG-GUI - Dialog Boxes" + (server-file-dialog function)) (defsection @clog-body (:title "CLOG Body Objects") "CLOG-Body - CLOG Body Objects" diff --git a/demos/03-demo.lisp b/demos/03-demo.lisp index 2f85d8b..db7435c 100644 --- a/demos/03-demo.lisp +++ b/demos/03-demo.lisp @@ -29,63 +29,6 @@ (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)) @@ -122,24 +65,33 @@ (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);" + (let ((app (connection-data-item obj "app-data"))) + (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))))))) + (html-id (current-window obj))))) + :left (- (/ (width (body app)) 2) 200))))) (defun do-ide-file-save-as (obj) - (let ((cw (current-window obj))) + (let* ((app (connection-data-item obj "app-data")) + (cw (current-window obj)) + (dir (directory-namestring (window-title cw)))) (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)))))) + (server-file-dialog obj "Save As.." dir + (lambda (fname) + (when fname + (setf (window-title cw) fname) + (write-file (js-query obj (format nil "editor_~A.getValue()" + (html-id cw))) + fname))) + :left (- (/ (width (body app)) 2) 200) + :initial-filename (window-title cw))))) (defun do-ide-file-save (obj) (if (equalp (window-title (current-window obj)) "New Window") @@ -256,6 +208,7 @@ (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 "")) (run body))