'set novalue on'  /* force KEXX and its way of SIGNAL ON NOVALUE  */

/* Usage:         [MACRO] TRACE mac [args]                        */
/* Purpose:       manage DEBUGGING ON and DEBUGGING OFF,          */
/*                manage DOS environment SET RXTRACE=ON and OFF,  */
/*                manage DEFINE MACro and PURGE MACro if needed,  */
/*                manage DEBUG START MACro and DEBUG STOP MACro,  */
/*                and in between DEBUG MACro ARGS resp. wait for  */
/*                key MACro to be pressed.  The special trick is  */
/*                to DEFINE (and later PURGE) the debugged macro, */
/*                because this is the only way to debug a macro   */
/*                calling itself recursively (e.g. KCOMPARE.KEX)  */
/*                without modifying its code.                     */
/* Details:       TRACE detects already DEFINEd macros, too often */
/*                I forgot to PURGE (or reDEFINE) an edited macro */
/*                and DEBUGged an obsolete in-memory version...   */
/*                TRACE also detects a DEFINEd key and processes  */
/*                keyboard input until the key is pressed.  This  */
/*                could be used in an INITIAL.KML as C-Debug key: */
/*    *C-Debug Kedit key macros using macro trace                 */
/*    :C-D                                                        */
/*       say 'press the key to debug'  ;  'readv key'             */
/*       if words( READV.1 ) = 1 then 'macro TRACE' READV.1       */
/*       else 'emsg' READV.2 'composed of' READV.1 'is no macro'  */
/* Caveats:    -  TRACE ALT cannot wait for pressed ALT, because  */
/*                READV KEY does not support this new Keditw-key. */
/*             -  TRACE does not support blanks in MACro names,   */
/*                jokes like TRACE .. for ...KEX (on HPFS) work.  */
/* Requires:      Kedit 5.0 or Keditw 1.0 (Frank Ellermann, 1999) */

   parse arg MAC ARG                   /* 1st word is macro name  */
   'extract /DEBUGGING/'            ;  'debugging on'

   if rexx.0() > 0 then do             /* external REXX processor */
      KEY = dosenv( 'RXTRACE' )     ;  ENV = 'environment'
      if opsys.1() = 'OS/2' then ENV = 'os2' || ENV
      if length( KEY ) <> 2            /* if not ON or Quercus ?x */
         then "imm /**/ call value 'RXTRACE', 'ON', '" || ENV || "'"
      ENV = "'RXTRACE', '" || KEY || "', '" || ENV || "'"
   end

   'nomsg debug start' MAC             /* rc = 0 if macro defined */

   if rc = 0 then do                   /* defined, could be a key */
      if ARG = '' then KEY = NAME( MAC )
                  else KEY = ''        /* ARG given, direct DEBUG */
      if KEY = '' then do
         'dmsg debugging defined' MAC
         'debug' MAC ARG               /* ARG given resp. no key  */
         exit DONE( 1, rc )            /* reset DEBUG environment */
      end

      'sos save tabcmd' ;  'extract /FIELD/' /* save command line */
      'nomsg mod macro' KEY            /* rc = 0: one liner macro */
      if rc = 0 then do                /* some dummies like macro */
         'nomsg q macro' KEY           /* s-1 'text !' cannot be  */
         'define' KEY lastmsg.1()      /* debugged without DEFine */
      end
      'cmsg' FIELD.1 ;  'sos restore'  /* restore user's cmd line */
      'dmsg to debug key press' KEY
      do until READV.1 = KEY
         'readv key' ;  'macro' READV.1
      end                              /* wait for exit from KEY  */
      exit DONE( 1, rc )               /* reset DEBUG environment */
   end

   KEY = SCAN( MAC )                   /* search for a MACro.kex  */
   if KEY > '' then 'define' KEY       /* found: define temporary */
   if KEY = '' & length( MAC ) = 1 then do
      KEY =                 '!@#$%^&*()<>?{|}+_":~'
      KEY = translate( MAC, "1234567890,./[\]=-';`", KEY )
      if MAC <> KEY        then KEY = 's-' || KEY
      if MAC << ' '        then KEY = 'c-' || d2c( 64 + c2d( MAC ))
      if MAC = d2c( 127 )  then KEY = 'c-bksp'  /* aka ^? in UNIX */
      if MAC = d2c(   0 )  then KEY = 'c-2'     /* aka ^@ KEYB US */
      if MAC = d2c(   6 )  then KEY = 'c-6'     /* aka ^^ KEYB US */
      if MAC = d2c(  31 )  then KEY = 'c--'     /* aka ^_ KEYB US */
      if MAC = d2c(  32 )  then KEY = 'space'   /* yet impossible */
      if MAC <> KEY then do
         'refresh'                              /* clear message  */
         say lastmsg.1() || ': use' translate( KEY ) 'for key' MAC
      end
      KEY = ''
   end
   if KEY = '' then exit DONE( 0, 1, 'nomsg' )  /* MAC not found  */

   'debug' MAC ARG                     ;  exit DONE( 0, rc )

