Changeset 9832 in project


Ignore:
Timestamp:
03/16/08 23:08:33 (12 years ago)
Author:
Kon Lovett
Message:

Added localized-template-set!

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

Legend:

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

    r9695 r9832  
    145145          "when found, otherwise the " (tt "DEFAULT") ".") )
    146146
     147        (procedure "(localized-template-set! PACKAGE-NAME TEMPLATE-NAME VALUE)"
     148          (p "Sets the " (tt "VALUE") " for the " (tt "TEMPLATE-NAME") " "
     149          "in " (tt "PACKAGE-NAME") " and returns " (code "#t") ", when the package exists. "
     150          "Otherwise returns " (code "#f") ".") )
     151
    147152        (procedure "(localized-template/default PACKAGE-NAME TEMPLATE-NAME [DEFAULT TEMPLATE-NAME])"
    148153          (p "Returns " (code "(localized-template PACKAGE-NAME TEMPLATE-NAME DEFAULT)") ".")
     
    154159          "using the " (code "(current-locale-format-function)") " and the "
    155160          "format string " (code "(localized-template PACKAGE-NAME TEMPLATE-NAME)") ".")
     161
     162          (p "When a localized-template is not found and the " (tt "TEMPLATE-NAME") " "
     163          "is a string then it is used a the format-string.")
    156164
    157165          (p "A representation is always displayed, even when no template is found. "
     
    178186
    179187    (history
     188     (version "1.8.0" "Added 'localized-template-set!'.")
    180189     (version "1.7.0" "Cached template lookup. 'localized-template' takes default parameter. Added 'localized-format', 'current-locale-format-function'.")
    181190     (version "1.6.0" "Support for missing locale component stated as " (code "#f") ".")
  • release/3/srfi-29/trunk/srfi-29.html

    r9695 r9832  
    224224<dd>
    225225<p>Returns the object for the <tt>TEMPLATE-NAME</tt> in <tt>PACKAGE-NAME</tt>, when found, otherwise the <tt>DEFAULT</tt>.</p></dd>
     226<dt class="definition"><strong>procedure:</strong> (localized-template-set! PACKAGE-NAME TEMPLATE-NAME VALUE)</dt>
     227<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>
    226229<dt class="definition"><strong>procedure:</strong> (localized-template/default PACKAGE-NAME TEMPLATE-NAME [DEFAULT TEMPLATE-NAME])</dt>
    227230<dd>
     
    231234<dd>
    232235<p>Formats the arguments <tt>ARG0 ...</tt> to the <tt>PORT</tt> using the <code>(current-locale-format-function)</code> and the format string <code>(localized-template PACKAGE-NAME TEMPLATE-NAME)</code>.</p>
     236<p>When a localized-template is not found and the <tt>TEMPLATE-NAME</tt> is a string then it is used a the format-string.</p>
    233237<p>A representation is always displayed, even when no template is found. Just not a localized one.</p></dd></div></div>
    234238<div class="section">
     
    240244<h3>Version</h3>
    241245<ul>
     246<li>1.8.0 Added 'localized-template-set!'.</li>
    242247<li>1.7.0 Cached template lookup. 'localized-template' takes default parameter. Added 'localized-format', 'current-locale-format-function'.</li>
    243248<li>1.6.0 Support for missing locale component stated as <code>#f</code>.</li>
  • release/3/srfi-29/trunk/srfi-29.scm

    r9695 r9832  
    2727    (no-procedure-checks)
    2828    (no-bound-checks)
     29    (bound-to-procedure
     30      most-specific-bundle-specifier )
    2931    (export
    3032      ;; Extensions
    3133      most-specific-bundle-specifier
    3234      localized-template/default
     35      localized-template-set!
    3336      remove-bundle!
    3437      undeclare-bundle!
     
    5255;;;
    5356
     57;;
     58
     59(define-inline (->symbol obj)
     60  (string->symbol (->string obj)) )
     61
    5462;; Constants
    5563
     
    6573(define COUNTRY-DEFAULT 'us)
    6674
    67 ;;;
    68 
    69 ;;
    70 
    71 (define-inline (->symbol obj)
    72   (string->symbol (->string obj)) )
    73 
    7475;;
    7576
    7677(define-inline (make-srfi-29-exception loc msg . args)
    7778  (make-composite-condition
    78     (make-property-condition 'exn 'message msg 'location loc 'arguments args)
    79     (make-property-condition 'srfi-29)) )
     79   (make-property-condition 'exn 'message msg 'location loc 'arguments args)
     80   (make-property-condition 'srfi-29)) )
    8081
    8182(define-inline (signal-srfi-29-exception loc msg . args)
     
    134135;;
    135136
    136 (define-inline (cached-package-bundle package-name thunk)
     137(define-inline (cached-package-bundle package-name)
    137138  (or (dict-ref *package-bundle-cache* package-name)
    138       (let loop ([specifier (thunk)])
     139      (let loop ([specifier (remove! not (most-specific-bundle-specifier package-name))])
    139140        (and (not (null? specifier))
    140141             (if* (find-bundle specifier)
     
    154155                  [(string? v)       (string->symbol (string-downcase v))]
    155156                  [else              (->symbol v)]) ) ] )
    156     (switch what
    157       ['language
     157    (select what
     158      [('language)
    158159        (as-sym (locale-component-ref locale 'language LANGUAGE-DEFAULT))]
    159       ['country
     160      [('country)
    160161        (as-sym (locale-component-ref locale 'region COUNTRY-DEFAULT))]
    161162      [else
     
    226227
    227228(define (localized-template package-name template-name #!optional default)
    228   (let ([bundle (cached-package-bundle package-name
    229                                        (lambda ()
    230                                          (remove!
    231                                           not
    232                                           (most-specific-bundle-specifier package-name))))])
    233     (if bundle
    234         (dict-ref bundle template-name)
    235         default ) ) )
     229  (if* (cached-package-bundle package-name)
     230       (dict-ref it template-name)
     231       default ) )
    236232
    237233;;
     
    244240(define (localized-format package-name template-name port . fmtargs)
    245241  (let ([fmtstr (localized-template package-name template-name)])
    246     (if fmtstr
     242    (if (or fmtstr (string? template-name))
    247243        (apply (current-locale-format-function) port fmtstr fmtargs)
    248244        (let ([str (apply conc template-name #\space (intersperse fmtargs #\space))])
     
    250246                [(or (string? port) (not port))   str]
    251247                [else                             (display str) ] ) ) ) ) )
     248
     249;;
     250
     251(define (localized-template-set! package-name template-name value)
     252  (and-let* ([bundle (cached-package-bundle package-name)])
     253    (dict-set! bundle template-name value)
     254    #t ) )
    252255
    253256;; Declare a bundle of templates with a given bundle specifier
  • release/3/srfi-29/trunk/tests/srfi-29-test.scm

    r9695 r9832  
    9393    (expect-eq "B33" 9 (localized-template 'srfi-29-test 'baz3))
    9494
     95    (expect-true "B37.1" (localized-template-set! 'srfi-29-test 'baz3 'foobar))
     96    (expect-eq "B37.2" 'foobar (localized-template 'srfi-29-test 'baz3))
     97    (expect-false "B37.3" (localized-template-set! 'foobar 'baz3 #t))
     98    (expect-true "B37.4" (localized-template-set! 'srfi-29-test 'barf 16))
     99    (expect-eq "B37.5" 16 (localized-template 'srfi-29-test 'barf))
     100
    95101    (expect-not-false "B34" (remove-bundle! '(srfi-29-test)))
    96102    (expect-not-false "B35" (remove-bundle! '(srfi-29-test foo)))
Note: See TracChangeset for help on using the changeset viewer.