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

Fixing bad re-indent.. I think?

Browse Source
This commit is contained in:
Jay McCarthy 2012-05-10 12:37:27 -06:00
parent 611e8d0d17
commit b703148833
3 changed files with 113 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/xml/scheme-snipclass.rkt
View File

@ -7,27 +7,27 @@
(define scheme-snip%
(class* editor-snip% (scheme-snip<%> readable-snip<%>)
(init-field splice?)
(define/public (get-splice?) splice?)
(init-field splice?)
(define/public (get-splice?) splice?)
(define/public (read-special file line col pos)
(scheme-read-special this
file
line
col
pos))
(define/public (read-special file line col pos)
(scheme-read-special this
file
line
col
pos))
(super-instantiate ())))
(super-instantiate ())))
(define scheme-snipclass%
(class snip-class%
(define/override (read stream-in)
(let* ([splice? (zero? (send stream-in get-exact))]
[snip (instantiate scheme-snip% ()
(splice? splice?))])
(send (send snip get-editor) read-from-file stream-in #f)
snip))
(super-instantiate ())))
(define/override (read stream-in)
(let* ([splice? (zero? (send stream-in get-exact))]
[snip (instantiate scheme-snip% ()
(splice? splice?))])
(send (send snip get-editor) read-from-file stream-in #f)
snip))
(super-instantiate ())))
(define snip-class (make-object scheme-snipclass%))
(send snip-class set-version 1)

162
collects/xml/text-snipclass.rkt
View File

