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

removed prefix from mred:wx signature

Browse Source 
original commit: da714820161ba99528cc02e9f443fdbb6d82356b
This commit is contained in:
Robby Findler 1997-04-27 19:10:01 +00:00
parent 7914fdde96
commit 749685795f
6 changed files with 35 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/mred/edit.ss
View File

@ -1,6 +1,6 @@
(unit/sig mred:edit^
(import [wx : mred:wx^]
(import mred:wx^
[mred:constants : mred:constants^]
[mred:connections : mred:connections^]
[mred:autosave : mred:autosave^]
@ -66,7 +66,7 @@
(public
[set-max-width
(lambda (x)
(mred:debug:printf 'rewrap "set-max-width: ~a" x)
(mred:debug:printf 'rewrap "rewrap: set-max-width: ~a" x)
(super-set-max-width x))]
[get-file (lambda (d)
(let ([v (mred:finder:get-file d)])
@ -81,38 +81,38 @@
[auto-set-wrap? (mred:preferences:get-preference 'mred:auto-set-wrap?)]
[set-auto-set-wrap
(lambda (v)
(mred:debug:printf 'rewrap "set-auto-set-wrap: ~a" v)
(mred:debug:printf 'rewrap
"rewrap: set-auto-set-wrap: ~a (canvases ~a)"
v canvases)
(set! auto-set-wrap? v)
(for-each (lambda (c) (send c resize-edit)) canvases))]
[rewrap
(let ([do-wrap
(lambda (new-width)
(let ([current-width (get-max-width)])
(mred:debug:printf 'rewrap "do-wrap: new-width ~a current-width ~a" new-width current-width)
(when (and (not (= current-width new-width))
(< 0 new-width))
(set-max-width new-width)
(mred:debug:printf 'rewrap "attempted to wrap to: ~a actually wrapped to ~a"
new-width (get-max-width)))))])
(lambda ()
(if auto-set-wrap?
(let* ([w-box (box 0)]
[h-box (box 0)]
[update-box
(lambda ()
(send (get-admin)
get-view null null
w-box h-box))])
(do-wrap
(mzlib:function:foldl
(lambda (canvas sofar)
(begin
(send canvas call-as-primary-owner update-box)
(max (unbox w-box) sofar)))
0
canvases)))
(do-wrap 0))))]
(lambda ()
(if auto-set-wrap?
(let* ([current-width (get-max-width)]
[w-box (box 0)]
[new-width
(mzlib:function:foldl
(lambda (canvas sofar)
(send canvas call-as-primary-owner
(lambda ()
(send (get-admin)
get-view null null
w-box (box 0))))
(max (unbox w-box) sofar))
0
canvases)])
(mred:debug:printf 'rewrap "rewrap: new-width ~a current-width ~a"
new-width current-width)
(when (and (not (= current-width new-width))
(< 0 new-width))
(set-max-width new-width)
(mred:debug:printf 'rewrap "rewrap: attempted to wrap to: ~a actually wrapped to ~a"
new-width (get-max-width))))
(begin
(mred:debug:printf 'rewrap "rewrap: wrapping to -1")
(set-max-width -1))))]
[mode #f]
[set-mode-direct (lambda (v) (set! mode v))]
[set-mode

2
collects/mred/exit.ss
View File

@ -1,6 +1,6 @@
(unit/sig mred:exit^
(import [wx : mred:wx^]
(import mred:wx^
[mred:constants : mred:constants^]
[mred:preferences : mred:preferences^]
[mred:gui-utils : mred:gui-utils^])

2
collects/mred/finder.ss
View File

@ -1,6 +1,6 @@
(unit/sig mred:finder^
(import [wx : mred:wx^]
(import mred:wx^
[mred:constants : mred:constants^]
[mred:container : mred:container^]
[mred:preferences : mred:preferences^]

2
collects/mred/keys.ss
View File

@ -1,6 +1,6 @@
(unit/sig mred:keymap^
(import [wx : mred:wx^]
(import mred:wx^
[mred:constants : mred:constants^]
[mred:preferences : mred:preferences^]
[mred:exit : mred:exit^]

2
collects/mred/panel.ss
View File

@ -1,6 +1,6 @@
(unit/sig mred:panel^
(import [wx : mred:wx^]
(import mred:wx^
[mred:constants : mred:constants^]
[mred:container : mred:container^]
[mred:canvas : mred:canvas^]

2
collects/mred/prefs.ss
View File

@ -1,7 +1,7 @@
;; need a preference for pconvert
(unit/sig mred:preferences^
(import [wx : mred:wx^]
(import mred:wx^
[mred:constants : mred:constants^]
[mred:exn : mred:exn^]
[mred : mred:container^] ;; warning -- to use the mred:panel macros,