Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50463/06/mided3.sim
There are 2 other files named mided3.sim in the archive. Click here to see a list.
00030	OPTIONS(/l/e); COMMENT VIDED - DISPLAY EDITOR. See
00060	VISTA.MAN for explanations on the routines used in this program;
00090	COMMENT Copyright (c) Swedish National Defense Research Institute;
00120	COMMENT The Author and the Swedish National Defense Research
00150	Institute take no responsibility for errors in this program or other
00180	files connected with it;
00210	
00240	COMMENT COMMENT%IF VIDTIM marks additions to output everything
00270	input from the user terminal onto a log file;
00300	COMMENT COMMENT%IF STAT marks output of statistics on command
00330	usage;
00360	COMMENT COMMENT%IF FQC marks additions to enable the use of
00390	FQC for frequency counting on VIDED;
00420	COMMENT COMMENT%IF DEBUGTERMINAL marks additions to allow separate
00450	debug and editing terminals;
00480	COMMENT COMMENT%IF DEBUGSLOW marks additions to create artificial
00510	slowness to debug behaviour on a heavily loaded machine;
00540	
00570	COMMENT all the external procedures below are described in the
00600	DECsystem-10 SIMULA Language Handbook part 3;
00630	COMMENT%IF callmac;
00660	EXTERNAL PROCEDURE vtmcur, vtsynk, vtisng;
00690	COMMENT%IFEND CALLMAC;
00720	EXTERNAL PROCEDURE outche, tshift, pgcopy, vdccin, vdccout;
00750	EXTERNAL INTEGER PROCEDURE iondx, vdlno;
00780	EXTERNAL TEXT PROCEDURE tmpin, conc, front, storbokstav,
00810	litenbokstav, rest, filspc, inline, frontstrip, scanto, from, upto,
00840	today, tmpnam, compress, skip, maketext;
00870	
00900	EXTERNAL CHARACTER PROCEDURE findtrigger, fetchar;
00930	EXTERNAL INTEGER PROCEDURE search, scanint, rename;
00960	EXTERNAL INTEGER PROCEDURE sscan;
00990	EXTERNAL REF (infile) PROCEDURE findinfile;
01020	EXTERNAL REF (outfile) PROCEDURE findoutfile;
01050	EXTERNAL CHARACTER PROCEDURE getch;
01080	EXTERNAL INTEGER PROCEDURE trmop, gettab, checkint;
01110	EXTERNAL BOOLEAN PROCEDURE puttext, numbered, tmpout, rescan,
01140	dotypeout, bokstav;
01170	EXTERNAL PROCEDURE depchar, outstring, forceout, echo, abort, exit,
01200	outchr, run;
01230	COMMENT%IF debugslow
01260	EXTERNAL PROCEDURE sleep;
01290	COMMENT%IFEND debugslow;
01320	EXTERNAL BOOLEAN PROCEDURE meny;
01350	EXTERNAL CLASS termty;
01380	COMMENT%IF CALLMAC;
01410	EXTERNAL CLASS mmista, mided1, mided2;
01440	mided2 CLASS mided3;
01470	COMMENT%IFNOT CALLMAC
01500	EXTERNAL CLASS mvista, vided1, vided2;
01530	COMMENT%IFNOT CALLMAC
01560	vided2 CLASS vided3;
01590	COMMENT%IFEND CALLMAC;
     
01620	BEGIN
01650	COMMENT%IF debugterminal - when debugging with a separate debug
01680	REF (infile) newsysin;   ! terminal for SIMDDT i/o and another;
01710	COMMENT%IF debugterminal   terminal for the VIDED editing
01740	REF(outfile) newsysout;
01770	COMMENT%IFEND debugterminal;
01800	COMMENT%IF VIDTIM
01830	REF (outfile) vidtim; ! File for log of input from terminal;
01860	COMMENT%IFEND VIDTIM;
01890	COMMENT%IF STAT
01920	REF (outfile) stat; ! File for statistics;
01950	COMMENT%IFEND STAT;
01980	
02010	REF (vided3x) the_editor;
02040	INTEGER giventrmspeed; ! terminal speed given by user;
02070	INTEGER terminaltype; ! Number of user terminal type;
02100	INTEGER height; ! Number of lines on the screen;
02130	INTEGER width; ! Number of characters in a line on the screen;
02160	INTEGER bad_line_count; ! Count of bad lines;
02190	INTEGER oldnarg; ! Number of lines to be shown after &N search;
02220	INTEGER backupzscroll; ! Line to scroll to after file backup;
02250	INTEGER backupsubpage; ! backup to this sub_page_number;
02280	INTEGER backuphor; ! Horzontal pos to return to after backup;
02310	INTEGER backupvert; ! Vertical pos to return to after backup;
02340	INTEGER backupchecksum; ! to check that backup came back right;
02370	INTEGER autobackcount; ! count for automatic &FB generation;
02400	INTEGER autobackup; ! limit for above count;
02430	COMMENT%IF debugterminal
02460	BOOLEAN debug; ! Debugging with separate terminal for SIMDDT;
02490	COMMENT%IFEND debugterminal;
02520	CHARACTER volkeomchar; ! Volker 414h EOM character;
02550	BOOLEAN merryentry; ! entered through merrygoround;
02580	BOOLEAN pagebottom; ! E argument to &P command;
02610	BOOLEAN synka; ! Synchronization needed of cursor;
02640	BOOLEAN tempfilecommand; ! VIDED got its command string from
02670	the tmpfile "VID";
02700	TEXT infilename;
02730	TEXT outfilename;
02760	TEXT inprotect; ! Protection code on input file;
02790	TEXT indevice; ! Device of input file;
02820	TEXT inspec; ! Input file specification;
02850	TEXT tempfilename; ! Temporary file name;
02880	TEXT please; ! Temporary text;
02910	BOOLEAN otherppn; ! Input file from other PPN than your own;
02940	CHARACTER c; ! for local use;
     
02970	PROCEDURE zeroini(i);
03000	COMMENT zero /N from SWITCH.INI if /-N in command string etcetera;
03030	INTEGER i;
03060	IF arg[i] =/= NOTEXT OR arg[i+1] =/= NOTEXT
03090	THEN ini[i]:- ini[i+1]:- NOTEXT;
03120	
03150	PROCEDURE overwritewarning(t); TEXT t;
03180	IF NOT tempfilecommand THEN
03210	BEGIN
03240	  outtext("%VIDED - You are overwriting a file: ");
03270	  outtext(tempfilename);
03300	  outtext(". To continue push RETURN."); outimage; inimage;
03330	  INSPECT the_editor DO IF backuping THEN badscreen:= TRUE;
03360	END;
     
03390	BOOLEAN PROCEDURE helptype(heightm1,helpprint);
03420	INTEGER heightm1; BOOLEAN helpprint;
03450	COMMENT Action of &H VIDED command requesting the printing of a help
03480	text;
03510	BEGIN REF (infile) helpfile;
03540	  INTEGER count; BOOLEAN limitfound; TEXT helpborder, sysoutimage;
03570	  helpborder:- copy("VIDED EDITING COMMANDS"); arg[5]:- NOTEXT;
03600	  sysoutimage:- sysout.image; sysout.image:- blanks(80);
03630	  helpfile:- findinfile("HLP:VIDED.HLP");
03660	  INSPECT helpfile DO
03690	  BEGIN
03720	    open(sysout.image); inimage;
03750	    WHILE NOT helpfile.endfile DO
03780	    BEGIN
03810	      COMMENT Different part of help file printed depending
03840	      on when this procedure is called;
03870	      IF NOT limitfound THEN
03900	      BEGIN
03930	        limitfound:= search(image,helpborder) <= 60;
03960	        IF limitfound THEN helpprint:= NOT helpprint;
03990	      END;
04020	      IF helpprint THEN
04050	      BEGIN
04080	        sysout.outimage;
04110	        count:= count+1;
04140	        IF count = heightm1 THEN
04170	        BEGIN sysout.outtext("To continue push RETURN.");
04200	          sysout.breakoutimage;
04230	          sysin.inimage; count:= 0;
04260	          outchr(sysout,char(13),1); !carriage return;
04290	          outchr(sysout,' ',25); outchr(sysout,char(13),1);
04320	        END;
04350	      END;
04380	      inimage;
04410	    END;
04440	    helptype:= TRUE;
04470	    close;
04500	  END;
04530	  sysout.image:- sysoutimage;
04560	END of procedure helptype;
     
04590	PROCEDURE before_editing;
04620	BEGIN
04650	  topstart: !z_t(18); COMMENT Start of execution here;
04680	  COMMENT%IF VIDTIM
04710	  vidtim:- new outfile("VIDTIM *");
04740	  COMMENT%IF VIDTIM
04770	  vidtim.open(notext);
04800	  COMMENT%IFEND VIDTIM;
04830	  COMMENT%IF STAT
04860	  IF stat == NONE THEN BEGIN
04890	    stat:- new outfile("STAT.VID/ACCESS:APPEND");
04920	  COMMENT%IF STAT
04950	  stat.open(blanks(80)) END;
04980	  COMMENT%IFEND STAT;
05010	
05040	  merryentry:= merrygoround;
05070	  IF NOT merrygoround THEN
05100	  BEGIN
05130	    outtext("%VIDED DISPLAY TERMINAL EDITOR VERSION 4A IS HERE");
05280	    outimage;
05310	  END;
05340	
05370	  IF the_editor == NONE THEN
05400	  BEGIN
05430	    key[1]:-copy("/DEFAULT:"); ! output file name;
05460	    key[2]:-copy("/T:"); ! terminal type;
05490	    key[3]:-copy("="); ! input file name;
05520	    key[4]:- copy("/DEBUG");
05550	    key[5]:- copy("/H");
05580	    key[6]:- copy("/N");
05610	    key[7]:- copy("/-N");
05640	    key[8]:- copy("/MP:");
05670	    key[9]:- copy("/ML:");
05700	    key[10]:- copy("/MR:");
05730	    key[11]:- copy("/P");
05760	    key[12]:- copy("/-P");
05790	    key[13]:- copy("/L:");
05820	    key[14]:- copy("/C:");
05850	    key[15]:- copy("/JE");
05880	    key[16]:- copy("/-JE");
05910	    key[17]:- copy("/S:");
05940	    key[18]:- copy("/DCA");
05970	    key[19]:- copy("/-DCA");
06000	    key[20]:- copy("/ALF");
06030	    key[21]:- copy("/-ALF");
06060	    key[22]:- copy("/OPTION:");
06090	    key[23]:- copy("/SWEDISH");
06120	    key[24]:- copy("/RUN:");
06150	    key[25]:- copy("/COUNT:");
06180	    key[26]:- copy("/AUTOBACKUP");
06210	    key[27]:- copy("/SPEED:");
06240	    keys:= 27;
06270	
06300	  END of the_editor == NONE;
     
