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

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 (:export :clog-builder
:clog-open :clog-open
:add-supported-controls :add-supported-controls
:adjust-control-placer
:control-info :control-info
:add-inspector :add-inspector
:add-file-extension :add-file-extension

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

@ -31,15 +31,20 @@ replaced. (Exported)"
*supported-controls*) *supported-controls*)
(list r))))) (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) (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) (setf *inspectors* (remove-if (lambda (x)
(equalp name (getf x :name))) (equalp name (getf x :name)))
*inspectors*)) *inspectors*))
(push (list :name name :func func) *inspectors*)) (push (list :name name :func func) *inspectors*))
(defun add-file-extension (name func) (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) (setf *file-extensions* (remove-if (lambda (x)
(equalp name (getf x :name))) (equalp name (getf x :name)))
*file-extensions*)) *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-inside-bottom-of control1 control2)
(place-before control1 control2)) (place-before control1 control2))
(place-after control2 placer2) (place-after control2 placer2)
(set-geometry placer1 :top (position-top control1) (adjust-placer control1 placer1)
:left (position-left control1) (adjust-placer control2 placer2)
: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))
(on-populate-control-properties-win content :win win) (on-populate-control-properties-win content :win win)
(on-populate-control-list-win content :win win)))) (on-populate-control-list-win content :win win))))
(set-on-drag-start list-item (lambda (obj)(declare (ignore obj))()) (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) (funcall (fourth item) obj)
(when placer (when placer
(jquery-execute placer "trigger('clog-builder-snap-shot')") (jquery-execute placer "trigger('clog-builder-snap-shot')")
(set-geometry placer :top (position-top control) (adjust-placer control placer)))))))))))))))
:left (position-left control)
:width (client-width control)
:height (client-height control))))))))))))))))

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

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

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

@ -360,6 +360,22 @@
(defparameter *props-text* (defparameter *props-text*
`((:name "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) :get ,(lambda (control)
(text-value control)) (text-value control))
:set ,(lambda (control obj) :set ,(lambda (control obj)