From cdfa775de7a1dc2e31c2bad1e096c9eb60ad63fe Mon Sep 17 00:00:00 2001
From: shivers <shivers>
Date: Mon, 10 Nov 1997 02:34:45 +0000
Subject: [PATCH] Added ABSOLUTE-FILE-NAME and ->REGEXP.

---
 doc/scsh-manual/strings.tex | 19 +++++++++++++++++++
 scsh/fname.scm              | 14 +++++++++++---
 scsh/re.scm                 | 13 ++++++++++---
 3 files changed, 40 insertions(+), 6 deletions(-)

diff --git a/doc/scsh-manual/strings.tex b/doc/scsh-manual/strings.tex
index 4cb925f..aca24db 100644
--- a/doc/scsh-manual/strings.tex
+++ b/doc/scsh-manual/strings.tex
@@ -29,6 +29,9 @@ The code uses Henry Spencer's regular expression package.
     Search \var{string} starting at position \var{start}, looking for a match
     for \var{regexp}. If a match is found, return a match structure describing
     the match, otherwise {\sharpf}. \var{Start} defaults to 0.
+
+    \var{regexp} may be a compiled regexp structure or a string defining
+    a regular expression, which will be compiled to a regexp structure.
 \end{defundesc}
 
 \begin{defundesc} {regexp-match?} {obj} \boolean
@@ -79,6 +82,11 @@ searches can be avoided by these lower-level routines:
   otherwise {\sharpf}. \var{Start} defaults to 0.
 \end{defundesc}
 
+\begin{defundesc} {->regexp} {regexp-or-string} {regexp}
+  Coerce the input value into a compiled regular expression:
+  strings are compiled; regexp structures are passed through unchanged.
+\end{defundesc}
+
 \defun{regexp-quote}{str}{\str}
 \begin{desc}
 Returns a regular expression that matches the string \var{str} exactly.
@@ -136,6 +144,8 @@ It has the following differences with \ex{regexp-substitute}:
 	a given match.
 	The procedure returns a string to be used in the result.
   \end{itemize}
+The \var{regexp} parameter can be either a compiled regular expression or
+a string specifying a regular expression.
 
 Some examples:
 {\small
@@ -515,6 +525,15 @@ File name & \ex{\ldots-directory?} & \ex{\ldots-non-directory?} \\
 Resolve and simplify the file-name.
 \end{defundesc}
     
+\begin{defundesc} {absolute-file-name} {fname [dir]} \str
+Convert file-name \var{fname} into an absolute file name,
+relative to directory \var{dir}, which defaults to the current
+working directory. The file name is simplified before being
+returned.
+
+This procedure does not treat a leading tilde character specially.
+\end{defundesc}
+
 \begin{defundesc}  {home-dir} {[user]} \str
     \ex{home-dir} returns \var{user}'s home directory. 
         \var{User} defaults to the current user.
diff --git a/scsh/fname.scm b/scsh/fname.scm
index 6072377..2451838 100644
--- a/scsh/fname.scm
+++ b/scsh/fname.scm
@@ -163,9 +163,8 @@
 
 (define (resolve-file-name fname . maybe-root)
   (let* ((root (ensure-file-name-is-nondirectory (:optional maybe-root ".")))
-	 (fname (ensure-file-name-is-nondirectory fname))
-	 (len (string-length fname)))
-    (if (zero? len) "/"
+	 (fname (ensure-file-name-is-nondirectory fname)))
+    (if (zero? (string-length fname)) "/"
 	(let ((c (string-ref fname 0)))
 	  (cond ((char=? #\/ c) fname) 	; Absolute file name.
 
@@ -222,6 +221,15 @@
   (simplify-file-name (apply resolve-file-name fname maybe-dir)))
 
 
+(define (absolute-file-name fname . maybe-root)
+  (let ((fname (ensure-file-name-is-nondirectory fname)))
+    (if (zero? (string-length fname)) "/"
+	(simplify-file-name
+	  (if (char=? #\/ (string-ref fname 0)) fname 	; Absolute file name.
+	      (let ((root (:optional maybe-root (cwd))))
+		(string-append (file-name-as-directory root) fname)))))))
+
+
 (define (home-dir . maybe-user)
   (if (pair? maybe-user)
       (let ((user (car maybe-user)))
diff --git a/scsh/re.scm b/scsh/re.scm
index 57a0253..e44a005 100644
--- a/scsh/re.scm
+++ b/scsh/re.scm
@@ -57,6 +57,12 @@
   static-string) ; Error msg or #f
 
 
+(define (->regexp x)
+  (cond ((string? x) (make-regexp x))
+	((regexp? x) x)
+	(else (error "Not a regexp or string." x))))
+
+
 ;;; Executing compiled regexps
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -151,7 +157,8 @@
 
 
 (define (regexp-substitute/global port re str . items)
-  (let ((range (lambda (start sv ev item)	; Return start & end of
+  (let ((re (->regexp re))
+	(range (lambda (start sv ev item)	; Return start & end of
 		 (cond ((integer? item)		; ITEM's range in STR.
 			(values (vector-ref sv item)
 				(vector-ref ev item)))
@@ -166,7 +173,7 @@
 
 	;; Output port case, with zero or one POST items.
 	(let recur ((start 0))
-	  (let ((match (string-match re str start)))
+	  (let ((match (regexp-exec re str start)))
 	    (if match
 		(let* ((sv (regexp-match:start match))
 		       (ev (regexp-match:end match)))
@@ -182,7 +189,7 @@
 		(write-string str port start)))) ; No match.
 
 	(let* ((pieces (let recur ((start 0))
-			 (let ((match (string-match re str start))
+			 (let ((match (regexp-exec re str start))
 			       (cached-post #f))
 			   (if match
 			       (let* ((sv (regexp-match:start match))