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

.

Browse Source 
original commit: 12cb552377c45864be81c0dbf1177a907636b835
This commit is contained in:
Robby Findler 2004-06-28 03:28:14 +00:00
parent 7486c4c96d
commit 4be0a2f1af
2 changed files with 27 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/framework/private/mode.ss
View File

@ -45,10 +45,10 @@
(augment (void) after-load-file (success?)) (augment (void) after-load-file (success?))
(augment (void) after-save-file (success?)) (augment (void) after-save-file (success?))
(augment #f can-change-style? (start len)) (augment #t can-change-style? (start len))
(augment #f can-delete? (start len)) (augment #t can-delete? (start len))
(augment #f can-insert? (start len)) (augment #t can-insert? (start len))
(augment #f can-set-size-constraint? ()) (augment #t can-set-size-constraint? ())
(augment #f can-do-edit-operation? (op recursive?)) (augment #t can-do-edit-operation? (op) (op recursive?))
(augment #f can-load-file? (filename format)) (augment #t can-load-file? (filename format))
(augment #f can-save-file? (filename format))))))) (augment #t can-save-file? (filename format)))))))

43
collects/framework/private/text.ss
View File

@ -68,7 +68,7 @@ WARNING: printf is rebound in the body of the unit to always
(define range-rectangles null) (define range-rectangles null)
(define ranges null) (define ranges null)
(define/public (get-highlighted-ranges) ranges) (define/public-final (get-highlighted-ranges) ranges)
(define (invalidate-rectangles rectangles) (define (invalidate-rectangles rectangles)
(let ([b1 (box 0)] (let ([b1 (box 0)]
@ -589,8 +589,8 @@ WARNING: printf is rebound in the body of the unit to always
(define delegate #f) (define delegate #f)
(inherit get-highlighted-ranges) (inherit get-highlighted-ranges)
(define/public (get-delegate) delegate) (define/public-final (get-delegate) delegate)
(define/public (set-delegate _d) (define/public-final (set-delegate _d)
(set! delegate _d) (set! delegate _d)
(set! linked-snips (if _d (set! linked-snips (if _d
(make-hash-table) (make-hash-table)
@ -879,7 +879,7 @@ WARNING: printf is rebound in the body of the unit to always
;; insert-between : string -> void ;; insert-between : string -> void
;; inserts something between the insertion point and the unread region ;; inserts something between the insertion point and the unread region
(define/public (insert-between str) (define/public-final (insert-between str)
(insert str unread-start-point unread-start-point) (insert str unread-start-point unread-start-point)
(set! unread-start-point (+ insertion-point (set! unread-start-point (+ insertion-point
;; string-length is bad here ;; string-length is bad here
@ -888,36 +888,33 @@ WARNING: printf is rebound in the body of the unit to always
;; has-between? : -> boolean ;; has-between? : -> boolean
;; indicates if there is currently some text after the insertion ;; indicates if there is currently some text after the insertion
;; point, but before the unread region ;; point, but before the unread region
(define/public (has-between?) (define/public-final (has-between?)
(not (= insertion-point unread-start-point))) (not (= insertion-point unread-start-point)))
(define/public (get-insertion-point) insertion-point) (define/public-final (get-insertion-point) insertion-point)
(define/public (set-insertion-point ip) (set! insertion-point ip)) (define/public-final (set-insertion-point ip) (set! insertion-point ip))
(define/public (get-unread-start-point) unread-start-point) (define/public-final (get-unread-start-point) unread-start-point)
(define/public (set-unread-start-point u) (set! unread-start-point u)) (define/public-final (set-unread-start-point u) (set! unread-start-point u))
(define/public (set-allow-edits allow?) (set! allow-edits? allow?)) (define/public-final (set-allow-edits allow?) (set! allow-edits? allow?))
(define/public (get-allow-edits) allow-edits?) (define/public-final (get-allow-edits) allow-edits?)
(define/public (send-eof-to-in-port) (channel-put read-chan eof)) (define/public-final (send-eof-to-in-port) (channel-put read-chan eof))
(define/public-final (clear-input-port) (channel-put clear-input-chan (void)))
(define/public (clear-input-port) (define/public-final (clear-output-ports)
(channel-put clear-input-chan (void)))
(define/public (clear-output-ports)
(channel-put clear-output-chan (void)) (channel-put clear-output-chan (void))
(init-output-ports)) (init-output-ports))
(define/public (get-in-port) (define/public-final (get-in-port)
(unless in-port (error 'get-in-port "not ready")) (unless in-port (error 'get-in-port "not ready"))
in-port) in-port)
(define/public (get-out-port) (define/public-final (get-out-port)
(unless out-port (error 'get-out-port "not ready")) (unless out-port (error 'get-out-port "not ready"))
out-port) out-port)
(define/public (get-err-port) (define/public-final (get-err-port)
(unless err-port (error 'get-err-port "not ready")) (unless err-port (error 'get-err-port "not ready"))
err-port) err-port)
(define/public (get-value-port) (define/public-final (get-value-port)
(unless err-port (error 'get-value-port "not ready")) (unless err-port (error 'get-value-port "not ready"))
value-port) value-port)
@ -926,8 +923,8 @@ WARNING: printf is rebound in the body of the unit to always
;; specialization interface ;; specialization interface
;; ;;
(define/public (submit-to-port? key) #t) (define/pubment (submit-to-port? key) (inner #t submit-to-port? key))
(define/public (on-submit) (void)) (define/pubment (on-submit) (inner (void) on-submit))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;