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

...

Browse Source 
original commit: a508514ed08e010b0448438489afbda36cedb77d
This commit is contained in:
Robby Findler 2001-11-08 01:03:47 +00:00
parent 07143b8562
commit 42e5229de7
3 changed files with 29 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/framework/private/frame.ss
View File

@ -474,9 +474,9 @@
(field (macro-recording? #f))
(define (update-macro-recording-icon)
(unless (eq? (send macro-recording-panel is-shown?)
(unless (eq? (send macro-recording-message is-shown?)
macro-recording?)
(send macro-recording-panel show macro-recording?)))
(send macro-recording-message show macro-recording?)))
(define (set-macro-recording on?)
(set! macro-recording? on?)
(update-macro-recording-icon))
@ -541,16 +541,6 @@
(inherit get-info-panel)
(define macro-recording-panel
(instantiate horizontal-panel% ()
(parent (get-info-panel))
(stretchable-width #f)
(stretchable-height #f)
(style '(border))))
(instantiate message% ()
(label "c-x;(")
(parent macro-recording-panel))
[define anchor-message
(make-object message%
(let ([b (icon:get-anchor-bitmap)])
@ -565,6 +555,12 @@
[define position-canvas (make-object editor-canvas% (get-info-panel) #f '(no-hscroll no-vscroll))]
[define position-edit (make-object text%)]
(define macro-recording-message
(instantiate message% ()
(label "c-x;(")
(parent (get-info-panel))))
(inherit determine-width)
(let ([move-front
(lambda (x l)
@ -572,13 +568,15 @@
(send (get-info-panel) change-children
(lambda (l)
(move-front
anchor-message
macro-recording-message
(move-front
overwrite-message
anchor-message
(move-front
position-canvas
l))))))
(send macro-recording-panel show #f)
overwrite-message
(move-front
position-canvas
l)))))))
(send macro-recording-message show #f)
(send anchor-message show #f)
(send overwrite-message show #f)
(send* position-canvas

2
collects/framework/private/group.ss
View File

@ -89,7 +89,7 @@
(label (string-constant bring-frame-to-front...))
(parent menu)
(callback (lambda (x y) (choose-a-frame (send (send menu get-parent) get-frame))))
(shortcut #\b))
(shortcut #\h))
(make-object separator-menu-item% menu)
(for-each
(lambda (frame)

16
collects/hierlist/hierlist-unit.ss
View File

@ -163,7 +163,10 @@
[get-clickable-snip (lambda () snip)]
[get-editor (lambda () (send snip get-item-buffer))]
[is-selected? (lambda () (send (send snip get-editor) is-selected?))]
;; the `get-editor' method is overridden
[is-selected? (lambda () (send (get-editor) is-selected?))]
[select (lambda (on?) (send snip select on?))]
[scroll-to (lambda () (let* ([admin (send snip get-admin)]
[dc (send admin get-dc)]
@ -292,7 +295,7 @@
(hide-caret #t)
(set-max-undo-history 0)
(set-keymap item-keymap))))
;; Buffer for a compound list item (and the top-level list)
(define (make-hierarchical-list-text% super%)
(class100 super% (tp tp-select dpth parent-snp)
@ -350,12 +353,19 @@
(less-than? (send a get-item)
(send b get-item))))])
(begin-edit-sequence)
(for-each (lambda (child)
(when (is-a? child hierarchical-list-snip%)
(let ([ed (send child get-content-buffer)])
(when (is-a? ed hierarchical-list-text%)
(send ed sort less-than?)))))
children)
(erase)
(let ([to-scroll-to #f])
(for-each
(lambda (s)
(unless to-scroll-to
(when (send (send s get-item) is-selected?)
(when (and (is-a? (send s get-item) hierarchical-list-item<%>)
(send (send s get-item) is-selected?))
(set! to-scroll-to s)))
(unless (is-a? s hierarchical-list-snip%)
(insert (make-whitespace)))