;;; -*-Scheme-*-
;;;
-;;; $Id: ed-ffi.scm,v 1.4 2000/04/13 18:00:53 cph Exp $
+;;; $Id: ed-ffi.scm,v 1.5 2000/04/13 20:16:05 cph Exp $
;;;
;;; Copyright (c) 2000 Massachusetts Institute of Technology
;;;
("imail-top" (edwin imail) edwin-syntax-table)
("imail-umail" (edwin imail) system-global-syntax-table)
("imail-util" (edwin imail) system-global-syntax-table)
- ("rexp" (edwin imail rexp) system-global-syntax-table)
+ ("rexp" (runtime rexp) system-global-syntax-table)
("rfc822" (edwin imail) system-global-syntax-table)
- ("url" (edwin imail url) system-global-syntax-table)))
\ No newline at end of file
+ ("url" (runtime url) system-global-syntax-table)))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Id: imail.pkg,v 1.11 2000/04/13 19:47:14 cph Exp $
+;;; $Id: imail.pkg,v 1.12 2000/04/13 20:16:07 cph Exp $
;;;
;;; Copyright (c) 2000 Massachusetts Institute of Technology
;;;
(global-definitions "$bscm/sos/sos")
(global-definitions "$bscm/edwin/edwinunx")
-(define-package (edwin imail rexp)
+(define-package (runtime rexp)
(files "rexp")
- (parent (edwin imail))
- (export (edwin imail)
+ (parent ())
+ (export ()
rexp*
rexp+
rexp->regexp
rexp-word-start
rexp?))
-(define-package (edwin imail url)
+(define-package (runtime url)
(files "url")
- (parent (edwin imail))
- (export (edwin imail)
+ (parent ())
+ (export ()
url:char-set:escaped
url:char-set:extra
url:char-set:national
;;; -*-Scheme-*-
;;;
-;;; $Id: rexp.scm,v 1.10 2000/04/13 19:47:34 cph Exp $
+;;; $Id: rexp.scm,v 1.11 2000/04/13 20:14:59 cph Exp $
;;;
;;; Copyright (c) 2000 Massachusetts Institute of Technology
;;;
((NOT-SYNTAX-CHAR) (string-append "\\S" (syntax-type)))
(else (lose))))))
(else (lose)))))
-
+\f
(define (case-fold-string s)
(let ((end (string-length s)))
(let loop ((start 0) (parts '()))
(re-quote-string
(substring s start index))
parts))
- (apply string-append (reverse! parts)))))))
\ No newline at end of file
+ (apply string-append (reverse! parts)))))))
+
+(define (separated-append tokens separator)
+ (cond ((not (pair? tokens)) "")
+ ((not (pair? (cdr tokens))) (car tokens))
+ (else
+ (let ((string
+ (make-string
+ (let ((ns (string-length separator)))
+ (do ((tokens (cdr tokens) (cdr tokens))
+ (count (string-length (car tokens))
+ (fix:+ count
+ (fix:+ (string-length (car tokens))
+ ns))))
+ ((not (pair? tokens)) count))))))
+ (let loop
+ ((tokens (cdr tokens))
+ (index (string-move! (car tokens) string 0)))
+ (if (pair? tokens)
+ (loop (cdr tokens)
+ (string-move! (car tokens)
+ string
+ (string-move! separator string index)))))
+ string))))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Id: rexp.scm,v 1.10 2000/04/13 19:47:34 cph Exp $
+;;; $Id: rexp.scm,v 1.11 2000/04/13 20:14:59 cph Exp $
;;;
;;; Copyright (c) 2000 Massachusetts Institute of Technology
;;;
((NOT-SYNTAX-CHAR) (string-append "\\S" (syntax-type)))
(else (lose))))))
(else (lose)))))
-
+\f
(define (case-fold-string s)
(let ((end (string-length s)))
(let loop ((start 0) (parts '()))
(re-quote-string
(substring s start index))
parts))
- (apply string-append (reverse! parts)))))))
\ No newline at end of file
+ (apply string-append (reverse! parts)))))))
+
+(define (separated-append tokens separator)
+ (cond ((not (pair? tokens)) "")
+ ((not (pair? (cdr tokens))) (car tokens))
+ (else
+ (let ((string
+ (make-string
+ (let ((ns (string-length separator)))
+ (do ((tokens (cdr tokens) (cdr tokens))
+ (count (string-length (car tokens))
+ (fix:+ count
+ (fix:+ (string-length (car tokens))
+ ns))))
+ ((not (pair? tokens)) count))))))
+ (let loop
+ ((tokens (cdr tokens))
+ (index (string-move! (car tokens) string 0)))
+ (if (pair? tokens)
+ (loop (cdr tokens)
+ (string-move! (car tokens)
+ string
+ (string-move! separator string index)))))
+ string))))
\ No newline at end of file