summaryrefslogtreecommitdiffstats
path: root/strcase.scm
diff options
context:
space:
mode:
authorSteve Langasek <vorlon@debian.org>2005-01-10 08:53:33 +0000
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:30 -0800
commite33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch)
treeabbf06041619e445f9d0b772b0d58132009d8234 /strcase.scm
parentf559c149c83da84d0b1c285f0298c84aec564af9 (diff)
parent8466d8cfa486fb30d1755c4261b781135083787b (diff)
downloadslib-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.scm41
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))))))))