diff options
author | Steve Langasek <vorlon@debian.org> | 2005-01-10 08:53:33 +0000 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:30 -0800 |
commit | e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch) | |
tree | abbf06041619e445f9d0b772b0d58132009d8234 /strcase.scm | |
parent | f559c149c83da84d0b1c285f0298c84aec564af9 (diff) | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip |
Import Debian changes 3a1-4.2debian/3a1-4.2
slib (3a1-4.2) unstable; urgency=low
* Non-maintainer upload.
* Add guile.init.local for use within the build dir, since otherwise we
have an (earlier unnoticed) circular build-dep due to a difference
between scm and guile.
slib (3a1-4.1) unstable; urgency=low
* Non-maintainer upload.
* Build-depend on guile-1.6 instead of scm, since the new version of
scm is wedged in unstable (closes: #281809).
slib (3a1-4) unstable; urgency=low
* Also check for expected creation on slibcat. (Closes: #240096)
slib (3a1-3) unstable; urgency=low
* Also check for /usr/share/guile/1.6/slib before installing for guile
1.6. (Closes: #239267)
slib (3a1-2) unstable; urgency=low
* Add format.scm back into slib until gnucash stops using it.
* Call guile-1.6 new-catalog (Closes: #238231)
slib (3a1-1) unstable; urgency=low
* New upstream release
* Remove Info section from doc-base file (Closes: #186950)
* Remove period from end of description (linda, lintian)
* html gen fixed upstream (Closes: #111778)
slib (2d4-2) unstable; urgency=low
* Fix url for upstream source (Closes: #144981)
* Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
* Add build depends.
slib (2d4-1) unstable; urgency=low
* New upstream.
slib (2d3-1) unstable; urgency=low
* New upstream.
* Remove texi2html call in debian/rules. Now done upstream. Add make
html instead.
* Changes to rules and doc-base to conform to upstream html gen
* Clean up upstream makefile to make sure it cleans up after itself.
Diffstat (limited to 'strcase.scm')
-rw-r--r-- | strcase.scm | 41 |
1 files changed, 32 insertions, 9 deletions
diff --git a/strcase.scm b/strcase.scm index 30b58ad..71daba4 100644 --- a/strcase.scm +++ b/strcase.scm @@ -4,30 +4,30 @@ ; This code is in the public domain. ; Modified by Aubrey Jaffer Nov 1992. -; SYMBOL-APPEND added by A. Jaffer 2001. +; SYMBOL-APPEND and StudlyCapsExpand added by A. Jaffer 2001. ; Authors of the original version were Ken Dickey and Aubrey Jaffer. ;string-upcase, string-downcase, string-capitalize ; are obvious string conversion procedures and are non destructive. ;string-upcase!, string-downcase!, string-capitalize! ; are destructive versions. - +;@ (define (string-upcase! str) (do ((i (- (string-length str) 1) (- i 1))) ((< i 0) str) (string-set! str i (char-upcase (string-ref str i))))) - +;@ (define (string-upcase str) (string-upcase! (string-copy str))) - +;@ (define (string-downcase! str) (do ((i (- (string-length str) 1) (- i 1))) ((< i 0) str) (string-set! str i (char-downcase (string-ref str i))))) - +;@ (define (string-downcase str) (string-downcase! (string-copy str))) - +;@ (define (string-capitalize! str) ; "hello" -> "Hello" (let ((non-first-alpha #f) ; "hELLO" -> "Hello" (str-len (string-length str))) ; "*hello" -> "*Hello" @@ -41,15 +41,15 @@ (set! non-first-alpha #t) (string-set! str i (char-upcase c)))) (set! non-first-alpha #f)))))) - +;@ (define (string-capitalize str) (string-capitalize! (string-copy str))) - +;@ (define string-ci->symbol (let ((s2cis (if (equal? "x" (symbol->string 'x)) string-downcase string-upcase))) (lambda (str) (string->symbol (s2cis str))))) - +;@ (define symbol-append (let ((s2cis (if (equal? "x" (symbol->string 'x)) string-downcase string-upcase))) @@ -64,3 +64,26 @@ ((not obj) "") (else (slib:error 'wrong-type-to 'symbol-append obj)))) args)))))) +;@ +(define (StudlyCapsExpand nstr . delimitr) + (set! delimitr + (cond ((null? delimitr) "-") + ((char? (car delimitr)) (string (car delimitr))) + (else (car delimitr)))) + (do ((idx (+ -1 (string-length nstr)) (+ -1 idx))) + ((> 1 idx) nstr) + (cond ((and (> idx 1) + (char-upper-case? (string-ref nstr (+ -1 idx))) + (char-lower-case? (string-ref nstr idx))) + (set! nstr + (string-append (substring nstr 0 (+ -1 idx)) + delimitr + (substring nstr (+ -1 idx) + (string-length nstr))))) + ((and (char-lower-case? (string-ref nstr (+ -1 idx))) + (char-upper-case? (string-ref nstr idx))) + (set! nstr + (string-append (substring nstr 0 idx) + delimitr + (substring nstr idx + (string-length nstr)))))))) |