Re: Sorted indexes and (string<?) in Jade

[Heiko Kirschke <Heiko.Kirschke@xxxxxxx>]

  > From: Toby Speight <Toby.Speight@xxxxxxxxxxxxxx>
  > Date: 15 Sep 1998 10:50:27 +0100
  > 
  > Jade doesn't support the string<? primitive, nor any of the related
  > functions.  I was hoping to use this to sort an index I've created, and
  > so I'd be interested to hear what other people use as a workaround.

My first idea was to work character by character on the strings to
compare, using the (char-property numeric-equiv: ...) [8.5.8.7,
8.5.8.1] for a numeric comparision between the `code' of both
characters. Unfortuately, jade returns always #f on char-property.

So, I wrote a function which returns the ASCII code of a character
(and ignoring the fact that jade uses Unicode internally)-: This I've
used to do character-by-character comparisions; these
character-by-character comparisions in turn I've used to define string
comparisions. The code uses some functions from the DSSSL procedure
library.

;; ======================================================================
;; 1998/09/09 HK: character encoding functions
(define default-character-numeric-equiv
  '((#\  . 32) (#\! . 33) (#\" . 34) (#\# . 35) (#\$ . 36)
    (#\% . 37) (#\& . 38) (#\' . 39) (#\( . 40) (#\) . 41)
    (#\* . 42) (#\+ . 43) (#\, . 44) (#\- . 45) (#\. . 46)
    (#\/ . 47) (#\0 . 48) (#\1 . 49) (#\2 . 50) (#\3 . 51)
    (#\4 . 52) (#\5 . 53) (#\6 . 54) (#\7 . 55) (#\8 . 56)
    (#\9 . 57) (#\: . 58) (#\; . 59) (#\< . 60) (#\= . 61)
    (#\> . 62) (#\? . 63) (#\@ . 64) (#\A . 65) (#\B . 66)
    (#\C . 67) (#\D . 68) (#\E . 69) (#\F . 70) (#\G . 71)
    (#\H . 72) (#\I . 73) (#\J . 74) (#\K . 75) (#\L . 76)
    (#\M . 77) (#\N . 78) (#\O . 79) (#\P . 80) (#\Q . 81)
    (#\R . 82) (#\S . 83) (#\T . 84) (#\U . 85) (#\V . 86)
    (#\W . 87) (#\X . 88) (#\Y . 89) (#\Z . 90) (#\[ . 91)
    (#\\ . 92) (#\] . 93) (#\^ . 94) (#\_ . 95) (#\` . 96)
    (#\a . 97) (#\b . 98) (#\c . 99) (#\d . 100) (#\e . 101)
    (#\f . 102) (#\g . 103) (#\h . 104) (#\i . 105) (#\j . 106)
    (#\k . 107) (#\l . 108) (#\m . 109) (#\n . 110) (#\o . 111)
    (#\p . 112) (#\q . 113) (#\r . 114) (#\s . 115) (#\t . 116)
    (#\u . 117) (#\v . 118) (#\w . 119) (#\x . 120) (#\y . 121)
    (#\z . 122) (#\{ . 123) (#\| . 124) (#\} . 125) (#\~ . 126)))

(define (char-property-numeric-equiv char)
  (let ((pair (assoc char default-character-numeric-equiv)))
    (if pair (cdr pair)	#f)))

;; ======================================================================
;; 1998/09/09 HK: character comparision functions

(define (char-less? char-1 char-2)
  (< (char-property-numeric-equiv char-1)
     (char-property-numeric-equiv char-2)))

(define (char-less-equal? char-1 char-2)
  (not (char-greater? char-1 char-2)))

(define (char-greater? char-1 char-2)
  (> (char-property-numeric-equiv char-1)
     (char-property-numeric-equiv char-2)))

(define (char-greater-equal? char-1 char-2)
  (not (char-less? char-1 char-2)))

(define (char-ci-less? char-1 char-2)
  (< (char-property-numeric-equiv (case-fold-down-char char-1))
     (char-property-numeric-equiv (case-fold-down-char char-2))))

(define (char-ci-less-equal? char-1 char-2)
  (not (char-ci-greater? char-1 char-2)))

(define (char-ci-greater? char-1 char-2)
  (> (char-property-numeric-equiv (case-fold-down-char char-1))
     (char-property-numeric-equiv (case-fold-down-char char-2))))

(define (char-ci-greater-equal? char-1 char-2)
  (not (char-ci-less? char-1 char-2)))

;; ======================================================================
;; 1998/09/09 HK: string comparision functions

(define (string-less? string-1 string-2)
  (let ((string-length-1 (string-length string-1))
	(string-length-2 (string-length string-2)))
    (let loop ((i 0))
      (cond
       ((>= i string-length-1)
	#t)
       ((>= i string-length-2)
	#f)
       ((char=? (string-ref string-1 i) (string-ref string-2 i))
	(loop (+ i 1)))
       (#t
	(char-less? (string-ref string-1 i) (string-ref string-2 i)))))))

(define (string-less-equal? string-1 string-2)
  (not (string-greater? string-1 string-2)))

(define (string-greater? string-1 string-2)
  (let ((string-length-1 (string-length string-1))
	(string-length-2 (string-length string-2)))
    (let loop ((i 0))
      (cond
       ((>= i string-length-1)
	#f)
       ((>= i string-length-2)
	#t)
       ((char=? (string-ref string-1 i) (string-ref string-2 i))
	(loop (+ i 1)))
       (#t
	(char-greater? (string-ref string-1 i) (string-ref string-2 i)))))))
       
(define (string-greater-equal? string-1 string-2)
  (not (string-less? string-1 string-2)))

(define (string-ci-less? string-1 string-2)
  (let ((string-length-1 (string-length string-1))
	(string-length-2 (string-length string-2)))
    (let loop ((i 0))
      (cond
       ((>= i string-length-1)
	#t)
       ((>= i string-length-2)
	#f)
       ((char=? (case-fold-down-char (string-ref string-1 i))
		(case-fold-down-char (string-ref string-2 i)))
	(loop (+ i 1)))
       (#t
	(char-ci-less? (string-ref string-1 i) (string-ref string-2 i)))))))

(define (string-ci-less-equal? string-1 string-2)
  (not (string-ci-greater? string-1 string-2)))

(define (string-ci-greater? string-1 string-2)
  (let ((string-length-1 (string-length string-1))
	(string-length-2 (string-length string-2)))
    (let loop ((i 0))
      (cond
       ((>= i string-length-1)
	#f)
       ((>= i string-length-2)
	#t)
       ((char=? (case-fold-down-char (string-ref string-1 i))
		(case-fold-down-char (string-ref string-2 i)))
	(loop (+ i 1)))
       (#t
	(char-ci-greater? (string-ref string-1 i) (string-ref string-2 i)))))))

(define (string-ci-greater-equal? string-1 string-2)
  (not (string-ci-less? string-1 string-2)))

  > I know it's a lot of work to build a collation engine (even simply
  > using the Unicode collation algorithm; more if it must support
  > (define-language) in the future), but does anyone have plans to
  > implement such a thing?

I'd like to ask that question urgently, too.

-- 
Viele Gruesse, Heiko


 DSSSList info and archive:  http://www.mulberrytech.com/dsssl/dssslist