v3.99.0.2

svn: r7706

original commit: 39cedb62edf9258b051a22a29a90be9c6841956f
This commit is contained in:
Matthew Flatt 2007-11-13 12:40:00 +00:00
parent 6ce4395e05
commit 8bc1d1c68c
146 changed files with 523 additions and 493 deletions

View File

@ -1,4 +1,4 @@
(module info (lib "infotab.ss" "setup")
(module info setup/infotab
(define name "Embedded GUI")
(define doc.txt "doc.txt"))

View File

@ -1,4 +1,5 @@
(module application (lib "a-unit.ss")
#lang scheme/unit
(require "sig.ss")
(import)
@ -11,4 +12,4 @@
(unless (string? x)
(error 'current-app-name
"the app name must be a string"))
x))))
x)))

View File

@ -1,5 +1,6 @@
(module autosave (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
(lib "file.ss")
"sig.ss"
@ -312,4 +313,4 @@
(delete-file autosave-name)
(when tmp-name
(delete-file tmp-name))
orig-name))))))
orig-name)))))

View File

@ -1,4 +1,4 @@
(module canvas (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
"sig.ss"
"../preferences.ss"
@ -178,4 +178,4 @@
(define -color% (color-mixin basic%))
(define info% (info-mixin basic%))
(define delegate% (delegate-mixin basic%))
(define wide-snip% (wide-snip-mixin basic%)))
(define wide-snip% (wide-snip-mixin basic%))

View File

@ -1,4 +1,4 @@
(module color-model (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
"sig.ss"
(lib "mred-sig.ss" "mred")
@ -265,4 +265,3 @@
;; (print-struct #t)
;; (xyz->luv (make-xyz 95.0 100.0 141.0))
;; (xyz->luv (make-xyz 60.0 80.0 20.0))
)

View File

@ -1,4 +1,4 @@
(module color-prefs (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
(lib "etc.ss")
(lib "mred.ss" "mred")
@ -482,4 +482,4 @@
[(is-a? old style-delta%)
(send old set-delta-foreground color)
(preferences:set p old)])))
color-scheme-colors)))
color-scheme-colors))

View File

@ -1,4 +1,4 @@
(module color (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
(lib "thread.ss")
(lib "mred.ss" "mred")
@ -724,4 +724,4 @@
(super-new)))
(define text-mode% (text-mode-mixin mode:surrogate-text%)))
(define text-mode% (text-mode-mixin mode:surrogate-text%))

View File

@ -1,5 +1,6 @@
(module comment-box (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
(lib "etc.ss")
(lib "mred.ss" "mred")
@ -121,4 +122,4 @@
(make-special-comment "comment"))
(super-instantiate ())
(inherit set-snipclass)
(set-snipclass snipclass))))
(set-snipclass snipclass)))

View File

@ -1,5 +1,5 @@
(module editor (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
(lib "string-constant.ss" "string-constants")
"sig.ss"
@ -598,4 +598,4 @@
(set! callback-running? #f))
#f))))
'framework:update-lock-icon))
(super-new))))
(super-new)))

View File

@ -1,4 +1,5 @@
(module exit (lib "a-unit.ss")
#lang scheme/unit
(require (lib "string-constant.ss" "string-constants")
"sig.ss"
"../preferences.ss"
@ -72,4 +73,4 @@
(exit)
(set! is-exiting? #f)))]
[else
(set! is-exiting? #f)])))
(set! is-exiting? #f)]))

View File

@ -1,5 +1,5 @@
(module finder (lib "a-unit.ss")
#lang scheme/unit
(require (lib "string-constant.ss" "string-constants")
"sig.ss"
"../preferences.ss"
@ -100,4 +100,4 @@
(apply (case (preferences:get 'framework:file-dialogs)
[(std) std-get-file]
[(common) common-get-file])
args))))
args)))

View File

@ -1,4 +1,4 @@
(module frame (lib "a-unit.ss")
#lang scheme/unit
(require (lib "string-constant.ss" "string-constants")
(lib "class.ss")
(lib "include.ss")
@ -2526,4 +2526,4 @@
(define searchable% (searchable-text-mixin (searchable-mixin -text%)))
(define delegate% (delegate-mixin searchable%))
(define -pasteboard% (pasteboard-mixin open-here%)))
(define -pasteboard% (pasteboard-mixin open-here%))

View File

@ -1,5 +1,5 @@
(module group (lib "a-unit.ss")
#lang scheme/unit
(require (lib "string-constant.ss" "string-constants")
(lib "class.ss")
"sig.ss"
@ -341,4 +341,4 @@
(internal-get-the-frame-group)))
(define (get-the-frame-group)
(internal-get-the-frame-group)))
(internal-get-the-frame-group))

View File

@ -1,5 +1,5 @@
(module handler (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
(lib "list.ss")
(lib "hierlist.ss" "hierlist")
@ -200,14 +200,18 @@
;; updates the recent menu preferences
;; with the positions `start' and `end'
(define (set-recent-position filename start end)
(let ([recent-items
(filter (λ (x) (string=? (path->string (car x))
(path->string filename)))
(preferences:get 'framework:recently-opened-files/pos))])
(unless (null? recent-items)
(let ([recent-item (car recent-items)])
(set-car! (cdr recent-item) start)
(set-car! (cddr recent-item) end)))))
(let* ([recent-items
(preferences:get 'framework:recently-opened-files/pos)]
[new-recent-items
(map (λ (x)
(if (string=? (path->string (car x))
(path->string filename))
(list* (car x) start end (cdddr x))
x))
(preferences:get 'framework:recently-opened-files/pos))])
(unless (equal? recent-items new-recent-items)
(preferences:set 'framework:recently-opened-files/pos
new-recent-items))))
;; install-recent-items : (is-a?/c menu%) -> void?
(define (install-recent-items menu)
@ -389,4 +393,4 @@
(send *open-directory*
set-from-file! file))
(and file
(edit-file file)))))
(edit-file file))))

View File

@ -1,4 +1,4 @@
(module icon (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
(lib "include-bitmap.ss" "mrlib")
"bday.ss"
@ -69,4 +69,4 @@
(force
(if (mrf-bday?)
mrf-off-bitmap
gc-off-bitmap))))
gc-off-bitmap)))

View File

@ -1,5 +1,6 @@
(module keymap (lib "a-unit.ss")
#lang scheme/unit
(require (lib "string-constant.ss" "string-constants")
(lib "class.ss")
(lib "list.ss")
@ -1404,4 +1405,4 @@
(λ (keymap)
(send keymap chain-to-keymap global #t)
(ctki keymap))])
(thunk)))))
(thunk))))

