home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / ice-9 / string-fun.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  8.6 KB  |  280 lines
  1. ;;;; string-fun.scm --- string manipulation functions
  2. ;;;;
  3. ;;;;     Copyright (C) 1995, 1996, 1997, 1999, 2001, 2006 Free Software Foundation, Inc.
  4. ;;;; 
  5. ;;;; This library is free software; you can redistribute it and/or
  6. ;;;; modify it under the terms of the GNU Lesser General Public
  7. ;;;; License as published by the Free Software Foundation; either
  8. ;;;; version 2.1 of the License, or (at your option) any later version.
  9. ;;;; 
  10. ;;;; This library is distributed in the hope that it will be useful,
  11. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13. ;;;; Lesser General Public License for more details.
  14. ;;;; 
  15. ;;;; You should have received a copy of the GNU Lesser General Public
  16. ;;;; License along with this library; if not, write to the Free Software
  17. ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18. ;;;; 
  19.  
  20. (define-module (ice-9 string-fun)
  21.   :export (split-after-char split-before-char split-discarding-char
  22.        split-after-char-last split-before-char-last
  23.        split-discarding-char-last split-before-predicate
  24.        split-after-predicate split-discarding-predicate
  25.        separate-fields-discarding-char separate-fields-after-char
  26.        separate-fields-before-char string-prefix-predicate string-prefix=?
  27.        sans-surrounding-whitespace sans-trailing-whitespace
  28.        sans-leading-whitespace sans-final-newline has-trailing-newline?))
  29.  
  30. ;;;;
  31. ;;;
  32. ;;; Various string funcitons, particularly those that take
  33. ;;; advantage of the "shared substring" capability.
  34. ;;;
  35.  
  36. ;;; {String Fun: Dividing Strings Into Fields}
  37. ;;; 
  38. ;;; The names of these functions are very regular.
  39. ;;; Here is a grammar of a call to one of these:
  40. ;;;
  41. ;;;   <string-function-invocation>
  42. ;;;   := (<action>-<seperator-disposition>-<seperator-determination> <seperator-param> <str> <ret>)
  43. ;;;
  44. ;;; <str>    = the string
  45. ;;;
  46. ;;; <ret>    = The continuation.  String functions generally return
  47. ;;;           multiple values by passing them to this procedure.
  48. ;;;
  49. ;;; <action> =    split
  50. ;;;        | separate-fields
  51. ;;;
  52. ;;;        "split" means to divide a string into two parts.
  53. ;;;            <ret> will be called with two arguments.
  54. ;;;
  55. ;;;        "separate-fields" means to divide a string into as many
  56. ;;;            parts as possible.  <ret> will be called with
  57. ;;;            however many fields are found.
  58. ;;;
  59. ;;; <seperator-disposition> =       before
  60. ;;;                | after
  61. ;;;                | discarding
  62. ;;;
  63. ;;;        "before" means to leave the seperator attached to
  64. ;;;            the beginning of the field to its right.
  65. ;;;        "after" means to leave the seperator attached to
  66. ;;;            the end of the field to its left.
  67. ;;;        "discarding" means to discard seperators.
  68. ;;;
  69. ;;;        Other dispositions might be handy.  For example, "isolate"
  70. ;;;        could mean to treat the separator as a field unto itself.
  71. ;;;
  72. ;;; <seperator-determination> =      char
  73. ;;;                | predicate
  74. ;;;
  75. ;;;        "char" means to use a particular character as field seperator.
  76. ;;;        "predicate" means to check each character using a particular predicate.
  77. ;;;        
  78. ;;;        Other determinations might be handy.  For example, "character-set-member".
  79. ;;;
  80. ;;; <seperator-param> = A parameter that completes the meaning of the determinations.
  81. ;;;            For example, if the determination is "char", then this parameter
  82. ;;;            says which character.  If it is "predicate", the parameter is the
  83. ;;;            predicate.
  84. ;;;
  85. ;;;
  86. ;;; For example:
  87. ;;;
  88. ;;;        (separate-fields-discarding-char #\, "foo, bar, baz, , bat" list)
  89. ;;;        => ("foo" " bar" " baz" " " " bat")
  90. ;;;
  91. ;;;        (split-after-char #\- 'an-example-of-split list)
  92. ;;;        => ("an-" "example-of-split")
  93. ;;;
  94. ;;; As an alternative to using a determination "predicate", or to trying to do anything
  95. ;;; complicated with these functions, consider using regular expressions.
  96. ;;;
  97.  
  98. (define (split-after-char char str ret)
  99.   (let ((end (cond
  100.           ((string-index str char) => 1+)
  101.           (else (string-length str)))))
  102.     (ret (substring str 0 end)
  103.      (substring str end))))
  104.  
  105. (define (split-before-char char str ret)
  106.   (let ((end (or (string-index str char)
  107.          (string-length str))))
  108.     (ret (substring str 0 end)
  109.      (substring str end))))
  110.  
  111. (define (split-discarding-char char str ret)
  112.   (let ((end (string-index str char)))
  113.     (if (not end)
  114.     (ret str "")
  115.     (ret (substring str 0 end)
  116.          (substring str (1+ end))))))
  117.  
  118. (define (split-after-char-last char str ret)
  119.   (let ((end (cond
  120.           ((string-rindex str char) => 1+)
  121.           (else 0))))
  122.     (ret (substring str 0 end)
  123.      (substring str end))))
  124.  
  125. (define (split-before-char-last char str ret)
  126.   (let ((end (or (string-rindex str char) 0)))
  127.     (ret (substring str 0 end)
  128.      (substring str end))))
  129.  
  130. (define (split-discarding-char-last char str ret)
  131.   (let ((end (string-rindex str char)))
  132.     (if (not end)
  133.     (ret str "")
  134.     (ret (substring str 0 end)
  135.          (substring str (1+ end))))))
  136.  
  137. (define (split-before-predicate pred str ret)
  138.   (let loop ((n 0))
  139.     (cond
  140.      ((= n (string-length str))        (ret str ""))
  141.      ((not (pred (string-ref str n)))    (loop (1+ n)))
  142.      (else                (ret (substring str 0 n)
  143.                          (substring str n))))))
  144. (define (split-after-predicate pred str ret)
  145.   (let loop ((n 0))
  146.     (cond
  147.      ((= n (string-length str))        (ret str ""))
  148.      ((not (pred (string-ref str n)))    (loop (1+ n)))
  149.      (else                (ret (substring str 0 (1+ n))
  150.                          (substring str (1+ n)))))))
  151.  
  152. (define (split-discarding-predicate pred str ret)
  153.   (let loop ((n 0))
  154.     (cond
  155.      ((= n (string-length str))        (ret str ""))
  156.      ((not (pred (string-ref str n)))    (loop (1+ n)))
  157.      (else                (ret (substring str 0 n)
  158.                          (substring str (1+ n)))))))
  159.  
  160. (define (separate-fields-discarding-char ch str ret)
  161.   (let loop ((fields '())
  162.          (str str))
  163.     (cond
  164.      ((string-rindex str ch)
  165.       => (lambda (w) (loop (cons (substring str (+ 1 w)) fields)
  166.                (substring str 0 w))))
  167.      (else (apply ret str fields)))))
  168.  
  169. (define (separate-fields-after-char ch str ret)
  170.   (reverse
  171.    (let loop ((fields '())
  172.              (str str))
  173.      (cond
  174.       ((string-index str ch)
  175.        => (lambda (w) (loop (cons (substring str 0 (+ 1 w)) fields)
  176.                            (substring str (+ 1 w)))))
  177.       (else (apply ret str fields))))))
  178.  
  179. (define (separate-fields-before-char ch str ret)
  180.   (let loop ((fields '())
  181.          (str str))
  182.     (cond
  183.      ((string-rindex str ch)
  184.       => (lambda (w) (loop (cons (substring str w) fields)
  185.                  (substring str 0 w))))
  186.      (else (apply ret str fields)))))
  187.  
  188.  
  189. ;;; {String Fun: String Prefix Predicates}
  190. ;;;
  191. ;;; Very simple:
  192. ;;;
  193. ;;; (define-public ((string-prefix-predicate pred?) prefix str)
  194. ;;;  (and (<= (string-length prefix) (string-length str))
  195. ;;;      (pred? prefix (substring str 0 (string-length prefix)))))
  196. ;;;
  197. ;;; (define-public string-prefix=? (string-prefix-predicate string=?))
  198. ;;;
  199.  
  200. (define ((string-prefix-predicate pred?) prefix str)
  201.   (and (<= (string-length prefix) (string-length str))
  202.        (pred? prefix (substring str 0 (string-length prefix)))))
  203.  
  204. (define string-prefix=? (string-prefix-predicate string=?))
  205.  
  206.  
  207. ;;; {String Fun: Strippers}
  208. ;;;
  209. ;;; <stripper> = sans-<removable-part>
  210. ;;;
  211. ;;; <removable-part> =       surrounding-whitespace
  212. ;;;            | trailing-whitespace
  213. ;;;            | leading-whitespace
  214. ;;;            | final-newline
  215. ;;;
  216.  
  217. (define (sans-surrounding-whitespace s)
  218.   (let ((st 0)
  219.     (end (string-length s)))
  220.     (while (and (< st (string-length s))
  221.         (char-whitespace? (string-ref s st)))
  222.        (set! st (1+ st)))
  223.     (while (and (< 0 end)
  224.         (char-whitespace? (string-ref s (1- end))))
  225.        (set! end (1- end)))
  226.     (if (< end st)
  227.     ""
  228.     (substring s st end))))
  229.  
  230. (define (sans-trailing-whitespace s)
  231.   (let ((st 0)
  232.     (end (string-length s)))
  233.     (while (and (< 0 end)
  234.         (char-whitespace? (string-ref s (1- end))))
  235.        (set! end (1- end)))
  236.     (if (< end st)
  237.     ""
  238.     (substring s st end))))
  239.  
  240. (define (sans-leading-whitespace s)
  241.   (let ((st 0)
  242.     (end (string-length s)))
  243.     (while (and (< st (string-length s))
  244.         (char-whitespace? (string-ref s st)))
  245.        (set! st (1+ st)))
  246.     (if (< end st)
  247.     ""
  248.     (substring s st end))))
  249.  
  250. (define (sans-final-newline str)
  251.   (cond
  252.    ((= 0 (string-length str))
  253.     str)
  254.  
  255.    ((char=? #\nl (string-ref str (1- (string-length str))))
  256.     (substring str 0 (1- (string-length str))))
  257.  
  258.    (else str)))
  259.  
  260. ;;; {String Fun: has-trailing-newline?}
  261. ;;;
  262.  
  263. (define (has-trailing-newline? str)
  264.   (and (< 0 (string-length str))
  265.        (char=? #\nl (string-ref str (1- (string-length str))))))
  266.  
  267.  
  268.  
  269. ;;; {String Fun: with-regexp-parts}
  270.  
  271. ;;; This relies on the older, hairier regexp interface, which we don't
  272. ;;; particularly want to implement, and it's not used anywhere, so
  273. ;;; we're just going to drop it for now.
  274. ;;; (define-public (with-regexp-parts regexp fields str return fail)
  275. ;;;   (let ((parts (regexec regexp str fields)))
  276. ;;;     (if (number? parts)
  277. ;;;         (fail parts)
  278. ;;;         (apply return parts))))
  279.  
  280.