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

...

Browse Source 
original commit: 824b5b741a60072823036ef363ec8af77cfd5795
This commit is contained in:
Robby Findler 1998-10-30 15:10:45 +00:00
parent 81fb41f957
commit 2bcea31ff4
5 changed files with 52 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/framework/scheme.ss
View File

@ -20,13 +20,11 @@
(define -text<%>
(interface ()
highlight-parens?
highlight-parens
get-limit
balance-quotes
balance-parens
tabify-on-return?
match-round-to-square?
tabify
tabify-selection
tabify-all
@ -45,14 +43,14 @@
find-down-sexp
down-sexp
remove-parens-forward
standard-style-delta
select-forward-sexp
select-backward-sexp
select-up-sexp
select-down-sexp
transpose-sexp
tab-size))
get-tab-size
set-tab-size))
(define init-wordbreak-map
(lambda (map)
@ -61,9 +59,11 @@
#\-
'(line)))))
(define wordbreak-map (make-object editor-wordbreak-map%))
(define (get-wordbreak-map) wordbreak-map)
(init-wordbreak-map wordbreak-map)
(define style-list (make-object style-list%))
(define (get-style-list) style-list)
(define standard-style-delta
(let ([delta (make-object style-delta% 'change-normal)])
(send delta set-delta 'change-family 'modern)
@ -115,7 +115,7 @@
(if (= -1 f)
#f
(= (send position-line f) line))))
scheme-paren:comments)))])
(scheme-paren:get-comments))))])
(private
[remove-indents-callback
(preferences:add-callback
@ -134,7 +134,6 @@
(rename [super-on-focus on-focus]
[super-on-change-style on-change-style]
[super-after-change-style after-change-style]
[super-on-edit-sequence on-edit-sequence]
[super-after-edit-sequence after-edit-sequence]
[super-on-insert on-insert]
[super-after-insert after-insert]
@ -159,9 +158,6 @@
(unless (get-styles-fixed)
(highlight-parens))
(super-after-change-style))]
[on-edit-sequence
(lambda ()
(super-on-edit-sequence))]
[after-edit-sequence
(lambda ()
(unless in-highlight-parens?
@ -206,10 +202,8 @@
(lambda ()
(highlight-parens))])
(public
[highlight-parens? (preferences:get 'framework:highlight-parens)])
(private
[highlight-parens? (preferences:get 'framework:highlight-parens)]
[remove-paren-callback (preferences:add-callback
'framework:highlight-parens
(lambda (p value)
@ -219,7 +213,7 @@
(lambda (pos)
(let loop ([pos pos])
(let ([paren-pos (apply max (map (lambda (pair) (find-string (car pair) -1 pos -1 #f))
scheme-paren:paren-pairs))])
(scheme-paren:get-paren-pairs)))])
(cond
[(= -1 paren-pos) #f]
[else
@ -263,7 +257,7 @@
(lambda (f)
(lambda (char)
(ormap (lambda (x) (char=? char (string-ref (f x) 0)))
scheme-paren:paren-pairs)))]
(scheme-paren:get-paren-pairs))))]
[is-left-paren? (is-paren? car)]
[is-right-paren? (is-paren? cdr)])
(when (and (= here there)
@ -327,7 +321,7 @@
[fixup-parens? (preferences:get 'framework:fixup-parens)]
[find-match
(lambda (pos)
(let loop ([parens scheme-paren:paren-pairs])
(let loop ([parens (scheme-paren:get-paren-pairs)])
(cond
[(null? parens) #f]
[else (let* ([paren (car parens)]
@ -364,7 +358,6 @@
[else (insert char)])
#t)))]
[tabify-on-return? (lambda () #t)]
[match-round-to-square? (lambda () #t)]
[tabify
(opt-lambda ([pos (get-start-position)])
(let* ([last-pos (last-position)]
@ -655,7 +648,7 @@
(if (and exp-pos (> exp-pos 0))
(let ([pos (apply max
(map paren-pos scheme-paren:paren-pairs))])
(map paren-pos (scheme-paren:get-paren-pairs)))])
(if (= pos -1) ;; all finds failed
#f
(- pos 1))) ;; subtract one to move outside the paren
@ -706,8 +699,7 @@
(delete (- closer 2) (- closer 1))
(end-edit-sequence))
(bell))
#t))]
[standard-style-delta #f])
#t))])
(private
[select-text
@ -752,8 +744,12 @@
(insert text-1 start-2 end-2)
(insert text-2 start-1 end-1)
(set-position end-2)
(end-edit-sequence)))))))))))]
(end-edit-sequence)))))))))))])
(private
[tab-size 8])
(public
[get-tab-size (lambda () tab-size)]
[set-tab-size (lambda (s) (set! tab-size s))])
(sequence
(apply super-init args)
@ -895,4 +891,5 @@
(send keymap map-function "c:c;c:b" "remove-parens-forward")))
(define keymap (make-object keymap%))
(setup-keymap keymap))
(setup-keymap keymap)
(define (get-keymap) keymap))

25
collects/framework/sig.ss
View File

@ -80,6 +80,7 @@
(define-signature framework:editor^
(basic<%>
info<%>
file<%>
backup-autosave<%>
basic-mixin
@ -96,19 +97,23 @@
(define-signature framework:text^
(basic<%>
searching<%>
return<%>
info<%>
clever-file-format<%>
basic-mixin
return-mixin
searching-mixin
return-mixin
info-mixin
clever-file-format-mixin
basic%
return%
searching%
info%
file%
clever-file-format%
backup-autosave%))
backup-autosave%
searching%
info%))
(define-signature framework:pasteboard%
(pasteboard:basic%
@ -210,19 +215,19 @@
(%))
(define-signature framework:scheme-paren^
(paren-pairs
quote-pairs
comments
(get-comments
get-paren-pairs
get-quote-pairs
forward-match
backward-match
balanced?
backward-containing-sexp))
(define-signature framework:scheme^
(wordbreak-map
(get-wordbreak-map
init-wordbreak-map
style-list
keymap
get-style-list
get-keymap
setup-keymap
text-mixin
text<%>

18
collects/framework/standard-menus-items.ss
View File

@ -17,14 +17,14 @@
(define items
(list (make-generic 'get-menu% '(lambda () menu%)
'("The result of this method is used as the class for creating:"
"@mlink file-menu %"
'("The result of this method is used as the class for creating the result of these methods:"
"@mlink get-file-menu %"
", "
"@mlink edit-menu %"
"@mlink get-edit-menu %"
", "
"@mlink windows-menu %"
"@mlink get-windows-menu %"
", and"
"@mlink help-menu %"
"@mlink get-help-menu %"
". "
""
"@return : (derived-from \\iscmclass{menu})"
@ -50,7 +50,7 @@
(lambda () m))
'("Returns the file menu"
"See also"
"@mlink get-menu\%"
"@mlink get-menu\\%"
""
"@return : (instance (derived-from \\iscmclass{menu}))"))
(make-generic 'get-edit-menu
@ -59,7 +59,7 @@
'("Returns the edit menu"
"See also"
"@mlink get-menu\%"
"@mlink get-menu\\%"
""
"@return : (instance (derived-from \\iscmclass{menu}))"))
(make-generic 'get-windows-menu
@ -68,7 +68,7 @@
'("Returns the windows menu"
"See also"
"@mlink get-menu\%"
"@mlink get-menu\\%"
""
"@return : (instance (derived-from \\iscmclass{menu}))"))
(make-generic 'get-help-menu
@ -77,7 +77,7 @@
'("Returns the help menu"
"See also"
"@mlink get-menu\%"
"@mlink get-menu\\%"
""
"@return : (instance (derived-from \\iscmclass{menu}))"))

1
collects/framework/test.ss
View File

@ -1,4 +1,5 @@
(printf "1~n")
(require-library "errortrace.ss" "errortrace")
(read-case-sensitive #t)
(compile-allow-cond-fallthrough #t)
(compile-allow-set!-undefined #t)

14
collects/framework/text.ss
View File

@ -312,8 +312,6 @@
(keymap:set-keymap-implied-shifts keymap)
(send keymap chain-to-keymap (keymap:get-global) #f)))))
(define file<%> (interface (basic<%>)))
(define searching<%>
(interface ()
find-string-embedded))
@ -407,8 +405,10 @@
(keymap:set-keymap-implied-shifts keymap)
(send keymap chain-to-keymap (keymap:get-search) #f)))))
(define return<%> (interface (text<%>)))
(define return-mixin
(mixin (text<%>) (text<%>) (return . args)
(mixin (text<%>) (return<%>) (return . args)
(rename [super-on-local-char on-local-char])
(override
[on-local-char
@ -423,8 +423,10 @@
(sequence
(apply super-init args))))
(define info<%> (interface (editor:basic<%> text<%>)))
(define info-mixin
(mixin (editor:basic<%> text<%>) (editor:basic<%> text<%>) args
(mixin (editor:basic<%> text<%>) (info<%>) args
(inherit get-start-position get-end-position get-canvas
run-after-edit-sequence)
(rename [super-after-set-position after-set-position]
@ -471,8 +473,10 @@
(enqueue-for-frame 'edit-position-changed
'framework:edit-position-changed))])))
(define clever-file-format<%> (interface (text<%>)))
(define clever-file-format-mixin
(mixin (text<%>) (text<%>) args
(mixin (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])