Re: Patch to 3.0b1 Canvas.stk

From: Moises Lejter <mlm_at_cs.brown.edu>
Date: Thu, 7 Dec 1995 01:34:44 -0500 (EST)

The patch to Canvas.stk I sent out yesterday was incomplete. The
complete one is attached below.

In addition to fixing it so that canvases work, this patch adds one
extra feature: #'bind-for-dragging now takes an extra keyword argument
:auto-move with can be specified as either #t or #f. If #t
(default), then the builtin motion-draf function will move the canvas
item selected itself. If #f, it will just call the user-specified
routine, which must then take charge of moving the canvas item itself.

Moises

-----cut here-----

*** /tmp/T0a002w7 Thu Dec 7 01:31:05 1995
--- Canvas.stk Thu Dec 7 01:24:01 1995
***************
*** 260,273 ****
  ;; ;; Apply user :start hook
  ;; (apply (car stk::hooks) stk::instance-selected x y '())))
  
! (define (stk::start-drag key w x y tag)
! (let ((instance (Id->instance w))
! (tag (or tag (car (w 'find 'with 'current)))))
! (w 'dtag 'selected)
! (w 'addtag 'selected 'with tag)
      (set! stk::last-x x)
      (set! stk::last-y y)
! (set! stk::instance-selected (Cid->instance instance tag))
      (raise stk::instance-selected)
  
      ;; Set! stk::hooks to the hooks setted for this binding
--- 260,273 ----
  ;; ;; Apply user :start hook
  ;; (apply (car stk::hooks) stk::instance-selected x y '())))
  
! (define (stk::start-drag key instance x y tag)
! (let ((tag (or tag (car (find-items instance 'with 'current)))))
! (delete-tag instance 'selected)
! (add-tag instance 'selected 'with tag)
      (set! stk::last-x x)
      (set! stk::last-y y)
! (set! stk::instance-selected
! (if (is-a? tag <Tk-canvas-item>) tag (Cid->instance instance tag)))
      (raise stk::instance-selected)
  
      ;; Set! stk::hooks to the hooks setted for this binding
***************
*** 280,287 ****
  ;;;
  ;;;
  ;;;
! (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
--- 280,288 ----
  ;;;
  ;;;
  ;;;
! (define (stk::motion-drag instance x y auto-move?)
! (when auto-move?
! (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
***************
*** 290,297 ****
  ;;;
  ;;;
  ;;;
! (define (stk::stop-drag w x y)
! (w 'dtag 'selected)
    ;; Apply user :stop hook
    (apply (caddr stk::hooks) stk::instance-selected x y '()))
  
--- 291,298 ----
  ;;;
  ;;;
  ;;;
! (define (stk::stop-drag instance x y)
! (delete-tag instance 'selected)
    ;; Apply user :stop hook
    (apply (caddr stk::hooks) stk::instance-selected x y '()))
  
***************
*** 299,319 ****
  ;;;
  ;;;
  (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)))
           (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 `(stk::start-drag ,start ,w %x %y
! ',(if alone #f who)))
! (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)
--- 300,320 ----
  ;;;
  ;;;
  (define-method bind-for-dragging ((self <Canvas>) . args)
! (let* ((who (tag-value (get-keyword :tag args 'all)))
           (but (get-keyword :button args 1))
           (mod (get-keyword :modifier args ""))
           (alone (get-keyword :only-current args #t))
+ (auto? (get-keyword :auto-move 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)))
  
! (bind self who start
! (lambda (x y) (stk::start-drag start self x y (if alone #f who))))
! (bind self who motion
! (lambda (x y) (stk::motion-drag self x y auto?)))
! (bind self who stop (lambda (x y) (stk::stop-drag self x y)))
  
      ;; See if user want to set some movement hooks
      (hash-table-put! (slot-ref self 'bindings)
Received on Thu Dec 07 1995 - 07:36:39 CET