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

Fixed alignment of syntax-snips, separate controllers, props icon

Browse Source 
svn: r5285

original commit: f546667d50aeb1b3baf23d102509196e5847f257
This commit is contained in:
Ryan Culpepper 2007-01-10 00:17:17 +00:00
parent bf64dc78e3
commit e1f644c03f
1 changed files with 34 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
collects/macro-debugger/syntax-browser/syntax-snip.ss
View File

@ -10,7 +10,10 @@
"typesetter.ss")
(provide snip@
snip-keymap-extension@)
;; Every snip has its own controller and properties-controller
;; (because every snip now displays its own properties)
(define snip@
(unit
(import prefs^
@ -25,15 +28,6 @@
(define *syntax-controller* #f)
(define (the-syntax-controller)
(let ([controller *syntax-controller*])
(or controller
(let* ([controller (new syntax-controller%)]
[props (new independent-properties-controller% (controller controller))])
(send controller set-properties-controller props)
(set! *syntax-controller* controller)
controller))))
;; syntax-value-snip%
(define syntax-value-snip%
(class* editor-snip% (readable-snip<%>)
@ -93,27 +87,32 @@
(list src line col pos 1))
#`(force '#,(delay stx)))
))
;; syntax-snip%
(define syntax-snip%
(class* editor-snip% (readable-snip<%>)
(init-field ((stx syntax)))
(init-field (controller (the-syntax-controller)))
(inherit set-margin
set-inset
set-snipclass
set-tight-text-fit
show-border)
(define controller (new syntax-controller%))
(define properties-controller
(new independent-properties-controller%
(syntax stx)
(controller controller)))
(send controller set-properties-controller properties-controller)
(define -outer (new text%))
(super-new (editor -outer) (with-border? #f))
(set-margin 0 0 0 0)
(set-inset 0 0 0 0)
(set-snipclass snip-class)
(send -outer select-all)
(send -outer change-style (make-object style-delta% 'change-alignment 'top)
0
(send -outer last-position))
(define the-syntax-snip
(new syntax-value-snip% (syntax stx) (controller controller)))
(define the-summary
@ -146,7 +145,13 @@
(outer:insert (hide-icon) style:hyper (lambda _ (hide-me)))
(outer:insert " ")
(outer:insert the-syntax-snip)
(outer:insert " ")
(outer:insert (show-properties-icon) style:hyper
(lambda _ (send properties-controller show #t)))
(send* -outer
(change-style (make-object style-delta% 'change-alignment 'top)
0
(send -outer last-position))
(lock #t)
(end-edit-sequence)))
@ -166,7 +171,7 @@
;; Snip methods
(define/override (copy)
(new syntax-snip% (controller controller) (syntax stx)))
(new syntax-snip% (syntax stx)))
(define/override (write stream)
(send stream put (string->bytes/utf-8 (format "~s" (marshall-syntax stx)))))
(define/public (read-special src line col pos)
@ -181,11 +186,19 @@
(define independent-properties-controller%
(class* object% (syntax-properties-controller<%>)
(init-field controller)
(init-field ((stx syntax) #f))
;; Properties display
(define parent
(new frame% (label "Properties") (height (pref:height))
(width (floor (* (pref:props-percentage) (pref:width))))))
;(define vp (new panel:vertical-dragable% (parent parent)))
;(define syntax-text (new text%))
;(define syntax-canvas (new editor-canvas% (parent vp) (editor syntax-text)))
;(let ([ss (new syntax-value-snip% (syntax stx) (controller controller))])
; (send syntax-text insert ss)
; ...)
;(send syntax-text lock #t)
(define pv (new properties-view% (parent parent)))
(define/private (show-properties)
@ -236,6 +249,10 @@
(make-object image-snip%
(build-path (collection-path "icons") "turn-down.png")))
(define (show-properties-icon)
(make-object image-snip%
(build-path (collection-path "icons") "syncheck.png")))
;; marshall-syntax : syntax -> printable
(define (marshall-syntax stx)
(unless (syntax? stx)