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

Macro stepper: added properties display code (but disabled)

Browse Source 
svn: r5668

original commit: 516257199464ee7cc7e811afc5fa26befe38ce1f
This commit is contained in:
Ryan Culpepper 2007-02-22 22:52:29 +00:00
parent fc798ea166
commit 41538c81f5
1 changed files with 38 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/macro-debugger/syntax-browser/properties.ss
View File

@ -3,7 +3,9 @@
(require "interfaces.ss" (require "interfaces.ss"
"util.ss" "util.ss"
(lib "class.ss") (lib "class.ss")
(lib "mred.ss" "mred")) (lib "mred.ss" "mred")
(lib "framework.ss" "framework")
(lib "interactive-value-port.ss" "mrlib"))
(provide properties-view% (provide properties-view%
properties-snip%) properties-snip%)
@ -54,7 +56,7 @@
(else (error 'properties-view%:refresh "internal error: no such mode: ~s" mode)))) (else (error 'properties-view%:refresh "internal error: no such mode: ~s" mode))))
;; text : text% ;; text : text%
(field (text (new text%))) (field (text (new text%))) ;; text:wide-snip%)))
(field (pdisplayer (new properties-displayer% (text text)))) (field (pdisplayer (new properties-displayer% (text text))))
(send text set-styles-sticky #f) (send text set-styles-sticky #f)
@ -118,6 +120,7 @@
(lambda (tp e) (lambda (tp e)
(set-mode (set-mode
(cdr (list-ref tab-choices (send tp get-selection)))))))) (cdr (list-ref tab-choices (send tp get-selection))))))))
;; canvas:wide-?%
(define ecanvas (new editor-canvas% (editor text) (parent tab-panel))))) (define ecanvas (new editor-canvas% (editor text) (parent tab-panel)))))
;; properties-displayer% ;; properties-displayer%
@ -203,7 +206,7 @@
(when (null? keys) (when (null? keys)
(display "No additional properties available.\n" n/a-sd)) (display "No additional properties available.\n" n/a-sd))
(when (pair? keys) (when (pair? keys)
(for-each (lambda (k) (display-subkv k (syntax-property stx k))) (for-each (lambda (k) (display-subkv/value k (syntax-property stx k)))
keys)))) keys))))
;; display-kv : any any -> void ;; display-kv : any any -> void
@ -216,6 +219,23 @@
(display (format "~a: " k) sub-key-sd) (display (format "~a: " k) sub-key-sd)
(display (format "~a~n" v) #f)) (display (format "~a~n" v) #f))
(define/public (display-subkv/value k v)
(display-subkv k v)
#;
(begin
(display (format "~a:~n" k) sub-key-sd)
(let* ([value-text (new text:standard-style-list% (auto-wrap #t))]
[value-snip (new editor-snip% (editor value-text))]
[value-port (make-text-port value-text)])
(set-interactive-write-handler value-port)
(set-interactive-print-handler value-port)
(set-interactive-display-handler value-port)
(write v value-port)
(send value-text lock #t)
(send text insert value-snip)
(send text insert "\n")
#;(send ecanvas add-wide-snip value-snip))))
;; display : string style-delta -> void ;; display : string style-delta -> void
(define/private (display item sd) (define/private (display item sd)
(let ([p0 (send text last-position)]) (let ([p0 (send text last-position)])
@ -247,6 +267,20 @@
'editor] 'editor]
[else s])) [else s]))
;; make-text-port : text -> port
;; builds a port from a text object.
(define (make-text-port text)
(make-output-port #f
always-evt
(lambda (s start end flush? enable-break?)
(send text insert
(bytes->string/utf-8 s #f start end))
(- end start))
void
(lambda (special buffer? enable-break?)
(send text insert special)
#t)))
;; Styles ;; Styles
(define key-sd (define key-sd