Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/comp/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;