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

[cells-cvs] CVS update: Test/TEST.BMP Test/TEST.GIF Test/TEST.JPG Test/cells.asd Test/cells.fasl Test/cells.lisp Test/cells.lpr
by Kenny Tilton 09 Jul '04

09 Jul '04

Update of /project/cells/cvsroot/Test In directory common-lisp.net:/tmp/cvs-serv5713 Removed Files: TEST.BMP TEST.GIF TEST.JPG cells.asd cells.fasl cells.lisp cells.lpr Log Message: Date: Thu Jul 8 20:50:42 2004 Author: ktilton

1 0

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

07 Jul '04

Update of /project/cells/cvsroot/cell-cultures/asdf-aclproj In directory common-lisp.net:/tmp/cvs-serv4580/asdf-aclproj Modified Files: asdf-aclproj.lisp Log Message: Something I did recently caused asdf-aclproj to load the source files, instead of the fasls it had just compiled. This isn't such a big deal on SBCL, which is a compile-only implementation, but it'd be pretty aweful on anything with and interpreter. This is a quick, ugly hack that fixes this for the time being, until I have a chance to do a real fix. Date: Tue Jul 6 21:17:14 2004 Author: tburdick Index: cell-cultures/asdf-aclproj/asdf-aclproj.lisp diff -u cell-cultures/asdf-aclproj/asdf-aclproj.lisp:1.4 cell-cultures/asdf-aclproj/asdf-aclproj.lisp:1.5 --- cell-cultures/asdf-aclproj/asdf-aclproj.lisp:1.4 Mon Jul 5 12:26:00 2004 +++ cell-cultures/asdf-aclproj/asdf-aclproj.lisp Tue Jul 6 21:17:14 2004 @@ -181,4 +181,10 @@ (defmethod asdf::component-self-dependencies ((o asdf:operation) (c lpr-component)) (let ((all-deps (asdf:component-depends-on o c))) (remove-if-not (lambda (x) (member c (cdr x))) - all-deps))) \ No newline at end of file + all-deps))) + +;; FIXME: asdf is compiling the source, then loading the source, not +;; FIXME: the fasl. This is gross, but it at least causes asdf to load +;; FIXME: the fasl, until I track down why it's getting the wrong pathname. +(defmethod asdf::input-files ((op asdf:load-op) (c module)) + (list (compile-file-pathname (asdf:component-pathname c))))

1 0

[cells-cvs] CVS update: cell-cultures/cellodemo/install-notes.txt
by Kenny Tilton 07 Jul '04

07 Jul '04

Update of /project/cells/cvsroot/cell-cultures/cellodemo In directory common-lisp.net:/tmp/cvs-serv10144/cellodemo Added Files: install-notes.txt Log Message: Date: Tue Jul 6 18:37:12 2004 Author: ktilton

1 0

[cells-cvs] CVS update: cell-cultures/utils-kt/defpackage.lisp
by Kenny Tilton 07 Jul '04

07 Jul '04

Update of /project/cells/cvsroot/cell-cultures/utils-kt In directory common-lisp.net:/tmp/cvs-serv4446/utils-kt Modified Files: defpackage.lisp Log Message: Date: Tue Jul 6 18:25:41 2004 Author: ktilton Index: cell-cultures/utils-kt/defpackage.lisp diff -u cell-cultures/utils-kt/defpackage.lisp:1.4 cell-cultures/utils-kt/defpackage.lisp:1.5 --- cell-cultures/utils-kt/defpackage.lisp:1.4 Sun Jul 4 11:59:46 2004 +++ cell-cultures/utils-kt/defpackage.lisp Tue Jul 6 18:25:41 2004 @@ -28,8 +28,9 @@ #-(or cormanlisp cmu sbcl) #:clos #+sbcl #:sb-mop #+mcl #:ccl) - (:export - #:eko #:count-it #:count-of #:trc #:maptimes #:bwhen #:bif #:xor + (:export #:utils-kt-reset + #:eko #:count-it #:count-of #:trc #:trcp + #:wdbg #:maptimes #:bwhen #:bif #:xor "WITH-DYNAMIC-FN" #:last1 #:packed-flat! #:with-metrics "TRUE" "SHORTC" #:intern$ #:defconstant-once "*COUNT*" "*STOP*" "*DBG*" "*TRCDEPTH*"

