adjust the find-in-files initial config dialog to
get the "global" framework keybindings closes PR 13110
This commit is contained in:
Robby Findler
parent
ac5965a1dc
commit
c069fa67a9
|
|
@ -358,212 +358,214 @@
|
||||||
;; thread: eventspace main thread
|
;; thread: eventspace main thread
|
||||||
;; configures the search
|
;; configures the search
|
||||||
(define (configure-search)
|
(define (configure-search)
|
||||||
(define dialog (make-object dialog% (string-constant mfs-configure-search)
|
(keymap:call/text-keymap-initializer
|
||||||
#f 500 #f #f #f '(resize-border)))
|
(λ ()
|
||||||
(define outer-files-panel (make-object vertical-panel% dialog '(border)))
|
(define dialog (make-object dialog% (string-constant mfs-configure-search)
|
||||||
(define outer-method-panel (make-object vertical-panel% dialog '(border)))
|
#f 500 #f #f #f '(resize-border)))
|
||||||
(define button-panel (make-object horizontal-panel% dialog))
|
(define outer-files-panel (make-object vertical-panel% dialog '(border)))
|
||||||
(define files-label (make-object message% (string-constant mfs-files-section) outer-files-panel))
|
(define outer-method-panel (make-object vertical-panel% dialog '(border)))
|
||||||
(define files-inset-outer-panel (make-object horizontal-panel% outer-files-panel))
|
(define button-panel (make-object horizontal-panel% dialog))
|
||||||
(define files-inset-panel (make-object horizontal-panel% files-inset-outer-panel))
|
(define files-label (make-object message% (string-constant mfs-files-section) outer-files-panel))
|
||||||
(define files-panel (make-object vertical-panel% files-inset-outer-panel))
|
(define files-inset-outer-panel (make-object horizontal-panel% outer-files-panel))
|
||||||
(define method-label (make-object message% (string-constant mfs-search-section) outer-method-panel))
|
(define files-inset-panel (make-object horizontal-panel% files-inset-outer-panel))
|
||||||
(define method-inset-outer-panel (make-object horizontal-panel% outer-method-panel))
|
(define files-panel (make-object vertical-panel% files-inset-outer-panel))
|
||||||
(define method-inset-panel (make-object horizontal-panel% method-inset-outer-panel))
|
(define method-label (make-object message% (string-constant mfs-search-section) outer-method-panel))
|
||||||
(define method-panel (make-object vertical-panel% method-inset-outer-panel))
|
(define method-inset-outer-panel (make-object horizontal-panel% outer-method-panel))
|
||||||
|
(define method-inset-panel (make-object horizontal-panel% method-inset-outer-panel))
|
||||||
(define dir-panel (make-object horizontal-panel% files-panel))
|
(define method-panel (make-object vertical-panel% method-inset-outer-panel))
|
||||||
(define dir-field (make-object text-field% (string-constant mfs-dir) dir-panel
|
|
||||||
(λ (x y) (dir-field-callback))))
|
(define dir-panel (make-object horizontal-panel% files-panel))
|
||||||
(define dir-button (make-object button% (string-constant browse...) dir-panel
|
(define dir-field (make-object text-field% (string-constant mfs-dir) dir-panel
|
||||||
(λ (x y) (dir-button-callback))))
|
(λ (x y) (dir-field-callback))))
|
||||||
|
(define dir-button (make-object button% (string-constant browse...) dir-panel
|
||||||
(define recur-check-box (make-object check-box% (string-constant mfs-recur-over-subdirectories) files-panel
|
(λ (x y) (dir-button-callback))))
|
||||||
(λ (x y) (recur-check-box-callback))))
|
|
||||||
|
(define recur-check-box (make-object check-box% (string-constant mfs-recur-over-subdirectories) files-panel
|
||||||
(define filter-panel (make-object horizontal-panel% files-panel))
|
(λ (x y) (recur-check-box-callback))))
|
||||||
(define filter-check-box (make-object check-box% (string-constant mfs-regexp-filename-filter) filter-panel
|
|
||||||
(λ (x y) (filter-check-box-callback))))
|
(define filter-panel (make-object horizontal-panel% files-panel))
|
||||||
(define filter-text-field (make-object text-field% #f filter-panel
|
(define filter-check-box (make-object check-box% (string-constant mfs-regexp-filename-filter) filter-panel
|
||||||
(λ (x y) (filter-text-field-callback))))
|
(λ (x y) (filter-check-box-callback))))
|
||||||
|
(define filter-text-field (make-object text-field% #f filter-panel
|
||||||
(define methods-choice (make-object choice% #f (map search-type-label search-types) method-panel
|
(λ (x y) (filter-text-field-callback))))
|
||||||
(λ (x y) (methods-choice-callback))))
|
|
||||||
(define search-text-field (make-object text-field% (string-constant mfs-search-string) method-panel
|
(define methods-choice (make-object choice% #f (map search-type-label search-types) method-panel
|
||||||
(λ (x y) (search-text-field-callback))))
|
(λ (x y) (methods-choice-callback))))
|
||||||
(define active-method-panel (make-object panel:single% method-panel))
|
(define search-text-field (make-object text-field% (string-constant mfs-search-string) method-panel
|
||||||
(define methods-check-boxess
|
(λ (x y) (search-text-field-callback))))
|
||||||
(let ([pref (preferences:get 'drracket:multi-file-search:search-check-boxes)])
|
(define active-method-panel (make-object panel:single% method-panel))
|
||||||
(map
|
(define methods-check-boxess
|
||||||
(λ (search-type prefs-settings)
|
(let ([pref (preferences:get 'drracket:multi-file-search:search-check-boxes)])
|
||||||
(let ([p (make-object vertical-panel% active-method-panel)]
|
(map
|
||||||
[params (search-type-params search-type)])
|
(λ (search-type prefs-settings)
|
||||||
(send p set-alignment 'left 'center)
|
(let ([p (make-object vertical-panel% active-method-panel)]
|
||||||
(map (λ (flag-pair prefs-setting)
|
[params (search-type-params search-type)])
|
||||||
(let ([cb (make-object check-box%
|
(send p set-alignment 'left 'center)
|
||||||
(car flag-pair)
|
(map (λ (flag-pair prefs-setting)
|
||||||
p
|
(let ([cb (make-object check-box%
|
||||||
(λ (evt chk) (method-callback chk)))])
|
(car flag-pair)
|
||||||
(send cb set-value prefs-setting)
|
p
|
||||||
cb))
|
(λ (evt chk) (method-callback chk)))])
|
||||||
params
|
(send cb set-value prefs-setting)
|
||||||
(if (= (length params) (length prefs-settings))
|
cb))
|
||||||
prefs-settings
|
params
|
||||||
(map (λ (x) #f) params)))))
|
(if (= (length params) (length prefs-settings))
|
||||||
search-types
|
prefs-settings
|
||||||
(if (= (length search-types) (length pref))
|
(map (λ (x) #f) params)))))
|
||||||
pref
|
search-types
|
||||||
(map (λ (x) '()) search-types)))))
|
(if (= (length search-types) (length pref))
|
||||||
(define-values (ok-button cancel-button)
|
pref
|
||||||
(gui-utils:ok/cancel-buttons
|
(map (λ (x) '()) search-types)))))
|
||||||
button-panel
|
(define-values (ok-button cancel-button)
|
||||||
(λ (x y) (ok-button-callback))
|
(gui-utils:ok/cancel-buttons
|
||||||
(λ (x y) (cancel-button-callback))))
|
button-panel
|
||||||
(define spacer (make-object grow-box-spacer-pane% button-panel))
|
(λ (x y) (ok-button-callback))
|
||||||
|
(λ (x y) (cancel-button-callback))))
|
||||||
;; initialized to a searcher during the ok button callback
|
(define spacer (make-object grow-box-spacer-pane% button-panel))
|
||||||
;; so the user can be informed of an error before the dialog
|
|
||||||
;; closes.
|
;; initialized to a searcher during the ok button callback
|
||||||
(define searcher #f)
|
;; so the user can be informed of an error before the dialog
|
||||||
|
;; closes.
|
||||||
;; initialized to a regexp if the user wants to filter filenames,
|
(define searcher #f)
|
||||||
;; during the ok-button-callback, so errors can be signaled.
|
|
||||||
(define filter #f)
|
;; initialized to a regexp if the user wants to filter filenames,
|
||||||
|
;; during the ok-button-callback, so errors can be signaled.
|
||||||
;; title for message box that signals error messages
|
(define filter #f)
|
||||||
(define message-box-title (string-constant mfs-drscheme-multi-file-search))
|
|
||||||
|
;; title for message box that signals error messages
|
||||||
(define (ok-button-callback)
|
(define message-box-title (string-constant mfs-drscheme-multi-file-search))
|
||||||
(cond
|
|
||||||
[(with-handlers ([exn:fail:filesystem?
|
(define (ok-button-callback)
|
||||||
(λ (x) #f)])
|
|
||||||
(directory-exists? (send dir-field get-value)))
|
|
||||||
(let ([_searcher
|
|
||||||
((search-type-make-searcher (list-ref search-types (send methods-choice get-selection)))
|
|
||||||
(map (λ (cb) (send cb get-value))
|
|
||||||
(send (send active-method-panel active-child) get-children))
|
|
||||||
(send search-text-field get-value))])
|
|
||||||
(if (string? _searcher)
|
|
||||||
(message-box message-box-title _searcher dialog)
|
|
||||||
(let ([regexp (with-handlers ([(λ (x) #t)
|
|
||||||
(λ (exn)
|
|
||||||
(format "~a" (exn-message exn)))])
|
|
||||||
(and (send filter-check-box get-value)
|
|
||||||
(regexp (send filter-text-field get-value))))])
|
|
||||||
(if (string? regexp)
|
|
||||||
(message-box message-box-title regexp dialog)
|
|
||||||
(begin (set! searcher _searcher)
|
|
||||||
(set! filter regexp)
|
|
||||||
(set! ok? #t)
|
|
||||||
(send dialog show #f))))))]
|
|
||||||
[else
|
|
||||||
(message-box message-box-title
|
|
||||||
(format (string-constant mfs-not-a-dir) (send dir-field get-value))
|
|
||||||
dialog)]))
|
|
||||||
(define (cancel-button-callback)
|
|
||||||
(send dialog show #f))
|
|
||||||
|
|
||||||
(define (method-callback chk)
|
|
||||||
(preferences:set
|
|
||||||
'drracket:multi-file-search:search-check-boxes
|
|
||||||
(let loop ([methods-check-boxess methods-check-boxess])
|
|
||||||
(cond
|
(cond
|
||||||
[(null? methods-check-boxess) null]
|
[(with-handlers ([exn:fail:filesystem?
|
||||||
|
(λ (x) #f)])
|
||||||
|
(directory-exists? (send dir-field get-value)))
|
||||||
|
(let ([_searcher
|
||||||
|
((search-type-make-searcher (list-ref search-types (send methods-choice get-selection)))
|
||||||
|
(map (λ (cb) (send cb get-value))
|
||||||
|
(send (send active-method-panel active-child) get-children))
|
||||||
|
(send search-text-field get-value))])
|
||||||
|
(if (string? _searcher)
|
||||||
|
(message-box message-box-title _searcher dialog)
|
||||||
|
(let ([regexp (with-handlers ([(λ (x) #t)
|
||||||
|
(λ (exn)
|
||||||
|
(format "~a" (exn-message exn)))])
|
||||||
|
(and (send filter-check-box get-value)
|
||||||
|
(regexp (send filter-text-field get-value))))])
|
||||||
|
(if (string? regexp)
|
||||||
|
(message-box message-box-title regexp dialog)
|
||||||
|
(begin (set! searcher _searcher)
|
||||||
|
(set! filter regexp)
|
||||||
|
(set! ok? #t)
|
||||||
|
(send dialog show #f))))))]
|
||||||
[else
|
[else
|
||||||
(cons (let loop ([methods-check-boxes (car methods-check-boxess)])
|
(message-box message-box-title
|
||||||
(cond
|
(format (string-constant mfs-not-a-dir) (send dir-field get-value))
|
||||||
[(null? methods-check-boxes) null]
|
dialog)]))
|
||||||
[else (cons (send (car methods-check-boxes) get-value)
|
(define (cancel-button-callback)
|
||||||
(loop (cdr methods-check-boxes)))]))
|
(send dialog show #f))
|
||||||
(loop (cdr methods-check-boxess)))]))))
|
|
||||||
|
(define (method-callback chk)
|
||||||
(define (dir-field-callback)
|
(preferences:set
|
||||||
(let ([df (send dir-field get-value)])
|
'drracket:multi-file-search:search-check-boxes
|
||||||
(when (path-string? df)
|
(let loop ([methods-check-boxess methods-check-boxess])
|
||||||
(preferences:set 'drracket:multi-file-search:directory (string->path df)))))
|
(cond
|
||||||
|
[(null? methods-check-boxess) null]
|
||||||
(define (filter-check-box-callback)
|
[else
|
||||||
(preferences:set 'drracket:multi-file-search:filter? (send filter-check-box get-value))
|
(cons (let loop ([methods-check-boxes (car methods-check-boxess)])
|
||||||
(send filter-text-field enable (send filter-check-box get-value)))
|
(cond
|
||||||
(define (filter-text-field-callback)
|
[(null? methods-check-boxes) null]
|
||||||
(preferences:set 'drracket:multi-file-search:filter-regexp (send filter-text-field get-value)))
|
[else (cons (send (car methods-check-boxes) get-value)
|
||||||
|
(loop (cdr methods-check-boxes)))]))
|
||||||
(define (recur-check-box-callback)
|
(loop (cdr methods-check-boxess)))]))))
|
||||||
(preferences:set 'drracket:multi-file-search:recur? (send recur-check-box get-value)))
|
|
||||||
(define (methods-choice-callback)
|
(define (dir-field-callback)
|
||||||
(define which (send methods-choice get-selection))
|
(let ([df (send dir-field get-value)])
|
||||||
(preferences:set 'drracket:multi-file-search:search-type which)
|
(when (path-string? df)
|
||||||
(set-method which))
|
(preferences:set 'drracket:multi-file-search:directory (string->path df)))))
|
||||||
(define (set-method which)
|
|
||||||
(send active-method-panel active-child
|
(define (filter-check-box-callback)
|
||||||
(list-ref (send active-method-panel get-children)
|
(preferences:set 'drracket:multi-file-search:filter? (send filter-check-box get-value))
|
||||||
which)))
|
(send filter-text-field enable (send filter-check-box get-value)))
|
||||||
(define (search-text-field-callback)
|
(define (filter-text-field-callback)
|
||||||
(preferences:set 'drracket:multi-file-search:search-string (send search-text-field get-value)))
|
(preferences:set 'drracket:multi-file-search:filter-regexp (send filter-text-field get-value)))
|
||||||
(define (dir-button-callback)
|
|
||||||
(define old-d (string->path (send dir-field get-value)))
|
(define (recur-check-box-callback)
|
||||||
(define new-d (get-directory #f
|
(preferences:set 'drracket:multi-file-search:recur? (send recur-check-box get-value)))
|
||||||
#f
|
(define (methods-choice-callback)
|
||||||
(and (directory-exists? old-d)
|
(define which (send methods-choice get-selection))
|
||||||
old-d)))
|
(preferences:set 'drracket:multi-file-search:search-type which)
|
||||||
(when (and new-d
|
(set-method which))
|
||||||
(directory-exists? new-d))
|
(define (set-method which)
|
||||||
(preferences:set 'drracket:multi-file-search:directory new-d)
|
(send active-method-panel active-child
|
||||||
(send dir-field set-value (path->string new-d))))
|
(list-ref (send active-method-panel get-children)
|
||||||
|
which)))
|
||||||
(define (get-files)
|
(define (search-text-field-callback)
|
||||||
(let ([dir (string->path (send dir-field get-value))])
|
(preferences:set 'drracket:multi-file-search:search-string (send search-text-field get-value)))
|
||||||
(and (directory-exists? dir)
|
(define (dir-button-callback)
|
||||||
(if (send recur-check-box get-value)
|
(define old-d (string->path (send dir-field get-value)))
|
||||||
(build-recursive-file-list dir filter)
|
(define new-d (get-directory #f
|
||||||
(build-flat-file-list dir filter)))))
|
#f
|
||||||
|
(and (directory-exists? old-d)
|
||||||
(define ok? #f)
|
old-d)))
|
||||||
|
(when (and new-d
|
||||||
(send button-panel set-alignment 'right 'center)
|
(directory-exists? new-d))
|
||||||
(send dir-panel stretchable-height #f)
|
(preferences:set 'drracket:multi-file-search:directory new-d)
|
||||||
(send outer-files-panel stretchable-height #f)
|
(send dir-field set-value (path->string new-d))))
|
||||||
(send outer-files-panel set-alignment 'left 'center)
|
|
||||||
(send files-inset-panel min-width 20)
|
(define (get-files)
|
||||||
(send files-inset-panel stretchable-width #f)
|
(let ([dir (string->path (send dir-field get-value))])
|
||||||
(send files-panel set-alignment 'left 'center)
|
(and (directory-exists? dir)
|
||||||
|
(if (send recur-check-box get-value)
|
||||||
(send recur-check-box set-value (preferences:get 'drracket:multi-file-search:recur?))
|
(build-recursive-file-list dir filter)
|
||||||
(send filter-check-box set-value (preferences:get 'drracket:multi-file-search:filter?))
|
(build-flat-file-list dir filter)))))
|
||||||
(send search-text-field set-value (preferences:get 'drracket:multi-file-search:search-string))
|
|
||||||
(send filter-text-field set-value (preferences:get 'drracket:multi-file-search:filter-regexp))
|
(define ok? #f)
|
||||||
(send dir-field set-value (path->string
|
|
||||||
(let ([p (preferences:get 'drracket:multi-file-search:directory)])
|
(send button-panel set-alignment 'right 'center)
|
||||||
(if (not p)
|
(send dir-panel stretchable-height #f)
|
||||||
(let ([p (car (filesystem-root-list))])
|
(send outer-files-panel stretchable-height #f)
|
||||||
(preferences:set 'drracket:multi-file-search:directory p)
|
(send outer-files-panel set-alignment 'left 'center)
|
||||||
p)
|
(send files-inset-panel min-width 20)
|
||||||
p))))
|
(send files-inset-panel stretchable-width #f)
|
||||||
|
(send files-panel set-alignment 'left 'center)
|
||||||
(send outer-method-panel stretchable-height #f)
|
|
||||||
(send outer-method-panel set-alignment 'left 'center)
|
(send recur-check-box set-value (preferences:get 'drracket:multi-file-search:recur?))
|
||||||
(send method-inset-panel min-width 20)
|
(send filter-check-box set-value (preferences:get 'drracket:multi-file-search:filter?))
|
||||||
(send method-inset-panel stretchable-width #f)
|
(send search-text-field set-value (preferences:get 'drracket:multi-file-search:search-string))
|
||||||
(send method-panel set-alignment 'left 'center)
|
(send filter-text-field set-value (preferences:get 'drracket:multi-file-search:filter-regexp))
|
||||||
(send filter-panel stretchable-height #f)
|
(send dir-field set-value (path->string
|
||||||
|
(let ([p (preferences:get 'drracket:multi-file-search:directory)])
|
||||||
(send methods-choice set-selection (preferences:get 'drracket:multi-file-search:search-type))
|
(if (not p)
|
||||||
(set-method (preferences:get 'drracket:multi-file-search:search-type))
|
(let ([p (car (filesystem-root-list))])
|
||||||
|
(preferences:set 'drracket:multi-file-search:directory p)
|
||||||
(send search-text-field focus)
|
p)
|
||||||
(let ([t (send search-text-field get-editor)])
|
p))))
|
||||||
(send t set-position 0 (send t last-position)))
|
|
||||||
(send dialog show #t)
|
(send outer-method-panel stretchable-height #f)
|
||||||
|
(send outer-method-panel set-alignment 'left 'center)
|
||||||
(and
|
(send method-inset-panel min-width 20)
|
||||||
ok?
|
(send method-inset-panel stretchable-width #f)
|
||||||
(make-search-info
|
(send method-panel set-alignment 'left 'center)
|
||||||
(send dir-field get-value)
|
(send filter-panel stretchable-height #f)
|
||||||
(send recur-check-box get-value)
|
|
||||||
(and (send filter-check-box get-value)
|
(send methods-choice set-selection (preferences:get 'drracket:multi-file-search:search-type))
|
||||||
(regexp (send filter-text-field get-value)))
|
(set-method (preferences:get 'drracket:multi-file-search:search-type))
|
||||||
searcher
|
|
||||||
(send search-text-field get-value))))
|
(send search-text-field focus)
|
||||||
|
(let ([t (send search-text-field get-editor)])
|
||||||
|
(send t set-position 0 (send t last-position)))
|
||||||
|
(send dialog show #t)
|
||||||
|
|
||||||
|
(and
|
||||||
|
ok?
|
||||||
|
(make-search-info
|
||||||
|
(send dir-field get-value)
|
||||||
|
(send recur-check-box get-value)
|
||||||
|
(and (send filter-check-box get-value)
|
||||||
|
(regexp (send filter-text-field get-value)))
|
||||||
|
searcher
|
||||||
|
(send search-text-field get-value))))))
|
||||||
|
|
||||||
|
|
||||||
;; do-search : search-info text -> void
|
;; do-search : search-info text -> void
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user