mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
added keyboard shortcuts for cut/copy/paste
This commit is contained in:
David Botton
parent
5f0aa0341f
commit
94b3e6768c
1 changed files with 124 additions and 100 deletions
|
|
@ -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,58 +1064,70 @@ 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
|
||||||
(when (current-control app)
|
(copy (obj)
|
||||||
(maphash
|
(when (current-control app)
|
||||||
(lambda (html-id control)
|
(maphash
|
||||||
(declare (ignore html-id))
|
(lambda (html-id control)
|
||||||
(place-inside-bottom-of (bottom-panel box)
|
(declare (ignore html-id))
|
||||||
(get-placer control)))
|
(place-inside-bottom-of (bottom-panel box)
|
||||||
(get-control-list app panel-id))
|
(get-placer control)))
|
||||||
(setf (copy-buf app)
|
(get-control-list app panel-id))
|
||||||
(js-query content
|
(setf (copy-buf app)
|
||||||
(format nil
|
(js-query content
|
||||||
"var z=~a.clone(); z=$('<div />').append(z);~
|
(format nil
|
||||||
|
"var z=~a.clone(); z=$('<div />').append(z);~
|
||||||
z.find('*').each(function(){~
|
z.find('*').each(function(){~
|
||||||
if($(this).attr('data-clog-composite-control') == 't'){$(this).text('')}~
|
if($(this).attr('data-clog-composite-control') == 't'){$(this).text('')}~
|
||||||
if($(this).attr('id') !== undefined && ~
|
if($(this).attr('id') !== undefined && ~
|
||||||
$(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
|
$(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
|
||||||
z.html()"
|
z.html()"
|
||||||
(jquery (current-control app)))))
|
(jquery (current-control app)))))
|
||||||
(system-clipboard-write obj (copy-buf app))
|
(system-clipboard-write obj (copy-buf app))
|
||||||
(maphash
|
(maphash
|
||||||
(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
|
||||||
(bordeaux-threads:with-lock-held ((new-control-lock app))
|
(paste (obj)
|
||||||
(let ((buf (or (system-clipboard-read obj)
|
(bordeaux-threads:with-lock-held ((new-control-lock app))
|
||||||
(copy-buf app))))
|
(let ((buf (or (system-clipboard-read obj)
|
||||||
(when buf
|
(copy-buf app))))
|
||||||
(let ((control (create-control content content
|
(when buf
|
||||||
`(:name "custom"
|
(let ((control (create-control content content
|
||||||
:create-type :paste)
|
`(:name "custom"
|
||||||
(format nil "CLOGB~A~A"
|
:create-type :paste)
|
||||||
(get-universal-time)
|
(format nil "CLOGB~A~A"
|
||||||
(next-id content))
|
(get-universal-time)
|
||||||
:custom-query buf)))
|
(next-id content))
|
||||||
(setf (attribute control "data-clog-name")
|
:custom-query buf)))
|
||||||
(format nil "~A-~A" "copy" (next-id content)))
|
(setf (attribute control "data-clog-name")
|
||||||
(incf-next-id content)
|
(format nil "~A-~A" "copy" (next-id content)))
|
||||||
(add-sub-controls control content :win win :paste t)
|
(incf-next-id content)
|
||||||
(let ((cr (control-info (attribute control "data-clog-type"))))
|
(add-sub-controls control content :win win :paste t)
|
||||||
(when (getf cr :on-load)
|
(let ((cr (control-info (attribute control "data-clog-type"))))
|
||||||
(funcall (getf cr :on-load) control cr)))
|
(when (getf cr :on-load)
|
||||||
(setup-control content control :win win)
|
(funcall (getf cr :on-load) control cr)))
|
||||||
(select-control control)
|
(setup-control content control :win win)
|
||||||
(on-populate-control-list-win content)))))))
|
(select-control control)
|
||||||
(set-on-click btn-del (lambda (obj)
|
(on-populate-control-list-win content))))))
|
||||||
(declare (ignore obj))
|
;; delete
|
||||||
(when (current-control app)
|
(del (obj)
|
||||||
(delete-current-control app panel-id (html-id (current-control app)))
|
(declare (ignore obj))
|
||||||
(on-populate-control-properties-win content :win win)
|
(when (current-control app)
|
||||||
(on-populate-control-list-win content))))
|
(delete-current-control app panel-id (html-id (current-control app)))
|
||||||
|
(on-populate-control-properties-win content :win win)
|
||||||
|
(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,58 +1294,70 @@ 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
|
||||||
(when (current-control app)
|
(copy (obj)
|
||||||
(maphash
|
(when (current-control app)
|
||||||
(lambda (html-id control)
|
(maphash
|
||||||
(declare (ignore html-id))
|
(lambda (html-id control)
|
||||||
(place-inside-bottom-of (bottom-panel box)
|
(declare (ignore html-id))
|
||||||
(get-placer control)))
|
(place-inside-bottom-of (bottom-panel box)
|
||||||
(get-control-list app panel-id))
|
(get-placer control)))
|
||||||
(setf (copy-buf app)
|
(get-control-list app panel-id))
|
||||||
(js-query content
|
(setf (copy-buf app)
|
||||||
(format nil
|
(js-query content
|
||||||
"var z=~a.clone(); z=$('<div />').append(z);~
|
(format nil
|
||||||
z.find('*').each(function(){~
|
"var z=~a.clone(); z=$('<div />').append(z);~
|
||||||
if($(this).attr('data-clog-composite-control') == 't'){$(this).text('')}~
|
z.find('*').each(function(){~
|
||||||
if($(this).attr('id') !== undefined && ~
|
if($(this).attr('data-clog-composite-control') == 't'){$(this).text('')}~
|
||||||
$(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
|
if($(this).attr('id') !== undefined && ~
|
||||||
z.html()"
|
$(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
|
||||||
(jquery (current-control app)))))
|
z.html()"
|
||||||
(system-clipboard-write obj (copy-buf app))
|
(jquery (current-control app)))))
|
||||||
(maphash
|
(system-clipboard-write obj (copy-buf app))
|
||||||
(lambda (html-id control)
|
(maphash
|
||||||
(declare (ignore html-id))
|
(lambda (html-id control)
|
||||||
(place-after control (get-placer control)))
|
(declare (ignore html-id))
|
||||||
(get-control-list app panel-id)))))
|
(place-after control (get-placer control)))
|
||||||
(set-on-click btn-paste (lambda (obj)
|
(get-control-list app panel-id))))
|
||||||
(bordeaux-threads:with-lock-held ((new-control-lock app))
|
;; paste
|
||||||
(let ((buf (or (system-clipboard-read obj)
|
(paste (obj)
|
||||||
(copy-buf app))))
|
(bordeaux-threads:with-lock-held ((new-control-lock app))
|
||||||
(when buf
|
(let ((buf (or (system-clipboard-read obj)
|
||||||
(let ((control (create-control content content
|
(copy-buf app))))
|
||||||
`(:name "custom"
|
(when buf
|
||||||
:create-type :paste)
|
(let ((control (create-control content content
|
||||||
(format nil "CLOGB~A~A"
|
`(:name "custom"
|
||||||
(get-universal-time)
|
:create-type :paste)
|
||||||
(next-id content))
|
(format nil "CLOGB~A~A"
|
||||||
:custom-query buf)))
|
(get-universal-time)
|
||||||
(setf (attribute control "data-clog-name")
|
(next-id content))
|
||||||
(format nil "~A-~A" "copy" (next-id content)))
|
:custom-query buf)))
|
||||||
(incf-next-id content)
|
(setf (attribute control "data-clog-name")
|
||||||
(add-sub-controls control content :win win :paste t)
|
(format nil "~A-~A" "copy" (next-id content)))
|
||||||
(let ((cr (control-info (attribute control "data-clog-type"))))
|
(incf-next-id content)
|
||||||
(when (getf cr :on-load)
|
(add-sub-controls control content :win win :paste t)
|
||||||
(funcall (getf cr :on-load) control cr)))
|
(let ((cr (control-info (attribute control "data-clog-type"))))
|
||||||
(setup-control content control :win win)
|
(when (getf cr :on-load)
|
||||||
(select-control control)
|
(funcall (getf cr :on-load) control cr)))
|
||||||
(on-populate-control-list-win content)))))))
|
(setup-control content control :win win)
|
||||||
(set-on-click btn-del (lambda (obj)
|
(select-control control)
|
||||||
(declare (ignore obj))
|
(on-populate-control-list-win content))))))
|
||||||
(when (current-control app)
|
;; delete
|
||||||
(delete-current-control app panel-id (html-id (current-control app)))
|
(del (obj)
|
||||||
(on-populate-control-properties-win content :win win)
|
(declare (ignore obj))
|
||||||
(on-populate-control-list-win content))))
|
(when (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-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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue