PR 9289

svn: r9259

collects/drscheme/private/frame.ss

@@ -158,7 +158,6 @@
         
         (drscheme:app:add-language-items-to-help-menu menu))
       
-      (define/override (file-menu:open-callback item evt) (handler:open-file))
       (define/override (file-menu:new-string) (string-constant new-menu-item))
       (define/override (file-menu:open-string) (string-constant open-menu-item))
       

collects/framework/private/frame.ss

@@ -1039,23 +1039,20 @@
         (super set-label (gui-utils:trim-string (get-entire-label) 200))
         (send (group:get-the-frame-group) frame-label-changed this))
       
-      (public get-entire-label get-label-prefix set-label-prefix)
+      (define/public (get-entire-label)
-      [define get-entire-label
-        (λ ()
         (cond
           [(string=? "" label)
            label-prefix]
           [(string=? "" label-prefix)
            label]
           [else 
-             (string-append label " - " label-prefix)]))]
+           (string-append label " - " label-prefix)]))
-      [define get-label-prefix (λ () label-prefix)]
+      (define/public (get-label-prefix) label-prefix)
-      [define set-label-prefix
+      (define/public (set-label-prefix s)
-        (λ (s)
         (when (and (string? s)
                    (not (string=? s label-prefix)))
           (set! label-prefix s)
-            (do-label)))]
+          (do-label)))
       [define/override get-label (λ () label)]
       [define/override set-label
         (λ (t)
@@ -1116,6 +1113,14 @@
       
       (inherit get-checkable-menu-item% get-menu-item%)
       
+      (define/override (file-menu:open-callback item evt)
+        (let* ([e (get-editor)]
+               [fn (and e (send e get-filename))]
+               [dir (and fn
+                         (let-values ([(base name dir) (split-path fn)])
+                           base))])
+          (handler:open-file dir)))
+      
       (define/override (file-menu:revert-on-demand item)
         (send item enable (not (send (get-editor) is-locked?))))
       

collects/framework/private/framework-exports.ss

@@ -642,13 +642,15 @@
              ]})
 
         (handler:open-file
-         (-> (or/c false/c (is-a?/c frame:basic<%>)))
+         (->* ()
-         ()
+              ((or/c false/c path? string?))
+              (or/c false/c (is-a?/c frame:basic<%>)))
+         (((dir #f)))
          @{This function queries the user for a filename and opens the file for
            editing.  It uses @scheme[handler:edit-file] to open the file, once
            the user has chosen it.
 
-           Calls @scheme[finder:get-file] and @scheme[handler:edit-file].})
+           Calls @scheme[finder:get-file] and @scheme[handler:edit-file], passing along @scheme[dir].})
 
         (handler:install-recent-items
          ((is-a?/c menu%) . -> . void?)

collects/framework/private/handler.ss

@@ -1,6 +1,6 @@
-
 #lang scheme/unit
-  (require mzlib/class
+
+(require mzlib/class
          mzlib/list
          (lib "hierlist.ss" "hierlist")
          "sig.ss"
@@ -11,19 +11,19 @@
          string-constants)
 
 
-  (import mred^
+(import mred^
         [prefix finder: framework:finder^]
         [prefix group: framework:group^]
         [prefix text: framework:text^]
         [prefix frame: framework:frame^])
-  (export framework:handler^)
+(export framework:handler^)
-  (init-depend framework:frame^)
+(init-depend framework:frame^)
 
-  (define-struct handler (name extension handler))
+(define-struct handler (name extension handler))
 
-  (define format-handlers '())
+(define format-handlers '())
 
-  (define make-insert-handler
+(define make-insert-handler
   (letrec ([string-list?
             (λ (l)
               (cond
@@ -49,13 +49,13 @@
                                 extension)
                             handler)]))))
 
-  (define insert-format-handler
+(define insert-format-handler
   (λ args
     (set! format-handlers 
           (cons (apply make-insert-handler 'insert-format-handler args)
                 format-handlers))))
 
-  (define find-handler
+(define find-handler
   (λ (name handlers)
     (let/ec exit
       (let ([extension (if (string? name)
@@ -74,12 +74,12 @@
          handlers)
         #f))))
 
-  (define find-format-handler
+(define find-format-handler
   (λ (name)
     (find-handler name format-handlers)))
 
-  ; Finding format & mode handlers by name
+; Finding format & mode handlers by name
-  (define find-named-handler
+(define find-named-handler
   (λ (name handlers)
     (let loop ([l handlers])
       (cond
@@ -88,19 +88,19 @@
          (handler-handler (car l))]
         [else (loop (cdr l))]))))
 
-  (define find-named-format-handler
+(define find-named-format-handler
   (λ (name)
     (find-named-handler name format-handlers)))
 
-  ; Open a file for editing
+; Open a file for editing
-  (define current-create-new-window
+(define current-create-new-window
   (make-parameter
    (λ (filename)
      (let ([frame (make-object frame:text% filename)])
        (send frame show #t)
        frame))))
 
-  (define edit-file
+(define edit-file
   (case-lambda
     [(filename) (edit-file
                  filename
@@ -150,10 +150,10 @@
                          (make-default)))]))
               (make-default)))))]))
 
-  ;; type recent-list-item = (list/p string? number? number?)
+;; type recent-list-item = (list/p string? number? number?)
 
-  ;; add-to-recent : path -> void
+;; add-to-recent : path -> void
-  (define (add-to-recent filename)
+(define (add-to-recent filename)
   (let* ([old-list (preferences:get 'framework:recently-opened-files/pos)]
          [old-ents (filter (λ (x) (string=? (path->string (car x))
                                             (path->string filename))) 
@@ -168,15 +168,15 @@
          [new-recent (size-down added-in (preferences:get 'framework:recent-max-count))])
     (preferences:set 'framework:recently-opened-files/pos new-recent)))
 
-  ;; compare-recent-list-items : recent-list-item recent-list-item -> boolean
+;; compare-recent-list-items : recent-list-item recent-list-item -> boolean
-  (define (compare-recent-list-items l1 l2)
+(define (compare-recent-list-items l1 l2)
   (string=? (path->string (car l1))
             (path->string (car l2))))
 
-  ;; size-down : (listof X) -> (listof X)[< recent-max-count]
+;; size-down : (listof X) -> (listof X)[< recent-max-count]
-  ;; takes a list of stuff and returns the
+;; takes a list of stuff and returns the
-  ;; front of the list, up to `recent-max-count' items
+;; front of the list, up to `recent-max-count' items
-  (define (size-down new-recent n)
+(define (size-down new-recent n)
   (let loop ([n n]
              [new-recent new-recent])
     (cond
@@ -187,19 +187,19 @@
              (loop (- n 1)
                    (cdr new-recent)))])))
 
-  ;; size-recently-opened-files : number -> void
+;; size-recently-opened-files : number -> void
-  ;; sets the recently-opened-files/pos preference
+;; sets the recently-opened-files/pos preference
-  ;; to a size limited by `n'
+;; to a size limited by `n'
-  (define (size-recently-opened-files n)
+(define (size-recently-opened-files n)
   (preferences:set
    'framework:recently-opened-files/pos
    (size-down (preferences:get 'framework:recently-opened-files/pos)
               n)))       
 
-  ;; set-recent-position : path number number -> void
+;; set-recent-position : path number number -> void
-  ;; updates the recent menu preferences 
+;; updates the recent menu preferences 
-  ;; with the positions `start' and `end'
+;; with the positions `start' and `end'
-  (define (set-recent-position filename start end)
+(define (set-recent-position filename start end)
   (let* ([recent-items
           (preferences:get 'framework:recently-opened-files/pos)]
          [new-recent-items
@@ -213,8 +213,8 @@
       (preferences:set 'framework:recently-opened-files/pos
                        new-recent-items))))
 
-  ;; install-recent-items : (is-a?/c menu%) -> void?
+;; install-recent-items : (is-a?/c menu%) -> void?
-  (define (install-recent-items menu)
+(define (install-recent-items menu)
   (let ([recently-opened-files
          (preferences:get
           'framework:recently-opened-files/pos)])
@@ -243,8 +243,8 @@
               recently-opened-files)
     (void)))
 
-  ;; open-recent-list-item : recent-list-item -> void
+;; open-recent-list-item : recent-list-item -> void
-  (define (open-recent-list-item recent-list-item)
+(define (open-recent-list-item recent-list-item)
   (let* ([filename (car recent-list-item)]
          [start (cadr recent-list-item)]
          [end (caddr recent-list-item)])
@@ -260,35 +260,35 @@
                     (format (string-constant cannot-open-because-dne)
                             filename))])))
 
-  ;; show-recent-items-window : -> void
+;; show-recent-items-window : -> void
-  (define (show-recent-items-window)
+(define (show-recent-items-window)
   (unless recent-items-window
     (set! recent-items-window (make-recent-items-window)))
   (send recent-items-window show #t))
 
-  ;; make-recent-items-window : -> frame
+;; make-recent-items-window : -> frame
-  (define (make-recent-items-window)
+(define (make-recent-items-window)
   (make-object (get-recent-items-window%)
     (string-constant show-recent-items-window-label)
     #f
     (preferences:get 'framework:recent-items-window-w) 
     (preferences:get 'framework:recent-items-window-h)))
 
-  ;; recent-items-window : (union #f (is-a?/c frame%))
+;; recent-items-window : (union #f (is-a?/c frame%))
-  (define recent-items-window #f)
+(define recent-items-window #f)
 
-  (define recent-items-hierarchical-list%
+(define recent-items-hierarchical-list%
   (class hierarchical-list%
     (define/override (on-double-select item)
       (send item open-item))
     (super-instantiate ())))
 
-  (define recent-items-super% (frame:standard-menus-mixin frame:basic%))
+(define recent-items-super% (frame:standard-menus-mixin frame:basic%))
 
-  (define (set-recent-items-frame-superclass super%)
+(define (set-recent-items-frame-superclass super%)
   (set! recent-items-super% super%))
 
-  (define (get-recent-items-window%)
+(define (get-recent-items-window%)
   (class recent-items-super%
     
     ;; remove extraneous separators
@@ -360,37 +360,20 @@
     
     (set-sort-by (preferences:get 'framework:recently-opened-sort-by))))
 
-  ;; make-hierlist-item-mixin : recent-item -> mixin(arg to new-item method of hierlist)
+;; make-hierlist-item-mixin : recent-item -> mixin(arg to new-item method of hierlist)
-  (define (make-hierlist-item-mixin recent-item)
+(define (make-hierlist-item-mixin recent-item)
   (λ (%)
     (class %
       (define/public (open-item)
         (open-recent-list-item recent-item))
       (super-instantiate ()))))
 
-  (define *open-directory* ; object to remember last directory
+(define (open-file [directory #f])
-    (new (class object%
-           (field [the-dir #f])
-           [define/public get (λ () the-dir)]
-           [define/public set-from-file!
-             (λ (file) 
-               (set! the-dir (path-only file)))]
-           [define/public set-to-default
-             (λ ()
-               (set! the-dir (current-directory)))]
-           (set-to-default)
-           (super-new))))
-  
-  (define (open-file)
   (let* ([parent (and (or (not (eq? 'macosx (system-type)))
                           (preferences:get 'framework:open-here?))
                       (get-top-level-focus-window))]
          [file 
           (parameterize ([finder:dialog-parent-parameter parent])
-              (finder:get-file
+            (finder:get-file directory))])
-               (send *open-directory* get)))])
-      (when file
-        (send *open-directory*
-              set-from-file! file))
     (and file
          (edit-file file))))

collects/framework/private/keymap.ss

@@ -1349,7 +1349,11 @@
               #t)]
            [load-file
             (λ (edit event)
-              (handler:open-file)
+              (let ([fn (send edit get-filename)])
+                (handler:open-file
+                 (and fn
+                      (let-values ([(base name dir) (split-path fn)])
+                        base))))
               #t)])
       (λ (kmap)
         (let* ([map (λ (key func)