suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use regexp-match?, fix a defclass bug

Browse Source 
svn: r5207
This commit is contained in:
Eli Barzilay 2007-01-03 08:14:07 +00:00
parent 41cb5beb36
commit 8305afe8d5
4 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/swindle/extra.ss
View File

@ -8,7 +8,7 @@
;;; ---------------------------------------------------------------------------
;;; A convenient `defstruct'
;; This makes it possible to create MzScheme structs using Swindle's `main' and
;; This makes it possible to create MzScheme structs using Swindle's `make' and
;; keyword arguments.
(define struct-to-slot-names (make-hash-table))
@ -36,8 +36,9 @@
[keys (build-list
(length slots)
(lambda (n) (list (symbol-append ': (nth slots n)) n)))]
[setter! (4th (call-with-values
(thunk (struct-type-info stype)) list))])
[setter! (5th (call-with-values
(thunk (struct-type-info stype))
list))])
(method ([obj this] initargs)
(for-each (lambda (k)
(let ([v (getarg initargs (1st k) none)])
@ -93,7 +94,8 @@
(defsyntax* (defstruct stx)
(define <>-re #rx"^<(.*)>$")
(define (<>-id? id)
(and (identifier? id) (regexp-match <>-re (symbol->string (syntax-e id)))))
(and (identifier? id)
(regexp-match? <>-re (symbol->string (syntax-e id)))))
(define (doit name super slots)
(let* ([str (regexp-replace <>-re (symbol->string (syntax-e name)) "\\1")]
[name-sans-<> (datum->syntax-object name (string->symbol str) name)]

10
collects/swindle/html.ss
View File

@ -132,11 +132,11 @@
(define* (relativize-path path)
(if (and (string? path) ; hack -- non-strings are just ignored
(not (regexp-match #rx"^[a-z]+://" path)))
(not (regexp-match? #rx"^[a-z]+://" path)))
(let ([cur-path
(cond [(*current-html-obj*) => (lambda (x) (getarg x :name))]
[else #f])])
(if (and cur-path (regexp-match #rx"/" cur-path))
(if (and cur-path (regexp-match? #rx"/" cur-path))
(let loop ([path path] [cur-path cur-path])
(let ([x (regexp-match #rx"^([^/]*/)(.*)" path)])
(if (and x (>= (string-length cur-path) (string-length (cadr x)))
@ -251,7 +251,7 @@
(substring str (caaddr x) (cdaddr x)))])
(when (or scm?
(not split-lines?)
(not (regexp-match #rx"^ *$" prefix)))
(not (regexp-match? #rx"^ *$" prefix)))
(disp prefix))
(cond
[(and (not scm?) token2
@ -275,7 +275,7 @@
[(equal? token meta-begin) (open)
(loop suffix)]
[(equal? token meta-end) (close)
(loop (if (and split-lines? (regexp-match #rx"^ *$" suffix))
(loop (if (and split-lines? (regexp-match? #rx"^ *$" suffix))
(begin (set! split-indent #f) (read-line))
suffix))]
;; remove one "\" (never happens -- see comment above)
@ -315,7 +315,7 @@
(define re (if (regexp? (car x)) (car x) (regexp (car x))))
(cons re
(if (and (string? (cadr x))
(regexp-match #rx"\\\\[0-9]" (cadr x)))
(regexp-match? #rx"\\\\[0-9]" (cadr x)))
(lambda (str . rest)
(if (string? str)
(regexp-replace re str (cadr x))

2
collects/swindle/tiny-clos.ss
View File

@ -1822,7 +1822,7 @@
method
(let* ([psym (object-name (%method-procedure method))]
[pstr (and psym (symbol->string psym))])
(if (or (not pstr) (regexp-match #rx":[0-9]*:[0-9]*$" pstr))
(if (or (not pstr) (regexp-match? #rx":[0-9]*:[0-9]*$" pstr))
(compute-method-name (%method-specializers method)
(%generic-name generic))
psym)))))

4
collects/swindle/tool.ss
View File

@ -130,11 +130,11 @@
(parameterize ([current-directory (collection-path "swindle")])
(define counter 100)
(define (do-customize file)
(when (regexp-match #rx"\\.ss$" file)
(when (regexp-match? #rx"\\.ss$" file)
(with-input-from-file file
(lambda ()
(let ([l (read-line)])
(when (regexp-match #rx"^;+ *CustomSwindle *$" l)
(when (regexp-match? #rx"^;+ *CustomSwindle *$" l)
(let ([file (regexp-replace #rx"\\.ss$" file "")]
[name #f] [dname #f] [one-line #f] [url #f])
(let loop ([l (read-line)])