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

double click for text entry window

Browse source
This commit is contained in:
David Botton 2024-07-28 10:58:16 -04:00
parent 4d02a3c689
commit 73157f85fc
6 changed files with 40 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

1
source/clog-helpers.lisp
View file

@ -14,6 +14,7 @@
(:export :clog-builder
:clog-open
:add-supported-controls
:adjust-control-placer
:control-info
:add-inspector
:add-file-extension

9
tools/clog-builder-api.lisp
View file

@ -31,15 +31,20 @@ replaced. (Exported)"
*supported-controls*)
(list r)))))
(defun adjust-control-placer (control)
"If changing a property potentialy can change the size of a control function should be called. (Exported)"
(let ((placer (get-placer control)))
(adjust-placer control placer)))
(defun add-inspector (name func)
"Add a custom inspector with NAME and (FUNC object title value clog-obj)"
"Add a custom inspector with NAME and (FUNC object title value clog-obj). (Exported)"
(setf *inspectors* (remove-if (lambda (x)
(equalp name (getf x :name)))
*inspectors*))
(push (list :name name :func func) *inspectors*))
(defun add-file-extension (name func)
"Add a custom file extension with NAME and (FUNC file dir project clog-obj)"
"Add a custom file extension with NAME and (FUNC file dir project clog-obj). (Exported)"
(setf *file-extensions* (remove-if (lambda (x)
(equalp name (getf x :name)))
*file-extensions*))

10
tools/clog-builder-control-list.lisp
View file

@ -199,14 +199,8 @@ of controls and double click to select control."
(place-inside-bottom-of control1 control2)
(place-before control1 control2))
(place-after control2 placer2)
(set-geometry placer1 :top (position-top control1)
:left (position-left control1)
:width (client-width control1)
:height (client-height control1))
(set-geometry placer2 :top (position-top control2)
:left (position-left control2)
:width (client-width control2)
:height (client-height control2))
(adjust-placer control1 placer1)
(adjust-placer control2 placer2)
(on-populate-control-properties-win content :win win)
(on-populate-control-list-win content :win win))))
(set-on-drag-start list-item (lambda (obj)(declare (ignore obj))())

5
tools/clog-builder-control-properties.lisp
View file

@ -184,7 +184,4 @@
(funcall (fourth item) obj)
(when placer
(jquery-execute placer "trigger('clog-builder-snap-shot')")
(set-geometry placer :top (position-top control)
:left (position-left control)
:width (client-width control)
:height (client-height control))))))))))))))))
(adjust-placer control placer)))))))))))))))

33
tools/clog-builder-panels.lisp
View file

@ -256,10 +256,7 @@ return t on success"
(add-to-control-list app panel-id control)
(setf (attribute placer "data-panel-id") panel-id)
;; setup placer
(set-geometry placer :top (position-top control)
:left (position-left control)
:width (client-width control)
:height (client-height control))
(adjust-placer control placer)
(setf (tab-index placer) "-1") ; must have a tab-index to accept keyboard input
(place-after control placer)
(set-on-key-down placer
@ -294,10 +291,7 @@ return t on success"
((and (equal key "x")
(or meta ctrl))
(blur placer)))
(set-geometry placer :top (position-top control)
:left (position-left control)
:width (client-width control)
:height (client-height control))
(adjust-placer control placer)
(jquery-execute placer "trigger('clog-builder-snap-shot')")
(set-properties-after-geomentry-change control))))
(flet ((mouse-move (obj data)
@ -365,14 +359,8 @@ return t on success"
(place-inside-bottom-of control1 control2)
(place-after control2 placer2)
(place-after control2 placer2)
(set-geometry placer1 :top (position-top control1)
:left (position-left control1)
:width (client-width control1)
:height (client-height control1))
(set-geometry placer2 :top (position-top control2)
:left (position-left control2)
:width (client-width control2)
:height (client-height control2)))
(adjust-placer control1 placer1)
(adjust-placer control2 placer2))
(select-control control)
(on-populate-control-properties-win content :win win)
(on-populate-control-list-win content :win win))
@ -450,6 +438,14 @@ manipulation of the control's location and size."
(setf (current-control app) nil)
(remove-deleted-from-control-list app panel-id))
(defun adjust-placer (control placer)
"Adjust placer geomatry to fit control"
(set-geometry placer
:top (position-top control)
:left (position-left control)
:width (client-width control)
:height (client-height control)))
(defun select-control (control)
"Select CONTROL as the current control and highlight its placer.
The actual original clog object used for creation must be used and
@ -458,10 +454,7 @@ not a temporarily attached one when using select-control."
(placer (get-placer control)))
(unless (eq control (current-control app))
(deselect-current-control app)
(set-geometry placer :top (position-top control)
:left (position-left control)
:width (client-width control)
:height (client-height control))
(adjust-placer control placer)
(setf (current-control app) control)
(set-border placer (unit "px" 2) :solid :blue)
(focus placer)

16
tools/clog-builder-settings-controls.lisp
View file

@ -360,6 +360,22 @@
(defparameter *props-text*
`((:name "text"
:setup ,(lambda (control td1 td2)
(declare (ignore td1))
(setf (advisory-title td2) "double click for external text editor")
(set-on-double-click td2 (lambda (obj)
(let ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*))
(input-dialog obj "Enter text:"
(lambda (result)
(when result
(setf (text-value control) result)
(adjust-control-placer control)))
:default-value (text-value control)
:width 800
:height 420
:size 80
:rows 10)))))
:get ,(lambda (control)
(text-value control))
:set ,(lambda (control obj)