View script | License | Download script | History | Other scripts by: luce80 |
19-Apr 2:05 UTC
[0.044] 22.756k
[0.044] 22.756k
Archive version of: file-requester.r ... version: 2 ... luce80 23-Sep-2012Amendment note: Sort drop down path tree, update scroller on resize || Publicly available? Yes REBOL [ Title: "Open a file or directory requester" Date: 21-09-2012 Version: 1.0.2 File: %file-requester.r Author: "Marco Antoniazzi" Purpose: "Requests a file or directory" eMail: [luce80 AT libero DOT it] History: [ 0.0.1 [02-09-2012 "First version"] 1.0.0 [08-09-2012 "Finished"] 1.0.1 [09-09-2012 "Minor fixes"] 1.0.2 [21-09-2012 "Sort drop down path tree, update scroller on resize"] ] Note: { Filters can be in the form: "*.a" or "*.a;*.b" or "Short description (*.a)" or "Short description (*.a;*.b)" or a block of such strings } Category: [util vid files] library: [ level: 'intermediate platform: 'all type: 'function domain: [gui files] tested-under: [View 2.7.8.3.1 2.7.8.4.3] support: none license: 'LGPL2 see-also: none ] comment: "2-Sep-2012 GUI automatically generated by VID_build. Author: Marco Antoniazzi" ] file-req: context [ ; files, filter, new folder, drop-list suffix?: func [ {Return the suffix (ext) of a filename or url, else tail of it.} path [any-string!] /local suff ][ either all [ suff: find/last path #"." not find suff #"/" ] [suff] [tail path] ] dir?: func [file [file!]] [#"/" = last file] is-link?: func [file [file!] /local str] [ ; WARNING: THIS IS A DIRTY HACK! if all [ equal? suffix? file %.lnk System/version/4 = 3 ;Win attempt [str: read file] equal? head str find str #{4C000000} ] [str] ] parent-dir: func [file [file!]] [ if equal? length? file 1 [return %/] file: head remove back tail dirize file head remove/part find/tail/last file %/ tail file ] online?: does [not error? try [close open tcp://www.google.com:80]] gather-each: func ['word [word!] data [series!] body [block!] /into result [block!]] [;collect result: any [result copy []] forskip data 1 [set word first data if do body [insert tail result first data]] head result ] filter_and_sort: func [list [block!] /local temp-list filters par temp-dir-list temp-files-list] [ temp-dir-list: copy list remove-each item temp-dir-list [not dir? item] sort temp-dir-list if only-dirs [return temp-dir-list] ; apply filters filters: copy get-face choice-filter if par: find filters "(" [filters: next par] if par: find filters ")" [clear par] filters: parse filters ";" temp-list: copy [] filtering-list: copy list forall filters [ gather-each/into item filtering-list [found? find/any/match item first filters] temp-list ] temp-files-list: copy temp-list remove-each item temp-files-list [dir? item] sort temp-files-list clear temp-list insert temp-files-list temp-dir-list temp-files-list ] add_folder: func [/local name][ name: request-text/title/default/offset "Enter the new folder name below" "New folder" btn-+/offset - 240x-46 unless none? name [attempt [make-dir path-name/:name replace_file-list path-name]] ] build_path-tree: func [/local path-tree paths n] [ path-tree: copy [] insert path-tree read %/ remove-each item path-tree [error? try [read/part join %/ item 1]] forall path-tree [change path-tree to-local-file first path-tree] sort path-tree paths: parse/all path-name "/" paths: next next paths n: 0 forall paths [insert/dup first paths " " n: n + 2] insert next find path-tree second head paths paths head path-tree ] show_drop-list: func [face [object!]] [ paths-list/data: build_path-tree show paths-list/update show-popup/window/away paths-lay face/parent-face do-events ] select_folder: func [dir [string!] /local path] [ path: find/tail copy path-name dirize trim dir dir: either path [dirize head clear path][to-file rejoin ["/" dir "/"]] if replace_file-list dir [add_to_undo-list] hide-popup ] ; update, undo update_list: func [] [ file-list: filter_and_sort orig-file-list clear list-of-files/data clear list-of-files/picked ; update and redraw file names text-list append list-of-files/data file-list set-face list-of-files/sld 0 do-face list-of-files/sld none show list-of-files/update ] replace_file-list: func [dir-name [file! none!] /local temp-dir-list] [ if error? try [temp-dir-list: read dir-name] [alert "Can not read directory, please verify that the name is correct" return false] focus list-of-files ; to unfocus fields old-path-name: path-name path-name: dir-name clear orig-file-list orig-file-list: copy temp-dir-list update_list set-face info-path to-local-file dir-name true ] select_line: func [ /local path str] [ if empty? path: get-face list-of-files [exit] path: last path case [ dir? path [ if replace_file-list path-name/:path [add_to_undo-list] ] str: is-link? path-name/:path [ ; WARNING: THIS IS A DIRTY HACK! str: back find/any/last str "?:" ; find a: b: c: etc. drive letters str: trim/with/all mold copy/part str find str #{00000000} "{^^@}" ; trim 0s if replace_file-list dirize to-rebol-file str [add_to_undo-list] ] 'else [ unless empty? list-of-files/picked [set-face field-selected list-of-files/picked] ] ] ] add_to_undo-list: does [ insert undo-list old-path-name ] undo: does [ if empty? undo-list [exit] insert redo-list path-name path-name: take undo-list replace_file-list path-name ] redo: does [ if empty? redo-list [exit] insert undo-list path-name path-name: take redo-list replace_file-list path-name ] ; gui tip*: any [ attempt [load %simple-tooltip-style.r] attempt [if online? [load http://www.rebol.org/download-a-script.r?script-name=simple-tooltip-style.r]] ] if tip* [clear back back tail tip*] ; remove example code do tip* file-req-styles: stylize [ arrow: arrow feel [ over-super: :over over: func [face action event][ over-super face action event remove/part find face/effect 'gradient 4 if action [ insert face/effect [gradient 0x-1 white orange] ] show face ] ] choice: choice white - 20 font [style: none size: 11 colors: [0.0.0 255.150.55] shadow: none] edge [size: 1x1] dir-list: text-list 500x200 with [ update: func [/local tot-rows visible-rows] [ tot-rows: length? data visible-rows: lc sld/redrag visible-rows / max 1 tot-rows either visible-rows >= tot-rows [ sld/step: 0.0 ][ sld/step: 1 / (tot-rows - visible-rows) ] self ] append init [ sld/action: func [face value] [ ;patched if sn = value: max 0 to-integer value * ((length? slf/data) - lc) [exit] ; I always hated that "1 +" ! sn: value show sub-area ] iter/feel: make iter/feel [ redraw-super: :redraw redraw: func [f a i /local fil] [ redraw-super f a i fil: to-file iter/text iter/font/color: case [ dir? fil [blue] is-link? path-name/:fil [blue] true [black] ] iter/font/style: either dir? fil ['bold][[]] ] engage-super: :engage engage: func [face action event /local fil] [ engage-super face action event if event/double-click [ fil: to-file iter/text either dir? fil [ do-face face none ][ if not empty? get-face field-selected [hide-popup] ] ] ] ] ] ] ] req-win: layout [ do [sp: 4x4] origin sp space sp styles file-req-styles Across style btn btn 24x24 btn "<" [undo] help "Back to previous folder" btn ">" [redo] help "Forward" btn "^^" [ if not none? path-name [ replace_file-list parent-dir path-name add_to_undo-list ] ] help "Go up one folder" style field field white white edge [color: gray + 30 effect: 'ibevel size: 1x1] info-path: field 389 [if replace_file-list dirize to-rebol-file face/text [add_to_undo-list]] pad (sp * -1x0 - 23x-1) arrow-d: arrow down white 22x22 edge none [show_drop-list face] help "Select a parent directory" pad 0x-1 btn-+: btn "+" 252.223.44 [add_folder] help "Create a new folder" return list-of-files: dir-list 500x200 [select_line] return field-selected: field 336 pad 0x2 text-filter: text "Filter:" pad 0x-2 choice-filter: choice "All files (*.*)" "Rebol files (*.r)" 120 [replace_file-list path-name] return pad 296x10 btn-ok: btn "Select" 100x24 [cancelled: false hide-popup] btn-cancel: btn "Cancel" 100 #"^[" [set-face field-selected "" cancelled: true hide-popup] ] remove find req-win/pane list-of-files insert tail req-win/pane list-of-files ; put on top req-win/user-data: reduce ['size req-win/size] req-win/options: [resize min-size 500x300] if tip* [Add-tooltip-2-faces req-win] paths-lay: layout/offset [ origin 0x0 at 0x0 paths-list: text-list (info-path/size * 1x0 + 0x200) [select_folder value] ] info-path/offset + (info-path/size * 0x1) rezize-faces: func [siz [pair!]] [ foreach [face pair] reduce [ arrow-d 1x0 btn-+ 1x0 field-selected 0x1 text-filter 1x1 choice-filter 1x1 btn-ok 1x1 btn-cancel 1x1 ][face/offset: face/offset + (siz * pair)] foreach [face pair] reduce [ info-path 1x0 field-selected 1x0 paths-lay 1x0 ][face/size: face/size + (siz * pair)] foreach [face pair] reduce [ list-of-files 1x1 paths-list 1x0 ][face/resize face/size + (siz * pair)] list-of-files/update ] req-win/feel: make req-win/feel [ detect: func [face event /local siz][ switch event/type [ close [set-face field-selected "" cancelled: true hide-popup return none] scroll-line [either event/offset/y >= 0 [scroll-drag list-of-files/sld] [scroll-drag/back list-of-files/sld] ] resize [ siz: face/size - face/user-data/size ; compute size difference face/user-data/size: face/size ; store new size rezize-faces siz show face ] ] system/view/window-feel/detect face event ; deal with key presses ] ] ; main old-path-name: path-name: what-dir orig-file-list: ; the unsorted file list file-list: [] ; the sorted file list undo-list: copy [] redo-list: copy [] only-dirs: false set '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." ;not implemented (but is default behaviour) ;/path "Return absolute path followed by relative files." ;not implemented /save "Request file for saving, otherwise loading." /local result ][ req-win/text: any [title-line "Select a File:"] field-selected/text: any [name ""] if filt [ filt: compose [(filt)] if not find form filt "*.*" [insert tail filt "All files (*.*)"] choice-filter/text: first choice-filter/data: choice-filter/texts: filt ] btn-ok/text: any [button-text either save ["Save"]["Select"]] if only-dirs [list-of-files/resize list-of-files/size - 0x30] only-dirs: false replace_file-list path-name show-popup req-win do-events unfocus if none? keep [ ; restore defaults choice-filter/text: first choice-filter/data: choice-filter/texts: ["All files (*.*)" "Rebol files (*.r)"] path-name: what-dir ] result: get-face field-selected if "" = result [return none] to-file result ] set 'request_dir func [ "Requests a directory using a popup list." /title "Change heading on request." title-line /dir "Set starting directory" where [file!] /keep "Keep previous directory path" /offset xy [pair!] /local offs result ][ req-win/text: any [title-line "Select a directory:"] if offset [offs: req-win/offset req-win/offset: xy] if not only-dirs [list-of-files/resize list-of-files/size + 0x30] only-dirs: true replace_file-list any [where path-name] show-popup req-win do-events unfocus if cancelled [return none] result: path-name if none? keep [ ; restore defaults req-win/offset: offs path-name: what-dir ] result ] ] ;comment [ do [ probe request_file/title/filter "gimme file" "Load" ["*.r; *.c" "files (*.s ; *.t)"] probe request_dir/title/offset "gimme dir" 100x100 probe request_file/title "gimme file again" "Load" halt ] |