;;;; "chap.scm" Chapter ordering -*-scheme-*- ;;; Copyright 1992, 1993, 1994, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is ;granted, subject to the following restrictions and understandings. ; ;1. Any copy made of this software must include this copyright notice ;in full. ; ;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; ;3. In conjunction with products arising from the use of this ;material, there shall be no use of my name in any advertising, ;promotional, or sales literature without prior written consent in ;each case. ;;; The CHAP: functions deal with strings which are ordered like ;;; chapters in a book. For instance, a_9 < a_10 and 4c < 4aa. Each ;;; section of the string consists of consecutive numeric or ;;; consecutive aphabetic characters. (require 'rev4-optional-procedures) ; string-copy ;;@code{(require 'chapter-order)} ;;@ftindex chapter-order ;; ;;The @samp{chap:} functions deal with strings which are ordered like ;;chapter numbers (or letters) in a book. Each section of the string ;;consists of consecutive numeric or consecutive aphabetic characters of ;;like case. ;;@args string1 string2 ;;Returns #t if the first non-matching run of alphabetic upper-case or ;;the first non-matching run of alphabetic lower-case or the first ;;non-matching run of numeric characters of @var{string1} is ;;@code{string= i l1) (not (>= i l2))) ((>= i l2) #f) (else (let ((c1 (string-ref s1 i)) (c2 (string-ref s2 i))) (cond ((char=? c1 c2) (if (ctypep c1) (match-so-far (+ 1 i) ctypep) (delimited i))) ((ctypep c1) (if (ctypep c2) (length-race (+ 1 i) ctypep (char= i l1) (if (>= i l2) def #t)) ((>= i l2) #f) (else (let ((c1 (string-ref s1 i)) (c2 (string-ref s2 i))) (cond ((ctypep c1) (if (ctypep c2) (length-race (+ 1 i) ctypep def) #f)) ((ctypep c2) #t) (else def)))))) (define (ctype c1) (cond ((char-numeric? c1) char-numeric?) ((char-lower-case? c1) char-lower-case?) ((char-upper-case? c1) char-upper-case?) (else #f))) (define (delimited i) (cond ((>= i l1) (not (>= i l2))) ((>= i l2) #f) (else (let* ((c1 (string-ref s1 i)) (c2 (string-ref s2 i)) (ctype1 (ctype c1))) (cond ((char=? c1 c2) (if ctype1 (match-so-far (+ i 1) ctype1) (delimited (+ i 1)))) ((and ctype1 (eq? ctype1 (ctype c2))) (length-race (+ 1 i) ctype1 (char? string1 string2) (chap:string=? string1 string2) (not (chap:stringinteger #\2) (char->integer #\1))) (define (chap:inc-string s p) (let ((c (string-ref s p))) (cond ((char=? c #\z) (string-set! s p #\a) (cond ((zero? p) (string-append "a" s)) ((char-lower-case? (string-ref s (+ -1 p))) (chap:inc-string s (+ -1 p))) (else (string-append (substring s 0 p) "a" (substring s p (string-length s)))))) ((char=? c #\Z) (string-set! s p #\A) (cond ((zero? p) (string-append "A" s)) ((char-upper-case? (string-ref s (+ -1 p))) (chap:inc-string s (+ -1 p))) (else (string-append (substring s 0 p) "A" (substring s p (string-length s)))))) ((char=? c #\9) (string-set! s p #\0) (cond ((zero? p) (string-append "1" s)) ((char-numeric? (string-ref s (+ -1 p))) (chap:inc-string s (+ -1 p))) (else (string-append (substring s 0 p) "1" (substring s p (string-length s)))))) ((or (char-alphabetic? c) (char-numeric? c)) (string-set! s p (integer->char (+ chap:char-incr (char->integer (string-ref s p))))) s) (else (slib:error "inc-string error" s p))))) ;;@args string ;;Returns the next string in the @emph{chapter order}. If @var{string} ;;has no alphabetic or numeric characters, ;;@code{(string-append @var{string} "0")} is returnd. The argument to ;;chap:next-string will always be @code{chap:string (chap:string ; (display s1) ; (display " > ") ; (display s2) ; (newline)))))