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

removed the dependency between the string-constants library and mrlib

Browse Source 
svn: r8369

original commit: 2e3c05b14e0ca53bb6e10376252266834750fc8f
This commit is contained in:
Robby Findler 2008-01-19 20:13:02 +00:00
parent bb5c1e5528
commit 2ef8d09762
1 changed files with 322 additions and 325 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/mrlib/name-message.ss
View File

@ -1,11 +1,4 @@
(module name-message mzscheme
(require (lib "string-constant.ss" "string-constants")
(lib "class.ss")
(lib "file.ss")
(lib "list.ss")
(lib "mred.ss" "mred")
(lib "contract.ss"))
#lang scheme/gui
;; min-w, min-h : number -> contract
;; determines if the widths and heights are suitable
@ -16,7 +9,7 @@
[get-left-side-padding (-> number?)]
(pad-xywh (number? number? (>=/c 0) (>=/c 0) . -> . (values number? number? (>=/c 0) (>=/c 0))))
(draw-button-label
(->r ([dc (is-a?/c dc<%>)]
(->d ([dc (is-a?/c dc<%>)]
[label (union false/c string?)]
[x number?]
[y number?]
@ -26,16 +19,21 @@
[grabbed? boolean?]
[button-label-font (is-a?/c font%)]
[bkg-color (or/c false/c (is-a?/c color%) string?)])
void?))
()
[result void?]))
(calc-button-min-sizes
(->* ((is-a?/c dc<%>) string? (is-a?/c font%))
(number? number?))))
()
(values number? number?))))
(provide name-message%)
(define name-message%
(class canvas%
(init-field [string-constant-untitled "Untitled"]
[string-constant-no-full-name-since-not-saved
"The file does not have a full name because it has not yet been saved."])
(inherit popup-menu get-dc get-size get-client-size min-width min-height
stretchable-width stretchable-height
get-top-level-window refresh)
@ -56,7 +54,7 @@
(define paths #f)
;; label : string
(init-field [label (string-constant untitled)]
(init-field [label string-constant-untitled]
[font small-control-font])
(define full-name-window #f)
@ -77,10 +75,9 @@
(map path->string (explode-path (normalize-path path-name)))
#f))
(let ([new-label (cond
[(and paths (not (null? paths)))
(car (last-pair paths))]
[(and paths (not (null? paths))) (last paths)]
[path-name path-name]
[else (string-constant untitled)])])
[else string-constant-untitled])])
(unless (equal? label new-label)
(set! label new-label)
(set! to-draw-message #f)
@ -99,7 +96,7 @@
(on-choose-directory (apply build-path (reverse paths)))))
(loop (cdr paths))]))
(let ([i (make-object menu-item%
(string-constant no-full-name-since-not-saved)
string-constant-no-full-name-since-not-saved
menu void)])
(send i enable #f))))
@ -331,4 +328,4 @@
(+ dy (+ y off-y)))
(loop (+ x-off 1) (+ off-y 1)))))
(void)))
(void))