hans/ellipsis-msg
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ok

Browse Source
This commit is contained in:
Hans Dijkema
2025-08-08 00:00:45 +02:00
parent 05e954ba1d
commit e89d82ca08
1 changed files with 12 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
main.rkt
View File

@@ -19,19 +19,19 @@
(lambda (w h) w)))) (lambda (w h) w))))
;(printf "label: ~a, max-w: ~a, w: ~a\n" l w ext) ;(printf "label: ~a, max-w: ~a, w: ~a\n" l w ext)
(if (or (< w 10) (<= ext w) (string=? l "")) (if (or (< w 10) (<= ext w) (string=? l ""))
l (if (eq? ellipsis 'right)
(string-append (str:string-drop-right l 3) "...")
(string-append "..." (str:string-drop l 3)))
(let* ((factor (/ w ext)) (let* ((factor (/ w ext))
(strl (string-length l)) (strl (string-length l))
(n-strl (round (* strl factor))) (n-strl (round (* strl factor)))
(drop (- strl n-strl))) (drop (- strl n-strl)))
(when (= drop 0) (when (= drop 0)
(set! drop 1)) (set! drop 1))
(if (eq? ellipsis 'right) (if (eq? ellipsis 'left)
(let ((nl (str:string-drop l drop))) (let ((nl (str:string-drop l drop)))
;(printf "new-try ~a\n" nl)
(ellipsize w (str:string-drop l drop))) (ellipsize w (str:string-drop l drop)))
(let ((nl (str:string-drop-right l drop))) (let ((nl (str:string-drop-right l drop)))
;(printf "new-try ~a\n" nl)
(ellipsize w (str:string-drop-right l drop)))))))) (ellipsize w (str:string-drop-right l drop))))))))
(define/override (set-label l . resize) (define/override (set-label l . resize)
@@ -60,11 +60,11 @@
my_label) my_label)
)) ))
;(define win (new frame% [label "Hi there!"])) (define win (new frame% [label "Hi there!"]))
;(define hp1 (new horizontal-pane% [parent win])) (define hp1 (new horizontal-pane% [parent win]))
;(define btn1 (new button% [label "Longer 1"] [parent hp1] [callback (lambda (b e) (send lbl1 set-label "This is a very long text, yes a longer text than we initial put"))])) (define btn1 (new button% [label "Longer 1"] [parent hp1] [callback (lambda (b e) (send lbl1 set-label "This is a very long text, yes a longer text than we initial put"))]))
;(define lbl1 (new ellipsis-msg% [label "This is an ellipsis label"] [parent hp1] [ellipsis 'right])) (define lbl1 (new ellipsis-msg% [label "This is an ellipsis label"] [parent hp1] [ellipsis 'right]))
;(define hp2 (new horizontal-pane% [parent win])) (define hp2 (new horizontal-pane% [parent win]))
;(define btn2 (new button% [label "Longer 2"] [parent hp2] [callback (lambda (b e) (send lbl2 set-label "This is a very long second text, yes a longer text than we initial put"))])) (define btn2 (new button% [label "Longer 2"] [parent hp2] [callback (lambda (b e) (send lbl2 set-label "This is a very long second text, yes a longer text than we initial put"))]))
;(define lbl2 (new ellipsis-msg% [label "This is an ellipsis label"] [parent hp2] [ellipsis 'left])) (define lbl2 (new ellipsis-msg% [label "This is an ellipsis label"] [parent hp2] [ellipsis 'left]))
;(send win show #t) (send win show #t)