(unit/sig framework:handler^ (import mred^ [gui-utils : framework:gui-utils^] [finder : framework:finder^] [group : framework:group^] [text : framework:text^] [preferences : framework:preferences^] [frame : framework:frame^] [mzlib:file : mzlib:file^]) (define-struct handler (name extension handler)) (define format-handlers '()) (define make-insert-handler (letrec ([string-list? (lambda (l) (cond [(null? l) #t] [(not (pair? l)) #f] [else (and (string? (car l)) (string-list? (cdr l)))]))]) (lambda (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 extension handler)])))) (define insert-format-handler (lambda args (set! format-handlers (cons (apply make-insert-handler 'insert-format-handler args) format-handlers)))) (define find-handler (lambda (name handlers) (let/ec exit (let ([extension (if (string? name) (or (mzlib:file:filename-extension name) "") "")]) (for-each (lambda (handler) (let ([ext (handler-extension handler)]) (when (or (and (procedure? ext) (ext name)) (and (string? ext) (string=? ext extension)) (and (pair? ext) (ormap (lambda (ext) (string=? ext extension)) ext))) (exit (handler-handler handler))))) handlers) #f)))) (define find-format-handler (lambda (name) (find-handler name format-handlers))) ; Finding format & mode handlers by name (define find-named-handler (lambda (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 (lambda (name) (find-named-handler name format-handlers))) ; Open a file for editing (define edit-file (opt-lambda (filename [make-default (lambda () (let ([frame (make-object frame:text-info-file% filename)]) (send frame show #t) frame))]) (gui-utils:show-busy-cursor (lambda () (if filename (let ([already-open (send (group:get-the-frame-group) locate-file filename)]) (if already-open (begin (send already-open show #t) already-open) (let ([handler (if (string? filename) (find-format-handler filename) #f)]) (if handler (handler filename) (make-default))))) (make-default)))))) ; Query the user for a file and then edit it (define *open-directory* ; object to remember last directory (make-object (class object% () (private [the-dir #f]) (public [get (lambda () the-dir)] [set-from-file! (lambda (file) (set! the-dir (mzlib:file:path-only file)))] [set-to-default (lambda () (set! the-dir (current-directory)))]) (sequence (set-to-default) (super-init))))) (define open-file (lambda () (let ([file (parameterize ([finder:dialog-parent-parameter (get-top-level-focus-window)]) (finder:get-file (send *open-directory* get)))]) (when file (send *open-directory* set-from-file! file)) (and file (edit-file file))))))