Google
 

Trailing-Edge - PDP-10 Archives - bb-r775d-bm_tops20_ks_upd_4 - sources/help.bli
There are 10 other files named help.bli in the archive. Click here to see a list.
 %TITLE 'HELP - process the HELP commands'
MODULE HELP (				! Process the HELP commands
		IDENT = '3-014'			! File: HELP.BLI Edit: CJG3014
		) =
BEGIN
!
!			  COPYRIGHT (C) 1983, 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!		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 WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
!	Process the HELP commands.
!
! ENVIRONMENT: TOPS-20 only
!
! AUTHOR: Bob Kushlis, CREATION DATE: 13-OCT-1979
!
! MODIFIED BY:
!
! 2-005	- Regularized headers and made PIC.  JBS 24-Feb-1981
! 2-006	- Fix module name.  JBS 05-Mar-1981
! 2-007	- Use new message codes.  JBS 04-Aug-1981
! 2-008 - Add new message for no help on a key.  SMB 19-Nov-1981
! 2-009 - Add new global for help file name and default. SMB 17-Dec-1981
! 2-010	- Print a message on close errors.  JBS 12-Apr-1982
! 2-011	- Return a value from setting the help file name.  JBS 04-May-1982
! 2-012 - Change default processing for SET HELP.  SMB 25-May-1982
! 3-001 - Rewrite most of this for TOPS-20. CJG 23-Feb-83
! 3-002 - Add FMT_FREE to improve speed of format routines. CJG 11-Jan-1984
!--

!<BLF/PAGE>
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$OUT_HLP : NOVALUE,
    EDT$$SET_HLPFNAM;

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

REQUIRE 'SYS:JSYS';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!

OWN
    HELP_FAC : INITIAL (%ASCIZ'EDT'),
    JFN_BLK : VECTOR [9] INITIAL (GJ_OLD,	! GTJFN argument block
			$NULIO*%O'1000001',
			REP 7 OF (0));

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    HELPER : FORTRAN_FUNC,
    EDT$$OUT_FMTBUF,
    EDT$$FMT_STR,
    EDT$$FMT_CRLF,
    EDT$$FMT_MSG,
    EDT$$MSG_TOSTR;

EXTERNAL
    HDEF_NAM : BLOCK,			! Help file default specs
    HELP_NAM,
    HELP_NAMLEN,
    HELP_SET,
    TEMP_BUFFER,
    FMT_FREE,				! Space left in format buffer
    TI_WID;

MESSAGES ((NOHLPAVL, HLPFILCLO, FILNAM, NOKEYHLP, INVSTR));
%SBTTL 'EDT$$OUT_HLP  - HELP command'

GLOBAL ROUTINE EDT$$OUT_HLP (			! HELP command
    STRING, 					! Address of HELP command arguments
    LENG, 					! Length of those arguments
    ADDITIONAL					! 1 = print key names and additional help
    ) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Process the HELP commands.
!
! FORMAL PARAMETERS:
!
!  STRING		Address of the text string that contains the HELP arguments
!
!  LENG			Length of that string
!
!  ADDITIONAL		1 = print key names and additional help
!
! IMPLICIT INPUTS:
!
!	HELP_SET
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	Calls EDT$$SET_HLPFNAM  if it has not already been called.
!
!--

    BEGIN

    LOCAL
	HELP_STATUS;				! Has the Help File been opened

!+
! If HELP_SET then the help file has already been opened, so
! set HELP_STATUS
!-

    IF ( .HELP_SET EQL 0)
    THEN
	HELP_STATUS = EDT$$SET_HLPFNAM (CH$PTR (HELP_NAM),
			    .HELP_NAMLEN)
    ELSE
	HELP_STATUS = 1;

    IF (.HELP_STATUS)
    THEN
	BEGIN

	LOCAL
	    HELP_VAL,			! Temp storage for value pointer
	    HELP_FLAGS;			! Flags for HELPER

!+
! Set the relevant flags for HELPER - don't do the title or extras
! if this is keypad mode.
!-
	HELP_FLAGS = .TI_WID + %O'400000000000';
	IF (.ADDITIONAL EQL 0)
	    THEN
		HELP_FLAGS = .HELP_FLAGS + %O'300000000000';

	IF (.LENG EQL 0)
	    THEN
!+
! If no command was given, default to 'HELP'.
!-
		HELP_STATUS = HELPER (UPLIT (%ASCIZ'HELP'),
				HELP_FAC,
				HELP_SET,
				HELP_FLAGS)
	    ELSE
