[cells-gtk-devel] Editable Table

[Peter Hildebrandt]

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.hildebrandt at 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.martin at 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 at common-lisp.net
>> http://common-lisp.net/mailman/listinfo/cells-gtk-devel
>>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cells-gtk-devel/attachments/20091007/ec2b598a/attachment.html>