From 1c48ad38401381753ae8017e56b382d1bb60ab5a Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Fri, 3 Feb 2012 01:42:47 -0500 Subject: [PATCH] add drracket bookmarks --- collects/drracket/private/bookmarks.rkt | 32 +++++++++++++++++++++++++++++++ collects/drracket/private/rep.rkt | 12 ++++++++++- collects/drracket/private/unit.rkt | 28 ++++++++++++++++++++++++++- 3 files changed, 70 insertions(+), 2 deletions(-) create mode 100644 collects/drracket/private/bookmarks.rkt diff --git a/collects/drracket/private/bookmarks.rkt b/collects/drracket/private/bookmarks.rkt new file mode 100644 index 0000000..f3c4019 --- /dev/null +++ b/collects/drracket/private/bookmarks.rkt @@ -0,0 +1,32 @@ +#lang racket + +(provide clear-bookmarks bookmarks-empty? bookmarks-push bookmarks-pop) + +;; ---------------------------------------------------------------------------- +;; Bookmarks +;; Bookmarks are a list (stack) of positions +(define bookmarks null) + +(define (clear-bookmarks) (set! bookmarks null)) + +(define (bookmarks-empty?) (null? bookmarks)) + +;; bookmarks-push : position -> void +(define (bookmarks-push bm) + (if (null? bookmarks) + (set! bookmarks (cons bm bookmarks)) + (when (not (= bm (car bookmarks))) ; only push if top bookmark != bm + (set! bookmarks (cons bm bookmarks))))) + +;; bookmarks-pop : position -> position or #f +;; pops bookmarks until one that is not = current-pot is found and returns it +;; returns #f if no such bookmark exists +(define (bookmarks-pop current-pos) + (let loop ([bms bookmarks]) + (if (null? bms) + #f + (if (and current-pos (= current-pos (car bms))) + (loop (cdr bms)) + (begin0 + (car bms) + (set! bookmarks (cdr bms))))))) \ No newline at end of file diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index e267126..414100d 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -30,6 +30,7 @@ TODO "drsig.rkt" "local-member-names.rkt" "stack-checkpoint.rkt" + "bookmarks.rkt" ;; the dynamic-require below loads this module, ;; so we make the dependency explicit here, even @@ -201,8 +202,17 @@ TODO (add-drs-function "send-selection-to-repl" (λ (frame) (send frame send-selection-to-repl #f))) (add-drs-function "send-toplevel-form-to-repl-and-go" (λ (frame) (send frame send-toplevel-form-to-repl #t))) (add-drs-function "send-selection-to-repl-and-go" (λ (frame) (send frame send-selection-to-repl #t))) - (add-drs-function "move-to-interactions" (λ (frame) (send frame move-to-interactions)))) + (add-drs-function "move-to-interactions" (λ (frame) (send frame move-to-interactions))) + (add-drs-function "jump-to-previous-bookmark" + (λ (frame) + (define editor (send frame get-editor)) + (define current-pos (box 0)) + (send editor get-position current-pos) + (let ([pos (bookmarks-pop (unbox current-pos))]) + (and pos + (send editor set-position pos)))))) + (send drs-bindings-keymap map-function "c:x;r" "jump-to-previous-bookmark") (send drs-bindings-keymap map-function "m:p" "jump-to-previous-error-loc") (send drs-bindings-keymap map-function "m:n" "jump-to-next-error-loc") (send drs-bindings-keymap map-function "esc;p" "jump-to-previous-error-loc") diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index ec058b7..2057961 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -37,6 +37,7 @@ module browser threading seems wrong. "get-defs.rkt" "local-member-names.rkt" "eval-helpers.rkt" + "bookmarks.rkt" (prefix-in drracket:arrow: "../arrow.rkt") (prefix-in icons: images/compile-time) mred @@ -1012,7 +1013,29 @@ module browser threading seems wrong. (parent menu) (label (gui-utils:format-literal-label (string-constant jump-to-defn) (defn-name defn))) (callback (λ (x y) - (send editor set-position (defn-start-pos defn)))))))))))) + (bookmarks-push current-pos) + (send editor set-position (defn-start-pos defn)))))) + (unless (and (bookmarks-empty?) (not current-pos)) + (new separator-menu-item% (parent menu)) + (when current-pos + (new menu-item% + (parent menu) + (label "Add this position to bookmarks") + (callback (λ (x y) (bookmarks-push current-pos))))) + (unless (bookmarks-empty?) + (new menu-item% + (parent menu) + (label "Jump to previous saved bookmark") + (callback + (λ (x y) + (let ([pos (bookmarks-pop current-pos)]) + (and pos + (send editor set-position pos)))))) + (new menu-item% + (parent menu) + (label "Clear all bookmarks") + (callback (λ (x y) (clear-bookmarks)))))) + )))))) (old menu editor event)))) ;; get-current-word : editor number -> string @@ -1106,6 +1129,9 @@ module browser threading seems wrong. menu (λ (x y) (reset) + (let ([current-pos (box 0)]) + (send text get-position current-pos) + (bookmarks-push (unbox current-pos))) (send text set-position (defn-start-pos defn) (defn-start-pos defn)) (let ([canvas (send text get-canvas)]) (when canvas -- 1.7.3.1.msysgit.0