[ltk-user] Q about canvas item handles
Daniel Herring
dherring at tentpost.com
Tue Jul 14 05:22:25 UTC 2009
Why isn't HANDLE (for canvas items) exported from :ltk?
"Hand to forehead" when I figured out why the following didn't work.
(defpackage :p
(:use :cl :ltk))
(in-package :p)
(defun test ()
(let* (...
(c (... 'canvas ...))
(o (make-instance 'canvas-oval :canvas c :x0 ...)))
(itemconfigure c (slot-value o 'handle) ...)))
Alternatively, would it make sense to have
(defmethod itemconfigure ((canvas canvas) (canvas-item item) ...))
do the right thing? Possible patch attached.
Thanks,
Daniel
-------------- next part --------------
From 4d678a213b251e9f3905590fc525bb3bde118e37 Mon Sep 17 00:00:00 2001
From: D Herring <dherring at at.tentpost.dot.com>
Date: Tue, 14 Jul 2009 01:20:22 -0400
Subject: [PATCH] rework itemconfigure
- use another defmethod to replace stringp
- add methods to handle canvas-items
---
ltk.lisp | 25 ++++++++++++++++++++-----
1 files changed, 20 insertions(+), 5 deletions(-)
diff --git a/ltk.lisp b/ltk.lisp
index 3d0011d..cd02f72 100644
--- a/ltk.lisp
+++ b/ltk.lisp
@@ -3219,19 +3219,34 @@ set y [winfo y ~a]
(defgeneric itemconfigure (widget item option value))
-(defmethod itemconfigure ((widget canvas) item option value)
- (format-wish "~A itemconfigure ~A -~(~A~) {~A}" (widget-path widget) item option
- (if (stringp value) ;; There may be values that need to be passed as
- value ;; unmodified strings, so do not downcase strings
- (format nil "~(~a~)" value))) ;; if its not a string, print it downcased
+(defmethod itemconfigure ((widget canvas) item option (value string))
+ "Some values need to be passed as unmodified strings, so do not downcase."
+ (format-wish "~A itemconfigure ~A -~(~A~) {~A}" (widget-path widget) item option value)
widget)
+(defmethod itemconfigure ((widget canvas) item option value)
+ (format-wish "~A itemconfigure ~A -~(~A~) {~(~a~)}" (widget-path widget) item option value)
+ widget)
;;; for tkobjects, the name of the widget is taken
(defmethod itemconfigure ((widget canvas) item option (value tkobject))
(format-wish "~A itemconfigure ~A -~(~A~) {~A}" (widget-path widget) item option (widget-path value))
widget)
+(defmethod itemconfigure ((widget canvas) (item canvas-item) option (value string))
+ "Some values need to be passed as unmodified strings, so do not downcase."
+ (format-wish "~A itemconfigure ~A -~(~A~) {~A}" (widget-path widget) (handle item) option value)
+ widget)
+
+(defmethod itemconfigure ((widget canvas) (item canvas-item) option value)
+ (format-wish "~A itemconfigure ~A -~(~A~) {~(~a~)}" (widget-path widget) (handle item) option value)
+ widget)
+
+;;; for tkobjects, the name of the widget is taken
+(defmethod itemconfigure ((widget canvas) (item canvas-item) option (value tkobject))
+ (format-wish "~A itemconfigure ~A -~(~A~) {~A}" (widget-path widget) (handle item) option (widget-path value))
+ widget)
+
(defgeneric itemlower (w i &optional below))
(defmethod itemlower ((widget canvas) item &optional below)
(format-wish "~A lower ~A ~@[~A~]" (widget-path widget)
--
1.6.0.2
More information about the ltk-user
mailing list