mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-05 18:20:36 -08:00
clog-gui-window api
This commit is contained in:
David Botton
parent
b79a343163
commit
2ce26b6e78
4 changed files with 287 additions and 219 deletions
268
clog-gui.lisp
268
clog-gui.lisp
|
|
@ -19,7 +19,11 @@
|
|||
(current-win
|
||||
:accessor current-win
|
||||
:initform nil
|
||||
:documentation "The current window at front.")
|
||||
:documentation "The current window at front")
|
||||
(windows
|
||||
:accessor windows
|
||||
:initform (make-hash-table :test 'equalp)
|
||||
:documentation "Window collection")
|
||||
(last-z
|
||||
:accessor last-z
|
||||
:initform -9999
|
||||
|
|
@ -31,13 +35,17 @@
|
|||
(in-drag
|
||||
:accessor in-drag
|
||||
:initform nil
|
||||
:documentation "Drag window or Size window.")
|
||||
:documentation "Drag window or Size window")
|
||||
(drag-obj
|
||||
:accessor drag-obj
|
||||
:initform nil
|
||||
:documentation "Drag target object")
|
||||
(drag-x
|
||||
:accessor drag-x
|
||||
:documentation "Location of the left side or width relative to pointer during drag.")
|
||||
:documentation "Location of the left side or width relative to pointer during drag")
|
||||
(drag-y
|
||||
:accessor drag-y
|
||||
:documentation "Location of the top or height relative to pointer during drag.")))
|
||||
:documentation "Location of the top or height relative to pointer during drag")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;; create-clog-gui ;;
|
||||
|
|
@ -45,7 +53,7 @@
|
|||
|
||||
(defun create-clog-gui (clog-body)
|
||||
"Create a clog-gui object and places it in CLOG-BODY's connection-data as
|
||||
\"clog-gui\". (private)"
|
||||
\"clog-gui\". (Private)"
|
||||
(let ((clog-gui (make-instance 'clog-gui)))
|
||||
(setf (connection-data-item clog-body "clog-gui") clog-gui)
|
||||
(setf (body clog-gui) clog-body)
|
||||
|
|
@ -122,7 +130,8 @@ clog-body."))
|
|||
(on-click nil)
|
||||
(class "w3-bar-item w3-button")
|
||||
(html-id nil))
|
||||
(let ((span (create-span obj :content content :class class :html-id html-id)))
|
||||
(let ((span
|
||||
(create-span obj :content content :class class :html-id html-id)))
|
||||
(set-on-click span on-click)
|
||||
(change-class span 'clog-gui-menu-item)))
|
||||
|
||||
|
|
@ -190,35 +199,35 @@ icon ⤢ and full screen mode."))
|
|||
:accessor sizer
|
||||
:documentation "Window sizer clog-element")
|
||||
(on-window-can-close
|
||||
:accessor set-on-window-can-close
|
||||
:accessor on-window-can-close
|
||||
:initform nil
|
||||
:documentation "Return t to allow close of window")
|
||||
(on-window-can-move
|
||||
:accessor set-on-window-can-move
|
||||
:accessor on-window-can-move
|
||||
:initform nil
|
||||
:documentation "Return t to allow move of window")
|
||||
(on-window-can-size
|
||||
:accessor set-on-window-can-size
|
||||
:accessor on-window-can-size
|
||||
:initform nil
|
||||
:documentation "Return t to allow close of window")
|
||||
(on-window-close
|
||||
:accessor set-on-window-close
|
||||
:accessor on-window-close
|
||||
:initform nil
|
||||
:documentation "Fired on window closed")
|
||||
(on-window-move
|
||||
:accessor set-on-window-move
|
||||
:accessor on-window-move
|
||||
:initform nil
|
||||
:documentation "Fired during move of window")
|
||||
(on-window-size
|
||||
:accessor set-on-window-size
|
||||
:accessor on-window-size
|
||||
:initform nil
|
||||
:documentation "Fired during size change of window")
|
||||
(on-window-move-done
|
||||
:accessor set-on-window-move-done
|
||||
:accessor on-window-move-done
|
||||
:initform nil
|
||||
:documentation "Fired after move of window")
|
||||
(on-window-size-done
|
||||
:accessor set-on-window-size-done
|
||||
:accessor on-window-size-done
|
||||
:initform nil
|
||||
:documentation "Fired after size change of window")))
|
||||
|
||||
|
|
@ -231,26 +240,35 @@ icon ⤢ and full screen mode."))
|
|||
(let ((app (connection-data-item obj "clog-gui")))
|
||||
(unless (in-drag app)
|
||||
(setf (in-drag app) (attribute obj "data-drag-type"))
|
||||
(let* ((id-drag (attribute obj "data-drag-obj"))
|
||||
(drag-obj (attach-as-child obj id-drag))
|
||||
(let* ((target (gethash (attribute obj "data-drag-obj") (windows app)))
|
||||
(pointer-x (getf data ':screen-x))
|
||||
(pointer-y (getf data ':screen-y))
|
||||
(obj-top)
|
||||
(obj-left))
|
||||
(cond ((equalp (in-drag app) "m")
|
||||
(setf obj-top (parse-integer (top drag-obj) :junk-allowed t))
|
||||
(setf obj-left (parse-integer (left drag-obj) :junk-allowed t)))
|
||||
((equalp (in-drag app) "s")
|
||||
(setf obj-top (height drag-obj))
|
||||
(setf obj-left (width drag-obj)))
|
||||
(t
|
||||
(format t "Warning - invalid data-drag-type attribute")))
|
||||
(setf (z-index drag-obj) (incf (last-z app)))
|
||||
(setf (current-win app) drag-obj)
|
||||
(setf (drag-y app) (- pointer-y obj-top))
|
||||
(setf (drag-x app) (- pointer-x obj-left))
|
||||
(set-on-pointer-move obj 'on-gui-drag-move)
|
||||
(set-on-pointer-up obj 'on-gui-drag-stop)))))
|
||||
(obj-left)
|
||||
(perform-drag nil))
|
||||
(when target
|
||||
(setf (drag-obj app) target)
|
||||
(cond ((equalp (in-drag app) "m")
|
||||
(setf obj-top
|
||||
(parse-integer (top (drag-obj app)) :junk-allowed t))
|
||||
(setf obj-left
|
||||
(parse-integer (left (drag-obj app)) :junk-allowed t))
|
||||
(setf perform-drag (fire-on-window-can-move (drag-obj app))))
|
||||
((equalp (in-drag app) "s")
|
||||
(setf obj-top (height (drag-obj app)))
|
||||
(setf obj-left (width (drag-obj app)))
|
||||
(setf perform-drag (fire-on-window-can-size (drag-obj app))))
|
||||
(t
|
||||
(format t "Warning - invalid data-drag-type attribute")))
|
||||
(setf (z-index (drag-obj app)) (incf (last-z app)))
|
||||
(setf (current-win app) (drag-obj app))
|
||||
(setf (drag-y app) (- pointer-y obj-top))
|
||||
(setf (drag-x app) (- pointer-x obj-left)))
|
||||
(cond (perform-drag
|
||||
(set-on-pointer-move obj 'on-gui-drag-move)
|
||||
(set-on-pointer-up obj 'on-gui-drag-stop))
|
||||
(t
|
||||
(setf (in-drag app) nil)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; on-gui-drag-move ;;
|
||||
|
|
@ -259,20 +277,19 @@ icon ⤢ and full screen mode."))
|
|||
(defun on-gui-drag-move (obj data)
|
||||
"Handle mouse tracking on drag object"
|
||||
(let* ((app (connection-data-item obj "clog-gui"))
|
||||
(drag-obj (attach-as-child obj (attribute obj "data-drag-obj")))
|
||||
(x (getf data ':screen-x))
|
||||
(y (getf data ':screen-y))
|
||||
(adj-y (- y (drag-y app)))
|
||||
(adj-x (- x (drag-x app))))
|
||||
(when (and (> adj-x 0) (> adj-y 30))
|
||||
(cond ((equalp (in-drag app) "m")
|
||||
;; send on-window-move
|
||||
(setf (top drag-obj) (unit :px adj-y))
|
||||
(setf (left drag-obj) (unit :px adj-x)))
|
||||
(fire-on-window-move (drag-obj app))
|
||||
(setf (top (drag-obj app)) (unit :px adj-y))
|
||||
(setf (left (drag-obj app)) (unit :px adj-x)))
|
||||
((equalp (in-drag app) "s")
|
||||
;; send on-window-resize
|
||||
(setf (height drag-obj) (unit :px adj-y))
|
||||
(setf (width drag-obj) (unit :px adj-x)))))))
|
||||
(fire-on-window-size (drag-obj app))
|
||||
(setf (height (drag-obj app)) (unit :px adj-y))
|
||||
(setf (width (drag-obj app)) (unit :px adj-x)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; on-gui-drag-stop ;;
|
||||
|
|
@ -280,18 +297,16 @@ icon ⤢ and full screen mode."))
|
|||
|
||||
(defun on-gui-drag-stop (obj data)
|
||||
"Handle end of drag object"
|
||||
(let ((app (connection-data-item obj "clog-gui"))
|
||||
(drag-obj (attach-as-child obj (attribute obj "data-drag-obj"))))
|
||||
(let ((app (connection-data-item obj "clog-gui")))
|
||||
(on-gui-drag-move obj data)
|
||||
(setf (in-drag app) nil)
|
||||
(set-on-pointer-move obj nil)
|
||||
(set-on-pointer-up obj nil)
|
||||
(cond ((equalp (in-drag app) "m")
|
||||
(when (set-on-window-move-done app)
|
||||
(funcall (set-on-window-move-done app) drag-obj)))
|
||||
(fire-on-window-move-done (drag-obj app)))
|
||||
((equalp (in-drag app) "s")
|
||||
(when (set-on-window-size-done app)
|
||||
(funcall (set-on-window-size-done app) drag-obj))))))
|
||||
(fire-on-window-size-done (drag-obj app))))
|
||||
(setf (in-drag app) nil)
|
||||
(setf (drag-obj app) nil)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; create-gui-window ;;
|
||||
|
|
@ -326,7 +341,7 @@ icon ⤢ and full screen mode."))
|
|||
<span id='~A-closer'
|
||||
style='cursor:pointer;user-select:none;'>X</span>
|
||||
</div>
|
||||
<div id='~A-body' style='flex-grow:9;'>~A</div>
|
||||
<div id='~A-body' style='flex-grow:9;overflow:auto'>~A</div>
|
||||
<div id='~A-sizer' style='user-select:none;height:1px;
|
||||
cursor:se-resize;opacity:0'
|
||||
class='w3-right' data-drag-obj='~A' data-drag-type='s'>+</div>
|
||||
|
|
@ -348,9 +363,25 @@ icon ⤢ and full screen mode."))
|
|||
(set-on-pointer-down (win-title win) 'on-gui-drag-down :capture-pointer t)
|
||||
(set-on-pointer-down (sizer win) 'on-gui-drag-down :capture-pointer t)
|
||||
(set-on-click (closer win) (lambda (obj)
|
||||
(remove-from-dom win)))
|
||||
(when (fire-on-window-can-close win)
|
||||
(remhash (format nil "~A" html-id) (windows app))
|
||||
(remove-from-dom win)
|
||||
(fire-on-window-close win))))
|
||||
(setf (gethash (format nil "~A" html-id) (windows app)) win)
|
||||
(setf (current-win app) win)
|
||||
win))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;
|
||||
;; current-window ;;
|
||||
;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric current-window (clog-obj)
|
||||
(:documentation "Get the current selected clog-gui-window"))
|
||||
|
||||
(defmethod current-window ((obj clog-obj))
|
||||
(let ((app (connection-data-item obj "clog-gui")))
|
||||
(current-win app)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
;; window-title ;;
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -367,3 +398,146 @@ icon ⤢ and full screen mode."))
|
|||
(defmethod set-window-title ((obj clog-gui-window) value)
|
||||
(setf (inner-html (win-title obj)) value))
|
||||
(defsetf window-title set-window-title)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;
|
||||
;; window-content ;;
|
||||
;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric window-content (clog-gui-window)
|
||||
(:documentation "Get window content element."))
|
||||
|
||||
(defmethod window-content ((obj clog-gui-window))
|
||||
(content obj))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-window-can-close ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-window-can-close (clog-gui-window handler)
|
||||
(:documentation "Set the on-window-can-close HANDLER"))
|
||||
|
||||
(defmethod set-on-window-can-close ((obj clog-gui-window) handler)
|
||||
(setf (on-window-can-close obj) handler))
|
||||
|
||||
(defgeneric fire-on-window-can-close (clog-gui-window)
|
||||
(:documentation "Fire handler if set. (Private)"))
|
||||
|
||||
(defmethod fire-on-window-can-close ((obj clog-gui-window))
|
||||
(if (on-window-can-close obj)
|
||||
(funcall (on-window-can-close obj) obj)
|
||||
t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-window-close ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-window-close (clog-gui-window handler)
|
||||
(:documentation "Set the on-window-close HANDLER"))
|
||||
|
||||
(defmethod set-on-window-close ((obj clog-gui-window) handler)
|
||||
(setf (on-window-close obj) handler))
|
||||
|
||||
(defgeneric fire-on-window-close (clog-gui-window)
|
||||
(:documentation "Fire handler if set. (Private)"))
|
||||
|
||||
(defmethod fire-on-window-close ((obj clog-gui-window))
|
||||
(when (on-window-close obj)
|
||||
(funcall (on-window-close obj) obj)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-window-can-size ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-window-can-size (clog-gui-window handler)
|
||||
(:documentation "Set the on-window-can-size HANDLER"))
|
||||
|
||||
(defmethod set-on-window-can-size ((obj clog-gui-window) handler)
|
||||
(setf (on-window-can-size obj) handler))
|
||||
|
||||
(defgeneric fire-on-window-can-size (clog-gui-window)
|
||||
(:documentation "Fire handler if set. (Private)"))
|
||||
|
||||
(defmethod fire-on-window-can-size ((obj clog-gui-window))
|
||||
(if (on-window-can-size obj)
|
||||
(funcall (on-window-can-size obj) obj)
|
||||
t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-window-size ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-window-size (clog-gui-window handler)
|
||||
(:documentation "Set the on-window-size HANDLER"))
|
||||
|
||||
(defmethod set-on-window-size ((obj clog-gui-window) handler)
|
||||
(setf (on-window-size obj) handler))
|
||||
|
||||
(defgeneric fire-on-window-size (clog-gui-window)
|
||||
(:documentation "Fire handler if set. (Private)"))
|
||||
|
||||
(defmethod fire-on-window-size ((obj clog-gui-window))
|
||||
(when (on-window-size obj)
|
||||
(funcall (on-window-size obj) obj)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-window-size-done ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-window-size-done (clog-gui-window handler)
|
||||
(:documentation "Set the on-window-size-done HANDLER"))
|
||||
|
||||
(defmethod set-on-window-size-done ((obj clog-gui-window) handler)
|
||||
(setf (on-window-size-done obj) handler))
|
||||
|
||||
(defmethod fire-on-window-size-done ((obj clog-gui-window))
|
||||
(when (on-window-size-done obj)
|
||||
(funcall (on-window-size-done obj) obj)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-window-can-move ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-window-can-move (clog-gui-window handler)
|
||||
(:documentation "Set the on-window-can-move HANDLER"))
|
||||
|
||||
(defmethod set-on-window-can-move ((obj clog-gui-window) handler)
|
||||
(setf (on-window-can-move obj) handler))
|
||||
|
||||
(defgeneric fire-on-window-can-move (clog-gui-window)
|
||||
(:documentation "Fire handler if set. (Private)"))
|
||||
|
||||
(defmethod fire-on-window-can-move ((obj clog-gui-window))
|
||||
(if (on-window-can-move obj)
|
||||
(funcall (on-window-can-move obj) obj)
|
||||
t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-window-move ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-window-move (clog-gui-window handler)
|
||||
(:documentation "Set the on-window-move HANDLER"))
|
||||
|
||||
(defmethod set-on-window-move ((obj clog-gui-window) handler)
|
||||
(setf (on-window-move obj) handler))
|
||||
|
||||
(defgeneric fire-on-window-move (clog-gui-window)
|
||||
(:documentation "Fire handler if set. (Private)"))
|
||||
|
||||
(defmethod fire-on-window-move ((obj clog-gui-window))
|
||||
(when (on-window-move obj)
|
||||
(funcall (on-window-move obj) obj)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-window-move-done ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-window-move-done (clog-gui-window handler)
|
||||
(:documentation "Set the on-window-move-done HANDLER"))
|
||||
|
||||
(defmethod set-on-window-move-done ((obj clog-gui-window) handler)
|
||||
(setf (on-window-move-done obj) handler))
|
||||
|
||||
(defmethod fire-on-window-move-done ((obj clog-gui-window))
|
||||
(when (on-window-move-done obj)
|
||||
(funcall (on-window-move-done obj) obj)))
|
||||
|
|
|
|||
|
|
@ -666,8 +666,17 @@ embedded in a native template application.)"
|
|||
(create-gui-menu-icon generic-function)
|
||||
|
||||
"CLOG-GUI - Windows"
|
||||
(current-window generic-function)
|
||||
(clog-gui-window class)
|
||||
(create-gui-window generic-function)
|
||||
(window-title generic-function)
|
||||
(window-content generic-function)
|
||||
(set-on-window-can-close generic-function)
|
||||
(set-on-window-close generic-function)
|
||||
(set-on-window-can-move generic-function)
|
||||
(set-on-window-can-size generic-function)
|
||||
(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))
|
||||
|
||||
|
|
|
|||
|
|
@ -10,129 +10,10 @@
|
|||
((body
|
||||
:accessor body
|
||||
:documentation "Top level access to browser window")
|
||||
(current-win
|
||||
:accessor current-win
|
||||
:initform nil
|
||||
:documentation "The current window at front.")
|
||||
(last-z
|
||||
:accessor last-z
|
||||
:initform -9999
|
||||
:documentation "Top z-order for windows")
|
||||
(copy-buf
|
||||
:accessor copy-buf
|
||||
:initform ""
|
||||
:documentation "Copy buffer")
|
||||
(in-drag
|
||||
:accessor in-drag
|
||||
:initform nil
|
||||
:documentation "Drag window or Size window.")
|
||||
(drag-x
|
||||
:accessor drag-x
|
||||
:documentation "Location of the left side or width relative to pointer during drag.")
|
||||
(drag-y
|
||||
:accessor drag-y
|
||||
:documentation "Location of the top or height relative to pointer during drag.")))
|
||||
|
||||
(defun on-ide-drag-down (obj data)
|
||||
(let ((app (connection-data-item obj "app-data")))
|
||||
(unless (in-drag app)
|
||||
(setf (in-drag app) (attribute obj "data-drag-type"))
|
||||
(let* ((id-drag (attribute obj "data-drag-obj"))
|
||||
(drag-obj (attach-as-child obj id-drag))
|
||||
(pointer-x (getf data ':screen-x))
|
||||
(pointer-y (getf data ':screen-y))
|
||||
(obj-top)
|
||||
(obj-left))
|
||||
(if (equalp (in-drag app) "m")
|
||||
(progn
|
||||
(setf (current-win app) drag-obj)
|
||||
(setf obj-top (parse-integer (top drag-obj) :junk-allowed t))
|
||||
(setf obj-left (parse-integer (left drag-obj) :junk-allowed t)))
|
||||
(progn
|
||||
(setf obj-top (height drag-obj))
|
||||
(setf obj-left (width drag-obj))))
|
||||
(setf (z-index drag-obj) (incf (last-z app)))
|
||||
(setf (drag-y app) (- pointer-y obj-top))
|
||||
(setf (drag-x app) (- pointer-x obj-left))
|
||||
(set-on-pointer-move obj 'on-ide-drag-move)
|
||||
(set-on-pointer-up obj 'on-ide-drag-stop)))))
|
||||
|
||||
(defun on-ide-drag-move (obj data)
|
||||
(let* ((app (connection-data-item obj "app-data"))
|
||||
(drag-obj (attach-as-child obj (attribute obj "data-drag-obj")))
|
||||
(x (getf data ':screen-x))
|
||||
(y (getf data ':screen-y))
|
||||
(adj-y (- y (drag-y app)))
|
||||
(adj-x (- x (drag-x app))))
|
||||
(when (and (> adj-x 0) (> adj-y 30))
|
||||
(cond ((equalp (in-drag app) "m")
|
||||
(setf (top drag-obj) (format nil "~Apx" adj-y))
|
||||
(setf (left drag-obj) (format nil "~Apx" adj-x)))
|
||||
((equalp (in-drag app) "s")
|
||||
(js-execute drag-obj (format nil "editor_~A.resize()" (html-id drag-obj)))
|
||||
(setf (height drag-obj) (format nil "~Apx" adj-y))
|
||||
(setf (width drag-obj) (format nil "~Apx" adj-x)))))))
|
||||
|
||||
(defun on-ide-drag-stop (obj data)
|
||||
(let ((app (connection-data-item obj "app-data")))
|
||||
(on-ide-drag-move obj data)
|
||||
(setf (in-drag app) nil)
|
||||
(set-on-pointer-move obj nil)
|
||||
(set-on-pointer-up obj nil)))
|
||||
|
||||
|
||||
(defgeneric create-window (clog-obj title
|
||||
&key html-id content left top width height)
|
||||
(:documentation "Create an mdi window"))
|
||||
|
||||
(defmethod create-window ((obj clog-obj) title &key
|
||||
(html-id nil)
|
||||
(content "")
|
||||
(left 60)
|
||||
(top 60)
|
||||
(width 400)
|
||||
(height 300))
|
||||
(unless html-id
|
||||
(setf html-id (clog-connection:generate-id)))
|
||||
|
||||
(let* ((app (connection-data-item obj "app-data"))
|
||||
(win (create-child (body app)
|
||||
(format nil
|
||||
"<div style='position:fixed;top:~Apx;left:~Apx;width:~Apx;height:~Apx;
|
||||
flex-container;display:flex;flex-direction:column;z-index:~A'
|
||||
class='w3-card-4 w3-white w3-border'>
|
||||
<div id='~A-title-bar' class='w3-container w3-black'
|
||||
style='flex-container;display:flex;align-items:stretch;'>
|
||||
<span data-drag-obj='~A' data-drag-type='m' id='~A-title'
|
||||
style='flex-grow:9;user-select:none;cursor:move;'>~A</span>
|
||||
<span id='~A-close'
|
||||
style='cursor:pointer;user-select:none;'>X</span>
|
||||
</div>
|
||||
<div id='~A-body' style='flex-grow:9;'>~A</div>
|
||||
<div id='~A-size' style='user-select:none;height:1px;
|
||||
cursor:se-resize;opacity:0'
|
||||
class='w3-right' data-drag-obj='~A' data-drag-type='s'>+</div>
|
||||
</div>"
|
||||
top left width height (incf (last-z app)) ; outer div
|
||||
html-id html-id html-id ; title bar
|
||||
title html-id ; title
|
||||
html-id content ; body
|
||||
html-id html-id) ; size
|
||||
:html-id html-id))
|
||||
(title (attach-as-child win (format nil "~A-title" html-id)))
|
||||
(close-x (attach-as-child win (format nil "~A-close" html-id)))
|
||||
(sizer (attach-as-child win (format nil "~A-size" html-id))))
|
||||
(set-on-pointer-down title 'on-ide-drag-down :capture-pointer t)
|
||||
(set-on-pointer-down sizer 'on-ide-drag-down :capture-pointer t)
|
||||
(set-on-click close-x (lambda (obj)
|
||||
(remove-from-dom win)))
|
||||
win))
|
||||
|
||||
(defun set-title (obj title)
|
||||
(setf (inner-html (attach-as-child obj (format nil "~A-title" (html-id obj)))) title))
|
||||
|
||||
(defun get-title (obj)
|
||||
(inner-html (attach-as-child obj (format nil "~A-title" (html-id obj)))))
|
||||
:documentation "Copy buffer")))
|
||||
|
||||
(defun read-file (infile)
|
||||
(with-open-file (instream infile :direction :input :if-does-not-exist nil)
|
||||
|
|
@ -149,12 +30,12 @@
|
|||
|
||||
(defun get-file-name (obj title on-file-name)
|
||||
(let* ((app (connection-data-item obj "app-data"))
|
||||
(win (create-window obj title
|
||||
:left (- (/ (width (body app)) 2) 200)
|
||||
:width 400
|
||||
:height 60))
|
||||
(body (attach-as-child win (format nil "~A-body" (html-id win))))
|
||||
(form (create-form body))
|
||||
(win (create-gui-window obj
|
||||
:title title
|
||||
:left (- (/ (width (body app)) 2) 200)
|
||||
:width 400
|
||||
:height 60))
|
||||
(form (create-form (window-content win)))
|
||||
(input (create-form-element form :input :label
|
||||
(create-label form :content "File Name:")))
|
||||
(ok (create-button form :content "OK")))
|
||||
|
|
@ -173,11 +54,14 @@
|
|||
(format nil "~A~%=>~A~%" result eval-result)))
|
||||
|
||||
(defun do-ide-file-new (obj)
|
||||
(let ((app (connection-data-item obj "app-data"))
|
||||
(win (create-window obj "New window"
|
||||
:left (random 600)
|
||||
:top (+ 40 (random 400)))))
|
||||
(create-child obj
|
||||
(let ((win (create-gui-window obj
|
||||
:title "New window"
|
||||
:left (random 600)
|
||||
:top (+ 40 (random 400)))))
|
||||
(set-on-window-size win (lambda (obj)
|
||||
(js-execute obj
|
||||
(format nil "editor_~A.resize()" (html-id win)))))
|
||||
(create-child win
|
||||
(format nil
|
||||
"<script>
|
||||
var editor_~A = ace.edit('~A-body');
|
||||
|
|
@ -190,76 +74,76 @@
|
|||
(html-id win)
|
||||
(html-id win)
|
||||
(html-id win)
|
||||
(html-id win)))
|
||||
(setf (current-win app) win)))
|
||||
(html-id win)))))
|
||||
|
||||
(defun do-ide-file-open (obj)
|
||||
(let ((app (connection-data-item obj "app-data")))
|
||||
(get-file-name obj "Open..."
|
||||
(lambda (fname)
|
||||
(do-ide-file-new obj)
|
||||
(set-title (current-win app) fname)
|
||||
(js-execute obj (format nil "editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||
(html-id (current-win app))
|
||||
(escape-string (read-file fname))
|
||||
(html-id (current-win app))))))))
|
||||
(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 (obj)
|
||||
(let ((app (connection-data-item obj "app-data")))
|
||||
(if (equalp (get-title (current-win app)) "New Window")
|
||||
(do-ide-file-save-as obj)
|
||||
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id (current-win app))))
|
||||
(get-title (current-win app))))))
|
||||
(if (equalp (window-title (current-window obj)) "New Window")
|
||||
(do-ide-file-save-as obj)
|
||||
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id (current-window obj))))
|
||||
(window-title (current-window obj)))))
|
||||
|
||||
(defun do-ide-file-save-as (obj)
|
||||
(let ((app (connection-data-item obj "app-data")))
|
||||
(get-file-name obj "Save.."
|
||||
(let ((cw (current-window obj)))
|
||||
(get-file-name obj "Save As.."
|
||||
(lambda (fname)
|
||||
(set-title (current-win app) fname)
|
||||
(do-ide-file-save obj)))))
|
||||
(setf (window-title cw) fname)
|
||||
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id cw)))
|
||||
fname)))))
|
||||
|
||||
|
||||
(defun do-ide-edit-copy (obj)
|
||||
(let* ((app (connection-data-item obj "app-data")))
|
||||
(setf (copy-buf app) (js-query obj (format nil "editor_~A.getCopyText();"
|
||||
(html-id (current-win app)))))))
|
||||
(html-id (current-window obj)))))))
|
||||
|
||||
(defun do-ide-edit-cut (obj)
|
||||
(do-ide-edit-copy obj)
|
||||
(let* ((app (connection-data-item obj "app-data")))
|
||||
(js-execute obj (format nil "editor_~A.execCommand('cut')"
|
||||
(html-id (current-win app))))))
|
||||
(js-execute obj (format nil "editor_~A.execCommand('cut')"
|
||||
(html-id (current-window obj)))))
|
||||
|
||||
(defun do-ide-edit-paste (obj)
|
||||
(let* ((app (connection-data-item obj "app-data")))
|
||||
(js-execute obj (format nil "editor_~A.execCommand('paste', '~A')"
|
||||
(html-id (current-win app))
|
||||
(html-id (current-window obj))
|
||||
(escape-string (copy-buf app))))))
|
||||
|
||||
(defun do-ide-lisp-eval-file (obj)
|
||||
(let* ((app (connection-data-item obj "app-data"))
|
||||
(form-string (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id (current-win app)))))
|
||||
(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)
|
||||
(js-execute obj (format nil "editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||
(html-id (current-win app))
|
||||
(html-id (current-window obj))
|
||||
(escape-string result)
|
||||
(html-id (current-win app))))))
|
||||
(html-id (current-window obj))))))
|
||||
|
||||
(defun do-ide-help-about (obj)
|
||||
(let* ((app (connection-data-item obj "app-data"))
|
||||
(about (create-window (body app) "About"
|
||||
:content "<div class='w3-black'>
|
||||
(let* ((app (connection-data-item obj "app-data"))
|
||||
(about (create-gui-window obj
|
||||
: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>(c) 2021 - David Botton</center></p></div>"
|
||||
:left (- (/ (width (body app)) 2) 100)
|
||||
:width 200
|
||||
:height 200)))
|
||||
(setf (current-win app) about)))
|
||||
:left (- (/ (width (body app)) 2) 100)
|
||||
:width 200
|
||||
:height 200)))
|
||||
(set-on-window-can-size about (lambda (obj)()))))
|
||||
|
||||
(defun on-new-window (body)
|
||||
(let ((app (make-instance 'app-data)))
|
||||
|
|
@ -274,6 +158,7 @@
|
|||
(edit (create-gui-menu-drop-down menu :content "Edit"))
|
||||
(lisp (create-gui-menu-drop-down menu :content "Lisp"))
|
||||
(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)
|
||||
(create-gui-menu-item file :content "Save" :on-click #'do-ide-file-save)
|
||||
|
|
|
|||
|
|
@ -5,9 +5,9 @@
|
|||
(in-package :clog-user)
|
||||
|
||||
(defun on-file-new (body)
|
||||
(setf (set-on-window-size-done (create-gui-window body))
|
||||
(lambda (obj)
|
||||
(print "sized"))))
|
||||
(let ((win (create-gui-window body)))
|
||||
(dotimes (n 100)
|
||||
(create-div (window-content win) :content n))))
|
||||
|
||||
(defun on-new-window (body)
|
||||
(clog-gui-initialize body)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue