[plt-scheme] Closing the current tab in DrScheme -- a roundabout way of doing it
Hi everyone,
I could not find a nice keybinding to close the current tab in DrScheme.
I know some binding for this exists on the Mac platform, but I couldn't
find an equivalent for Linux.
Just for fun (and to play with some framework/gui code), I wrote the
following keybindings module:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module close-tab-keybinding (lib "keybinding-lang.ss" "framework")
(require (lib "list.ss")
(lib "class.ss"))
;; This introduces a keybinding bound to C-x k to close the current tab.
;;
;; This is actually a bit tricker than I thought, because the Framework
;; doesn't expose this functionality for public consumption.
;; This approaches this problem in a roundabout way: we traverse
;; the menu structure in the toplevel window.
(keybinding "c:x;k"
(lambda (editor event)
(close-current-tab editor event)))
;; with-top-level-window: any (window -> any) -> void
;; Calls f on the top-level-window of obj. Mostly a copy-and-paste
;; of DrScheme's private get-top-level-frame function.
(define (with-top-level-window obj f)
(when (is-a? obj editor<%>)
(let ([canvas (send obj get-canvas)])
(when canvas
(let ([frame (send canvas get-top-level-window)])
(f frame))))))
;; Given a structure that supports *get-items*, tries to find
;; the item that we want.
(define (find-with-plain-label container item-class label)
(let loop ([items (send container get-items)])
(cond
[(empty? items) #f]
[(and (is-a? (first items) item-class)
(equal? (send (first items) get-plain-label) label))
(first items)]
[else (loop (rest items))])))
;; get-file-menu: menu-bar% -> (union menu% #f)
(define (get-file-menu menu-bar%)
(find-with-plain-label menu-bar% menu% "File"))
;; get-close-tab-item: menu% -> (union menu-item% #f)
(define (get-close-tab-item menu%)
(find-with-plain-label menu% menu-item% "Close Tab"))
;; wrap/#f: wrap function to handle #f input. If #f, returns
;; #f.
(define (wrap/#f f)
(lambda (x)
(cond
[x (f x)]
[else #f])))
(define (make-control-event key-event)
(new control-event% [event-type 'menu]))
(define (close-current-tab editor event)
(with-top-level-window
editor
(lambda (tlw)
(let ([close-tab-menu-item ((wrap/#f get-close-tab-item)
((wrap/#f get-file-menu)
(send tlw get-menu-bar)))])
(when (and close-tab-menu-item
(send close-tab-menu-item is-enabled?))
(send close-tab-menu-item
command
(make-control-event event))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I hope this helps!