Rebol Programming/request-file

USAGE:

REQUEST-FILE /title title-line button-text /file name /filter filt /keep /only /path /save 

DESCRIPTION:

Requests a file using a popup list of files and directories.

REQUEST-FILE is a function value.

REFINEMENTS

• /title -- Change heading on request.
  • title-line -- Title line of request (Type: any)
  • button-text -- Button text for selection (Type: any)
• /file
  • name -- Default file name or block of file names (Type: any)
• /filter
  • filt -- Filter or block of filters (Type: any)
• /keep -- Keep previous settings and results
• /only -- Return only a single file, not a block.
• /path -- Return absolute path followed by relative files.
• /save -- Request file for saving, otherwise loading.

SOURCE CODE

request-file: func [
    {Requests a file using a popup list of files and directories.} 
    /title "Change heading on request." 
    title-line "Title line of request" 
    button-text "Button text for selection" 
    /file name "Default file name or block of file names" 
    /filter filt "Filter or block of filters" 
    /keep "Keep previous settings and results" 
    /only "Return only a single file, not a block." 
    /path "Return absolute path followed by relative files." 
    /save "Request file for saving, otherwise loading." 
    /local where data filt-names filt-values
][
    if none? out start-out 
    either file [
        either block? name [picked: copy name] [picked: reduce [to-file name]]
    ] [
        if not keep [picked: copy []]
    ] 
    if none? picked [picked: copy []] 
    if file: picked/1 [where: first split-path file] 
    while [not tail? picked] [
        set [name file] split-path first picked 
        either name <> where [remove picked] [
            change picked file 
            picked: next picked
        ]
    ] 
    picked: head picked 
    if any [not where not exists? where] [where: clean-path %.] 
    if not keep [
        fp/data: head fp/data 
        so/data: head so/data 
        si: 1
    ] 
    either filter [
        filters: either block? filt [filt] [reduce [filt]]
    ] [if any [not keep not block? filters] [pick-filter]] 
    ff/text: form filters 
    tt/text: either title [copy title-line] ["Select a File:"] 
    ob/text: either title [copy button-text] ["Select"] 
    if all [
        error? done: try [
            filt-names: copy head fp/data 
            filt-values: copy filter-list 
            either filter [
                insert head filt-names "Custom" 
                insert/only filt-values filters
            ] [
                filt-names: at filt-names index? fp/data
            ] 
            done: local-request-file data: reduce 
            [tt/text ob/text clean-path where picked filt-names filt-values found? any [only] found? any [save]] 
            if done [
                dir-path: data/3 
                picked: data/4 
                if not filter [fp/data: at head fp/data index? data/5]
            ] 
            done
        ] 
        (get in disarm done 'code) = 328
    ] [
        done: false 
        read-dir/full either where [where] [dir-path] 
        show-pick 
        inform out 
        unfocus
    ] 
    if error? done [done] 
    if all [done picked any [path not empty? picked]] [
        either path [
            done: insert copy picked copy dir-path 
            either only [done/1] [head done]
        ] [
            foreach file picked [insert file dir-path] 
            either only [picked/1] [picked]
        ]
    ]
]