...
original commit: 02db02daefb74250c42b8791e4837dca7726a533
This commit is contained in:
parent
09eb5cd7c2
commit
341ed5990f
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:autosave^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[exit : framework:exit^]
|
||||
[preferences : framework:preferences^])
|
||||
|
||||
|
|
|
@ -1,12 +1,12 @@
|
|||
|
||||
(unit/sig framework:canvas^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[preferences : framework:preferences^]
|
||||
[frame : framework:frame^])
|
||||
|
||||
(define basic<%> (interface (editor-canvas<%>)))
|
||||
(define basic<%> (interface ((class->interface editor-canvas%))))
|
||||
(define basic-mixin
|
||||
(mixin (editor-canvas<%>) (basic<%>) args
|
||||
(mixin ((class->interface editor-canvas%)) (basic<%>) args
|
||||
(sequence
|
||||
(apply super-init args))))
|
||||
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:editor^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[autosave : framework:autosave^]
|
||||
[finder : framework:finder^]
|
||||
[path-utils : framework:path-utils^]
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
;;; Authors: Matthew Flatt, Robby Findler, Paul Steckler
|
||||
|
||||
(unit/sig framework:finder^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[preferences : framework:preferences^]
|
||||
[gui-utils : framework:gui-utils^]
|
||||
[mzlib:string : mzlib:string^]
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:frame^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[group : framework:group^]
|
||||
[preferences : framework:preferences^]
|
||||
[icon : framework:icon^]
|
||||
|
@ -18,9 +18,7 @@
|
|||
|
||||
(rename [-editor<%> editor<%>]
|
||||
[-pasteboard% pasteboard%]
|
||||
[-pasteboard<%> pasteboard<%>]
|
||||
[-text% text%]
|
||||
[-text<%> text<%>])
|
||||
[-text% text%])
|
||||
|
||||
(define (reorder-menus frame)
|
||||
(let* ([items (send (send frame get-menu-bar) get-items)]
|
||||
|
@ -57,14 +55,14 @@
|
|||
(set! frame-width (min frame-width (- w window-trimming-upper-bound-width)))
|
||||
(set! frame-height (min frame-height (- h window-trimming-upper-bound-height)))))
|
||||
|
||||
(define basic<%> (interface (frame<%>)
|
||||
(define basic<%> (interface ((class->interface frame%))
|
||||
get-area-container%
|
||||
get-area-container
|
||||
get-menu-bar%
|
||||
make-root-area-container
|
||||
close))
|
||||
(define basic-mixin
|
||||
(mixin (frame<%>) (basic<%>)
|
||||
(mixin ((class->interface frame%)) (basic<%>)
|
||||
(label [parent #f] [width #f] [height #f] [x #f] [y #f] [style null])
|
||||
(rename [super-can-close? can-close?]
|
||||
[super-on-close on-close]
|
||||
|
@ -211,7 +209,7 @@
|
|||
(do-label)))])
|
||||
(public
|
||||
[get-canvas% (lambda () editor-canvas%)]
|
||||
[get-canvas<%> (lambda () editor-canvas<%>)]
|
||||
[get-canvas<%> (lambda () (class->interface editor-canvas%))]
|
||||
[make-canvas (lambda ()
|
||||
(let ([% (get-canvas%)]
|
||||
[<%> (get-canvas<%>)])
|
||||
|
@ -249,7 +247,7 @@
|
|||
(if (or (not filename) (unbox b))
|
||||
(bell)
|
||||
(let ([start
|
||||
(if (is-a? edit original:text%)
|
||||
(if (is-a? edit text%)
|
||||
(send edit get-start-position)
|
||||
#f)])
|
||||
(send edit begin-edit-sequence)
|
||||
|
@ -259,7 +257,7 @@
|
|||
#f)])
|
||||
(if status
|
||||
(begin
|
||||
(when (is-a? edit original:text%)
|
||||
(when (is-a? edit text%)
|
||||
(send edit set-position start start))
|
||||
(send edit end-edit-sequence))
|
||||
(begin
|
||||
|
@ -344,23 +342,23 @@
|
|||
(let ([canvas (get-canvas)])
|
||||
(send canvas focus)))))
|
||||
|
||||
(define -text<%> (interface (-editor<%>)))
|
||||
(define text<%> (interface (-editor<%>)))
|
||||
(define text-mixin
|
||||
(mixin (-editor<%>) (-text<%>) args
|
||||
(mixin (-editor<%>) (text<%>) args
|
||||
(override
|
||||
[get-editor<%> (lambda () text<%>)]
|
||||
[get-editor<%> (lambda () (class->interface text%))]
|
||||
[get-editor% (lambda () text:keymap%)])
|
||||
(sequence (apply super-init args))))
|
||||
|
||||
(define -pasteboard<%> (interface (-editor<%>)))
|
||||
(define pasteboard<%> (interface (-editor<%>)))
|
||||
(define pasteboard-mixin
|
||||
(mixin (-editor<%>) (-pasteboard<%>) args
|
||||
(mixin (-editor<%>) (pasteboard<%>) args
|
||||
(override
|
||||
[get-editor<%> (lambda () pasteboard<%>)]
|
||||
[get-editor<%> (lambda () (class->interface pasteboard%))]
|
||||
[get-editor% (lambda () pasteboard:keymap%)])
|
||||
(sequence (apply super-init args))))
|
||||
|
||||
(define searchable<%> (interface (-text<%>)
|
||||
(define searchable<%> (interface (text<%>)
|
||||
get-text-to-search
|
||||
hide-search
|
||||
unhide-search
|
||||
|
@ -475,11 +473,11 @@
|
|||
(if (and (not flat) pop-out?)
|
||||
(pop-out)
|
||||
(values edit flat))]
|
||||
[(is-a? current-snip original:editor-snip%)
|
||||
[(is-a? current-snip editor-snip%)
|
||||
(let-values ([(embedded embedded-pos)
|
||||
(let ([media (send current-snip get-editor)])
|
||||
(if (and media
|
||||
(is-a? media original:text%))
|
||||
(is-a? media text%))
|
||||
(begin
|
||||
(find-string-embedded
|
||||
media
|
||||
|
@ -614,7 +612,7 @@
|
|||
(send replace-edit get-keymap)))))
|
||||
|
||||
(define searchable-mixin
|
||||
(mixin (-text<%>) (searchable<%>) args
|
||||
(mixin (text<%>) (searchable<%>) args
|
||||
(sequence (init-find/replace-edits))
|
||||
(inherit get-editor)
|
||||
(rename [super-make-root-area-container make-root-area-container]
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
[core:thread : mzlib:thread^]
|
||||
[framework:keys : framework:keys^]
|
||||
[framework:test : framework:test^]
|
||||
[m : mred-interfaces^])
|
||||
[m : mred^])
|
||||
(link [f : frameworkc^ ((require-relative-library "frameworkc.ss")
|
||||
core:string
|
||||
core:function
|
||||
|
@ -39,5 +39,5 @@
|
|||
mzlib:thread^
|
||||
(keys : framework:keys^)
|
||||
(test : framework:test^)
|
||||
mred-interfaces^)
|
||||
mred^)
|
||||
|
||||
|
|
|
@ -8,7 +8,6 @@
|
|||
(require-library "macro.ss")
|
||||
(require-relative-library "macro.ss")
|
||||
|
||||
(require-relative-library "mred-interfacess.ss")
|
||||
(require-relative-library "tests.ss")
|
||||
|
||||
(define-signature framework:version^
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:group^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[application : framework:application^]
|
||||
[frame : framework:frame^]
|
||||
[preferences : framework:preferences^]
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:gui-utils^
|
||||
(import mred-interfaces^)
|
||||
(import mred^)
|
||||
|
||||
(define next-untitled-name
|
||||
(let ([n 1])
|
||||
|
@ -155,7 +155,7 @@
|
|||
(cond
|
||||
[(<= end pos) eof]
|
||||
[(not snip) eof]
|
||||
[(is-a? snip original:string-snip%)
|
||||
[(is-a? snip string-snip%)
|
||||
(let ([t (send snip get-text (- pos (unbox box)) 1)])
|
||||
(unless (= (string-length t) 1)
|
||||
(error 'read-snips/chars-from-buffer
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:handler^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[gui-utils : framework:gui-utils^]
|
||||
[finder : framework:finder^]
|
||||
[group : framework:group^]
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:icon^
|
||||
(import mred-interfaces^)
|
||||
(import mred^)
|
||||
|
||||
(define icon-path
|
||||
(with-handlers ([void (lambda (x) (collection-path "mzlib"))])
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:keymap^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[keys : framework:keys^]
|
||||
[preferences : framework:preferences^]
|
||||
[finder : framework:finder^]
|
||||
|
@ -302,7 +302,7 @@
|
|||
[region-click
|
||||
(lambda (edit event f)
|
||||
(when (and (send event button-down?)
|
||||
(is-a? edit original:text%))
|
||||
(is-a? edit text%))
|
||||
(let ([x-box (box (send event get-x))]
|
||||
[y-box (box (send event get-y))]
|
||||
[eol-box (box #f)])
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:main^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[preferences : framework:preferences^]
|
||||
[exit : framework:exit^]
|
||||
[group : framework:group^])
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:panel^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[mzlib:function : mzlib:function^])
|
||||
|
||||
(rename [-editor<%> editor<%>])
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:pasteboard^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[editor : framework:editor^])
|
||||
|
||||
(rename [-keymap% keymap%])
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:preferences^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[exn : framework:exn^]
|
||||
[exit : framework:exit^]
|
||||
[panel : framework:panel^]
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
; Scheme mode for MrEd.
|
||||
|
||||
(unit/sig framework:scheme^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[preferences : framework:preferences^]
|
||||
[match-cache : framework:match-cache^]
|
||||
[paren : framework:paren^]
|
||||
|
|
|
@ -1,15 +1,14 @@
|
|||
(require-relative-library "tests.ss")
|
||||
(require-relative-library "mred-interfaces.ss")
|
||||
|
||||
(begin-elaboration-time
|
||||
(require-library "invoke.ss"))
|
||||
|
||||
(define-values/invoke-unit/sig ((open mred-interfaces^)
|
||||
(define-values/invoke-unit/sig ((open mred^)
|
||||
(unit keys : framework:keys^)
|
||||
(unit test : framework:test^))
|
||||
(compound-unit/sig
|
||||
(import)
|
||||
(link [mred : mred-interfaces^ (mred-interfaces@)]
|
||||
(link [mred : mred^ (mred@)]
|
||||
[keys : framework:keys^ ((require-relative-library "keys.ss"))]
|
||||
[test : framework:test^ ((require-relative-library "testr.ss") mred keys)])
|
||||
(export
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(unit/sig framework:text^
|
||||
(import mred-interfaces^
|
||||
(import mred^
|
||||
[icon : framework:icon^]
|
||||
[editor : framework:editor^]
|
||||
[preferences : framework:preferences^]
|
||||
|
@ -16,7 +16,7 @@
|
|||
;; unless matthew makes it primitive
|
||||
|
||||
(define basic<%>
|
||||
(interface (editor:basic<%> text<%>)
|
||||
(interface (editor:basic<%> (class->interface text%))
|
||||
highlight-range
|
||||
get-styles-fixed
|
||||
set-styles-fixed
|
||||
|
@ -24,7 +24,7 @@
|
|||
initial-autowrap-bitmap))
|
||||
|
||||
(define basic-mixin
|
||||
(mixin (editor:basic<%> text<%>) (basic<%>) args
|
||||
(mixin (editor:basic<%> (class->interface text%)) (basic<%>) args
|
||||
(inherit get-canvases get-admin split-snip get-snip-position
|
||||
set-autowrap-bitmap
|
||||
delete find-snip invalidate-bitmap-cache
|
||||
|
@ -336,10 +336,10 @@
|
|||
(sequence
|
||||
(apply super-init args))))
|
||||
|
||||
(define return<%> (interface (text<%>)))
|
||||
(define return<%> (interface ((class->interface text%))))
|
||||
|
||||
(define return-mixin
|
||||
(mixin (text<%>) (return<%>) (return . args)
|
||||
(mixin ((class->interface text%)) (return<%>) (return . args)
|
||||
(rename [super-on-local-char on-local-char])
|
||||
(override
|
||||
[on-local-char
|
||||
|
@ -355,10 +355,10 @@
|
|||
(sequence
|
||||
(apply super-init args))))
|
||||
|
||||
(define info<%> (interface (editor:basic<%> text<%>)))
|
||||
(define info<%> (interface (editor:basic<%> (class->interface text%))))
|
||||
|
||||
(define info-mixin
|
||||
(mixin (editor:keymap<%> text<%>) (info<%>) args
|
||||
(mixin (editor:keymap<%> (class->interface text%)) (info<%>) args
|
||||
(inherit get-start-position get-end-position get-canvas
|
||||
run-after-edit-sequence)
|
||||
(rename [super-after-set-position after-set-position]
|
||||
|
@ -407,10 +407,10 @@
|
|||
(sequence
|
||||
(apply super-init args))))
|
||||
|
||||
(define clever-file-format<%> (interface (text<%>)))
|
||||
(define clever-file-format<%> (interface ((class->interface text%))))
|
||||
|
||||
(define clever-file-format-mixin
|
||||
(mixin (text<%>) (clever-file-format<%>) args
|
||||
(mixin ((class->interface text%)) (clever-file-format<%>) args
|
||||
(inherit get-file-format set-file-format find-first-snip)
|
||||
(rename [super-on-save-file on-save-file]
|
||||
[super-after-save-file after-save-file])
|
||||
|
@ -428,7 +428,7 @@
|
|||
(let loop ([s (find-first-snip)])
|
||||
(cond
|
||||
[(not s) #t]
|
||||
[(is-a? s original:string-snip%)
|
||||
[(is-a? s string-snip%)
|
||||
(loop (send s next))]
|
||||
[else #f])))])
|
||||
(lambda (name format)
|
||||
|
|
Loading…
Reference in New Issue
Block a user