/* OS/2 REXX - grep first occurence of pattern per file, and sort */
/* result by the number of occurences.  If the pattern contains a */
/* space it has to be quoted.                                     */

/* Replace '@grep -i' (see below) by something working for you.   */
/* Requires: grep, rxqueue, REXX interpreter with rxqueue('get'). */

/* 2006-11-06: bug fix, a single source wasn't reported at all    */
/* <http://purl.net/xyzzy/src/ygrep.cmd>  (Frank Ellermann, 2006) */

   signal on  novalue  name TRAP ;  signal on  syntax name TRAP
   signal on  failure  name TRAP ;  signal on  halt   name TRAP

   if abbrev( strip( arg( 1 )), '"' )
      then  parse arg '"' PAT '"' TXT
      else  parse arg     PAT     TXT
   if TXT = '' then  TXT = '*.txt'
   if PAT = '' then  do
      parse source . . TXT
      say 'usage:' TXT 'pattern [files]'
      say 'Quote pattern as needed, default files: *.txt'
      exit 1
   end

   QUE = rxqueue( 'get' )
   OLD = queued()
   address CMD '@grep -i "' || PAT || '"' TXT '| rxqueue /LIFO' QUE

   if rc <> 0 | queued() <= OLD  then  do
      do while queued() > OLD ;  pull  ;  end
      say 'found no "' || PAT || '" in' TXT
      exit max( 1, abs( rc ))
   end

   W.0 = 0  ;  GOT = '' ;  N = 0
   do while queued() > OLD
      parse pull TXT ':' PAT
      if abbrev( GOT, strip( TXT ) || ':' ) = 0 then  do
         if N > 0 then  do
            L = W.0 + 1 ;  W.0 = L
            W.L = right( min( N, 999 ), 3 ) GOT
            N = 0
         end
         GOT = strip( TXT ) || ':' PAT
      end
      N = N + 1
   end
   if N > 0 then  do
      L = W.0 + 1 ;  W.0 = L
      W.L = right( min( N, 999 ), 3 ) GOT
   end

   call KWIK 'W.'
   do N = 1 to W.0
      say left( W.N, 79 )
   end N
   exit 0

/* see <URL:http://purl.net/xyzzy/rexxtrap.htm>, (c) F. Ellermann */

KWIK:                            /* quick sort: call KWIK 'stem.' */
   if arg() <> 1 then return abs( /* REXX error 40 */ )
   THIS... = arg( 1 )            /* abuse global THIS... as stem  */
   if right( THIS... , 1 ) <> .  then  THIS... = THIS... || .
   return KWIK.Y( THIS... )      /* expose THIS... stem           */

KWIK.Y:  procedure expose ( THIS... )
   S = 1 ;  SL.1 = 1 ;  SR.1 = value( THIS... || 0 )

   do until S = 0
      L = SL.S ;  R = SR.S ;  S = S - 1                  /* pop   */

      do while L < R
         I = ( L + R ) % 2 ;  P = value( THIS... || L )

         XR = value( THIS... || R )
         if XR << P then do                              /* R...L */
            call value THIS... || R, P
            call value THIS... || L, XR   ;  P = XR
         end                                             /* L...R */
         XI = value( THIS... || I )
         XR = value( THIS... || R )
         select
            when XI << P then do                         /* I L R */
               call value THIS... || I, P
               call value THIS... || L, XI
            end                                          /* L I R */
            when XI >> XR then do                        /* L R I */
               call value THIS... || R, XI
               call value THIS... || I, XR   ;  P = XR
            end                                          /* L I R */
            otherwise   P = XI                           /* L I R */
         end

         I = L + 1   ;  J = R - 1                        /* I...J */
         if J <= I then leave                            /* ready */

         do until I > J
            do while value( THIS... || I ) << P ;  I = I+1  ;  end
            do while value( THIS... || J ) >> P ;  J = J-1  ;  end

            if I <= J then do
               XI = value( THIS... || I )
               call value  THIS... || I, value( THIS... || J, XI )
               I = I + 1   ;  J = J - 1
            end
         end /* I  > J */

         if J - L < R - I then do               /* less left keys */
            S = S + 1   ;  SL.S = I ;  SR.S = R ;  R = J
         end               /* pushed old R - I > 1 keys, now do L */
         else do                                /* more left keys */
            S = S + 1   ;  SL.S = L ;  SR.S = J ;  L = I
         end               /* pushed J - old L > 1 keys, now do R */
      end    /* R <= L */
   end       /* S == 0 */
   return value( THIS... || 0 )

TRAP:                            /* select REXX exception handler */
   call trace 'O' ;  trace N           /* don't trace interactive */
   parse source TRAP                   /* source on separate line */
   TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A )
   TRAP = TRAP || right( '+++', 10 )   /* = standard trace prefix */
   TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' ))
   select
      when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do
         if condition( 'd' ) > ''      /* need an additional line */
            then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
         TRAP = TRAP '(RC' rc || ')'   /* any system error codes  */
         if condition( 'c' ) = 'FAILURE' then rc = -3
      end
      when wordpos( condition( 'c' ), 'HALT SYNTAX'   ) > 0 then do
         if condition( 'c' ) = 'HALT' then rc = 4
         if condition( 'd' ) > '' & condition( 'd' ) <> rc then do
            if condition( 'd' ) <> errortext( rc ) then do
               TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
               TRAP = TRAP errortext( rc )
            end                        /* future condition( 'd' ) */
         end                           /* may use errortext( rc ) */
         else  TRAP = TRAP errortext( rc )
         rc = -rc                      /* rc < 0: REXX error code */
      end
      when condition( 'c' ) = 'NOVALUE'  then rc = -2 /* dubious  */
      when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious  */
      otherwise                        /* force non-zero whole rc */
         if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1
         if rc = 0                             then rc = 1
         if condition() = '' then TRAP = TRAP arg( 1 )
   end                                 /* direct: TRAP( message ) */

   TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 )
   signal on syntax name TRAP.SIGL     /* throw syntax error 3... */
   if 0 < sigl & sigl <= sourceline()  /* if no handle for source */
      then TRAP = TRAP '*-*' strip( sourceline( sigl ))
      else TRAP = TRAP '+++ (source line unavailable)'
TRAP.SIGL:                             /* ...catch syntax error 3 */
   if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do
      TRAP = TRAP '+++ (source line unreadable)'   ;  rc = -rc
   end
   select
      when 0 then do                   /* in pipes STDERR: output */
         parse version TRAP.REXX       /* REXX/Personal: \dev\con */
         if abbrev( TRAP.REXX, 'REXXSAA ' ) |                /**/ ,
            6 <= word( TRAP.REXX, 2 )  then  TRAP.REXX = 'STDERR'
                                       else  TRAP.REXX = '\dev\con'
         signal on syntax name TRAP.FAIL
         call lineout TRAP.REXX , TRAP /* fails if no more handle */
      end
      when 0 then do                   /* OS/2 PM or ooREXX on NT */
         signal on syntax name TRAP.FAIL
         call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ ,
            'Trap' time(),, 'ERROR'
      end
      otherwise   say TRAP ; trace ?L  /* interactive Label trace */
   end

   if condition() = 'SIGNAL' then signal TRAP.EXIT
TRAP.CALL:  return rc                  /* continue after CALL ON  */
TRAP.FAIL:  say TRAP ;  rc = 0 - rc    /* force TRAP error output */
TRAP.EXIT:  exit   rc                  /* exit for any SIGNAL ON  */