Quellcode-Bibliothek ZPRD.REXX Sprache: REXX

/* REXX  */
   /* Drucken des aktuellen Members oder eines ausgewählten      */
   /* Bereichs aus diesem Member.                                */
   /*                                                            */
   /* - Druck des gesamten Members:                              */
   /*   Absetzen von 'prd' in der Command-Zeile                  */
   /*                                                            */
   /* - Druck eines Bereiches:                                   */
   /*   - Markieren des Bereiches mit dem Line-Command '#'       */
   /*   - Absetzen von 'prd' in der Command-Zeile                */
   /*                                                            */
   /*                                                            */
   /* trace ?r */

   Version     = "Version 1.02 vom 01.01.19xx"
   Autor       = "unknown"
   Redakteur1  = "JD Drucker U0021515 voreingestellt"
   Redakteur2  = "JD autom. Umschaltung von Hoch- auf Querformat"
   Redakteur3  = "JD Fehler bei Selektion ## beseitigt"
   Redakteur4  = "JD Fehler PROUT beseitigt"
   Redakteur5  = "JD Drucker abhängig von der User-Id"

   address isredit
  'ISREDIT MACRO (parm1) NOPROCESS'

   parm1 = translate(parm1)
   if parm1 = '?' then
      do
        call help
        exit
      end

   /* Ersatz-Datei mit DSN z.B.= 'ANWj1.PROUT' (User = anwj1) */
   user = userid()
   PROUTDAT = '''' !! user !! '.PROUT'''

   /* Ermitteln von DSN und Membername:  */
   'isredit (dsn) = dataset'
   rc_dsn = rc

   'isredit (mem) = member'
   rc_mem = rc

   address ispexec
   /* Weder DSN noch Membername ermittelbar */
   if (rc_dsn /= 0 & rc_mem /= 0) ! (dsn = '' & mem = '') then
      do
        kz_ersatz = 1
      end
   else
      do
        kz_ersatz = 0
        dsn_listdsi = "'" !! dsn !! "'"
        rc_list = LISTDSI(dsn_listdsi)

        if rc_list /= 0 then
           do
             zedsmsg = 'Macro-prd-Error **'
             zedlmsg = 'RC from LISTDSI: ',
                       rc_list ', REASON: ' SYSREASON
             'setmsg msg(isrz000)'
             exit(12)
           end

        /* Auswerten der Variablen nach erfolgreichem LISTDSI */
        if sysdsorg = 'PS' then
           full_dsn = "'" !! dsn !! "'"
        else
           full_dsn = "'" !! dsn !! "(" !! mem !!")'"
      end


   /* Ermitteln der Satzlänge:  */
   rc = sysdsn(full_dsn)
   lrecl = syslrecl
   if lrecl > 88 then
     dfcb = "Q321"
   else
      dfcb = "H326"

   address isredit
   /* Ermitteln, welcher Bereich gedruckt werden soll.   */
   'isredit process range #'

   select
   when rc = 0   then nop
   when rc = 4   then
                   do
                      say 'RC from Edit-Cmd PROCESS RANGE = 'rc
                   end
   when rc = 8   then
                   do
                      say 'RC from Edit-Cmd PROCESS RANGE = 'rc
                   end
   when rc = 12  then
                   do
                      say 'RC from Edit-Cmd PROCESS RANGE = 'rc
                   end
   otherwise          say 'Error on Edit-Cmd PROCESS RANGE, RC = 'rc
                      exit (12)
   end

   'isredit (cmd) = range_cmd'

   select
   when rc = 0   then nop
   when rc = 4   then
                   do
                      say 'WARNING:'
                      say 'RC from Edit-Cmd RANGE_CMD = 'rc
                      say '==> the whole member will be printed',
                          ' to printer ' userpr() '.'
                      say 'Type to proceed or',
                          '''N'' to stop'
                      pull answer
                      if answer = '' then nop
                                     else exit(4)
                   end
   otherwise          say 'Error on Edit-Cmd RANGE_CMD, RC = 'rc
                      exit (12)
   end

   'isredit (first) = linenum .zfrange'
   'isredit (last) = linenum .zlrange'

   /*
   say 'cmd: 'cmd
   say 'first:  'first
   say 'last :  'last
   */
   address tso

   if kz_ersatz = 1 then
     /* DSN of currently edited Source is not available
        ==> put the marked lines to the stack, write them
            to the auxiliary file 'Userid.PROUT' and print
            the whole file 'Userid.PROUT' */
     do
       'NEWSTACK'             /* get a new stack */
       do lnr = first to last by 1
          /* put current liner to the stack  */
          'isredit (lq) = line' lnr
          queue lq
       end

       /* write the current stack to the file  */
       'ALLOC F(OUT) DA('PROUTDAT') OLD'
       'EXECIO * DISKW OUT (FINIS'       /* write stack to the file */
       'FREE F(OUT)'
       'DELSTACK'                        /* delete stack */
       'esfprint dsname('PROUTDAT') dest('userpr()') fcb('dfcb')'
       rc_pr = rc
       dsn = PROUTDAT
       full_dsn = PROUTDAT
     end
   else
     /* DSN of currently edited Source has been determined;
        print the marked lines via TSO-Print-Command directly */
     do
       'esfprint dsname('full_dsn') dest('userpr()') fcb('dfcb') ',
       'lines('first':'last')'
       rc_pr = rc
     end

   if rc_pr = 0 then
      do
        if mem /= '' then
           say 'Print of Member 'mem' in Dataset 'dsn
        else
           say 'Print of Dataset 'dsn
        say 'from Line 'first' to Line 'last' ended successfully'
        exit(0)
      end
   else
      do
        say 'Error in printing Dataset 'full_dsn
        say 'RC from PRINTDS: 'rc_pr
        exit(8)
      end

HELP:
say ' '
say 'ISPF/PDF edit macro to print the current member on the printer '
say 'with destination ' userpr() ' for user ' userid() '.'
say ' '
say 'To run: '
say '1. If you want to print the whole member beeing editet: '
say ' Enter ''prd'' on the COMMAND line and type . '
say ' '
say '2. If you what to print only a part of the member beeing editet:'
say ' Use the # line command to mark the range to be printed (for '
say ' example: #120 - 120 lines or a block marked by the ## ...## '
say ' command). Type ''prd'' on the COMMAND line to print the '
say ' range. '
say ' '
Return

quality68%

¤ 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.0.15Bemerkung: (vorverarbeitet) ¤

*Bot Zugriff

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.