!+
! Copy the command so that it is ASCIZ, and get the help for it.
!-
		BEGIN
		CH$WCHAR (0, CH$MOVE (.LENG, .STRING,
				CH$PTR (TEMP_BUFFER)));
		HELP_STATUS = HELPER (TEMP_BUFFER,
				HELP_FAC,
				HELP_SET,
				HELP_FLAGS);
		END;

!+
! Type a message if any errors were returned from HELPER
!-

	IF ((.HELP_STATUS EQL 1) OR (.HELP_STATUS EQL 2))
	    THEN
		EDT$$FMT_MSG (EDT$_NOHLPAVL);

	IF ((.HELP_STATUS EQL 3) OR (.HELP_STATUS EQL 4))
	    THEN
		EDT$$FMT_MSG (EDT$_NOKEYHLP);

!+
! And output any remaining characters.
!-

	IF (.FMT_FREE NEQ FMT_BUFLEN) THEN EDT$$OUT_FMTBUF ();

	END;

    END;

!<BLF/PAGE>
%SBTTL 'EDT$$SET_HLPFNAM  - set help library name'

GLOBAL ROUTINE EDT$$SET_HLPFNAM (		! Set help library name
    ADDR, 					! Address of new HELP library name
    LEN						! Length of that name
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Set the name of the help library.  Attempt an open to force a
! 	parse of the name and return an error if no help available.
!
! FORMAL PARAMETERS:
!
!  ADDR			Address of new HELP library name
!
!  LEN			Length of that name
!
! IMPLICIT INPUTS:
!
!	HELP_NAM
!	HELP_NAMLEN
!	HELP_SET
!	LBR_INDEX
!
! IMPLICIT OUTPUTS:
!
!	HELP_NAM
!	HELP_NAMLEN
!	HELP_SET
!	LBR_INDEX
!
! ROUTINE VALUE:
!
!	1 = success
!	0 = invalid string
!
! SIZE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    LOCAL
	TEMP_PTR,				! Pointer returned from JFNS
	HELP_DESC : VECTOR [2],			! Descriptor for help name
	RESULT_DESC : VECTOR [2];		! Resultant help file name

    IF (.LEN NEQ 0)
    THEN
	BEGIN
	HELP_DESC [0] = .LEN;
	HELP_DESC [1] = .ADDR;
	END
    ELSE
!+
! No file name was given, so restore it to the default help file
!-
	BEGIN
	HELP_DESC [0] = .HDEF_NAM [DSC$W_LENGTH];
	HELP_DESC [1] = CH$PTR (.HDEF_NAM [DSC$A_POINTER]);
	END;

!+
! See if the old jfn can be released, return an error if not.
!-

    IF ( .HELP_SET NEQ 0) THEN
	IF ( NOT _RLJFN ( .HELP_SET)) THEN
	    BEGIN
	    EDT$$FMT_MSG (EDT$_HLPFILCLO);
	    RETURN (0)
	    END;

!+
! Set up the resultant help file name descriptor
!-
    RESULT_DESC [0] = 0;
    RESULT_DESC [1] = CH$PTR (TEMP_BUFFER);

!+
! Attempt to open the help library.
!-

    CH$WCHAR (0, CH$MOVE (.HELP_DESC [0], .HELP_DESC [1], CH$PTR (TEMP_BUFFER)));
    IF ( NOT _GTJFN (JFN_BLK, CH$PTR (TEMP_BUFFER); HELP_SET))
    THEN
	BEGIN
	HELP_SET = 0;			! Next time re-open the old help file
	EDT$$FMT_MSG (EDT$_NOHLPAVL);
	EDT$$MSG_TOSTR (EDT$_FILNAM);
	EDT$$FMT_STR (.HELP_DESC [1], .HELP_DESC [0]);
	EDT$$OUT_FMTBUF ();
	RETURN (0);
	END;

!+
! Get the full filespec corresponding to any defaults
!-

    _JFNS ( CH$PTR (TEMP_BUFFER), .HELP_SET, K_JFNS ; TEMP_PTR );
    RESULT_DESC [0] = CH$DIFF ( .TEMP_PTR, CH$PTR (TEMP_BUFFER));

!+
! Store the new Help File name and name length in the globals
!-

    CH$MOVE ( .RESULT_DESC [0], CH$PTR (TEMP_BUFFER), CH$PTR (HELP_NAM));
    HELP_NAMLEN = .RESULT_DESC [0];
    RETURN (1);
    END;					! of routine EDT$$SET_HLPFNAM
!<BLF/PAGE>
END						! of module EDT$HELP

ELUDOM