View File

@ -1,4 +1,4 @@
(module main (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
"sig.ss"
"../preferences.ss"
@ -298,6 +298,3 @@
;(preferences:set 'framework:file-dialogs 'std)
;; setup the color scheme stuff
(void))

View File

@ -1,4 +1,4 @@
(module menu (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
"sig.ss"
"../preferences.ss"
@ -45,4 +45,4 @@
(define can-restore-menu-item% (can-restore-mixin menu-item%))
(define can-restore-checkable-menu-item% (can-restore-mixin checkable-menu-item%))
(define can-restore-underscore-menu% (can-restore-underscore-mixin menu%)))
(define can-restore-underscore-menu% (can-restore-underscore-mixin menu%))

View File

@ -1,4 +1,4 @@
(module mode (lib "a-unit.ss")
#lang scheme/unit
(require (lib "surrogate.ss")
(lib "class.ss")
"sig.ss")
@ -47,4 +47,4 @@
(augment #t can-set-size-constraint? ())
(override can-do-edit-operation? (op) (op recursive?))
(augment #t can-load-file? (filename format))
(augment #t can-save-file? (filename format)))))
(augment #t can-save-file? (filename format))))

View File

@ -1,5 +1,6 @@
(module number-snip (lib "a-unit.ss")
#lang scheme/unit
(require "sig.ss"
(lib "mred-sig.ss" "mred")
(lib "class.ss")
@ -515,4 +516,4 @@
(define (hash-table-bound? ht key)
(let/ec k
(hash-table-get ht key (λ () (k #f)))
#t)))
#t))

View File

@ -1,5 +1,5 @@
(module panel (lib "a-unit.ss")
#lang scheme/unit
(require (lib "class.ss")
"sig.ss"
(lib "mred-sig.ss" "mred")
@ -267,10 +267,10 @@
[(and gap (send evt button-down? 'left))
(set! resizing-dim (event-get-dim evt))
(set! resizing-gap gap)]
[(and resizing-dim (send evt button-up?))
[(send evt button-up? 'left)
(set! resizing-dim #f)
(set! resizing-gap #f)]
[(and resizing-dim (send evt moving?))
[(and resizing-dim resizing-gap (send evt moving?))
(let-values ([(width height) (get-client-size)])
(let* ([before-percentage (gap-before-percentage resizing-gap)]
[orig-before (percentage-% before-percentage)]
@ -419,5 +419,5 @@
(define vertical-dragable% (vertical-dragable-mixin (dragable-mixin vertical-panel%)))
(define horizontal-dragable% (horizontal-dragable-mixin (dragable-mixin horizontal-panel%))))
(define horizontal-dragable% (horizontal-dragable-mixin (dragable-mixin horizontal-panel%)))

View File

@ -1,4 +1,4 @@
(module pasteboard (lib "a-unit.ss")
#lang scheme/unit
(require "sig.ss"
(lib "mred-sig.ss" "mred"))
@ -14,4 +14,4 @@
(define -keymap% (editor:keymap-mixin standard-style-list%))
(define file% (editor:file-mixin -keymap%))
(define backup-autosave% (editor:backup-autosave-mixin file%))
(define info% (editor:info-mixin backup-autosave%)))
(define info% (editor:info-mixin backup-autosave%))

View File

@ -1,4 +1,4 @@
(module path-utils (lib "a-unit.ss")
#lang scheme/unit
(require "sig.ss"
(lib "mred-sig.ss" "mred"))
@ -54,5 +54,5 @@
[(eq? (system-type) 'windows)
(build-path base (bytes->path-element (bytes-append name-bytes #".bak")))]
[else
(build-path base (bytes->path-element (bytes-append name-bytes #"~")))]))))))
(build-path base (bytes->path-element (bytes-append name-bytes #"~")))])))))

View File

@ -26,7 +26,8 @@ the state transitions / contracts are:
|#
(module preferences (lib "a-unit.ss")
#lang scheme/unit
(require (lib "string-constant.ss" "string-constants")
(lib "class.ss")
(lib "file.ss")
@ -132,7 +133,7 @@ the state transitions / contracts are:
(add-to-existing-children
titles
make-panel
(λ (new-subtree) (set! ppanels (cons new-subtree ppanels))))))
(λ (new-ppanels) (set! ppanels new-ppanels)))))
;; add-to-existing-children : (listof string) (panel -> panel) (ppanel -> void)
;; adds the child specified by the path in-titles to the tree.
@ -143,7 +144,7 @@ the state transitions / contracts are:
[banger banger])
(cond
[(null? children)
(banger (build-new-subtree (cons title titles) make-panel))]
(banger (list (build-new-subtree (cons title titles) make-panel)))]
[else
(let ([child (car children)])
(if (string=? (ppanel-name child) title)
@ -157,19 +158,17 @@ the state transitions / contracts are:
(ppanel-interior-children child)
(car titles)
(cdr titles)
(λ (x)
(λ (children)
(set-ppanel-interior-children!
(cons
x
(ppanel-interior-children child)))))])
child
children)))])
(loop
(cdr children)
title
titles
(λ (x)
(set-cdr! children
(cons x (cdr children)))))))])))
(λ (children)
(banger (cons child children))))))])))
;; build-new-subtree : (cons string (listof string)) (panel -> panel) -> ppanel
(define (build-new-subtree titles make-panel)
(let loop ([title (car titles)]
@ -641,4 +640,4 @@ the state transitions / contracts are:
main))))
(set! local-add-font-panel void))
(define (add-font-panel) (local-add-font-panel)))
(define (add-font-panel) (local-add-font-panel))

View File

@ -1,7 +1,7 @@
;; originally by Dan Grossman
;; 6/30/95
(module scheme (lib "a-unit.ss")
#lang scheme/unit
(require "collapsed-snipclass-helpers.ss"
(lib "string-constant.ss" "string-constants")
(lib "class.ss")
@ -1757,23 +1757,27 @@
(send text change-style sd 0 (send text last-position))))
(define (update-pref sel x)
(let ([pref (preferences:get 'framework:tabify)])
(set-car! (sel pref) x)
(preferences:set 'framework:tabify pref)))
(let ([pref
(let loop ([pref pref][sel sel])
(if (zero? sel)
(cons sel (cdr pref))
(cons (car pref) (loop (cdr pref) (sub1 sel)))))])
(preferences:set 'framework:tabify pref))))
(define-values (begin-list-box begin-regexp-text)
(make-column "Begin"
'begin
begin-keywords
(λ (x) (update-pref cdr x))))
(λ (x) (update-pref 1 x))))
(define-values (define-list-box define-regexp-text)
(make-column "Define"
'define
define-keywords
(λ (x) (update-pref cddr x))))
(λ (x) (update-pref 2 x))))
(define-values (lambda-list-box lambda-regexp-text)
(make-column "Lambda"
'lambda
lambda-keywords
(λ (x) (update-pref cdddr x))))
(λ (x) (update-pref 3 x))))
(define (update-list-boxes hash-table)
(let-values ([(begin-keywords define-keywords lambda-keywords) (get-keywords hash-table)]
[(reset) (λ (list-box keywords)
@ -1792,6 +1796,4 @@
(preferences:add-callback 'framework:tabify (λ (p v) (update-gui v)))
(update-gui (preferences:get 'framework:tabify))
main-panel)
)

View File

@ -5,7 +5,7 @@ WARNING: printf is rebound in the body of the unit to always
|#
(module text (lib "a-unit.ss")
#lang scheme/unit
(require (lib "string-constant.ss" "string-constants")
(lib "class.ss")
(lib "match.ss")
@ -2814,4 +2814,4 @@ designates the character that triggers autocompletion
(define clever-file-format% (clever-file-format-mixin file%))
(define backup-autosave% (editor:backup-autosave-mixin clever-file-format%))
(define searching% (searching-mixin backup-autosave%))
(define info% (info-mixin (editor:info-mixin searching%))))
(define info% (info-mixin (editor:info-mixin searching%)))

View File

@ -1,4 +1,5 @@
(module version (lib "a-unit.ss")
#lang scheme/unit
(require "sig.ss"
(lib "mred-sig.ss" "mred")
(lib "string.ss")
@ -19,4 +20,4 @@
(define (add-spec sep num)
(set! specs (cons (list (expr->string sep) (format "~a" num))
specs))))
specs)))

View File

@ -1,11 +1,10 @@
(module hierlist-sig (lib "a-signature.ss")
hierarchical-list%
hierarchical-list-item<%>
hierarchical-list-item%
hierarchical-list-compound-item<%>
hierarchical-list-compound-item%
hierarchical-item-snip%
hierarchical-list-snip%)
#lang scheme/signature
hierarchical-list%
hierarchical-list-item<%>
hierarchical-list-item%
hierarchical-list-compound-item<%>
hierarchical-list-compound-item%
hierarchical-item-snip%
hierarchical-list-snip%

View File

@ -338,30 +338,33 @@
[depth dpth]
[parent-snip parent-snp]
[children null]
[last-child #f]
[new-children null]
[no-sublists? #f])
(private
[append-children! (lambda ()
(unless (null? new-children)
(set! children (append children (reverse new-children)))
(set! new-children null)))]
[make-whitespace (lambda () (make-object whitespace-snip%))]
[insert-item
(lambda (mixin snip% whitespace?)
(let ([s (make-object snip% this top top-select (add1 depth) mixin)])
(begin-edit-sequence)
(unless (null? children)
(unless (and (null? children)
(null? new-children))
(insert #\newline (last-position)))
(when whitespace?
(insert (make-whitespace) (last-position)))
(insert s (last-position))
(end-edit-sequence)
(let ([p (list s)])
(if last-child
(set-cdr! last-child p)
(set! children (append children p)))
(set! last-child p))
(set! new-children (cons s new-children))
(send s get-item)))])
(public
[get-parent-snip (lambda () parent-snip)]
[deselect-all
(lambda () (for-each (lambda (x) (send x deselect-all)) children))]
(lambda ()
(append-children!)
(for-each (lambda (x) (send x deselect-all)) children))]
[new-item
(case-lambda
[() (new-item (lambda (x) x))]
@ -376,12 +379,16 @@
(insert-item mixin hierarchical-list-snip% #f)])]
[set-no-sublists
(lambda (no?)
(append-children!)
(unless (null? children)
(error 'set-no-sublists "cannot change sublist mode because the list is non-empty"))
(set! no-sublists? (and no? #t)))]
[get-items (lambda () (map (lambda (x) (send x get-item)) children))]
[get-items (lambda ()
(append-children!)
(map (lambda (x) (send x get-item)) children))]
[delete-item
(lambda (i)
(append-children!)
(let loop ([pos 0][l children][others null])
(cond
[(null? l) (error 'hierarchical-list-compound-item::delete-item "item not found: ~a" i)]
@ -389,12 +396,12 @@
(send top ensure-not-selected i)
(send (car l) deselect-all)
(set! children (append (reverse others) (cdr l)))
(set! last-child #f)
(let ([s (line-start-position pos)]
[e (line-end-position pos)])
(delete (if (zero? s) s (sub1 s)) (if (zero? s) (add1 e) e)))]
[else (loop (add1 pos) (cdr l) (cons (car l) others))])))]
[sort (opt-lambda (less-than? [recur? #t])
(append-children!)
(let ([l (sort* children
(lambda (a b)
(less-than? (send a get-item)
@ -424,12 +431,12 @@
(unless (null? l)
(delete)) ; delete last #\newline
(set! children l)
(set! last-child #f)
(when to-scroll-to
(send (send to-scroll-to get-item) scroll-to)))
(end-edit-sequence)))]
[reflow-items
(lambda ()
(append-children!)
(for-each
(lambda (c)
(send c reflow-item))

View File

@ -1,4 +1,2 @@
(module reader mzscheme
(require (lib "module-reader.ss" "syntax"))
(provide-module-reader (lib "main.ss" "mred" "lang")))
(module reader syntax/module-reader
mred)

3
collects/mred/main.ss Normal file
View File

@ -0,0 +1,3 @@
(module main scheme/base
(require "mred.ss")
(provide (all-from-out "mred.ss")))

View File

@ -1,206 +1,205 @@
(module mred-sig (lib "a-signature.ss")
add-color<%>
add-editor-keymap-functions
add-pasteboard-keymap-functions
add-text-keymap-functions
append-editor-font-menu-items
append-editor-operation-menu-items
application-about-handler
application-file-handler
application-preferences-handler
application-quit-handler
area-container-window<%>
area-container<%>
area<%>
begin-busy-cursor
bell
bitmap%
bitmap-dc%
brush%
brush-list%
button%
can-get-page-setup-from-user?
canvas%
canvas<%>
check-box%
check-for-break
checkable-menu-item%
choice%
clipboard-client%
clipboard<%>
color%
color-database<%>
combo-field%
control-event%
control<%>
current-eventspace
current-eventspace-has-menu-root?
current-eventspace-has-standard-menus?
current-ps-afm-file-paths
current-ps-cmap-file-paths
current-ps-setup
current-text-keymap-initializer
cursor%
dc<%>
dc-path%
dialog%
editor-admin%
editor-canvas%
editor-data%
editor-data-class%
editor-data-class-list<%>
editor-set-x-selection-mode
editor-snip%
editor-snip-editor-admin<%>
editor-stream-in%
editor-stream-in-base%
editor-stream-in-bytes-base%
editor-stream-out%
editor-stream-out-base%
editor-stream-out-bytes-base%
editor-wordbreak-map%
editor<%>
end-busy-cursor
event%
event-dispatch-handler
eventspace-handler-thread
eventspace-shutdown?
eventspace?
file-creator-and-type
find-graphical-system-path
flush-display
font%
font-list%
font-name-directory<%>
frame%
gauge%
get-choices-from-user
get-color-from-user
get-default-shortcut-prefix
get-directory
get-display-depth
get-display-left-top-inset
get-display-size
get-face-list
get-family-builtin-face
get-file
get-file-list
get-font-from-user
get-page-setup-from-user
get-panel-background
get-ps-setup-from-user
get-resource
get-text-from-user
get-the-editor-data-class-list
get-the-snip-class-list
get-top-level-edit-target-window
get-top-level-focus-window
get-top-level-windows
get-window-text-extent
gl-config%
gl-context<%>
graphical-read-eval-print-loop
group-box-panel%
grow-box-spacer-pane%
hide-cursor-until-moved
horizontal-pane%
horizontal-panel%
tab-panel%
image-snip%
is-busy?
is-color-display?
key-event%
keymap%
label->plain-label
labelled-menu-item<%>
list-box%
list-control<%>
make-eventspace
make-namespace-with-mred
map-command-as-meta-key
menu%
menu-bar%
menu-control-font
menu-item%
menu-item-container<%>
menu-item<%>
message%
message-box
message+check-box
message-box/custom
message+check-box/custom
mouse-event%
mult-color<%>
normal-control-font
open-input-graphical-file
open-input-text-editor
open-output-text-editor
pane%
panel%
pasteboard%
pen%
pen-list%
play-sound
point%
popup-menu%
post-script-dc%
printer-dc%
ps-setup%
put-file
queue-callback
radio-box%
readable-snip<%>
read-editor-global-footer
read-editor-global-header
read-editor-version
region%
register-collecting-blit
scroll-event%
selectable-menu-item<%>
send-event
send-message-to-window
separator-menu-item%
sleep/yield
slider%
small-control-font
snip%
snip-admin%
snip-class%
snip-class-list<%>
special-control-key
special-option-key
string-snip%
style-delta%
style-list%
style<%>
subarea<%>
subwindow<%>
tab-snip%
text%
text-editor-load-handler
text-field%
the-brush-list
the-clipboard
the-color-database
the-editor-wordbreak-map
the-font-list
the-font-name-directory
the-pen-list
the-style-list
the-x-selection-clipboard
timer%
tiny-control-font
top-level-window<%>
unregister-collecting-blit
vertical-pane%
vertical-panel%
view-control-font
window<%>
write-editor-global-footer
write-editor-global-header
write-editor-version
write-resource
yield
)
#lang scheme/signature
add-color<%>
add-editor-keymap-functions
add-pasteboard-keymap-functions
add-text-keymap-functions
append-editor-font-menu-items
append-editor-operation-menu-items
application-about-handler
application-file-handler
application-preferences-handler
application-quit-handler
area-container-window<%>
area-container<%>
area<%>
begin-busy-cursor
bell
bitmap%
bitmap-dc%
brush%
brush-list%
button%
can-get-page-setup-from-user?
canvas%
canvas<%>
check-box%
check-for-break
checkable-menu-item%
choice%
clipboard-client%
clipboard<%>
color%
color-database<%>
combo-field%
control-event%
control<%>
current-eventspace
current-eventspace-has-menu-root?
current-eventspace-has-standard-menus?
current-ps-afm-file-paths
current-ps-cmap-file-paths
current-ps-setup
current-text-keymap-initializer
cursor%
dc<%>
dc-path%
dialog%
editor-admin%
editor-canvas%
editor-data%
editor-data-class%
editor-data-class-list<%>
editor-set-x-selection-mode
editor-snip%
editor-snip-editor-admin<%>
editor-stream-in%
editor-stream-in-base%
editor-stream-in-bytes-base%
editor-stream-out%
editor-stream-out-base%
editor-stream-out-bytes-base%
editor-wordbreak-map%
editor<%>
end-busy-cursor
event%
event-dispatch-handler
eventspace-handler-thread
eventspace-shutdown?
eventspace?
file-creator-and-type
find-graphical-system-path
flush-display
font%
font-list%
font-name-directory<%>
frame%
gauge%
get-choices-from-user
get-color-from-user
get-default-shortcut-prefix
get-directory
get-display-depth
get-display-left-top-inset
get-display-size
get-face-list
get-family-builtin-face
get-file
get-file-list
get-font-from-user
get-page-setup-from-user
get-panel-background
get-ps-setup-from-user
get-resource
get-text-from-user
get-the-editor-data-class-list
get-the-snip-class-list
get-top-level-edit-target-window
get-top-level-focus-window
get-top-level-windows
get-window-text-extent
gl-config%
gl-context<%>
graphical-read-eval-print-loop
group-box-panel%
grow-box-spacer-pane%
hide-cursor-until-moved
horizontal-pane%
horizontal-panel%
tab-panel%
image-snip%
is-busy?
is-color-display?
key-event%
keymap%
label->plain-label
labelled-menu-item<%>
list-box%
list-control<%>
make-eventspace
make-namespace-with-mred
map-command-as-meta-key
menu%
menu-bar%
menu-control-font
menu-item%
menu-item-container<%>
menu-item<%>
message%
message-box
message+check-box
message-box/custom
message+check-box/custom
mouse-event%
mult-color<%>
normal-control-font
open-input-graphical-file
open-input-text-editor
open-output-text-editor
pane%
panel%
pasteboard%
pen%
pen-list%
play-sound
point%
popup-menu%
post-script-dc%
printer-dc%
ps-setup%
put-file
queue-callback
radio-box%
readable-snip<%>
read-editor-global-footer
read-editor-global-header
read-editor-version
region%
register-collecting-blit
scroll-event%
selectable-menu-item<%>
send-event
send-message-to-window
separator-menu-item%
sleep/yield
slider%
small-control-font
snip%
snip-admin%
snip-class%
snip-class-list<%>
special-control-key
special-option-key
string-snip%
style-delta%
style-list%
style<%>
subarea<%>
subwindow<%>
tab-snip%
text%
text-editor-load-handler
text-field%
the-brush-list
the-clipboard
the-color-database
the-editor-wordbreak-map
the-font-list
the-font-name-directory
the-pen-list
the-style-list
the-x-selection-clipboard
timer%
tiny-control-font
top-level-window<%>
unregister-collecting-blit
vertical-pane%
vertical-panel%
view-control-font
window<%>
write-editor-global-footer
write-editor-global-header
write-editor-version
write-resource
yield

View File

@ -36,11 +36,9 @@
(wx:set-dialogs get-file put-file get-ps-setup-from-user message-box)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define mred-module-name ((current-module-name-resolver)
'(lib "mred.ss" "mred") #f #f))
(define class-module-name ((current-module-name-resolver)
'(lib "class.ss") #f #f))
(define mred-module-name '(lib "mred/mred.ss"))
(define class-module-name '(lib "scheme/class.ss"))
(define make-namespace-with-mred
(opt-lambda ([flag 'mred])

View File

@ -9,11 +9,11 @@
;; the library compiles with setup-plt in mzscheme.
(define kernel:initialize-primitive-object
(dynamic-require '#%mred-kernel 'initialize-primitive-object))
(dynamic-require ''#%mred-kernel 'initialize-primitive-object))
(define kernel:primitive-class-find-method
(dynamic-require '#%mred-kernel 'primitive-class-find-method))
(dynamic-require ''#%mred-kernel 'primitive-class-find-method))
(define kernel:primitive-class-prepare-struct-type!
(dynamic-require '#%mred-kernel 'primitive-class-prepare-struct-type!))
(dynamic-require ''#%mred-kernel 'primitive-class-prepare-struct-type!))
(define-syntax define-constant
(lambda (stx)
@ -28,7 +28,7 @@
#f)])
(syntax
(begin
(define kernel:name (dynamic-require '#%mred-kernel 'name))
(define kernel:name (dynamic-require ''#%mred-kernel 'name))
(provide (protect (rename kernel:name name))))))])))
(define-syntax define-function
@ -76,7 +76,7 @@
(with-syntax ([(old ...) (datum->syntax-object #f old #f)]
[(new ...) (datum->syntax-object #f new #f)])
(syntax
(define name (let ([c (dynamic-require '#%mred-kernel 'name)])
(define name (let ([c (dynamic-require ''#%mred-kernel 'name)])
(make-primitive-class
(lambda (class prop:object preparer dispatcher)
(kernel:primitive-class-prepare-struct-type!

View File

@ -373,12 +373,15 @@
[-append-list-string (lambda (i)
(set! content (append content (list i))))]
[-set-list-string (lambda (i s)
(set-car! (list-tail content i) (string->immutable-string s)))]
(set! content (let loop ([content content][i i])
(if (zero? i)
(cons (string->immutable-string s) (cdr content))
(cons (car content) (loop (cdr content) (sub1 i)))))))]
[-delete-list-item (lambda (pos)
(if (zero? pos)
(set! content (cdr content))
(set-cdr! (list-tail content (sub1 pos))
(list-tail content (add1 pos)))))]
(set! content (let loop ([content content][pos pos])
(if (zero? pos)
(cdr content)
(cons (car content) (loop (cdr content) (sub1 pos)))))))]
[-set-list-strings (lambda (l)
(set! content (map string->immutable-string l)))])
(private-field

View File

@ -110,7 +110,7 @@
(lambda (l)
(check-label-string '(method labelled-menu-item<%> set-label) l)
(set! label (string->immutable-string l))
(set-car! (send wx get-menu-data) l) ; for meta-shortcuts
(set-mcar! (send wx get-menu-data) l) ; for meta-shortcuts
(set! plain-label (string->immutable-string (wx:label->plain-label l)))
(when shown?
(if in-menu?
@ -152,7 +152,7 @@
(lambda ()
(when help-string
(set! help-string (string->immutable-string help-string)))
(set! wx (set-wx (make-object wx-menu-item% this (cons label #f) #t)))
(set! wx (set-wx (make-object wx-menu-item% this (mcons label #f) #t)))
(set! wx-parent (send (mred->wx parent) get-container))
(super-init wx)
(when keymap (send wx set-keymap keymap))))
@ -212,9 +212,9 @@
(define default-prefix
(case (system-type)
[(unix) (list-immutable default-x-prefix)]
[(windows) (list-immutable 'ctl)]
[(macosx) (list-immutable 'cmd)]))
[(unix) (list default-x-prefix)]
[(windows) (list 'ctl)]
[(macosx) (list 'cmd)]))
(define (get-default-shortcut-prefix)
default-prefix)
@ -238,7 +238,7 @@
(check-instance '(method selectable-menu-item<%> command) wx:control-event% 'control-event% #f e)
(void (callback this e)))])
(private-field
[prefix (apply list-immutable shrtcut-prefix)])
[prefix shrtcut-prefix])
(private
[calc-labels (lambda (label)
(let* ([new-label (if shortcut
@ -392,7 +392,7 @@
(set! wx-menu (make-object wx-menu% this #f void #f))
(super-init parent label help-string wx-menu #f (send wx-menu get-keymap) (lambda (x) x) void)
(let ([wx-item (mred->wx this)])
(set-cdr! (send wx-item get-menu-data) wx-menu) ; for meta-shortcuts
(set-mcdr! (send wx-item get-menu-data) wx-menu) ; for meta-shortcuts
(send wx-item set-wx-menu wx-menu)))))))
(define menu-bar%

View File

@ -154,7 +154,10 @@
(check-item 'set-item-label i)
(check-label-string '(method tab-panel% set-item-label) s)
(let ([s (string->immutable-string s)])
(set-car! (list-tail save-choices i) s)
(set! save-choices (let loop ([save-choices save-choices][i i])
(if (zero? i)
(cons s (cdr save-choices))
(cons (car save-choices) (loop (cdr save-choices) (sub1 i))))))
(send (mred->wx tabs) set-label i s))))]
[set
(entry-point (lambda (l)

View File

@ -245,7 +245,7 @@
(directory-list))]
[pnames '()])
(if (null? paths)
(let ([ps (sort! pnames pname<?)])
(let ([ps (sort pnames pname<?)])
(if (root? dir) ps (cons up-dir-pname ps)))
(let* ([path (car paths)]
[paths (cdr paths)]

View File

@ -211,7 +211,9 @@
(dynamic-wind
(lambda () (void))
(lambda ()
(parameterize ([read-accept-compiled #t])
(parameterize ([read-accept-compiled #t]
[read-on-demand-source (and (load-on-demand-enabled)
(path->complete-path filename))])
(if expected-module
(with-module-reading-parameterization
(lambda ()

View File

@ -1,5 +1,2 @@
(module reader mzscheme
(require (lib "module-reader.ss" "syntax"))
(provide-module-reader mzscheme))
(module reader syntax/module-reader
mzscheme)

4
collects/scheme/gui.ss Normal file
View File

@ -0,0 +1,4 @@
(module gui scheme
(require mred)
(provide (all-from-out scheme)
(all-from-out mred)))

View File

@ -0,0 +1,8 @@
(module init scheme/gui
(require (only-in scheme/init))
(current-load text-editor-load-handler)
(provide (all-from-out scheme/gui)
(all-from-out scheme/init)))

View File

@ -0,0 +1,2 @@
(module reader syntax/module-reader
scheme/gui)

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[add-color<%> ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[area-container<%> (area<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[area-container-window<%> (area-container<%> window<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[area<%> ()]{

View File

@ -1,12 +1,12 @@
#reader(lib "reader.ss" "scribble")
(module blurbs (lib "lang.ss" "big")
(require (lib "struct.ss" "scribble")
(lib "manual.ss" "scribble")
(lib "scheme.ss" "scribble")
(lib "decode.ss" "scribble"))
(require-for-label (lib "mred.ss" "mred"))
#readerscribble/reader
(module blurbs scheme/base
(require scribble/struct
scribble/manual
scribble/scheme
scribble/decode
(for-label mred))
(provide (all-defined-except p))
(provide (except-out (all-defined-out) p))
(define (p . l)
(decode-paragraph l))
@ -160,7 +160,7 @@ information@|details|, even if the editor currently has delayed refreshing (see
@item{@method[dc<%> end-doc]}}
@p{Attempts to use a drawing method outside of an active page raises an exception.})))
(define reference-doc '(lib "reference.scrbl" "scribblings" "reference"))
(define reference-doc '(lib "scribblings/reference/reference.scrbl"))
(define SeeMzParam @elem{(see @secref[#:doc reference-doc "parameters"])})

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[button% object% (control<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[canvas% object% (canvas<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[canvas<%> (subwindow<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[check-box% object% (control<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[checkable-menu-item% object% (selectable-menu-item<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[choice% object% (list-control<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[clipboard-client% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[clipboard<%> ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[combo-field% text-field% ()]{

View File

@ -1,22 +1,22 @@
(module common mzscheme
(require (lib "manual.ss" "scribble")
(lib "basic.ss" "scribble")
(lib "class.ss")
(lib "contract.ss")
(module common scheme/base
(require scribble/manual
scribble/basic
mzlib/class
mzlib/contract
"blurbs.ss"
(only "../reference/mz.ss" AllUnix exnraise))
(provide (all-from (lib "manual.ss" "scribble"))
(all-from (lib "basic.ss" "scribble"))
(all-from (lib "class.ss"))
(all-from (lib "contract.ss"))
(all-from "blurbs.ss")
(all-from "../reference/mz.ss"))
(only-in "../reference/mz.ss" AllUnix exnraise))
(provide (all-from-out scribble/manual)
(all-from-out scribble/basic)
(all-from-out mzlib/class)
(all-from-out mzlib/contract)
(all-from-out "blurbs.ss")
(all-from-out "../reference/mz.ss"))
(require-for-label (lib "mred.ss" "mred")
(lib "class.ss")
(lib "lang.ss" "big"))
(provide-for-label (all-from (lib "mred.ss" "mred"))
(all-from (lib "class.ss"))
(all-from (lib "lang.ss" "big"))))
(require (for-label mred
mzlib/class
scheme/base))
(provide (for-label (all-from-out mred)
(all-from-out mzlib/class)
(all-from-out scheme/base))))

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[control-event% event% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[control<%> (subwindow<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[cursor% object% ()]{

View File

@ -1,9 +1,8 @@
(module diagrams mzscheme
(require (lib "string.ss")
(lib "struct.ss" "scribble")
(lib "scheme.ss" "scribble")
(lib "manual.ss" "scribble"))
(require-for-label (lib "mred.ss" "mred"))
(module diagrams scheme/base
(require scribble/struct
scribble/scheme
scribble/manual
(for-label mred))
(provide diagram->table
short-windowing-diagram

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[dialog% object% (top-level-window<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@title{Dialogs}
@ -503,4 +503,4 @@ Returns @scheme[#t] if the current platform (Mac OS X) supports a
created. Returns @scheme[#f] if no separate page-layout dialog is
needed (Windows and Unix).
}
}

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-admin% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-canvas% object% (canvas<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@require["diagrams.ss"]

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-data-class% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[editor-data-class-list<%> ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-data% object% ()]{

View File

@ -1,6 +1,6 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@require[(lib "bnf.ss" "scribble")]
@require[scribble/bnf]
@title{Editor Functions}

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[editor<%> ()]{

View File

@ -1,5 +1,5 @@
#reader(lib "docreader.ss" "scribble")
@require[(lib "bnf.ss" "scribble")]
#lang scribble/doc
@require[scribble/bnf]
@require["common.ss"]
@title[#:tag "editor-overview"]{Editor}

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-snip% snip% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[editor-snip-editor-admin<%> ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-stream-in-base% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-stream-in-bytes-base% editor-stream-in-base% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-stream-in% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-stream-out-base% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-stream-out-bytes-base% editor-stream-out-base% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-stream-out% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[editor-wordbreak-map% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[event% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@title[#:tag "eventspace-funcs"]{Eventspaces}
@ -230,4 +230,4 @@ Returns the handler thread of the given eventspace. If the handler
}
}

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@title{Fonts}

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[frame% object% (top-level-window<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[gauge% object% (control<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@title{Global Graphics}

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[group-box-panel% vertical-panel% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[grow-box-spacer-pane% pane% ()]{

View File

@ -1,15 +1,15 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@title[#:tag-prefix '(lib "gui.scrbl" "scribblings" "gui")
@title[#:tag-prefix '(lib "scribblings/gui/gui.scrbl")
#:tag "top"]{PLT Scheme GUI: MrEd}
@declare-exporting[(lib "mred")]
This reference manual describes the MrEd GUI toolbox that is part of
PLT Scheme. See @secref[#:doc '(lib "guide.scrbl" "scribblings"
"guide") "mred"] in @italic{@link["../guide/index.html"]{A Guide to
PLT Scheme}} for an introduction to MrEd.
PLT Scheme. See @secref[#:doc '(lib "scribblings/guide/guide.scrbl")
"mred"] in @italic{@link["../guide/index.html"]{A Guide to PLT
Scheme}} for an introduction to MrEd.
The @scheme[(lib "mred")] module provides all of the class, interface,
and procedure bindings defined in this manual. The

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@title[#:style '(toc reveal)]{Overview}

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[horizontal-pane% pane% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[horizontal-panel% panel% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[image-snip% snip% ()]{

View File

@ -1,4 +1,4 @@
(module info (lib "infotab.ss" "setup")
(module info setup/infotab
(define name "Scribblings: GUI")
(define scribblings '(("gui.scrbl" (multi-page main-doc)))))

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[key-event% event% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@defclass/title[keymap% object% ()]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@definterface/title[labelled-menu-item<%> (menu-item<%>)]{

View File

@ -1,4 +1,4 @@
#reader(lib "docreader.ss" "scribble")
#lang scribble/doc
@require["common.ss"]
@define[lbnumnote @elem{List box items are indexed from @scheme[0].}]

Some files were not shown because too many files have changed in this diff Show More