mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
window-center
This commit is contained in:
parent
29122904ec
commit
339b3cce6d
5 changed files with 71 additions and 57 deletions
|
|
@ -8,10 +8,7 @@
|
||||||
(in-package :clog-user)
|
(in-package :clog-user)
|
||||||
|
|
||||||
(defclass app-data ()
|
(defclass app-data ()
|
||||||
((body
|
((copy-buf
|
||||||
:accessor body
|
|
||||||
:documentation "Top level access to browser window")
|
|
||||||
(copy-buf
|
|
||||||
:accessor copy-buf
|
:accessor copy-buf
|
||||||
:initform ""
|
:initform ""
|
||||||
:documentation "Copy buffer")))
|
:documentation "Copy buffer")))
|
||||||
|
|
@ -65,35 +62,32 @@
|
||||||
(html-id win)))))
|
(html-id win)))))
|
||||||
|
|
||||||
(defun do-ide-file-open (obj)
|
(defun do-ide-file-open (obj)
|
||||||
(let ((app (connection-data-item obj "app-data")))
|
(server-file-dialog obj "Open..." "./"
|
||||||
(server-file-dialog obj "Open..." "./"
|
(lambda (fname)
|
||||||
(lambda (fname)
|
(when fname
|
||||||
(when fname
|
(do-ide-file-new obj)
|
||||||
(do-ide-file-new obj)
|
(setf (window-title (current-window obj)) fname)
|
||||||
(setf (window-title (current-window obj)) fname)
|
(js-execute obj
|
||||||
(js-execute obj
|
(format nil
|
||||||
(format nil "editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
"editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||||
(html-id (current-window obj))
|
(html-id (current-window obj))
|
||||||
(escape-string (read-file fname))
|
(escape-string (read-file fname))
|
||||||
(html-id (current-window obj))))))
|
(html-id (current-window obj))))))))
|
||||||
:top 10
|
|
||||||
:left (- (/ (width (body app)) 2) 200))))
|
|
||||||
|
|
||||||
(defun do-ide-file-save-as (obj)
|
(defun do-ide-file-save-as (obj)
|
||||||
(let* ((app (connection-data-item obj "app-data"))
|
(let* ((cw (current-window obj))
|
||||||
(cw (current-window obj))
|
|
||||||
(dir (directory-namestring (window-title cw))))
|
(dir (directory-namestring (window-title cw))))
|
||||||
(when cw
|
(when cw
|
||||||
(server-file-dialog obj "Save As.." dir
|
(server-file-dialog obj "Save As.." dir
|
||||||
(lambda (fname)
|
(lambda (fname)
|
||||||
|
(window-focus cw)
|
||||||
(when fname
|
(when fname
|
||||||
(setf (window-title cw) fname)
|
(setf (window-title cw) fname)
|
||||||
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
||||||
(html-id cw)))
|
(html-id cw)))
|
||||||
fname)))
|
fname)))
|
||||||
:top 10
|
:initial-filename (when (equal (window-title cw) "New Window")
|
||||||
:left (- (/ (width (body app)) 2) 200)
|
(window-title cw))))))
|
||||||
:initial-filename (window-title cw)))))
|
|
||||||
|
|
||||||
(defun do-ide-file-save (obj)
|
(defun do-ide-file-save (obj)
|
||||||
(if (equalp (window-title (current-window obj)) "New Window")
|
(if (equalp (window-title (current-window obj)) "New Window")
|
||||||
|
|
@ -124,7 +118,7 @@
|
||||||
(defun do-ide-edit-copy (obj)
|
(defun do-ide-edit-copy (obj)
|
||||||
(let ((cw (current-window obj)))
|
(let ((cw (current-window obj)))
|
||||||
(when cw
|
(when cw
|
||||||
(let* ((app (connection-data-item obj "app-data")))
|
(let ((app (connection-data-item obj "app-data")))
|
||||||
(setf (copy-buf app) (js-query obj
|
(setf (copy-buf app) (js-query obj
|
||||||
(format nil "editor_~A.execCommand('copy');~
|
(format nil "editor_~A.execCommand('copy');~
|
||||||
navigator.clipboard.writeText(editor_~A.getCopyText());~
|
navigator.clipboard.writeText(editor_~A.getCopyText());~
|
||||||
|
|
@ -141,13 +135,12 @@
|
||||||
(defun do-ide-edit-paste (obj)
|
(defun do-ide-edit-paste (obj)
|
||||||
(let ((cw (current-window obj)))
|
(let ((cw (current-window obj)))
|
||||||
(when cw
|
(when cw
|
||||||
(let ((app (connection-data-item obj "app-data")))
|
;; Note this methods uses the global clip buffer and not (copy-buf app)
|
||||||
;; 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.
|
||||||
;; on copy and paste we set both the global and local buffer.
|
(js-execute obj (format nil "navigator.clipboard.readText().then(function(text) {~
|
||||||
(js-execute obj (format nil "navigator.clipboard.readText().then(function(text) {~
|
|
||||||
editor_~A.execCommand('paste', text)~
|
editor_~A.execCommand('paste', text)~
|
||||||
})"
|
})"
|
||||||
(html-id cw)))))))
|
(html-id cw))))))
|
||||||
|
|
||||||
(defun do-ide-lisp-eval-file (obj)
|
(defun do-ide-lisp-eval-file (obj)
|
||||||
(let ((cw (current-window obj)))
|
(let ((cw (current-window obj)))
|
||||||
|
|
@ -164,26 +157,23 @@
|
||||||
(html-id cw)))))))
|
(html-id cw)))))))
|
||||||
|
|
||||||
(defun do-ide-help-about (obj)
|
(defun do-ide-help-about (obj)
|
||||||
(let* ((app (connection-data-item obj "app-data"))
|
(let ((about (create-gui-window obj
|
||||||
(about (create-gui-window obj
|
:title "About"
|
||||||
:title "About"
|
:content "<div class='w3-black'>
|
||||||
:content "<div class='w3-black'>
|
|
||||||
<center><img src='/img/clogwicon.png'></center>
|
<center><img src='/img/clogwicon.png'></center>
|
||||||
<center>CLOG</center>
|
<center>CLOG</center>
|
||||||
<center>The Common Lisp Omnificent GUI</center></div>
|
<center>The Common Lisp Omnificent GUI</center></div>
|
||||||
<div><p><center>Demo 3</center>
|
<div><p><center>Demo 3</center>
|
||||||
<center>(c) 2021 - David Botton</center></p></div>"
|
<center>(c) 2021 - David Botton</center></p></div>"
|
||||||
:left (- (/ (inner-width (window (body app))) 2.0) 100)
|
:width 200
|
||||||
:top (- (/ (inner-height (window (body app))) 2.0) 100)
|
:height 200)))
|
||||||
:width 200
|
(window-center about)
|
||||||
:height 200)))
|
|
||||||
(set-on-window-can-size about (lambda (obj)
|
(set-on-window-can-size about (lambda (obj)
|
||||||
(declare (ignore obj))()))))
|
(declare (ignore obj))()))))
|
||||||
|
|
||||||
(defun on-new-window (body)
|
(defun on-new-window (body)
|
||||||
(let ((app (make-instance 'app-data)))
|
(let ((app (make-instance 'app-data)))
|
||||||
(setf (connection-data-item body "app-data") app)
|
(setf (connection-data-item body "app-data") app))
|
||||||
(setf (body app) body))
|
|
||||||
(clog-gui-initialize body)
|
(clog-gui-initialize body)
|
||||||
(load-script (html-document body) "https://pagecdn.io/lib/ace/1.4.12/ace.js")
|
(load-script (html-document body) "https://pagecdn.io/lib/ace/1.4.12/ace.js")
|
||||||
(add-class body "w3-teal")
|
(add-class body "w3-teal")
|
||||||
|
|
|
||||||
|
|
@ -823,7 +823,21 @@ interactions. Use window-end-modal to undo."))
|
||||||
(let ((app (connection-data-item obj "clog-gui")))
|
(let ((app (connection-data-item obj "clog-gui")))
|
||||||
(remove-from-dom (modal-background app))
|
(remove-from-dom (modal-background app))
|
||||||
(window-focus obj)))
|
(window-focus obj)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; window-center ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defgeneric window-center (clog-gui-window)
|
||||||
|
(:documentation "Center CLOG-GUI-WINDOW in browser."))
|
||||||
|
|
||||||
|
(defmethod window-center ((obj clog-gui-window))
|
||||||
|
(let ((body (connection-data-item obj "clog-body")))
|
||||||
|
(setf (top obj) (unit :px (- (/ (inner-height (window body)) 2.0)
|
||||||
|
(/ (height obj) 2.0))))
|
||||||
|
(setf (left obj) (unit :px (- (/ (inner-width (window body)) 2.0)
|
||||||
|
(/ (width obj) 2.0))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; window-toggle-maximize ;;
|
;; window-toggle-maximize ;;
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
@ -1029,7 +1043,8 @@ interactions. Use window-end-modal to undo."))
|
||||||
(initial-filename nil))
|
(initial-filename nil))
|
||||||
"Create a local file dialog box called TITLE using INITIAL-DIR on server
|
"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."
|
machine, upon close ON-FILE-NAME called with filename or nil if failure."
|
||||||
(let* ((win (create-gui-window obj
|
(let* ((body (connection-data-item obj "clog-body"))
|
||||||
|
(win (create-gui-window obj
|
||||||
:title title
|
:title title
|
||||||
:maximize maximize
|
:maximize maximize
|
||||||
:top top
|
:top top
|
||||||
|
|
@ -1044,6 +1059,12 @@ machine, upon close ON-FILE-NAME called with filename or nil if failure."
|
||||||
(create-label form :content "File Name:")))
|
(create-label form :content "File Name:")))
|
||||||
(ok (create-button form :content "OK"))
|
(ok (create-button form :content "OK"))
|
||||||
(cancel (create-button form :content "Cancel")))
|
(cancel (create-button form :content "Cancel")))
|
||||||
|
(unless top
|
||||||
|
(setf (top win) (unit :px (- (/ (inner-height (window body)) 2.0)
|
||||||
|
(/ (height win) 2.0)))))
|
||||||
|
(unless left
|
||||||
|
(setf (left win) (unit :px (- (/ (inner-width (window body)) 2.0)
|
||||||
|
(/ (width win) 2.0)))))
|
||||||
(setf (size dirs) 4)
|
(setf (size dirs) 4)
|
||||||
(setf (box-width dirs) "100%")
|
(setf (box-width dirs) "100%")
|
||||||
(setf (size files) 8)
|
(setf (size files) 8)
|
||||||
|
|
|
||||||
|
|
@ -689,6 +689,7 @@ embedded in a native template application.)"
|
||||||
(window-keep-on-top generic-function)
|
(window-keep-on-top generic-function)
|
||||||
(window-make-modal generic-function)
|
(window-make-modal generic-function)
|
||||||
(window-end-modal generic-function)
|
(window-end-modal generic-function)
|
||||||
|
(window-center generic-function)
|
||||||
(set-on-window-focused generic-function)
|
(set-on-window-focused generic-function)
|
||||||
(set-on-window-blurred generic-function)
|
(set-on-window-blurred generic-function)
|
||||||
(set-on-window-can-close generic-function)
|
(set-on-window-can-close generic-function)
|
||||||
|
|
|
||||||
|
|
@ -7,7 +7,11 @@
|
||||||
(defclass app-data ()
|
(defclass app-data ()
|
||||||
((body
|
((body
|
||||||
:accessor body
|
:accessor body
|
||||||
:documentation "Top level access to browser window")))
|
:documentation "Top level access to browser window")
|
||||||
|
(db-connection
|
||||||
|
:accessor db-connection
|
||||||
|
:initform nil
|
||||||
|
:documentation "Access to database connection")))
|
||||||
|
|
||||||
(defun on-db-open (obj)
|
(defun on-db-open (obj)
|
||||||
(let* ((app (connection-data-item obj "app-data"))
|
(let* ((app (connection-data-item obj "app-data"))
|
||||||
|
|
@ -41,12 +45,15 @@
|
||||||
<button class='w3-btn w3-black' id=odb-cancel>Cancel</button>
|
<button class='w3-btn w3-black' id=odb-cancel>Cancel</button>
|
||||||
|
|
||||||
</form>"
|
</form>"
|
||||||
:left (- (/ (inner-width (window (body app))) 2.0) 200)
|
:width 400
|
||||||
:top (- (/ (inner-height (window (body app))) 2.0) 225)
|
:height 450)))
|
||||||
:width 400
|
(window-center win)
|
||||||
:height 450)))
|
(set-on-click (attach-as-child obj "odb-open")
|
||||||
(set-on-click (attach-as-child obj "odb-open") (lambda (obj)
|
(lambda (obj)
|
||||||
(print "submit")))
|
(format t "open db : ~A" (name-value obj "db-name"))
|
||||||
|
(setf (db-connection app)
|
||||||
|
(dbi:connect :sqlite3
|
||||||
|
:database-name (name-value obj "db-name")))))
|
||||||
(set-on-click (attach-as-child obj "odb-cancel") (lambda (obj)
|
(set-on-click (attach-as-child obj "odb-cancel") (lambda (obj)
|
||||||
(window-close win)))))
|
(window-close win)))))
|
||||||
|
|
||||||
|
|
@ -62,11 +69,9 @@
|
||||||
<center>The Common Lisp Omnificent GUI</center></div>
|
<center>The Common Lisp Omnificent GUI</center></div>
|
||||||
<div><p><center>CLOG DB Admin</center>
|
<div><p><center>CLOG DB Admin</center>
|
||||||
<center>(c) 2021 - David Botton</center></p></div>"
|
<center>(c) 2021 - David Botton</center></p></div>"
|
||||||
:left (- (/ (inner-width (window (body app))) 2.0) 100)
|
|
||||||
:top (- (/ (inner-height (window (body app))) 2.0) 100)
|
|
||||||
:width 200
|
:width 200
|
||||||
:height 200)))
|
:height 200)))
|
||||||
(print (- (/ (inner-width (window (body app))) 2.0) 100))
|
(window-center about)
|
||||||
(set-on-window-can-size about (lambda (obj)
|
(set-on-window-can-size about (lambda (obj)
|
||||||
(declare (ignore obj))()))))
|
(declare (ignore obj))()))))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -44,20 +44,18 @@
|
||||||
|
|
||||||
(defun on-file-pinned (obj)
|
(defun on-file-pinned (obj)
|
||||||
(let ((win (create-gui-window obj :title "Pinned"
|
(let ((win (create-gui-window obj :title "Pinned"
|
||||||
:top (unit :px 50)
|
:top 200
|
||||||
:left (unit :px 0)
|
:left 0
|
||||||
:width 100
|
:width 100
|
||||||
:height 100)))
|
:height 100)))
|
||||||
(flet ((can-do (obj)()))
|
(flet ((can-do (obj)()))
|
||||||
(set-on-window-can-close win #'can-do)
|
(set-on-window-can-close win #'can-do)
|
||||||
(set-on-window-can-move win #'can-do)
|
|
||||||
(set-on-window-can-size win #'can-do))
|
(set-on-window-can-size win #'can-do))
|
||||||
(window-keep-on-top win)
|
(window-keep-on-top win)
|
||||||
(create-div win :content "I am pinned")))
|
(create-div win :content "I am pinned")))
|
||||||
|
|
||||||
(defun on-help-about (obj)
|
(defun on-help-about (obj)
|
||||||
(let* ((body (connection-data-item obj "clog-body"))
|
(let* ((about (create-gui-window obj
|
||||||
(about (create-gui-window obj
|
|
||||||
:title "About"
|
:title "About"
|
||||||
:content "<div class='w3-black'>
|
:content "<div class='w3-black'>
|
||||||
<center><img src='/img/clogwicon.png'></center>
|
<center><img src='/img/clogwicon.png'></center>
|
||||||
|
|
@ -65,10 +63,9 @@
|
||||||
<center>The Common Lisp Omnificent GUI</center></div>
|
<center>The Common Lisp Omnificent GUI</center></div>
|
||||||
<div><p><center>Tutorial 22</center>
|
<div><p><center>Tutorial 22</center>
|
||||||
<center>(c) 2021 - David Botton</center></p></div>"
|
<center>(c) 2021 - David Botton</center></p></div>"
|
||||||
:left (- (/ (inner-width (window body)) 2.0) 100)
|
|
||||||
:top (- (/ (inner-height (window body)) 2.0) 100)
|
|
||||||
:width 200
|
:width 200
|
||||||
:height 200)))
|
:height 200)))
|
||||||
|
(window-center about)
|
||||||
(set-on-window-can-size about (lambda (obj)
|
(set-on-window-can-size about (lambda (obj)
|
||||||
(declare (ignore obj))()))))
|
(declare (ignore obj))()))))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue