PR 9289
svn: r9259 original commit: 3b09127a486e09677d60f5e474d6003555d37f3f
This commit is contained in:
parent
44c7e9df8d
commit
e7149ced11
|
@ -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
|
(cond
|
||||||
[(string=? "" label)
|
[(string=? "" label)
|
||||||
label-prefix]
|
label-prefix]
|
||||||
[(string=? "" label-prefix)
|
[(string=? "" label-prefix)
|
||||||
label]
|
label]
|
||||||
[else
|
[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)
|
(when (and (string? s)
|
||||||
(not (string=? s label-prefix)))
|
(not (string=? s label-prefix)))
|
||||||
(set! label-prefix s)
|
(set! label-prefix s)
|
||||||
(do-label)))]
|
(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?))))
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
#lang scheme/unit
|
#lang scheme/unit
|
||||||
|
|
||||||
(require mzlib/class
|
(require mzlib/class
|
||||||
mzlib/list
|
mzlib/list
|
||||||
(lib "hierlist.ss" "hierlist")
|
(lib "hierlist.ss" "hierlist")
|
||||||
|
@ -368,29 +368,12 @@
|
||||||
(open-recent-list-item recent-item))
|
(open-recent-list-item recent-item))
|
||||||
(super-instantiate ()))))
|
(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)))
|
(let* ([parent (and (or (not (eq? 'macosx (system-type)))
|
||||||
(preferences:get 'framework:open-here?))
|
(preferences:get 'framework:open-here?))
|
||||||
(get-top-level-focus-window))]
|
(get-top-level-focus-window))]
|
||||||
[file
|
[file
|
||||||
(parameterize ([finder:dialog-parent-parameter parent])
|
(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
|
(and file
|
||||||
(edit-file file))))
|
(edit-file 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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user