(module close-tab-keybinding (lib "keybinding-lang.ss" "framework")
  (require (lib "list.ss")
           (lib "class.ss")
           (lib "string-constant.ss" "string-constants"))

  
  ;; This introduces a keybinding bound to C-x k to close the current
  ;; tab or window
  
  (keybinding "c:x;k" 
   (lambda (editor event)
     (close-current-tab-or-window 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-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-label) label))
         (first items)]
        [else (loop (rest items))])))
  

  ;; wrap/#f: wrap function to handle #f input.  If #f, returns
  ;; #f.
  (define (wrap/#f f)
    (lambda (x)
      (cond
        [x (f x)]
        [else #f])))
  
  ;; get-file-menu: menu-bar% -> (union menu% #f)
  (define get-file-menu 
    (wrap/#f 
     (lambda (menu-bar%)
       (find-with-label menu-bar% menu% (string-constant file-menu)))))
   
  ;; get-close-tab-item: menu% -> (union menu-item% #f)
  (define get-close-tab-item 
    (wrap/#f 
     (lambda (menu%)
       (find-with-label menu% menu-item% (string-constant close-tab)))))

  ;; get-close-item: menu% -> (union menu-item% #f)
  (define get-close-item 
    (wrap/#f
     (lambda (menu%)
       (find-with-label menu% menu-item% (string-constant close-menu-item)))))
  
  ;; make-control-event: ->  control-event%
  (define (make-control-event)
    (new control-event% [event-type 'menu]))

  
  (define (close-current-tab-or-window editor event)
    (with-top-level-window 
     editor
     (lambda (tlw)
       (let* ([file-menu (get-file-menu (send tlw get-menu-bar))]
              [close-tab-item (get-close-tab-item file-menu)]
              [close-item (get-close-item file-menu)])
         (cond
           [(and close-tab-item (send close-tab-item is-enabled?))
            (send close-tab-item command (make-control-event))]
           [close-item
            (send close-item command (make-control-event))]))))))