#lang racket/gui
(define saved-lines (make-hash))
(define (save-current-line! ed)
(define ln (send ed position-paragraph (send ed get-start-position)))
(hash-set! saved-lines ed
(cons ln (hash-ref! saved-lines ed '()))))
(define (pop-saved-line! ed)
(define lines (hash-ref! saved-lines ed '()))
(if (empty? lines)
#f
(begin0 (first lines)
(hash-set! saved-lines ed (rest lines)))))
(define (ed-goto-line ed ln)
(send ed set-position (send ed paragraph-start-position ln)))
(provide temp-bookmark)
(define (temp-bookmark str #:editor ed)
(save-current-line! ed)
#f)
(provide goto-line)
(define (goto-line str #:editor ed)
(define line (get-text-from-user "Go to line" "Line number:"
#:validate string->number))
(define lnum (string->number line))
(when lnum
(save-current-line! ed)
(ed-goto-line ed (sub1 lnum)))
#f)
(provide goto-previous)
(define (goto-previous str #:editor ed)
(define ln (pop-saved-line! ed))
(when ln
(ed-goto-line ed ln))
#f)
(provide bookmarks)
(define (bookmarks str #:definitions ed)
(define txt (send ed get-text))
(define marks
(filter values
(for/list ([line (in-lines (open-input-string txt))]
[i (in-naturals)])
(define m (regexp-match #px"^;@@\\s*(.*)" line))
(and m (list i (second m))))))
(bookmark-frame marks ed)
#f)
(provide add-bookmark)
(define (add-bookmark str)
(string-append ";@@ " (if (string=? str "")
(format "bookmark name")
str)))
(define (bookmark-frame marks ed)
(define fr (new frame% [label "Bookmarks"]
[min-width 200] [min-height 300]))
(define (list-box-select lb)
(define sel (send lb get-selection))
(when sel
(save-current-line! ed)
(send ed set-position
(send ed paragraph-start-position
(first (list-ref marks sel)))))
(when (send cb get-value)
(send fr show #f)))
(define lb (new list-box% [label #f]
[parent fr]
[choices (map second marks)] [callback (λ(lb ev)
(print (send ev get-event-type))
(when (eq? (send ev get-event-type) 'list-box-dclick)
(list-box-select lb)))]
))
(define cb (new check-box% [parent fr] [label "Close on select?"] [value #t]))
(define bt (new button% [parent fr] [label "Go!"] [callback (λ _ (list-box-select lb))]))
(send fr show #t))