[cells-cvs] CVS update: cell-cultures/celtic/callback.lisp cell-cultures/celtic/demos.lisp

[Kenny Tilton]

Update of /project/cells/cvsroot/cell-cultures/celtic
In directory common-lisp.net:/tmp/cvs-serv14617

Modified Files:
	callback.lisp demos.lisp 
Log Message:
Not sure what I did! There is still a problem with text edit items, tho.
Date: Wed Sep 29 05:09:59 2004
Author: ktilton

Index: cell-cultures/celtic/callback.lisp
diff -u cell-cultures/celtic/callback.lisp:1.3 cell-cultures/celtic/callback.lisp:1.4
--- cell-cultures/celtic/callback.lisp:1.3	Wed Jul 21 13:49:38 2004
+++ cell-cultures/celtic/callback.lisp	Wed Sep 29 05:09:59 2004
@@ -61,6 +61,53 @@
 (defun peek-char-no-hang (stream)
   (and (listen stream) (peek-char t stream)))
 
+;;;<<<<<<< callback.lisp
+;;;(defun peek-char-no-hang (stream)
+;;;  (and (listen stream) (peek-char nil stream)))
+;;;
+;;;(defun tk-eval-list (form$)
+;;;  ;
+;;;  ; clear stdin
+;;;  ;
+;;;  (trc "tk-eval-list > entry w eval form:" form$)
+;;;  (loop while (peek-char-no-hang *w*)
+;;;        do (if (eql #\( (peek-char t *w*))
+;;;               (let ((msg (read *w*)))
+;;;                 (trc "tk-eval-list > buffer not empty:" msg)
+;;;                 (when (eql 'callback (first msg))
+;;;                   (trc "tk-eval-list > tending to callback:" (rest msg))
+;;;                   (dispatch-callback (rest msg))))
+;;;             (c-break "tk-eval-list error 1: ~a" (read-line *w*))))
+;;;  ;
+;;;  (trc "tk-eval-list > buffer clear, now evaluating (in Tk):" form$)
+;;;  ;
+;;;  (tk-send
+;;;   (format nil "puts -nonewline {(};puts -nonewline [~a];puts {)};flush stdout" 
+;;;     form$))
+;;;  ;
+;;;  ; retrieve result
+;;;  ;
+;;;  (if (eql #\( (peek-char t *w* nil nil))
+;;;      (let ((*readtable* (copy-readtable)))
+;;;        (set-macro-character #\} (get-macro-character #\)))
+;;;        (set-macro-character #\{
+;;;          #'(lambda (s c1)
+;;;              (declare (ignore c1))
+;;;              (read-delimited-list #\} s t)))
+;;;        (return-from tk-eval-list (eko ("tk-eval-list > result:")
+;;;                                    (read *w*))))
+;;;    (if (peek-char t *w* nil nil)
+;;;      (c-break "tk-eval-list error 2: ~a" (read-line *w*))
+;;;      (trc "looks like wish exited"))))
+;;;
+;;;(def-c-output command ((self widget))
+;;;  (when (and new-value (^command-is-callback))
+;;;    (configure self "-command"
+;;;      (format nil
+;;;          "puts {(callback ~a)};flush stdout; list" ;; list cuz Tk feeds args to some 
+;;;                                             ; widgets' commands and list will consume syntax
+;;;        (register-callback self "command" new-value)))))
+
 (defun tk-eval-list (self form$)
   (let* ((id (copy-symbol 'eval-list))
          result


Index: cell-cultures/celtic/demos.lisp
diff -u cell-cultures/celtic/demos.lisp:1.4 cell-cultures/celtic/demos.lisp:1.5
--- cell-cultures/celtic/demos.lisp:1.4	Thu Sep  2 05:19:16 2004
+++ cell-cultures/celtic/demos.lisp	Wed Sep 29 05:09:59 2004
@@ -33,6 +33,27 @@
 (defmodel all (window)
   ()
   (:default-initargs
+;;;<<<<<<< demos.lisp
+;;;    :md-value (c? (let ((ff (tk-eval-list "font families")))
+;;;                    (assert (consp ff))
+;;;                    ff))
+;;;    :pady 2 :padx 4
+;;;    :layout (pack-layout? "-side left -fill both -expand 1 -anchor nw")
+;;;    :kids  (c? (list
+;;;                (mk-spinbox :md-name :font-face
+;;;                  :md-value (c-in (car (^md-value)))
+;;;                 :tk-values (c? (md-value .parent)))
+;;;                (mk-scale :md-name :font-size
+;;;                  :md-value (c-in 14)
+;;;                  :tk-label "Font Size"
+;;;                  :from 7 :to 24 
+;;;                  :orient 'horizontal)
+;;;                (mk-label :text "Four score and seven years ago today"
+;;;                  :wraplength 600
+;;;                  :font (c? (list ;; format nil "{{~{~a~^ ~}} ~a}" ;; eg, {{wp greek century} 24}
+;;;                              (md-value (fm^ :font-face))
+;;;                              (md-value (fm^ :font-size)))))))))
+
       :kids (c? (list
                  (demo-all-menubar)