Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - tvedit/getfil.sai
There are no other files named getfil.sai in the archive.
	!
	Copyright (c) 1977 by Pentti Kanerva
	All rights reserved
	;

COMMENT On Tenex, file extensions are ended with semicolon, not .;


COMMENT  "GETFIL" hosts procedures: "OPTION", "GETFILE", "OPENNEW", and
	  ------       then some.
	 ;


INTEGER SUBROUTINE	option (STRING opts, help);
!			------
	General purpose (almost) dialog to get a valid option.
	The option characters in "OPTS" are presented first.
	"OPTS" are the valid responses (excluding "?").  Letters must
	  be in upper case.
	"?" evokes printing of the "HELP" and looping back.  Help
	  should tell what this is all about.

	EXAMPLE:  n _ option("NO","N for new, O for old")

	Returns the valid option character.
	;
FOREVER  DO
BEGIN "option" INTEGER reply, ch; STRING str; BOOLEAN helpful;
   helpful _ nonEmpty (help);

 ! Present the probe;
   str _ opts & (IF helpful THEN "?" ELSE NIL);
   outStr ("
Type  " & lop(str));

   WHILE (ch _ lop(str))  
   DO outStr((IF empty(str) THEN " or " ELSE ", ") & ch)
   ;
   outStr("  *");

 ! Wait for the answer;
   DO reply _ INCHRW LAND '177  UNTIL reply AND reply NEQ '15;
   outstr (EOLstr);  ! Acknowledge;

 ! Check for valid answer;
   str _ opts;

   IF (reply _ upperCase (reply)) = "?"  THEN outStr (help)
   ELSE WHILE (ch _ lop(str))
   DO IF upperCase(ch) = reply  THEN RETURN (ch)
   ;
END "option" ! FOREVER; 
;
INTEGER SUBROUTINE	getCase (STRING options);
!			-------
	Gets empty answers, designated one-letter answers, and
	  answer strings.
	OPTIONS is a string of one-letter answers, in upper case.
	Returns:
	  0  for empty answer string
	  i  for one-letter reply thet is the ith character of OPTIONS
	  LENGTH(OPIONS)+1  for other non-empty answer strings.
	Sets global variables:
	  CHAR  to valid single letter option, if got.
	  ANSWER  to answer string, if not one-letter anser.
	  RUSHED  to  TRUE  if ESC terminates, o.w. not changed.
	;
BEGIN "getCase" INTEGER ch, gtCs;

	SUBROUTINE  testOpts (STRING opts);
	!	    --------;
	BEGIN
	   char _ upperCase (char);  gtCs _ 0;
	   DO inc(gtCs)  UNTIL NOT (ch _ lop(opts)) OR ch = char;
	END
	;

			! +  +  +  + ;

	
   char _ INCHRW LAND '177;  testOpts (options);

   IF NOT ch  THEN  ! 1st input not one of option letters;
   BEGIN
      BKJFN ('100);  scan (answer _ INCHWL, br.sBl, char);

      IF empty (answer)  THEN gtCs _ 0
      ELSE IF length (answer) = 1  THEN testOpts (options)
      ;
   END
   ;
 ! Look at terminator;
   BKJFN ('100);  IF INCHRW LAND '177 = ESC  THEN rushed _ TRUE;  
   RETURN (gtCs);
END "getCase"
;
FORWARD BOOLEAN SUBROUTINE	readsStrings  (INTEGER pg);
FORWARD BOOLEAN SUBROUTINE	writesStrings (INTEGER pg);


SUBROUTINE	relSPage;
!		--------
	Remove string page form fork, release string file JFN.
	;
BEGIN "relSPage"

   START!CODE
	seto	1,;
	hrlzi	2, '400000;
	hrri	2, sBufPage;
	setz	3,;
	PMAP;
   END
   ;
   closeFile (strChan);
END "relSPage"
;


SUBROUTINE	remSPage;
!		--------
	Remove (unmap) SPAGE from STRINGFILE.
	;
START!CODE
	seto	1,;
	hrlzi	2, '400000;
	hrri	2, sBufPage;
	setz	3,;
	PMAP;			! First remove page from fork..;

!	seto	1,;
	hrlz	2, strJfn;
	hrr	2, sPage;
!	setz	3,;
	PMAP;			! ..then from file;
END
;
BOOLEAN SUBROUTINE	mapsSPage (INTEGER pg; BOOLEAN wr);
!			---------
	Map appropriate page of STRINGFILE to SBUFPAGE of fork.
	PG = 0 makes it a no-op.
	
	A leq PG leq Z  to use PG, 
        PG = .  to use last non-0 page (OLDPG),
	  o.w. use page 0.
	WR  means map to write, o.w. map to read.

	Globals affected:  STRCHAN, STRJFN, STRPAGE, GOTSTRINGS.
	Returns TRUE  iff  succesful.
	;
IF NOT pg  THEN RETURN (TRUE)
ELSE
BEGIN "mapsSPage" OWN INTEGER oldPg;
   strJfn _ cvJfn (strChan _ GTJFN (stringFile, IF wr THEN '1000000
						ELSE  '100001000000) );
   IF !skip!  THEN RETURN (FALSE);

   OPENF (strChan, IF wr THEN '300000 ELSE '200000);

   IF !skip!  THEN
   BEGIN  
      outStr ("
'" & stringFile & "' ...");  errMes;
      If not wr Then gotStrings _ false;
      closeFile (strChan);  RETURN (FALSE);
   END
   ;

 ! Determine STRINGFILE page number, map file page to fork;

   sPage _ IF "A" LEQ pg LEQ "Z" THEN (oldPg _ pg)
	   ELSE IF pg = "." THEN oldPg ELSE 0;

   START!CODE
    ! Map string page to current fork;
	hrlz	1, strJfn;	! From string file;
	hrr	1, sPage;
	hrlzi	2, '400000;	! To current fork;
	hrri	2, sBufPage;
	hrlzi	3, '100000;	! Prepare to read;
	skipe	 wr;		! Is it WRite?;
	 hrlzi	3, '040000;	!  Yes, write instead;
	PMAP;

    ! Does the page exist?;
	setzm	 !skip!;
	RPACS;			! AC1 is already loded;
	tlnn	2, '010000;
	 setom	 !skip!;	! No such page;
   END
   ;
   If not wr Then
    IF !skip! Then
     Begin
	If sPage = 0 Then gotStrings _ true;
	relSPage; RETURN (FALSE)
     End
    Else gotStrings _ true
   ;
   RETURN (TRUE);
END "mapsSPage"
;
BOOLEAN SUBROUTINE	getsMode (REFERENCE INTEGER md);
!			--------
	MD = L or U is shown as W, and reply = W is converted to L.
	;
BEGIN "getsMode"
   FOREVER DO
   BEGIN
      outStr ("
(Mode:  W or R) ");

      IF md
       THEN outStr (If md = "L" or md = "U" Then "W// " Else (md & "// "));

      CASE getCase ("LUWR^?")  OF
      BEGIN
	 IF md  THEN RETURN (TRUE);
	 DONE;	! L;
	 DONE;	! U;
	 DONE;	! W;
	 DONE;	! R;
	 RETURN (FALSE);

	 outStr ("

  The options are:

    W  to Write and edit the file (subsumes former options L and U),
    R  to Read only--a safe and fast way to view the file,

    RETURN or ESC to use standard option if available, and

    ^  to start over.
")	 ;
	 ;  ! Anything else: try again;
      END ! of CASE;
      ;
   END ! of FOREVER;
   ;
 ! L, U, W, and R  fall through.  Acknowledge;
   outStr (eolStr);  If (md _ char) = "W" Then md _ "L";  RETURN (TRUE);
END "getsMode"
;
BOOLEAN SUBROUTINE	getsPlaces (REFERENCE STRING pl);
!			----------
	Starting Page.Line specification.
	;
FOREVER DO
BEGIN "getsPlaces"
   outStr ("
(Page.Line) " & pl & "// ");

   CASE getCase ("^?@")  OF
   BEGIN
      RETURN (TRUE);	! Empty answer, accept default;
      RETURN (FALSE);	! ^--go back;
      outStr ("

  You can specify places to edit by giving the Page and the Line.  
  ""@"" command takes through successive items of the Page.Line
  list.  Use spaces or commas to separate list items, periods to 
  separate the page and line numbers of an item.  Example:

	7.11 15.5 10 12,22.7,30.5

     The place list can also be accepted from a text file.  XSEARCH
  program creates appropriate 'xxx.PL' files.

  Type Page.Line list, or type
    RETURN or ESC key for the default (the place of last finish),
    @  to get the place list from a .PL file, or
    ^  to start over.
")    ;
      BEGIN "@" INTEGER plChan; STRING plFile; 
	 outStr (eolStr);  ! Ack;
	 plChan _ OPENFILE (plFile _ #name&".PL", "ORE");

	 IF NOT !skip!  THEN
	 BEGIN
	    SETINPUT (plChan, 1000, char, junk);
	    pl _ INPUT (plChan, br.FF);
	    closeFile (plChan);  RETURN (TRUE);
	 END
	 ELSE outStr ("  File '" & plFile & "' not found.
");
      END "@"
      ;
      BEGIN pl _ answer; RETURN (TRUE) END;  ! List;
   END ! of CASE;
   ;
END "getsPlaces" ! of FOREVER; 
;
BOOLEAN SUBROUTINE	wantsSOS (REFERENCE INTEGER fate);
!			--------
	What to do with an SOS file?.
	;
BEGIN "wantsSOS"
   FOREVER DO
   BEGIN
      outStr ("
(SOS line numbers:  D or R) " & fate & "// ");

      CASE getCase ("DR^?")  OF
      BEGIN
	 RETURN (TRUE);  ! Empty, accept default;
	 DONE;
	 DONE;
	 RETURN (FALSE); ! ^;

	 outStr ("

 SOS file is first copied and converted to TV file (the SOS file
 stays as old file).

 Type
   D - to Delete SOS line numbers while copying,
   R - to Retain SOS line numbers, but convert them to normal text
       (R  is useful for BASIC programmers),
   ^ - to not edit this file after all.
")    	 ;
	 ! Anything else:  Try again;
      END ! of CASE;
      ;
   END ! of FOREVER;
   ;
   outStr (eolStr);  fate _ char;  RETURN (TRUE);
END "wantsSOS"
;
FORWARD BOOLEAN SUBROUTINE	okToEdit;


SUBROUTINE	getFile (STRING name, places; INTEGER mode);
!		-------
	Sets INCHAN, FILENAME, NEWFILE, OWNFILE, UCFILE, and READONLY, 
	  and opens the file.
	If NAME is non-empty, tries to get the named file.
	If MODE is non-0, it must be valid:  L, U, W, or R.
	Non-empty name + non-0 mode mean:  this is an RPGSW call and
	  wants to go directly to edit.
	Returns only after file is properly opened.
	;
BEGIN "getFile" BOOLEAN accepted;
IFC tops20.sw THENC
	IF empty (name) AND RSCAN 
	  THEN
	    BEGIN "parsecommand"
	    STRING line,atom,breaks;
	    line _ INTTY;
	    SCAN(line,br.findatom,junk); ! skip command name;
	    SCAN(line,br.scanatom,junk);
	    DO
	      BEGIN
	      breaks _ SCAN (line,br.findatom,junk);
	      atom _ SCAN (line,br.scanatom,junk);
	      IF empty(atom) 
		THEN
	      ELSE IF first(atom) = "("
		THEN
	      ELSE IF last(breaks) = "/"
		THEN mode _ first(atom)
	      ELSE IF empty(name)
		THEN name _ atom
	      END
	     UNTIL empty(line)
       	    END;
ENDC ! Tops20 RSCAN for TVEDIT /switch filename;
   IF rushed _ accepted _ nonEmpty (name)  THEN
   BEGIN
      sameFile _ FALSE;
      fileName _ name;  filePlaces _ places;  fileMode _ mode;
   END
   ELSE
   BEGIN
      IF (NOT (sameFile _ nonEmpty (fileName))) AND oldInFile
IFC tops20.sw THENC
      THEN BEGIN INTEGER tempChan;  ! strip the version number;
      fileName _ JFNS(tempChan _ GTJFN (oldInFile, '43000000), '111100000001);
      RLJFN (tempChan)
      END
ELSEC
      THEN fileName _ scan (oldInFile, br.dot, junk)&"."&scan (oldInFile, br.semi, junk)
ENDC
      ;
      outStr ("
( ?  for help,  ^  to start over)
")    ;
   END
   ;

   FOREVER DO
   BEGIN
      WHILE empty (name)  DO
      BEGIN
	 outStr ("
(File name, *, or :) ");
	 IF nonEmpty (fileName)  THEN outStr (fileName & "// ");

 IFC tops20.sw  THENC
	 DO char _ INCHRW  UNTIL char NEQ CR;
 ELSEC
	 char _ INCHRW;
 ENDC

	 IF char = "?"  THEN outStr ("

  Type NAME of file you wish to edit (i.e., to create, read, or revise),
	confirm with RETURN to review and change options or with ESC
	to use standard options, or type

  RETURN  only, to edit the same file with new options,

   ESC 	only, to edit the same file with old options,

    *	to read the latest news (changes, excuses), or

    :	to read the TVEDIT Reference Card.

  In general, terminating a reply with ESC means:  ""Ask no more,
  use standard options.""
")
 IFC tops20.sw  THENC
	 ELSE IF (accepted _ char = LF OR char = ESC)  
 ELSEC
	 ELSE IF (accepted _ char = tnxEOL OR char = ESC)  
 ENDC
	 THEN name _ fileName
	 ELSE IF char = "*"
	 THEN BEGIN getFile(newsFile,"1","R"); RETURN END
	 ELSE IF char = ":"  
	 THEN BEGIN getFile(guidFile,"2","R"); RETURN END
	 ELSE BEGIN BKJFN('100); DONE END
	 ;
      END ! of WHILE;
      ;
    ! Get JFN:  Print message, confirm, block other forks;
      inJfn _ CVJFN (inChan _ GTJFN (name, '062000000000));

      IF (!skip! NEQ 0 AND !skip! NEQ '600115)  THEN errMes  ! File not 
							       ok to edit;
      ELSE
      BEGIN "gotJfn"
       ! If deleted a char, then typed ESC or CR, fill in name;
	 IF (!skip! = '600115)  THEN BEGIN
	    injfn _ CVJFN (inChan _ GTJFN (name _ fileName, '062000000000)); 
	    outStr ("
");
	    accepted _ true;
	 END;
       ! Allow disk files only; 
	 IF DEVTYPE (inChan) NEQ 0  THEN outstr
("...couldn't resist?  Well, disk files only.")
	 ELSE
	 BEGIN "dskFile" STRING dStr;
	  ! Was ESC used to confirm?;
	    BKJFN ('100);  IF INCHRW = ESC  THEN rushed _ TRUE;

	    ownFile _ empty (dStr _ JFNS (inChan,
ifc tops20.sw thenc
						  '220000000000
elsec
						  '020000000000
endc
		      )) ORIF equ (dStr, dirString);  ! Connect or login;

	    GTFDB (inChan, fdb);

	    IF fdb[1] LAND '010000000000  THEN outStr 
("...long file.  Cannot TV-Edit!")
	    ELSE IF (byteSize _ ldb(p.byteSize)) NEQ 7 
		ANDIF byteSize NEQ 36 ANDIF fdb['11] LAND '007700777777
	    THEN outStr
("...improper text file.  Byte size = " & cvs(byteSize))
	    ELSE
	    BEGIN "opts"
ifc tops20.sw thenc
	       fileName _ JFNS (inChan, '111110000001);
elsec
	       fileName _ JFNS (inChan, '011110000001);
endc
	       sameFile _ sameFile AND accepted;

	     ! File ound o.k. so far.  Set default parameters;

	       IF NOT fileMode OR NOT accepted
	       THEN fileMode _ IF NOT ownFile THEN "R" 
			   ELSE IF NOT lcd AND NOT fdb['24] THEN 0
			   ELSE IF ldb(p.mode) THEN "U" ELSE "L"
	       ;
	       IF empty (filePlaces) OR NOT accepted
	       THEN filePlaces _ IF fdb['24] THEN cvs(backPage_ldb(p.page))
					  & "." & cvs(backLine_ldb(p.line))
				 ELSE cvs(backPage_backLine_1)
	       ;
	     ! Get options for this editing session...places and mode 
	     ! first;
	       IF (rushed ORIF getsPlaces(filePlaces))
		  ANDIF
		  ((fileMode AND rushed) ORIF getsMode(fileMode))
	       THEN
	       BEGIN "opn"
	           ! Make new file exist--so it survives a system crash;
	           IF (newFile _ fdb[1] LAND '020000000000) AND 
			fileMode NEQ "R"
	            THEN BEGIN OPENF(inChan,'100000); CLOSF(inChan) END
	           ;
		  OPENF (inChan, IF (readOnly _ fileMode = "R") 
				 THEN '440000200000 ELSE '440000300000)
		  ;
		  IF !skip! = '600123
		    THEN BEGIN 
		    OPENF (inChan, '440000200000);
		    IF NOT !skip!
		      THEN BEGIN
		      fileMode _ "R";
		      readOnly _ TRUE
		      END
		    END;
		  IF !skip!  THEN errMes
		  ELSE
		  BEGIN "gotFile" INTEGER pg;
		   ! Guarantee valid file mode L, U, or R;
		     IF NOT readOnly  THEN
		     BEGIN
			IF fileMode NEQ "L" AND fileMode NEQ "U"
			THEN fileMode _ IF fdb['24]
				   THEN IF ldb(p.mode) THEN "U" ELSE "L"
				   ELSE option ("LU", "
  L  to write text mostly in Lower case
  U  to write mostly in UPPER case
")  			;
			dpb (ucFile _ fileMode = "U", p.mode);
		     END
		     ;
		     fileLength _ fdb['12];  ! For OKTOEDIT; 

		     IF okToEdit  THEN
		     BEGIN "go"
			RETURN;
		     END "go"
		     ;
		  END "gotFile"
		  ;
	       END "opn"
	       ;
	    END "opts"
	    ;
	 END "dskFile"
	 ;

	 CLOSEFILE (inChan);

      END "gotJfn"
      ;
      rushed _ FALSE;  name _ NIL;  
      outStr ("


   Starting over...
");

   END ! of FOREVER;
   ;
END "getFile"
;
INTEGER SUBROUTINE	openNew (STRING name; Boolean FORCE);
!			-------
	Get a new file.  Let user delete and expunge if directory full.
	Sets !SKIP! if fails.  FORCE means try till success. (Dec-81)
??	Strings are copied to page 777.
	;
FOREVER DO
BEGIN "openNew" INTEGER chan;
   chan _ openFile (name, "WE");  ! "W" to get new version, "R" 
				  !  is done below in start!code;
   IF NOT !skip!  THEN
   BEGIN
    ! Finish creating the file so pages survive a system crash;
      START!CODE  acDef;
	push	p, chan;
	pushj	p, cvJfn;	! JFN to AC 1;
	tlo	1, '400000;	! To not to release;

	CLOSF;
	  0;			! Illegal instruction stop;

	andi	1, -1;
	move	2, ['440000300000];	! 36-bit bytes,,read & write;

	OPENF;			! Reopen;
	  0;			! Illegal instruction stop;

! !	hrli	1, '24;		! To change word 24 in FDB;
! !	hrroi	2, '777000;	! Don't touch TV 252 flag;
! !	move	3, fdb['24];
! !	CHFDB;			! Store user setable word;
      END
      ;
      RETURN (chan);
   END
   ;
   If not force Then Return (-1);  ! Failed, but ok to return;

   errMes;
   outStr ("

...IF DIRECTORY IS FULL,
EXPUNGE AND CONTINUE...
");
   halt.f;

END "openNew" ! of FOREVER;
;
SUBROUTINE	tell.1;		ERSTR (-1, 0);
!		------;

SUBROUTINE	tell.0;		BEGIN  duxOn; tell.1; duxOff  END;
!		------;

SUBROUTINE	tell1; 		tell.1;
!		-----;

SUBROUTINE	tell;		tell.0;
!		----;
COMMENT  End of file  GETFIL	;