Google
 

Trailing-Edge - PDP-10 Archives - tops20tools_v6_9-jan-86_dumper - tools/locate/locate.for
There are 5 other files named locate.for in the archive. Click here to see a list.
	PROGRAM locate
C
C	Change or display information regarding a user's default printer.
C
C	Created:	28-July-82 QCJ
C	Last Modified:	25-Jan-83 QCJ
C
	INCLUDE	    'locdef.inc/list'

	CHARACTER*80	arg,device
C
C	Get the argument the user passed.
C
	istat=CLI$GET_VALUE('ARG',arg)
C	IF(.NOT.istat)CALL LIB$STOP(%VAL(istat))
	f_fast=CLI$PRESENT('BRIEF')
	f_log=CLI$PRESENT('LOG')
C
C	Determine action.
C
	IF(arg.EQ.' ')THEN
	    istat=SYS$TRNLOG('SYS$PRINT',device_l,device,,,)
	    IF(.NOT.istat)CALL LIB$STOP(%VAL(istat))
	    IF(f_log)THEN
		TYPE*,'Your default printer location is currently:'
	        TYPE*
	    ENDIF
	    loc=find_loc(device(1:device_l))
	    IF(loc.NE.-1)THEN
		CALL show_loc(loc,f_fast)
	    ELSE
		IF(f_log)THEN
		    TYPE*
		    TYPE*,'	'//device
		    TYPE*
		    TYPE*,'Which is not a valid location'
		ELSE
		    TYPE*,'Current location invalid '//device
		ENDIF
	    ENDIF
	    IF(f_log)THEN
	        TYPE*
                TYPE*,'Valid locations are:'
	        TYPE*
	        DO loc=0,loc_max-1
	            CALL show_loc(loc,f_fast)
	        ENDDO
	    ENDIF
	ELSE
	    loc=find_loc(arg)
	    IF(loc.NE.-1)THEN
	        IF(f_log)THEN
	            TYPE*,'Your default printer is now:'
		    TYPE*
		    CALL show_loc(loc,f_fast)
		ENDIF
		istat=LIB$SET_LOGICAL
	1	    ('SYS$PRINT',queue(loc)(1:QCJ_TRIM(queue(loc))))
	    ELSE
	        IF(f_log)THEN
		    TYPE*
		    TYPE*,'    '//arg(1:QCJ_TRIM(arg))//' is not a valid location'
		    TYPE*
	            TYPE*,'Valid locations are:'
		    TYPE*
	            DO loc=0,loc_max-1
	                CALL show_loc(loc,f_fast)
	            ENDDO
		ELSE
		    TYPE*,arg(1:QCJ_TRIM(arg))//' is not valid'
		ENDIF
	    ENDIF
	ENDIF

	END

	INTEGER*4 FUNCTION show

	INCLUDE	    'locdef.inc'

	CHARACTER*(*)	token

	ENTRY find_loc(token)

	    l=0
	    found=.FALSE.
	    DO WHILE (l.LE.loc_max-1.AND..NOT.found)
		tok=1
		DO WHILE (tok.LE.n_tokens(l).AND..NOT.found)
		    found=token.EQ.tokens(l,tok)
		    tok=tok+1
		ENDDO
		l=l+1
	    ENDDO
	    IF(.NOT.found)THEN
		find_loc=-1
	    ELSE
		find_loc=l-1
	    ENDIF

	RETURN

	ENTRY show_loc(loc,f_fast)
	    TYPE00102
	1	,loc
	2       ,queue(loc)(1:QCJ_TRIM(queue(loc)))
	3	,place(loc)(1:QCJ_TRIM(place(loc)))
00102	    FORMAT(
	2       X'    Location 'I2' -- Line Printer 'A' -- 'A
	5       )
	    IF(.NOT.f_fast)THEN
	        TYPE00101
	2           ,(text(loc,line)
	3           (1:QCJ_TRIM(text(loc,line))),line=1,n_text_lines(loc))
00101	        FORMAT(
	4           <n_text_lines(loc)>(/X,8X,A)
	1           ,/
	5           )
	    ENDIF

	RETURN

	END