06330	  start:
06360	  IF the_editor == NONE THEN please:- tmpin("VID",TRUE)
06390	  ELSE please:- NOTEXT;
06420	  IF please =/= NOTEXT THEN
06450	  BEGIN tempfilecommand:= TRUE;
06480	    GOTO implicit_command;
06510	  END ELSE IF NOT merrygoround THEN
06540	  BEGIN
06570	    IF rescan THEN
06600	    BEGIN COMMENT Reread line invoking VIDED;
06630	      sysin.inimage; please:- sysin.image;
06660	      IF scanto(please,'-').length < please.length THEN
06690	      BEGIN
06720	        please:- rest(please);
06750	        implicit_command:
06780	        IF sscan(please,keys,arg,key,1) NE 0 THEN
06810	        GOTO multiple ELSE GOTO gotparameters;
06840	      END;
06870	  END; END;
06900	
06930	  IF NOT merrygoround THEN
06960	  BEGIN COMMENT Scan and interpret switches in input command;
06990	    echo(sysin,0);
07020	    WHILE sscan(inline("*",sysin),keys,arg,key,1) NE 0 DO
07050	    BEGIN
07080	      multiple: outtext("? Multiple keywords:");
07110	      outtext(sysin.image.strip);
07140	      outtext("please try again.");
07170	      outimage;
07200	  END; END;
     
07230	  gotparameters:
07260	
07290	  COMMENT If the user gave no input file name, look for previously
07320	  used file name in TMP:EDS;
07350	  IF arg[1] = " " THEN
07380	  BEGIN
07410	    please:- tmpin("EDS",FALSE);
07440	    please:- scanto(please,char(13)).strip;
07470	    please:- scanto(please,char(10)).strip;
07500	    scanto(please,' '); arg[1]:- rest(please);
07530	  END;
07560	  please:- NOTEXT;
07590	
07620	  IF NOT merrygoround THEN
07650	  BEGIN
07680	    INSPECT findinfile("SWITCH.INI") DO
07710	    BEGIN COMMENT The SWITCH.INI file may contain personal default
07740	      settings, e.g. telling VIDED what kind of terminal you are
07770	      using;
07800	      TEXT lineoption, switchoption, imagp;
07830	      open(blanks(130));
07860	      switchoption:- arg[22]; IF switchoption == NOTEXT THEN
07890	      switchoption:- arg[1]; storbokstav(switchoption);
07920	      inimage;
07950	      imagp:- IF numbered THEN image.sub(7,124) ELSE image;
07980	      WHILE NOT endfile DO
08010	      BEGIN
08040	        storbokstav(imagp);
08070	        IF imagp.sub(1,5) = "VIDED" THEN
08100	        BEGIN
08130	          imagp.setpos(6); IF imagp.getchar = ':' THEN
08160	          BEGIN lineoption:- scanto(imagp,' ');
08190	            switchoption.setpos(1);
08220	            IF search(switchoption,lineoption) > switchoption.length
08250	            THEN GOTO afterread;
08280	          END;
08310	          IF sscan(rest(imagp),keys,ini,key,1) NE 0 THEN
08340	          BEGIN outtext("? Multiple keywords"
08370	            " in SWITCH.INI:");
08400	            outtext(imagp.strip);
08430	            outimage;
08460	          END;
08490	        END;
08520	        afterread:
08550	        inimage;
08580	      END;
08610	      close;
08640	    END;
08670	    COMMENT read Terminal information from TMP:TRM TMPCOR file;
08700	    please:- tmpin("TRM",FALSE);
08730	    IF please =/= NOTEXT THEN
08760	    sscan(conc("/t:",please),keys,ini,key,1);
08790	  END;
     
08820	  IF NOT merrygoround AND (arg[1] = "?" OR arg[5] =/= NOTEXT) THEN
08850	  BEGIN COMMENT type help text to the user;
08880	    echo(sysin,2); ! no echo;
08910	    IF NOT helptype(15,TRUE) THEN
08940	    BEGIN outtext("Cannot find VIDED.HLP"); outimage;
08970	    END;
09000	    echo(sysin,4); ! echo again;
09030	    GOTO start;
09060	  END;
09090	
09120	  IF NOT merrygoround THEN
09150	  BEGIN INTEGER i;
09180	    COMMENT Use default settings from the SWITCH.INI file;
09210	    IF arg[2] =/= NOTEXT THEN ini[18]:- ini[19]:- NOTEXT;
09240	    zeroini(6); zeroini(11); zeroini(15);
09270	    zeroini(18); zeroini(20);
09300	    FOR i:= 1 STEP 1 UNTIL keys DO
09330	    BEGIN IF arg[i] == NOTEXT THEN arg[i]:- ini[i];
09360	    END;
09390	  END;
09420	
09450	  editin:- findinfile(arg[1]);
09480	  IF editin =/= NONE THEN
09510	  BEGIN
09540	    IF arg[3] =/= NOTEXT THEN
09570	    overwritewarning(arg[1]) ELSE
09600	    BEGIN
09630	      arg[3]:- arg[1];
09660	      tmpoutfile:= TRUE;
09690	    END;
09720	  END ELSE IF arg[3] == NOTEXT THEN arg[3]:- copy("NUL:NUL");
09750	  IF arg[1] NE arg[3] THEN editin:- findinfile(arg[3]);
09780	  IF editin == NONE THEN
09810	  BEGIN outtext("?CANNOT FIND INPUT FILE: "); outtext(arg[3]);
09840	    outimage; GOTO start;
09870	  END;
09900	
09930	  editin.open(blanks(IF width < 140 THEN 140 ELSE width));
     
09960	  COMMENT find and interpret input file specification;
09990	  inspec:- filspc(editin,8R121101 000001);
10020	  scanto(inspec,':');
10050	  indevice:- inspec.sub(1,inspec.pos-1);
10080	  scanto(inspec,'[');
10110	  otherppn:= inspec.more;
10140	  inspec.setpos(1); scanto(inspec,'<');
10170	  inprotect:- from(inspec,inspec.pos-1);
10200	
10230	  IF tmpoutfile THEN
10260	  BEGIN COMMENT Use temporary name on the output file;
10290	    IF otherppn THEN
10320	  BEGIN COMMENT Input file not on the user PPN, put output file
10350	    there;
10380	      tempfilename:- arg[1];
10410	      tempfilename.setpos(1); scanto(tempfilename,'[');
10440	      IF tempfilename.more THEN
10470	      BEGIN tempfilename.setpos(tempfilename.pos-1);
10500	        scanto(tempfilename,']'):= NOTEXT;
10530	        tempfilename.sub(tempfilename.pos-3,2):= "[,";
10560	      END ELSE tempfilename:- conc(tempfilename,"[,]");
10590	      arg[1]:- tempfilename;
10620	      tmpoutfile:= FALSE;
10650	      IF findinfile(tempfilename) =/= NONE THEN
10680	      overwritewarning(tempfilename);
10710	    END ELSE
10740	    BEGIN
10770	      arg[1]:- tmpnam("VIT");
10800	    END;
10830	  END;
     
10860	  COMMENT Read first line to check for line numbers;
10890	  editin.inimage;
10920	  numbered_infile:= numbered AND arg[3] NE "NUL:NUL";
10950	  largest_line_number:= last_line_number:= 0;
10980	  IF arg[6] =/= NOTEXT THEN
11010	  BEGIN
11040	    arg[6].setpos(1);
11070	    IF NOT digit(arg[6].getchar) THEN arg[6]:- rest(arg[6]);
11100	    increment:= scanint(arg[6]);
11130	    IF increment < 0 OR increment > 9999 THEN increment:= 10;
11160	  END;
11190	  IF numbered_infile AND increment = 0 THEN increment:= 2;
11220	  IF arg[7] =/= NOTEXT THEN increment:= 0;
11250	
11280	  tempfilename:- arg[1];
11310	  IF tmpoutfile THEN
11340	  BEGIN COMMENT Create name of backup file;
11370	    inspec.setpos(1); scanto(inspec,'.');
11400	    IF inspec.more THEN
11430	    BEGIN IF fetchar(inspec,inspec.pos) = 'Q' OR inspec.getchar = 'q'
11460	      THEN
11490	      BEGIN outtext("?VIDED - Cannot handle input file with '.Q': ");
11520	        outtext(inspec); outimage;
11550	        GOTO start;
11580	      END;
11610	    END;
11640	
11670	    c:= fetchar(inprotect,2);
11700	    IF c > '2' AND c NE '4' THEN
11730	    BEGIN outtext("?VIDED - Cannot overwrite file: ");
11760	      outtext(inspec); outimage;
11790	      outtext("%VIDED - Type ""CONTINUE"" if you think it will work.");
11820	      outimage; exit(0);
11850	    END;
11880	
11910	    COMMENT Set protection of temporary output file;
11940	    tempfilename.setpos(1);
11970	    IF scanto(tempfilename, '<').length >= tempfilename.length THEN
12000	    BEGIN COMMENT no protection given by the user;
12030	      tempfilename:- conc(tempfilename,"<077>");
12060	    END;
12090	
12120	    COMMENT Set device for temporary output file;
12150	    tempfilename.setpos(1); IF scanto(tempfilename,
12180	    ':').length >= tempfilename.length THEN
12210	    BEGIN COMMENT no device given by the user;
12240	      tempfilename:- conc(indevice,tempfilename);
12270	    END;
12300	  END;
12330	
12360	  COMMENT Numbered outfile?;
12390	  IF increment > 0 THEN tempfilename:- conc(tempfilename,"/NUMBERED");
12420	
12450	  editout:- findoutfile(tempfilename);
12480	  arg[1]:- tempfilename;
12510	  IF editout == NONE THEN
12540	  BEGIN outtext("?VIDED - CANNOT OPEN OUTPUT FILE: "); outtext(arg[1]);
12570	    outimage; exit(0);
12600	    GOTO start;
12630	  END;
12660	
12690	COMMENT%IF debugterminal
12720	debug:= arg[4] =/= NOTEXT;
12750	  COMMENT%IFEND debugterminal;
     
