added current-page-number-adjust

svn: r8347

collects/scribblings/slideshow/slides.scrbl

@@ -276,6 +276,15 @@ visible).}
 Parameter that determines the color used to draw the page number (if
 visible).}
 
+@defparam[current-page-number-adjust proc (-> number? string? string?)]{ 
+Parameter that controls the precise text
+that appears to indicate the page numbers (if visible). The
+input to the function is the default string and the slide
+number, and the result is what is drawn in the bottom right
+corner. The default parameter value just returns its first
+argument.
+} 
+
 @; ------------------------------------------------------------------------
 
 @section{Constants and Layout Variables}

collects/slideshow/base.ss

@@ -42,7 +42,7 @@
 	   set-use-background-frame!
 	   enable-click-advance!
 	   title-h set-title-h! current-slide-assembler
-	   current-page-number-font current-page-number-color 
+	   current-page-number-font current-page-number-color current-page-number-adjust
            current-titlet current-para-width
 	   set-page-numbers-visible! done-making-slides
            clickback make-slide-inset slide-inset? apply-slide-inset))

collects/slideshow/core.ss

@@ -173,6 +173,12 @@
 			  (unless (s . is-a? . color%)
 			    (raise-type-error 'current-page-number-color "color%" s))
 			  s)))
+      (define current-page-number-adjust (make-parameter 
+                                          (λ (n s) s)
+                                          (lambda (f)
+                                            (unless (procedure-arity-includes? f 2)
+                                              (raise-type-error 'current-page-number-adjust "procedure that accepts 2 arguments" f))
+                                            f)))
       
       (define page-number 1)
 

collects/slideshow/sig.ss

@@ -75,7 +75,7 @@
      set-use-background-frame!
      enable-click-advance!
      get-title-h set-title-h! current-slide-assembler
-     current-page-number-font current-page-number-color
+     current-page-number-font current-page-number-color current-page-number-adjust
      current-titlet current-para-width
      set-page-numbers-visible! done-making-slides
      clickback 

collects/slideshow/slide.ss

@@ -100,7 +100,7 @@
 	   set-use-background-frame!
 	   enable-click-advance!
 	   title-h get-title-h set-title-h! current-slide-assembler
-	   current-page-number-font current-page-number-color 
+	   current-page-number-font current-page-number-color current-page-number-adjust
            current-titlet current-para-width
 	   set-page-numbers-visible! done-making-slides
            slide/timeout

collects/slideshow/viewer.ss

@@ -566,11 +566,16 @@
       (define black-color (make-object color% "BLACK"))
 
       (define (slide-page-string slide)
-	(if (= 1 (sliderec-page-count slide))
-	    (format "~a" (sliderec-page slide))
-	    (format "~a-~a" (sliderec-page slide) (+ (sliderec-page slide)
-						     (sliderec-page-count slide)
-						     -1))))
+        (let ([s ((current-page-number-adjust)
+                  (sliderec-page slide)
+                  (if (= 1 (sliderec-page-count slide))
+                      (format "~a" (sliderec-page slide))
+                      (format "~a-~a" (sliderec-page slide) (+ (sliderec-page slide)
+                                                               (sliderec-page-count slide)
+                                                               -1))))])
+          (unless (string? s)
+            (error 'current-page-number-adjust "expected a procedure that returned a string, but it returned ~s" s))
+          s))
       
       (define (calc-progress)
 	(if (and start-time config:talk-duration-minutes)