home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxlb.zip / SAMPLES / TREED2.CMD < prev    next >
OS/2 REXX Batch file  |  1994-02-02  |  10KB  |  366 lines
  1. /*****************************************************************************/
  2. /*                                                                           */
  3. /* TREED2 displays the directory structure of a disk in a window. It starts  */
  4. /* at the root directory of the current disk, or at the directory name given */
  5. /* as the first argument. It is derived from TREED.CMD, but a slightly       */
  6. /* different tree format is used.                                            */
  7. /*                                                                           */
  8. /* Requires Personal REXX or REXXLIB (cursor, dosdir, inkey, parsefn,        */
  9. /* doschdir, dosdrive, doscd, dosenv, scrread, scrput, scrsize, pcvideomode  */
  10. /* functions) and RXWINDOW functions.                                        */
  11. /*                                                                           */
  12. /* Command format: TREED2 <directory>                                        */
  13. /*                                                                           */
  14. /*****************************************************************************/
  15.  
  16. /* process parameter, if any, and check it names existing directory */
  17. badarg = validate_directory(arg(1))
  18. if badarg then do
  19.     say "'"arg(1)"'" 'is not the name of a directory.'
  20.     exit 1
  21.     end
  22.  
  23. call rxfuncadd 'w_register', 'rxwin30', 'rxwindow'
  24. call w_register
  25.  
  26. /* processing */
  27. call initialize
  28. curpos = cursor()
  29. call read_tree
  30. call display
  31.  
  32. /* termination */
  33. parse var curpos row col
  34. call cursor row, col
  35. exit
  36.  
  37. /* subroutine to read in entire tree */
  38. read_tree: procedure expose base name. location. total. line. count fullname.
  39. name.0 = base
  40. location.0 = 1
  41. line. = ''
  42. count = 1
  43. line.1 = base
  44. fullname.1 = base
  45. call tree strip(base,'t','\'), 1   /* call tree routine to do the real work */
  46. return
  47.  
  48. /* subroutine to recursively trace through directory tree structure */
  49. tree: procedure expose name. location. total. line. count fullname.
  50. arg directory, depth
  51. n = 0
  52. name = dosdir(directory'\*.*','n','d','d')
  53. do while name \= ''
  54.     if name \= '.' & name \= '..' then do
  55.         n = n + 1
  56.         dir.n = name
  57.     end
  58.     name = dosdir(,'n','d','d')
  59. end
  60. call sortdir n
  61. total.depth = n
  62. do loc = 1 to n
  63.     name.depth = dir.loc
  64.     location.depth = loc
  65.     call output
  66.     call tree directory'\'dir.loc, depth+1
  67. end
  68. return
  69.  
  70. /* routine to output a line of the output diagram */
  71. output:
  72. line = ''
  73. do i = 1 to depth-1
  74.     if location.i < total.i then
  75.         line = line || left(d2c(179),3)
  76.     else
  77.         line = line || copies(' ',3)
  78.     end
  79. if location.depth = total.depth then
  80.     join = d2c(192)     /* bottom corner */
  81. else
  82.     join = d2c(195)     /* vertical with spur */
  83. line = line || left(join,3,d2c(196)) || name.depth
  84. count = count + 1
  85. line.count = line
  86. fullname.count = directory'\'name.depth
  87. return
  88.  
  89. /* display the results in a window */
  90. display:
  91. height = scr_height - 6
  92. width = 40
  93. w = w_open(2,3,height+2,width,normal)
  94. call w_border w,,,,,border
  95. call showhelp
  96. namew = w_open(scr_height-1,1,2,80,normal)
  97. top = 1
  98. curline = 2
  99. old_top = 0
  100. newdir = 1
  101. do forever
  102.     if top \= old_top then
  103.         call show
  104.     old_top = top
  105.     current = top + curline - 2
  106.     call w_put namew, 1, 1, 'Select: 'fullname.current, 80
  107.     if newdir then
  108.         call w_put namew, 2, 1, 'Current directory: 'dosdrive()':'doscd(), 80
  109.     newdir = 0
  110.     key = inkey()
  111.     select
  112.         when key = pf2 then do
  113.             call command
  114.             newdir = 1
  115.             end
  116.         when key = pf3 then
  117.             leave
  118.         when key = pf4 then do
  119.             call changedir
  120.             newdir = 1
  121.             end
  122.         when key = pf5 then do
  123.             call newtree
  124.             if irc \= 0 then
  125.                 iterate
  126.             top = 1
  127.             curline = 2
  128.             old_top = 0
  129.             end
  130.         when key = down then do
  131.             if current = count then
  132.                 iterate
  133.             if curline <= height then do
  134.                 call w_attr w, curline, 3, width-4, normal
  135.                 curline = curline + 1
  136.                 current = top + curline - 2
  137.                 call highlight line.current, curline
  138.                 end
  139.             else
  140.                 top = top + 1
  141.             end
  142.         when key = up then do
  143.             if current = 1 then
  144.                 iterate
  145.             if curline > 2 then do
  146.                 call w_attr w, curline, 3, width-4, normal
  147.                 curline = curline - 1
  148.                 current = top + curline - 2
  149.                 call highlight line.current, curline
  150.                 end
  151.             else
  152.                 top = top - 1
  153.             end
  154.         when key = pgdn then do
  155.             if count >= top + height
  156.                 then top = top + height
  157.             if top + curline - 2 > count then
  158.                 curline = count - top + 2
  159.             end
  160.         when key = pgup then do
  161.             if top - height > 0
  162.                 then top = top - height
  163.             else
  164.                 top = 1
  165.             end
  166.         when key = ctrlpgup then do
  167.             top = 1
  168.             end
  169.         when key = ctrlpgdn then do
  170.             if count - height + 1 > 0
  171.                 then top = count - height + 1
  172.             end
  173.         otherwise nop
  174.         end
  175.     end
  176. call w_close w
  177. call w_close namew
  178. call w_close helpw
  179. return
  180.  
  181. /* get a new tree name and switch to it */
  182. newtree:
  183. irc = 0
  184. dw = w_open(4,5,5,50,normal)
  185. call w_border dw,,,,,border
  186. call w_put dw, 2, 3, 'Enter name of new directory:'
  187. answer = ''
  188. do forever
  189.     answer = w_get(dw, 3, 3, 46, answer,,,'f')
  190.     key = _activation_key
  191.     select
  192.         when key = esc then do
  193.             irc = 1
  194.             leave
  195.             end
  196.         when key = enter then do
  197.             if validate_directory(answer) \= 0 then do
  198.                 msg = "Directory not found."
  199.                 call w_put dw, 4, 3, msg, 46
  200.                 iterate
  201.                 end
  202.             call read_tree
  203.             leave
  204.             end
  205.         otherwise nop
  206.         end
  207.     end
  208. call w_close dw
  209. return irc
  210.  
  211. /* show a portion of the tree */
  212. show:
  213. call w_hide w, 'n'
  214. do i = 0 to height-1
  215.     j = top + i
  216.     call w_put w, i+2, 3, line.j, width-4
  217.     if i+2 = curline then
  218.         call highlight line.j, i+2
  219.     end
  220. call w_unhide w
  221. return
  222.  
  223. /* highlight the directory name */
  224. highlight:
  225. line = arg(1)
  226. row = arg(2)
  227. col = lastpos(d2c(196),line) + 3
  228. call w_attr w, row, col, length(line) - col + 3, reverse
  229. return
  230.  
  231. /* display the help window */
  232. showhelp:
  233. helpw = w_open(2,50,help_lines+2,28,normal)
  234. call w_border helpw,,,,,border
  235. do i = 1 to help_lines
  236.     call w_put helpw, i+1, 3, help_line.i
  237.     end
  238. return
  239.  
  240. /* call command.com */
  241. command:
  242. call w_hide w
  243. call w_hide namew
  244. call w_hide helpw
  245. parse var curpos row col
  246. call cursor row, col
  247. say
  248. say '┌───────────────────────────────────────────────────────────────────────┐'
  249. say '│ Shelling to OS/2...                                                   │'
  250. say '│ Type "EXIT" to return control to TREED2                               │'
  251. say '└───────────────────────────────────────────────────────────────────────┘'
  252. address command dosenv('comspec')
  253. curpos = cursor()
  254. call w_unhide w
  255. call w_unhide namew
  256. call w_unhide helpw
  257. return
  258.  
  259. /* change directory */
  260. changedir: procedure expose fullname. current
  261. parse value parsefn(fullname.current) with drive path . .
  262. if drive \= '-' then
  263.     call dosdrive drive
  264. if path \= '\' then
  265.     path = strip(path,'t','\')
  266. call doschdir path
  267. return
  268.  
  269. /* preserve screen contents */
  270. save_screen:
  271. saved_screen = scrread(1,1,scr_height*scr_width,'b')
  272. return
  273.  
  274. /* restore screen contents */
  275. restore_screen:
  276. call scrput 1, 1, saved_screen, 'b'
  277. return
  278.  
  279. /* validate a putative directory name */
  280. validate_directory: procedure expose base
  281. base = upper(arg(1))
  282. if base = '' then
  283.     base = dosdrive()':\'
  284. parse value parsefn(base) with drive path fn ft
  285. if fn \= '-' | ft \= '-' then
  286.     badarg = 1
  287. else do
  288.     if drive = '-' then
  289.         drive = dosdrive()
  290.     if path = '-' then
  291.         path = '\'
  292.     else do
  293.         if left(path,1) \= '\' then do
  294.             if doscd(drive) \= '\' then
  295.                 path = doscd(drive)'\'path
  296.             else
  297.                 path = '\'path
  298.             end
  299.         end
  300.     if path \= '\' then
  301.         path = strip(path,'t','\')
  302.     base = drive':'path
  303.     if right(base,2) \= ':\' & dosdir(base,,'d','d') = '' then
  304.         badarg = 1
  305.     else
  306.         badarg = 0
  307.     end
  308. return badarg
  309.  
  310. /* sort a list of subdirectories into alphabetical order */
  311. sortdir: procedure expose dir.
  312. top = arg(1)
  313. do i = 1 to top - 1
  314.     low = i
  315.     do j = i + 1 to top
  316.         if dir.j < dir.low then low = j
  317.     end
  318.     temp = dir.i
  319.     dir.i = dir.low
  320.     dir.low = temp
  321. end
  322. return
  323.  
  324. /* initialize variables */
  325. initialize:
  326. esc = '1b'x
  327. enter = '0d'x
  328. ansiclear = esc'[2J'
  329. up = '0048'x
  330. down = '0050'x
  331. pgup = '0049'x
  332. pgdn = '0051'x
  333. ctrlpgup = '0084'x
  334. ctrlpgdn = '0076'x
  335. pf1 = '003b'x
  336. pf2 = '003c'x
  337. pf3 = '003d'x
  338. pf4 = '003e'x
  339. pf5 = '003f'x
  340. pf6 = '0040'x
  341. pf7 = '0041'x
  342. pf8 = '0042'x
  343. pf9 = '0043'x
  344. pf10 = '0044'x
  345.  
  346. parse value scrsize() with scr_height scr_width .
  347.  
  348. parse value pcvideomode() with irc colors . .
  349. if irc = 1 & colors < 4 then do
  350.    reverse = 112
  351.    normal = 7
  352.    border = 15
  353.    end
  354. else do
  355.    reverse = 112
  356.    normal = 31
  357.    border = 30
  358.    end
  359. help_line.1 = "F2 - OS/2 Command line"
  360. help_line.2 = "F3 - Exit"
  361. help_line.3 = "F4 - Change directory"
  362. help_line.4 = "F5 - New tree"
  363. /* help_line.n = "F5 - Your new option..." */
  364. help_lines = 4     /* must be kept in synch */
  365. return
  366.