12780	  IF the_editor == NONE THEN
12810	  BEGIN
12840	    IF arg[8] =/= NOTEXT THEN warningheight:= scanint(arg[8]) ELSE
12870	    warningheight:= 56;
12900	    IF arg[9] =/= NOTEXT THEN leftmargin:= scanint(arg[9]) ELSE
12930	    leftmargin:= IF increment = 0 THEN 5 ELSE 13;
12960	    IF arg[10] =/= NOTEXT THEN rightmargin:= scanint(arg[10]) ELSE
12990	    rightmargin:= IF increment = 0 THEN 72 ELSE 78;
13020	  END;
13050	
13080	  IF increment > 0 AND leftmargin < 8 THEN leftmargin:= 8;
13110	  COMMENT ask user about terminal type if not known;
13140	  gettype:
13170	  IF the_editor == NONE THEN
13200	  BEGIN
13230	    INSPECT NEW termty DO
13260	    BEGIN
13290	      IF arg[2] == NOTEXT THEN asktype:
13320	      BEGIN TEXT answer;
13350	        type_menu(sysout);
13380	        outtext("(Other) display."); outimage;
13410	        inloop: outchr(sysout,'>',1); forceout(sysout);
13440	        inimage;
13470	        answer:- copy(storbokstav(sysin.image.strip));
13500	        arg[2]:- scanto(answer,'/'); answer:- rest(answer);
13530	        IF answer = "DCA" THEN
13560	        BEGIN arg[18]:- blanks(1); arg[19]:- NOTEXT;
13590	        END ELSE IF answer = "-DCA" THEN
13620	        BEGIN arg[18]:- NOTEXT; arg[19]:- blanks(1);
13650	        END;
13680	        IF arg[2] == NOTEXT THEN GOTO inloop;
13710	      END;
13740	      IF NOT meny(arg[2],terminaltype,tr,termtype) THEN
13770	      BEGIN
13800	        outtext(IF terminaltype = -1 THEN
13830	        "Ambiguous terminal type: " ELSE
13860	        "Unknown terminal type: "); outtext(arg[2]); outimage;
13890	        GOTO asktype;
13920	      END;
13950	      IF terminaltype = termtype THEN terminaltype:= 0;
13980	      sysin.setpos(0);
14010	
14040	      IF arg[14] =/= NOTEXT THEN width:= scanint(arg[14]) ELSE
14070	      BEGIN width:= cdefault(terminaltype);
14100	        IF width = 0 THEN
14130	        BEGIN again: outimage;
14160	          outtext("Input terminal screen width: "); breakoutimage;
14190	          inimage; width:= scanint(sysin.image);
14220	          IF sysin.image.pos = 1 THEN
14250	          BEGIN outtext("?VIDED - Unrecognizable integer");
14280	            GOTO again;
14310	          END;
14340	          width:= width-1;
14370	        END;
14400	      END;
14430	
14460	      IF arg[13] =/= NOTEXT THEN height:= scanint(arg[13]) ELSE
14490	      BEGIN height:= ldefault(terminaltype);
14520	        IF height = 0 THEN
14550	        BEGIN
14580	          again2: outtext("Input terminal screen height: ");
14610	          breakoutimage;
14640	          inimage; height:= scanint(sysin.image);
14670	          IF sysin.image.pos = 1 THEN
14700	          BEGIN outtext("?VIDED - unrecognizable integer."); outimage;
14730	            GOTO again2;
14760	          END;
14790	        END;
14820	      END;
14850	  END of asktype, inspect new temty; END;
14880	
14910	  IF arg[27] =/= NOTEXT THEN giventrmspeed:= scanint(arg[27]);
     
14940	  COMMENT Open output text file for edited results;
14970	  editout.open(blanks(IF increment = 0 THEN width ELSE width+8));
15000	
15030	COMMENT%IF debugterminal
15060	IF debug THEN
15090	BEGIN
15120	  newsysin:- NEW infile("sysin *");
15150	  COMMENT%IF debugterminal
15180	  newsysout:- NEW outfile("sysout *");
15210	  COMMENT%IF debugterminal
15240	  newsysin.open(blanks(80));
15270	  COMMENT%IF debugterminal
15300	  newsysout.open(blanks(80))
15330	END ELSE
15360	BEGIN
15390	  newsysin:- sysin;
15420	  COMMENT%IF debugterminal
15450	  newsysout:- sysout
15480	END;
15510	  COMMENT%IFEND debugterminal;
15540	
15570	  IF width < 11 THEN
15600	  BEGIN outtext("?VIDED - Screen width must be > 10");
15630	    outimage; exit(0);
15660	  END;
15690	
15720	  COMMENT Write VIDED command and file name onto TMP:EDS;
15750	  IF NOT merrygoround THEN
15780	  BEGIN
15810	    IF command == NOTEXT THEN
15840	    BEGIN command:- blanks(width);
15870	      belowcommand:- blanks(width);
15900	    END;
15930	    IF tmpoutfile THEN outfilename:- arg[3] ELSE
15960	    BEGIN
15990	      outfilename:- arg[1]; outfilename.setpos(1);
16020	      outfilename:- scanto(outfilename,'/');
16050	    END;
16080	    puttext(belowcommand,"VIDED ");
16110	    puttext(belowcommand,outfilename);
16140	    belowcommand.putchar(char(10)); ! line feed;
16170	    tmpout("EDS",copy(belowcommand.strip));
16200	    belowcommand.setpos(belowcommand.pos-1);
16230	    belowcommand.putchar(char(32));
16260	  END;
     
16290	  IF arg[15] =/= NOTEXT THEN
16320	  BEGIN
16350	    IF arg[15].length = 1 THEN
16380	    dot:= char(1) ELSE
16410	    BEGIN
16440	      arg[15].setpos(2); dot:= arg[15].getchar;
16470	    END;
16500	  END;
16530	
16560	  IF arg[26] =/= NOTEXT THEN ! /AUTOBACKUP;
16590	  BEGIN arg[26].setpos(2);
16620	    autobackup:= scanint(arg[26]);
16650	    IF autobackup < 0 THEN autobackup:= 10;
16680	  END ELSE autobackup:= 20;
16710	  autobackcount:= IF autobackup = 0 THEN -3000000000 ELSE 0;
16740	
16770	  IF arg[17] == NOTEXT THEN showdefault:= height ELSE
16800	  BEGIN arg[17].setpos(1);
16830	    showdefault:= scanint(arg[17]);
16860	    IF arg[17].pos = 1 THEN showdefault:= height;
16890	  END;
16920	  IF arg[16] =/= NOTEXT THEN dot:= char(127);
16950	
16955	  BEGIN TEXT extension;
16960	    outfilename.setpos(1); scanto(outfilename,'.');
16965	    extension:- rest(outfilename); extension:- upto(extension,4);
16970	    storbokstav(extension);
16975	
17220	    IF dot = char(0) THEN
17250	    BEGIN
17280	      IF extension = "GNO" THEN dot:= '%'
17310	      ELSE IF extension = "OVH" THEN dot:= '1'
17340	      ELSE IF upto(extension,3) = "RN" THEN dot:= '.';
17370	    END;
17400	
17430	    IF arg[23] == NOTEXT AND extension = "SWE" OR extension = "VIS"
17460	    THEN arg[23]:- key[3];
17462	
17464	    IF upto(extension,3) = "VI" THEN
17466	    BEGIN videdp:= TRUE; pageheight:= warningheight*1.5;
17468	    END ELSE pageheight:= warningheight;
     
17475	  COMMENT Shall VIDED produce headers and page numbers?;
17480	  IF arg[11] =/= NOTEXT THEN pageheader:= TRUE ELSE
17490	    IF arg[12] =/= NOTEXT THEN pageheader:= FALSE ELSE
17520	    BEGIN COMMENT these extensions give no page numbers;
17550	      pageheader:=
17580	      extension NE "INI" AND
17610	      extension NE "SIM" AND
17640	      extension NE "ALG" AND
17670	      extension NE "B10" AND
17700	      extension NE "B11" AND
17730	      extension NE "BAS" AND
17760	      extension NE "BLI" AND
17790	      extension NE "CCL" AND
17820	      extension NE "MIC" AND
17850	      extension NE "FOR" AND
17880	      extension NE "OVH" AND
17910	      extension NE "F4" AND
17940	      extension NE "GNO" AND
17970	      extension NE "LAP" AND
18000	      extension NE "LOG" AND
18030	      extension NE "LST" AND
18060	      extension NE "LSP" AND
18090	      extension NE "MAC" AND
18120	      extension NE "P11" AND
18150	      extension NE "PL1" AND
18180	      extension NE "RNO" AND
18210	      extension NE "RNM" AND
18240	      extension NE "RNH" AND
18270	      extension NE "RNP" AND
18300	      extension NE "SNO" AND
18330	      extension NE "SRC" AND
18360	      extension NE "ADR" AND
18390	      extension NE "TEC";
18420	      IF NOT pageheader THEN
18450	      BEGIN COMMENT programming language extension and no /mp;
18480	        IF dot = char(0) THEN dot:= char(127);
18510	        IF arg[8] == NOTEXT THEN pageheight:= 150;
18540	      END;
18570	  END; END;
18600	
18630	  IF dot = char(0) THEN dot:= '.';
18660	
18690	  IF height < 2 THEN
18720	  BEGIN outtext("?VIDED- Screen height must be > 1"); outimage;
18750	    exit(0);
18780	  END;
18810	  COMMENT Get access to the editing facilities in vided1 and ;
18840	  !z_t(-18);
18870	END of procedure before_editing;
     
18900	vided2x CLASS vided3x;
18930	BEGIN
18960	
18990	  TEXT old_search_string; ! &S& and &N& makes the same search
19020	                            as previous search command;
19050	  TEXT dashblank; ! Used by &- command;
19080	
19110	  PROCEDURE help;
19140	  BEGIN COMMENT &H VIDED command;
19170	    blankterminal;
19200	    IF NOT helptype(heightm1,FALSE) THEN
19230	    warning("Cannot find VIDED.HLP",NOTEXT);
19260	    to_continue; command_done:= TRUE;
19290	  END;
     
