library change in 2.1.6->2.1.7

From: Joshua Peck Macdonald <jmacd_at_uclink.berkeley.edu>
Date: Wed, 21 Jun 1995 17:34:34 -0700

I'm curious why this changed, I think it is incorrect, and would
like to suggest changes to Canvas.stk which make using Tk composite
widgets feasible.

in 2.1.6 the stk::motion-drag looked like this:

(define (stk::motion-drag w x y)
  (w 'move 'selected (- x stk::last-x) (- y stk::last-y))
  (set! stk::last-x x)
  (set! stk::last-y y)
  ;; Apply user :motion hook
  (apply (cadr stk::hooks) stk::instance-selected x y '()))

and in 2.1.7 the second line changed:

(define (stk::motion-drag w x y)
  (move stk::instance-selected (- x stk::last-x) (- y stk::last-y))
  (set! stk::last-x x)
  (set! stk::last-y y)
  ;; Apply user :motion hook
  (apply (cadr stk::hooks) stk::instance-selected x y '()))

This broke a lot of code of mine, since bind-for-dragging allows you
to give it a canvas tag for moving, which sets the canvas tag 'selected.
In 2.1.6 it worked, now it doesn't. Something which I also would like
to suggest is this (along with changing back the above difference to
2.1.6)

Something I have found extremely useful in STk are the composite widget
canvas items. There are very few examples of how to use these, but
when I began a project for a professor of mine I decided to try them.
One shortcoming I found was in the movement of composite widgets, because
the current method of notifying user-hooks is useless for composite
widgets. The reason is that the selected items are put into a list
and the car of that list is used as the widget with which to notify
the user-hooks, so if I make a composite widget out of two rectangles and
a circle and would like to make a motion-hook, the motion hook will
get called with either of the rectangles or the circle, depending only
on which has the lowest Tk CID. This is useless information though, so
I propose the following changes (perhaps there is a better way to do
this, but this is the functionality I'm looking for.)

bind-for-dragging gets a new optional keyword :use-instance which will
force the user-hooks to notify the argument to :use-instance when
user-hooks are called.

Minor changes are all that are neccesary to bind-for-dragging and
stk::start-drag (and the 2.1.6-style movement command in stk::motion-drag)

(define-method bind-for-dragging ((self <Canvas>) . args)
  (let* ((Id (slot-ref self 'Id))
         (w (widget-name Id))
         (who (tag-value (get-keyword :tag args 'all)))
         ;; this looks for keyword :use-instance and will set 'ui to
         ;; be #f or the address of the object to use.
         (ui (let ((it (get-keyword :use-instance args #f)))
                   (if it (address-of it) #f)))
         (but (get-keyword :button args 1))
         (mod (get-keyword :modifier args ""))
         (alone (get-keyword :only-current args #t))
         (str (if (equal? mod "") "" (string-append mod "-")))
         (start (format #f "<~AButtonPress-~A>" str but))
         (motion (format #f "<~AB~A-Motion>" str but))
         (stop (format #f "<~AButtonRelease-~A>" str but)))

    (Id 'bind who start
        ;; here add a fifth argument to stk::start-drag, ui
        `(stk::start-drag ,start ,w %x %y ',(if alone #f who) ,ui))
    (Id 'bind who motion `(stk::motion-drag ,w %x %y))
    (Id 'bind who stop `(stk::stop-drag ,w %x %y))

    ;; See if user want to set some movement hooks
    (hash-table-put! (slot-ref self 'bindings)
                     (string->symbol start)
                     (list (get-keyword :start args list)
                           (get-keyword :motion args list)
                           (get-keyword :stop args list)))))

now change stk::start-drag so that it sets set::instance-selected
to the value of ui if ui is non-false

(define (stk::start-drag key w x y tag use-instance)
  (let ((instance (Id->instance w)))
    (w 'dtag 'selected)
    (w 'addtag 'selected 'with (or tag 'current))
    (w 'raise (or tag 'current))
    (set! stk::last-x x)
    (set! stk::last-y y)
    (set! stk::instance-selected
          ;; if use-instance is non-false, set it to use-instance, otherwise
          ;; use the old-method, taking the first of Tk's selected CIDs
          (if use-instance
              use-instance
              (Cid->instance instance
                             (car (w 'find 'withtag 'selected)))))

    ;; Set! stk::hooks to the hooks setted for this binding
    (set! stk::hooks (hash-table-get (slot-ref instance 'bindings)
                                     (string->symbol key)))

    ;; Apply user :start hook
    (apply (car stk::hooks) stk::instance-selected x y '())))

that's all that's neccessary to make this work, this allows you
to use tk-composite-widgets for movement hooks.

What do you think of these changes?

-josh
Received on Thu Jun 22 1995 - 02:36:02 CEST