suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

PR 9289

Browse Source 
svn: r9259
This commit is contained in:
Robby Findler 2008-04-11 17:56:18 +00:00
parent 251491e17f
commit 3b09127a48
5 changed files with 408 additions and 415 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/drscheme/private/frame.ss
View File

@ -158,7 +158,6 @@
(drscheme:app:add-language-items-to-help-menu menu)) (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:new-string) (string-constant new-menu-item))
(define/override (file-menu:open-string) (string-constant open-menu-item)) (define/override (file-menu:open-string) (string-constant open-menu-item))

39
collects/framework/private/frame.ss
View File

@ -1039,23 +1039,20 @@
(super set-label (gui-utils:trim-string (get-entire-label) 200)) (super set-label (gui-utils:trim-string (get-entire-label) 200))
(send (group:get-the-frame-group) frame-label-changed this)) (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)
(cond label-prefix]
[(string=? "" label) [(string=? "" label-prefix)
label-prefix] label]
[(string=? "" label-prefix) [else
label] (string-append label " - " label-prefix)]))
[else (define/public (get-label-prefix) label-prefix)
(string-append label " - " label-prefix)]))] (define/public (set-label-prefix s)
[define get-label-prefix (λ () label-prefix)] (when (and (string? s)
[define set-label-prefix (not (string=? s label-prefix)))
(λ (s) (set! label-prefix s)
(when (and (string? s) (do-label)))
(not (string=? s label-prefix)))
(set! label-prefix s)
(do-label)))]
[define/override get-label (λ () label)] [define/override get-label (λ () label)]
[define/override set-label [define/override set-label
(λ (t) (λ (t)
@ -1116,6 +1113,14 @@
(inherit get-checkable-menu-item% get-menu-item%) (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) (define/override (file-menu:revert-on-demand item)
(send item enable (not (send (get-editor) is-locked?)))) (send item enable (not (send (get-editor) is-locked?))))

8
collects/framework/private/framework-exports.ss
View File

@ -642,13 +642,15 @@
]}) ]})
(handler:open-file (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 @{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 editing. It uses @scheme[handler:edit-file] to open the file, once
the user has chosen it. 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 (handler:install-recent-items
((is-a?/c menu%) . -> . void?) ((is-a?/c menu%) . -> . void?)

697
collects/framework/private/handler.ss
View File

@ -1,396 +1,379 @@
#lang scheme/unit #lang scheme/unit
(require mzlib/class
mzlib/list (require mzlib/class
(lib "hierlist.ss" "hierlist") mzlib/list
"sig.ss" (lib "hierlist.ss" "hierlist")
"../preferences.ss" "sig.ss"
"../gui-utils.ss" "../preferences.ss"
(lib "mred-sig.ss" "mred") "../gui-utils.ss"
scheme/path (lib "mred-sig.ss" "mred")
string-constants) scheme/path
string-constants)
(import mred^ (import mred^
[prefix finder: framework:finder^] [prefix finder: framework:finder^]
[prefix group: framework:group^] [prefix group: framework:group^]
[prefix text: framework:text^] [prefix text: framework:text^]
[prefix frame: framework:frame^]) [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? (letrec ([string-list?
(λ (l) (λ (l)
(cond
[(null? l) #t]
[(not (pair? l)) #f]
[else
(and (string? (car l))
(string-list? (cdr l)))]))])
(λ (who name extension handler)
(cond
[(not (string? name))
(error who "name was not a string")]
[(and (not (procedure? extension))
(not (string? extension))
(not (string-list? extension)))
(error who
"extension was not a string, list of strings, or a predicate")]
[(not (procedure? handler))
(error who "handler was not a function")]
[else (make-handler name
(if (string? extension)
(list extension)
extension)
handler)]))))
(define insert-format-handler
(λ args
(set! format-handlers
(cons (apply make-insert-handler 'insert-format-handler args)
format-handlers))))
(define find-handler
(λ (name handlers)
(let/ec exit
(let ([extension (if (string? name)
(or (filename-extension name)
"")
"")])
(for-each
(λ (handler)
(let ([ext (handler-extension handler)])
(when (or (and (procedure? ext)
(ext name))
(and (pair? ext)
(ormap (λ (ext) (string=? ext extension))
ext)))
(exit (handler-handler handler)))))
handlers)
#f))))
(define find-format-handler
(λ (name)
(find-handler name format-handlers)))
; Finding format & mode handlers by name
(define find-named-handler
(λ (name handlers)
(let loop ([l handlers])
(cond
[(null? l) #f]
[(string-ci=? (handler-name (car l)) name)
(handler-handler (car l))]
[else (loop (cdr l))]))))
(define find-named-format-handler
(λ (name)
(find-named-handler name format-handlers)))
; Open a file for editing
(define current-create-new-window
(make-parameter
(λ (filename)
(let ([frame (make-object frame:text% filename)])
(send frame show #t)
frame))))
(define edit-file
(case-lambda
[(filename) (edit-file
filename
(λ ()
((current-create-new-window) filename)))]
[(filename make-default)
(with-handlers ([(λ (x) #f) ;exn:fail?
(λ (exn)
(message-box
(string-constant error-loading)
(string-append
(format (string-constant error-loading-file/name)
(or filename
(string-constant unknown-filename)))
"\n\n"
(if (exn? exn)
(format "~a" (exn-message exn))
(format "~s" exn))))
#f)])
(gui-utils:show-busy-cursor
(λ ()
(if filename
(let ([already-open (send (group:get-the-frame-group)
locate-file
filename)])
(cond (cond
[(null? l) #t] [already-open
[(not (pair? l)) #f] (send already-open make-visible filename)
(send already-open show #t)
already-open]
[(and (preferences:get 'framework:open-here?)
(send (group:get-the-frame-group) get-open-here-frame))
=>
(λ (fr)
(add-to-recent filename)
(send fr open-here filename)
(send fr show #t)
fr)]
[else [else
(and (string? (car l)) (let ([handler
(string-list? (cdr l)))]))]) (if (path? filename)
(λ (who name extension handler) (find-format-handler filename)
(cond #f)])
[(not (string? name)) (add-to-recent filename)
(error who "name was not a string")] (if handler
[(and (not (procedure? extension)) (handler filename)
(not (string? extension)) (make-default)))]))
(not (string-list? extension))) (make-default)))))]))
(error who
"extension was not a string, list of strings, or a predicate")]
[(not (procedure? handler))
(error who "handler was not a function")]
[else (make-handler name
(if (string? extension)
(list extension)
extension)
handler)]))))
(define insert-format-handler ;; type recent-list-item = (list/p string? number? number?)
(λ args
(set! format-handlers
(cons (apply make-insert-handler 'insert-format-handler args)
format-handlers))))
(define find-handler ;; add-to-recent : path -> void
(λ (name handlers) (define (add-to-recent filename)
(let/ec exit (let* ([old-list (preferences:get 'framework:recently-opened-files/pos)]
(let ([extension (if (string? name) [old-ents (filter (λ (x) (string=? (path->string (car x))
(or (filename-extension name) (path->string filename)))
"") old-list)]
"")]) [old-ent (if (null? old-ents)
(for-each #f
(λ (handler) (car old-ents))]
(let ([ext (handler-extension handler)]) [new-ent (list filename
(when (or (and (procedure? ext) (if old-ent (cadr old-ent) 0)
(ext name)) (if old-ent (caddr old-ent) 0))]
(and (pair? ext) [added-in (cons new-ent (remove new-ent old-list compare-recent-list-items))]
(ormap (λ (ext) (string=? ext extension)) [new-recent (size-down added-in (preferences:get 'framework:recent-max-count))])
ext))) (preferences:set 'framework:recently-opened-files/pos new-recent)))
(exit (handler-handler handler)))))
handlers)
#f))))
(define find-format-handler ;; compare-recent-list-items : recent-list-item recent-list-item -> boolean
(λ (name) (define (compare-recent-list-items l1 l2)
(find-handler name format-handlers))) (string=? (path->string (car l1))
(path->string (car l2))))
; Finding format & mode handlers by name ;; size-down : (listof X) -> (listof X)[< recent-max-count]
(define find-named-handler ;; takes a list of stuff and returns the
(λ (name handlers) ;; front of the list, up to `recent-max-count' items
(let loop ([l handlers]) (define (size-down new-recent n)
(cond (let loop ([n n]
[(null? l) #f] [new-recent new-recent])
[(string-ci=? (handler-name (car l)) name) (cond
(handler-handler (car l))] [(zero? n) null]
[else (loop (cdr l))])))) [(null? new-recent) null]
[else
(cons (car new-recent)
(loop (- n 1)
(cdr new-recent)))])))
(define find-named-format-handler ;; size-recently-opened-files : number -> void
(λ (name) ;; sets the recently-opened-files/pos preference
(find-named-handler name format-handlers))) ;; to a size limited by `n'
(define (size-recently-opened-files n)
(preferences:set
'framework:recently-opened-files/pos
(size-down (preferences:get 'framework:recently-opened-files/pos)
n)))
; Open a file for editing ;; set-recent-position : path number number -> void
(define current-create-new-window ;; updates the recent menu preferences
(make-parameter ;; with the positions `start' and `end'
(λ (filename) (define (set-recent-position filename start end)
(let ([frame (make-object frame:text% filename)]) (let* ([recent-items
(send frame show #t) (preferences:get 'framework:recently-opened-files/pos)]
frame)))) [new-recent-items
(map (λ (x)
(if (string=? (path->string (car x))
(path->string filename))
(list* (car x) start end (cdddr x))
x))
(preferences:get 'framework:recently-opened-files/pos))])
(unless (equal? recent-items new-recent-items)
(preferences:set 'framework:recently-opened-files/pos
new-recent-items))))
(define edit-file ;; install-recent-items : (is-a?/c menu%) -> void?
(case-lambda (define (install-recent-items menu)
[(filename) (edit-file (let ([recently-opened-files
filename (preferences:get
(λ () 'framework:recently-opened-files/pos)])
((current-create-new-window) filename)))] (for-each (λ (item) (send item delete))
[(filename make-default) (send menu get-items))
(with-handlers ([(λ (x) #f) ;exn:fail?
(λ (exn)
(message-box
(string-constant error-loading)
(string-append
(format (string-constant error-loading-file/name)
(or filename
(string-constant unknown-filename)))
"\n\n"
(if (exn? exn)
(format "~a" (exn-message exn))
(format "~s" exn))))
#f)])
(gui-utils:show-busy-cursor
(λ ()
(if filename
(let ([already-open (send (group:get-the-frame-group)
locate-file
filename)])
(cond
[already-open
(send already-open make-visible filename)
(send already-open show #t)
already-open]
[(and (preferences:get 'framework:open-here?)
(send (group:get-the-frame-group) get-open-here-frame))
=>
(λ (fr)
(add-to-recent filename)
(send fr open-here filename)
(send fr show #t)
fr)]
[else
(let ([handler
(if (path? filename)
(find-format-handler filename)
#f)])
(add-to-recent filename)
(if handler
(handler filename)
(make-default)))]))
(make-default)))))]))
;; type recent-list-item = (list/p string? number? number?) (instantiate menu-item% ()
(parent menu)
(label (string-constant show-recent-items-window-menu-item))
(callback (λ (x y) (show-recent-items-window))))
;; add-to-recent : path -> void (instantiate separator-menu-item% ()
(define (add-to-recent filename) (parent menu))
(let* ([old-list (preferences:get 'framework:recently-opened-files/pos)]
[old-ents (filter (λ (x) (string=? (path->string (car x))
(path->string filename)))
old-list)]
[old-ent (if (null? old-ents)
#f
(car old-ents))]
[new-ent (list filename
(if old-ent (cadr old-ent) 0)
(if old-ent (caddr old-ent) 0))]
[added-in (cons new-ent (remove new-ent old-list compare-recent-list-items))]
[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 (for-each (λ (recent-list-item)
(define (compare-recent-list-items l1 l2) (let ([filename (car recent-list-item)])
(string=? (path->string (car l1)) (instantiate menu-item% ()
(path->string (car l2)))) (parent menu)
(label (gui-utils:trim-string
(regexp-replace*
"&"
(path->string filename)
"&&")
200))
(callback (λ (x y) (open-recent-list-item recent-list-item))))))
recently-opened-files)
(void)))
;; size-down : (listof X) -> (listof X)[< recent-max-count] ;; open-recent-list-item : recent-list-item -> void
;; takes a list of stuff and returns the (define (open-recent-list-item recent-list-item)
;; front of the list, up to `recent-max-count' items (let* ([filename (car recent-list-item)]
(define (size-down new-recent n) [start (cadr recent-list-item)]
(let loop ([n n] [end (caddr recent-list-item)])
[new-recent new-recent]) (cond
(cond [(file-exists? filename)
[(zero? n) null] (let ([fr (edit-file filename)])
[(null? new-recent) null] (when (is-a? fr frame:open-here<%>)
[else (let ([ed (send fr get-open-here-editor)])
(cons (car new-recent) (when (equal? (send ed get-filename) filename)
(loop (- n 1) (send ed set-position start end)))))]
(cdr new-recent)))]))) [else
(message-box (string-constant error)
(format (string-constant cannot-open-because-dne)
filename))])))
;; size-recently-opened-files : number -> void ;; show-recent-items-window : -> void
;; sets the recently-opened-files/pos preference (define (show-recent-items-window)
;; to a size limited by `n' (unless recent-items-window
(define (size-recently-opened-files n) (set! recent-items-window (make-recent-items-window)))
(preferences:set (send recent-items-window show #t))
'framework:recently-opened-files/pos
(size-down (preferences:get 'framework:recently-opened-files/pos)
n)))
;; set-recent-position : path number number -> void ;; make-recent-items-window : -> frame
;; updates the recent menu preferences (define (make-recent-items-window)
;; with the positions `start' and `end' (make-object (get-recent-items-window%)
(define (set-recent-position filename start end) (string-constant show-recent-items-window-label)
(let* ([recent-items #f
(preferences:get 'framework:recently-opened-files/pos)] (preferences:get 'framework:recent-items-window-w)
[new-recent-items (preferences:get 'framework:recent-items-window-h)))
(map (λ (x)
(if (string=? (path->string (car x))
(path->string filename))
(list* (car x) start end (cdddr x))
x))
(preferences:get 'framework:recently-opened-files/pos))])
(unless (equal? recent-items new-recent-items)
(preferences:set 'framework:recently-opened-files/pos
new-recent-items))))
;; install-recent-items : (is-a?/c menu%) -> void? ;; recent-items-window : (union #f (is-a?/c frame%))
(define (install-recent-items menu) (define recent-items-window #f)
(let ([recently-opened-files
(preferences:get
'framework:recently-opened-files/pos)])
(for-each (λ (item) (send item delete))
(send menu get-items))
(instantiate menu-item% () (define recent-items-hierarchical-list%
(parent menu) (class hierarchical-list%
(label (string-constant show-recent-items-window-menu-item)) (define/override (on-double-select item)
(callback (λ (x y) (show-recent-items-window)))) (send item open-item))
(super-instantiate ())))
(instantiate separator-menu-item% () (define recent-items-super% (frame:standard-menus-mixin frame:basic%))
(parent menu))
(for-each (λ (recent-list-item) (define (set-recent-items-frame-superclass super%)
(let ([filename (car recent-list-item)]) (set! recent-items-super% super%))
(instantiate menu-item% ()
(parent menu)
(label (gui-utils:trim-string
(regexp-replace*
"&"
(path->string filename)
"&&")
200))
(callback (λ (x y) (open-recent-list-item recent-list-item))))))
recently-opened-files)
(void)))
;; open-recent-list-item : recent-list-item -> void (define (get-recent-items-window%)
(define (open-recent-list-item recent-list-item) (class recent-items-super%
(let* ([filename (car recent-list-item)]
[start (cadr recent-list-item)]
[end (caddr recent-list-item)])
(cond
[(file-exists? filename)
(let ([fr (edit-file filename)])
(when (is-a? fr frame:open-here<%>)
(let ([ed (send fr get-open-here-editor)])
(when (equal? (send ed get-filename) filename)
(send ed set-position start end)))))]
[else
(message-box (string-constant error)
(format (string-constant cannot-open-because-dne)
filename))])))
;; show-recent-items-window : -> void ;; remove extraneous separators
(define (show-recent-items-window) (define/override (file-menu:between-print-and-close menu) (void))
(unless recent-items-window (define/override (edit-menu:between-find-and-preferences menu) (void))
(set! recent-items-window (make-recent-items-window)))
(send recent-items-window show #t))
;; make-recent-items-window : -> frame (define/override (on-size w h)
(define (make-recent-items-window) (preferences:set 'framework:recent-items-window-w w)
(make-object (get-recent-items-window%) (preferences:set 'framework:recent-items-window-h h))
(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%)) ;; refresh-hl : (listof recent-list-item) -> void
(define recent-items-window #f) (define/private (refresh-hl recent-list-items)
(let ([ed (send hl get-editor)])
(send ed begin-edit-sequence)
(for-each (λ (item) (send hl delete-item item)) (send hl get-items))
(for-each (λ (item) (add-recent-item item))
(if (eq? (preferences:get 'framework:recently-opened-sort-by) 'name)
(sort recent-list-items
(λ (x y) (string<=? (path->string (car x))
(path->string (car y)))))
recent-list-items))
(send ed end-edit-sequence)))
(define recent-items-hierarchical-list% (define/private (add-recent-item recent-list-item)
(class hierarchical-list% (let ([item (send hl new-item (make-hierlist-item-mixin recent-list-item))])
(define/override (on-double-select item) (send (send item get-editor) insert (path->string (car recent-list-item)))))
(send item open-item))
(super-instantiate ())))
(define recent-items-super% (frame:standard-menus-mixin frame:basic%)) (field [remove-prefs-callback
(preferences:add-callback
'framework:recently-opened-files/pos
(λ (p v)
(refresh-hl v)))])
(define (set-recent-items-frame-superclass super%) (define/augment (on-close)
(set! recent-items-super% super%)) (inner (void) on-close)
(remove-prefs-callback)
(set! recent-items-window #f))
(define (get-recent-items-window%) (super-new)
(class recent-items-super%
;; remove extraneous separators (inherit get-area-container)
(define/override (file-menu:between-print-and-close menu) (void)) (field [bp (make-object horizontal-panel% (get-area-container))]
(define/override (edit-menu:between-find-and-preferences menu) (void)) [hl (make-object recent-items-hierarchical-list% (get-area-container) '())]
[sort-by-name-button
(make-object button%
(string-constant recent-items-sort-by-name)
bp
(λ (x y) (set-sort-by 'name)))]
[sort-by-age-button
(make-object button%
(string-constant recent-items-sort-by-age)
bp
(λ (x y) (set-sort-by 'age)))])
(define/override (on-size w h) (send bp stretchable-height #f)
(preferences:set 'framework:recent-items-window-w w) (send sort-by-name-button stretchable-width #t)
(preferences:set 'framework:recent-items-window-h h)) (send sort-by-age-button stretchable-width #t)
;; refresh-hl : (listof recent-list-item) -> void (define/private (set-sort-by flag)
(define/private (refresh-hl recent-list-items) (preferences:set 'framework:recently-opened-sort-by flag)
(let ([ed (send hl get-editor)]) (case flag
(send ed begin-edit-sequence) [(name)
(for-each (λ (item) (send hl delete-item item)) (send hl get-items)) (send sort-by-age-button enable #t)
(for-each (λ (item) (add-recent-item item)) (send sort-by-name-button enable #f)]
(if (eq? (preferences:get 'framework:recently-opened-sort-by) 'name) [(age)
(sort recent-list-items (send sort-by-age-button enable #f)
(λ (x y) (string<=? (path->string (car x)) (send sort-by-name-button enable #t)])
(path->string (car y))))) (refresh-hl (preferences:get 'framework:recently-opened-files/pos)))
recent-list-items))
(send ed end-edit-sequence)))
(define/private (add-recent-item recent-list-item) (set-sort-by (preferences:get 'framework:recently-opened-sort-by))))
(let ([item (send hl new-item (make-hierlist-item-mixin recent-list-item))])
(send (send item get-editor) insert (path->string (car recent-list-item)))))
(field [remove-prefs-callback ;; make-hierlist-item-mixin : recent-item -> mixin(arg to new-item method of hierlist)
(preferences:add-callback (define (make-hierlist-item-mixin recent-item)
'framework:recently-opened-files/pos (λ (%)
(λ (p v) (class %
(refresh-hl v)))]) (define/public (open-item)
(open-recent-list-item recent-item))
(super-instantiate ()))))
(define/augment (on-close) (define (open-file [directory #f])
(inner (void) on-close) (let* ([parent (and (or (not (eq? 'macosx (system-type)))
(remove-prefs-callback) (preferences:get 'framework:open-here?))
(set! recent-items-window #f)) (get-top-level-focus-window))]
[file
(super-new) (parameterize ([finder:dialog-parent-parameter parent])
(finder:get-file directory))])
(inherit get-area-container) (and file
(field [bp (make-object horizontal-panel% (get-area-container))] (edit-file file))))
[hl (make-object recent-items-hierarchical-list% (get-area-container) '())]
[sort-by-name-button
(make-object button%
(string-constant recent-items-sort-by-name)
bp
(λ (x y) (set-sort-by 'name)))]
[sort-by-age-button
(make-object button%
(string-constant recent-items-sort-by-age)
bp
(λ (x y) (set-sort-by 'age)))])
(send bp stretchable-height #f)
(send sort-by-name-button stretchable-width #t)
(send sort-by-age-button stretchable-width #t)
(define/private (set-sort-by flag)
(preferences:set 'framework:recently-opened-sort-by flag)
(case flag
[(name)
(send sort-by-age-button enable #t)
(send sort-by-name-button enable #f)]
[(age)
(send sort-by-age-button enable #f)
(send sort-by-name-button enable #t)])
(refresh-hl (preferences:get 'framework:recently-opened-files/pos)))
(set-sort-by (preferences:get 'framework:recently-opened-sort-by))))
;; make-hierlist-item-mixin : recent-item -> mixin(arg to new-item method of hierlist)
(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
(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
(send *open-directory* get)))])
(when file
(send *open-directory*
set-from-file! file))
(and file
(edit-file file))))

6
collects/framework/private/keymap.ss
View File

@ -1349,7 +1349,11 @@
#t)] #t)]
[load-file [load-file
(λ (edit event) (λ (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)]) #t)])
(λ (kmap) (λ (kmap)
(let* ([map (λ (key func) (let* ([map (λ (key func)