19320	  PROCEDURE avstava(nlines,evenmargin);
19350	  COMMENT &J- and &F- VIDED commands;
19380	  INTEGER nlines; BOOLEAN evenmargin;
19410	  IF q_verticalpos > 0 THEN
19440	  BEGIN
19470	    IF q_horizontalpos > 0 THEN
19500	    BEGIN IF
19530	      get_char_from_screen(q_horizontalpos-1,q_verticalpos)
19560	      = '-'
19590	      THEN GOTO dash_is_there;
19620	    END;
19650	    IF get_char_from_screen(q_horizontalpos,q_verticalpos) = '-'
19680	    THEN
19710	    BEGIN move_the_cursor_to(q_horizontalpos+1,q_verticalpos);
19740	      GOTO dash_is_there;
19770	    END;
19800	    insert(dashblank,FALSE);
19830	    IF FALSE THEN dash_is_there: insert(dashblank.sub(2,1),FALSE);
19860	    move_the_cursor_to(leftmargin,q_verticalpos-1);
19890	    justify(nlines,evenmargin,TRUE);
19920	  END ELSE warning("&J- or & F- not possible on top line.",NOTEXT);
19950	
19980	  PROCEDURE dobackup; ! &FB command action;
20010	  BEGIN
20040	    IF nooutput THEN badscreen:= TRUE;
20070	    WHILE screen[0].sub(1,page_end_marker.length) =
20100	    page_end_marker DO z_scroll(1);
20130	    backupchecksum:= checksum;
20160	    backuphor:= q_horizontalpos; backupvert:= q_verticalpos;
20190	    backupzscroll:= top_fill; startpage:= out_pagenumber-1;
20220	    IF NOT addff AND startpage > 0 THEN startpage:= startpage-1;
20250	    backupsubpage:= sub_page_number; pagebottom:= FALSE;
20280	    IF backupsubpage > 1 AND backupzscroll = -1 THEN
20310	    BEGIN backupsubpage:= backupsubpage-1;
20340	      backupzscroll:= top_size;
20370	    END;
20400	    backuping:= TRUE; GOTO roundabout;
20430	  END of procedure dobackup;
     
