Hi Martin,
here's the object inspector I wrote:
(defmodel net-ed-object-inspector (frame)
()
(:default-initargs
:kids (list
(mk-listbox
:md-name :active-object-desc
:selection-mode :single
:on-edited (lambda (self item col type new-value)
(declare (ignorable self col type))
;; accept the editing when it is an editable entry
(when (desc-item-editable item)
(deb "edited to ~a --> calling setter" new-value)
(funcall (desc-item-setter item) new-value)))
:columns (def-columns
(:string (:title "Name"))
(:string (:title "Value")
#'(lambda (var) (declare (ignore var)))
t)
(:boolean (:title "r/w")))
:items (c? (when-bind (obj (active-object (upper self
net-editor)))
(desc-items obj)))
:print-fn (lambda (item)
(when item
(list (desc-item-label item)
(desc-item-getter item)
(desc-item-editable item))))))))
Where desc-item works like this
(defstruct desc-item
label
getter
setter
editable)
and is typically created with make-desc like this
......
(:readers
((desc-items (make-desc (color :editable t) (tag :editable t))))
make-desc is defined as
(defmacro make-desc (&rest fields)
`(list
;; heading
(make-desc-item
:label "Type"
:getter (format nil "~:(~a~)" (type-of self))
:setter #'(lambda (new-val) (declare (ignore new-val)))
:editable nil)
,@@(loop for field-desc in fields
for field-spec = (if (atom field-desc) (list field-desc) field-desc)
for field = (first field-spec)
for field-properties = (rest field-spec)
for editable = (getf field-properties :editable)
collecting `(make-desc-item
:label ,(format nil "~:(~a~)" field)
:getter (prin1-to-string (,(intern (string field) :net-ed) self))
:setter #'(lambda (new-val) (setf (,(intern (string field) :net-ed) self)
(read-from-string new-val)))
:editable ,editable))))
Hope you'll be able to deduct the necessary parts from this code.
I gotta get back to work now ...
Kind regards
Peter
On Tue, Oct 6, 2009 at 9:52 PM, Peter Hildebrandt <
peter.hildebra...@gmail.com> wrote:
>
> Hi Martin,
>
> This should be possible--and as a matter of fact I used similar
> functionality in my MSc project. I had a table in which I could enter
> numbers, symbols, and even functions (which--using cells--got compiled in
> real time like this: (compiled-fn :initform (c? (compile ^fn))) )
>
> I will try to locate the code later (unfortunately I am on a business trip
> right now, but I might find it somewhere anyways ...)
>
> Best
> Peter
>
> PS. We're seeing a lot of traffic (comparably) on this list lately. It's
> great to see people actually using cells-gtk.
>
> On Tue, Oct 6, 2009 at 8:37 PM, Martin Kielhorn <
> kielhorn.mar...@googlemail.com> wrote:
>
>> Hi,
>> I want a table with numbers and when I click on one number I want to
>> change it to
>> a new value. I managed to copy the table from test-gtk/test-tree-view.lisp
>> and I added
>> :editable t to the def-columns call. I can edit the number, but the system
>> doesn't store
>> the value back into one of my variables, e.g. (position$ (nth 2 *items*)).
>> So when I press
>> enter after the edit, the old value will be shown again.
>>
>> I hoped the :on-edit slot of listbox could be used for this task but the
>> format is never executed.
>>
>> Or is it only possible to do it like in the Cells-Tree-View example?
>> It seemed quite complicated to me, as I don't want two copies of branched
>> trees.
>> I think that is the next thing I would be glad to hear how :on-edit is to
>> be used.
>>
>> [I run the following code in sbcl with threads.]
>>
>> (require :asdf)
>> (require :cells-gtk)
>>
>> (defpackage :mk
>> (:use :cells :cl :cells-gtk))
>>
>> (in-package :mk)
>>
>> (defmodel myapp (gtk-app)
>> ()
>> (:default-initargs :width 400 :height 300
>> :md-name :mk-top
>> :kids (c-in nil)))
>> (init-gtk)
>> (start-win 'myapp)
>>
>> (defmodel listbox-test-item ()
>> ((position :accessor position$ :initarg :position :initform nil)
>> (curvature :accessor curvature$ :initarg :curvature :initform nil)))
>>
>> (defparameter *items*
>> (list (make-be 'listbox-test-item
>> :position (coerce (random 20) 'double-float)
>> :curvature (coerce (random 20) 'double-float))
>> (make-be 'listbox-test-item
>> :position (coerce (random 20) 'double-float)
>> :curvature (coerce (random 20) 'double-float))))
>>
>> (let ((top (find-widget :mk-top)))
>> (setf
>> (kids top)
>> (list
>> (mk-vbox
>> :fm-parent top
>> :kids
>> (kids-list?
>> (mk-listbox :md-name :listbox
>> :selection-mode :single
>> :columns (def-columns
>> (:double (:title "Position") (lambda (node) '(:editable
>> t)))
>> (:double (:title "Curvature")))
>> :items *items*
>> :print-fn (lambda (item)
>> (list (position$ item)
>> (curvature$ item)))
>> :on-edit (lambda (node col new-val)
>> (format t "~a~%" (list node col new-val)))))))))
>>
>>
>> Regards, Martin
>> --
>> Martin Kielhorn
>> Randall Division of Cell & Molecular Biophysics
>> King's College London, New Hunt's House
>> Guy's Campus, London SE1 1UL, U.K.
>> tel: +44 (0) 207 848 6519, fax: +44 (0) 207 848 6435
>>
>> _______________________________________________
>> cells-gtk-devel site list
>> cells-gtk-devel@common-lisp.net
>> http://common-lisp.net/mailman/listinfo/cells-gtk-devel
>>
>
>
_______________________________________________
cells-gtk-devel site list
cells-gtk-devel@common-lisp.net
http://common-lisp.net/mailman/listinfo/cells-gtk-devel
