srfi/srfi-14.scm

   1 ;;;; srfi-14.scm --- SRFI-14 procedures for Guile
   2 ;;;;
   3 ;;;;    Copyright (C) 2001 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This program is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU General Public License as
   7 ;;;; published by the Free Software Foundation; either version 2, or
   8 ;;;; (at your option) any later version.
   9 ;;;;
  10 ;;;; This program 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 ;;;; General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with this software; see the file COPYING.  If not, write to
  17 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  18 ;;;; Boston, MA 02111-1307 USA
  19
  20 (define-module (srfi srfi-14))
  21
  22 (export
  23 ;;; General procedures
  24  char-set?
  25  char-set=
  26  char-set<=
  27  char-set-hash
  28
  29 ;;; Iterating over character sets
  30  char-set-cursor
  31  char-set-ref
  32  char-set-cursor-next
  33  end-of-char-set?
  34  char-set-fold
  35  char-set-unfold char-set-unfold!
  36  char-set-for-each
  37  char-set-map
  38
  39 ;;; Creating character sets
  40  char-set-copy
  41  char-set
  42  list->char-set list->char-set!
  43  string->char-set string-char-set!
  44  char-set-filter char-set-filter!
  45  ucs-range->char-set ucs-range->char-set!
  46  ->char-set
  47
  48 ;;; Querying character sets
  49  char-set-size
  50  char-set-count
  51  char-set->list
  52  char-set->string
  53  char-set-contains?
  54  char-set-every
  55  char-set-any
  56
  57 ;;; Character set algebra
  58  char-set-adjoin char-set-adjoin!
  59  char-set-delete char-set-delete!
  60  char-set-complement
  61  char-set-union
  62  char-set-intersection
  63  char-set-difference
  64  char-set-xor
  65  char-set-diff+intersection
  66  char-set-complement!
  67  char-set-union!
  68  char-set-intersection!
  69  char-set-difference!
  70  char-set-xor!
  71  char-set-diff+intersection!
  72
  73 ;;; Standard character sets
  74  char-set:lower-case
  75  char-set:upper-case
  76  char-set:title-case
  77  char-set:letter
  78  char-set:digit
  79  char-set:letter+digit
  80  char-set:graphic
  81  char-set:printing
  82  char-set:whitespace
  83  char-set:iso-control
  84  char-set:punctuation
  85  char-set:symbol
  86  char-set:hex-digit
  87  char-set:blank
  88  char-set:ascii
  89  char-set:empty
  90  char-set:full
  91  )
  92
  93 (dynamic-call "scm_init_srfi_13_14" (dynamic-link "libguile-srfi-srfi-13-14"))
  94
  95 (define (->char-set x)
  96   (cond
  97    ((string? x)   (string->char-set x))
  98    ((char? x)     (char-set x))
  99    ((char-set? x) x)
 100    (else (error "invalid argument to `->char-set'"))))
 101
 102 (define char-set:full (ucs-range->char-set 0 256))
 103
 104 (define char-set:lower-case (char-set-filter char-lower-case? char-set:full))
 105
 106 (define char-set:upper-case (char-set-filter char-upper-case? char-set:full))
 107
 108 (define char-set:title-case (char-set))
 109
 110 (define char-set:letter (char-set-union char-set:lower-case
 111                                         char-set:upper-case))
 112
 113 (define char-set:digit (string->char-set "0123456789"))
 114
 115 (define char-set:letter+digit
 116   (char-set-union char-set:letter char-set:digit))
 117
 118 (define char-set:punctuation (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}"))
 119
 120 (define char-set:symbol (string->char-set "$+<=>^`|~"))
 121
 122 (define char-set:whitespace (char-set #\space #\newline #\tab #\cr #\vt #\np))
 123
 124 (define char-set:blank (char-set #\space #\tab))
 125
 126 (define char-set:graphic
 127   (char-set-union char-set:letter+digit char-set:punctuation char-set:symbol))
 128
 129 (define char-set:printing
 130   (char-set-union char-set:graphic char-set:whitespace))
 131
 132 (define char-set:iso-control
 133   (char-set-adjoin
 134    (char-set-filter (lambda (ch) (< (char->integer ch) 31)) char-set:full)
 135    (integer->char 127)))
 136
 137 (define char-set:hex-digit (string->char-set "0123456789abcdefABCDEF"))
 138
 139 (define char-set:ascii
 140   (char-set-filter (lambda (ch) (< (char->integer ch) 128)) char-set:full))
 141
 142 (define char-set:empty (char-set))