From c9724446e6237778b770294410c94af8be954070 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 1 May 2013 07:17:22 -0500 Subject: [PATCH] adjust check syntax keyboard shortcuts - make them use the same names as the context menu items - add c:x;a to tack/untack arrows --- collects/drracket/private/syncheck/gui.rkt | 43 +++++++++++++------ collects/drracket/private/syncheck/intf.rkt | 3 +- .../private/syncheck/local-member-names.rkt | 1 + .../private/english-string-constants.rkt | 3 +- 4 files changed, 36 insertions(+), 14 deletions(-) diff --git a/collects/drracket/private/syncheck/gui.rkt b/collects/drracket/private/syncheck/gui.rkt index c136f99d1e..b4096277f9 100644 --- a/collects/drracket/private/syncheck/gui.rkt +++ b/collects/drracket/private/syncheck/gui.rkt @@ -702,7 +702,21 @@ If the namespace does not, they are colored the unbound color. an-identifier-location-set)))) - + (define/public (syncheck:tack/untack-arrows text) + (when arrow-records + (define arrow-record (hash-ref arrow-records text #f)) + (define (find-arrows pos) + (define vec-ents (interval-map-ref arrow-record pos null)) + (define arrs (filter arrow? vec-ents)) + (and (not (null? arrs)) arrs)) + (define arrows + (or (find-arrows (send text get-start-position)) + (and (= (send text get-start-position) + (send text get-end-position)) + (find-arrows (- (send text get-start-position) 1))))) + (when arrows + (tack/untack-callback arrows)))) + ;; rename-callback : string ;; (and/c syncheck-text<%> definitions-text<%>) ;; (list source number number) @@ -2177,29 +2191,34 @@ If the namespace does not, they are colored the unbound color. (when (is-a? defs syncheck-text<%>) (send-msg defs obj))))))))))]) (send keymap add-function - "jump to binding occurrence" + (string-constant cs-jump-to-binding) (cs-callback (λ (defs obj) (send defs syncheck:jump-to-binding-occurrence obj)))) (send keymap add-function - "jump to next bound occurrence" + (string-constant cs-jump-to-next-bound-occurrence) (cs-callback (λ (defs obj) (send defs syncheck:jump-to-next-bound-occurrence obj)))) (send keymap add-function - "jump to previous bound occurrence" + (string-constant cs-jump-to-previous-bound-occurrence) (cs-callback (λ (defs obj) (send defs syncheck:jump-to-next-bound-occurrence obj #t)))) (send keymap add-function - "jump to definition (in other file)" + (string-constant cs-jump-to-definition) (cs-callback (λ (defs obj) (send defs syncheck:jump-to-definition obj)))) (send keymap add-function - "rename identifier" + (string-constant cs-rename-id) (cs-callback (λ (defs obj) - (send defs syncheck:rename-identifier obj))))) + (send defs syncheck:rename-identifier obj)))) + (send keymap add-function + (string-constant cs-tack/untack-arrow) + (cs-callback (λ (defs obj) + (send defs syncheck:tack/untack-arrows obj))))) (send keymap map-function "f6" "check syntax") (send keymap map-function "c:c;c:c" "check syntax") - (send keymap map-function "c:x;b" "jump to binding occurrence") - (send keymap map-function "c:x;n" "jump to next bound occurrence") - (send keymap map-function "c:x;p" "jump to previous bound occurrence") - (send keymap map-function "c:x;d" "jump to definition (in other file)") - (send keymap map-function "c:x;m" "rename identifier") + (send keymap map-function "c:x;b" (string-constant cs-jump-to-binding)) + (send keymap map-function "c:x;n" (string-constant cs-jump-to-next-bound-occurrence)) + (send keymap map-function "c:x;p" (string-constant cs-jump-to-previous-bound-occurrence)) + (send keymap map-function "c:x;d" (string-constant cs-jump-to-definition)) + (send keymap map-function "c:x;m" (string-constant cs-rename-id)) + (send keymap map-function "c:x;a" (string-constant cs-tack/untack-arrow)) (send keymap add-function "show/hide blue boxes in upper-right corner" (λ (txt evt) diff --git a/collects/drracket/private/syncheck/intf.rkt b/collects/drracket/private/syncheck/intf.rkt index 047a5e1bea..951ad11da0 100644 --- a/collects/drracket/private/syncheck/intf.rkt +++ b/collects/drracket/private/syncheck/intf.rkt @@ -27,7 +27,8 @@ syncheck:jump-to-next-bound-occurrence syncheck:jump-to-binding-occurrence syncheck:jump-to-definition - syncheck:rename-identifier)) + syncheck:rename-identifier + syncheck:tack/untack-arrows)) ;; use this to communicate the frame being ;; syntax checked w/out having to add new diff --git a/collects/drracket/private/syncheck/local-member-names.rkt b/collects/drracket/private/syncheck/local-member-names.rkt index 1b57fa3806..6ae75de8bd 100644 --- a/collects/drracket/private/syncheck/local-member-names.rkt +++ b/collects/drracket/private/syncheck/local-member-names.rkt @@ -24,6 +24,7 @@ syncheck:jump-to-binding-occurrence syncheck:jump-to-definition syncheck:rename-identifier + syncheck:tack/untack-arrows syncheck:clear-highlighting syncheck:apply-style/remember diff --git a/collects/string-constants/private/english-string-constants.rkt b/collects/string-constants/private/english-string-constants.rkt index 4e165f9158..50af0d3130 100644 --- a/collects/string-constants/private/english-string-constants.rkt +++ b/collects/string-constants/private/english-string-constants.rkt @@ -193,8 +193,9 @@ please adhere to these guidelines: (cs-background-color "Background Color") (cs-tack/untack-arrow "Tack/Untack Arrow(s)") (cs-jump-to-next-bound-occurrence "Jump to Next Bound Occurrence") + (cs-jump-to-previous-bound-occurrence "Jump to Previous Bound Occurrence") (cs-jump-to-binding "Jump to Binding Occurrence") - (cs-jump-to-definition "Jump to Definition") + (cs-jump-to-definition "Jump to Definition (in Other File)") (cs-open-defining-file "Open Defining File") (cs-error-message "Error Message") (cs-open-file "Open ~a")