[cells-gtk-devel] Fwd: Editable Table

[Martin Kielhorn]

---------- Forwarded message ----------
From: Martin Kielhorn <kielhorn.martin at googlemail.com>
Date: 2009/10/7
Subject: Re: [cells-gtk-devel] Editable Table
To: Peter Hildebrandt <peter.hildebrandt at gmail.com>




2009/10/7 Peter Hildebrandt <peter.hildebrandt at gmail.com>

>
> Hi Martin,
>
> here's the object inspector I wrote:
>

Thanks for the fast response.
Your code looks interesting. I'll try to make something out of it later.
I have to get rid of the references to obj and net-editor first.

Yesterday I understood the tree-view example and managed to change it,
so that it will only display a table. If an entry isn't parsed as a
single-float I draw it red:

(require :asdf)
(require :cells-gtk)

(defpackage :mk
  (:use :cl :cells :cells-gtk))

(in-package :mk)

(defmodel mk-app (gtk-app)
  ()
  (:default-initargs
      :md-name :mk-app
    :width 300
    :height 200
    :kids (c-in nil)))

(init-gtk)
(start-win 'mk-app)

(defmodel node (family)
  ((thickness :accessor thickness
              :initarg :position
              :initform (c-in (coerce (random 100) 'single-float)))
   (curvature :accessor curvature
              :initarg :curvature
              :initform (c-in (coerce (random 100) 'single-float)))))

(defparameter *root*
  (make-instance 'node
                 :md-name :tree
                 :kids (kids-list?
                        (make-kid 'node)
                        (make-kid 'node)
                        (make-kid 'node))))

(def-cells-tree-view node-tree ()
  (thickness :title "Thickness"
             :type :string
             :writer-fn #'(lambda (val) (format t "writer-fn ~a~%" val)
(read-from-string val))
             :reader-fn #'(lambda (val) (format t "reader-fn ~a~%" val)
(prin1-to-string val))
             :render-fn #'(lambda (node) (if (eql 'single-float (type-of
(thickness node)))
                                             '(:editable t :foreground
"black")
                                             '(:editable t :foreground
"red"))))
  (curvature :title "Curvature"))

(setf
 (kids (find-widget :mk-app))
 (list
  (mk-vbox
   :fm-parent (find-widget :mk-app)
   :kids
   (kids-list?
    (mk-node-tree *root* :expand t :fill t :md-name :tree-1)))))


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



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