Had to shuffle packages due to broken package dependencies.
The whole thing is a disaster and should be completely re-factorised.
This commit is contained in:
parent
6a7ecc38a1
commit
e989a744e4
15
scsh/re.c
15
scsh/re.c
|
@ -67,18 +67,3 @@ scheme_value df_re_match(long nargs, scheme_value *args)
|
|||
return ret1;
|
||||
}
|
||||
|
||||
scheme_value df_filter_stringvec(long nargs, scheme_value *args)
|
||||
{
|
||||
extern char *filter_stringvec(const char *, char const ** , int *);
|
||||
scheme_value ret1;
|
||||
char *r1;
|
||||
int r2;
|
||||
|
||||
cig_check_nargs(3, nargs, "filter_stringvec");
|
||||
r1 = filter_stringvec(cig_string_body(args[2]), (char const ** )AlienVal(args[1]), &r2);
|
||||
ret1 = VECTOR_REF(*args,0);
|
||||
{AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);}
|
||||
VECTOR_REF(*args,1) = ENTER_FIXNUM(r2);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
|
|
13
scsh/re.scm
13
scsh/re.scm
|
@ -143,10 +143,10 @@
|
|||
|
||||
(reduce (lambda (index item)
|
||||
(cond ((string? item)
|
||||
(copy-string! ans index item)
|
||||
(string-replace! ans index item)
|
||||
(+ index (string-length item)))
|
||||
(else (receive (si ei) (range item)
|
||||
(copy-substring! ans index str si ei)
|
||||
(substring-replace! ans index str si ei)
|
||||
(+ index (- ei si))))))
|
||||
0 items)
|
||||
ans))))
|
||||
|
@ -154,15 +154,6 @@
|
|||
;;; Miscellaneous
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; I do this one in C, I'm not sure why:
|
||||
;;; It is used by MATCH-FILES.
|
||||
|
||||
(define-foreign %filter-C-strings!
|
||||
(filter_stringvec (string pattern) ((C "char const ** ~a") cvec))
|
||||
static-string ; error message -- #f if no error.
|
||||
integer) ; number of files that pass the filter.
|
||||
|
||||
|
||||
;;; Convert a string into a regex pattern that matches that string exactly --
|
||||
;;; in other words, quote the special chars with backslashes.
|
||||
|
||||
|
|
|
@ -9,6 +9,3 @@ char *re_exec(scheme_value cr, const char *string, int start,
|
|||
char *re_match(const char *re, const char *string, int start,
|
||||
scheme_value start_vec, scheme_value end_vec,
|
||||
int *hit);
|
||||
|
||||
char *filter_stringvec(const char *re, char const **stringvec,
|
||||
int *nummatch);
|
||||
|
|
21
scsh/rw.scm
21
scsh/rw.scm
|
@ -179,24 +179,3 @@
|
|||
(extensible-port-local-data fd/port)))
|
||||
|
||||
(else (display (substring s start end) fd/port))))) ; hack
|
||||
|
||||
(define (y-or-n? question . maybe-eof-value)
|
||||
(let loop ((count *y-or-n-eof-count*))
|
||||
(display question)
|
||||
(display " (y/n)? ")
|
||||
(let ((line (read-line)))
|
||||
(cond ((eof-object? line)
|
||||
(newline)
|
||||
(if (= count 0)
|
||||
(:optional maybe-eof-value (error "EOF in y-or-n?"))
|
||||
(begin (display "I'll only ask another ")
|
||||
(write count)
|
||||
(display " times.")
|
||||
(newline)
|
||||
(loop (- count 1)))))
|
||||
((< (string-length line) 1) (loop count))
|
||||
((char=? (string-ref line 0) #\y) #t)
|
||||
((char=? (string-ref line 0) #\n) #f)
|
||||
(else (loop count))))))
|
||||
|
||||
(define *y-or-n-eof-count* 100)
|
||||
|
|
|
@ -213,7 +213,7 @@
|
|||
read-string!
|
||||
read-string/partial
|
||||
read-string!/partial
|
||||
write-string
|
||||
(write-string (proc (:string &opt :value :exact-integer :exact-integer) :unspecific))
|
||||
write-string/partial)))
|
||||
|
||||
|
||||
|
@ -429,11 +429,7 @@
|
|||
|
||||
|
||||
(define-interface scsh-string-interface
|
||||
(compound-interface (export substitute-env-vars
|
||||
index
|
||||
rindex)
|
||||
scsh-regexp-interface))
|
||||
|
||||
(export substitute-env-vars index rindex))
|
||||
|
||||
(define-interface scsh-file-names-interface
|
||||
(export file-name-as-directory
|
||||
|
|
|
@ -52,54 +52,12 @@
|
|||
(open defenum-package scheme)
|
||||
(files (machine bufpol)))
|
||||
|
||||
(define-structures ((scsh-regexp-package scsh-regexp-interface)
|
||||
(scsh-regexp-internals (export %filter-C-strings!)))
|
||||
(open defrec-package
|
||||
scsh-utilities
|
||||
define-foreign-syntax
|
||||
receiving
|
||||
error-package
|
||||
let-opt ; optional-arg parsing & defaulting
|
||||
scheme)
|
||||
(files re))
|
||||
|
||||
|
||||
(define-structure char-set-package char-set-interface
|
||||
(open error-package ascii scheme)
|
||||
(files char-set))
|
||||
|
||||
|
||||
(define-structure field-reader-package scsh-field-reader-interface
|
||||
(open receiving ; receive
|
||||
char-set-package
|
||||
scsh-utilities
|
||||
error-package ; error
|
||||
scsh-level-0 ; regexes and delimited readers
|
||||
let-opt ; optional-arg parsing & defaulting
|
||||
scheme
|
||||
)
|
||||
(files fr))
|
||||
|
||||
|
||||
(define-structures
|
||||
((awk-expander-package (export expand-awk))
|
||||
(awk-support-package (export next-range next-:range
|
||||
next-range: next-:range:)))
|
||||
(open receiving ; receive
|
||||
scsh-utilities
|
||||
error-package ; error
|
||||
char-set-package
|
||||
scheme
|
||||
)
|
||||
(files awk))
|
||||
|
||||
|
||||
(define-structure awk-package awk-interface
|
||||
(open awk-support-package scsh-regexp-package receiving scheme)
|
||||
(for-syntax (open awk-expander-package scheme))
|
||||
(begin (define-syntax awk expand-awk)))
|
||||
|
||||
|
||||
(define-structures ((tty-flags tty-flags-interface)
|
||||
(scsh-internal-tty-flags scsh-internal-tty-flags-interface))
|
||||
(open scheme ascii bitwise)
|
||||
|
@ -110,6 +68,16 @@
|
|||
(open scheme)
|
||||
(files scsh-version))
|
||||
|
||||
(define-structure partial-s48-ports
|
||||
(export current-input-port current-output-port
|
||||
newline
|
||||
error-output-port
|
||||
|
||||
$current-input-port
|
||||
$current-output-port
|
||||
$error-output-port)
|
||||
(open ports))
|
||||
|
||||
;;; The scsh-level-0 package is for implementation convenience.
|
||||
;;; The scsh startup and top-level modules need access to scsh
|
||||
;;; procedures, but they export procedures that are themselves
|
||||
|
@ -118,7 +86,8 @@
|
|||
;;; export the whole scsh enchilada.
|
||||
|
||||
(define-structures
|
||||
((scsh-level-0-internals (export set-command-line-args!
|
||||
((scsh-regexp-package scsh-regexp-interface)
|
||||
(scsh-level-0-internals (export set-command-line-args!
|
||||
init-scsh-hindbrain
|
||||
init-scsh-vars))
|
||||
(scsh-level-0
|
||||
|
@ -166,7 +135,8 @@
|
|||
ascii
|
||||
records
|
||||
extended-ports
|
||||
ports
|
||||
partial-s48-ports
|
||||
; ports
|
||||
build
|
||||
bigbit
|
||||
bitwise
|
||||
|
@ -177,8 +147,8 @@
|
|||
fluids
|
||||
weak
|
||||
|
||||
scsh-regexp-package
|
||||
scsh-regexp-internals
|
||||
; scsh-regexp-package
|
||||
; scsh-regexp-internals
|
||||
char-set-package
|
||||
scsh-version
|
||||
tty-flags
|
||||
|
@ -216,7 +186,6 @@
|
|||
fileinfo
|
||||
glob
|
||||
filemtch
|
||||
rdelim
|
||||
time ; New in release 0.2.
|
||||
(machine time_dep)
|
||||
network ; New in release 0.3.
|
||||
|
@ -226,6 +195,8 @@
|
|||
pty ; New in release 0.4.
|
||||
sighandlers ; New in release 0.5.
|
||||
scsh
|
||||
re
|
||||
rdelim
|
||||
))
|
||||
|
||||
(define-structure defrec-package (export (define-record :syntax))
|
||||
|
@ -278,9 +249,42 @@
|
|||
(files top meta-arg))
|
||||
|
||||
|
||||
(define-structure field-reader-package scsh-field-reader-interface
|
||||
(open receiving ; receive
|
||||
char-set-package
|
||||
scsh-utilities
|
||||
error-package ; error
|
||||
scsh-level-0 ; delimited readers
|
||||
scsh-regexp-package
|
||||
let-opt ; optional-arg parsing & defaulting
|
||||
scheme
|
||||
)
|
||||
(files fr))
|
||||
|
||||
|
||||
(define-structures
|
||||
((awk-expander-package (export expand-awk))
|
||||
(awk-support-package (export next-range next-:range
|
||||
next-range: next-:range:)))
|
||||
(open receiving ; receive
|
||||
scsh-utilities
|
||||
error-package ; error
|
||||
scsh-regexp-package
|
||||
scheme
|
||||
)
|
||||
(files awk))
|
||||
|
||||
|
||||
(define-structure awk-package awk-interface
|
||||
(open awk-support-package scsh-regexp-package receiving scheme)
|
||||
(for-syntax (open awk-expander-package scheme))
|
||||
(begin (define-syntax awk expand-awk)))
|
||||
|
||||
|
||||
(define-structure scsh
|
||||
(compound-interface (interface-of scsh-level-0)
|
||||
(interface-of scsh-startup-package)
|
||||
scsh-regexp-interface
|
||||
scsh-field-reader-interface ; new in 0.3
|
||||
; scsh-dbm-interface
|
||||
(export repl)
|
||||
|
@ -289,6 +293,7 @@
|
|||
(open structure-refs
|
||||
scsh-level-0
|
||||
scsh-level-0-internals
|
||||
scsh-regexp-package
|
||||
scsh-startup-package
|
||||
; dbm
|
||||
awk-package
|
||||
|
@ -305,3 +310,10 @@
|
|||
features ; make-immutable!
|
||||
scheme)
|
||||
(files here))
|
||||
|
||||
(define-structure test-package (export test-proc)
|
||||
(open scsh-regexp-package scheme)
|
||||
(begin (define (test-proc p)
|
||||
(regexp-substitute p
|
||||
(string-match "(foo)(.*)(bar)" "Hello foo Olin bar quux")
|
||||
'post 3 1 2 'pre))))
|
||||
|
|
|
@ -548,6 +548,27 @@
|
|||
(substring buf 0 nread)))) ; last one.
|
||||
(lp))))))))
|
||||
|
||||
(define (y-or-n? question . maybe-eof-value)
|
||||
(let loop ((count *y-or-n-eof-count*))
|
||||
(display question)
|
||||
(display " (y/n)? ")
|
||||
(let ((line (read-line)))
|
||||
(cond ((eof-object? line)
|
||||
(newline)
|
||||
(if (= count 0)
|
||||
(:optional maybe-eof-value (error "EOF in y-or-n?"))
|
||||
(begin (display "I'll only ask another ")
|
||||
(write count)
|
||||
(display " times.")
|
||||
(newline)
|
||||
(loop (- count 1)))))
|
||||
((< (string-length line) 1) (loop count))
|
||||
((char=? (string-ref line 0) #\y) #t)
|
||||
((char=? (string-ref line 0) #\n) #f)
|
||||
(else (loop count))))))
|
||||
|
||||
(define *y-or-n-eof-count* 100)
|
||||
|
||||
|
||||
;;; Stdio/stdport sync procedures
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
@ -856,6 +856,21 @@ scheme_value df_scm_sort_filevec(long nargs, scheme_value *args)
|
|||
return SCHFALSE;
|
||||
}
|
||||
|
||||
scheme_value df_filter_stringvec(long nargs, scheme_value *args)
|
||||
{
|
||||
extern char *filter_stringvec(const char *, char const ** , int *);
|
||||
scheme_value ret1;
|
||||
char *r1;
|
||||
int r2;
|
||||
|
||||
cig_check_nargs(3, nargs, "filter_stringvec");
|
||||
r1 = filter_stringvec(cig_string_body(args[2]), (char const ** )AlienVal(args[1]), &r2);
|
||||
ret1 = VECTOR_REF(*args,0);
|
||||
{AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);}
|
||||
VECTOR_REF(*args,1) = ENTER_FIXNUM(r2);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
scheme_value df_scm_envvec(long nargs, scheme_value *args)
|
||||
{
|
||||
extern char** scm_envvec(int *);
|
||||
|
|
|
@ -848,6 +848,15 @@
|
|||
(filter (lambda (f) (not (char=? (string-ref f 0) #\.)))
|
||||
files))))))
|
||||
|
||||
;;; I do this one in C, I'm not sure why:
|
||||
;;; It is used by MATCH-FILES.
|
||||
|
||||
(define-foreign %filter-C-strings!
|
||||
(filter_stringvec (string pattern) ((C "char const ** ~a") cvec))
|
||||
static-string ; error message -- #f if no error.
|
||||
integer) ; number of files that pass the filter.
|
||||
|
||||
|
||||
(define (match-files regexp . maybe-dir)
|
||||
(let ((dir (:optional maybe-dir ".")))
|
||||
(check-arg string? dir match-files)
|
||||
|
|
Loading…
Reference in New Issue