Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search

[REBOL] New Directory Requestor

From: carl::s::rebol::com at: 24-Dec-2002 6:08

Here is a directory requestor (still BETA) that will be added to the next release of REBOL. Send comments/corrections to REBOL [] *req-dir: context [ dirs: [] max-dirs: cnt: 0 path: last-path: f-name: f-list: f-txt: f-slid: f-path: result: none show-dir: does [ dirs: attempt [load dirize path] if not dirs [ path: last-path if not dirs: attempt [load dirize path][ alert reform ["Invalid directory:" path] dirs: copy [] exit ] ] remove-each file dirs [(last file) <> slash] foreach file dirs [remove back tail file] f-name/text: any [attempt [second split-path path] "(Top)"] f-path/text: any [attempt [to-local-file path] copy ""] f-slid/redrag max-dirs / max 1 length? dirs f-slid/data: 0.0 cnt: 0 show [f-list f-name f-path f-slid] ] chg-dir: func [file][ if none? file [exit] last-path: copy path if slash <> pick file 1 [append path slash] append path file show-dir ] back-dir: does [ last-path: copy path clear find/last path slash show-dir ] dirout: [ origin 6 space 0 ;text center 200 bold "Pick a Directory:" f-name: text white bold black 200 "Parent" [back-dir] across f-list: list 184x200 [ f-txt: text font-size 11 200 font [colors: [0.0.0 0.0.0]] [chg-dir value] ] supply [ count: count + cnt face/color: pick [240.240.240 220.220.220] odd? count face/text: pick dirs count ] f-slid: scroller 16x200 [ c: to-integer value * ((length? dirs) - max-dirs) if c <> cnt [cnt: c show f-list] ] return f-path: field wrap font-size 11 200x40 [ value: attempt [to-rebol-file to-file f-path/text] if all [value exists? value] [path: value show-dir] ] return pad 2x3 btn-enter 65 "Open" [result: path hide-popup] btn 65 "Make Dir" [ value: request-text/title "Directory name:" if value [ trim value if not empty? value [ either attempt [make-dir rejoin [path slash value]][chg-dir value][ alert "Cannot create directory." ] ] ] ] btn-cancel 65 "Cancel" [hide-popup] at f-name/offset + 180x2 arrow 20x16 black white up with [color: none edge: none] [back-dir] ] set 'request-dir func [ "Requests a directory using a popup list." /keep "Keep previous directory path" /dir "Set starting directory" where [file!] /offset xy /local ][ if block? dirout [ dirout: layout dirout max-dirs: to-integer f-list/size/y - 4 / f-txt/size/y center-face dirout ] if not all [keep path] [path: any [where what-dir]] if all [not empty? path slash = last path][remove back tail path] last-path: path result: none show-dir either offset [inform/offset dirout xy][inform dirout] result ] ] ;Example usage: request-dir