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

.

Browse Source 
original commit: c1755b8a2a4e29d7b0d2b8395e138b5fb3ab7f54
This commit is contained in:
Matthew Flatt 2004-02-03 17:09:46 +00:00
parent 054e5d96b7
commit 7db48df217
2 changed files with 10 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/mred/mred.ss
View File

@ -5435,7 +5435,7 @@
(super-init wx))) (super-init wx)))
(restore)))) (restore))))
(define (strip-tab s) (car (regexp-match (format "^[^~a]*" #\tab) s))) (define (strip-tab s) (car (regexp-match #rxb"^[^\t]*" s)))
(define basic-labelled-menu-item% (define basic-labelled-menu-item%
(class100* mred% (labelled-menu-item<%>) (prnt lbl help-str wx-sub chkble? keymap set-wx demand-callback) (class100* mred% (labelled-menu-item<%>) (prnt lbl help-str wx-sub chkble? keymap set-wx demand-callback)
@ -5894,7 +5894,7 @@
(sequence (sequence
(super-init) (super-init)
(let ([s (last-position)] (let ([s (last-position)]
[m (regexp-match "^(.*), (Copyright.*)$" (banner))]) [m (regexp-match #rxb"^(.*), (Copyright.*)$" (banner))])
(insert (format "Welcome to ~a." (cadr m))) (insert (format "Welcome to ~a." (cadr m)))
(let ([e (last-position)]) (let ([e (last-position)])
(insert #\newline) (insert #\newline)
@ -6019,9 +6019,8 @@
(define (no-stretch a) (send a stretchable-width #f) (send a stretchable-height #f)) (define (no-stretch a) (send a stretchable-width #f) (send a stretchable-height #f))
(define protect& (define protect&
(let ([re (regexp "&")]) (lambda (s)
(lambda (s) (regexp-replace* #rxb"&" s "\\&\\&")))
(regexp-replace* re s "\\&\\&"))))
(define message-box/custom (define message-box/custom
@ -6044,9 +6043,7 @@
style) style)
(let* ([strings (let loop ([s message]) (let* ([strings (let loop ([s message])
(let ([m (regexp-match (let ([nl (string #\newline #\return)]) (let ([m (regexp-match #rxb"([^\n]*)[\n](.*)" s)])
(format "([^~a]*)[~a](.*)" nl nl))
s)])
(if m (if m
(cons (cadr m) (loop (caddr m))) (cons (cadr m) (loop (caddr m)))
(list s))))] (list s))))]
@ -6202,7 +6199,7 @@
(define (number->string* n) (define (number->string* n)
(let ([s (number->string n)]) (let ([s (number->string n)])
(regexp-replace "[.]([0-9][0-9][0-9])[0-9]*$" (regexp-replace #rxb"[.]([0-9][0-9][0-9])[0-9]*$"
s s
".\\1"))) ".\\1")))
@ -7282,7 +7279,7 @@
[(unix) [(unix)
;; Detect Xft by looking for a font with a space in front of its name: ;; Detect Xft by looking for a font with a space in front of its name:
(when (eq? x-has-xft? 'unknown) (when (eq? x-has-xft? 'unknown)
(set! x-has-xft? (ormap (lambda (s) (regexp-match #rx"^ " s)) (wx:get-face-list)))) (set! x-has-xft? (ormap (lambda (s) (regexp-match #rxb"^ " s)) (wx:get-face-list))))
(if x-has-xft? (if x-has-xft?
(case family (case family
[(system) " Sans"] [(system) " Sans"]
@ -7389,7 +7386,7 @@
(let ([load-one (let ([load-one
(lambda (str id %) (lambda (str id %)
(let ([m (with-handlers ([void (lambda (x) #f)]) (let ([m (with-handlers ([void (lambda (x) #f)])
(and (regexp-match "^[(].*[)]$" str) (and (regexp-match #rxb"^[(].*[)]$" str)
(read (open-input-string str))))]) (read (open-input-string str))))])
(if (and (list? m) (if (and (list? m)
(eq? 'lib (car m)) (eq? 'lib (car m))
@ -7579,7 +7576,7 @@
(let ([p (open-input-file filename)]) (let ([p (open-input-file filename)])
(port-count-lines! p) (port-count-lines! p)
(let ([p (cond (let ([p (cond
[(regexp-match-peek "^WXME01[0-9][0-9] ## " p) [(regexp-match-peek #rxb"^WXME01[0-9][0-9] ## " p)
(let ([t (make-object text%)]) (let ([t (make-object text%)])
(send t insert-file p 'standard) (send t insert-file p 'standard)
(close-input-port p) (close-input-port p)
@ -7590,7 +7587,7 @@
;; Wrap regexp check with `with-handlers' in case the file ;; Wrap regexp check with `with-handlers' in case the file
;; starts with non-text input ;; starts with non-text input
(when (with-handlers ([not-break-exn? (lambda (x) #f)]) (when (with-handlers ([not-break-exn? (lambda (x) #f)])
(regexp-match-peek "^#!" p)) (regexp-match-peek #rxb"^#!" p))
;; Throw away chars/specials up to eol, ;; Throw away chars/specials up to eol,
;; and continue if line ends in backslash ;; and continue if line ends in backslash
(let lloop ([prev #f]) (let lloop ([prev #f])

5
collects/mred/private/kernel.ss
View File

@ -1154,7 +1154,6 @@
on-event on-event
size-cache-invalid size-cache-invalid
copy copy
get-text!
get-text get-text
merge-with merge-with
split split
@ -1192,7 +1191,6 @@
on-event on-event
size-cache-invalid size-cache-invalid
copy copy
get-text!
get-text get-text
merge-with merge-with
split split
@ -1217,7 +1215,6 @@
on-event on-event
size-cache-invalid size-cache-invalid
copy copy
get-text!
get-text get-text
merge-with merge-with
split split
@ -1249,7 +1246,6 @@
on-event on-event
size-cache-invalid size-cache-invalid
copy copy
get-text!
get-text get-text
merge-with merge-with
split split
@ -1292,7 +1288,6 @@
on-event on-event
size-cache-invalid size-cache-invalid
copy copy
get-text!
get-text get-text
merge-with merge-with
split split