Script Library: 1222 scripts
 

ropus.r

REBOL [ Title: "Simple file manager" Date: 12-Dec-1999 Purpose: "A simple file manager" Version: 2.0.1.3 File: %ropus.r Author: "Gabriele Santilli" 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" ] library: [ level: 'intermediate platform: none type: none domain: 'file-handling tested-under: none support: none license: none see-also: none ] ] 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" ] ] ]
halt ;; to terminate script if DO'ne from webpage