DONE:                   /* --- resets MAC and DEBUGGING.1 at exit */
   if rexx.0() > 0      /* value('RXTRACE', '', 'os2environment') */
      then "imm /**/ call trace 'O' ; call value" ENV

   'sos save'                          ;  'debugging' DEBUGGING.1
   if arg( 1 ) then 'debug stop' MAC   ;  else 'nomsg purge' MAC
   if arg() = 2 then say MAC ARG 'terminated (' || arg( 2 ) || ')'
   'sos restore'                       ;  return arg( 2 )

NAME: procedure         /* --- return "classic" internal KEY name */
   arg KEY                             ;  PREF = ''

   SCAN = 'A- A+ ALT- ALT+'            /* Keditw introduced alias */
   do until SCAN = ''
      parse var SCAN NEXT SCAN
      if abbrev( KEY, NEXT ) then do
         KEY = substr( KEY, 1 + length( NEXT ))
         PREF = 'A-' ;  leave          /* classic internal prefix */
      end
      if version.1() = 'KEDIT' then leave
   end   /* ALT-Scan */

   SCAN = 'S- S+ SHIFT- SHIFT+'        /* Keditw introduced alias */
   if PREF = '' then do until SCAN = ''
      parse var SCAN NEXT SCAN
      if abbrev( KEY, NEXT ) then do
         KEY = substr( KEY, 1 + length( NEXT ))
         PREF = 'S-' ;  leave          /* classic internal prefix */
      end
      if version.1() = 'KEDIT' then leave
   end   /* SHIFT-Scan */

   SCAN = 'C- C+ CTRL- CTRL+'          /* Keditw introduced alias */
   if PREF = '' | version.1() <> 'KEDIT' then do until SCAN = ''
      parse var SCAN NEXT SCAN
      if abbrev( KEY, NEXT ) then do
         KEY = substr( KEY, 1 + length( NEXT ))
         PREF = PREF || 'C-'  ;  leave /* Keditw allows ALT-CTRL  */
      end                              /* and SHIFT+CTRL PREFixes */
      if version.1() = 'KEDIT' then leave
   end   /* CTRL-Scan */

   if wordpos( KEY, 'ENTER BKSP PLUS MINUS SLASH NUMENTER' ) > 0 then
      if PREF = 'S-' then return ''          /* SHIFT not ok. but */
                     else return PREF || KEY /* S-C- etc. is okay */

   if version.1() <> 'KEDIT' then do               /* only Keditw */
      if KEY = 'SPACE' & PREF = 'A-' then return 'A-SPACE'
      if KEY = 'STAR'  & PREF > '' then return ''  /* STAR alone  */
   /* if KEY = 'ALT' & PREF = ''   then return KEY ** ALT alone ? */
      if KEY = 'ESC' & PREF > ''   then return ''  /* no  ALT+ESC */
      if KEY = 'TAB' & PREF = 'A-' then return ''  /* no  ALT+TAB */
   end

   if KEY = 'ESC' &  PREF = 'S-'   then return ''  /* no S-ESC    */
   if KEY = 'ESC' &  PREF = 'C-'   then return ''  /* no C-ESC    */
   if KEY = 'DEL' &  PREF = 'A-C-' then return ''  /* no A-C-DEL  */
   if KEY = 'CENTER' & PREF = 'A-' then return ''  /* A- keypad 5 */
   if KEY = 'SPACE'  & PREF > ''   then return ''  /* no ?-SPACE  */
   /* KEY = 'STAR'   & PREF > ''   then return ''  ** Kedit 5.00  */
   /* my Kedit 5 is patched supporting A-STAR (55), C-STAR (150), */
   /* and S-STAR (144, Ctrl+PrtSc), shifted key 55 is still STAR  */

   if wordpos( KEY, 'ESC TAB DEL CENTER SPACE STAR HOME' ) > 0
      then return PREF || KEY                /* other combination */
   if wordpos( KEY, 'F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12' ) > 0
      then return PREF || KEY                /* all combinations  */
   if wordpos( KEY, 'PGUP PGDN CURU CURD CURR CURL END INS' ) > 0
      then return PREF || KEY                /* all combinations  */

   if length( KEY ) <> 1 then return ''      /* it's no Kedit key */

   if pos( KEY, xrange( 'A', 'Z' ) || '26-=[\]' ) > 0 /* 2:@, 6:^ */
      then return PREF || KEY                /* all combinations  */
   if pos( KEY, xrange( '0', '9' )) > 0 then
      if PREF <> 'C-' | version.1() <> 'KEDIT'
         then return PREF || KEY             /* C-2/C-6 see above */
         else return ''                      /* Keditw has C-0..9 */

   if pos( KEY, ";,'./" ) = 0 then return '' /* otherwise no keys */
   if pos( PREF, 'C-'   ) = 0 then return PREF || KEY
                              else return '' /* no C-; S-C-; etc. */

