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

.

Browse Source 
original commit: 81c3805bbb57ee65f2632d1856df8ab73feb01c0
This commit is contained in:
Matthew Flatt 2004-11-11 15:36:17 +00:00
parent 5a661d73dc
commit 864b560cf4
3 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mred/mred.ss
View File

@ -2062,6 +2062,12 @@
(on-paint)
(send dc set-clipping-region #f)))))))
(define/public (set-label i s)
(set-car! (list-tail tabs i) (wx:label->plain-label s))
(set! tab-widths #f)
(set! regions #f)
(on-paint))
(define -append
(entry-point
(lambda (s)
@ -5380,7 +5386,12 @@
(if (= p i)
(cdr l)
(cons (car l) (loop (add1 p) (cdr l))))))
(as-exit (lambda () (send (mred->wx tabs) delete i)))))])
(as-exit (lambda () (send (mred->wx tabs) delete i)))))]
[set-item-label (entry-point
(lambda (i s)
(check-item 'set-item-label i)
(check-label-string '(method tab-panel% set-item-label) s)
(as-exit (lambda () (send (mred->wx tabs) set-label i s)))))])
(private
[check-item

1
collects/mred/private/kernel.ss
View File

@ -1435,6 +1435,7 @@
basic-style)
(define-function get-the-style-list)
(define-class tab-group% item% #f
set-label
delete
append
enable

10
collects/tests/mred/item.ss
View File

@ -1941,10 +1941,12 @@
(set! count (add1 count))))
(make-object button% "Delete" p2 (lambda (b e)
(send p delete 0)))
(make-object button% "Set First" p2 (lambda (b e)
(send p set-selection 0)))
(make-object button% "Set Last" p2 (lambda (b e)
(send p set-selection (sub1 (send p get-number)))))
(make-object button% "First" p2 (lambda (b e)
(send p set-selection 0)))
(make-object button% "Last" p2 (lambda (b e)
(send p set-selection (sub1 (send p get-number)))))
(make-object button% "Rename" p2 (lambda (b e)
(send p set-item-label (quotient (send p get-number) 2) "Do&nut")))
(when no-border?
(make-object button% "Toggle" p2 (lambda (b e)
(if on?