Just had some time to work on it. :-) Should be a good FTP
client... ;-)
Take care,
Gabriele.
--
o--------------------) .-^-. (----------------------------------o
| Gabriele Santilli / /_/_\_\ \ Amiga Group Italia --- L'Aquila |
| GIESSE on IRC \ \-\_/-/ / http://www.amyresource.it/AGI/ |
o--------------------) `-v-' (----------------------------------o
REBOL [
Title: "Simple file manager"
Author: "Gabriele Santilli"
File: %ropus.r
Date: 12-Dec-1999
Version: 2.0.1.3 ; release.status.majorv.minorv
; status: 0: alpha; 1: beta; 2: gamma
History: [
12-Dec-1999 1.0.1.1 "First working version"
12-Dec-1999 1.0.1.2 "Now get-input keeps a buffer, and it's way
smarter"
12-Dec-1999 2.0.1.3 "Finished ask-user; posting to the list"
]
Needs: 2.2.0
]
system/options/quiet: true
; -- text interface (requires REBOL 2.2)
restring: func [b] [make string! reduce b]
control-sequences: make object! [
csi: "^(1B)["
sequence: func [
"Creates a sequence"
s [block!]
] [
restring bind s 'self
]
left: func [
"Moves the cursor n chars left"
n [integer!]
] [
sequence [csi n "D"]
]
right: func [
"Moves the cursor n chars right"
n [integer!]
] [
sequence [csi n "C"]
]
up: func [
"Moves the cursor n rows up"
n [integer!]
] [
sequence [csi n "A"]
]
down: func [
"Moves the cursor n rows down"
n [integer!]
] [
sequence [csi n "B"]
]
move-to: func [
"Moves the cursor to the given position"
row [integer!]
column [integer!]
] [
sequence [csi row ";" column "H"]
]
home: sequence [csi "H"] ; goto (1, 1)
delete: func [
"Deletes n chars to the right"
n [integer!]
] [
sequence [csi n "P"]
]
insert: func [
"Inserts n spaces"
n [integer!]
] [
sequence [csi n "@"]
]
cls: sequence [csi "J"] ; clear screen
clear-to-end-of-line: sequence [csi "K"]
cursor-pos: sequence [csi "6n"]
dimensions: sequence [csi "7n"]
]
control-chars: charset [#"^(00)" - #"^(1F)" #"^(7F)" - #"^(9F)"]
control-char?: func [
"Is it a control character?"
char [char!]
] [
find control-chars char
]
emit: func [
"Emit to the console"
value
] [
write/binary console:// value
]
read-con: func [
"Read from the console"
] [
read/binary/wait console://
]
input-buffer: make block! 100
get-input: func [
"Waits keyboard input and parses it"
/local char
] [
if empty? input-buffer [
parse/all read-con [
some [
"^(1B)[A" (insert tail input-buffer 'up) |
"^(1B)[B" (insert tail input-buffer 'down) |
"^(1B)[C" (insert tail input-buffer 'right) |
"^(1B)[D" (insert tail input-buffer 'left) |
"^(1B)[5~" (insert tail input-buffer 'page-up) |
"^(1B)[6~" (insert tail input-buffer 'page-down) |
"^(7F)" (insert tail input-buffer 'delete) |
"^-" (insert tail input-buffer 'tab) |
"^M" (insert tail input-buffer 'enter) |
"^(08)" (insert tail input-buffer 'backspace) |
copy char skip (insert tail input-buffer to-char char)
]
]
]
char: input-buffer/1
remove input-buffer
char
]
input-loop: func [
"Input loop"
body [block!]
/local input
] [
forever [
switch get-input body
]
]
send-sequence: func [
"Sends a sequence to the console"
seq [block!]
] [
emit control-sequences/sequence seq
]
digits: charset "1234567890"
console-get: func [
"Reads cursor position or console dimensions"
'what [word!]
/local row col
] [
send-sequence reduce [what]
parse/all read-con [
"^(1B)["
copy row some digits
";"
copy col some digits
"R" end
]
reduce [to-integer row to-integer col]
]
get-cursor: func [] [console-get cursor-pos]
get-dimensions: func [] [console-get dimensions]
footer: restring [
"ROpus " system/script/header/version/3 "." system/script/header/version/4
" (release " system/script/header/version/1
pick [" ALPHA" " BETA" ""] system/script/header/version/2 + 1 ")"
" --- �1999 Gabriele Santilli --- Press H for help"
]
redraw: func [
"Redraws the screen"
/local width height
] [
set [height width] get-dimensions
send-sequence [
cls
move-to height 1
copy/part footer width
home
]
lister1/set-rect 1 1 to-integer width / 2 height - 1
lister2/set-rect (to-integer width / 2) + 1 1 to-integer width / 2 height - 1
lister1/redraw
lister2/redraw
]
show-text: func [
"Shows a text on screen (used by view-text)"
lines [block!] "Block of lines"
sk [integer!] "Horizontal scroll"
rows [integer!] "Numbers of rows to show"
margin [integer!] "Maximum line length"
/local line x
] [
rows: min rows length? lines
line: make paren! [copy/part skip lines/1 sk margin]
x: margin + 2
for y 2 rows + 1 1 [
send-sequence [
move-to y 2
line clear-to-end-of-line
move-to y x "|"
]
lines: next lines
]
]
show-box: func [
"Shows a box on screen"
x [integer!]
y [integer!]
lines [block!]
] [
for y y (y + length? lines) - 1 1 [
send-sequence [
move-to y x
lines/1
]
lines: next lines
]
]
message: func [
"Shows a message"
msg [string! block!] "Line or block of lines"
/confirm "Ask confirmation to the user"
/local scrw scrh boxw boxh boxx boxy box border blank res
] [
set [scrh scrw] get-dimensions
if string? msg [msg: reduce [msg]]
boxh: length? msg
boxw: 13
foreach line msg [if boxw < length? line [boxw: length? line]]
box: make block! 100
border: make string! 100
blank: make string! 100
insert insert/dup insert border "+" "-" boxw "+"
insert/dup blank " " boxw
boxx: to-integer ((scrw - boxw) / 2) - 1
boxy: to-integer ((scrh - boxh) / 2) - 1
insert box border
foreach line msg [
insert tail box restring [
"|" head change copy blank copy/part line boxw "|"
]
]
insert tail box border
res: either confirm [
insert tail box restring [
"| [Y]es" head insert/dup copy "" " " (boxw - 11) "[N]o |"
]
insert tail box border
boxy: boxy - 1
show-box boxx boxy box
select [#"Y" true #"N" false] get-input
] [
show-box boxx boxy box
get-input
]
redraw
res
]
lister: make object! [
x: y: w: h: 0
border: make string! 100
blank: make string! 100
set-rect: func [
xx yy ww hh
] [
set [x y w h] reduce [xx yy ww hh]
clear border
clear blank
insert insert/dup insert border "+" "-" w - 2 "+"
insert insert/dup insert blank "| " " " w - 3 "|"
]
list: make block! 0
current: 1
redraw: func [
"Disegna il lister"
/local line row
] [
send-sequence [
move-to y x
border
move-to y + h - 1 x
border
]
row: y + 1
foreach element copy/part list h - 2 [
line: head
change
next next copy blank
copy/part form element w - 3
send-sequence [
move-to row x
line
]
row: row + 1
]
for row row y + h - 2 1 [
send-sequence [
move-to row x
blank
]
]
draw-pointer
]
draw-pointer: func [] [
send-sequence [
move-to y + current x + 1
">"
]
]
clear-pointer: func [] [
send-sequence [
move-to y + current x + 1
" "
]
]
down: func [] [
if current < length? list [
clear-pointer
either current < (h - 2) [
current: current + 1
draw-pointer
] [
list: next list
redraw
]
]
]
up: func [] [
either current > 1 [
clear-pointer
current: current - 1
draw-pointer
] [
if not head? list [
list: back list
redraw
]
]
]
get-current: func [] [
pick list current
]
]
lister1: make lister []
lister2: make lister []
ask-user: func [
"Asks a question to the user"
question [string!]
/local scrw scrh buffer bc cpos maxlen xpos key refresh
] [
bc: buffer: make string! 256
set [scrh scrw] get-dimensions
send-sequence [
move-to scrh 1
question
clear-to-end-of-line
]
xpos: 1 + length? question
cpos: xpos
maxlen: scrw - xpos
refresh: make paren! [
send-sequence [
move-to scrh xpos
copy/part buffer maxlen
clear-to-end-of-line
move-to scrh cpos
]
]
while ['enter <> key: get-input] [
either all [char? key not control-char? key] [
bc: insert bc key
either cpos >= scrw [
buffer: next buffer
refresh
] [
cpos: cpos + 1
either not tail? bc [
refresh
] [
emit key
]
]
] [
switch key [
left [
either all [cpos = xpos not head? buffer] [
bc: buffer: back buffer
refresh
] [
if cpos > xpos [
cpos: cpos - 1
bc: back bc
send-sequence [left 1]
]
]
]
right [
either all [cpos = scrw maxlen < length?
buffer] [
buffer: next buffer
bc: next bc
refresh
] [
if all [cpos < scrw not tail? bc] [
cpos: cpos + 1
bc: next bc
send-sequence [right 1]
]
]
]
delete [
if not tail? bc [
remove bc
refresh
]
]
backspace [
either all [cpos = xpos not head? buffer] [
bc: buffer: back buffer
remove bc
refresh
] [
if cpos > xpos [
cpos: cpos - 1
bc: back bc
remove bc
refresh
]
]
]
]
]
]
head buffer
]
; -- file manager
change-active-dir: func [
"Changes the active directory"
dir [file! url!]
] [
source-dest/2: dir
source-dest/1/list: sort read dir
source-dest/1/current: 1
source-dest/1/redraw
]
refresh: func [
"Refreshes the listers and redraws the screen"
] [
source-dest/1/list: sort read source-dest/2
source-dest/3/list: sort read source-dest/4
redraw
]
swap: func [
"Exchange source and destination"
sd [block!]
] [
change sd reduce [sd/3 sd/4 sd/1 sd/2]
]
cases-dialect: make object! [
"Dialect for do-cases"
else-if: if: func [
condition
body [block!]
] [
system/words/if condition [
do body
true
]
]
else: :do
]
do-cases: func [
"Executes the case whose condition is true"
; example for cases:
; if cond1 [code1] else-if cond2 [code2] ... else [default]
cases [block!]
] [
any bind cases in cases-dialect 'self
]
form-error: func [
"Forms an error message"
error [error!]
/local id type
] [
error: disarm error
id: error/id
type: error/type
reduce [
"*** Error message"
reform ["*** Type:" system/error/:type/type]
reform ["*** Why:" reform bind system/error/:type/:id in error 'self]
reform ["*** Near:" trim/lines mold error/near]
]
]
execute-script: func [
"Executes the given script"
script [file! url!]
/local result id type
] [
send-sequence [cls]
print "Trying to execute the script..."
either error? result: try [do script] [
foreach line form-error result [
print line
]
] [
if value? 'result [print ["Result:" mold result]]
]
print "Press any key to continue..."
get-input
refresh
]
text?: func [
"Is it a text file?"
file [file! url!]
/local freq sum
] [
file: read/binary/part file 512
freq: array/initial 256 0
foreach byte file [
byte: byte + 1
poke freq byte freq/:byte + 1
]
sum: 0
for i 32 126 1 [sum: sum + freq/:i]
sum > ((4 * length? file) / 5)
]
view-text: func [
"Text file viewer --- slow but nice ;-)"
textfile [file! url!]
/local scrh scrw border footer sk refresh maxskip maxindex
] [
set [scrh scrw] get-dimensions
border: make string! 100
insert insert/dup insert border "+" "-" scrw - 2 "+"
footer: restring [
"Q to quit --- " textfile
]
send-sequence [
cls
border CRLF
down scrh - 3
border CRLF
copy/part footer scrw
]
for i 2 scrh - 2 1 [
send-sequence [
move-to i 1 "|"
right scrw - 2 "|" CRLF
]
]
textfile: parse/all detab/size read textfile 4 "^/"
maxskip: 0
foreach line textfile [if maxskip < length? line [maxskip: length? line]]
maxskip: max 0 maxskip - (scrw - 2)
maxindex: (4 + length? textfile) - scrh
show-text textfile 0 scrh - 3 scrw - 2
sk: 0
refresh: make paren! [
show-text textfile sk scrh - 3 scrw - 2
]
input-loop [
#"Q" [break]
up [
if not head? textfile [
textfile: back textfile
refresh
]
]
down [
if maxindex > index? textfile [
textfile: next textfile
refresh
]
]
left [
if sk > 0 [
sk: sk - 1
refresh
]
]
right [
if sk < maxskip [
sk: sk + 1
refresh
]
]
page-up [
if not head? textfile [
textfile: skip textfile negate scrh - 4
refresh
]
]
page-down [
if maxindex > index? textfile [
textfile: skip textfile min scrh - 4 maxindex - index?
textfile
refresh
]
]
]
redraw
]
show-info: func [
"Shows file info"
file [file! url!]
/local name maxlen info
] [
maxlen: to-integer (pick get-dimensions 2) / 2
name: form file
if maxlen < length? name [
name: restring ["..." skip tail name negate (maxlen - 3)]
]
info: info? file
message reduce [
restring ["Informations on " name]
restring ["Size: " info/size]
restring ["Last modification: " info/date]
]
]
source-dest: reduce [
lister1 system/script/path
lister2 system/script/path
]
refresh
show-message-on-error: func [
"Shows a message in case of error"
code [block!]
/local error
] [
if error? set/any 'error try code [
message form-error error
]
]
; main input loop
input-loop [
#"Q" [
send-sequence [cls]
break
]
up [
source-dest/1/up
]
down [
source-dest/1/down
]
tab [
swap source-dest
]
enter [
show-message-on-error [
file: join source-dest/2 source-dest/1/get-current
do-cases [
if dir? file [
change-active-dir file
]
else-if script? file [
execute-script file
]
else-if text? file [
view-text file
]
else [
show-info file
]
]
]
]
#"P" [
show-message-on-error [
change-active-dir first split-path source-dest/2
]
]
delete [
show-message-on-error [
file: source-dest/1/get-current
if message/confirm reduce [
"Please confirm deletion"
reform ["of" file]
] [
delete join source-dest/2 file
refresh
]
]
]
#"V" [
show-message-on-error [
view-text join source-dest/2 source-dest/1/get-current
]
]
#"C" [
show-message-on-error [
use [source dest file] [
source: join source-dest/2 file:
source-dest/1/get-current
dest: join source-dest/4 file
write/binary dest read/binary source
]
refresh
]
]
#"M" [
show-message-on-error [
use [source dest file] [
source: join source-dest/2 file:
source-dest/1/get-current
dest: join source-dest/4 file
write/binary dest read/binary source
delete source
]
refresh
]
]
#"R" [refresh]
#"G" [ ; goto
show-message-on-error [
file: load ask-user "Go to dir: "
if any [file? file url? file] [
if dir? file [
change-active-dir file
]
]
]
use [w h] [
set [h w] get-dimensions
send-sequence [
move-to h 1
copy/part footer w
]
]
]
#"H" [
message [
" KEY | FUNCTION"
"-----+------------------------------------"
" Q | Quit ROpus"
" H | Show this help"
" G | Change directory (accepts URLs too)"
" R | Refresh the screen"
" M | Move file"
" C | Copy file"
" V | View text file"
" DEL | Delete file"
" P | Go to parent directory"
"ENTER| Perform action based on file type"
" TAB | Exchange source/destination lister"
"ARROW| Select file"
]
]
]
