Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: PRD.REXX Sprache: REXX

Original von: 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 '#'       */
/*     oder dem Block-Command '##'                            */
/*   - Absetzen von 'prd' in der Command-Zeile                */
/*                                                            */
/* ---------------------------------------------------------- */

   /* trace i */
   Version     = "Version 1.02 vom 01.01.19xx"
   Autor       = "NN"
   Redakteur01 = "JD Drucker U0021515 voreingestellt"
   Redakteur02 = "JD autom. Umschaltung von Hoch- auf Querformat"
   Redakteur03 = "JD Fehler bei Selektion ## beseitigt"
   Redakteur04 = "JD Fehler PROUT beseitigt"
   Redakteur05 = "JD Drucker abhängig von der User-Id",
                 " und Drucken von überlangen Zeilen"
   Redakteur06 = "JD PRD in der Tabellenansicht ermög",
                 "licht."
   Redakteur07 = "JD PRD ist nun auch im ELIPS möglic",
                 "h."
   Redakteur08 = "JD fehlerhaften Close im Rochade be",
                 "handelt."
   Redakteur09 = "JD lange Blankzeilen werden abgekür",
                 "zt."
   Redakteur10 = "JD lange ---------# Zeilen werden",
                 "gekürzt und Fehler ## beseitigt"
   Redakteur11 = "JD Ausgabemessages entfernt ",
                 " "

   /*-----------------------*/
   /* Parameter untersuchen */
   /*-----------------------*/
   arg parm1
   address isredit
   'ISREDIT MACRO (parm1) NOPROCESS'
   if parm1 = "" then
      arg parm1
   parm1 = translate(parm1)
   if parm1 = '?' then do
      call help
      exit
   end
   if parm1 <> 'hoch' & parm1 <> 'quer' & parm1 <> '',
   &  parm1 <> 'HOCH' & parm1 <> 'QUER',
   &  substr(parm1,1,1) <> "'" then do
      call help
      exit
   end

   /*-----------------------*/
   /* Find file in TSO     */
   /*-----------------------*/
   'isredit (dsn) = dataset'
   rc_edi = rc
   if parm1='' & rc_edi > 0 then do
      say "searching for dataset..."
      pvsname=''
      call alist
      do while queued() > 0
         pull p
         if substr(p,1,15)="PVS.TEMP.BROWSE" then do
            pvsname=p
         end
      end
      parm1="'"pvsname"'"
      if pvsname  = '' then do
         say 'Dataset not found'
         exit(4)
      end
      say 'Type to proceed or ''N'' to stop'
      pull answer
      if answer = '' then nop
                     else exit(4)
   end

   /*---------------------------------------------------------*/
   /* Ersatz-Datei mit DSN z.B.= 'ANWJ1.PROUT' (User = anwj1) */
   /*---------------------------------------------------------*/
   user = userid()
   proutdat = '''' !! user !! '.PROUT'''
   print_prout = 0

   /*----------------------------------*/
   /* Ermitteln von Dateiinformationen */
   /*----------------------------------*/
   editor = 1
   if substr(parm1, 1, 1) = "'" then do
      /*-----------------------------------------------*/
      /* Ermitteln von DSN bei Aufruf aus Command Line */
      /*-----------------------------------------------*/
      editor = 0
      dsn_e = 0
      do i = length(parm1) by -1 to 2
         if substr(parm1, i, 1) = "'" then
           dsn_e = i
      end
      dsn = substr(parm1, 2, dsn_e-2)
      full_dsn = "'" !! dsn !! "'"
      mem = ""
      print_prout = 0
      first = 1
      last = 9999
   end
   else do
      /*------------------------------------*/
      /* Ermitteln von DSN und Membername:  */
      /*------------------------------------*/
      'isredit (dsn) = dataset'
      rc_dsn = rc
      'isredit (mem) = member'
      rc_mem = rc
      /*-----------------------------------------------*/
      /* Ermitteln von DSN bei Aufruf aus Editor       */
      /*-----------------------------------------------*/
      if (rc_dsn /= 0 & rc_mem /= 0) ! (dsn = '' & mem = '') then
        /*---------------------------------------*/
        /* Weder DSN noch Membername ermittelbar */
        /*---------------------------------------*/
        print_prout = 1
      else do
        /*---------------------------------------*/
        /* DSN oder Membername bekannt           */
        /*---------------------------------------*/
         print_prout = 0
         first = 1
         last = 9999
         full_dsn = "'" !! dsn !! "'"
         rc_list = listdsi(full_dsn)
         if rc_list /= 0 then do
            if rc_list = 16 then
               print_prout = 1
            else do
               zedsmsg = 'Macro-prd-Error **'
               zedlmsg = 'RC from LISTDSI: ',
                         rc_list ', REASON: ' SYSREASON
               say "zedmsg="zedlmsg
               'setmsg msg(isrz000)'
               exit(12)
            end
         end
         /* Auswerten der Variablen nach erfolgreichem LISTDSI */
         if sysdsorg /= 'PS' then
            full_dsn = "'" !! dsn !! "(" !! mem !!")'"
         if index(dsn,'IKVTEMP') > 0 then do
            'isredit save'
         end
      end
   end


   /*----------------------------------------------------*/
   /* Ermitteln der Satzlänge und Setzen der Seitenlänge */
   /*----------------------------------------------------*/
   rc_list = listdsi(full_dsn)
   if rc_list /= 0 then do
      say "listdsi.rc="rc_list" syslrecl="syslrecl
      if editor = 1 then do
         'isredit (lq) = line' 1
         lrecl = length(lq)
      end
      else
         lrecl = 133
   end
   else
      lrecl = syslrecl
   select
   when lrecl > 87 then do
                          dfcb = "Q321"
                          pagewidth = 133
                        end
   when lrecl <= 87 then do
                           dfcb = "H326"
                           pagewidth = 88
                         end
   otherwise
      nop
   end
   select
   when parm1 = 'quer' ! parm1 = 'QUER' then do
                          dfcb = "Q321"
                          pagewidth = 133
                        end
   when parm1 = 'hoch' ! parm1 = 'HOCH' then do
                           dfcb = "H326"
                           pagewidth = 88
                         end
   otherwise
      nop
   end
   if lrecl >= pagewidth then do
     print_prout = 1
     first = 1
     last = 9999
   end

   /*----------------------------------------------------*/
   /* Ermitteln, welcher Bereich gedruckt werden soll.   */
   /*----------------------------------------------------*/
   if editor = 1 then do
      address isredit
      'isredit process range #'
      select
      when rc = 0   then print_prout = 1
      when rc = 4   then say 'RC from Edit-Cmd PROCESS RANGE = 'rc
      when rc = 8   then say 'RC from Edit-Cmd PROCESS RANGE = 'rc
      when rc = 12  then say 'RC from Edit-Cmd PROCESS RANGE = 'rc
      otherwise          say 'Error on Edit-Cmd PROCESS RANGE, RC = 'rc
                         exit (12)
      end

      'isredit (cmd) = range_cmd'
      select
      when rc = 0   then do
                         say '==> the selected lines will be printed',
                             ' to printer 'userpr()'.'
                         end
      when rc = 4   then
                      do
                         say '==> the whole member will be printed',
                             ' to printer 'userpr()'.'
                      end
      otherwise          say 'Error on Edit-Cmd RANGE_CMD, RC = 'rc
                         exit (12)
      end
      say 'Type to proceed or ''N'' to stop'
      pull answer
      if answer = '' then nop
                     else exit(4)
      'isredit (first) = linenum .zfrange'
      'isredit (last) = linenum .zlrange'
   end

   address tso
   if print_prout = 1 then do
     /*---------------------------------------------------*/
     /* DSN of currently edited Source is not available   */
     /* or Record Length > 133                            */
     /* ==> put the marked lines to the stack, write them */
     /*     to the auxiliary file 'Userid.PROUT' and print*/
     /*     the whole file 'Userid.PROUT'                 */
     /*---------------------------------------------------*/
     'NEWSTACK'             /* get a new stack */
     if editor = 1 then do
       do lnr = first to last by 1
          'isredit (lq) = line' lnr
          if lrecl <= pagewidth+10 then do
            record=' 'substr(lq,1,pagewidth-1)
            /* put current linenr to the stack  */
            queue record
            do j = 1 to length(lq)
              if substr(lq,j,1) <= "4A"X & substr(lq,j,1)<>" " then
                lr=substr(lq,1,j-1)"."substr(lq,j+1,pagewidth-j)
            end
          end
          else do
            /* Zeile  länger als pagewidth */
            /* also aufbrechen             */
            queue ' +++'lnr':'
            do i = 0 while i < lrecl
              lr = substr(lq,i+1, pagewidth-5)
              if i >= pagewidth-5 then do
               if substr(lq,1,10)='---------+' then
                  if substr(lq,11,10)='---------+' then
                     if substr(lq,21,10)='---------+' then
                        lq = substr(lq,1,pagewidth-5)
              end
              do j = 1 to length(lr)
                if substr(lr,j,1) <= "4A"X & substr(lr,j,1)<>" " then
                  lr=substr(lr,1,j-1)"."substr(lr,j+1,pagewidth-5-j)
              end
              record=' 'lr
              if substr(lq,i+1,lrecl) /= ' ' then
                 queue record
              i =i+pagewidth-5-1
            end
          end
       end  /* do lnr = 1 to last */
     end
     else do  /* editor /= 1 */
       'ALLOC F(IN) DA('FULL_DSN') SHR'
       'EXECIO * DISKR IN (FINIS'       /* READ  FILE TO STACK  */
       'FREE F(IN)'
     end
     /* delete previous dataset */
     rc_p=msg('off')
     rc_del = listdsi(proutdat)
     if rc_list = 0 then
        'DEL ('proutdat')'
     if rc <> 0 then say 'rc1='rc
     /* allocate new dataset */
     pw=pagewidth-1
     'ALLOC DA('proutdat') NEW CATALOG SPACE(30,10)',
     'BLKSIZE('pw*10') LRECL('pw')'
     rc_p=msg('on')
     if rc <> 0 then say 'rc2='rc
     /* write the current stack to the file  */
     queue ''
     '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 do
     /*-------------------------------------------------------*/
     /* DSN of currently edited Source has been determined;   */
     /* print the marked lines via TSO-Print-Command directly */
     /*-------------------------------------------------------*/
     if last = 9999 then
       'esfprint dsname('full_dsn') dest('userpr()') fcb('dfcb') '
     else
       '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 being edited: '
say ' Enter ''prd'' on the COMMAND line and type . '
say ' '
say '2. If you what to print only a part of the member being edited: '
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 ' '
say '3. If you want to specify page orientation enter: '
say ' ''prd quer'' for landscape '
say ' ''prd hoch'' for portrait '
say ' '
say '4. If you have a linelength > 132 characters the output will '
say ' be broken into several lines per input line. '
say ' '
say '5. If you have questions about this command, '
say ' contact Hamburg -4244. '
Return

¤ Dauer der Verarbeitung: 0.41 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

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.