Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/diushd.b36
There are 4 other files named diushd.b36 in the archive. Click here to see a list.
%TITLE 'DIU Show Defaults Routine'

MODULE DIUSHD (IDENT = '252',
               LANGUAGE(BLISS36),
               ENTRY(SHODEF)
               ) =
BEGIN

!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
!	ALL RIGHTS RESERVED.
!
!	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
!	THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
!	ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
!	AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
!	SOFTWARE IS HEREBY TRANSFERRED.
!
!	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!	EQUIPMENT CORPORATION.
!
!	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
! FACILITY:	DIU    Data Interchange Utility
!
! ENVIRONMENT:  TOPS-20 V6.1    XPORT
!		BLISS-36 V4     FAO-36
!
! ABSTRACT:     This module contains the routine needed to show the DIU
!               defaults chain.
!
! AUTHOR:  Rick Fricchione			CREATED: 21-Feb-1985
! HISTORY:
!
!  252	Remove library of CONDIT.
!	Sandy Clemens  1-Jul-86
!
!  252  Target string for wild match wasn't made ASCIZ, causing  SHOW  DEFAULTS
!       node:: to work strangely.
!       Gregory A. Scott 7-Jun-86
!
!  174  Remove library of TOPS20.
!       Gregory A. Scott 20-May-86
!
!  164  Rename D$SHDF  to SHODEF  and don't  accept an  unused third  argument.
!       Using RMS for terminal IO was causing us problems here too, so don't do
!       it anymore here.
!       Gregory A. Scott 16-May-86
!
!  131  Remove external of diudbg which wasn't referenced and is no longer 
!       used.
!       Gregory A. Scott 28-Apr-86
!
!  117  Make room for the entire 39 character username and account to be
!       displayed.  Repair display of "queued" default.  Adjust columns.
!       Gregory A. Scott 17-Apr-86
!
!  102  Conform SHOW DEFAULTS to make it like show queue (i.e. no version
!       output and time and date on same line).
!       Gregory A. Scott 27-Mar-86
!
!  100  Get version number from .JBVER and print via FAO's !V.
!       Gregory A. Scott 26-Mar-86
!
!    50  Clean up SHOW DEFAULTS (again).
!        Sandy Clemens	4-Nov-85
!
!    40  Put the REQUIRE/LIBRARY of 'TOPS20' into a TOPS-20 only
!        conditional.
!        Sandy Clemens  7-Oct-85
!
!       SC00002 V01-000         Sandy Clemens           20-Sept-1985
!               Fix bug in clearing (zeroing) buffers with CH$FILL.
!
!	RDF0001	V01-000		Rick Fricchione		21-Feb-1985
!               Original version of D$SHDF.  Convert from VAX DIU
!               version (DIU$SHO_DEFAULTS).
!
!--
!************************************************************************
!                        L I B R A R I E S                      
!************************************************************************

! Libraries

LIBRARY 'BLI:XPORT';                    ! XPORT of course
LIBRARY 'FAO';                          ! FAO services
LIBRARY 'DIU';                          ! DIU Data Structures

! Externals

EXTERNAL tty : $XPO_IOB();              ! IOB for the TTY

EXTERNAL ROUTINE wild_match;            ! Wild match routine
!******************************************************************
!                      F A O   O U T P U T
!******************************************************************

LITERAL fao_buf_len = 160;              ! fao_buf size in bytes

OWN fao_desc : $STR_DESCRIPTOR(CLASS=BOUNDED),
    fao_buf :  VECTOR[CH$ALLOCATION(fao_buf_len)];

! Macro to print a FAOized string to the terminal

MACRO $put_fao (control) = 

      BEGIN

      LOCAL fao_ctl : $STR_DESCRIPTOR(STRING=%STRING(control,%CHAR(13,10)));

      $STR_DESC_INIT(DESC=fao_desc,           ! Re-init the buffer
                     CLASS=BOUNDED,
                     STRING=(fao_buf_len,CH$PTR(fao_buf)));

      $FAO(fao_ctl,0,fao_desc,%REMAINING);    ! Format string

      $XPO_PUT(IOB=tty,                       ! Slurp to terminal
               STRING=fao_desc);

      END %;

! Own strings are for output below 

OWN defer :  VECTOR[4] INITIAL(CH$PTR(UPLIT(%ASCIZ'No')),
                               CH$PTR(UPLIT(%ASCIZ'Yes')),
                               CH$PTR(UPLIT(%ASCIZ'Conditional'))),

    notify : VECTOR[5] INITIAL(CH$PTR(UPLIT(%ASCIZ'None')),
                               CH$PTR(UPLIT(%ASCIZ'Terminal')),
                               CH$PTR(UPLIT(%ASCIZ'Mail')),
                               CH$PTR(UPLIT(%ASCIZ'IPCF')));

LITERAL notify_max = 3;
!******************************************************************
!                         S H O _ N O D E
!******************************************************************
ROUTINE SHO_NODE (default : REF $DEF_DECL,
                  default_seen)                    : NOVALUE = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine dumps the default block given to the terminal.
