Trailing-Edge
-
PDP-10 Archives
-
integ_tools_tops20_v7_30-apr-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