[plt-scheme] Closing the current tab in DrScheme -- a roundabout way of doing it

From: Danny Yoo (dyoo at hkn.eecs.berkeley.edu)
Date: Tue May 30 15:57:52 EDT 2006

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!


Posted on the users mailing list.