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

fix bug that inhibited certain menus from appearing. Also Rackety

Browse Source 
closes PR 12155
This commit is contained in:
Robby Findler 2011-09-01 18:03:07 -05:00
parent feefa31401
commit 8c7846fff4
1 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/drracket/private/syncheck/gui.rkt
View File

@ -538,14 +538,13 @@ If the namespace does not, they are colored the unbound color.
[else #f])) [else #f]))
(define/public (syncheck:add-require-open-menu text start-pos end-pos file) (define/public (syncheck:add-require-open-menu text start-pos end-pos file)
(define (make-require-open-menu file) (define ((make-require-open-menu file) menu)
(λ (menu) (define-values (base name dir?) (split-path file))
(let-values ([(base name dir?) (split-path file)]) (new menu-item%
(instantiate menu-item% () (label (fw:gui-utils:format-literal-label (string-constant cs-open-file) (path->string name)))
(label (fw:gui-utils:format-literal-label (string-constant cs-open-file) (path->string name))) (parent menu)
(parent menu) (callback (λ (x y) (fw:handler:edit-file file))))
(callback (λ (x y) (fw:handler:edit-file file)))) (void))
(void))))
(syncheck:add-menu text start-pos end-pos #f (make-require-open-menu file))) (syncheck:add-menu text start-pos end-pos #f (make-require-open-menu file)))
(define/public (syncheck:add-docs-menu text start-pos end-pos id the-label path tag) (define/public (syncheck:add-docs-menu text start-pos end-pos id the-label path tag)
@ -666,7 +665,7 @@ If the namespace does not, they are colored the unbound color.
(define/private (syncheck:add-menu text start-pos end-pos key make-menu) (define/private (syncheck:add-menu text start-pos end-pos key make-menu)
(when arrow-records (when arrow-records
(when (and (<= 0 start-pos end-pos (last-position))) (when (<= 0 start-pos end-pos (last-position))
(add-to-range/key text start-pos end-pos make-menu key (and key #t))))) (add-to-range/key text start-pos end-pos make-menu key (and key #t)))))
(define/public (syncheck:add-background-color text start fin color) (define/public (syncheck:add-background-color text start fin color)
@ -880,7 +879,6 @@ If the namespace does not, they are colored the unbound color.
(define last-known-mouse-x #f) (define last-known-mouse-x #f)
(define last-known-mouse-y #f) (define last-known-mouse-y #f)
(define/override (on-event event) (define/override (on-event event)
(cond (cond
[(send event leaving?) [(send event leaving?)
(set! last-known-mouse-x #f) (set! last-known-mouse-x #f)
@ -970,7 +968,8 @@ If the namespace does not, they are colored the unbound color.
[arrows (filter arrow? vec-ents)] [arrows (filter arrow? vec-ents)]
[def-links (filter def-link? vec-ents)] [def-links (filter def-link? vec-ents)]
[var-arrows (filter var-arrow? arrows)] [var-arrows (filter var-arrow? arrows)]
[add-menus (map cdr (filter pair? vec-ents))]) [add-menus (append (map cdr (filter pair? vec-ents))
(filter procedure? vec-ents))])
(unless (null? arrows) (unless (null? arrows)
(make-object menu-item% (make-object menu-item%
(string-constant cs-tack/untack-arrow) (string-constant cs-tack/untack-arrow)