From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 20 May 2000 20:08:37 +0000 (+0000)
Subject: Supply missing STRING-GREATEST-COMMON-PREFIX, needed by completion code.
X-Git-Tag: 20090517-FFI~3768
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5706d9907a1ccfdeb4743e84610d185cb6611eec;p=mit-scheme.git

Supply missing STRING-GREATEST-COMMON-PREFIX, needed by completion code.
---

diff --git a/v7/src/imail/imail-util.scm b/v7/src/imail/imail-util.scm
index f7d2dbbf5..4cf8edba9 100644
--- a/v7/src/imail/imail-util.scm
+++ b/v7/src/imail/imail-util.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-util.scm,v 1.21 2000/05/20 19:36:28 cph Exp $
+;;; $Id: imail-util.scm,v 1.22 2000/05/20 20:08:37 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -241,6 +241,32 @@
 (define (burst-comma-list-string string)
   (list-transform-negative (map string-trim (burst-string string #\, #f))
     string-null?))
+
+(define (string-greatest-common-prefix strings)
+  (let loop
+      ((strings (cdr strings))
+       (string (car strings))
+       (index (string-length (car strings))))
+    (if (null? strings)
+	(substring string 0 index)
+	(let ((string* (car strings)))
+	  (let ((index* (string-match-forward string string*)))
+	    (if (< index* index)
+		(loop (cdr strings) string* index*)
+		(loop (cdr strings) string index)))))))
+
+(define (string-greatest-common-prefix-ci strings)
+  (let loop
+      ((strings (cdr strings))
+       (string (car strings))
+       (index (string-length (car strings))))
+    (if (null? strings)
+	(substring string 0 index)
+	(let ((string* (car strings)))
+	  (let ((index* (string-match-forward-ci string string*)))
+	    (if (< index* index)
+		(loop (cdr strings) string* index*)
+		(loop (cdr strings) string index)))))))
 
 ;;;; Broken-pipe handler