Added ABSOLUTE-FILE-NAME and ->REGEXP.
This commit is contained in:
		
							parent
							
								
									b4c84222e7
								
							
						
					
					
						commit
						cdfa775de7
					
				|  | @ -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. | ||||
|  |  | |||
|  | @ -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))) | ||||
|  |  | |||
							
								
								
									
										13
									
								
								scsh/re.scm
								
								
								
								
							
							
						
						
									
										13
									
								
								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)) | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue
	
	 shivers
						shivers