!
! FORMAL PARAMETERS
!
!       default      - Address of default node
!       default_seen - flag indicating that we have been called once
!
! IMPLICIT PARAMETERS
!
!	All of the OWN storage at the module level.
!
!--

BIND nodespec = default[DEF$D_NODE]     : $STR_DESCRIPTOR(),
     user     = default[DEF$D_USER]     : $STR_DESCRIPTOR(),
     account  = default[DEF$D_ACCOUNT]  : $STR_DESCRIPTOR(),
     password = default[DEF$D_PASSWORD] : $STR_DESCRIPTOR(),
     log_file = default[DEF$D_LOG]      : $STR_DESCRIPTOR();

$TRACE('SHO_NODE');

! Print the banner but once...

IF NOT .default_seen
THEN $PUT_FAO('!/!AZ!2(_)!%D!/Session Defaults Display!/',
              diu$$system_banner,0);

! Print the username, or tell them none specified or we will prompt for it soon
! For some reason the compiler thinks nodespec as an initial value means 0.


IF $STR_EQL(STRING1=user,STRING2=PROMPT_STRING)
THEN $PUT_FAO('!10<!AS::!>Username: <prompt>',nodespec)
ELSE IF .user[STR$H_LENGTH] NEQ 0 
     THEN $PUT_FAO('!10<!AS::!>Username: !AS',nodespec,user)
     ELSE $PUT_FAO('!10<!AS::!>Username: <none specified>',nodespec);

! Tell me the account if you know it, or at least if you are prompting for one

IF $STR_EQL(STRING1=account,STRING2=PROMPT_STRING)
THEN $PUT_FAO('!_  Account:  <prompt>')
ELSE IF .account[STR$H_LENGTH] NEQ 0 
     THEN $PUT_FAO('!_  Account:  !AS',account)
     ELSE $PUT_FAO('!_  Account:  <none specified>');

! Tell me about the password; are you prompting, none specified, or do you know

IF $STR_EQL(STRING1=password,STRING2=PROMPT_STRING)
THEN $PUT_FAO('!_  Password: <prompt>')
ELSE IF .password[STR$H_LENGTH] NEQ 0 
     THEN $PUT_FAO('!_  Password: <specified>')
     ELSE $PUT_FAO('!_  Password: <none specified>');

! Now please tell him about the defaut log file for this request.

IF .log_file[STR$H_LENGTH] NEQ 0
THEN $PUT_FAO('!_  Log File: !AS',log_file)
ELSE $PUT_FAO('!_  Log File: <none specified>');

! Next tell the guy about the default notification method and queueing default.

IF .default[DEF$B_NOTIFY] GTR notify_max THEN SIGNAL(DIU$_BUG);
$PUT_FAO('!_  Notify:   !16AZ!_Queued:   !AZ',
         .notify[.default[DEF$B_NOTIFY]],
         .defer[.default[DEF$B_DEFER]]);

! Print a blank line, free that memory and then return.

$PUT_FAO(' ');

END;                                    ! SHO_NODE
!******************************************************************
!                           S H O D E F
!******************************************************************
GLOBAL ROUTINE SHODEF(p_root, p_node) : NOVALUE = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!       List on  the  terminal the  default  table entries.   The  passed  root
!       address is the  start of  the default chain.   The passed  node is  the
!       address of a ASCIZ string that is  to be matched for the listing.   The
!       output always goes to the terminal.
!
! FORMAL PARAMETERS:
!
!       root: Address of defaults root list.
!       node: Address of ASCIZ node spec (possibly wild).
!
! ROUTINE VALUE
!
!	DIU$_NORMAL: successful display of request block
!
!--

BIND default_root = .p_root  : $DEF_DECL,
     node = .p_node;

LOCAL flag : INITIAL(0),
      target : VECTOR[CH$ALLOCATION(10)],
      wild_desc : REF $STR_DESCRIPTOR(),
      default : REF $DEF_DECL;

! Point to head of chain, zero buffer

default = default_root;
CH$FILL(0,10,CH$PTR(target));

! Set up for wildcard match

$TRACE_FAO('SHODEF pattern given is !AZ',CH$PTR(node));

! Loop through the node table and display whatever matches.

DO BEGIN
 
    BIND wild_desc = default[DEF$D_NODE] : $STR_DESCRIPTOR();

    CH$COPY(.wild_desc[STR$H_LENGTH],.wild_desc[STR$A_POINTER], ! Source
            0,                                                  ! Fill 0
            10,CH$PTR(target));                                 ! Destination

    $TRACE_FAO('SHODEF Comparing pattern with !AZ', CH$PTR(target));

    IF WILD_MATCH(CH$PTR(node),CH$PTR(target))
    THEN BEGIN
         SHO_NODE(.default,.flag);
         flag = true;
         END;

    END UNTIL (default = .default[DEF$A_NXT]) EQL 0;

! Print message if nothing matched.

IF NOT .flag
THEN $PUT_FAO('?DIU command error: No defaults match node "!AZ"',CH$PTR(node));

END;                                    ! SHODEF
END 
ELUDOM