removed the dependency between the string-constants library and mrlib

svn: r8369

original commit: 2e3c05b14e0ca53bb6e10376252266834750fc8f

collects/mrlib/name-message.ss

@@ -1,22 +1,15 @@
+#lang scheme/gui
 
-(module name-message mzscheme
+;; min-w, min-h : number -> contract
-  (require (lib "string-constant.ss" "string-constants")
+;; determines if the widths and heights are suitable
-           (lib "class.ss")
+(define (min-w h) (flat-named-contract "draw-button-label-width" (lambda (w) (w . > . (- h (* 2 border-inset))))))
-           (lib "file.ss")
+(define (min-h w) (flat-named-contract "draw-button-label-height" (lambda (h) (h . > . (* 2 border-inset)))))
-           (lib "list.ss")
-           (lib "mred.ss" "mred")
-           (lib "contract.ss"))
 
-  ;; min-w, min-h : number -> contract
+(provide/contract
-  ;; determines if the widths and heights are suitable
-  (define (min-w h) (flat-named-contract "draw-button-label-width" (lambda (w) (w . > . (- h (* 2 border-inset))))))
-  (define (min-h w) (flat-named-contract "draw-button-label-height" (lambda (h) (h . > . (* 2 border-inset)))))
-  
-  (provide/contract
  [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%)
+(provide name-message%)
 
-  (define 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)))
+                         [(and paths (not (null? paths))) (last paths)]
-                            (car (last-pair 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))))
     
@@ -205,37 +202,37 @@
     (stretchable-width #f)
     (stretchable-height #f)))
 
-  (define (get-left-side-padding) (+ button-label-inset circle-spacer))
+(define (get-left-side-padding) (+ button-label-inset circle-spacer))
-  (define button-label-inset 1)
+(define button-label-inset 1)
-  (define black-color (make-object color% "BLACK"))
+(define black-color (make-object color% "BLACK"))
 
-  (define triangle-width 10)
+(define triangle-width 10)
-  (define triangle-height 14)
+(define triangle-height 14)
-  (define triangle-color (make-object color% 50 50 50))
+(define triangle-color (make-object color% 50 50 50))
 
-  (define border-inset 1)
+(define border-inset 1)
-  (define triangle-space 0)
+(define triangle-space 0)
-  (define circle-spacer 4)
+(define circle-spacer 4)
-  (define rrect-spacer 3)
+(define rrect-spacer 3)
 
-  (define (offset-color color offset-one)
+(define (offset-color color offset-one)
   (make-object color%
     (offset-one (send color red))
     (offset-one (send color green))
     (offset-one (send color blue))))
 
-  (define mouse-over-color (case (system-type)
+(define mouse-over-color (case (system-type)
                            [(macosx) "darkgray"]
                            [else (make-object color% 230 230 230)]))
-  (define mouse-grabbed-color (make-object color% 100 100 100))
+(define mouse-grabbed-color (make-object color% 100 100 100))
-  (define grabbed-fg-color (make-object color% 220 220 220))
+(define grabbed-fg-color (make-object color% 220 220 220))
 
-  (define (calc-button-min-sizes dc label button-label-font)
+(define (calc-button-min-sizes dc label button-label-font)
   (let-values ([(w h a d) (send dc get-text-extent label button-label-font)])
     (let-values ([(px py pw ph) (pad-xywh 0 0 w h)])
       (values pw ph))))
 
-  (define (pad-xywh tx ty tw th)
+(define (pad-xywh tx ty tw th)
   (let* ([ans-h
           (+ button-label-inset
              (max 0 
@@ -259,7 +256,7 @@
      ans-w
      ans-h)))
 
-  (define (draw-button-label dc label dx dy full-w h mouse-over? grabbed? button-label-font bkg-color)
+(define (draw-button-label dc label dx dy full-w h mouse-over? grabbed? button-label-font bkg-color)
   
   (define label-width
     (if label
@@ -331,4 +328,4 @@
               (+ dy (+ y off-y)))
         (loop (+ x-off 1) (+ off-y 1)))))
   
-    (void)))
+  (void))