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

added keyboard shortcuts for cut/copy/paste

Browse source
This commit is contained in:
David Botton 2022-06-23 23:57:26 -04:00
parent 5f0aa0341f
commit 94b3e6768c
1 changed files with 124 additions and 100 deletions
Download patch file Download diff file Expand all files Collapse all files

46
tools/clog-builder.lisp
View file

@ -1034,7 +1034,7 @@ of controls and double click to select control."
(setf-next-id content 1) (setf-next-id content 1)
(setf (overflow content) :auto) (setf (overflow content) :auto)
(init-control-list app panel-id) (init-control-list app panel-id)
;; setup panel window ;; Setup panel window
(let ((panel-name (format nil "panel-~A" (incf (next-panel-id app))))) (let ((panel-name (format nil "panel-~A" (incf (next-panel-id app)))))
(setf (window-title win) panel-name) (setf (window-title win) panel-name)
(setf (attribute content "data-clog-name") panel-name)) (setf (attribute content "data-clog-name") panel-name))
@ -1064,7 +1064,8 @@ of controls and double click to select control."
(declare (ignore obj)) (declare (ignore obj))
(on-populate-control-properties-win content :win win))) (on-populate-control-properties-win content :win win)))
;; setup tool bar events ;; setup tool bar events
(set-on-click btn-copy (lambda (obj) (flet (;; copy
(copy (obj)
(when (current-control app) (when (current-control app)
(maphash (maphash
(lambda (html-id control) (lambda (html-id control)
@ -1087,8 +1088,9 @@ of controls and double click to select control."
(lambda (html-id control) (lambda (html-id control)
(declare (ignore html-id)) (declare (ignore html-id))
(place-after control (get-placer control))) (place-after control (get-placer control)))
(get-control-list app panel-id))))) (get-control-list app panel-id))))
(set-on-click btn-paste (lambda (obj) ;; paste
(paste (obj)
(bordeaux-threads:with-lock-held ((new-control-lock app)) (bordeaux-threads:with-lock-held ((new-control-lock app))
(let ((buf (or (system-clipboard-read obj) (let ((buf (or (system-clipboard-read obj)
(copy-buf app)))) (copy-buf app))))
@ -1109,13 +1111,23 @@ of controls and double click to select control."
(funcall (getf cr :on-load) control cr))) (funcall (getf cr :on-load) control cr)))
(setup-control content control :win win) (setup-control content control :win win)
(select-control control) (select-control control)
(on-populate-control-list-win content))))))) (on-populate-control-list-win content))))))
(set-on-click btn-del (lambda (obj) ;; delete
(del (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (current-control app) (when (current-control app)
(delete-current-control app panel-id (html-id (current-control app))) (delete-current-control app panel-id (html-id (current-control app)))
(on-populate-control-properties-win content :win win) (on-populate-control-properties-win content :win win)
(on-populate-control-list-win content)))) (on-populate-control-list-win content))))
;; set up del/cut/copy/paste handlers
(set-on-copy content #'copy)
(set-on-click btn-copy #'copy)
(set-on-paste content #'paste)
(set-on-click btn-paste #'paste)
(set-on-click btn-del #'del)
(set-on-cut content (lambda (obj)
(copy obj)
(del obj))))
(set-on-click btn-sim (lambda (obj) (set-on-click btn-sim (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(cond (in-simulation (cond (in-simulation
@ -1282,7 +1294,8 @@ of controls and double click to select control."
(declare (ignore html-id)) (declare (ignore html-id))
(place-after control (get-placer control))) (place-after control (get-placer control)))
(get-control-list app panel-id))))))) (get-control-list app panel-id)))))))
(set-on-click btn-copy (lambda (obj) (flet (;; copy
(copy (obj)
(when (current-control app) (when (current-control app)
(maphash (maphash
(lambda (html-id control) (lambda (html-id control)
@ -1305,8 +1318,9 @@ of controls and double click to select control."
(lambda (html-id control) (lambda (html-id control)
(declare (ignore html-id)) (declare (ignore html-id))
(place-after control (get-placer control))) (place-after control (get-placer control)))
(get-control-list app panel-id))))) (get-control-list app panel-id))))
(set-on-click btn-paste (lambda (obj) ;; paste
(paste (obj)
(bordeaux-threads:with-lock-held ((new-control-lock app)) (bordeaux-threads:with-lock-held ((new-control-lock app))
(let ((buf (or (system-clipboard-read obj) (let ((buf (or (system-clipboard-read obj)
(copy-buf app)))) (copy-buf app))))
@ -1327,13 +1341,23 @@ of controls and double click to select control."
(funcall (getf cr :on-load) control cr))) (funcall (getf cr :on-load) control cr)))
(setup-control content control :win win) (setup-control content control :win win)
(select-control control) (select-control control)
(on-populate-control-list-win content))))))) (on-populate-control-list-win content))))))
(set-on-click btn-del (lambda (obj) ;; delete
(del (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (current-control app) (when (current-control app)
(delete-current-control app panel-id (html-id (current-control app))) (delete-current-control app panel-id (html-id (current-control app)))
(on-populate-control-properties-win content :win win) (on-populate-control-properties-win content :win win)
(on-populate-control-list-win content)))) (on-populate-control-list-win content))))
;; set up del/cut/copy/paste handlers
(set-on-copy content #'copy)
(set-on-click btn-copy #'copy)
(set-on-paste content #'paste)
(set-on-click btn-paste #'paste)
(set-on-click btn-del #'del)
(set-on-cut content (lambda (obj)
(copy obj)
(del obj))))
(set-on-click btn-sim (lambda (obj) (set-on-click btn-sim (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(cond (in-simulation (cond (in-simulation