From 361bc3e9337dbd353b8ef798ee86a1f5bf55214d Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 25 Jun 1997 07:25:08 +0000
Subject: [PATCH] Change RCS-FIND-DELTA to have an extra argument saying
 whether or not to signal an error if there is no such delta.

---
 v7/src/edwin/rcsparse.scm | 90 ++++++++++++++++++++++-----------------
 1 file changed, 51 insertions(+), 39 deletions(-)

diff --git a/v7/src/edwin/rcsparse.scm b/v7/src/edwin/rcsparse.scm
index fcef1b1fe..42bb4bf0e 100644
--- a/v7/src/edwin/rcsparse.scm
+++ b/v7/src/edwin/rcsparse.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rcsparse.scm,v 1.2 1997/04/02 08:17:13 cph Exp $
+$Id: rcsparse.scm,v 1.3 1997/06/25 07:25:08 cph Exp $
 
 Copyright (c) 1991-97 Massachusetts Institute of Technology
 
@@ -200,61 +200,73 @@ MIT in each case. |#
 
 ;;;; Delta Search
 
-(define (rcs-find-delta admin number)
+(define (rcs-find-delta admin number error?)
   (if number
       (let ((n-fields (rcs-number-length number))
 	    (head (rcs-admin/head admin)))
 	(if (fix:= n-fields 1)
 	    (let loop ((delta head))
-	      (if (not delta)
-		  (error:bad-range-argument number 'RCS-FIND-DELTA))
-	      (if (string-prefix? number (rcs-delta/number delta))
-		  delta
-		  (loop (rcs-delta/next delta))))
+	      (if delta
+		  (if (string-prefix? number (rcs-delta/number delta))
+		      delta
+		      (loop (rcs-delta/next delta)))
+		  (and error?
+		       (error:bad-range-argument number 'RCS-FIND-DELTA))))
 	    (let loop ((branch head) (i 1))
 	      (let* ((i (fix:+ i 1))
-		     (delta (find-revision branch (rcs-number-head number i))))
-		(if (fix:= n-fields i)
-		    delta
-		    (let* ((i (fix:+ i 1))
-			   (branch
-			    (find-branch delta (rcs-number-head number i))))
-		      (if (fix:= n-fields i)
-			  (last-revision branch)
-			  (loop branch i))))))))
+		     (delta
+		      (find-revision branch
+				     (rcs-number-head number i error?)
+				     error?)))
+		(and delta
+		     (if (fix:= n-fields i)
+			 delta
+			 (let* ((i (fix:+ i 1))
+				(branch
+				 (find-branch delta
+					      (rcs-number-head number i error?)
+					      error?)))
+			   (and branch
+				(if (fix:= n-fields i)
+				    (last-revision branch)
+				    (loop branch i))))))))))
       (if (rcs-admin/branch admin)
-	  (rcs-find-delta admin (rcs-admin/branch admin))
+	  (rcs-find-delta admin (rcs-admin/branch admin) error?)
 	  (rcs-admin/head admin))))
 
 (define (last-revision delta)
   (if (rcs-delta/next delta)
       (last-revision (rcs-delta/next delta))
       delta))
-
-(define (find-revision delta number)
-  (let loop ((delta delta))
-    (if (not delta)
-	(error:bad-range-argument number 'RCS-FIND-DELTA))
-    (if (string=? number (rcs-delta/number delta))
-	delta
-	(loop (rcs-delta/next delta)))))
-
-(define (find-branch delta number)
-  (let loop ((branches (rcs-delta/branches delta)))
-    (if (null? branches)
-	(error:bad-range-argument number 'RCS-FIND-DELTA))
-    (if (string-prefix? number (rcs-delta/number (car branches)))
-	(car branches)
-	(loop (cdr branches)))))
-
-(define (rcs-number-head number n-fields)
+
+(define (find-revision delta number error?)
+  (and number
+       (let loop ((delta delta))
+	 (if delta
+	     (if (string=? number (rcs-delta/number delta))
+		 delta
+		 (loop (rcs-delta/next delta)))
+	     (and error?
+		  (error:bad-range-argument number 'RCS-FIND-DELTA))))))
+
+(define (find-branch delta number error?)
+  (and number
+       (let loop ((branches (rcs-delta/branches delta)))
+	 (if (not (null? branches))
+	     (if (string-prefix? number (rcs-delta/number (car branches)))
+		 (car branches)
+		 (loop (cdr branches)))
+	     (and error?
+		  (error:bad-range-argument number 'RCS-FIND-DELTA))))))
+
+(define (rcs-number-head number n-fields error?)
   (let ((end (string-length number)))
     (let loop ((i 0) (n-fields n-fields))
       (if (fix:= i end)
-	  (begin
-	    (if (fix:> n-fields 1)
-		(error:bad-range-argument n-fields 'RCS-FIND-DELTA))
-	    number)
+	  (if (fix:> n-fields 1)
+	      (and error?
+		   (error:bad-range-argument n-fields 'RCS-FIND-DELTA))
+	      number)
 	  (let ((i* (fix:+ i 1)))
 	    (if (char=? #\. (string-ref number i))
 		(let ((n-fields (fix:- n-fields 1)))
-- 
2.25.1