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

[cells-cvs] CVS update: cell-cultures/utils-kt/debug.lisp cell-cultures/utils-kt/defpackage.lisp cell-cultures/utils-kt/utils-kt.lpr
by Thomas F. Burdick 29 Jun '04

29 Jun '04

Update of /project/cells/cvsroot/cell-cultures/utils-kt In directory common-lisp.net:/tmp/cvs-serv14176/utils-kt Modified Files: debug.lisp defpackage.lisp utils-kt.lpr Log Message: Added asdf<->lpr glue, and fixed ACL-produced nonsense like defpackage forms for the common-lisp package (I'm guessing ACL ignores these). Date: Tue Jun 29 01:58:49 2004 Author: tburdick Index: cell-cultures/utils-kt/debug.lisp diff -u cell-cultures/utils-kt/debug.lisp:1.1 cell-cultures/utils-kt/debug.lisp:1.2 --- cell-cultures/utils-kt/debug.lisp:1.1 Sat Jun 26 11:38:43 2004 +++ cell-cultures/utils-kt/debug.lisp Tue Jun 29 01:58:49 2004 @@ -22,10 +22,6 @@ (in-package :utils-kt) -(eval-when (compile load eval) - (export '(eko eko-if))) - - (defparameter *trcdepth* 0) (defvar *count* nil) (defvar *counting* nil) Index: cell-cultures/utils-kt/defpackage.lisp diff -u cell-cultures/utils-kt/defpackage.lisp:1.1 cell-cultures/utils-kt/defpackage.lisp:1.2 --- cell-cultures/utils-kt/defpackage.lisp:1.1 Sat Jun 26 11:38:43 2004 +++ cell-cultures/utils-kt/defpackage.lisp Tue Jun 29 01:58:49 2004 @@ -20,15 +20,13 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -(in-package :common-lisp) - (defpackage :utils-kt (:use #:common-lisp #-(or cormanlisp cmu sbcl) #:clos #+sbcl #:sb-mop #+mcl #:ccl) (:export - #:eko #:count-it #:trc #:maptimes #:bwhen #:bif #:xor + #:eko #:eko-if #:count-it #:trc #:maptimes #:bwhen #:bif #:xor "WITH-DYNAMIC-FN" #:last1 #:packed-flat! #:with-metrics "TRUE" "SHORTC" #:intern$ #:defconstant-once "*COUNT*" "*STOP*" "*DBG*" "*TRCDEPTH*" Index: cell-cultures/utils-kt/utils-kt.lpr diff -u cell-cultures/utils-kt/utils-kt.lpr:1.1 cell-cultures/utils-kt/utils-kt.lpr:1.2 --- cell-cultures/utils-kt/utils-kt.lpr:1.1 Sat Jun 26 11:38:43 2004 +++ cell-cultures/utils-kt/utils-kt.lpr Tue Jun 29 01:58:49 2004 @@ -2,10 +2,6 @@ (in-package :common-graphics-user) -(defpackage :common-lisp - (:export :intern :find-package :list :make-instance :t :nil - :quote)) - (define-project :name :utils-kt :application-type (intern "Standard EXE" (find-package :keyword)) :modules (list (make-instance 'module :name "defpackage.lisp")

1 0

[cells-cvs] CVS update: cell-cultures/asdf-aclproj/asdf-aclproj.asd cell-cultures/asdf-aclproj/asdf-aclproj.lisp
by Thomas F. Burdick 29 Jun '04

29 Jun '04

Update of /project/cells/cvsroot/cell-cultures/asdf-aclproj In directory common-lisp.net:/tmp/cvs-serv14176/asdf-aclproj Added Files: asdf-aclproj.asd asdf-aclproj.lisp Log Message: Added asdf<->lpr glue, and fixed ACL-produced nonsense like defpackage forms for the common-lisp package (I'm guessing ACL ignores these). Date: Tue Jun 29 01:58:48 2004 Author: tburdick

1 0

[cells-cvs] CVS update: Directory change: cell-cultures/asdf-repository
by Thomas F. Burdick 29 Jun '04

29 Jun '04

Update of /project/cells/cvsroot/cell-cultures/asdf-repository In directory common-lisp.net:/tmp/cvs-serv11718/asdf-repository Log Message: Directory /project/cells/cvsroot/cell-cultures/asdf-repository added to the repository Date: Tue Jun 29 01:56:15 2004 Author: tburdick New directory cell-cultures/asdf-repository added

1 0

[cells-cvs] CVS update: Directory change: cell-cultures/asdf-aclproj
by Thomas F. Burdick 29 Jun '04

29 Jun '04

Update of /project/cells/cvsroot/cell-cultures/asdf-aclproj In directory common-lisp.net:/tmp/cvs-serv4384/asdf-aclproj Log Message: Directory /project/cells/cvsroot/cell-cultures/asdf-aclproj added to the repository Date: Tue Jun 29 01:54:05 2004 Author: tburdick New directory cell-cultures/asdf-aclproj added

1 0

[cells-cvs] CVS update: cell-cultures/celtic/button.lisp cell-cultures/celtic/frame.lisp cell-cultures/celtic/widget-item.lisp cell-cultures/celtic/base.lisp
by Kenny Tilton 28 Jun '04

28 Jun '04

Update of /project/cells/cvsroot/cell-cultures/celtic In directory common-lisp.net:/tmp/cvs-serv8831/celtic Modified Files: button.lisp frame.lisp widget-item.lisp Removed Files: base.lisp Log Message: Date: Sun Jun 27 21:25:14 2004 Author: ktilton Index: cell-cultures/celtic/button.lisp diff -u cell-cultures/celtic/button.lisp:1.2 cell-cultures/celtic/button.lisp:1.3 --- cell-cultures/celtic/button.lisp:1.2 Sun Jun 27 16:54:28 2004 +++ cell-cultures/celtic/button.lisp Sun Jun 27 21:25:14 2004 @@ -30,7 +30,7 @@ -bitmap -borderwidth -cursor -disabledforeground -font -foreground -highlightbackground -highlightcolor -highlightthickness -image -justify -padx -pady -relief -repeatdelay - -repeatinterval -takefocus -text -textvariable (-uline -underline) -wraplength + -repeatinterval -takefocus -text -textvariable -underline -wraplength (-command nil) -compound -default -height -overrelief -state -width)) Index: cell-cultures/celtic/frame.lisp diff -u cell-cultures/celtic/frame.lisp:1.2 cell-cultures/celtic/frame.lisp:1.3 --- cell-cultures/celtic/frame.lisp:1.2 Sun Jun 27 16:54:28 2004 +++ cell-cultures/celtic/frame.lisp Sun Jun 27 21:25:14 2004 @@ -45,6 +45,19 @@ -takefocus -background (tk-class -class) -colormap -container -height -visual -width -text -labelanchor -labelwidget)) +(defmodel stack (frame) + () + (:default-initargs + :kid-slots (lambda (self) + (declare (ignore self)) + (list + (mk-kid-slot (layout :if-missing t) + (c? (format nil "pack~{ ~a~} -side {top} -anchor nw" + (path self)))))))) +(defun stack (&rest init-args) + (apply 'make-instance 'stack init-args)) + + (defun test-labelframe () (make-be 'labelframe :text "Considering" Index: cell-cultures/celtic/widget-item.lisp diff -u cell-cultures/celtic/widget-item.lisp:1.1 cell-cultures/celtic/widget-item.lisp:1.2 --- cell-cultures/celtic/widget-item.lisp:1.1 Sat Jun 26 11:38:38 2004 +++ cell-cultures/celtic/widget-item.lisp Sun Jun 27 21:25:14 2004 @@ -35,8 +35,7 @@ :initform (c? (format nil "~a.~a" (if (fm-parent self) (path .parent) "") (name self)))) - (layout :reader layout :initarg :layout - :initform (c? (format nil "pack ~a" (path self)))) + (layout :reader layout :initarg :layout :initform nil) (configurations :reader configurations :initarg :configurations :initform nil)) (:default-initargs :md-name (create-name))) @@ -98,7 +97,7 @@ )) (defmethod not-to-be :after ((self item)) - (trc "whacking item" self) + (trc nil "whacking item" self) (tk-send (format nil "~a delete ~a" (path (upper self widget)) (id-no self)))) (defmethod make-tk-instance :after ((self item))

1 0

[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/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/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
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