From f210fc2ea40ab45a7a2658e2de9f8bed6d046d85 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 16 Jan 2008 05:04:18 +0000 Subject: [PATCH] added current-page-number-adjust svn: r8347 --- collects/scribblings/slideshow/slides.scrbl | 9 +++++++++ collects/slideshow/base.ss | 2 +- collects/slideshow/core.ss | 6 ++++++ collects/slideshow/sig.ss | 2 +- collects/slideshow/slide.ss | 2 +- collects/slideshow/viewer.ss | 15 ++++++++++----- 6 files changed, 28 insertions(+), 8 deletions(-) diff --git a/collects/scribblings/slideshow/slides.scrbl b/collects/scribblings/slideshow/slides.scrbl index 0f0e9726d3..4a47b95561 100644 --- a/collects/scribblings/slideshow/slides.scrbl +++ b/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} diff --git a/collects/slideshow/base.ss b/collects/slideshow/base.ss index df80483aa0..44014f0e13 100644 --- a/collects/slideshow/base.ss +++ b/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)) diff --git a/collects/slideshow/core.ss b/collects/slideshow/core.ss index c76667ec71..618b6db80f 100644 --- a/collects/slideshow/core.ss +++ b/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) diff --git a/collects/slideshow/sig.ss b/collects/slideshow/sig.ss index 1c1bee8ab7..19defbc9b5 100644 --- a/collects/slideshow/sig.ss +++ b/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 diff --git a/collects/slideshow/slide.ss b/collects/slideshow/slide.ss index f91987f9b9..104c003171 100644 --- a/collects/slideshow/slide.ss +++ b/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 diff --git a/collects/slideshow/viewer.ss b/collects/slideshow/viewer.ss index 162b34e0f9..8a3c17eb26 100644 --- a/collects/slideshow/viewer.ss +++ b/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)