Quelle ZFIRALL.REXX Sprache: REXX

/* REXX */
/*   Erstes Vorkommen eines Strings im aktuellen Member finden      */
/*   und Häufigkeit des Vorkommens anzegen                          */
/*   in Entwicklung durch Katja Wallowy                             */
/*   ----------------------------------------------------------     */
'ISREDIT MACRO (parm1)'

   'isredit (dsn) = DATASET'     /* name of current dataset  */
   'isredit (mem) = MEMBER'      /* name of current member   */

/* Set some variables :  */
   user     = userid()

address ispexec
'isredit (,col) = CURSOR'

parm1 = translate(parm1)
if parm1 = 'T' then
   trace ?R

  /*trace a*/
if col = 0 then
   do
     zedsmsg = 'Invalid cursor position'
     zedlmsg = 'Please, set the cursor in the Edit Area'
     'setmsg msg(isrz001)'
     exit(12)
   end

'isredit (topline, botline) = DISPLAY_LINES'
rc_dl = rc
if  rc_dl /= 0 then
    do
      zedsmsg = 'DISPLAY_LINES Error'
      zedlmsg = 'Range of display lines could not be determined ',
                'RC form DISPLAY_LINES = ' rc_dl
      'setmsg msg(isrz000)'
      exit(14)
    end

'isredit (maxcol) = DATA_WIDTH'
rc_dataw = rc
if  rc_dataw /= 0 then
    do
      zedsmsg = 'LRECL not determined'
      zedlmsg = 'Data-width could not be determined, RC = ',
                 rc_dataw
      'setmsg msg(isrz000)'
      exit(16)
    end

'isredit (line) = LINE .ZCSR'
rc_linec = rc
if  rc_linec /= 0 then
    do
      zedsmsg = 'Current line not determined'
      zedlmsg = 'Current line was not determined, RC = ',
                 rc_linec
      'setmsg msg(isrz000)'
      exit(20)
    end

i = 0

/* An den Anfang des Names gehen, bis SPACE, Hochkomma oder     */
/* Punkt gefunden */
do i = col  to 1 by -1 ,
   while  ( substr(line, i, 1) /= " " ) & ,
          ( substr(line, i, 1) /= "'" ) & ,
          ( substr(line, i, 1) /= "," )
    nop
end

/* Wenn Name am linken Rand steht, war Auswahl falsch */
if i = 1 then
   do
     zedsmsg = 'Invalid select'
     msg = 'Please, set the cursor on the Copy-Member to be edited'
     zedlmsg = msg
     'setmsg msg(isrz001)'
     exit(12)
   end

/* set index on first character of name  */
col_anf = i + 1

/* Ausgehend von Spalte col den nä. space, das nä. Hochkomma,   */
/* den nä. punkt oder das nä. Komma suchen                      */
do i = col_anf  to maxcol by 1 ,
   while  ( substr(line, i, 1) /= ' ' ) & ,
          ( substr(line, i, 1) /= "'" ) & ,
          ( substr(line, i, 1) /= '.' ) & ,
          ( substr(line, i, 1) /= ',' )
    nop
end

/* set index on last  character of name  */
col_end = i - 1

/* compute length of name and evaluate name   */
col_len = col_end -col_anf + 1
name    = substr(line, col_anf, col_len)


/* find all occurence of string determined by variable 'name'  */
'isredit find 'name' all'
rc_find = rc

/* Return-Code of find-command */
/* kwy: RC=0 Meldg noch nicht richtig */
/* kwy: Anzahl fehlt noch */
end_fir:
select
  when rc_find = 0 then
    do
      zedsmsg = 'All CHARS '''name''''
      zedlmsg = 'First occurence of string '''name''' found'
      'setmsg msg(isrz000)'
    end
  when rc_find = 4 then
    do
      zedsmsg = 'CHARS '''name''' not found'
      zedlmsg = 'The string '''name''' was not found'
      'setmsg msg(isrz000)'
    end
  when rc_find = 12 then
    do
      zedsmsg = 'Syntax Error'
      zedlmsg = 'Syntax-Error - command: FIND 'name' ALL'
      'setmsg msg(isrz001)'
    end
  otherwise
    do
      zedsmsg = 'Critical Error'
      zedlmsg = 'Find-Command RC: 'rc_find
      'setmsg msg(isrz001)'
    end
end

exit(rc)

quality47%

¤ Dauer der Verarbeitung: 0.12 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.