#!/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:   ingo@2b1.de
   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 <bo@rebol.com> (?) 
   ;

   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 <bo@rebol.com>
   ; 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 <allenk@powerup.com.au>
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 <bo@rebol.com>
; 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