SCAN: procedure         /* --- search macro in whatever MACROPATH */
   arg FILE
   if right( FILE, 4 ) <> '.KEX' then FILE = FILE || '.KEX'
   if pos( '\', FILE ) > 0 | pos( ':', FILE ) = 2 then do
      LAST = lastpos( '\', FILE ) + 1  ;  if LAST = 1 then LAST = 3
      parse var FILE PATH =(LAST) FILE    /* split PATH from id.  */
      LAST = PATH( FILE, PATH )           /* test macro existence */
      if LAST > '' then LAST = LAST || FILE
      if LAST = '' then 'emsg' PATH || FILE 'not found'
      return LAST
   end

   PATH = dosenv( 'PATH' )                /* prepare macro search */
   if PATH > '' & right( PATH, 1 ) <> ';' then PATH = PATH || ';'

   if version.1() == 'KEDIT' then do      /* Kedit 5.0 MACROPATH: */
      LAST = PATH( 'kedit.exe',  PATH )   /* Kedit's LAST resort  */
      if macropath.1() = 'ON'  then nop   /* LAST is part of PATH */
      if macropath.1() = 'OFF' then PATH = LAST    /* OFF -> LAST */
   end
   else do                                /* KEDITW not tested... */
      LAST = PATH( 'keditw.exe', PATH )   /* Keditw's LAST resort */
      if LAST > '' then do                /* add \USER & \SAMPLES */
         LAST = LAST || ';' || LAST || 'USER;' || LAST || 'SAMPLES'
      end
      if macropath.1() = 'ON'  then PATH = PATH || LAST
      if macropath.1() = 'OFF' then PATH = ''      /* OFF -> void */
   end
   if wordpos( macropath.1(), 'OFF ON' ) = 0 then do
      PATH = dosenv( macropath.1())       /* use common MACROPATH */
      if PATH > '' & right( PATH, 1 ) <> ';' then PATH = PATH || ';'
      PATH = PATH || LAST                 /* LAST is Kedit's home */
   end
   if PATH = '' then do                   /* sorry: MACROPATH OFF */
      'emsg' FILE 'not found: unknown KEDIT directory'   ; return ''
   end
   PATH = PATH( FILE, PATH )              /* search FILE in PATH  */
   if PATH = '' then do
      'emsg' FILE 'not found in MACROPATH'               ; return ''
   end
   return PATH || FILE

PATH: procedure         /* --- find FILE in PATH with DIR command */
   parse arg FILE, PATH                   /* search FILE in PATH  */
   if sign( pos( '*', FILE )) then return '' /* don't find *.* or */
   if sign( pos( '?', FILE )) then return '' /* similar file id.s */
   'extract /DIRFORMAT/'                     /* adapted DIRFORMAT */
   'nomsg dirformat' max( 8, length( FILE )) max( 3, length( FILE ))

   do while PATH <> ''
      parse var PATH NAME ';' PATH        /* NAME= next directory */
      if right( NAME, 1 ) <> '\' then NAME = NAME || '\'

      'nomsg dir "' || NAME || FILE || '" (noprof'
      if rc <> 0 then iterate             /* ignore bad path NAME */

      do until focuseof()                 /* match dot file NAMEs */
         'next'   ;                 ID = dirfileid.4()
         if dirfileid.5() > '' then ID = ID || '.' || dirfileid.5()
         if translate( ID ) == translate( FILE ) then do
            if ring.0() > 1 then 'quit'   /* found, exit DIR.DIR  */
            'dirformat' DIRFORMAT.1 DIRFORMAT.2
            return NAME                   /* return found path    */
         end
      end

      if ring.0() > 1 then 'quit'         /* go on, exit DIR.DIR  */
   end

   'dirformat' DIRFORMAT.1 DIRFORMAT.2    /* reset user's DIRFORM */
   return ''                              /* not found: ''-string */