@ -44,8 +44,8 @@
(define snipclass-text-box%
(class decorated-editor-snipclass%
(define/override (make-snip stream-in) (new text-box%))
(super-instantiate ())))
(define/override (make-snip stream-in) (new text-box%))
(super-instantiate ())))
(define old-snipclass (new snipclass-text-box%))
(send old-snipclass set-version 1)
@ -59,90 +59,90 @@
(define text-box%
(class* decorated-editor-snip% (readable-snip<%>)
(define/override (make-editor) (let ([e (new text:keymap%)])
(send e set-max-undo-history 'forever)
e))
(define/override (make-snip) (make-object text-box%))
(inherit get-editor get-admin)
(define/override (make-editor) (let ([e (new text:keymap%)])
(send e set-max-undo-history 'forever)
e))
(define/override (make-snip) (make-object text-box%))
(inherit get-editor get-admin)
(define/override (get-corner-bitmap)
(get-icon))
(define/override (get-corner-bitmap)
(get-icon))
(define/override (get-menu)
(let ([menu (new popup-menu%)])
(new menu-item%
(label "Convert to string")
(parent menu)
(callback
(lambda (x y)
(let ([to-ed (find-containing-editor)])
(when to-ed
(let ([this-pos (find-this-position)])
(when this-pos
(let ([from-ed (get-editor)])
(send to-ed begin-edit-sequence)
(send from-ed begin-edit-sequence)
(send to-ed delete this-pos (+ this-pos 1))
(let* ((p (open-input-text-editor from-ed 0 'end
(lambda (s)
(values (box s) 1))))
(contents
(let loop ((next (read-char-or-special p)))
(cond
((eof-object? next) null)
(else
(cons next (loop (read-char-or-special p)))))))
(repaired-contents
(map (lambda (x)
(if (string? x)
(marshall x)
(send (unbox x) copy)))
(chunk-string contents null))))
(for-each
(lambda (x)
(send to-ed insert x this-pos))
(reverse repaired-contents)))
(send to-ed end-edit-sequence)
(send from-ed end-edit-sequence)))))))))
menu))
(define/override (get-menu)
(let ([menu (new popup-menu%)])
(new menu-item%
(label "Convert to string")
(parent menu)
(callback
(lambda (x y)
(let ([to-ed (find-containing-editor)])
(when to-ed
(let ([this-pos (find-this-position)])
(when this-pos
(let ([from-ed (get-editor)])
(send to-ed begin-edit-sequence)
(send from-ed begin-edit-sequence)
(send to-ed delete this-pos (+ this-pos 1))
(let* ((p (open-input-text-editor from-ed 0 'end
(lambda (s)
(values (box s) 1))))
(contents
(let loop ((next (read-char-or-special p)))
(cond
((eof-object? next) null)
(else
(cons next (loop (read-char-or-special p)))))))
(repaired-contents
(map (lambda (x)
(if (string? x)
(marshall x)
(send (unbox x) copy)))
(chunk-string contents null))))
(for-each
(lambda (x)
(send to-ed insert x this-pos))
(reverse repaired-contents)))
(send to-ed end-edit-sequence)
(send from-ed end-edit-sequence)))))))))
menu))
;; find-containing-editor : -> (union #f editor)
(define/private (find-containing-editor)
(let ([admin (get-admin)])
(and admin
(send admin get-editor))))
;; find-containing-editor : -> (union #f editor)
(define/private (find-containing-editor)
(let ([admin (get-admin)])
(and admin
(send admin get-editor))))
;; find-this-position : -> (union #f number)
(define/private (find-this-position)
(let ([ed (find-containing-editor)])
(and ed
(send ed get-snip-position this))))
;; find-this-position : -> (union #f number)
(define/private (find-this-position)
(let ([ed (find-containing-editor)])
(and ed
(send ed get-snip-position this))))
;; input-port -> (union (listof char) char eof-object? syntax-object)
(define/private (get-next port)
(let ([v (read-char-or-special port)])
(if (special-comment? v)
(get-next port)
v)))
;; input-port -> (union (listof char) char eof-object? syntax-object)
(define/private (get-next port)
(let ([v (read-char-or-special port)])
(if (special-comment? v)
(get-next port)
v)))
(define/public (read-special source line column position)
(let* ((ed (get-editor))
(port (open-input-text-editor ed))
(str (let loop ((next (get-next port)))
(cond
((eof-object? next) null)
((char? next)
(cons next (loop (get-next port))))
(else (cons #`(marshall #,next) (loop (get-next port))))))))
#`(let ((marshall
(lambda (s)
(let ((os (open-output-string)))
(with-handlers ((exn:fail? (lambda (x) "")))
(display s os)
(get-output-string os))))))
(string-append #,@(chunk-string str null)))))
(define/public (read-special source line column position)
(let* ((ed (get-editor))
(port (open-input-text-editor ed))
(str (let loop ((next (get-next port)))
(cond
((eof-object? next) null)
((char? next)
(cons next (loop (get-next port))))
(else (cons #`(marshall #,next) (loop (get-next port))))))))
#`(let ((marshall
(lambda (s)
(let ((os (open-output-string)))
(with-handlers ((exn:fail? (lambda (x) "")))
(display s os)
(get-output-string os))))))
(string-append #,@(chunk-string str null)))))
(super-instantiate ())
(inherit set-snipclass)
(set-snipclass snipclass)))
(super-instantiate ())
(inherit set-snipclass)
(set-snipclass snipclass)))

32
collects/xml/xml-snipclass.rkt
View File

@ -7,27 +7,27 @@
(define xml-snip%
(class* editor-snip% (xml-snip<%> readable-snip<%>)
(init-field eliminate-whitespace-in-empty-tags?)
(init-field eliminate-whitespace-in-empty-tags?)
(define/public (read-special file line col pos)
(xml-read-special eliminate-whitespace-in-empty-tags?
this
file
line
col
pos))
(define/public (read-special file line col pos)
(xml-read-special eliminate-whitespace-in-empty-tags?
this
file
line
col
pos))
(super-new)))
(super-new)))
(define xml-snipclass%
(class snip-class%
(define/override (read stream-in)
(let* ([eliminate-whitespace-in-empty-tags? (zero? (send stream-in get-exact))]
[snip (instantiate xml-snip% ()
(eliminate-whitespace-in-empty-tags? eliminate-whitespace-in-empty-tags?))])
(send (send snip get-editor) read-from-file stream-in #f)
snip))
(super-new)))
(define/override (read stream-in)
(let* ([eliminate-whitespace-in-empty-tags? (zero? (send stream-in get-exact))]
[snip (instantiate xml-snip% ()
(eliminate-whitespace-in-empty-tags? eliminate-whitespace-in-empty-tags?))])
(send (send snip get-editor) read-from-file stream-in #f)
snip))
(super-new)))
(define snip-class (make-object xml-snipclass%))
(send snip-class set-version 1)