From 91ff966c7c65bc1b0177c1369a27ad928bea979f Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 1 Sep 1998 22:12:24 +0000 Subject: [PATCH] ... original commit: 798c71780415bdcce317a03e3b4a4df08d51e0ff --- collects/framework/finder.ss | 768 +++++++++++++++++++++++++++++++++++ collects/framework/group.ss | 234 +++++++++++ collects/framework/main.ss | 21 +- 3 files changed, 1017 insertions(+), 6 deletions(-) create mode 100644 collects/framework/finder.ss diff --git a/collects/framework/finder.ss b/collects/framework/finder.ss new file mode 100644 index 00000000..02cf838e --- /dev/null +++ b/collects/framework/finder.ss @@ -0,0 +1,768 @@ +;;; finder.ss + +;;; Authors: Matthew Flatt, Robby Findler, Paul Steckler + +(unit/sig mred:finder^ + (import mred^ + [preferences : framework:preferences^] + [gui-utils : framework:gui-utils^] + [mzlib:string : mzlib:string^] + [mzlib:function : mzlib:function^] + [mzlib:file : mzlib:file^]) + + (define dialog-parent-parameter (make-parameter null)) + + (define filter-match? + (lambda (filter name msg) + (let-values ([(base name dir?) (split-path name)]) + (if (mzlib:string:regexp-match-exact? filter name) + #t + (begin + (message-box "Error" msg) + #f))))) + + (define last-directory #f) + + (define make-relative + (lambda (s) s)) + + (define current-find-file-directory + (opt-lambda ([dir 'get]) + (cond + [(eq? dir 'get) + (if (not last-directory) + (set! last-directory (current-directory))) + last-directory] + [(and (string? dir) + (directory-exists? dir)) + (set! last-directory dir) + #t] + [else #f]))) + + (define build-updir + (lambda (dir) + (let-values ([(base _1 _2) (split-path dir)]) + (or base dir)))) + + + ; the finder-dialog% class controls the user interface for dialogs + + (define finder-dialog% + (class dialog-box% (parent-win + save-mode? + replace-ok? + multi-mode? + result-box + start-dir + start-name + prompt + file-filter + file-filter-msg) + + (inherit new-line tab fit center + popup-menu show) + + (private + [WIDTH 500] + [HEIGHT 400] + dirs + current-dir + last-selected + [select-counter 0]) + + (private + + [set-directory ; sets directory in listbox + + (lambda (dir) ; dir is normalized + (when (directory-exists? dir) + (gui-utils:show-busy-cursor + (lambda () + (set! current-dir dir) + (set! last-directory dir) + (let-values + ([(dir-list menu-list) + (let loop ([this-dir dir] + [dir-list ()] + [menu-list ()]) + (let-values ([(base-dir in-dir dir?) + (split-path this-dir)]) + (if (eq? (system-type) 'windows) + (mzlib:string:string-lowercase! in-dir)) + (let* ([dir-list (cons this-dir dir-list)] + [menu-list (cons in-dir menu-list)]) + (if base-dir + (loop base-dir dir-list menu-list) + ; No more + (values dir-list menu-list)))))]) + (set! dirs (reverse dir-list)) + (send dir-choice clear) + (let loop ([choices (reverse menu-list)]) + (unless (null? choices) + (send dir-choice append (car choices)) + (loop (cdr choices)))) + (send dir-choice set-selection 0) + (send top-panel force-redraw)) + + (send name-list clear) + (send name-list set + (mzlib:function:quicksort + (let ([no-periods? + (not (preferences:get + 'framework:show-periods-in-dirlist))]) + (let loop ([l (directory-list dir)]) + (if (null? l) + null + (let ([s (car l)] + [rest (loop (cdr l))]) + (cond + [(and no-periods? + (<= 1 (string-length s)) + (char=? (string-ref s 0) #\.)) + rest] + [(directory-exists? (build-path dir s)) + (cons (string-append s (get-slash)) + rest)] + [(or (not file-filter) + (mzlib:string:regexp-match-exact? + file-filter s)) + (cons s rest)] + [else rest]))))) + (if (eq? (system-type) 'unix) string (send name-list number) 0)]) + + (cond + + [(and save-mode? + non-empty? + (not (string? name))) 'nothing-selected] + + [(and save-mode? + non-empty? + (string=? name "")) + (let ([file (send directory-edit get-text)]) + (if (directory-exists? file) + (set-directory (mzlib:file:normalize-path file)) + (message-box + "Error" + "You must specify a file name")))] + + [(and save-mode? + non-empty? + file-filter + (not (mzlib:string:regexp-match-exact? file-filter name))) + (message-box "Error" file-filter-msg)] + + [else + + ; if dir in edit box, go to that dir + + (let ([dir-name (send directory-edit get-text)]) + + (if (directory-exists? dir-name) + (set-directory (mzlib:file:normalize-path dir-name)) + + ; otherwise, try to return absolute path + + (let* ([relative-name (make-relative name)] + [file-in-edit (file-exists? dir-name)] + [file (if (or file-in-edit + (null? relative-name) + save-mode?) + dir-name + (build-path current-dir relative-name))]) + + ; trying to open a file that doesn't exist + + (if (and (not save-mode?) (not file-in-edit)) + (message-box + "Error" + (string-append "The file \"" + dir-name + "\" does not exist.")) + + ; saving a file, which may exist, or + ; opening an existing file + + (if (or (not save-mode?) + (not (file-exists? file)) + replace-ok? + (= (wx:message-box + (string-append + "The file " + file + " already exists. " + "Replace it?") + "Warning" + wx:const-yes-no) + wx:const-yes)) + (let ([normal-path + (with-handlers + ([(lambda (_) #t) + (lambda (_) + (wx:message-box + (string-append + "The file " + file + " contains nonexistent directory or cycle.") + "Warning") + #f)]) + (mzlib:file:normalize-path file))]) + (when normal-path + (set-box! result-box normal-path) + (show #f))))))))]))))] + + [add-one + (lambda (name) + (unless (or (directory-exists? name) + (> (send result-list find-string name) -1)) + (set! select-counter (add1 select-counter)) + (send result-list append (mzlib:file:normalize-path name))))] + + [do-add + (lambda args + (let ([name (send name-list get-string-selection)]) + (if (string? name) + (let ([name (build-path current-dir + (make-relative name))]) + (add-one name)))))] + + [do-add-all + (lambda args + (let loop ([n 0]) + (let ([name (send name-list get-string n)]) + (if (and (string? name) + (positive? (string-length name))) + (let ([name (build-path current-dir + (make-relative name))]) + (add-one name) + (loop (add1 n)))))))] + + [do-remove + (lambda args + (let loop ([n 0]) + (if (< n select-counter) + (if (send result-list selected? n) + (begin + (send result-list delete n) + (set! select-counter (sub1 select-counter)) + (loop n)) + (loop (add1 n))))))] + + [do-cancel + (lambda args + (set-box! result-box #f) + (show #f))] + + [on-close (lambda () #f)]) + + (sequence + (super-init (if save-mode? "Put file" "Get file") + parent-win + WIDTH + HEIGHT)) + + (private + + [main-panel (make-object vertical-panel% this)] + + [top-panel (make-object horizontal-panel% main-panel)] + + [_1 (make-object message% top-panel prompt)] + + [dir-choice (make-object choice% top-panel do-dir '())] + + [middle-panel (make-object horizontal-panel% main-panel)] + [left-middle-panel (make-object vertical-panel% middle-panel)] + [right-middle-panel (when multi-mode? + (make-object vertical-panel% middle-panel))] + [name-list% + + (class-asi list-box% + + (inherit + get-first-item + get-string + get-selection + get-string-selection + number + number-of-visible-items + set-first-item + set-focus + set-selection) + + (public + + [set-selection-and-edit ; set selection, update edit box + + (lambda (pos) + (when (> (number) 0) + (let* ([first-item (get-first-item)] + [last-item (sub1 (+ (number-of-visible-items) + first-item))]) + (if (or (< pos first-item) (> pos last-item)) + (set-first-item pos)) + (set-selection pos))) + (set-edit))] + + [pre-on-char ; set selection according to keystroke + + (lambda (_ key) + (let ([code (send key get-key-code)] + [num-items (number)] + [curr-pos (get-selection)]) + + (cond + + [(and (char? code) + (or (char=? code #\newline) + (char=? code #\return))) ; CR or LF + (do-ok)] + + [(and (char? code) + (char=? code #\tab)) + (set-focus-to-directory-edit)] + + ; look for letter at beginning of a filename + + [(char? code) + (letrec + ([loop + (lambda (pos) + (unless + (>= pos num-items) + (let ([first-char (string-ref (get-string pos) 0)]) + (if (char=? code first-char) + (set-selection-and-edit pos) + (loop (add1 pos))))))]) + (loop (add1 curr-pos)))] + + ; movement keys + + [(and (eq? code 'up) + (> curr-pos 0)) + (set-selection-and-edit (sub1 curr-pos))] + + [(and (eq? code 'down) + (< curr-pos (sub1 num-items))) + (let* ([num-vis (number-of-visible-items)] + [curr-first (get-first-item)] + [new-curr-pos (add1 curr-pos)] + [new-first (if (< new-curr-pos (+ curr-first num-vis)) + curr-first ; no scroll needed + (add1 curr-first))]) + (set-first-item new-first) + (set-selection-and-edit new-curr-pos))] + + [(and (eq? code 'prior) + (> curr-pos 0)) + (let* ([num-vis (number-of-visible-items)] + [new-first (- (get-first-item) num-vis)]) + (set-first-item (max new-first 0)) + (set-selection-and-edit (max 0 (- curr-pos num-vis))))] + + [(and (eq? code 'next) + (< curr-pos (sub1 num-items))) + (let* ([num-vis (number-of-visible-items)] + [new-first (+ (get-first-item) num-vis)]) + (set-first-item (min new-first (- (number) num-vis))) + (set-selection-and-edit + (min (sub1 num-items) (+ curr-pos num-vis))))] + + [else #f])))] + + [on-default-action + (lambda () + (when (> (send name-list number) 0) + (let* ([which (send name-list get-string-selection)] + [dir (build-path current-dir + (make-relative which))]) + (if (directory-exists? dir) + (set-directory (mzlib:file:normalize-path dir)) + (if multi-mode? + (do-add) + (do-ok))))))]))] + + [name-list (make-object name-list% + #f left-middle-panel do-name-list + '(single))] + + [set-focus-to-name-list + (lambda () + (send name-list set-focus))] + [set-focus-to-directory-edit + (lambda () + (send directory-panel set-focus))] + + [save-panel (when save-mode? (make-object horizontal-panel% main-panel))] + + [directory-panel (make-object horizontal-panel% main-panel)] + + [directory-edit + (make-object (class-asi text% + (rename [super-on-local-char on-local-char]) + (public + [on-local-char + (lambda (key) + (let ([code (send key get-key-code)]) + (cond + [(or (equal? code #\return) + (equal? code #\newline)) + (do-ok) + (set-focus-to-name-list)] + [(equal? code #\tab) + (set-focus-to-name-list)] + [else + (super-on-local-char key)])))])))] + + [dot-panel (when (eq? 'unix (system-type)) + (make-object horizontal-panel% main-panel))] + + [bottom-panel (make-object horizontal-panel% main-panel)] + + [result-list + (when multi-mode? + (make-object list-box% + #f + do-result-list + right-middle-panel + void + '(multiple)))] + [add-panel + (when multi-mode? + (make-object horizontal-panel% left-middle-panel))] + + [remove-panel + (when multi-mode? + (make-object horizontal-panel% right-middle-panel))] + + [do-updir + (lambda () + (set-directory (build-updir current-dir)) + (set-focus-to-name-list)) + ]) + + (sequence + + (when (eq? (system-type) 'unix) + (let ([dot-cb + (make-object + check-box% dot-panel + do-period-in/exclusion + "Show files and directories that begin with a dot")]) + (send dot-panel stretchable-in-y #f) + (send dot-cb set-value + (preferences:get 'framework:show-periods-in-dirlist)))) + + (send directory-panel stretchable-in-y #f) + + (let ([canvas (make-object editor-canvas% directory-panel #f + (list 'hide-h-scroll 'v-scroll))]) + + (send* canvas + (set-line-count 1) + (set-media directory-edit) + (set-focus) + (user-min-height 20))) + + (when multi-mode? + (send add-panel stretchable-in-y #f) + (send remove-panel stretchable-in-y #f) + (send result-list stretchable-in-x #t)) + + (make-object button% + "Up directory" + top-panel + (lambda (button evt) (do-updir))) + + (send name-list stretchable-in-x #t) + + (send top-panel stretchable-in-y #f) + + (send bottom-panel stretchable-in-y #f) + + (when save-mode? + (send save-panel stretchable-in-y #f))) + + (private + + [add-button (when multi-mode? + (make-object horizontal-panel% add-panel) + (make-object button% + "Add" + add-panel + do-add))] + [add-all-button (when multi-mode? + (begin0 + (make-object button% + "Add all" + add-panel do-add-all) + (make-object horizontal-panel% add-panel)))] + [remove-button (when multi-mode? + (make-object horizontal-panel% remove-panel) + (begin0 + (make-object button% "Remove" remove-panel do-remove) + (make-object horizontal-panel% remove-panel)))]) + (sequence + (make-object vertical-panel% bottom-panel)) + (private + [cancel-button (make-object button% "Cancel" bottom-panel do-cancel)] + [ok-button + (make-object button% + "OK" + bottom-panel do-ok)]) + (sequence + (cond + [(and start-dir + (not (null? start-dir)) + (directory-exists? start-dir)) + (set-directory (mzlib:file:normalize-path start-dir))] + [last-directory (set-directory last-directory)] + [else (set-directory (current-directory))]) + + (send ok-button min-width (send cancel-button get-width)) + + (center 'both) + + (show #t)))) + + ; make-common takes a dialog-maker + ; used to make one dialog object per session, now created each time + + (define make-common + (lambda (make-dialog) + (lambda args + (let ([result-box (box #f)]) + (apply make-dialog result-box args) + (unbox result-box))))) + + ; the common versions of these functions have their visual + ; interfaces under Scheme control + + (define common-put-file + (make-common + (opt-lambda (result-box + [name ()] + [directory ()] + [replace? #f] + [prompt "Select file"] + [filter #f] + [filter-msg "Invalid form"] + [parent-win (dialog-parent-parameter)]) + (let* ([directory (if (and (null? directory) + (string? name)) + (or (mzlib:file:path-only name) null) + directory)] + [name (or (and (string? name) + (mzlib:file:file-name-from-path name)) + name)]) + (make-object finder-dialog% + parent-win + #t + replace? + #f + result-box + directory + name + prompt + filter + filter-msg))))) + + (define common-get-file + (make-common + (opt-lambda + (result-box + [directory ()] + [prompt "Select file"] + [filter #f] + [filter-msg "Bad name"] + [parent-win (dialog-parent-parameter)]) + (make-object finder-dialog% + parent-win ; parent window + #f ; save-mode? + #f ; replace-ok? + #f ; multi-mode? + result-box ; boxed results + directory ; start-dir + '() ; start-name + prompt ; prompt + filter ; file-filter + filter-msg ; file-filter-msg + )))) + + (define common-get-file-list + (make-common + (opt-lambda (result-box + [directory ()] + [prompt "Select files"] + [filter #f] + [filter-msg "Bad name"] + [parent-win (dialog-parent-parameter)]) + (make-object + finder-dialog% + parent-win ; parent window + #f ; save-mode? + #f ; replace-ok? + #t ; multi-mode? + result-box ; boxed results + directory ; directory + '() ; start-name + prompt ; prompt + filter ; file-filter + filter-msg ; file-filter-msg + )))) + + ; the std- and common- forms both have opt-lambda's, with the same + ; list of args. Should the opt-lambda's be placed in the dispatching function? + + (define std-put-file + (opt-lambda ([name ()] + [directory ()] + [replace? #f] + [prompt "Select file"] + [filter #f] + [filter-msg "That filename does not have the right form."] + [parent-win (dialog-parent-parameter)]) + (let* ([directory (if (and (null? directory) + (string? name)) + (or (mzlib:file:path-only name) null) + directory)] + [name (or (and (string? name) + (mzlib:file:file-name-from-path name)) + name)] + [f (wx:put-file + prompt + parent-win + directory + name + ".ss")]) + (if (or (null? f) + (and filter + (not (filter-match? filter + f + filter-msg)))) + #f + (let* ([f (mzlib:file:normalize-path f)] + [dir (mzlib:file:path-only f)] + [name (mzlib:file:file-name-from-path f)]) + (cond + [(not (and (string? dir) (directory-exists? dir))) + (message-box "That directory does not exist." "Error") + #f] + [(or (not name) (equal? name "")) + (message-box "Empty filename." "Error") + #f] + [else f])))))) + + (define std-get-file + (opt-lambda ([directory ()] + [prompt "Select file"] + [filter #f] + [filter-msg "That filename does not have the right form."] + [parent-win (dialog-parent-parameter)]) + (let ([f (wx:file-selector + prompt + directory + null + null + "*" + wx:const-open + parent-win)]) + (if (null? f) + #f + (if (or (not filter) (filter-match? filter f filter-msg)) + (let ([f (mzlib:file:normalize-path f)]) + (cond + [(directory-exists? f) + (message-box "That is a directory name." "Error") + #f] + [(not (file-exists? f)) + (message-box "File does not exist.") + #f] + [else f])) + #f))))) + + ; external interfaces to file functions + + (define put-file + (lambda args + (let ([actual-fun + (case (preferences:get 'framework:file-dialogs) + [(std) std-put-file] + [(common) common-put-file])]) + (apply actual-fun args)))) + + (define get-file + (lambda args + (let ([actual-fun + (case (preferences:get 'framework:file-dialogs) + [(std) std-get-file] + [(common) common-get-file])]) + (apply actual-fun args))))) + + + diff --git a/collects/framework/group.ss b/collects/framework/group.ss index 8851955a..27a009d4 100644 --- a/collects/framework/group.ss +++ b/collects/framework/group.ss @@ -45,3 +45,237 @@ when adding a frame, do this: (set-close-menu-item-state! a-frame #t))))) +(unit/sig mred:group^ + (import [mred:preferences : mred:preferences^] + [mred:editor-frame : mred:editor-frame^] + [mred:gui-utils : mred:gui-utils^] + [mred:exit : mred:exit^] + [mred:autosave : mred:autosave^] + [mred:handler : mred:handler^] + [mzlib:function : mzlib:function^] + [mzlib:file : mzlib:file^]) + + (mred:debug:printf 'invoke "mred:group@") + + (define frame-group% + (let-struct frame (frame id) + (class null () + (private + [active-frame #f] + [frame-counter 0] + [frames null] + [todo-to-new-frames void] + [empty-close-down (lambda () (void))] + [empty-test (lambda () #t)] + + [windows-menus null]) + + (private + [get-windows-menu + (lambda (frame) + (and (ivar-in-class? 'windows-menu (object-class frame)) + (ivar frame windows-menu)))] + [insert-windows-menu + (lambda (frame) + (let ([menu (get-windows-menu frame)]) + (when menu + (set! windows-menus (cons (list menu) windows-menus)))))] + [remove-windows-menu + (lambda (frame) + (let* ([menu (get-windows-menu frame)]) + (set! windows-menus + (mzlib:function:remove + menu + windows-menus + (lambda (x y) + (eq? x (car y)))))))] + + [update-windows-menus + (lambda () + (let* ([windows (length windows-menus)] + [get-name (lambda (frame) (send (frame-frame frame) get-title))] + [sorted-frames + (mzlib:function:quicksort + frames + (lambda (f1 f2) + (string-ci<=? (get-name f1) + (get-name f2))))]) + (set! + windows-menus + (map + (lambda (menu-list) + (let ([menu (car menu-list)] + [old-ids (cdr menu-list)]) + (for-each (lambda (id) (send menu delete id)) + old-ids) + (let ([new-ids + (map + (lambda (frame) + (let ([frame (frame-frame frame)] + [default-name "Untitled"]) + (send menu append-item + (let ([title (send frame get-title)]) + (if (string=? title "") + (if (ivar-in-class? 'get-entire-title (object-class frame)) + (let ([title (send frame get-entire-title)]) + (if (string=? title "") + default-name + title)) + default-name) + title)) + (lambda () + (send frame show #t))))) + sorted-frames)]) + (cons menu new-ids)))) + windows-menus))))]) + + + (public + [set-empty-callbacks + (lambda (test close-down) + (set! empty-test test) + (set! empty-close-down close-down))] + [get-frames (lambda () (map frame-frame frames))] + [frame% mred:editor-frame:editor-frame%] + [get-frame% (lambda () frame%)] + + [frame-title-changed + (lambda (frame) + (when (member frame (map frame-frame frames)) + (update-windows-menus)))] + + [for-each-frame + (lambda (f) + (for-each (lambda (x) (f (frame-frame x))) frames) + (set! todo-to-new-frames + (let ([old todo-to-new-frames]) + (lambda (frame) (old frame) (f frame)))))] + [get-active-frame + (lambda () + (cond + [active-frame active-frame] + [(null? frames) #f] + [else (frame-frame (car frames))]))] + [set-active-frame + (lambda (f) + (set! active-frame f))] + [insert-frame + (lambda (f) + (set! frame-counter (add1 frame-counter)) + (let ([new-frames (cons (make-frame f frame-counter) + frames)]) + (set! frames new-frames) + (insert-windows-menu f) + (update-windows-menus)) + (todo-to-new-frames f))] + + [can-remove-frame? + (opt-lambda (f) + (let ([new-frames + (mzlib:function:remove + f frames + (lambda (f fr) (eq? f (frame-frame fr))))]) + (if (null? new-frames) + (empty-test) + #t)))] + [remove-frame + (opt-lambda (f) + (when (eq? f active-frame) + (set! active-frame #f)) + (let ([new-frames + (mzlib:function:remove + f frames + (lambda (f fr) (eq? f (frame-frame fr))))]) + (set! frames new-frames) + (remove-windows-menu f) + (update-windows-menus) + (when (null? frames) + (empty-close-down))))] + [clear + (lambda () + (and (empty-test) + (begin (set! frames null) + (empty-close-down) + #t)))] + [close-all + (lambda () + (let/ec escape + (for-each (lambda (f) + (let ([frame (frame-frame f)]) + (if (send frame on-close) + (send frame show #f) + (escape #f)))) + frames) + #t))] + [new-frame + (lambda (filename) + (if (string? filename) + (mred:handler:edit-file filename this #f + (lambda (fn group) + (make-object (get-frame%) + fn #t group))) + (make-object (get-frame%) filename #t this)))] + [locate-file + (lambda (name) + (let* ([normalized + ;; allow for the possiblity of filenames that are urls + (with-handlers ([(lambda (x) #t) + (lambda (x) name)]) + (mzlib:file:normalize-path name))] + [test-frame + (lambda (frame) + (and (ivar-in-class? 'get-edit (object-class frame)) + (let* ([edit (send frame get-edit)] + [filename (send edit get-filename)]) + (and (ivar edit editing-this-file?) + (string? filename) + (string=? normalized + (with-handlers ([(lambda (x) #t) + (lambda (x) filename)]) + (mzlib:file:normalize-path + filename)))))))]) + (let loop ([frames frames]) + (cond + [(null? frames) #f] + [else + (let* ([frame (frame-frame (car frames))]) + (if (test-frame frame) + frame + (loop (cdr frames))))]))))])))) + + (define the-frame-group (make-object frame-group%)) + + (define at-most-one-maker + (lambda () + (let ([s (make-semaphore 1)] + [test #f]) + (lambda (return thunk) + (semaphore-wait s) + (if test + (begin (semaphore-post s) + return) + (begin + (set! test #t) + (semaphore-post s) + (begin0 (thunk) + (semaphore-wait s) + (set! test #f) + (semaphore-post s)))))))) + + (define at-most-one (at-most-one-maker)) + + (send the-frame-group set-empty-callbacks + (lambda () + (at-most-one (void) + (lambda () (mred:exit:exit #t)))) + (lambda () + (at-most-one #t + (lambda () + (mred:exit:run-exit-callbacks))))) + + (mred:exit:insert-exit-callback + (lambda () + (at-most-one + #t + (lambda () + (send the-frame-group close-all)))))) diff --git a/collects/framework/main.ss b/collects/framework/main.ss index a3e06f52..86129888 100644 --- a/collects/framework/main.ss +++ b/collects/framework/main.ss @@ -4,22 +4,31 @@ ;; preferences - (preferences:set-default 'mred:autosave-delay 300 number?) - (preferences:set-default 'mred:autosaving-on? #t + (preferences:set-default 'framework:autosave-delay 300 number?) + (preferences:set-default 'framework:autosaving-on? #t (lambda (x) (or (not x) (eq? x #t)))) - (preferences:set-default 'mred:verify-exit #t + (preferences:set-default 'framework:verify-exit #t (lambda (x) (or (not x) (eq? x #t)))) - - - (preferences:set-default 'mred:delete-forward? + (preferences:set-default 'framework:delete-forward? (not (eq? (system-type) 'unix)) (lambda (x) (or (not x) (eq? x #t)))) + (preferences:set 'framework:show-periods-in-dirlist #f + (lambda (x) + (or (not x) + (eq? x #t)))) + (preferences:set 'framework:file-dialogs + (if (eq? wx:platform 'unix) + 'common + 'std) + (lambda (x) + (or (eq? x 'common) + (eq? x 'std)))) (preferences:read)