Changeset 11834 in project


Ignore:
Timestamp:
09/01/08 04:53:16 (13 years ago)
Author:
Kon Lovett
Message:

Added rqrd Unit files. Bug fixes. Stopped use of long-ish inline procs..

Location:
release/3/srfi-29/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/3/srfi-29/trunk/srfi-29-eggdoc.scm

    r10096 r11834  
    141141          (p "This procedure should be used with caution.") )
    142142
    143         (procedure "(localized-template PACKAGE-NAME TEMPLATE-NAME [DEFAULT #f])"
     143        (procedure "(localized-template PACKAGE-NAME TEMPLATE-NAME [NOT-FOUND #f])"
    144144          (p "Returns the object for the " (tt "TEMPLATE-NAME") " in " (tt "PACKAGE-NAME") ", "
    145           "when found, otherwise the " (tt "DEFAULT") ".") )
     145          "when found, otherwise the " (tt "NOT-FOUND") ".") )
    146146
    147147        (procedure "(localized-template-set! PACKAGE-NAME TEMPLATE-NAME VALUE)"
    148           (p "Sets the " (tt "VALUE") " for the " (tt "TEMPLATE-NAME") " "
     148          (p "Creates or updates the " (tt "VALUE") " for the " (tt "TEMPLATE-NAME") " "
    149149          "in " (tt "PACKAGE-NAME") " and returns " (code "#t") ", when the package exists. "
    150           "Otherwise returns " (code "#f") ".") )
    151 
    152         (procedure "(localized-template/default PACKAGE-NAME TEMPLATE-NAME [DEFAULT TEMPLATE-NAME])"
    153           (p "Returns " (code "(localized-template PACKAGE-NAME TEMPLATE-NAME DEFAULT)") ".")
     150          "Otherwise returns " (code "#f") ".")
     151
     152          (p "This can be used to extend the meaning of a package template at "
     153          "runtime. For example: caching the actual closure for a named procedure.") )
     154
     155        (procedure "(localized-template/default PACKAGE-NAME TEMPLATE-NAME [NOT-FOUND TEMPLATE-NAME])"
     156          (p "Returns " (code "(localized-template PACKAGE-NAME TEMPLATE-NAME NOT-FOUND)") ".")
    154157
    155158          (p "Somewhat like the Posix 'gettext' routine.") )
     
    186189
    187190    (history
     191     (version "1.12.0" "Needed Unit files. Procedure 'localized-format' did not follow specification.")
    188192     (version "1.9.0" "Version increased to force egg update [by Ivan Raikov].")
    189193     (version "1.8.0" "Added 'localized-template-set!'.")
  • release/3/srfi-29/trunk/srfi-29.html

    r10096 r11834  
    221221<p>Does not remove the bundle, if any, from the active bundles. A filesystem only operation.</p>
    222222<p>This procedure should be used with caution.</p></dd>
    223 <dt class="definition"><strong>procedure:</strong> (localized-template PACKAGE-NAME TEMPLATE-NAME [DEFAULT #f])</dt>
    224 <dd>
    225 <p>Returns the object for the <tt>TEMPLATE-NAME</tt> in <tt>PACKAGE-NAME</tt>, when found, otherwise the <tt>DEFAULT</tt>.</p></dd>
     223<dt class="definition"><strong>procedure:</strong> (localized-template PACKAGE-NAME TEMPLATE-NAME [NOT-FOUND #f])</dt>
     224<dd>
     225<p>Returns the object for the <tt>TEMPLATE-NAME</tt> in <tt>PACKAGE-NAME</tt>, when found, otherwise the <tt>NOT-FOUND</tt>.</p></dd>
    226226<dt class="definition"><strong>procedure:</strong> (localized-template-set! PACKAGE-NAME TEMPLATE-NAME VALUE)</dt>
    227227<dd>
    228 <p>Sets the <tt>VALUE</tt> for the <tt>TEMPLATE-NAME</tt> in <tt>PACKAGE-NAME</tt> and returns <code>#t</code>, when the package exists. Otherwise returns <code>#f</code>.</p></dd>
    229 <dt class="definition"><strong>procedure:</strong> (localized-template/default PACKAGE-NAME TEMPLATE-NAME [DEFAULT TEMPLATE-NAME])</dt>
    230 <dd>
    231 <p>Returns <code>(localized-template PACKAGE-NAME TEMPLATE-NAME DEFAULT)</code>.</p>
     228<p>Creates or updates the <tt>VALUE</tt> for the <tt>TEMPLATE-NAME</tt> in <tt>PACKAGE-NAME</tt> and returns <code>#t</code>, when the package exists. Otherwise returns <code>#f</code>.</p>
     229<p>This can be used to extend the meaning of a package template at runtime. For example: caching the actual closure for a named procedure.</p></dd>
     230<dt class="definition"><strong>procedure:</strong> (localized-template/default PACKAGE-NAME TEMPLATE-NAME [NOT-FOUND TEMPLATE-NAME])</dt>
     231<dd>
     232<p>Returns <code>(localized-template PACKAGE-NAME TEMPLATE-NAME NOT-FOUND)</code>.</p>
    232233<p>Somewhat like the Posix 'gettext' routine.</p></dd>
    233234<dt class="definition"><strong>procedure:</strong> (localized-format PACKAGE-NAME TEMPLATE-NAME PORT ARG0 ...)</dt>
     
    244245<h3>Version</h3>
    245246<ul>
     247<li>1.12.0 Needed Unit files. Procedure 'localized-format' did not follow specification.</li>
    246248<li>1.9.0 Version increased to force egg update [by Ivan Raikov].</li>
    247249<li>1.8.0 Added 'localized-template-set!'.</li>
  • release/3/srfi-29/trunk/srfi-29.scm

    r10024 r11834  
    44;; ISSUES
    55;;
    6 ;; - Bit of a dither about (disable-interrupts). Suspect not really necessary but
    7 ;; w/o the binary grows by ~10%!
     6;; - Bit of a dither about (disable-interrupts). Suspect not really
     7;; necessary but w/o the binary grows by ~10%!
    88;;
    99;; - Locale component symbols must have lowercase printname, as
    1010;; such they do not truely reflect ISO 639-1 & ISO 3166-1.
    1111;;
    12 ;; - The locale details component is ill-defined, which symbol means what?
     12;; - The locale details component of the SRFI is ill-defined, which
     13;; symbol means what?
    1314;;
    1415;; - Possible race condition creating a bundle file or directory
     
    2728    (no-procedure-checks)
    2829    (no-bound-checks)
    29     (bound-to-procedure
    30       most-specific-bundle-specifier )
     30    (bound-to-procedure ; Forward references
     31      most-specific-bundle-specifier
     32      invalidate-package-bundle-cache )
    3133    (export
    3234      ;; Extensions
     
    5052      localized-template ) ) )
    5153
    52 (use srfi-1 srfi-12 srfi-13 posix extras utils
     54(use srfi-1 srfi-12 srfi-13 posix files
    5355     miscmacros lookup-table locale misc-extn-directory)
    5456
     
    7779;;
    7880
    79 (define-inline (make-srfi-29-exception loc msg . args)
     81(define (make-srfi-29-exception loc msg . args)
    8082  (make-composite-condition
    8183   (make-property-condition 'exn 'message msg 'location loc 'arguments args)
    8284   (make-property-condition 'srfi-29)) )
    8385
    84 (define-inline (signal-srfi-29-exception loc msg . args)
     86(define (signal-srfi-29-exception loc msg . args)
    8587  (abort (apply make-srfi-29-exception loc msg args)) )
    8688
     
    112114                 (bundle-specification->pathname bundle-specifier)) )
    113115
     116;; Bundles Dictionary
     117
     118(define *localization-bundles* (make-dict 1 equal?))
     119
     120(define-inline (find-bundle bundle-specifier)
     121  (dict-ref *localization-bundles* bundle-specifier) )
     122
     123(define-inline (set-bundle! bundle-specifier bundle-alist)
     124  (dict-set! *localization-bundles* bundle-specifier (alist->dict bundle-alist equal?)) )
     125
     126(define-inline (reset-bundle! bundle-specifier)
     127  (invalidate-package-bundle-cache bundle-specifier)
     128  (dict-delete! *localization-bundles* bundle-specifier) )
     129
    114130;; Package Bundle Cache
    115131
     
    121137      (set! *package-bundle-cache* (make-dict 1 eq?)) ) )
    122138
    123 ;; Bundles Dictionary
    124 
    125 (define *localization-bundles* (make-dict 1 equal?))
    126 
    127 (define-inline (find-bundle bundle-specifier)
    128   (dict-ref *localization-bundles* bundle-specifier) )
    129 
    130 (define-inline (set-bundle! bundle-specifier bundle-alist)
    131   (dict-set! *localization-bundles* bundle-specifier (alist->dict bundle-alist equal?)) )
    132 
    133 (define-inline (reset-bundle! bundle-specifier)
    134   (invalidate-package-bundle-cache bundle-specifier)
    135   (dict-delete! *localization-bundles* bundle-specifier) )
    136 
    137 ;;
    138 
    139 (define-inline (cached-package-bundle package-name)
     139(define (cached-package-bundle package-name)
    140140  (or (dict-ref *package-bundle-cache* package-name)
    141141      (let loop ([specifier (remove! not (most-specific-bundle-specifier package-name))])
     
    169169;;; Locale Parameters
    170170
     171;; The default 'format' procedure
     172;; Any supplied procedure MUST have the same signature as SRFI 28 'format'
     173;; The initial procedure is the builtin
     174
    171175(define-parameter current-locale-format-function
    172176  format
     
    177181          (warning 'current-locale-format-function "invalid procedure" x)
    178182          (current-locale-format-function) ) ) ) )
     183
     184;; The default language
    179185
    180186(define-parameter current-language
     
    188194           (current-language) ] ) ) )
    189195
     196;; The default country
     197
    190198(define-parameter current-country
    191199  (locale-ref 'country)
     
    198206           (current-country) ] ) ) )
    199207
     208;; The default locale-details
     209
    200210(define-parameter current-locale-details
    201211  (locale-ref 'details)
     
    220230;;; Bundle Operations
    221231
    222 ;;
     232;; Returns the full bundle specifier for the specified package using the default locale
    223233
    224234(define (most-specific-bundle-specifier package-name)
    225235  `(,package-name ,(current-language) ,(current-country) ,@(current-locale-details)) )
    226236
    227 ;; Retrieve the localized template from the most specific bundle given
    228 ;; its' package name and a template name
    229 
    230 (define (localized-template package-name template-name #!optional default)
     237;; Returns the localized template from the most specific bundle given
     238;; its' package name and a template name, if the package exists. Otherwise
     239;; returns the not-found argument, default #f.
     240
     241(define (localized-template package-name template-name #!optional not-found)
    231242  (if* (cached-package-bundle package-name)
    232243       (dict-ref it template-name)
    233        default ) )
    234 
    235 ;;
    236 
    237 (define (localized-template/default package-name template-name #!optional (default template-name))
    238   (localized-template package-name template-name default) )
    239 
    240 ;;
     244       not-found ) )
     245
     246;; Returns the localized template from the most specific bundle given
     247;; its' package name and a template name, if the package exists. Otherwise
     248;; returns the not-found argument, default is the template-name.
     249
     250(define (localized-template/default package-name template-name #!optional (not-found template-name))
     251  (localized-template package-name template-name not-found) )
     252
     253;; Returns the application of the default 'format' procedure to the
     254;; supplied arguments, using the package template as the format-string.
     255;; When a format-string is unavailable an emergency display of the
     256;; relevant details is made to proper destination.
    241257
    242258(define (localized-format package-name template-name port . fmtargs)
    243   (let ([fmtstr (localized-template package-name template-name)])
    244     (if (or fmtstr (string? template-name))
     259  (let ([fmtstr (or (localized-template package-name template-name)
     260                    (and (string? template-name)
     261                         template-name))])
     262    (if fmtstr
    245263        (apply (current-locale-format-function) port fmtstr fmtargs)
    246         (let ([str (apply conc template-name #\space (intersperse fmtargs #\space))])
     264        (let ([str (conc #\[ package-name #\/ template-name
     265                             #\space
     266                             (apply conc (intersperse fmtargs #\space))
     267                         #\])])
    247268          (cond [(port? port)                     (display str port)]
    248269                [(or (string? port) (not port))   str]
    249270                [else                             (display str) ] ) ) ) ) )
    250271
    251 ;;
     272;; Create or update the value for a template in an existing package.
     273;; Returns #t for success & #f when no such package.
    252274
    253275(define (localized-template-set! package-name template-name value)
Note: See TracChangeset for help on using the changeset viewer.