allow pin-over to accept pict-finding paths, etc.

svn: r7430

collects/slideshow/viewer.ss

@@ -319,7 +319,7 @@
 		    [y (send background-f get-y)])
 		(send background-f move (+ x dx) (+ y dy)))))
 	  
-	  (define/private (prev)
+	  (define/public (prev)
 	    (stop-transition)
 	    (set! current-page 
                   (let loop ([pos (max (sub1 current-page) 0)])
@@ -504,9 +504,11 @@
       (send (new (class editor-canvas% 
 		   (define/override (on-event e)
 		     (super on-event e)
-		     (when (and click-to-advance?
-				(send e button-up?))
-		       (send f next)))
+		     (when click-to-advance?
+                       (when (send e button-up? 'left)
+                         (send f next))
+                       (when (send e button-up? 'right)
+                         (send f prev))))
 		   (super-new))
 		 [parent c-frame] 
 		 [editor commentary] 
@@ -638,9 +640,12 @@
 		(set! clicking #f)
 		(when hit?
 		  ((click-region-thunk c))))]
-	     [(send e button-up?)
+	     [(send e button-up? 'left)
 	      (when click-to-advance?
 		(send (get-top-level-window) next))]
+	     [(send e button-up? 'right)
+	      (when click-to-advance?
+		(send (get-top-level-window) prev))]
 	     [else 
 	      (when (and clicking clicking-hit?)
 		(invert-clicking! #f))

collects/texpict/private/common-unit.ss

@@ -811,7 +811,9 @@
 		      (cond
 		       [(and (number? dx) (number? dy))
 			(values dx (- (pict-height base) dy))]
-		       [(and (pict? dx) (procedure? dy)
+		       [(and (or (pict? dx) 
+                                 (and (list? dx) (andmap pict? dx)))
+                             (procedure? dy)
 			     (procedure-arity-includes? dy 2))
 			(if flip?
 			    (let-values ([(dx dy) (dy base dx)])

collects/texpict/utils.ss

@@ -931,15 +931,20 @@
   (define cellophane
     (case-lambda
      [(p alpha-factor)
+      (cond
+       [(= 1.0 alpha-factor)
+        (inset p 0)]
+       [(zero? alpha-factor)
+        (ghost p)]
+       [else
         (let ([drawer (make-pict-drawer p)])
           (let ([new
                  (dc
                   (lambda (dc x y)
-                  (unless (zero? alpha-factor)
                     (let ([a (send dc get-alpha)])
                       (send dc set-alpha (* a alpha-factor))
                       (drawer dc x y)
-                      (send dc set-alpha a))))
+                      (send dc set-alpha a)))
                   (pict-width p)
                   (pict-height p)
                   (pict-ascent p)
@@ -950,7 +955,7 @@
                        (pict-ascent new)
                        (pict-descent new)
                        (list (make-child p 0 0 1 1))
-		     #f)))]))
+                       #f)))])]))
 
   (define inset/clip
     (case-lambda