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

...

Browse Source 
original commit: e9db8c3da1d993f0393215d7cd8aa784abf34f94
This commit is contained in:
Robby Findler 1999-02-07 04:15:41 +00:00
parent 36d892a66f
commit e256c05fdf
7 changed files with 75 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/framework/editor.ss
View File

@ -162,7 +162,7 @@
(apply super-init args)
(auto-wrap (default-auto-wrap?)))))
(define -keymap<%> (interface (basic<%>)))
(define -keymap<%> (interface (basic<%>) get-keymaps))
(define keymap-mixin
(mixin (basic<%>) (-keymap<%>) args
(public
@ -179,18 +179,20 @@
(add-text-keymap-functions keymap)
(add-pasteboard-keymap-functions keymap)
(for-each (lambda (k)
(keymap:set-keymap-error-handler k)
(keymap:set-keymap-implied-shifts k)
(send keymap chain-to-keymap k #f))
(get-keymaps))))))
(define file<%> (interface (basic<%>)))
(define file-mixin ;; wx - should come from -keymap<%>
(mixin (basic<%>) (file<%>) args
(inherit get-keymap
get-filename lock get-style-list
(define file<%> (interface (-keymap<%>)))
(define file-mixin
(mixin (-keymap<%>) (file<%>) args
(inherit get-filename lock get-style-list
is-modified? change-style set-modified
get-top-level-window)
(rename [super-after-save-file after-save-file]
[super-after-load-file after-load-file])
[super-after-load-file after-load-file]
[super-get-keymaps get-keymaps])
(override [editing-this-file? (lambda () #t)])
(private
@ -215,11 +217,12 @@
(lambda (sucessful?)
(when sucessful?
(check-lock))
(super-after-load-file sucessful?))])
(super-after-load-file sucessful?))]
[get-keymaps
(lambda ()
(cons (keymap:get-file) (super-get-keymaps)))])
(sequence
(apply super-init args)
(let ([keymap (get-keymap)])
(send keymap chain-to-keymap (keymap:get-file) #f)))))
(apply super-init args))))
(define backup-autosave<%>
(interface (basic<%>)

2
collects/framework/frameworks.ss
View File

@ -88,11 +88,13 @@
(define-signature framework:editor^
(basic<%>
keymap<%>
info<%>
file<%>
backup-autosave<%>
basic-mixin
keymap-mixin
info-mixin
file-mixin
backup-autosave-mixin))

4
collects/framework/keymap.ss
View File

@ -9,10 +9,6 @@
(rename [-get-file get-file])
; This is a list of keys that are typed with the SHIFT key, but
; are not normally thought of as shifted. It will have to be
; changed for different keyboards.
(define keyerr
(lambda (str)
(display str (current-error-port))

7
collects/framework/main.ss
View File

@ -35,11 +35,8 @@
'(cond
begin begin0 delay
unit compound-unit compound-unit/sig
public private
inherit inherit-from
rename rename-from
share share-from
sequence))
public private override
inherit sequence))
(for-each (lambda (x) (hash-table-put! hash-table x 'lambda))
'(lambda let let* letrec recur
let/cc let/ec letcc catch

2
collects/framework/pasteboard.ss
View File

@ -2,7 +2,7 @@
(import mred-interfaces^
[editor : framework:editor^])
(define basic% (editor:basic-mixin pasteboard%))
(define basic% (editor:keymap-mixin (editor:basic-mixin pasteboard%)))
(define file% (editor:file-mixin basic%))
(define backup-autosave% (editor:backup-autosave-mixin file%))
(define info% (editor:info-mixin backup-autosave%)))

65
collects/framework/scheme.ss
View File

@ -184,20 +184,23 @@
(lambda (pos)
(let loop ([pos pos])
(let ([paren-pos
(apply max (map (lambda (pair)
(find-string
(car pair)
'backward
pos
'eof
#f))
(scheme-paren:get-paren-pairs)))])
(let loop ([pairs (scheme-paren:get-paren-pairs)]
[curr-max #f])
(cond
[(null? pairs) curr-max]
[else (let* ([pair (car pairs)]
[fnd (find-string (car pair) 'backward pos 'eof #f)])
(if (and fnd curr-max)
(loop (cdr pairs)
(max fnd curr-max))
(loop (cdr pairs)
(or fnd curr-max))))]))])
(cond
[(= -1 paren-pos) #f]
[(not paren-pos) #f]
[else
(let ([semi-pos (find-string ";" 'backward paren-pos)])
(cond
[(or (= -1 semi-pos)
[(or (not semi-pos)
(< semi-pos (paragraph-start-position
(position-paragraph paren-pos))))
paren-pos]
@ -282,9 +285,8 @@
[balance-quotes
(lambda (key)
(let* ([code (send key get-key-code)] ;; must be a character because of the mapping setup
;; this function is only bound to ascii-returning keys
[char (integer->char code)])
(let* ([char (send key get-key-code)]) ;; must be a character because of the mapping setup
;; this function is only bound to ascii-returning keys
(insert char)
(let* ([start-pos (get-start-position)]
[limit (get-limit start-pos)]
@ -376,15 +378,16 @@
[visual-offset
(lambda (pos)
(let loop ([p (sub1 pos)])
(let ([c (get-character p)])
(cond
[(= p -1) 0]
[(char=? c #\null) 0]
[(char=? c #\tab)
(let ([o (loop (sub1 p))])
(+ o (- 8 (modulo o 8))))]
[(char=? c #\newline) 0]
[else (add1 (loop (sub1 p)))]))))]
(if (= p -1)
0
(let ([c (get-character p)])
(cond
[(char=? c #\null) 0]
[(char=? c #\tab)
(let ([o (loop (sub1 p))])
(+ o (- 8 (modulo o 8))))]
[(char=? c #\newline) 0]
[else (add1 (loop (sub1 p)))])))))]
[do-indent
(lambda (amt)
(let* ([pos-start end]
@ -446,7 +449,7 @@
#f))
=> (lambda (x) (set-position x))]
[(= para 0) (do-indent 0)]
[(or (not contains) (= contains -1))
[(not contains)
(do-indent 0)]
[(not last) ;; search backwards for the opening parenthesis, and use it to align this line
(let ([enclosing (find-enclosing-paren pos)])
@ -487,7 +490,7 @@
(loop (add1 para))))
(when (and (>= (position-paragraph start-pos) end-para)
(<= (paren:skip-whitespace
this (get-start-position) -1)
this (get-start-position) 'backward)
(paragraph-start-position first-para)))
(set-position
(let loop ([new-pos (get-start-position)])
@ -544,7 +547,7 @@
(paren:skip-whitespace
this
(paragraph-start-position curr-para)
1)])
'forward)])
(delete first-on-para
(+ first-on-para
(let char-loop ([n 0])
@ -666,7 +669,7 @@
#t))]
[remove-parens-forward
(lambda (start-pos)
(let* ([pos (paren:skip-whitespace this start-pos 1)]
(let* ([pos (paren:skip-whitespace this start-pos 'forward)]
[first-char (get-character pos)]
[paren? (or (char=? first-char #\( )
(char=? first-char #\[ ))]
@ -741,11 +744,11 @@
(set-tabs null tab-size #f)
(set-style-list style-list)
(set-styles-fixed #t)
(let ([keymap (or (get-keymap)
(let ([k (make-object keymap%)])
(set-keymap k)
k))])
(send keymap chain-to-keymap keymap #t)))))
(let ([k (or (get-keymap)
(let ([k (make-object keymap%)])
(set-keymap k)
k))])
(send k chain-to-keymap keymap #t)))))
(define -text% (text-mixin text:info%))

39
collects/framework/text.ss
View File

@ -13,7 +13,7 @@
;; unless matthew makes it primitive
(define basic<%>
(interface (editor:basic<%> text<%>)
(interface (editor:keymap<%> text<%>)
highlight-range
get-styles-fixed
set-styles-fixed
@ -21,10 +21,10 @@
initial-autowrap-bitmap))
(define basic-mixin
(mixin (editor:basic<%> text<%>) (basic<%>) args
(mixin (editor:keymap<%> text<%>) (basic<%>) args
(inherit get-canvases get-admin split-snip get-snip-position
delete find-snip invalidate-bitmap-cache
set-autowrap-bitmap get-keymap
set-autowrap-bitmap
set-file-format get-file-format
get-style-list is-modified? change-style set-modified
position-location get-extent)
@ -296,22 +296,24 @@
(public
[initial-autowrap-bitmap (lambda () #f)])
(rename [super-get-keymaps get-keymaps])
(override
[get-keymaps
(lambda ()
(cons (keymap:get-global) (super-get-keymaps)))])
(sequence
(apply super-init args)
(set-autowrap-bitmap (initial-autowrap-bitmap))
(let ([keymap (get-keymap)])
(keymap:set-keymap-error-handler keymap)
(keymap:set-keymap-implied-shifts keymap)
(send keymap chain-to-keymap (keymap:get-global) #f)))))
(set-autowrap-bitmap (initial-autowrap-bitmap)))))
(define searching<%>
(interface ()
find-string-embedded))
(define searching-mixin
(mixin (editor:basic<%> text<%>) (searching<%>) args
(mixin (basic<%>) (searching<%>) args
(inherit get-end-position get-start-position last-position
find-string get-snip-position get-admin find-snip
get-keymap)
find-string get-snip-position get-admin find-snip)
(public
[find-string-embedded
(opt-lambda (str [direction 1] [start -1]
@ -390,12 +392,15 @@
(next-loop)
(values embedded embedded-pos)))]
[else (next-loop)]))))))])
(rename [super-get-keymaps get-keymaps])
(override
[get-keymaps
(lambda ()
(cons (keymap:get-search) (super-get-keymaps)))])
(sequence
(apply super-init args)
(let ([keymap (get-keymap)])
(keymap:set-keymap-error-handler keymap)
(keymap:set-keymap-implied-shifts keymap)
(send keymap chain-to-keymap (keymap:get-search) #f)))))
(apply super-init args))))
(define return<%> (interface (text<%>)))
@ -516,7 +521,7 @@
#f))))])
(sequence (apply super-init args))))
(define basic% (basic-mixin (editor:basic-mixin text%)))
(define basic% (basic-mixin (editor:keymap-mixin (editor:basic-mixin text%))))
(define return% (return-mixin basic%))
(define file% (editor:file-mixin basic%))
(define clever-file-format% (clever-file-format-mixin file%))