20460	  PROCEDURE print_status;
20490	  COMMENT &O VIDED command;
20520	  INSPECT sysin DO INSPECT sysout DO
20550	  BEGIN
20580	    REF (qregister) current_q;
20610	    TEXT qname; INTEGER i;
20640	    blankterminal;
20670	    outtext("VIDED STATUS INFORMATION:"); outimage;
20700	    outtext("You are editing page no"); outint(pagenumber,4);
20730	    outtext("(input),"); outint(out_pagenumber,4);
20760	    outtext("(output).");
20790	    IF sub_page_number > 1 THEN
20820	    BEGIN outtext(" Subpage:"); outint(sub_page_number,3);
20850	    END;
20880	    outimage;
20910	    outtext("Screen is showing line no.");
20940	    outint(top_fill+2,3); outtext(" -");
20970	    outint(top_fill+2+heightm1,3); outtext(" of current page.");
21000	    outimage;
21030	    outtext("Page height ="); outint(pageheight,3);
21060	    outchar('.');
21090	    IF pageheader THEN
21120	    BEGIN
21150	      outtext(" Title and subtitle of previous page:");
21180	      outimage; outtext(header); outimage;
21210	      outtext(sub_header);
21240	    END;
21270	    outimage;
21300	    outtext("Current cursor position, horizontal =");
21330	    outint(q_horizontalpos,3);
21360	    outtext(", vertical ="); outint(q_verticalpos,3);
21390	    outchar('.'); outimage;
21420	    outtext("Input file """); outtext(arg[3]);
21450	    outtext(""", "); IF tmpoutfile THEN outtext("temporary ");
21480	    outtext("output file """); outtext(arg[1]);
21510	    outtext(""".");
21540	    outimage;
21570	    IF tmpoutfile THEN
21600	    BEGIN
21630	      outtext("Output file will be renamed to """);
21660	      outtext(arg[3]); outtext("""."); outimage;
21690	    END;
21720	    outtext("You are ");
21750	    IF NOT endpage OR NOT lower_lines == NONE THEN
21780	    outtext("not ");
21810	    outtext("at the end of a page.");
21840	    outimage; outtext("You are ");
21870	    IF NOT editin.endfile OR NOT lower_lines == NONE
21900	    THEN outtext("not ");
21930	    outtext("at the end of the file.");
21960	    outimage;
21990	    outtext("Left margin ="); outint(leftmargin,3);
22020	    outtext("  Right margin ="); outint(rightmargin,3);
22050	    outimage;
22080	    IF qregisters == NONE THEN
22110	    BEGIN outtext("You have no Q-registers."); outimage;
22140	      to_continue;
22170	    END ELSE
22200	    BEGIN
22230	      IF NOT q_echoenabled THEN echon;
22260	      qlist:
22290	      outtext("Width  Height  Q-register name"); outimage;
22320	      current_q:- qregisters;
22350	      WHILE current_q =/= NONE DO
22380	      BEGIN
22410	        outint(current_q.qwidth,4);
22440	        outint(current_q.qheight,7); image.setpos(16);
22470	        outtext(current_q.qname); outimage;
22500	        current_q:- current_q.next_qregister;
22530	      END;
22560	      again:
22590	      outtext(
22620	      "If you want to see the contents of a Q-register,");
22650	      outtext(" then type its name:"); outimage;
22680	      inimage; qname:- storbokstav(sysin.image.strip);
22710	      IF qname =/= NOTEXT THEN
22740	      INSPECT find_qregister(qname) DO
22770	      BEGIN
22800	        FOR i:= 1 STEP 1 UNTIL qheight DO
22830	        BEGIN outtext(lines(i-1)); outimage;
22860	        END;
22890	        GOTO again;
22920	      END OTHERWISE
22950	      BEGIN outtext("?VIDED - There is no such Q-register."
22980	        " Push RETURN to exit.");
23010	        outimage; GOTO qlist;
23040	      END;
23070	      restore_screen(q_verticalpos, showdefault);
23100	    END; command_done:= TRUE;
23130	  END;
     
23160	  PROCEDURE getcommand(simulated_command);
23190	  VALUE simulated_command; TEXT simulated_command;
23220	  COMMENT Interpret VIDED command, this procedure is called when the
23250	  user has typed <ALTMODE> or <CONTROL-F> to start a VIDED command;
23280	  BEGIN BOOLEAN stoptime; ! Time to exit from "getcommand";
23310	    BOOLEAN anytextparameter; ! Interpreting the part of a VIDED
23340	    command such as &Q or &S which has a text parameter;
23370	    BOOLEAN type_ahead; ! The user has done type_ahead;
23400	    BOOLEAN got_digit; ! Explicit user digit was input;
23430	    BOOLEAN signed; ! There was a + or - sign on the digit;
23460	    CHARACTER commandchar; ! First nonnumeric character after &;
23490	    CHARACTER oldchar; ! Screen character overwritten by command
23520	    character;
23550	    CHARACTER secondchar; ! Second character in VIDED command;
23580	    INTEGER hstart; ! Horizontal pos of &;
23610	    INTEGER vstart; ! Vertical pos of &;
23640	    INTEGER arg1; ! First numerical parameter to the command;
23670	    INTEGER arg2; ! Second numerical parameter to the command;
23700	    INTEGER leading_number; ! Number given by the user before the
23730	    command character, e.g. in &13V;
23760	    INTEGER multi; ! Number of times this command is to be repeated;
23790	    INTEGER multic; ! Counter of iterations from 1 to multi;
23820	    INTEGER multistep; ! step between lines with multi application;
23850	    INTEGER vtop; ! One less than the top line to be modified;
23880	    INTEGER stringstart; ! Startpos of text param to I, Q etc;
23910	    INTEGER intpos; ! startpos of integer being read;
23940	    TEXT qname; ! Value of text parameter to VIDED command;
     
23970	    PROCEDURE checkvalue(arg,min);
24000	    INTEGER arg, min;
24030	    IF arg < min THEN
24060	    BEGIN warning("Too small numerical parameter.",NOTEXT);
24090	      commandchar:= char(0); GOTO endcommand;
24120	    END;
24150	
24180	    INTEGER PROCEDURE intin;
24210	    COMMENT read integer parameter to VIDED command;
24240	    IF leading_number NE -100000 THEN
24270	    BEGIN intin:= leading_number; leading_number:= -100000;
24300	    END ELSE
24330	    BEGIN TEXT digpart;
24360	      intpos:= command.pos;
24390	      signed:= nextchar = '-' OR q_gotchar = '+';
24420	      IF signed OR digit(q_gotchar) THEN
24450	      BEGIN
24480	        WHILE digit(nextchar) DO;
24510	      END;
24540	      IF q_gotchar = carriagereturn THEN
24570	      command.putchar(q_gotchar);
24600	      IF intpos+1 >= command.pos THEN
24630	      BEGIN got_digit:= FALSE;
24660	        intin:= (IF commandchar = char(0) THEN -100000 ELSE IF
24690	        commandchar = 'M' THEN hstart ELSE IF commandchar = 'F' THEN 0
24720	        ELSE IF commandchar = 'T' THEN -1000 ELSE 1)
24750	      END ELSE
24780	      BEGIN got_digit:= TRUE;
24810	        digpart:- command.sub(intpos,command.pos-intpos-1);
24840	        IF digpart.length > 6 THEN
24870	        BEGIN warning("Too large integer parameter.",NOTEXT);
24900	          commandchar:= char(0); GOTO endcommand;
24930	        END;
24960	        intin:= IF NOT signed OR digpart.length > 1 THEN
24990	        digpart.getint ELSE IF digpart = "-" THEN -1 ELSE 1;
25020	      END;
25050	    END;
     
25080	    PROCEDURE take_line_feed;
25110	    BEGIN IF vstart >= heightm1 THEN
25140	      BEGIN call(p_scroll);
25170	        vstart:= vstart-1;
25200	        verybadscreen:= type_ahead;
25230	      END;
25260	    END;
25290	
25320	    PROCEDURE restore_command;
25350	    COMMENT When the user has ended a VIDED command, the screen is
25380	    restored to what it was below the command before it was typed;
25410	    BEGIN
25440	      IF q_gotchar = carriagereturn THEN
25470	      COMMENT%IFNOT CALLMAC
25500	      call(p_insingle) ELSE
25530	      COMMENT%IF CALLMAC;
25560	      vtisng(cpunumber) ELSE
25590	      COMMENT%IFEND CALLMAC;
25595	      IF controlchar AND q_gotchar >= ' ' THEN BEGIN
25600	        IF trmop(8R001,sysout,1) = 1 THEN BEGIN
25603	          loop: getch; IF trmop(8R001,sysout,1) = 1 THEN GOTO loop;
25605	          warning("Use RETURN key to finish VIDED COMMAND.",
25610	          NOTEXT);
25613	        END;
25615	      END;
25620	      COMMENT%IF VIDTIM
25650	      outchr(vidtim,q_gotchar,1);
25680	      COMMENT%ENDIF VIDTIM;
25710	      COMMENT%IF debugslow
25740	      IF debugslow > 0 THEN sleep(debugslow);
25770	      COMMENT%IFEND debugslow;
25800	      normaltext;
25830	      IF q_gotchar = linefeed THEN take_line_feed;
25860	      synchronize(hstart,vstart);
25890	      outtext(front(belowcommand));
25920	      move_the_cursor_to(hstart,vstart);
25950	      COMMENT%IF STAT
25980	      stat.outtext(front(command));
26010	      COMMENT%IF STAT
26040	      stat.outimage;
26070	      COMMENT%IFEND stat;
26100	    END;
     
26130	    CHARACTER PROCEDURE nextchar;
26160	    BEGIN COMMENT Input of one character in a VIDED command;
26190	      IF stoptime THEN
26220	      BEGIN
26250	        IF badscreen THEN verybadscreen:= TRUE;
26280	        warning("End of line, command stopped.",NOTEXT);
26310	        GOTO endcommand;
26340	      END;
26370	      stoptime:= q_horizontalpos = widthm1;
26400	      start: oldchar:=
26430	      get_char_from_screen(q_horizontalpos,q_verticalpos);
26460	      IF simulated_command.more
26490	      THEN BEGIN
26520	        q_gotchar:= simulated_command.getchar;
26550	        outchar(q_gotchar); controlchar:= FALSE;
26580	      END ELSE
26610	      COMMENT%IFNOT CALLMAC
26640	      call(p_insingle);
26670	      COMMENT%IF CALLMAC;
26700	      vtisng(cpunumber);
26730	      COMMENT%IFEND CALLMAC;
26760	      nextchar:= q_gotchar;
26790	      COMMENT%IF VIDTIM
26820	      outchr(vidtim,q_gotchar,1);
26850	      COMMENT%IFEND VIDTIM;
26880	      COMMENT%IF debugslow
26910	      IF debugslow > 0 THEN sleep(debugslow);
26940	      COMMENT%IFEND debugslow;
26970	      IF q_gotchar = fill OR controlchar AND q_gotchar = left THEN
27000	      BEGIN
27030	        IF command.pos > 3 AND command.pos >= intpos THEN
27060	        BEGIN
27090	          IF q_echoenabled THEN BEGIN
27120	            IF q_gotchar = left THEN BEGIN
27150	              IF addaltmode AND NOT leftsingle THEN
27180	              outchr(terminalout,altmode,1);
27210	              outchr(terminalout,left,1);
27240	            END;
27270	            q_display_output:= FALSE;
27300	            outstring(terminalout,deletechar);
27330	          END;
27360	          outchar(fetchar(belowcommand,belowcommand.pos-1));
27390	          move_the_cursor_to(q_horizontalpos-1,q_verticalpos);
27420	          q_display_output:= TRUE;
27450	          command.setpos(command.pos-1);
27480	          belowcommand.setpos(belowcommand.pos-1);
27510	          GOTO start;
27540	        END ELSE
27570	        BEGIN commandchar:= char(0); GOTO endcommand;
27600	        END;
27630	      END ELSE
27660	      IF q_gotchar = control_u THEN ! erase command;
27674	      BEGIN IF NOT q_echoenabled
27678	        THEN commandchar:= char(0) ELSE BEGIN
27680	          normaltext;
27682	          screen(vstart).sub(hstart+1,belowcommand.pos-3):=
27684	          belowcommand.sub(3,belowcommand.pos-3);
27686	          restore_lines(vstart,vstart);
27688	          command.setpos(1);
27691	        END; GOTO endcommand;
27720	      END ELSE
27750	      BEGIN
27780	        IF controlchar THEN
27810	        BEGIN
27840	          IF q_gotchar = altmode THEN
27870	          outchr(terminalout,delayer,1);
27900	          IF q_gotchar NE carriagereturn AND
27930	          anytextparameter THEN GOTO endcommand;
27960	          IF q_gotchar NE carriagereturn AND
27990	          q_gotchar NE control_f AND q_gotchar NE comstartchar AND
28020	          q_gotchar NE altmode THEN
28050	          BEGIN ! illegal char; commandchar:= char(0);
28080	            GOTO endcommand;
28110	          END;
28140	        END ELSE
28170	        BEGIN
28200	          IF q_echoenabled THEN BEGIN
28230	            outstring(terminalout,insertchar);
28260	            outchr(terminalout,q_gotchar,1);
28290	          END;
28320	          belowcommand.putchar(oldchar);
28350	          command.putchar(q_gotchar);
28380	        END;
28410	      END;
28440	    END;
     
28470	    PROCEDURE adjustmulti;
28500	    BEGIN
28530	      vtop:= vstart-1;
28560	      IF multi < 0 THEN
28590	      BEGIN
28620	        IF screen[vstart].sub(1,1) NE "." THEN
28650	        multi:= height-vstart ELSE
28680	        BEGIN
28710	          FOR vtop:= vstart STEP -1 UNTIL 0 DO
28740	          IF screen[vtop].sub(1,1) NE "." THEN GOTO exit1;
28770	          vtop:= -1;
28800	          exit1:
28830	          FOR multi:= vstart STEP 1 UNTIL heightm1 DO
28860	          IF screen[multi].sub(1,1) NE "." THEN GOTO exit2;
28890	          multi:= multi+1;
28920	          exit2: multi:= multi-vtop-1;
28950	        END;
28980	      END;
29010	      IF multi > heightm1-vtop THEN multi:= heightm1-vtop;
29040	    END;
29055	
29070	    PROCEDURE get_line_feed;
29100	    IF getch = linefeed THEN BEGIN
29130	      type_ahead:= FALSE; normaltext; take_line_feed; specialtext;
29160	    END;
     
29220	    COMMENT body of PROCEDURE getcommand; !z_t(19);
29250	    hstart:= q_horizontalpos; vstart:= q_verticalpos;
29280	    vtop:= vstart-1; command_done:= FALSE;
29310	    command:= "&"; command.setpos(2);
29340	    IF q_horizontalpos > widthm1 THEN GOTO getout;
29370	    belowcommand:=
29400	    screen(q_verticalpos).sub(q_horizontalpos+1,1);
29430	    belowcommand.setpos(2);
29460	    type_ahead:= trmop(8R0001,sysout,1) = 1 !=type ahead;;
29490	    IF terminaltype = volker414h THEN BEGIN
29520	      IF volkeomchar NE char(0) AND
29550	      (q_gotchar = 'A' OR simulated_command =/= NOTEXT) THEN
29580	      BEGIN IF getch = carriagereturn THEN get_line_feed;
29610	      END;
29640	    END ELSE IF terminaltype = elite3025 AND
29670	    (q_gotchar = 'p' OR simulated_command =/= NOTEXT)
29700	    THEN BEGIN getch; get_line_feed; END;
29707	    COMMENT%IF debugslow
29716	    sleep(1);
29723	    COMMENT%IFEND debugslow;
29730	    echoff; synchronize(hstart,vstart);
29760	    specialtext;
29790	    outchr(sysout,delayer,1); outchar('&');
29820	    IF hstart >= widthm1 THEN GOTO endcommand;
29850	    multi:= 1; stringstart:= 3;
29880	    readcommand: leading_number:= -100000;
29910	    leading_number:= intin;
29940	    commandchar:= q_gotchar;
29970	    COMMENT storbokstav commandchar;
30000	    IF commandchar >= 'a' THEN
30030	    commandchar:= char(rank(commandchar)-32) ELSE
30060	    IF controlchar THEN commandchar:= char(0);
30090	
30120	    COMMENT test for each possible first command character;
30150	    IF commandchar = '*' THEN
30180	    BEGIN multi:= leading_number; stringstart:= command.pos+1;
30210	      commandchar:= char(0); GOTO readcommand;
30240	    END;
30270	    IF commandchar = '_' THEN
30300	    BEGIN nooutput:= TRUE; commandchar:= char(0);
30330	      GOTO readcommand;
30360	    END;
30390	    IF commandchar = 'R' THEN
30420	    BEGIN restore_command;
30450	      restore_screen(vstart, IF leading_number <= 0 THEN 998 ELSE
30480	      -leading_number);
30510	      command_done:= TRUE;
30540	    END ELSE IF commandchar = 'W' THEN
30570	    BEGIN restore_command; arg1:= IF leading_number < 0 THEN 1 ELSE
30600	      leading_number;
30630	      FOR multic:= 1 STEP 1 UNTIL arg1 DO removeword;
30660	    END ELSE IF commandchar = '-' THEN
30690	    BEGIN restore_command; warning("Use &J- or &F- commands.",NOTEXT);
30720	    END ELSE IF commandchar = 'X' THEN
30750	    BEGIN restore_command;
30780	      IF leading_number = -100000 THEN
30810	      arg1:= screen(vstart).strip.length ! &X;
30840	      ELSE arg1:= width-frontstrip(screen[vstart].
30870	      sub(first_text_pos+1,width-first_text_pos)).length; ! &-X;
30900	      IF arg1 > widthm1 THEN arg1:= widthm1;
30930	      move_the_cursor_to(arg1,vstart); command_done:= TRUE;
30960	    END ELSE IF commandchar = 'O' THEN
30990	    BEGIN restore_command; print_status;
31020	    END ELSE IF commandchar = 'U' THEN
31050	    BEGIN restore_command; adjustmulti;
31080	      FOR multic:= 1 STEP 1 UNTIL multi DO
31110	      BEGIN move_the_cursor_to(hstart,vtop+multic);
31140	        blank_front;
31170	      END; IF multi > 1 THEN move_the_cursor_to(hstart,vstart);
31200	    END ELSE IF commandchar = 'E' THEN
31230	    BEGIN restore_command; forceout(sysout); GOTO stopedit;
31260	    END ELSE IF commandchar = 'C' THEN
31290	    BEGIN restore_command; IF leading_number < 0 THEN control_c;
31320	    END ELSE IF commandchar = 'V' THEN
31350	    BEGIN arg1:= IF leading_number < 0 THEN 1 ELSE
31380	      leading_number;
31410	      IF arg1 > line_model.length THEN arg1:= 0;
31440	      restore_command; adjustmulti;
31470	      FOR multic:= 1 STEP 1 UNTIL multi DO
31500	      BEGIN move_the_cursor_to(hstart,vtop+multic);
31530	        insert(line_model.sub(1,arg1),FALSE);
31560	      END;
31590	      move_the_cursor_to(hstart,vstart);
31620	    END ELSE IF commandchar = 'T' THEN
31650	    BEGIN arg1:= intin; restore_command;
31680	      IF arg1 < 0 AND arg1 >= -999 THEN
31710	      BEGIN arg1:= width+arg1; checkvalue(arg1,0);
31740	      END;
31770	      IF arg1 > widthm1 THEN arg1:= widthm1;
31800	      IF q_gotchar > ' ' AND q_gotchar NE 'T' AND q_gotchar NE 't'
31830	      THEN settab(IF arg1 < 0 THEN hstart ELSE arg1,q_gotchar) ELSE
31860	      BEGIN command_done:= TRUE;
31890	        IF arg1 < 0 THEN position_tab(FALSE) ELSE
31920	        move_the_cursor_to(arg1,vstart);
31950	      END;
31980	    END ELSE IF commandchar = 'L' THEN
32010	    BEGIN IF leading_number >= 0 THEN
32040	      BEGIN restore_command;
32070	        addlines(leading_number,TRUE,FALSE,TRUE);
32100	      END ELSE
32130	      BEGIN
32160	        got_digit:= FALSE; arg1:= intin; restore_command;
32190	        checkvalue(arg1,1);
32220	        IF q_gotchar = 'D' OR q_gotchar = 'd' OR
32250	        q_gotchar < ' ' THEN
32280	        addlines(arg1,TRUE,q_gotchar > ' ',TRUE) ELSE
32310	        BEGIN
32340	          adjustmulti;
32370	          FOR multic:= 1 STEP 1 UNTIL multi DO
32400	          BEGIN move_the_cursor_to(hstart,vtop+multic);
32430	            IF q_gotchar = 'n' OR q_gotchar = 'N'
32460	            THEN numberlines(arg1)
32490	            ELSE IF q_gotchar = 'C' OR q_gotchar = 'c'
32520	            THEN center_line(IF got_digit THEN arg1 ELSE -1)
32550	            ELSE IF q_gotchar = 'U' OR q_gotchar = 'u'
32580	            OR q_gotchar = 'L' OR q_gotchar = 'l'
32610	            THEN case_shift(q_gotchar);
32640	          END of multic loop;
32670	        END;
32700	      END;
32730	    END ELSE IF commandchar = 'M' THEN
32760	    BEGIN secondchar:= nextchar;
32790	      arg1:= intin; restore_command;
32820	      margset(secondchar,arg1);
32850	    END ELSE IF commandchar = 'J' OR commandchar = 'F' THEN
32880	    BEGIN IF nextchar >= 'a' THEN
32910	      q_gotchar:= char(rank(q_gotchar)-32);
32940	      IF q_gotchar NE '-' AND
32970	      (commandchar = 'J' AND q_gotchar NE 'U' OR
33000	      commandchar = 'F' AND q_gotchar NE 'I' AND q_gotchar NE 'C')
33030	      THEN
33060	      BEGIN IF q_gotchar= carriagereturn THEN
33090	        BEGIN
33120	          COMMENT%IFNOT CALLMAC
33150	          call(p_insingle);
33180	          COMMENT%IF CALLMAC;
33210	          vtisng(cpunumber);
33240	          COMMENT%IFEND CALLMAC;
33270	          q_gotchar:= char(0);
33300	        END;
33330	        IF q_gotchar = 'B' OR q_gotchar = 'b' THEN
33360	        BEGIN COMMENT &FB = File Backup command;
33390	          restore_command; dobackup;
33420	        END ELSE
33450	        BEGIN warning("Use &JU, &FI or &FC commands",NOTEXT);
33480	          GOTO endcommand;
33510	        END;
33540	      END;
33570	      arg1:= IF leading_number < 0 THEN
33600	      0 ELSE leading_number; restore_command;
33630	      adjustmulti;
33660	      FOR multic:= 1 STEP 1 UNTIL multi DO
33690	      BEGIN move_the_cursor_to(hstart,vtop+multic);
33720	        IF q_gotchar = '-' THEN avstava(arg1,commandchar = 'J') ELSE
33750	        justify(arg1,commandchar = 'J',q_gotchar NE 'I');
33780	      END;
33810	    END ELSE IF commandchar = 'Z' THEN
33840	    BEGIN arg1:= intin;
33870	      restore_command; z_scroll(arg1);
33900	    END ELSE IF commandchar = 'D' THEN
33930	    BEGIN arg1:= IF leading_number < 0 THEN 1 ELSE leading_number;
33960	      restore_command; adjustmulti;
33990	      FOR multic:= 1 STEP 1 UNTIL multi DO
34020	      BEGIN move_the_cursor_to(hstart,vtop+multic);
34050	        removechars(arg1);
34080	      END; move_the_cursor_to(hstart,vstart);
34110	    END ELSE IF commandchar = 'K' THEN
34140	    BEGIN arg1:= IF leading_number < 0 THEN 1 ELSE leading_number;
34170	      restore_command; adjustmulti;
34200	      FOR multic:= 1 STEP 1 UNTIL multi DO
34230	      BEGIN move_the_cursor_to(hstart,vtop+multic);
34260	        IF q_horizontalpos = 0 AND q_verticalpos = 0 THEN
34290	        BEGIN nooutput:= TRUE; z_scroll(arg1);
34320	        END ELSE removelines(arg1);
34350	      END; move_the_cursor_to(hstart,vstart);
34380	    END ELSE IF commandchar = 'H' THEN
34410	    BEGIN restore_command; help;
     
34440	    END ELSE IF commandchar = 'P' THEN
34470	    BEGIN IF leading_number NE -100000 THEN
34500	      BEGIN arg1:= leading_number; nextchar;
34530	      END ELSE arg1:= intin;
34560	      IF NOT got_digit THEN
34590	      BEGIN signed:= TRUE; arg1:= 0;
34620	      END;
34650	      restore_command;
34680	      pagebottom:= q_gotchar = 'E' OR q_gotchar = 'e';
34710	      IF q_gotchar = 'F' OR q_gotchar = 'f' THEN
34740	      newpages(1000000,FALSE,TRUE) ELSE
34770	      IF q_gotchar = 'A' OR q_gotchar = 'a' THEN
34800	      BEGIN
34830	        IF NOT (endpage OR editin.endfile) OR lower_lines =/= NONE
34836	        THEN newpages(0,TRUE,FALSE);
34861	        append_page;
34890	      END
34920	      ELSE IF q_gotchar = 'I' OR q_gotchar = 'i' THEN pagedivide
34950	      ELSE IF q_gotchar = 's' OR q_gotchar = 'S' THEN
34980	      BEGIN
35010	        psearch:= TRUE; pbottom:= arg1;
35040	        IF pbottom <= 1 THEN pbottom:= 10;
35070	        pfound:= (endpage OR editin.endfile) AND lower_lines
35100	        == NONE AND (IF videdp THEN videdpcount ELSE
35114	        top_fill+heightm1) + pbottom < warningheight;
35131	        IF NOT pfound THEN
35160	        search_for(page_end_marker,'N',showdefault);
35190	        IF pfound THEN warning(
35220	        "Page with few lines found.",NOTEXT);
35250	      END ELSE IF q_gotchar = 'O' OR q_gotchar = 'o' THEN
35280	      warning("Have you written the letter O "
35310	      "instead of the digit 0? ",NOTEXT)
35340	      ELSE
35370	      BEGIN COMMENT &PE, &PT, &P;
35400	        IF q_gotchar < ' ' THEN
35430	        BEGIN COMMENT &P command;
35460	          IF NOT got_digit THEN arg1:= 1;
35490	        END ELSE
35520	        BEGIN
35550	          IF NOT pagebottom AND q_gotchar NE 'T' AND q_gotchar NE 't'
35580	          THEN GOTO endcommand; ! Neither &P nor &PE nor &PT;
35610	          IF NOT signed AND arg1 NE 0 THEN
35640	          arg1:= arg1-out_pagenumber; ! Absolute page no to relative;
35670	        END;
35700	        IF arg1 < 0 OR got_digit AND arg1 = 0 AND
35730	        sub_page_number > 1 THEN
35760	        BEGIN startpage:= arg1+out_pagenumber-1;
35790	          IF sub_page_number > 1 THEN startpage:= startpage-1;
35820	          GOTO roundabout;
35850	        END ELSE
35880	        BEGIN newpages(arg1,pagebottom,FALSE);
35910	          IF NOT pagebottom AND sub_page_number > 1 THEN
35940	          warning("Cannot find top of large page.",
35970	          "Push RETURN and write &-0PT to find real page top.");
36000	        END;
36030	      END;
     
36060	    END ELSE IF commandchar = 'Q' THEN
36090	    BEGIN
36120	      arg2:= -100000; anytextparameter:= TRUE;
36150	      WHILE letter(nextchar) OR digit(q_gotchar) DO;
36180	      IF command.pos > (IF q_gotchar = carriagereturn THEN 3 ELSE 4)
36210	      THEN qname:- copy(command.sub(3,command.pos-
36240	      (IF q_gotchar = carriagereturn THEN 3 ELSE 4)));
36270	      IF q_gotchar > ' ' OR qname == NOTEXT THEN commandchar:= null;
36300	      anytextparameter:= FALSE;
36330	      arg1:= IF q_gotchar < ' ' THEN 1 ELSE intin;
36360	      IF q_gotchar = ' ' THEN arg2:= intin ELSE
36390	      BEGIN arg2:= arg1; arg1:= 0;
36420	      END;
36450	      restore_command;
36480	      qregistercall:
36510	      checkvalue(arg1,0); checkvalue(arg2,0);
36540	      IF qname = NOTEXT THEN
36570	      qname:- warning( "You gave no qregister name.",NOTEXT)
36600	      ELSE put_register(qname,arg1,arg2);
36630	    END ELSE IF commandchar = 'A' THEN
36660	    BEGIN
36690	      arg1:= intin; arg2:= intin; restore_command;
36720	      checkvalue(arg1,0); checkvalue(arg2,0);
36750	      IF arg1 < width AND arg2 < height THEN
36780	      BEGIN move_the_cursor_to(arg1,arg2); command_done:= TRUE;
36810	      END;
36840	    END ELSE IF commandchar = 'G' THEN
36870	    BEGIN
36900	      WHILE letter(nextchar) OR digit(q_gotchar) DO;
36930	      IF q_gotchar = carriagereturn THEN
36960	      command.setpos(command.pos+1);
36990	      IF command.pos > stringstart+1 THEN
37020	      qname:-
37050	      copy(command.sub(stringstart,command.pos-stringstart-1));
37080	      restore_command; adjustmulti;
37110	      INSPECT find_qregister(qname) DO
37140	      BEGIN multistep:= qheight;
37170	        multi:= multi*multistep;
37200	        FOR multic:= 1 STEP multistep UNTIL multi DO
37230	        IF vtop + multic < height THEN
37260	        BEGIN move_the_cursor_to(hstart,vtop+multic);
37290	          get_register(THIS qregister);
37320	        END; move_the_cursor_to(hstart,vstart);
37350	      END;
37380	    END ELSE IF commandchar = 'I' OR commandchar = 'S' OR
37410	    commandchar = 'N' THEN
37440	    BEGIN
37470	      stringstart:= command.pos;
37500	      anytextparameter:= TRUE;
37530	      IF insertchar =/= NOTEXT AND commandchar = 'I' THEN BEGIN
37560	        ! Advanced I action if insertchar code is available;
37569	        IF trmop(8R0001,sysout,1) = 1 ! type ahead; THEN BEGIN
37576	          normaltext; restore_lines(vstart,vstart);
37583	        END;
37590	        restore_command; q_echoenabled:= TRUE; specialtext;
37620	      END;
37650	      WHILE TRUE DO nextchar;
37680	    END ELSE
37710	    endcommand:
37740	    BEGIN COMMENT handling of end of &I, &Q, &S and &N commands,
37770	      that is some of the commands taking nonnumerical parameters,
37800	      also handling of some ununderstandable commands;
37830	      IF insertchar == NOTEXT OR commandchar NE 'I'
37860	      THEN restore_command ELSE BEGIN ! Advanced I action;
37890	        q_echoenabled:= FALSE; normaltext;
37920	        screen[vstart].sub(hstart+1,belowcommand.pos-stringstart):=
37950	        belowcommand.sub(stringstart,belowcommand.pos-stringstart);
37980	      END;
38010	      IF commandchar = 'I' THEN
38040	      BEGIN COMMENT &I<qname>& command;
38070	        IF command.pos > stringstart THEN
38100	        qname:- command.sub(stringstart,command.pos-stringstart);
38130	        adjustmulti;
38160	        FOR multic:= 1 STEP 1 UNTIL multi DO
38190	        BEGIN move_the_cursor_to(hstart,vtop+multic);
38220	          insert(qname,insertchar =/= NOTEXT AND multic = 1);
38250	        END; IF multi > 1 THEN move_the_cursor_to(hstart,vstart);
38280	      END ELSE IF commandchar = 'S' OR commandchar = 'N' THEN
38310	      BEGIN COMMENT &nS<qname>& and &nN<qname>& command;
38340	        IF command.pos > stringstart THEN
38370	        qname:- command.sub(stringstart,command.pos-stringstart);
38400	        IF qname = NOTEXT THEN
38430	        qname:- old_search_string ELSE
38460	        BEGIN oldnarg:= IF leading_number < 0 THEN showdefault
38490	          ELSE leading_number;
38520	          old_search_string:- copy(qname);
38550	        END;
38580	        psearch:= FALSE;
38610	        FOR multic:= 1 STEP 1 UNTIL multi DO
38640	        BEGIN search_for(qname,commandchar,oldnarg);
38670	          IF multic < multi THEN
38700	          BEGIN IF editin.endfile AND lower_lines == NONE THEN
38730	            GOTO exit_nsearch;
38760	          END;
38790	        END;
38820	        exit_nsearch:
38850	      END ELSE
38880	      IF commandchar = 'Q' THEN
38910	      BEGIN COMMENT &Q<qname>& command;
38940	        IF arg2 < 0 THEN
38970	        BEGIN arg2:= arg1; arg1:= 0;
39000	        END;
39030	        IF qname == NOTEXT
39060	        AND command.pos > stringstart THEN
39090	        qname:-
39120	        copy(command.sub(stringstart,command.pos-stringstart));
39150	        GOTO qregistercall;
39180	      END;
39210	    END;
39240	    COMMENT End of the handling a VIDED command, ignore type ahead
39270	    made by the user during the performance of the action of the
39300	    VIDED command, and restore the screen if there was too much type
39330	    ahead before the beginning of the handling of the VIDED command;
39360	    IF NOT q_echoenabled THEN
39390	    BEGIN WHILE trmop(8R0001,sysout,1) = 1 !=type ahead; DO getch;
39420	      IF verybadscreen THEN
39450	      BEGIN restore_screen(q_verticalpos, 998);
39480	        verybadscreen:= badscreen:= FALSE;
39510	      END ELSE echon;
39540	    END;
39570	    getout: nooutput:= FALSE; !z_t(-19);
39600	    IF NOT command_done THEN
39630	    warning(" The VIDED command was never EXECUTED!",NOTEXT);
39660	    autobackcount:= autobackcount+1;
39690	    IF autobackcount > autobackup THEN dobackup;
39720	  END of getcommand;
     
39750	  PROCEDURE edit;
39780	  COMMENT This procedures contains a loop with one step for every
39810	  character typed by the user which is to be included in the text
39840	  being edited. (Not characters in the inputting of VIDED commands
39870	  preceded by ESCAPE or CONTROL-F). The procedure checks if the
39900	  character is a single character command like CONTROL-U and
39930	  performs the appropriate action;
39960	  BEGIN INTEGER vpos, hpos; COMMENT pos before last character read;
39990	    IF terminaltype = elite3025 THEN ! inverse video;
40020	    BEGIN outchr(sysout,altmode,1); outchr(sysout,'O',1);
40050	      outchr(sysout,char(16r31),1);
40080	    END;
40110	    WHILE TRUE DO
40140	    BEGIN
40170	      vpos:= q_verticalpos; hpos:= q_horizontalpos;
40200	      COMMENT read one character;
40230	      COMMENT%IFNOT CALLMAC
40260	      call(p_insingle);
40290	      COMMENT%IF CALLMAC;
40320	      vtisng(cpunumber);
40350	      COMMENT%IFEND CALLMAC;
40380	      IF NOT q_echoenabled THEN
40410	      BEGIN COMMENT shall we restore echoing if no type ahead?;
40440	        IF NOT trmop(8R0001,sysout,1) = 1 !=type ahead; THEN echon;
40470	      END;
40500	      COMMENT%IF VIDTIM
40530	      outchr(vidtim,q_gotchar,1);
40560	      COMMENT%IFEND VIDTIM;
40590	      COMMENT%IF debugslow
40620	      IF debugslow > 0 THEN sleep(debugslow);
40650	      COMMENT%IFEND debugslow;
40680	      IF controlchar THEN
40710	      BEGIN COMMENT character < 32 or > 126 or preceded by ESCAPE;
40740	        IF q_gotchar EQ carriagereturn THEN
40770	        BEGIN
40800	          IF hpos > 0 THEN
40830	          autobackcount:= autobackcount+1;
40860	        END ELSE
40890	        BEGIN
40920	          IF q_gotchar = linefeed THEN
40950	          BEGIN
40980	            IF vpos >= heightm1 THEN
41010	            BEGIN
41040	              emptyscroll:= TRUE; call(p_scroll);
41070	              emptyscroll:= FALSE;
41100	            END;
41130	            IF autobackcount > autobackup THEN dobackup;
41160	          END ELSE
41190	          BEGIN
41220	            IF q_gotchar = altmode THEN
41250	            BEGIN
41280	              IF terminaltype = minitec OR terminaltype = tandberg
41310	              THEN outchr(terminalout,delayer,2);
41340	              getcommand(NOTEXT);
41370	            END ELSE IF q_gotchar = control_f
41400	            OR q_gotchar = comstartchar THEN getcommand(NOTEXT)
41430	            ELSE IF q_gotchar = tab THEN position_tab(TRUE)
41460	            ELSE IF q_gotchar = fill THEN
41490	            BEGIN COMMENT RUB OUT;
41520	              IF hpos = 0 AND vpos > 0 THEN
41550	              BEGIN COMMENT RUB OUT at beginning of line goes back
41580	                to end of previous line;
41610	                vpos:= vpos-1;
41640	                hpos:= screen(vpos).strip.length;
41670	                IF hpos > widthm1 THEN hpos:= widthm1;
41700	                move_the_cursor_to(hpos,vpos);
41730	              END;
41760	            END ELSE IF q_gotchar = control_u THEN
41790	            BEGIN IF q_gotchar NE right THEN blank_front;
41820	            END ELSE IF q_gotchar = control_d THEN
41850	            removechars(1) ELSE IF q_gotchar = control_v THEN
41880	            BEGIN insert(line_model.sub(1,1),FALSE);
41910	              move_the_cursor_to(hpos,vpos);
41940	            END ELSE IF q_gotchar = control_w THEN
41970	            BEGIN IF terminaltype = infoton THEN
42000	              removeword;
42030	            END ELSE
42060	            IF insline NE null AND q_gotchar = insline THEN
42090	            addline ELSE
42120	            IF delline NE null AND q_gotchar = delline THEN
42150	            removeline ELSE
42180	            IF inschar NE null AND q_gotchar = inschar THEN
42210	            charinsert ELSE
42240	            IF delchar NE null AND q_gotchar = delchar THEN
42270	            removechar ELSE
42300	            IF unknownchar THEN
42330	            BEGIN IF terminaltype = vt52 AND q_gotchar = char(6) THEN
42360	              getcommand(NOTEXT) ELSE
42390	              IF letter(q_gotchar) THEN BEGIN
42420	                IF terminaltype = volker414h THEN BEGIN
42450	                  IF q_gotchar = 'B' THEN getcommand("I")  ELSE
42480	                  IF q_gotchar = 'C' THEN getcommand("X")  ELSE
42510	                  IF q_gotchar = 'D' THEN getcommand("-X") ELSE
42540	                  IF q_gotchar = 'E' THEN getcommand("S")  ELSE
42570	                  IF q_gotchar = 'F' THEN getcommand("N")  ELSE
42600	                  IF q_gotchar = 'G' THEN getcommand("K")  ELSE
42630	                  IF q_gotchar = 'H' THEN getcommand("1L");
42660	                END ELSE IF terminaltype = elite3025 THEN BEGIN
42690	                  IF q_gotchar = 'q' THEN getcommand("I")  ELSE
42720	                  IF q_gotchar = 'r' THEN getcommand("X")  ELSE
42750	                  IF q_gotchar = 's' THEN getcommand("-X") ELSE
42780	                  IF q_gotchar = 't' THEN getcommand("S")  ELSE
42810	                  IF q_gotchar = 'u' THEN getcommand("N")  ELSE
42840	                  IF q_gotchar = 'v' THEN getcommand("K")  ELSE
42870	                  IF q_gotchar = 'w' THEN getcommand("1L") ELSE
42900	                  GOTO restore;
42930	                END ELSE GOTO restore;
42960	              END ELSE restore: restore_screen(q_verticalpos, 998);
42990	            END;
43020	          END;
43050	        END;
43080	      END ELSE
43110	      BEGIN COMMENT NOT controlchar;
43140	        IF badscreen THEN COMMENT LF at bottom of a page;
43170	        BEGIN echoff; emptyscroll:= TRUE; call(p_scroll);
43200	          emptyscroll:= badscreen:= FALSE;
43230	          restore_screen(q_verticalpos,998);
43260	        END ELSE
43290	        IF hpos >= widthm1 THEN
43320	        BEGIN echoff; hpos:= q_horizontalpos; vpos:= q_verticalpos;
43350	          restore_lines(IF vpos > 0 THEN vpos-1 ELSE vpos,vpos);
43380	          move_the_cursor_to(hpos,vpos);
43410	        END;
43440	      END;
43470	    END;
43500	  END;
     
43530	  PROCEDURE stop_editing;
43560	  BEGIN GOTO stopedit;
43590	  END;
43620	
43650	  PROCEDURE closefiles;
43680	  INSPECT sysout DO
43710	  BEGIN COMMENT close edit text files;
43740	    IF NOT backuping THEN
43770	    BEGIN
43800	      outtext(" INPUT FILE """);
43830	      outtext(arg[3]); outchar('"'); outimage;
43860	      outtext(" OUTPUT FILE """);
43890	      outtext(arg[(IF tmpoutfile THEN 3 ELSE 1)]); outchar('"');
43920	      outimage;
43950	    END;
43980	    IF NOT tmpoutfile THEN
44010	    BEGIN editin.close; editout.close;
44040	    END ELSE
44070	    BEGIN COMMENT delete old backup file, rename input file to
44100	      backup extension, rename output file to the name of the input
44130	      file;
44160	      TEXT bakfilename; CHARACTER c; INTEGER i;
44190	      bakfilename:- copy(inspec);
44220	      COMMENT backup file takes extension beginning with .Q;
44250	      FOR i:= 0 STEP 1 UNTIL IF merryentry THEN 1 ELSE 0 DO
44280	      BEGIN
44310	        bakfilename.setpos(1); scanto(bakfilename,'.');
44340	        bakfilename.setpos(bakfilename.pos+i);
44370	        c:= fetchar(bakfilename,bakfilename.pos);
44400	        IF c NE '[' AND c NE '<' THEN
44430	        bakfilename.putchar('Q') ELSE
44460	        bakfilename:- conc(front(bakfilename),"Q",rest(bakfilename));
44490	      END;
44520	      depchar(bakfilename,bakfilename.length-3,'0');
44550	
44580	      outimage;
44610	      IF rename(bakfilename,NOTEXT,FALSE) > 0 THEN
44640	      BEGIN COMMENT Old backup file could not be deleted;
44670	        outtext("?VIDED - CANNOT DELETE FILE: ");
44700	        outtext(bakfilename);
44730	        outimage; merrygoround:= FALSE;
44760	        editin.close; editout.close;
44790	      END ELSE
44820	      BEGIN
44850	        IF NOT backuping THEN
44880	        BEGIN
44910	          outtext(" INPUT FILE WILL BE RENAMED TO: ");
44940	          outtext(bakfilename); outimage;
44970	        END;
45000	        IF rename(editin,bakfilename,TRUE) >= 0 THEN
45030	        BEGIN COMMENT input file could not be renamed to backup
45060	          name;
45090	          outtext("?VIDED - CANNOT RENAME INPUT FILE: ");
45120	          outtext(inspec); editout.close; merrygoround:= FALSE;
45150	        END ELSE
45180	        BEGIN
45210	          IF rename(editout,inspec,TRUE) >= 0 THEN
45240	          BEGIN COMMENT temporary output file could not be renamed
45270	            to the name of the input file;
45300	            outtext("?VIDED - CANNOT RENAME OUTPUT FILE: ");
45330	            outtext(arg[1]); merrygoround:= FALSE;
45360	          END;
45390	        END;
45420	      END;
45450	      sysout.outimage;
45480	    END;
45510	  END;
     
