- cells-cvs@common-lisp.net - mailman3.common-lisp.net

[cells-cvs] CVS update: cell-cultures/celtic/button.lisp cell-cultures/celtic/celtic.lisp cell-cultures/celtic/celtic.lpr cell-cultures/celtic/frame.lisp cell-cultures/celtic/ctk-test.lisp cell-cultures/celtic/visual-apropos.lisp
by Kenny Tilton 27 Jun '04

27 Jun '04

Update of /project/cells/cvsroot/cell-cultures/celtic In directory common-lisp.net:/tmp/cvs-serv23697/celtic Modified Files: button.lisp celtic.lisp celtic.lpr frame.lisp Removed Files: ctk-test.lisp visual-apropos.lisp Log Message: Date: Sun Jun 27 16:54:29 2004 Author: ktilton Index: cell-cultures/celtic/button.lisp diff -u cell-cultures/celtic/button.lisp:1.1 cell-cultures/celtic/button.lisp:1.2 --- cell-cultures/celtic/button.lisp:1.1 Sat Jun 26 11:38:38 2004 +++ cell-cultures/celtic/button.lisp Sun Jun 27 16:54:28 2004 @@ -34,8 +34,6 @@ (-command nil) -compound -default -height -overrelief -state -width)) - - (defun test-button () (make-be 'button :text (format nil "Time is ~a" (get-internal-real-time)) :width 48 @@ -58,6 +56,11 @@ -overrelief -selectcolor -selectimage -state -tristateimage -tristatevalue (-tk-variable -variable) -width)) +(def-c-output .md-value ((self checkbutton)) + (tk-send (format nil "set ~a ~a" + (down$ (md-name self)) + (if new-value 1 0)))) + (def-widget radiobutton () (-activebackground -activeforeground -anchor -background -bitmap -borderwidth -cursor -disabledforeground @@ -70,7 +73,6 @@ -overrelief -selectcolor -selectimage -state -tristateimage -tristatevalue (-tk-variable -variable) -width) (:default-initargs - :value (c? (eql self (selection (upper self selector)))) :command (lambda (self) (setf (selection (upper self selector)) self)))) Index: cell-cultures/celtic/celtic.lisp diff -u cell-cultures/celtic/celtic.lisp:1.1 cell-cultures/celtic/celtic.lisp:1.2 --- cell-cultures/celtic/celtic.lisp:1.1 Sat Jun 26 11:38:38 2004 +++ cell-cultures/celtic/celtic.lisp Sun Jun 27 16:54:28 2004 @@ -88,7 +88,7 @@ (defun tk-send (text) "send a string to wish" - (when t ;;*debug-tk* + (when *debug-tk* (format t "~&tk-send> ~A~%" text) (force-output)) (format *w* "~A~%" text) Index: cell-cultures/celtic/celtic.lpr diff -u cell-cultures/celtic/celtic.lpr:1.1 cell-cultures/celtic/celtic.lpr:1.2 --- cell-cultures/celtic/celtic.lpr:1.1 Sat Jun 26 11:38:38 2004 +++ cell-cultures/celtic/celtic.lpr Sun Jun 27 16:54:28 2004 @@ -11,9 +11,7 @@ (make-instance 'module :name "frame.lisp") (make-instance 'module :name "canvas.lisp") (make-instance 'module :name "textual.lisp") - (make-instance 'module :name "button.lisp") - (make-instance 'module :name "ps-test.lisp") - (make-instance 'module :name "visual-apropos.lisp")) + (make-instance 'module :name "button.lisp")) :projects (list (make-instance 'project-module :name "c:\\dvl\\cells\\cells")) :libraries nil Index: cell-cultures/celtic/frame.lisp diff -u cell-cultures/celtic/frame.lisp:1.1 cell-cultures/celtic/frame.lisp:1.2 --- cell-cultures/celtic/frame.lisp:1.1 Sat Jun 26 11:38:38 2004 +++ cell-cultures/celtic/frame.lisp Sun Jun 27 16:54:28 2004 @@ -21,7 +21,6 @@ (in-package :celtic) - (def-widget frame () (-borderwidth -cursor -highlightbackground -highlightcolor -highlightthickness -padx -pady -relief @@ -60,6 +59,12 @@ :cursor "hand2" :font "Courier")))) +; ------------------------------------------------------------------ + +(defmodel labelframe-selector (selector labelframe)()) +(defun labelframe-selector (&rest init-args) + (apply 'make-instance 'labelframe-selector init-args)) + ;------------------------------------------------------- (defun layout-row () @@ -67,7 +72,7 @@ (path self) (mapcar 'path (^kids))))) (defun layout-stack () - (c? (format nil "pack ~a -side {left}; pack~{ ~a~} -side {top}" + (c? (format nil "pack ~a -side {left}; pack~{ ~a~} -side {top} -anchor nw" (path self) (mapcar 'path (^kids))))) (defmacro frame-row ((&rest options) &rest kids) @@ -79,3 +84,34 @@ `(frame ,@(append options `(:layout (layout-stack) :kids (c? (list ,@kids)))))) + +;------------------------------------------------------ + +(defmodel selector () + ((selection :accessor selection :initarg :selection) + (initial-selection :initform nil :reader initial-selection + :initarg :initial-selection) + (tk-variable :cell nil :accessor tk-variable :initarg :tk-variable)) + (:default-initargs + :selection (c-in nil))) + +(def-c-output initial-selection () + (setf (selection self) new-value)) + +(def-c-output selection () + (when new-value + (tk-send (format nil "set ~a ~a" + (down$ (tk-variable self)) + (down$ (md-name new-value)))))) + +;--------------------------------------------------------- + +(defmodel radiogroup (selector) + ((tk-variable :accessor tk-variable :initarg :tk-variable)) + (:default-initargs + :tk-variable (c? (md-name self)))) + +(defmodel labelframe-radiogroup (radiogroup labelframe)()) +(defun labelframe-radiogroup (&rest init-args) + (apply 'make-instance 'labelframe-radiogroup init-args)) +

1 0

[cells-cvs] CVS update: cell-cultures/clyde/visual-apropos/visual-apropos.lisp
by Kenny Tilton 27 Jun '04

27 Jun '04

Update of /project/cells/cvsroot/cell-cultures/clyde/visual-apropos In directory common-lisp.net:/tmp/cvs-serv17111/clyde/visual-apropos Added Files: visual-apropos.lisp Log Message: Date: Sun Jun 27 16:52:25 2004 Author: ktilton

1 0

[cells-cvs] CVS update: Directory change: cell-cultures/clyde/visual-apropos
by Kenny Tilton 27 Jun '04

27 Jun '04

Update of /project/cells/cvsroot/cell-cultures/clyde/visual-apropos In directory common-lisp.net:/tmp/cvs-serv25007/visual-apropos Log Message: Directory /project/cells/cvsroot/cell-cultures/clyde/visual-apropos added to the repository Date: Sun Jun 27 10:46:57 2004 Author: ktilton New directory cell-cultures/clyde/visual-apropos added

1 0

[cells-cvs] CVS update: Directory change: cell-cultures/clyde/cloucell
by Kenny Tilton 27 Jun '04

27 Jun '04

Update of /project/cells/cvsroot/cell-cultures/clyde/cloucell In directory common-lisp.net:/tmp/cvs-serv25007/cloucell Log Message: Directory /project/cells/cvsroot/cell-cultures/clyde/cloucell added to the repository Date: Sun Jun 27 10:46:57 2004 Author: ktilton New directory cell-cultures/clyde/cloucell added

1 0

[cells-cvs] CVS update: Directory change: cell-cultures/clyde
by Kenny Tilton 27 Jun '04

27 Jun '04

Update of /project/cells/cvsroot/cell-cultures/clyde In directory common-lisp.net:/tmp/cvs-serv24768/clyde Log Message: Directory /project/cells/cvsroot/cell-cultures/clyde added to the repository Date: Sun Jun 27 10:46:50 2004 Author: ktilton New directory cell-cultures/clyde added

1 0

[cells-cvs] CVS update: cell-cultures/cells/cells.lpr
by Thomas F. Burdick 26 Jun '04

26 Jun '04

Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv13771 Modified Files: cells.lpr Log Message: Made path to utils-kt relative (hopefully this is okay) Date: Sat Jun 26 16:36:49 2004 Author: tburdick Index: cell-cultures/cells/cells.lpr diff -u cell-cultures/cells/cells.lpr:1.1 cell-cultures/cells/cells.lpr:1.2 --- cell-cultures/cells/cells.lpr:1.1 Sat Jun 26 11:38:36 2004 +++ cell-cultures/cells/cells.lpr Sat Jun 26 16:36:49 2004 @@ -27,7 +27,7 @@ (make-instance 'module :name "family-values.lisp") (make-instance 'module :name "test.lisp")) :projects (list (make-instance 'project-module :name - "c:\\dvl\\utils-kt\\utils-kt")) + "../utils-kt/utils-kt")) :libraries nil :distributed-files nil :project-package-name :cells

1 0

[cells-cvs] CVS update: cell-cultures/utils-kt/debug.lisp cell-cultures/utils-kt/defpackage.lisp cell-cultures/utils-kt/detritus.lisp cell-cultures/utils-kt/flow-control.lisp cell-cultures/utils-kt/quad.lisp cell-cultures/utils-kt/strings.lisp cell-cultures/utils-kt/utils-kt.lpr
by Kenny Tilton 26 Jun '04

26 Jun '04

Update of /project/cells/cvsroot/cell-cultures/utils-kt In directory common-lisp.net:/tmp/cvs-serv14387/utils-kt Added Files: debug.lisp defpackage.lisp detritus.lisp flow-control.lisp quad.lisp strings.lisp utils-kt.lpr Log Message: hello world Date: Sat Jun 26 11:38:43 2004 Author: ktilton

1 0

26 Jun '04

Update of /project/cells/cvsroot/cell-cultures/ide/cloucell In directory common-lisp.net:/tmp/cvs-serv14387/ide/cloucell Added Files: 01-cell-basics.lisp cloucell.asd cloucell.lpr ct-item-stack.lisp ct-slot-stack.lisp edt-window.lisp inspection.lisp inspector-toolbar.lisp inspector-window.lisp object-inspector-01.lisp object-inspector-02.lisp outline.lisp slot-inspector.lisp structure-view.lisp Log Message: hello world Date: Sat Jun 26 11:38:42 2004 Author: ktilton

1 0

[cells-cvs] CVS update: cell-cultures/config/cellocore-config.lisp cell-cultures/config/cellodemo-config.lisp cell-cultures/config/cl-ftgl-config.lisp cell-cultures/config/cl-magick-config.lisp cell-cultures/config/cl-openal-config.lisp cell-cultures/config/cl-opengl-config.lisp
by Kenny Tilton 26 Jun '04

26 Jun '04

Update of /project/cells/cvsroot/cell-cultures/config In directory common-lisp.net:/tmp/cvs-serv14387/config Added Files: cellocore-config.lisp cellodemo-config.lisp cl-ftgl-config.lisp cl-magick-config.lisp cl-openal-config.lisp cl-opengl-config.lisp Log Message: hello world Date: Sat Jun 26 11:38:41 2004 Author: ktilton

1 0

[cells-cvs] CVS update: cell-cultures/ftgl-int/FTGLFromC.cpp cell-cultures/ftgl-int/main.cpp
by Kenny Tilton 26 Jun '04

26 Jun '04

Update of /project/cells/cvsroot/cell-cultures/ftgl-int In directory common-lisp.net:/tmp/cvs-serv14387/ftgl-int Added Files: FTGLFromC.cpp main.cpp Log Message: hello world Date: Sat Jun 26 11:38:42 2004 Author: ktilton

1 0