[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 http://www.rebol.com/feedback.html

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

  [This is the only message in the thread]