45540	  COMMENT start of execution;
45570	
45600	  IF terminaltype = volker414h THEN ! check EOM charcter;
45614	  BEGIN echoff; outchr(sysout,altmode,1);
45660	    outchr(sysout,'-',1); forceout(sysout);
45674	    volkeomchar:= getch;
45720	    IF volkeomchar = ' ' THEN volkeomchar:= getch ! control-D;
45750	    ELSE
45810	    IF volkeomchar = carriagereturn THEN getch ! read line feed;
45825	    ELSE volkeomchar:= char(0);
45840	    echon;
45870	  END;
45900	
45930	  dashblank:- copy("- ");
45960	  IF arg[18] =/= NOTEXT THEN direct_cursor_addressing:= TRUE;
45990	  IF arg[19] =/= NOTEXT THEN direct_cursor_addressing:= FALSE;
46020	  IF arg[20] =/= NOTEXT THEN allow_cr:= FALSE;
46050	  IF arg[21] =/= NOTEXT THEN allow_cr:= TRUE;
46080	
46110	  COMMENT write TMPCOR TMP:TRM file with terminal info;
46140	  tmpout("TRM",conc(arg[2],copy(IF direct_cursor_addressing
46170	  THEN "/DCA" ELSE "/-DCA")));
46200	
46230	  mainloop: IF arg[23] =/= NOTEXT THEN swedish:= TRUE;
46260	
46290	  IF NOT merrygoround THEN
46320	  BEGIN
46350	    IF pageheader THEN
46380	    BEGIN
46410	      sid_word:- IF arg[25] =/= NOTEXT
46440	      THEN storbokstav(conc(arg[25]," "))
46470	      ELSE copy("SID "); page_word:- copy("PAGE ");
46500	      header:- blanks(IF increment > 0 THEN width-8 ELSE width);
46530	      header.setpos((header.length-sid_word.length-3)//2);
46560	      puttext(header, IF swedish
46590	      OR arg[25] =/= NOTEXT THEN sid_word ELSE page_word);
46620	      puttext(header,"00");
46650	      defaultheader:- copy(header.strip);
46680	    END;
46710	    restorechar:= erasescreen;
46740	    line_model:- blanks(width);
46770	    set_tty_tab;
46800	    settab(0,'R'); ! Initial default tab settings;
46830	  END of NOT merrygoround;
46860	  margset('L',leftmargin);
46890	  editout_image:- editout.image;
46920	  printing:= TRUE;
46950	  first_text_pos:= IF increment = 0 THEN 0 ELSE 8;
46980	  scrollallow:= TRUE; first_input_line:= TRUE;
47010	  out_pagenumber:= 1;
47040	  initialload; pagenumber:= 1; ! Load first page;
47070	  IF pageheader THEN adjust_date(screen[0]);
47100	  IF merrygoround THEN
47130	  BEGIN newpages(startpage,pagebottom,FALSE);
47160	    IF backuping THEN
47190	    BEGIN
47220	      printing:= FALSE; q_verticalpos:= heightm1;
47250	      WHILE top_fill < backupzscroll OR sub_page_number <
47280	      backupsubpage DO call(p_scroll);
47310	      printing:= TRUE; normaltext;
47340	      IF badscreen OR checksum NE backupchecksum
47370	      THEN restore_screen(0,998) ELSE
47400	      BEGIN screen_length[0]:= 45;
47430	        restore_lines(0,0);
47460	      END;
47490	      move_the_cursor_to(backuphor,backupvert);
47520	      backuping:= FALSE;
47550	    END of backuping;
47580	  END ELSE restore_screen(0,showdefault); ! show first page to user;
47610	  merrygoround:= FALSE;
47640	  IF trmop(8R0001,sysout,1) = 1 ! type ahead; THEN
47670	  echoff ELSE echon;
47700	  edit; COMMENT start of editing;
47730	  stopedit:
47760	  IF NOT q_echoenabled THEN echon;
47790	  IF merrygoround THEN roundabout:
47820	  BEGIN merrygoround:= TRUE; echoff;
47850	  END ELSE
47880	  BEGIN
47910	    backuping:= merrygoround:= FALSE;
47940	    q_display_output:= TRUE;
47970	  END;
48000	
48030	  INSPECT sysout DO
48060	  BEGIN
48090	    IF backuping THEN
48120	    BEGIN home_the_cursor;
48150	      specialtext;
48180	      IF startblink NE char(0) THEN
48210	      BEGIN IF addaltmode THEN outchar(altmode);
48240	        outchar(startblink);
48270	      END;
48300	    END ELSE blankterminal;
48330	    outtext(IF merrygoround THEN
48360	    "***** FILE BACK-UP IN PROGRESS. *****    "
48390	    ELSE "VIDED IS FINISHING.");
48420	    IF backuping AND startblink NE char(0) THEN
48450	    BEGIN IF addaltmode THEN outchar(altmode);
48480	      outchar(stopblink);
48510	      breakoutimage;
48540	    END ELSE breakoutimage;
48570	  END of inspect sysout;
48600	  finalwrite;
48630	  closefiles;
48660	  IF NOT merrygoround THEN restore_trmops;
48690	  detach;
48720	  GOTO mainloop;
48750	END of class vided3x;
     
48780	topstart: COMMENT start of execution is here!!!!;
48810	before_editing;
48840	
48870	IF the_editor == NONE THEN
48900	the_editor:- NEW vided3x(
48930	width, height,
48960	COMMENT%IF debugterminal
48990	newsysin, newsysout, NOT debug,
49020	COMMENT%IFNOT debugterminal;
49050	sysin, sysout, TRUE,
49080	COMMENT%IFEND debugterminal;
49110	terminaltype,giventrmspeed)
49140	ELSE call(the_editor);
49170	
49200	stopedit:
49230	COMMENT remember initial parameter settings at continued execution;
49260	BEGIN INTEGER i;
49290	  IF NOT merrygoround THEN
49320	  BEGIN
49350	    IF arg[24] =/= NOTEXT THEN run(arg[24],1);
49380	    COMMENT%IF stat
49410	    stat.close;
49440	    COMMENT%IF stat
49470	    stat:- NONE;
49500	    COMMENT%IFEND stat;
49530	    exit(0);
49560	    FOR i:= 1 STEP 1 UNTIL keys DO
49590	    BEGIN
49620	      IF arg[i] =/= NOTEXT THEN
49650	      BEGIN ini[i]:- arg[i]; arg[i]:- NOTEXT;
49680	        ini[i].setpos(1);
49710	      END;
49740	    END;
49770	  END;
49800	  IF merrygoround THEN
49830	  BEGIN IF tmpoutfile THEN arg[1]:- arg[3];
49860	    arg[3]:- NOTEXT;
49890	  END ELSE
49920	  BEGIN
49950	    ini[1]:- ini[3]:- NOTEXT;
49980	    tmpoutfile:= FALSE;
50010	    COMMENT%IF VIDTIM
50040	    vidtim.close;
50070	    COMMENT%IFEND VIDTIM;
50100	    COMMENT%IF FQC
50130	    Goto totalstop;
50160	    COMMENT%IFEND FQC;
50190	  END;
50220	  GOTO topstart;
50250	END;
50280	totalstop:
50310	END;