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

Added context popup menu to syntax browser & macro stepper

Browse Source 
Made identifier=? menus use checkable items

svn: r4461

original commit: 00b0dc8f10ce311a620aead3844af299440a0124
This commit is contained in:
Ryan Culpepper 2006-10-01 22:38:19 +00:00
parent 86e824488c
commit 19920550e1
2 changed files with 48 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/macro-debugger/syntax-browser/controller.ss
View File

@ -16,6 +16,7 @@
(define colorers null)
(define selection-listeners null)
(define selected-syntax #f)
(define identifier=?-listeners null)
(init-field (properties-controller
(new independent-properties-controller% (controller this))))
@ -27,8 +28,7 @@
(for-each (lambda (c) (send c select-syntax stx)) colorers)
(for-each (lambda (p) (p stx)) selection-listeners))
(define/public (get-selected-syntax)
selected-syntax)
(define/public (get-selected-syntax) selected-syntax)
(define/public (get-properties-controller) properties-controller)
@ -41,10 +41,15 @@
(define/public (add-selection-listener p)
(set! selection-listeners (cons p selection-listeners)))
(define/public (on-update-identifier=? id=?)
(define/public (on-update-identifier=? name id=?)
(set! -secondary-partition
(and id=? (new partition% (relation id=?))))
(for-each (lambda (c) (send c refresh)) colorers))
(for-each (lambda (c) (send c refresh)) colorers)
(for-each (lambda (f) (f name id=?)) identifier=?-listeners))
(define/public (add-identifier=?-listener f)
(set! identifier=?-listeners
(cons f identifier=?-listeners)))
(define/public (erase)
(set! colorers null))

45
collects/macro-debugger/syntax-browser/widget.ss
View File

@ -77,6 +77,36 @@
"")
(send e get-time-stamp)))))
;; FIXME: Add option for "formatted" copy/paste?
(new menu-item%
(label "Clear selection")
(parent context-menu)
(callback (lambda _ (send controller select-syntax #f))))
(new separator-menu-item% (parent context-menu))
;; properties
(new menu-item%
(label "Show/hide syntax properties")
(parent context-menu)
(callback (lambda _ (toggle-props))))
;; primary selection
(let ([secondary (new menu% (label "identifier=?") (parent context-menu))])
(for-each
(lambda (name func)
(let ([this-choice
(new checkable-menu-item%
(label name)
(parent secondary)
(callback
(lambda (i e)
(send controller on-update-identifier=? name func))))])
(send controller add-identifier=?-listener
(lambda (new-name new-id=?)
(send this-choice check (eq? name new-name))))))
(map car (identifier=-choices))
(map cdr (identifier=-choices))))
context-menu))
;; syntax-properties-controller<%> methods
@ -202,15 +232,16 @@
(callback (lambda _ (toggle-props))))
(define/private (on-update-identifier=?-choice)
(let ([id=? (get-identifier=?)])
(send (get-controller) on-update-identifier=? id=?)))
(define/private (get-identifier=?)
(cond [(assoc (send -choice get-string-selection)
-identifier=-choices)
=> cdr]
[else #f]))))
=> (lambda (p)
(send (get-controller)
on-update-identifier=? (car p) (cdr p)))]
[else #f]))
(send (get-controller) add-identifier=?-listener
(lambda (name func)
(send -choice set-selection
(or (send -choice find-string name) 0))))))
;; syntax-browser-frame%
(define syntax-browser-frame%