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

Add a missing check for when arrow-records might be #f

Browse Source 
closes PR 13133
This commit is contained in:
Robby Findler 2012-09-21 16:19:28 -05:00
parent 9b6ff5d94d
commit c3a454aebf
1 changed files with 70 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1056,79 +1056,80 @@ If the namespace does not, they are colored the unbound color.
(invalidate-bitmap-cache 0 0 'display-end 'display-end)) (invalidate-bitmap-cache 0 0 'display-end 'display-end))
(define/public (syncheck:build-popup-menu menu pos text) (define/public (syncheck:build-popup-menu menu pos text)
(define arrow-record (hash-ref arrow-records text #f)) (when arrow-records
(when arrow-record (define arrow-record (hash-ref arrow-records text #f))
(define added-sep? #f) (when arrow-record
(define (add-sep) (define added-sep? #f)
(unless added-sep? (define (add-sep)
(set! added-sep? #t) (unless added-sep?
(new separator-menu-item% [parent menu]))) (set! added-sep? #t)
(define vec-ents (interval-map-ref arrow-record pos null)) (new separator-menu-item% [parent menu])))
(define start-selection (send text get-start-position)) (define vec-ents (interval-map-ref arrow-record pos null))
(define end-selection (send text get-end-position)) (define start-selection (send text get-start-position))
(define arrows (filter arrow? vec-ents)) (define end-selection (send text get-end-position))
(define def-links (filter def-link? vec-ents)) (define arrows (filter arrow? vec-ents))
(define var-arrows (filter var-arrow? arrows)) (define def-links (filter def-link? vec-ents))
(define add-menus (append (map cdr (filter pair? vec-ents)) (define var-arrows (filter var-arrow? arrows))
(filter procedure? vec-ents))) (define add-menus (append (map cdr (filter pair? vec-ents))
(unless (null? arrows) (filter procedure? vec-ents)))
(add-sep) (unless (null? arrows)
(make-object menu-item% (add-sep)
(string-constant cs-tack/untack-arrow)
menu
(λ (item evt) (tack/untack-callback arrows))))
(unless (null? def-links)
(add-sep)
(let ([def-link (car def-links)])
(make-object menu-item% (make-object menu-item%
jump-to-definition (string-constant cs-tack/untack-arrow)
menu menu
(λ (item evt) (λ (item evt) (tack/untack-callback arrows))))
(jump-to-definition-callback def-link))))) (unless (null? def-links)
(unless (null? var-arrows) (add-sep)
(add-sep) (let ([def-link (car def-links)])
(make-object menu-item% (make-object menu-item%
jump-to-next-bound-occurrence jump-to-definition
menu menu
(λ (item evt) (jump-to-next-callback pos text arrows))) (λ (item evt)
(make-object menu-item% (jump-to-definition-callback def-link)))))
jump-to-binding (unless (null? var-arrows)
menu (add-sep)
(λ (item evt) (jump-to-binding-callback arrows)))) (make-object menu-item%
(unless (= start-selection end-selection) jump-to-next-bound-occurrence
(add-sep) menu
(define arrows-menu (λ (item evt) (jump-to-next-callback pos text arrows)))
(make-object menu% (make-object menu-item%
"Arrows crossing selection" jump-to-binding
menu)) menu
(define (callback accept) (λ (item evt) (jump-to-binding-callback arrows))))
(tack-crossing-arrows-callback (unless (= start-selection end-selection)
arrow-record (add-sep)
start-selection (define arrows-menu
end-selection (make-object menu%
text "Arrows crossing selection"
accept)) menu))
(make-object menu-item% (define (callback accept)
"Tack arrows" (tack-crossing-arrows-callback
arrows-menu
(lambda (item evt)
(callback
'(lexical top-level imported))))
(make-object menu-item%
"Tack non-import arrows"
arrows-menu
(lambda (item evt)
(callback
'(lexical top-level))))
(make-object menu-item%
"Untack arrows"
arrows-menu
(lambda (item evt)
(untack-crossing-arrows
arrow-record arrow-record
start-selection start-selection
end-selection)))) end-selection
(for-each (λ (f) (f menu)) add-menus))) text
accept))
(make-object menu-item%
"Tack arrows"
arrows-menu
(lambda (item evt)
(callback
'(lexical top-level imported))))
(make-object menu-item%
"Tack non-import arrows"
arrows-menu
(lambda (item evt)
(callback
'(lexical top-level))))
(make-object menu-item%
"Untack arrows"
arrows-menu
(lambda (item evt)
(untack-crossing-arrows
arrow-record
start-selection
end-selection))))
(for-each (λ (f) (f menu)) add-menus))))
(struct tooltip-spec (strings x y w h) #:transparent) (struct tooltip-spec (strings x y w h) #:transparent)