From 4d678a213b251e9f3905590fc525bb3bde118e37 Mon Sep 17 00:00:00 2001 From: D Herring 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