1 0

[cells-cvs] CVS update: cell-cultures/cells/cells.lisp cell-cultures/cells/family.lisp cell-cultures/cells/integrity.lisp cell-cultures/cells/md-slot-value.lisp cell-cultures/cells/md-utilities.lisp cell-cultures/cells/propagate.lisp
by Kenny Tilton 07 Jul '04

07 Jul '04

Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv4446/cells Modified Files: cells.lisp family.lisp integrity.lisp md-slot-value.lisp md-utilities.lisp propagate.lisp Log Message: Date: Tue Jul 6 18:25:40 2004 Author: ktilton Index: cell-cultures/cells/cells.lisp diff -u cell-cultures/cells/cells.lisp:1.3 cell-cultures/cells/cells.lisp:1.4 --- cell-cultures/cells/cells.lisp:1.3 Sun Jul 4 11:59:41 2004 +++ cell-cultures/cells/cells.lisp Tue Jul 6 18:25:40 2004 @@ -38,15 +38,13 @@ (defparameter *c-debug* nil) (defun cell-reset () - (setf *count* nil - *stop* nil - *dbg* nil - *trcdepth* 0 - *c-prop-depth* 0 - *data-pulse-id* 0 - *data-pulses* nil - *unfinished-business* nil - ) + (utils-kt-reset) + (setf + *c-debug* nil + *c-prop-depth* 0 + *data-pulse-id* 0 + *data-pulses* nil + *unfinished-business* nil) (trc nil "------ cell reset ----------------------------")) (defun c-stop (&optional why) Index: cell-cultures/cells/family.lisp diff -u cell-cultures/cells/family.lisp:1.1 cell-cultures/cells/family.lisp:1.2 --- cell-cultures/cells/family.lisp:1.1 Sat Jun 26 11:38:36 2004 +++ cell-cultures/cells/family.lisp Tue Jul 6 18:25:40 2004 @@ -182,6 +182,7 @@ (when (find-if 'zerop new-kids :key 'adopt-ct) (dolist (k new-kids) + (trc nil "kids change sees new kid" self k) (unless (member k old-kids) (if (eql :nascent (md-state k)) (progn Index: cell-cultures/cells/integrity.lisp diff -u cell-cultures/cells/integrity.lisp:1.2 cell-cultures/cells/integrity.lisp:1.3 --- cell-cultures/cells/integrity.lisp:1.2 Sun Jul 4 11:59:41 2004 +++ cell-cultures/cells/integrity.lisp Tue Jul 6 18:25:40 2004 @@ -102,20 +102,25 @@ (count-it :ufb-wasted)) (finish-business))))) + + (defun finish-business (&aux task some-output setfs (setf-ct 0)) (declare (ignorable setfs)) (tagbody - start ;--------------------------------- - (setf task (cdr (fifo-pop (ufb-queue :user-notify)))) - - (when task - (trc nil "finish-business notifying--------------------------") - (funcall task) - (go start)) + notify-users + ;--- notify users ------------------------------ + (let ((user-q-item (fifo-pop (ufb-queue :user-notify)))) + (when user-q-item + (destructuring-bind (defer-info . task) user-q-item + (declare (ignorable defer-info)) + (trc nil "finbiz notifying users of cell" (car defer-info)) + (funcall task) + (go notify-users)))) (setf some-output nil) - next-output ;-------------------------- + next-output + ;--- do c-output-slot-name ----------------------- (setf task (cdr (fifo-pop (ufb-queue :output)))) (cond @@ -125,8 +130,9 @@ (funcall task) (go next-output)) (some-output - (go start))) + (go notify-users))) + ; --- do deferred setfs ------------------------ (setf task (fifo-pop (ufb-queue :setf))) (when task (incf setf-ct) @@ -139,4 +145,4 @@ (push c setfs) (data-pulse-next (list :finbiz c new-value)) (funcall task-fn)))) - (go start)))) + (go notify-users)))) Index: cell-cultures/cells/md-slot-value.lisp diff -u cell-cultures/cells/md-slot-value.lisp:1.2 cell-cultures/cells/md-slot-value.lisp:1.3 --- cell-cultures/cells/md-slot-value.lisp:1.2 Sun Jul 4 11:59:41 2004 +++ cell-cultures/cells/md-slot-value.lisp Tue Jul 6 18:25:40 2004 @@ -38,6 +38,7 @@ (defun c-value-ensure-current (c) (count-it :c-value-ensure-current) + (trc nil "c-value-ensure-current>" c) (cond ((c-inputp c)) ((c-currentp c)) @@ -46,6 +47,7 @@ (c-calculate-and-set c)) (t (c-pulse-update c :valid-uninfluenced))) + ;;(unless (cmdead c) (when (c-unboundp c) (error 'unbound-cell :instance (c-model c) :name (c-slot-name c))) @@ -64,34 +66,37 @@ (c-useds c)))) (defun c-calculate-and-set (c) - (when (c-stopped) - (princ #\.) - (return-from c-calculate-and-set)) - - (when (find c *c-calculators*) ;; circularity - (trc "c-calculate-and-set breaking on circularity" c) - (c-break ;; break is problem when testing cells on some CLs - "cell ~a midst askers: ~a" c *c-calculators*)) - - (count-it :c-calculate-and-set) - ;;; (count-it :c-calculate-and-set (type-of (c-model c))) ;; (c-slot-name c)) - - (cd-usage-clear-all c) - - (let ((raw-value - (progn - (let ((*c-calculators* (cons c *c-calculators*))) - (trc nil "c-calculate-and-set> just added to *c-calculators*:" - *c-calculators*) - (c-assert (c-model c)) - (funcall (cr-rule c) c))))) + (flet ((body () + (when (c-stopped) + (princ #\.) + (return-from c-calculate-and-set)) - (when (and *c-debug* (typep raw-value 'cell)) - (c-break "new value for cell ~s is itself a cell: ~s. probably nested (c? ... (c? ))" - c raw-value)) + (when (find c *c-calculators*) ;; circularity + (trc "c-calculate-and-set breaking on circularity" c) + (c-break ;; break is problem when testing cells on some CLs + "cell ~a midst askers: ~a" c *c-calculators*)) - (c-unlink-unused c) - (md-slot-value-assume c raw-value))) + (count-it :c-calculate-and-set) + ;;; (count-it :c-calculate-and-set (type-of (c-model c))) ;; (c-slot-name c)) + + (cd-usage-clear-all c) + + (let ((raw-value + (progn + (let ((*c-calculators* (cons c *c-calculators*))) + (trc nil "c-calculate-and-set> just added to *c-calculators*:" + *c-calculators*) + (c-assert (c-model c)) + (funcall (cr-rule c) c))))) + (progn ;; unless (cmdead c) ;; eg, rule includes (nsib), then parent decides (c-model c) is no more + (when (and *c-debug* (typep raw-value 'cell)) + (c-break "new value for cell ~s is itself a cell: ~s. probably nested (c? ... (c? ))" + c raw-value)) + + (c-unlink-unused c) + (md-slot-value-assume c raw-value))))) + (if nil ;; *dbg* + (ukt::wtrc (0 100 "calcnset" c) (body))(body)))) ;------------------------------------------------------------- Index: cell-cultures/cells/md-utilities.lisp diff -u cell-cultures/cells/md-utilities.lisp:1.1 cell-cultures/cells/md-utilities.lisp:1.2 --- cell-cultures/cells/md-utilities.lisp:1.1 Sat Jun 26 11:38:36 2004 +++ cell-cultures/cells/md-utilities.lisp Tue Jul 6 18:25:40 2004 @@ -63,8 +63,9 @@ (trc nil "not-to-be cleared 2 fm-parent, eternal-rest" self)) (defmethod not-to-be ((self model-object)) - (trc nil "not to be!!!" self) - (unless (md-untouchable self) + (trc self "not to be!!!" self) + (if (md-untouchable self) + (trc "not-to-be not quiescing untouchable" self) (md-quiesce self))) (defmethod md-untouchable (self) ;; would be t for closed-stream under acl @@ -72,7 +73,7 @@ nil) (defun md-quiesce (self) - (trc nil "md-quiesce doing" self) + (trc nil "md-quiesce doing" self (type-of self)) (md-map-cells self nil (lambda (c) (trc nil "quiescing" c) (c-assert (not (find c *c-calculators*))) Index: cell-cultures/cells/propagate.lisp diff -u cell-cultures/cells/propagate.lisp:1.2 cell-cultures/cells/propagate.lisp:1.3 --- cell-cultures/cells/propagate.lisp:1.2 Sun Jul 4 11:59:41 2004 +++ cell-cultures/cells/propagate.lisp Tue Jul 6 18:25:40 2004 @@ -63,9 +63,14 @@ (let ((*causation* causation)) (trc nil "c-propagate-to-users > notifying users of" c) (dolist (user (c-users c)) - (trc user "c-propagate-to-users> *data-pulse-id*, user, c:" *data-pulse-id* user c) - (when (c-user-cares user) - (c-value-ensure-current user))))))) + (bwhen (dead (catch :mdead + (trc nil "c-propagate-to-users> *data-pulse-id*, user, c:" *data-pulse-id* user c) + (when (c-user-cares user) + (c-value-ensure-current user)))) + (when (eq dead (c-model c)) + (trc nil "!!! aborting further user prop of dead" dead) + (return-from c-propagate-to-users)) + (trc nil "!!! continuing user prop following: user => dead" user dead))))))) (defun c-user-cares (c) (not (or (c-currentp c) @@ -139,13 +144,13 @@ (not (c-optimized-away-p c)) ;; the other way above condition can be met (mdead (c-model c)))) -(defmethod cmdead :around (c) +(defmethod cmdead :around (c ) (when (call-next-method) (break "still reaching dead cells ~a" c))) (defun mdead (m) (when (eq :eternal-rest (md-state m)) - (break "still reaching dead instances ~a" m))) + (throw :mdead m))) (defmacro def-c-output (slotname (&optional (self-arg 'self) (new-varg 'new-value)

1 0

[cells-cvs] CVS update: cell-cultures/celtic/menu.lisp cell-cultures/celtic/scrolling.lisp cell-cultures/celtic/widget-item.lisp
by Kenny Tilton 07 Jul '04

07 Jul '04

Update of /project/cells/cvsroot/cell-cultures/celtic In directory common-lisp.net:/tmp/cvs-serv4446/celtic Modified Files: menu.lisp scrolling.lisp widget-item.lisp Log Message: Date: Tue Jul 6 18:25:41 2004 Author: ktilton Index: cell-cultures/celtic/menu.lisp diff -u cell-cultures/celtic/menu.lisp:1.1 cell-cultures/celtic/menu.lisp:1.2 --- cell-cultures/celtic/menu.lisp:1.1 Sun Jul 4 11:59:43 2004 +++ cell-cultures/celtic/menu.lisp Tue Jul 6 18:25:41 2004 @@ -79,6 +79,13 @@ (path l))) (read *w*)) +(defmethod tk-eval (form$) + (tk-send + (format nil "puts -nonewline {(};puts -nonewline [~a];puts {)};flush stdout" + form$)) + (loop for value = (read *w* nil :eof) + While (not (eq value :eof)) + collecting value)) Index: cell-cultures/celtic/scrolling.lisp diff -u cell-cultures/celtic/scrolling.lisp:1.1 cell-cultures/celtic/scrolling.lisp:1.2 --- cell-cultures/celtic/scrolling.lisp:1.1 Sun Jul 4 11:59:43 2004 +++ cell-cultures/celtic/scrolling.lisp Tue Jul 6 18:25:41 2004 @@ -30,23 +30,25 @@ -activerelief -command -elementborderwidth -width)) (defmodel scrolled-list (frame-row) - ((list-items :initarg :list-items :accessor list-items :initform nil) + ((list-item-keys :initarg :list-item-keys :accessor list-item-keys :initform nil) + (list-item-factory :initarg :list-item-factory :accessor list-item-factory :initform nil) (list-height :initarg :list-height :accessor list-height :initform nil)) (:default-initargs - :list-height (c? (max 1 (length (^list-items)))) - :kids (c? (list + :list-height (c? (max 1 (length (^list-item-keys)))) + :kids (c? (the-kids (listbox :md-name :list - :kids (c? (list-items .parent)) + :kids (c? (mapcar (list-item-factory .parent) + (list-item-keys .parent))) :font "courier 9" :state (c? (if (enabled .parent) 'normal 'disabled)) :height (c? (list-height .parent)) :layout (c? (format nil "pack ~a -side left -fill both -expand 1" (^path))) - :yscrollcommand (c? (format nil "~a set" (path (nsib))))) + :yscrollcommand (c? (when (enabled .parent) + (format nil "~a set" (path (nsib)))))) (scrollbar :md-name :vscroll - :layout (c? (format nil "pack ~a -side right -fill y" (^path))) - :state (c? (if (enabled .parent) 'normal 'disabled)) - :command (c? (format nil "~a yview" (path (psib)))) - :command-is-callback nil))))) + :layout (c? (format nil "pack ~a -side right -fill y" (^path))) + :command (c? (format nil "~a yview" (path (psib)))) + :command-is-callback nil))))) (defun scrolled-list (&rest inits) (apply 'make-instance 'scrolled-list inits)) Index: cell-cultures/celtic/widget-item.lisp diff -u cell-cultures/celtic/widget-item.lisp:1.4 cell-cultures/celtic/widget-item.lisp:1.5 --- cell-cultures/celtic/widget-item.lisp:1.4 Mon Jul 5 12:29:53 2004 +++ cell-cultures/celtic/widget-item.lisp Tue Jul 6 18:25:41 2004 @@ -47,8 +47,9 @@ :md-name (create-name))) (defmethod not-to-be :after ((self widget)) - (trc "whacking true widget" self) - (tk-send (format nil "pack forget ~a" (^path)))) + (trc "not-to-be tk-forgetting true widget" self) + (tk-send (format nil "pack forget ~a" (^path))) + (tk-send (format nil "destroy ~a" (^path)))) (def-c-output command ((self widget)) (when (^command-is-callback) @@ -105,6 +106,7 @@ (apply 'make-instance ',class inits)) ,(when std-factory `(defmethod make-tk-instance ((self ,class)) + (trc nil "!!! tk-creating" self) (tk-send (format nil ,(concatenate 'string (down$ class) " ~A") (path self))))) ,@outputs))))

1 0

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

07 Jul '04

Update of /project/cells/cvsroot/cell-cultures/clyde/visual-apropos In directory common-lisp.net:/tmp/cvs-serv4446/clyde/visual-apropos Modified Files: visual-apropos.lisp Log Message: Date: Tue Jul 6 18:25:41 2004 Author: ktilton Index: cell-cultures/clyde/visual-apropos/visual-apropos.lisp diff -u cell-cultures/clyde/visual-apropos/visual-apropos.lisp:1.2 cell-cultures/clyde/visual-apropos/visual-apropos.lisp:1.3 --- cell-cultures/clyde/visual-apropos/visual-apropos.lisp:1.2 Sun Jul 4 11:59:45 2004 +++ cell-cultures/clyde/visual-apropos/visual-apropos.lisp Tue Jul 6 18:25:41 2004 @@ -19,15 +19,9 @@ |# -#| do list - -at least show search in entry - -|# - (in-package :celtic) -;; +;; ------------------- ;; to run, enter following in repl: ;; ;; (tk-test 'vis-apropos) @@ -35,13 +29,13 @@ (defun vis-apropos () (make-be 'visual-apropos - :sub-symbol 'padding)) + :sub-symbol (c-in 'padding))) (defmodel visual-apropos (frame-stack) ((symbols :initarg :symbols :initform nil :accessor symbols) (sub-symbol :initarg :sub-symbol :initform nil :accessor sub-symbol)) (:default-initargs - :symbols (c? (apropos-list (^sub-symbol))) + :symbols (c-in nil) :pady 2 :padx 4 :layout (pack-layout? "-side left -fill both -expand 1 -anchor nw") @@ -61,9 +55,6 @@ (setf (^md-value) (not (^md-value))))) (show-which-symbols)))) (package-filtering)))) - (label :text (c? (format nil "Symbols containing ~a" - (sub-symbol .parent))) - :underline 4) (symbol-list))))) (defun search-for-symbol () @@ -84,8 +75,8 @@ (button :text "Search" :underline 0 :command (lambda (self) - (setf (md-value (upper self visual-apropos)) - (md-value (fm^ :search-string))))))))) + (setf (symbols (upper self visual-apropos)) + (apropos-list (text (fm^ :search-string)))))))))) ; --- symbol package filtering ------------------------------- @@ -104,11 +95,13 @@ :md-name :in-package :list-height 4 :layout (pack-layout? "-side left -fill x -expand 1") - :enabled (c? (not (md-value (psib)))) - :list-items (c? (loop for p in (list-all-packages) - collecting (make-instance 'listbox-item - :md-value p - :item-text (down$ (package-name p)))))))))) + :enabled (c? (when (not (md-value (psib))) + (setf *dbg* t))) + :list-item-keys (list-all-packages) + :list-item-factory (lambda (pkg) + (make-instance 'listbox-item + :md-value pkg + :item-text (down$ (package-name pkg))))))))) ; --- symbol binding filtering --------------------------------------- @@ -124,13 +117,13 @@ (^kids)))) :selection (c-in :any) :kids (c? (flet ((rb (n) - (radiobutton :md-name n - :text (string-capitalize (string n)) - :tk-variable (tk-variable self) - :value n - :layout nil - :underline 0))) - (list (rb :any)(rb :functions)(rb :variables)(rb :classes)))))) + (radiobutton :md-name n + :text (string-capitalize (string n)) + :tk-variable (tk-variable self) + :value n + :layout nil + :underline 0))) + (list (rb :any)(rb :functions)(rb :variables)(rb :classes)))))) (defun symbol-list () (frame-stack :md-name :symbol-list @@ -183,21 +176,37 @@ (if (constantp s) "con" "var")) (find-class s nil) (exported-p s))))) - :list-items (c? (let ((sorter (let ((ss (fm^ :sym-sort))) - (or (md-value (fm^ :sym-sort)) - (kid1 ss))))) - (sort (loop for si in (^md-value) - collect (make-instance 'va-symbol-info - :md-value si)) - (sort-button-predicate sorter) - :key (sort-button-key sorter))))))))) + :list-item-keys (c? (let ((sorter (let ((ss (fm^ :sym-sort))) + (or (md-value (fm^ :sym-sort)) + (kid1 ss))))) + (sort (copy-list (^md-value)) + (sort-button-predicate sorter) + :key (sort-button-key sorter)))) + :list-item-factory (lambda (symbol-info) + (make-instance 'va-symbol-info + :md-value symbol-info))))))) (defmodel sort-button (button) ((sort-button-predicate :initarg :sort-button-predicate :accessor sort-button-predicate - :initform #'string<) + :initform #'va-string<) (sort-button-key :initarg :sort-button-key :accessor sort-button-key :initform #'identity))) +(defun va-string< (v1 v2) + (flet ((blank (v) (or (null v)(equal v "")))) + (unless (equal v1 v2) + (unless (blank v1) ;; arrange for blanks to appear last + (or (blank v2) + (string< v1 v2)))))) + +(defun va-string> (v1 v2) + (flet ((blank (v) (or (null v)(equal v "")))) + (unless (equal v1 v2) + (if (blank v1) ;; arrange for blanks to appear last + (not (blank v2)) + (and (not (blank v2)) + (string> v1 v2)))))) + (defmodel va-sorter (sort-button) ((sort-string-fn :initform 'string :initarg :sort-string-fn :accessor sort-string-fn)) (:default-initargs @@ -205,13 +214,13 @@ (let* ((ss (fm^ :sym-sort))) (if (eq self (or (md-value ss) (kid1 ss))) (setf (sort-button-predicate self) - (if (eq (sort-button-predicate self) 'string<) - 'string> 'string<)) + (if (eq (sort-button-predicate self) 'va-string<) + 'va-string> 'va-string<)) (setf (md-value ss) self)))) - :sort-button-predicate (c-in 'string<) + :sort-button-predicate (c-in 'va-string<) :sort-button-key (c? (lambda (si) (funcall (^sort-string-fn) - (elt (md-value si) (kid-no self))))))) + (elt si (kid-no self))))))) (defmodel va-symbol-info (listbox-item) () @@ -249,7 +258,7 @@ (unless (or (md-value (fm^ :all-pkgs)) (bIf (sel (selection (fm^ :in-package))) (eq (symbol-package symbol) - (md-value (elt (list-items (fm^ :in-package)) sel))) + (elt (list-item-keys (fm^ :in-package)) sel)) t)) (return-from va-show-symbol-p nil))

1 0

[cells-cvs] CVS update: cell-cultures/celtic/celtic.asd
by Thomas F. Burdick 05 Jul '04

05 Jul '04

Update of /project/cells/cvsroot/cell-cultures/celtic In directory common-lisp.net:/tmp/cvs-serv2175/celtic Added Files: celtic.asd Log Message: Changes for SBCL Date: Mon Jul 5 12:31:42 2004 Author: tburdick

1 0

[cells-cvs] CVS update: cell-cultures/clyde/clyde.asd
by Thomas F. Burdick 05 Jul '04

05 Jul '04

Update of /project/cells/cvsroot/cell-cultures/clyde In directory common-lisp.net:/tmp/cvs-serv1859/clyde Added Files: clyde.asd Log Message: Changes for SBCL Date: Mon Jul 5 12:31:22 2004 Author: tburdick

1 0

[cells-cvs] CVS update: cell-cultures/celtic/widget-item.lisp
by Thomas F. Burdick 05 Jul '04

05 Jul '04

Update of /project/cells/cvsroot/cell-cultures/celtic In directory common-lisp.net:/tmp/cvs-serv20704/celtic Modified Files: widget-item.lisp Log Message: Changes for SBCL Date: Mon Jul 5 12:29:53 2004 Author: tburdick Index: cell-cultures/celtic/widget-item.lisp diff -u cell-cultures/celtic/widget-item.lisp:1.3 cell-cultures/celtic/widget-item.lisp:1.4 --- cell-cultures/celtic/widget-item.lisp:1.3 Sun Jul 4 11:59:43 2004 +++ cell-cultures/celtic/widget-item.lisp Mon Jul 5 12:29:53 2004 @@ -83,8 +83,9 @@ (loop for tk-option-def in tk-options for slot-name = (de- (if (atom tk-option-def) tk-option-def (car tk-option-def))) - collecting `(,slot-name :initform nil :initarg ,(intern slot-name :keyword) - :accessor ,slot-name) + collecting `(,slot-name :initform nil + :initarg ,(intern (string slot-name) :keyword) + :accessor ,slot-name) into slot-defs when (or (atom tk-option-def) (cadr tk-option-def)) @@ -142,8 +143,9 @@ tk-option-def (cadr tk-option-def)) for slot-name = (de- (if (atom tk-option-def) tk-option-def (car tk-option-def))) - collecting `(,slot-name :initform nil :initarg ,(intern slot-name :keyword) - :accessor ,slot-name) + collecting `(,slot-name :initform nil + :initarg ,(intern (string slot-name) :keyword) + :accessor ,slot-name) into slot-defs collecting `(def-c-output ,slot-name ((self ,class)) (when (and (id-no self) new-value)

1 0