pkg/gui: fixes for label widths

This commit is contained in:
Matthew Flatt 2013-04-25 06:13:39 -06:00
parent 306194e9fa
commit ab9caeb05c
3 changed files with 18 additions and 5 deletions

View File

@ -160,7 +160,9 @@
(define install-button
(new button%
[label (string-constant install-pkg-install)]
[label (pick-wider normal-control-font
(string-constant install-pkg-install)
(string-constant install-pkg-update))]
[parent button-line]
[style '(border)]
[callback (lambda (b e)
@ -379,7 +381,8 @@
(send status-text set-label default-status))))
(define/private (->label-string s)
(substring s 0 (min 200 (string-length s))))
(let ([s (regexp-replace* #rx"[\r\n]+" s " ")])
(substring s 0 (min 200 (string-length s)))))
(define pkgs '#())
(define tagss #(hash))

View File

@ -9,7 +9,8 @@
pkg
racket/list
framework
net/url)
net/url
"common.rkt")
(provide by-source-panel%)
@ -105,7 +106,9 @@
(define ok-button
(new button%
[label sc-install-pkg-install]
[label (pick-wider normal-control-font
sc-install-pkg-install
sc-install-pkg-update)]
[parent button-panel]
[style '(border)]
[callback (lambda (b e)

View File

@ -5,7 +5,8 @@
racket/format)
(provide really-remove?
sc-install-pkg-remove)
sc-install-pkg-remove
pick-wider)
(define sc-install-pkg-remove (string-constant install-pkg-remove))
(define really-uninstall?-msg (string-constant install-pkg-really-remove?))
@ -23,3 +24,9 @@
parent
'(caution default=1))))
(define (pick-wider font a b)
(define-values (wa ha) (get-window-text-extent a font))
(define-values (wb hb) (get-window-text-extent b font))
(if (wa . > . wb)
a
b))