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

.

Browse Source 
original commit: 0ae0ef8d3f250dd89aca0f6008ce53e9f8b68986
This commit is contained in:
Matthew Flatt 2000-08-14 16:50:37 +00:00
parent 49889f6d06
commit 1af7704e7b
1 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/mred/wrap/mred.ss
View File

@ -4539,6 +4539,11 @@
(define box-width 300) (define box-width 300)
(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&
(let ([re (regexp "&")])
(lambda (s)
(regexp-replace* re s "\\&\\&"))))
(define message-box (define message-box
(case-lambda (case-lambda
[(title message) (message-box title message #f '(ok))] [(title message) (message-box title message #f '(ok))]
@ -4561,7 +4566,7 @@
(if (and (< (length strings) 10) (andmap (lambda (s) (< (string-length s) 60)) strings)) (if (and (< (length strings) 10) (andmap (lambda (s) (< (string-length s) 60)) strings))
(begin (begin
(send f set-alignment (if (= (length strings) 1) 'center 'left) 'center) (send f set-alignment (if (= (length strings) 1) 'center 'left) 'center)
(for-each (lambda (s) (make-object message% s f)) strings) (for-each (lambda (s) (make-object message% (protect& s) f)) strings)
(send f stretchable-width #f) (send f stretchable-width #f)
(send f stretchable-height #f)) (send f stretchable-height #f))
(let* ([e (make-object text%)] (let* ([e (make-object text%)]
@ -4818,8 +4823,8 @@
[__ (when message [__ (when message
(let ([p (make-object vertical-pane% f)]) (let ([p (make-object vertical-pane% f)])
(send p stretchable-height #f) (send p stretchable-height #f)
(make-object message% message p)))] (make-object message% (protect& message) p)))]
[m (make-object message% dir f)] [m (make-object message% (protect& dir) f)]
[lp (make-object horizontal-pane% f)] [lp (make-object horizontal-pane% f)]
[dirs (make-object list-box% #f null lp (lambda (d e) [dirs (make-object list-box% #f null lp (lambda (d e)
(when (eq? (send e get-event-type) 'list-box-dclick) (when (eq? (send e get-event-type) 'list-box-dclick)
@ -4881,7 +4886,7 @@
(begin (begin
(unless directory (unless directory
(set! last-visted-directory dir)) (set! last-visted-directory dir))
dir) (protect& dir))
(string-append "BAD DIRECTORY: " dir))) (string-append "BAD DIRECTORY: " dir)))
(send dir-text set-value dir) (send dir-text set-value dir)
(let ([l (with-handlers ([void (lambda (x) null)]) (let ([l (with-handlers ([void (lambda (x) null)])