I noticed there didn't seem to be any mapping from path strings to CLOS widgets in Lisp, useful for things like "winfo children ...". So here's some code that works, diffed from v0.90. I wrote it, and give permission to use in ltk however you want, whatever license, etc legal hoopdedoo.
$ diff -ur ltk.lisp ltk-0.90/ltk.lisp --- ltk.lisp 2006-07-15 07:45:14.000000000 -0700 +++ ltk-0.90/ltk.lisp 2006-12-26 11:55:43.492704000 -0700 @@ -462,6 +462,12 @@
(defvar *init-wish-hook* nil)
+(defvar *paths-to-widgets* (make-hash-table :test #'equal) + "Maps Tcl window path strings to their Lisp widget object.") + +(defun path-to-widget (path) + (gethash path *paths-to-widgets*)) + (defun dbg (fmt &rest args) (when *debug-tk* (apply #'format t fmt args) @@ -507,6 +513,10 @@ (defun start-wish (&rest keys &key handle-errors handle-warnings (debugger t) stream) (declare (ignore handle-errors handle-warnings debugger)) + + ;; Clear out the name mapping + (clrhash *paths-to-widgets*) + ;; open subprocess (if (null (wish-stream *wish*)) (progn @@ -1166,7 +1176,8 @@ (send-wish (format nil "bell")))
(defun destroy (widget) - (send-wish (format nil "destroy ~a" (widget-path widget)))) + (send-wish (format nil "destroy ~a" (widget-path widget))) + (remhash (widget-path widget) *paths-to-widgets*))
(defun clipboard-clear () (send-wish "clipboard clear")) @@ -1225,7 +1236,9 @@ (defmethod create ((widget widget)) (when (init-command widget) ;;(format t "creating: ~a~%" (init-command widget)) (finish-output) - (format-wish (init-command widget) (widget-path widget)))) + (format-wish (init-command widget) (widget-path widget)) + ;; Register this path + (setf (gethash (widget-path widget) *paths-to-widgets*) widget)))
(defgeneric (setf command) (value widget)) (defgeneric command (widget)) @@ -2561,6 +2574,12 @@ (format-wish "senddata [winfo rooty ~a];flush stdout" (widget-path tl)) (read-data))
+(defun children (w) + "give a list of the children of the widget" + (format-wish "senddatastrings [winfo children ~a];flush stdout" (widget-path w)) + ;; Convert paths into widget objects + (mapcar #'path-to-widget (read-data))) + ;;; misc functions
(defun focus (widget)
_________________________________________________________________ Dave vs. Carl: The Insignificant Championship Series. Who will win? http://clk.atdmt.com/MSN/go/msnnkwsp0070000001msn/direct/01/?href=http://dav...