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

implemented status panel

Browse Source 
original commit: 9aee794c7228c64d59df9c0fee14331fccd8f743
This commit is contained in:
Robby Findler 1997-06-02 21:33:47 +00:00
parent 5698736743
commit ca4d9ab51e
2 changed files with 30 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/mred/edit.ss
View File

@ -624,11 +624,25 @@
[super-on-edit-sequence on-edit-sequence]
[super-after-insert after-insert]
[super-after-delete after-delete]
[super-lock lock])
[super-lock lock]
[super-set-overwrite-mode set-overwrite-mode]
[super-set-anchor set-anchor])
(private
[edit-sequence-depth 0]
[position-needs-updating #f]
[lock-needs-updating #f]
[anchor-needs-updating #f]
[overwrite-needs-updating #f]
[maybe-update-anchor
(lambda ()
(if (= edit-sequence-depth 0)
(send (get-frame) anchor-status-changed)
(set! anchor-needs-updating #t)))]
[maybe-update-overwrite
(lambda ()
(if (= edit-sequence-depth 0)
(send (get-frame) overwrite-status-changed)
(set! overwrite-needs-updating #t)))]
[maybe-update-lock-icon
(lambda ()
(if (= edit-sequence-depth 0)
@ -644,6 +658,14 @@
(send (get-frame) edit-position-changed))])
(public
[set-anchor
(lambda (x)
(super-set-anchor x)
(maybe-update-anchor))]
[set-overwrite-mode
(lambda (x)
(super-set-overwrite-mode x)
(maybe-update-overwrite))]
[lock
(lambda (x)
(super-lock x)
@ -664,6 +686,12 @@
(lambda ()
(set! edit-sequence-depth (sub1 edit-sequence-depth))
(when (= 0 edit-sequence-depth)
(when anchor-needs-updating
(set! anchor-needs-updating #f)
(send (get-frame) overwrite-status-changed))
(when lock-needs-updating
(set! lock-needs-updating #f)
(send (get-frame) anchor-status-changed))
(when position-needs-updating
(set! position-needs-updating #f)
(update-position-edit))

2
collects/mred/prefs.ss
View File

@ -286,7 +286,7 @@
(lambda (x) (eq? x 'std)))
;; sleep is not effecient, so we wait for the next release to turn this on.
'(make-check 'mred:status-line "Show clock?" id id)
(make-check 'mred:show-status-line "Show status-line?" id id)
(make-check 'mred:verify-exit "Verify exit?" id id)
(make-check 'mred:verify-change-format "Ask before changing save format?" id id)