ltk-user

Download

ltk-user@common-lisp.net

December 2006

3 participants
2 discussions

[ltk-user] Convert path strings to CLOS widgets
by David Holz 26 Dec '06

26 Dec '06

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://da…

1 0

[ltk-user] UTF-8 text
by Zdenek Eichler 15 Dec '06

15 Dec '06

Hi, I have this problem: I want to use unicode characters (chess figures) in canvas. But it displays only some squares. But when i create button with same characters . it work! (make-instance 'canvas-text :canvas c :x 10 :y 10 :text "♖") this displays only garbage (make-instance 'button :master right-frame :text "♖" :command (lambda () (+ 1 2))) this display button with text ♖ I'm not sure this character will be displayed in email correctely... so my character is unicode WHITE CHESS PAWN... I use SBCL on MAC OS X 10.4 Any idea? Thanks Zed

2 2