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

..

Browse Source 
original commit: a6ad08b9da43d70a1f9624af938dc522bb1080ce
This commit is contained in:
Robby Findler 2003-01-07 17:35:38 +00:00
parent 6cf7e741a5
commit c5960208a5
7 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/framework/private/autosave.ss
View File

@ -244,7 +244,7 @@
(format (string-constant autosave-error-deleting)
autosave-file
(if (exn? exn)
(exn-message exn)
(format "~a" (exn-message exn))
(format "~s" exn))))
#f)])
(delete-file autosave-file)

6
collects/framework/private/editor.ss
View File

@ -108,7 +108,9 @@
(let ([sp (open-output-string)])
(parameterize ([current-output-port sp])
((error-display-handler)
(if (exn? exn) (exn-message exn) (format "uncaught exn: ~s" exn))
(if (exn? exn)
(format "~a" (exn-message exn))
(format "uncaught exn: ~s" exn))
exn))
(get-output-string sp)))
@ -501,7 +503,7 @@
(string-constant autosaving-turned-off)
"\n\n"
(if (exn? exn)
(exn-message exn)
(format "~a" (exn-message exn))
(format "~s" exn)))
#f
'(caution ok)))

8
collects/framework/private/frame.ss
View File

@ -253,19 +253,19 @@
(define/override (on-paint)
(let* ([dc (get-dc)]
[draw
(lambda (str bg-color bg-style line-color)
(lambda (str bg-color bg-style line-color line-style)
(send dc set-font lock-canvas-font)
(let-values ([(w h) (get-client-size)]
[(tw th ta td) (send dc get-text-extent str)])
(send dc set-pen (send the-pen-list find-or-create-pen line-color 1 'solid))
(send dc set-pen (send the-pen-list find-or-create-pen line-color 1 line-style))
(send dc set-brush (send the-brush-list find-or-create-brush bg-color bg-style))
(send dc draw-rectangle 0 0 w h)
(send dc draw-text str
(- (/ w 2) (/ tw 2))
(- (/ h 2) (/ th 2)))))])
(if locked?
(draw locked-message "yellow" 'solid "black")
(draw unlocked-message (get-panel-background) 'panel (get-panel-background)))))
(draw locked-message "yellow" 'solid "black" 'solid)
(draw unlocked-message (get-panel-background) 'panel (get-panel-background) 'transparent))))
(inherit get-parent min-width min-height stretchable-width stretchable-height)
(super-instantiate ())
(let ([dc (get-dc)])

4
collects/framework/private/handler.ss
View File

@ -120,7 +120,9 @@
(or filename
(string-constant unknown-filename)))
"\n\n"
(if (exn? exn) (exn-message exn) (format "~s" exn))))
(if (exn? exn)
(format "~a" (exn-message exn))
(format "~s" exn))))
#f)])
(gui-utils:show-busy-cursor
(lambda ()

1
collects/framework/private/main.ss
View File

@ -73,6 +73,7 @@
define-syntax-set
define-values
define/public define/override define/private define/field
define/override-final define/public-final
define-signature
define-syntax define-syntaxes
define-schema define/contract))

1
collects/framework/private/panel.ss
View File

@ -2,7 +2,6 @@
(module panel mzscheme
(require (lib "unitsig.ss")
(lib "class.ss")
(lib "class100.ss")
"sig.ss"
"../macro.ss"
(lib "mred-sig.ss" "mred")

2
collects/framework/private/preferences.ss
View File

@ -63,7 +63,7 @@
(raise exn)))
(message-box (format (string-constant error-unmarshalling) p)
(if (exn? exn)
(exn-message exn)
(format "~a" (exn-message exn))
(format "~s" exn)))))))))
;; get-callbacks : sym -> (listof (-> void))