#!/home/ingo/entw/rebol/rebol -q REBOL [ Title: "Highnoon Commander" Date: 1999-10-03 Version: 0.9.2 File: %hc.r Site: http://www.2b1.de/Rebol/ Author: "Ingo Hohmann" Email: [EMAIL PROTECTED] Rights: "Copyright (C) Ingo Hohmann 1999" Category: ['file 'script] Purpose: { Quick 'n dirty replacement for Midnight Commander } Comment: { Initial Phase } History: [ [0.9.2 03-10-1999 "iho" "minor changes" ] [0.9.1 23-07-1999 "iho" "first public release" ] [0.0 17-7-1999 "iho" "Initial Version" ] ] KnownBugs: [ { Change dir seems broken, don't know where the additional "/" at the end comes from ...} ] ] ; ; try loading my modules, if not use ... ; if error? try [ module 'hc.r import %iho-tools.r use [a] [ ; menu-object is in my Definitions.r, not in iho-tools.r a: menu-object ] ] [ ; ; Copied over from my startup scripts for distribution ... ; ; ; text alignment ; needed for history ; by Bohdan Lechnowsky <[EMAIL PROTECTED]> (?) ; align: function [ "Forms data into a columns with optional alignment" data length /left /right /center] [len] [ if right [ return head copy/part tail insert/dup head form data " " length (length * -1) ] if center [ data: head insert/dup head form data " " len: (length / 2) data: head insert/dup tail data " " len return copy/part at data ((length? data) / 2 - len + 1) length ] return copy/part head insert/dup tail form data " " length length ] ; ; A menu system, needed for pager ; menu-object: make object! [ header: copy "^LHelp" menus: copy [] init: func [ "Initialize menu" /data men [block!]] [ either data [menus: copy men] [menus: copy []] ] ; init add: func [ "Adds a new menuline" key [char! none!] help [string! none!] action [block! none!]] [ append menus key append menus help append/only menus action ] ; add show: func [ "Shows the menu" ] [ print rejoin [ header ] foreach [key help action] menus [ prin either char? key [rejoin ["("key") "]] [" "] print either string? help [help] [""] ] print " " ] ; show ask: func [ "Waits for a keypress, and DOes menu action" /local con c key help action ] [ con: open/binary [scheme: 'console] wait con c: to-char to-integer copy con foreach [key help action] menus [ if key == c [ if error? try [ if error? err: try action [ print rejoin ["Error in menu function: " action] if confirm "... would you like to see it (y/N)? " [ print mold disarm err ask "Press <Return>" ] return 'error ] [ 'none ] ] [ return 'ok ] ] ] return 'not_found ] ; ask loop: func [ {After keypress, starts waiting for the next key, you'd better have a halt in one of your menu actions} /show "always show the menu, before waiting for keypress" /do "always do action before waiting" todo [block!] "action to do"] [ while [ true ] [ if show [ self/show ] if do [ if error? try todo [ print "Error while doing menu action!" ] ] ask ] ] ; loop ; ] ; use ] ; make menu ; ; A text pager ; ; extracted from messenger.r by Bohdan Lechnowsky <[EMAIL PROTECTED]> ; Andrew M Grossmann <Andrew.M.Grossmann@ > ; changed by iho pager: make object! [ header: [ "^LPager" ] footer: [ perc "% command: " ] curr-line: 1 view-lines: 25 content: copy "" keep-going: true init-header: func [new-hdr] [ header: copy new-hdr ] init-footer: func [new-foot] [ footer: copy new-foot ] validate: func [] [ if curr-line < 1 [curr-line: 1] if curr-line > ((length? content) - view-lines) [ curr-line: (length? content) - view-lines ] ] menu: make menu-object [ menus: [ none "Paging" none #"b" "Back one page" [ curr-line: curr-line - view-lines validate ] #"f" "Forward one page" [ curr-line: curr-line + view-lines validate ] #" " "forward one page" [ curr-line: curr-line + view-lines validate ] #"p" "Previous line" [ curr-line: curr-line - 1 validate ] #"n" "Next line" [ curr-line: curr-line + 1 validate ] none "Window" none #"," "decrease view lines by 1" [view-lines: view-lines - 1] #"." "increase view lines by 1" [view-lines: view-lines + 1] #"<" "decrease view lines by 5" [view-lines: view-lines - 5] #">" "increase view lines by 5" [view-lines: view-lines + 5] none "Other" none #"q" "quit pager" [keep-going: false] #"h" "Help" [menu/show menu/ask] ] ] do: func [string /local line] [ content: parse/all string "^/" curr-line: 1 keep-going: true while [keep-going] [ print rejoin header for line curr-line (curr-line + view-lines) 1 [ if found? pick content line [print pick content line] a: line ] if ((perc: to-integer (100 * (a / length? content))) > 100) [ perc: 100 ] prin rejoin footer menu/ask ] print " " exit ] ] ; ; Debugging object ; dbg: make object! [ debug: true on: func [] [ debug: true ] off: func [] [ debug: false ] out: func[ "prints value, if debug = true" value ] [ if debug [print ["<dbg>" value]] ] wait: func [ "waits for key press" /local k] [ if debug [ k: ask "<dbg> Press <ret> " if k = "q" [make error! "exit"] ] ] ow: func [ "Prints value, and waits" value ] [ if debug [ out value wait ] ] assert: func[ "Tests, if test is true" test [block!] /named name [string!] "Name to show in message" ] [ if debug [ if not do test [ either named [make error! rejoin [{Assert "} name {" failed}]] [make error! rejoin ["Assert failed on: " test ]] ] ] ] ] ] ; if error? ... ; ; END OF COPIED OVER ; dirinfo: make object! [ name: "unknown" path: what-dir pattern: copy "*" listing: none tagged: copy [] get-filename: func [number] [ if integer? number [ if number > length? listing [throw make error! "out of listing"] return pick listing number * 3 ] ] get-tag: func [number] [ if integer? number [ if number > lenght? listing [throw "out of listing"] return pick listing ((number * 3) - 1) ] ] set-tag: func [number] [ if integer? number [ if number > lenght? listing [throw "out of listing"] change pick listing ((number * 3) - 1) "*" ] ] readdir: func [/local list tag cnt file exor] [ prin "Reading directory ... " list: copy [%../] files: copy [] dirs: copy [] ; sorting with directories first is too time expensive ; exor: func [a b][(a or b) and not (a and b)] ; append list sort/compare read path ; func [a b] [ ; either exor dir? a dir? b ; [ dir? a ] ; [ a < b ] ; ] ; another way to sort directories first ; much faster append list sort read path foreach file list [ either dir? file [append dirs file] [append files file] ] list: dirs append list files listing: copy [] ; listing is object field! tag: " " cnt: 1 foreach file list [ if find/match/any file pattern [ append listing reduce [cnt tag file] cnt: cnt + 1 ] ] print "done" ]; readdir printdir: func [/local num tag file] [ print rejoin [ "^LDir" dir/curr/name ": " dir/curr/path " [" dir/curr/pattern "] > "] foreach [num tag file] listing [ print [align/right num 3 tag file] ] prin rejoin [ "Dir" dir/curr/name ": " dir/curr/path " [" dir/curr/pattern "] > "] ] comment { printdir: func [/local num tag file list] [ list: copy "" page/init-header: [ "^LDir" dir/curr/name ": " dir/curr/path " ["; dir/curr/pattern "] > "] page/init-footer [ "Dir" dir/curr/name ": " dir/curr/path " [" dir/curr/pattern "] > "] foreach [num tag file] listing [ append list rejoin [align num 3 tag file "^/"] ] page/do list ] } changedir: func [/local newpath oldpath num tag file] [ oldpath: copy to-string self/path newpath: copy [] print "^LDirectories:" foreach [num tag file] listing [ if dir? file [print [align/right num 3 " " file]] ] num: ask "^/CHANGE DIR to Number (leave empty to edit): " FIXME: "Some things are wrong here ..." FIXME: "I sometimes get two slashes appended to the path, why?" if not error? try [num: to-integer num] [ ;either not error? try [ newpath: rejoin [oldpath get-filename num] dbg/out String? newpath dbg/out last newpath ;if (last newpath) = #"/" [ ; remove last newpath ;] dbg/ow rejoin [ "<" newpath ">" ] change-dir to-file newpath ;] [ self/path: copy what-dir self/readdir ;] self/printdir exit ] if not error? try [ newpath: prompt "^/Change to Directory: " oldpath if not (last newpath) = #"/" [append newpath "/"] newpath: to-file newpath change-dir newpath ] [ self/path: copy what-dir self/readdir ] self/printdir ] changepat: func [/local newpat] [ newpat: prompt "^/New pattern: " pattern either block? newpat [ pattern: first newpat ][ pattern: newpat ] readdir printdir ] tag: func [/local files] [ files: prompt "^/Filenumbers to tag: " "" while [not tail? files] [ if integer? first files [ change second pick first files "*" ] ] ] ] ; dirinfo dir: make object! [ a: make dirinfo [ name: "A"] b: make dirinfo [ name: "B"] curr: a no-ask: false ] menu: make menu-object [] menu/init/data [ none "Directories" none #"a" "directory A" [dir/curr: dir/a dir/curr/printdir] #"b" "directory B" [dir/curr: dir/b dir/curr/printdir] #"l" "List dir" [dir/curr/printdir] #"u" "update dir" [dir/curr/readdir dir/curr/printdir] #"d" "change Dir" [dir/curr/changedir] #"p" "change Pattern (pat)" [dir/curr/changepat] none none none none "Files" none #"r" "rename file" [rename-file dir/curr/readdir dir/curr/printdir] #"c" "Copy file" [copy-file dir/curr/readdir dir/curr/printdir] #"m" "Move file" [move-file dir/curr/readdir dir/curr/printdir] #"t" "Type file" [type-file dir/curr/printdir] #"s" "Send file" [send-file] #"k" "Kill file" [kill-file dir/curr/readdir dir/curr/printdir] none none none none "Other" none #"h" "Help" [menu/show] #"f" "Fall back to rebol" [print "bye!" halt] #"q" "Quit" [q] ] ; by Allen Kamp <[EMAIL PROTECTED]> delete-dir: func[ {Delete directory and its contents, including read-only files. Use with caution} directory [file! url!] {The directory to delete} /local file ][ if not dir? directory [exit] foreach file read directory [ either not dir? directory/:file [ if error? try [delete directory/:file][ ; File is probably read only, so change its access to write. try [write/binary/allow directory/:file "" [write]] try [delete directory/:file] ] ][ delete-dir directory/:file ] ] try [delete directory] ] kill-file: func [/local file] [ file: to-integer ask "^/DELETE File number: " file: dir/curr/get-filename file if confirm rejoin [{OK to delete: "} file {"? (y/N) }] [ file: rejoin [dir/curr/path file] either dir? file [ delete-dir file ] [ delete file ] ] ] send-file: func [/local file addr] [ file: to-integer ask "^/SEND File number: " file: to-file dir/curr/get-filename file addr: to-email ask "SEND to Address: " send addr read file ] rename-file: func [/local file old new] [ file: to-integer ask "^/RENAME File number: " old: dir/curr/get-filename file print old new: prompt "New name: " old rename old new ] type-file: func [/local num] [ num: to-integer ask "^/TYPE File number: " if not integer? num [exit] name: dir/curr/get-filename num pager/do read to-file name ] ; Bohdan Lechnowsky <[EMAIL PROTECTED]> ; iho move: function [ "Allows moving very large files" oldname [file! url!] newname [file! url!] /buffer size [integer!] "Size of transfer buffer to use" /clean "Removes oldname when completed"] [oldfile size block] [ either exists? oldname [ if exists? newname [ if any [dir/no-ask confirm rejoin [newname " does exist, delete? (y/N)"] ] [ delete newname ] ] ][ print [oldname "doesn't exist"] exit ] oldfile: open/binary/direct oldname if not buffer [size: to-integer 2 ** 11] while [block: copy/part oldfile size][ write/binary/append newname block ] close oldfile if clean [delete oldname] ] copy-recursive: func [ "Copies a complete directory structure" old-path [file!] new-path [file!] /clean "deletes source dirs" /local path-list dir err ] [ if not dir? old-path [exit] ; shouldn't be needed if not exists? new-path [ if error? err: try [ make-dir new-path true ] [ print rejoin ["Error while creating: " new-path] err ] ] path-list: copy [] foreach file read old-path [ either dir? rejoin [ old-path file ] [ append path-list file ] [ if error? err: try [ either clean [move/clean rejoin [old-path file] rejoin [new-path file ]] [move rejoin [old-path file] rejoin [new-path file ]] true ] [ ; try print rejoin ["Error while processing: " old-path file] err ] ; if error? ] ; either dir? ] ; foreach foreach dir path-list [ copy-recursive rejoin [old-path dir] rejoin [new-path dir] ] if clean [delete-dir old-path] ] copy-file: func ["Copies a file or directory" /local old-f new-f] [ old-f: to-integer ask "^/COPY File number: " old-f: to-file dir/curr/get-filename old-f either dir/a/path = dir/b/path [ print "Directories are identical" new-f: prompt "New Name of file: " old-f ] [ new-f: copy old-f ] new-f: to-file rejoin [ either dir/curr/name = "A" [ dir/b/path ] [ dir/a/path ] new-f ] old-f: to-file rejoin [dir/curr/path old-f] either not found? find new-f old-f [ either not dir? old-f [ move old-f new-f ] [ copy-recursive old-f new-f ] ] [ print "Error: Cannot copy a directory into its own sub-directory" ask "" ] ] move-file: func ["moves a file or directory" /local file-old file-new] [ if dir/a/path = dir/b/path [ print "Directories are identical" rename-file exit ] file-old: dir/curr/get-filename to-integer ask "^/MOVE File number: " file-new: to-file rejoin [ either dir/curr/name = "A" [ dir/b/path ] [ dir/a/path ] file-old ] file-old: to-file rejoin [dir/curr/path file-old] either not found? find file-new file-old [ either not dir? file-old [ move/clean file-old file-new ] [ copy-recursive/clean file-old file-new ] ] [ print "Error: Cannot move a directory into its own sub-dir" ask "" ] ] hc: func [] [ dir/a/readdir dir/b/readdir dir/curr/printdir menu/loop ] hc none
