home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / cmdpk164.zip / xdir.cmd < prev    next >
OS/2 REXX Batch file  |  1998-01-10  |  26KB  |  800 lines
  1. /* This is CommandPak's xdir command                    */
  2. /* (w) 1996-98 Martin Lafaix, Ulrich Möller             */
  3.  
  4. /* Options: type xdir -h */
  5.  
  6. signal on halt
  7. signal on syntax name syntax
  8. signal on failure name syntax
  9.  
  10. call init
  11.  
  12. parse arg commandLine
  13.  
  14. do while commandLine \= ''
  15.    parse var commandLine left '"' file '"' commandLine
  16.    if left \= '' then call getOptions left
  17.    if file \=='' then call add file
  18. end /* do */
  19.  
  20. if specs.0 = 0 & filespec = 0 then call add '*'
  21. if sub & sortorder \= '' then sortorder = 'P' sortorder
  22.  
  23. do spec = 1 to specs.0
  24.    call emit spec
  25. end /* do */
  26.  
  27. call terminate
  28.  
  29. exit
  30.  
  31.  
  32. getOptions:
  33.   procedure expose nl wpabstract debug stdext ext wide UNIX full fullPath classify lowerc upperc verbose pause specs. attron attroff filespec sortorder sub processingInit invalidOpt lineCount height
  34.   if debug then Say "Entering options..."
  35.  
  36.   parse arg opt
  37.   do while (opt \= "")
  38.     parse value opt with opt1 opt
  39.     if debug then do
  40.         Say nl||'Now parsing block  "'opt1'"'
  41.         Say 'Remaining blocks:  "'opt'"'
  42.     end
  43.  
  44.     if (substr(opt1, 1, 1)="/") then
  45.         opt1 = lowercase(opt1)
  46.  
  47.     if (substr(opt1, 1, 1)="-") | (substr(opt1, 1, 1)="/") then do
  48.         do optcount = 2 to length(opt1) by 1
  49.             switch = substr(opt1, optcount, 1)
  50.             if debug then say '  Now examining "'switch'"'
  51.             select
  52.               when (switch = 'w') & \full & \fullPath then do
  53.                 wide = 1
  54.                 UNIX = 0
  55.               end
  56.               when (switch = 'C') & \full & \fullPath then do
  57.                 wide = 0
  58.                 UNIX = 1
  59.               end
  60.               when (switch = 'F') then do
  61.                 classify = 1
  62.               end
  63.               when (switch = 'D') then
  64.                 debug = 1
  65.               when (switch = 'W') then
  66.                 attron = attron||'W'
  67.               when (switch = 'b') | (switch = '1') then do
  68.                 full = 1
  69.                 wide = 0
  70.                 UNIX = 0
  71.               end
  72.               when switch = 'p' then do
  73.                 pause = 1
  74.               end
  75.               when switch = 'f' then do
  76.                 fullPath = 1
  77.                 wide = 0
  78.                 UNIX = 0
  79.               end
  80.               when (switch = 'l') | (switch = "n") then do
  81.                 wide = 0
  82.                 UNIX = 0
  83.                 ext = stdext
  84.               end
  85.               when switch = 'L' then lowerc = 1
  86.               when switch = 'U' then upperc = 1
  87.               when (switch = 's') | (switch = 'R') then sub = 1
  88.               when switch = 'd' then do; attron = "D"; attroff = ""; end;
  89.               when switch = 't' then sortorder = "D"
  90.               when switch = 'S' then sortorder = "S"
  91.               when (switch = '?') | (switch = 'h') then do
  92.                 'call xhelp xdir'
  93.                 exit 0
  94.               end
  95.               when switch = 'a' then do
  96.                  if substr(opt1,3,1) \= ':' then
  97.                     attroff = ''
  98.                  else do
  99.                     attr = translate(strip(substr(opt1,3),,':'))
  100.                     attron = ''
  101.                     attroff = ''
  102.                     do while attr \= ''
  103.                        if debug then say '    Subparsing attr: "'attr'"'
  104.                        neg = left(attr,1) = '-'
  105.                        if neg then attr = substr(attr,2)
  106.                        if pos(left(attr,1),'HRSADW') > 0 then
  107.                           if neg then
  108.                              attroff = attroff||left(attr,1)
  109.                           else
  110.                              attron = attron||left(attr,1)
  111.                        else
  112.                           call invalidOption arg(1), attr
  113.                        attr = substr(attr,2)
  114.                     end /* do */
  115.                     if debug then say '    Exiting attribs; attron = "'attron'"'
  116.                     leave
  117.                  end
  118.               end
  119.               when switch = 'x' then do
  120.                  if debug then say '    Entering ext'
  121.                  ext = ""
  122.                  wide = 0
  123.                  UNIX = 0
  124.                  if (substr(opt1,3,1) \= ':') then
  125.                     ext = "asel"
  126.                  else do
  127.                     ext2 = strip(substr(opt1,3),,':')
  128.                     do while ext2 \= ''
  129.                        if debug then say '    Subparsing ext2: "'ext2'" ext: "'ext'"'
  130.                        if (pos(left(ext2,1),'adtsel') > 0) then
  131.                           ext = ext||left(ext2,1)
  132.                        else
  133.                           call invalidOption arg(1), ext2
  134.                        ext2 = substr(ext2,2)
  135.                     end /* do */
  136.                     if debug then say '    Exiting ext: "'ext'"'
  137.                     leave
  138.                  end
  139.               end
  140.               when (switch = 'o') then do
  141.                  if substr(opt1,3,1) \= ':' then
  142.                     sortorder = 'N'
  143.                  else do
  144.                     order = translate(strip(substr(opt1,3),,':'))
  145.                     sortorder = ''
  146.                     do while order \= ''
  147.                        if debug then say '    Subparsing order: "'order'"'
  148.                        neg = left(order,1) = '-'
  149.                        if neg then order = substr(order,2)
  150.                        if (pos(left(order,1),'NESDG') > 0) then do
  151.                           if neg then
  152.                              sortorder = sortorder '-'left(order,1)
  153.                           else
  154.                              sortorder = sortorder left(order,1)
  155.                        end
  156.                        else
  157.                           call invalidOption arg(1), order
  158.                        order = substr(order,2)
  159.                     end /* do */
  160.                     if debug then say '    Exiting order.'
  161.                     leave
  162.                  end /* else */
  163.               end /*when */
  164.            otherwise
  165.                call invalidOption arg(1), opt1
  166.            end /* select */
  167.         end /* do*/
  168.     end /* if */
  169.     else
  170.         call add opt1
  171.   if debug then say "Done with block."
  172.   end
  173.   if sub & full then
  174.      fullPath = 1
  175.   if debug then say "Exiting options."
  176. return
  177.  
  178. invalidOption:
  179.   call display SysGetMessage(1003)
  180.   if words(arg(1)) > 1 | pos('/',arg(1),pos('/',arg(1))+1) > 0 then
  181.      call display SysGetMessage(1249,,'/'arg(2))
  182.   if processingInit then do
  183.      invalidOpt = 1
  184.      return
  185.      end
  186.   else
  187.      exit 1
  188.  
  189. add:
  190.   procedure expose specs. filespec
  191.   filespec = filespec + 1
  192.   i = specs.0 + 1
  193.   file = arg(1)
  194.  
  195.   /*
  196.    * les divers cas sont :
  197.    *
  198.    * 1- chemin relatif dans l'unité courante
  199.    * 2- chemin absolu dans l'unité courante
  200.    * 3- chemin relatif dans une unité donnée
  201.    * 4- chemin absolu dans une unité donnée
  202.    */
  203.   if substr(file,2,1) \= ':' then
  204.      file = filespec('d',directory())file
  205.   /*
  206.    * les cas 1- et 2- ont été traités
  207.    */
  208.   if substr(file,3,1) \= '\' then
  209.      file = directory(filespec('d',file))'\'substr(file,3)
  210.   if left(file,1) = '\' then do
  211.      call display SysGetMessage(15)
  212.      return
  213.      end
  214.   /*
  215.    * directory() ajoute un '\' en fin de chaîne si c'est la racine
  216.    */
  217.   if substr(file,4,1) = '\' then
  218.      file = delstr(file,4,1)
  219.   /*
  220.    * le résultat est-il un répertoire, ou une spécification de fichier ?
  221.    */
  222.   if right(file,1) \= '\' & verify(file,'*?','M') = 0 then
  223.      if stream(file,'c','query exists') = '' & stream(file,'c','query datetime') \= '' then
  224.         file = file'\'
  225.  
  226.   specs.i = file
  227.   specs.0 = i
  228.  
  229.   return
  230.  
  231. init:
  232.   if RxFuncQuery("SysLoadFuncs") then do
  233.      call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs'
  234.      call SysLoadFuncs
  235.      end
  236.   if RxFuncQuery("VioLoadFuncs") then do
  237.      call RxFuncAdd 'VioLoadFuncs','REXXVIO','VioLoadFuncs'
  238.      call VioLoadFuncs
  239.      end
  240.  
  241.   debug = 0
  242.  
  243.   processingInit = 1
  244.  
  245.   lineCount = 1
  246.  
  247.   filespec = 0            /* no filespec found */
  248.   orgdir = directory()    /* initial directory */
  249.   specs.0 = 0
  250.   sub = 0                 /* /S */
  251.   wide = 0                /* /W */
  252.   UNIX = 0                /* -C */
  253.   full = 0                /* not /B */
  254.   fullPath = 0            /* not /F */
  255.   stdext = "dtse"
  256.   ext = stdext            /* for -l: date, time, size, easize, name */
  257.   classify = 0            /* not -F (append '/', '*' etc.) */
  258.   lowerc = 0              /* -L */
  259.   upperc = 0              /* -U */
  260.   verbose = 0             /* /V */
  261.   pause = 0               /* /P */
  262.   attron = ''             /* attributes required */
  263.   attroff = 'SH'          /* attributes exclued */
  264.   sortorder = ''          /* how to sort */
  265.  
  266.   prevdrive = ''
  267.   prevrep = ''
  268.   prevfile = 0
  269.   partialSize = 0
  270.   partialCount = 0
  271.   totalSize = 0
  272.   totalCount = 0
  273.  
  274.   dirLabel = strip(SysGetMessage(1054)) /* <DIR> */
  275.   parse value SysTextScreenSize() with height width .
  276.  
  277.   ci = DosQueryCtryInfo()
  278.   iDate = c2d(substr(ci,9,1))    /* 0 = MDY, 1 = DMY, 2 = YMD */
  279.   iTime = c2d(substr(ci,28,1))   /* 0 = 12 Hour clock, 1 = 24 */
  280.   sThousands = substr(ci,18,1)   /* ',' */
  281.   sDate = substr(ci,22,1)        /* '/' */
  282.   sTime = substr(ci,24,1)        /* ':' */
  283.  
  284.   today = left(date('S'),4)*372+substr(date('S'),5,2)*31+right(date('S'),2)
  285.  
  286.   normal = '1b'x'[0m'
  287.  
  288.   bright = 1
  289.   underline = 4
  290.   blink = 5
  291.  
  292.   black = 30
  293.   red = 31
  294.   green = 32
  295.   yellow = 33
  296.   blue = 34
  297.   magenta = 35
  298.   cyan = 36
  299.   white = 37
  300.  
  301.   val = value('DIRCLR.ATTRIB',,'OS2ENVIRONMENT')
  302.   do while val \= ''
  303.      parse var val list ':' color ';' val
  304.      list = translate(list,' ',',')
  305.      do i = 1 to words(list)
  306.         call value 'dirclr._attrib_._'word(list,i), ansivalue(color)
  307.      end /* do */
  308.   end /* do */
  309.   val = value('DIRCLR.EXT',,'OS2ENVIRONMENT')
  310.   do while val \= ''
  311.      parse var val list ':' color ';' val
  312.      list = translate(list,' ',',')
  313.      do i = 1 to words(list)
  314.         call value 'dirclr._ext_.'word(list,i), ansivalue(color)
  315.      end /* do */
  316.   end /* do */
  317.   val = value('DIRCLR.NAME',,'OS2ENVIRONMENT')
  318.   do while val \= ''
  319.      parse var val list ':' color ';' val
  320.      list = translate(list,' ',',')
  321.      do i = 1 to words(list)
  322.         call value 'dirclr._name_.'word(list,i), ansivalue(color)
  323.      end /* do */
  324.   end /* do */
  325.   val = value('DIRCLR.DATE',,'OS2ENVIRONMENT')
  326.   do while val \= ''
  327.      parse var val list ':' color ';' val
  328.      dirclr._date_.newer = -list ansivalue(color)
  329.   end /* do */
  330.   val = value('DIRCLR.WPABSTRACT',,'OS2ENVIRONMENT')
  331.   do while val \= ''
  332.      parse var val color ';' val
  333.      dirclr._wpabstract_ = ansivalue(color)
  334.      if debug then say 'dirclr._wpabstract_: "'dirclr._wpabstract_'"'
  335.   end /* do */
  336.  
  337.   val = value('XDIR.DIRCMD',,'OS2ENVIRONMENT')
  338.   if (val = "") then
  339.       val = value('DIRCMD',,'OS2ENVIRONMENT')
  340.   if (val \= "") then
  341.      call getOptions val
  342.   if invalidOpt = 1 then
  343.      call display SysGetMessage(3154,,'DIRCMD')
  344.  
  345.   processingInit = 0
  346.   return
  347.  
  348. ansivalue:
  349.   litcolor = arg(1); ansicolor = ''; on = 0
  350.   do while litcolor \= ''
  351.      parse upper var litcolor item litcolor
  352.      if item = 'ON' then on = 10
  353.      else
  354.        ansicolor = ansicolor || ';' || value(item)+on
  355.   end /* do */
  356.  
  357.   return '1b'x'['strip(ansicolor,'L',';')'m'
  358.  
  359. emitHeader1:
  360.   drive = SysDriveInfo(filespec('d',file))
  361.   rep = left(file,lastpos('\',file)-1)
  362.   if length(rep) = 2 then rep = rep'\'
  363.  
  364.   /* displaying standard directory header */
  365.   if drive \= prevdrive then do
  366.      if prevdrive \= '' then call terminate
  367.      call display SysGetMessage(1516,,left(drive,1),word(drive,4))
  368.      call display SysGetMessage(1243,,translate('abcd:efgh',word(DosQueryFSInfo(drive),6),'abcdefgh'))
  369.      end
  370.   return
  371.  
  372. emitHeader2:
  373.   rep = strip(arg(1))
  374.   if length(rep) = 2 then rep = rep'\'
  375.  
  376.   if rep \= prevrep then do
  377.      if partialCount > 0 then
  378.         if verbose then
  379.            call display SysGetMessage(1060,,format(partialCount,9),right(pprint(partialSize),13))'0d0a'x
  380.         else
  381.            call display SysGetMessage(1060,,format(partialCount,9),format(partialSize,10))'0d0a'x
  382.      partialSize = 0
  383.      partialCount = 0
  384.      call display SysGetMessage(1053,,rep)
  385.      end
  386.   else
  387.   if spec \= prevfile then do
  388.      if partialCount > 0 then
  389.         if verbose then
  390.            call display SysGetMessage(1060,,format(partialCount,9),right(pprint(partialSize),13))
  391.         else
  392.            call display SysGetMessage(1060,,format(partialCount,9),format(partialSize,10))
  393.      partialSize = 0
  394.      partialCount = 0
  395.      end
  396.   if LOCALRC \= 0 then do
  397.      if partialCount > 0 then
  398.         call display SysGetMessage(1060,,format(partialCount,9),format(partialSize,10))
  399.      partialSize = 0
  400.      partialCount = 0
  401.      call display SysGetMessage(LOCALRC)
  402.      end
  403.  
  404.   prevdrive = drive
  405.   prevrep = rep
  406.   prevfile = spec
  407.   return
  408.  
  409. /*
  410.  Heap sort the "file." array in ascending order.
  411.  Algorithm from "Numerical Recipes in Fortran", Cambridge University Press
  412. */
  413. sort:
  414.   if debug then Say "Entering sort for" file.0 "files"
  415.   if file.0 < 2 then
  416.      return
  417.   l = trunc(file.0/2)+1
  418.   ir = file.0
  419.   do forever
  420.      if l>1 then do
  421.         l = l-1
  422.         tempd = file.l
  423.         end
  424.      else do
  425.         tempd = file.ir
  426.         file.ir = file.1
  427.         ir = ir - 1
  428.         if ir = 1 then do
  429.            file.1 = tempd
  430.            return
  431.            end
  432.         end
  433.      i = l
  434.      j = l + l
  435.      do while j <= ir
  436.         if j < ir then do
  437.            k = j + 1
  438.            if compare(file.j, file.k) then
  439.               j = j + 1
  440.            end
  441.         if compare(tempd, file.j) then do
  442.            file.i = file.j
  443.            i = j
  444.            j = j + j
  445.            end
  446.         else
  447.            j = ir + 1
  448.      end /* do */
  449.      file.i = tempd
  450.   end /* do */
  451.  
  452. compare: /* arg(1) < arg(2) */
  453.   procedure expose sortorder
  454.   parse upper value arg(1) with date1 size1 . attr1 fullname1
  455.   parse upper value arg(2) with date2 size2 . attr2 fullname2
  456.   name1 = substr(fullname1,lastpos('\',fullname1)+1)
  457.   name2 = substr(fullname2,lastpos('\',fullname2)+1)
  458.  
  459.   do i = 1 to words(sortorder)
  460.      order = word(sortorder,i)
  461.      select
  462.         when order = 'D' then do
  463.            if date1 < date2 then return 1
  464.            if date1 > date2 then return 0
  465.         end
  466.         when order = '-D' then do
  467.            if date1 > date2 then return 1
  468.            if date1 < date2 then return 0
  469.         end
  470.         when order = 'S' then do
  471.            if size1 < size2 then return 1
  472.            if size1 > size2 then return 0
  473.         end
  474.         when order = '-S' then do
  475.            if size1 > size2 then return 1
  476.            if size1 < size2 then return 0
  477.         end
  478.         when order = 'N' then do
  479.            if name1 < name2 then return 1
  480.            if name1 > name2 then return 0
  481.         end
  482.         when order = '-N' then do
  483.            if name1 > name2 then return 1
  484.            if name1 < name2 then return 0
  485.         end
  486.         when order = 'E' then do
  487.            p1 = lastpos('.',name1); if p1 = 0 then ext1 = ''; else ext1 = substr(name1,p1+1)
  488.            p2 = lastpos('.',name2); if p2 = 0 then ext2 = ''; else ext2 = substr(name2,p2+1)
  489.            if ext1 < ext2 then return 1
  490.            if ext1 > ext2 then return 0
  491.         end
  492.         when order = '-E' then do
  493.            p1 = lastpos('.',name1); if p1 = 0 then ext1 = ''; else ext1 = substr(name1,p1+1)
  494.            p2 = lastpos('.',name2); if p2 = 0 then ext2 = ''; else ext2 = substr(name2,p2+1)
  495.            if ext1 > ext2 then return 1
  496.            if ext1 < ext2 then return 0
  497.         end
  498.         when order = 'G' then do
  499.            if substr(attr1,2,1) \= substr(attr2,2,1) & substr(attr1,2,1) = 'D' then return 1
  500.            if substr(attr1,2,1) \= substr(attr2,2,1) & substr(attr2,2,1) = 'D' then return 0
  501.         end
  502.         when order = '-G' then do
  503.            if substr(attr1,2,1) \= substr(attr2,2,1) & substr(attr1,2,1) = '-' then return 1
  504.            if substr(attr1,2,1) \= substr(attr2,2,1) & substr(attr2,2,1) = '-' then return 0
  505.         end
  506.         when order = 'P' then do /* only set when sub is 1 */
  507.            if left(fullname1, length(fullname1)-length(name1)) < left(fullname2, length(fullname2)-length(name2)) then return 1
  508.            if left(fullname1, length(fullname1)-length(name1)) > left(fullname2, length(fullname2)-length(name2)) then return 0
  509.         end
  510.         otherwise do; end;
  511.      end  /* select */
  512.   end /* do */
  513. return 0
  514.  
  515. emit:
  516.   file = value('specs.'arg(1))
  517.   filename = substr(file,lastpos('\',file)+1)
  518.  
  519.   if \full & \fullPath then call emitHeader1 arg(1)
  520.  
  521.   maxWidth = 0
  522.  
  523.   wpabstract = (pos('W', attron) > 0)
  524.  
  525.   attron = strReplace(attron, 'W', '')
  526.   if Debug then say 'attron: "'attron'"'
  527.  
  528.   if attron \= '' & attroff \= '' & verify(attron,attroff,'M') \= 0 then
  529.      file.0 = 0
  530.   else do
  531.      attribute = '*****'
  532.      do i = 1 to length(attron)
  533.         attribute = overlay('+',attribute,pos(substr(attron,i,1),'ADHRSW'))
  534.      end /* do */
  535.      do i = 1 to length(attroff)
  536.         attribute = overlay('-',attribute,pos(substr(attroff,i,1),'ADHRSW'))
  537.      end /* do */
  538.  
  539.      if sub then
  540.         call DosFileTree file, file., 'TS', attribute
  541.      else
  542.         call DosFileTree file, file., 'T', attribute
  543.   end
  544.  
  545.   if debug then say 'file.0: "'file.0'"'
  546.  
  547.   if (wpabstract) then do
  548.          if RxFuncQuery("WPToolsLoadFuncs") then do
  549.              call RxFuncAdd 'WPToolsLoadFuncs', 'WPTOOLS', 'WPToolsLoadFuncs'
  550.              call WPToolsLoadFuncs
  551.          end
  552.          if debug then Say "Entering WPAbstract."
  553.          rc = WPToolsFolderContent(left(file, length(file)-2), objects.)
  554.          ofs = file.0
  555.          file.0 = file.0+objects.0
  556.          if rc then
  557.             do i = 1 to objects.0
  558.                 rc2=WPToolsQueryObject(objects.i, "szclass", "sztitle", "szsetupstring", "szlocation")
  559.                 i2=i+ofs
  560.                 file.i2 = "0000/00/00/00/00        0      0  -----  "||left(file, length(file)-1)||sztitle||'@'
  561.             end
  562.   end
  563.  
  564.   if file.0 = 0 then do
  565.      LOCALRC = 2
  566.      call emitHeader2 left(file,lastpos('\',file)-1)
  567.      end
  568.   else do
  569.      LOCALRC = 0
  570.      if (sortorder \= '') then call sort
  571.   end
  572.  
  573.   /* handling relevant files */
  574.   do i = 1 to file.0
  575.      parse var file.i year '/' month '/' day '/' hour '/' min size easize attr name
  576.  
  577.      if full | fullPath then do
  578.         if right(name,2) = '\.' | right(name,3) = '\..' then iterate
  579.         end
  580.      else
  581.         call emitHeader2 left(name,lastpos('\',name)-1)
  582.  
  583.      partialSize = partialSize + size
  584.      partialCount = partialCount + 1
  585.      totalSize = totalSize + size
  586.      totalCount = totalCount + 1
  587.  
  588.      if \ fullPath then
  589.         name = substr(name,lastpos('\',name)+1)
  590.      else
  591.         name = strip(name)
  592.      easize = easize % 2
  593.      if easize = 2 then easize = 0
  594.      if lowerc then name = lowercase(name)
  595.      if upperc then name = translate(name)
  596.      itemLength = length(name)
  597.      if itemLength > maxWidth then maxWidth = itemLength
  598.      if substr(attr,2,1) = 'D' then do
  599.         if wide | UNIX then
  600.            name = '['name']'
  601.         else
  602.            size = dirLabel
  603.         itemLength = itemLength + 2
  604.         end
  605.  
  606.      /* highlighting relevent files */
  607.      dot = lastpos('.',name); oname = name
  608.      do j = 1 to 5
  609.         if symbol('dirclr._attrib_._'substr(attr,j,1)) = 'VAR' then
  610.            name = value('dirclr._attrib_._'substr(attr,j,1))name
  611.      end /* do */
  612.      if dot > 0 then
  613.         if symbol('dirclr._ext_'substr(oname,dot)) = 'VAR' then
  614.            name = value('dirclr._ext_'substr(oname,dot))name
  615.      if dot = 0 then dot = length(oname)+1
  616.      if symbol('dirclr._name_.'left(oname,dot-1)) = 'VAR' then
  617.         name = value('dirclr._name_.'left(oname,dot-1))name
  618.      if symbol('dirclr._date_.newer') = 'VAR' then
  619.         if today - (year * 372 + month * 31 + day) <= word(dirclr._date_.newer,1) then
  620.            name = subword(dirclr._date_.newer,2)||name
  621.      if length(name) \= itemLength then
  622.         name = name||normal
  623.  
  624.      if (wpabstract & (pos('@', name) > 0)) then do
  625.          if symbol('dirclr._wpabstract_') = 'VAR' then do
  626.             name = dirclr._wpabstract_||name||normal
  627.          end
  628.      end
  629.  
  630.      if classify then do
  631.         name_ = translate(name)
  632.         if (pos('.EXE', name_)>0) | (pos('.COM', name_)>0) | (pos('.BAT', name_)>0) | (pos('.CMD', name_)>0) then do
  633.             name = name||"*"
  634.             itemLength = itemLength+1
  635.         end
  636.      end
  637.  
  638.      if (wide | UNIX) then
  639.         dir.partialCount = itemLength name
  640.      else if full | fullPath then
  641.         call display name'0d0a'x
  642.      else do
  643.         year = right(year,2)
  644.         select
  645.            when iDate = 0 then fdate = format(month)||sDate||day||sDate||year
  646.            when iDate = 1 then fdate = format(day)||sDate||month||sDate||year
  647.            when iDate = 2 then fdate = year||sDate||month||sDate||day
  648.         end  /* select */
  649.         if iTime = 1 then
  650.            time = format(hour)||sTime||min' '
  651.         else
  652.            if hour < 13 then
  653.               time = format(hour)||sTime||min'a'
  654.            else
  655.               time = format(hour-12)||sTime||min'p'
  656.         if verbose then
  657.           call display right(fdate,8) right(time,6) right(pprint(size),13) right(pprint(easize),6) translate(delstr(attr,2,1), 'arsh', 'ARSH')'  'name'0d0a'x
  658.         else do
  659.             line = ""
  660.             do i_ = 1 to length(ext)
  661.                 if debug then say attr
  662.                 if (substr(ext, i_, 1) = "a") then line = line||lowercase(attr)||" "
  663.                 if (substr(ext, i_, 1) = "d") then line = line||right(fdate, 8)||" "
  664.                 if (substr(ext, i_, 1) = "t")  then line = line||right(time, 7)||" "
  665.                 if (substr(ext, i_, 1) = "s") then line = line||right(size, 9)||" "
  666.                 if (substr(ext, i_, 1) = "e") then line = line||right(easize, 11)||" "
  667.             end
  668.             line = line name
  669.             if (pos('l', ext) > 0) then do
  670.                 rc = SysGetEA(oname, ".LONGNAME", "longname_")
  671.                 if (rc=0) then do
  672.                     longname = substr(longname_, 5)
  673.                     line = line '('||longname||')'
  674.                 end
  675.             end
  676.             /* call display right(fdate,8) right(time,7) right(size,9) right(easize,11)'  'name'0d0a'x */
  677.             call display line'0d0a'x
  678.         end
  679.       end
  680.   end /* do */
  681.  
  682.   /* displaying result */
  683.   if wide & partialCount > 0 then do
  684.     itemCount = width % (maxWidth+4)
  685.     line = ''
  686.     do i = 1 to partialCount
  687.       line = line || subword(dir.i,2)
  688.       if i // itemCount = 0 then do
  689.         call display line'0d0a'x
  690.         line = ''
  691.         end
  692.       else
  693.         line = line || copies(' ',maxWidth+4-word(dir.i,1))
  694.     end /* do */
  695.     if i // itemCount \= 1 then call display line'0d0a'x
  696.   end
  697.  
  698.   if (UNIX) then do  /* wide format, top to bottom */
  699.     spaces = 4
  700.     itemsPerLine = (width % (maxWidth+spaces))
  701.     lineCount = ((totalCount-1) % itemsPerLine)+1
  702.     do i = 1 to lineCount
  703.       line = ""
  704.       do i2 = 0 to itemsPerLine-1
  705.           i3 = i + (i2*lineCount)
  706.           if (i3 <= totalCount) then do
  707.               line = line || subword(dir.i3,2)
  708.               if (maxWidth+spaces-word(dir.i3,1) > 0) & (i2 < itemsPerLine-1) then
  709.                   line = line || copies(' ',maxWidth+spaces-word(dir.i3,1))
  710.           end
  711.       end
  712.       say line
  713.     end /* do */
  714.   end /* if */
  715.  
  716.   if LOCALRC = 0 & \full & \fullPath & spec = specs.0 then do
  717.      if sub then do
  718.         if verbose then
  719.            call display SysGetMessage(1060,,format(partialCount,9),right(pprint(partialSize),13))
  720.         else
  721.            call display SysGetMessage(1060,,format(partialCount,9),format(partialSize,10))
  722.         call display SysGetMessage(3155)
  723.         if verbose then
  724.            call display SysGetMessage(1060,,format(totalCount,9),right(pprint(totalSize),13))
  725.         else
  726.            call display SysGetMessage(1060,,format(totalCount,9),format(totalSize,10))
  727.         end
  728.      else do
  729.         if verbose then
  730.            call display SysGetMessage(1060,,format(partialCount,9),right(pprint(partialSize),13))
  731.         else
  732.            call display SysGetMessage(1060,,format(partialCount,9),format(partialSize,10))
  733.        end
  734.      end
  735.  
  736.   return
  737.  
  738. terminate:
  739.   /* displaying standard directory footer */
  740.   if LOCALRC = 0 & specs.0 \= 0 & \full & \fullPath then
  741.      if verbose then
  742.         call display SysGetMessage(3156,,right(pprint(word(drive,2)),31))
  743.      else
  744.         call display SysGetMessage(3156,,format(word(drive,2),28))
  745.  
  746.   call directory orgdir
  747.   return
  748.  
  749. pprint:
  750.   procedure expose sThousands
  751.   if \ datatype(arg(1), 'N') then
  752.     return arg(1)
  753.   value = reverse(arg(1))
  754.   newval = ''
  755.   do while value \= ''
  756.      parse var value group =4 value
  757.      newval = newval || sThousands || group
  758.   end /* do */
  759.   return strip(reverse(newval),, sThousands)
  760.  
  761. halt:
  762.   call directory orgdir
  763.   "call xhelp -f abortMsg xdir"
  764.   exit
  765.  
  766. syntax:
  767.   cond = condition('C') condition('D')
  768.   say '0a0d'x||"Internal error in xdir ("||cond||")."
  769.   call directory orgdir
  770.   exit
  771.  
  772. display:
  773.   call charout ,arg(1)
  774.   if (symbol(lineCount) = "VAR") then do
  775.       lineCount = lineCount+length(space(translate(arg(1),'             !',,' '),0))
  776.       if pause & lineCount // height = 0 then do
  777.          call charout ,SysGetMessage(1032)
  778.          if pos(SysGetKey('NOECHO'), '00e0'x) > 0 then
  779.             call SysGetKey('NOECHO')
  780.          say
  781.          call charout ,SysGetMessage(3152,,rep)
  782.          lineCount = lineCount+2
  783.          end
  784.   end
  785. return
  786.  
  787. strReplace:
  788.     /* syntax: result = strReplace(str, old, new) */
  789.     /* will replace a by b in oldstr */
  790.     parse arg str, old, new
  791.     p = pos(old, str)
  792.     if (p > 0) then
  793.         return left(str, p-1)||new||substr(str,p+length(old))
  794.     else
  795.         return str
  796.  
  797.  
  798. lowercase:
  799.     return translate(arg(1), 'abcdefghijklmnopqrstuvwxyz', 'ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  800.