home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECO_EDIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-06-14  |  24.1 KB  |  711 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21. *)
  22. {$V-,F+,O+}
  23. {$M 65520,0,65520}
  24. unit eco_edit;
  25. interface
  26. uses
  27.  
  28.   unit_scn,
  29.  
  30.   ttt_key,  unit_key,
  31.  
  32.   bined,    dos,
  33.  
  34.   ECO_utl,  ECO_time, ECO_pasc,
  35.  
  36.   unit_ext, unit_fil,
  37.   unit_str, unit_sup
  38.  
  39.   ;
  40.  
  41. var
  42.   exitcommand,
  43.   hours, minutes,
  44.   seconds, tics,
  45.   year, month,
  46.   day, errorcode  :    word;
  47.   edfilesize      : longint;
  48.   st,filename     :  string;
  49.   eddata          :    edcb;
  50.  
  51.  
  52. const
  53.   windx1                               = 2;
  54.   windx2                               = 79;
  55.   windy1                               = 2;
  56.   windy2                               = 24;
  57.   editortimer     : byte               = 1;
  58.   backupwait      : byte               = 5;
  59.   makebackup      : boolean            = false;
  60.   extension       : string[3]          = 'TXT';
  61.   boxes: array[1..4,1..4,1..3] of char =
  62.   (
  63.    (('┌','┬','┐'), ('├','┼','┤'), ('└','┴','┘'), ('│','─','─')),
  64.    (('╔','╦','╗'), ('╠','╬','╣'), ('╚','╩','╝'), ('║','═','═')),
  65.    (('╓','╥','╖'), ('╟','╫','╢'), ('╙','╨','╜'), ('║','─','─')),
  66.    (('╒','╤','╕'), ('╞','╪','╡'), ('╘','╧','╛'), ('│','═','═'))
  67.   );
  68.  
  69.   exitcommands    : array[0..24] of char =
  70.   ( #2,            { editor exit commands   }
  71.     #0, #59,  #2,  { 0     f1: help         }
  72.     #0, #17,  #2,  { 1  alt-w: save         }
  73.     #0, #68,  #2,  { 2    f10: size/shift   }
  74.     ^k,  ^s,  #2,  { 3  redraw editor       }
  75.     #0, #30,  #2,  { 4  alt-a: accent chars }
  76.     #0, #44,  #2,  { 5  alt-z: ascii chars  }
  77.     #0, #17,  #2,  { 6  alt-w: weird chars  }
  78.     #0, #48,  #0   { 7  alt-b: box chars    }
  79.   );
  80.  
  81.  
  82.   procedure call_editor;
  83.  
  84.  
  85. implementation
  86.  
  87.  
  88. procedure writeupstat(st: string);
  89. begin
  90.   clearline(1,invf,invb);
  91.   writeat(1,1,invf,invb,st)
  92. end;
  93.  
  94.  
  95. procedure writednstat(st: string);
  96. begin
  97.   clearline(25,invf,invb);
  98.   writeat(1,25,invf,invb,st)
  99. end;
  100.  
  101.  
  102. procedure initstatusline;
  103. var i: shortint;
  104. begin                       {initstatusline}
  105.   writednstat(' f1help  f2      f3      f4stat  f5      '+
  106.               'f6      f7      f8      f9ascii f0menu');
  107.   for i := 0 to 9 do attrib(i*8+2,25,i*8+3,25,8,15)
  108. end;
  109.  
  110.  
  111. procedure hidnstat;
  112. begin
  113.   attrib(1,25,80,25,8,15)
  114. end;
  115.  
  116.  
  117. procedure initupstat;
  118. begin
  119.   clearline(1,invf,invb); xy(2,1); colors(invf,invb); ECO_message;
  120. end;
  121.  
  122.  
  123. procedure initdnstat;
  124. var i: shortint;
  125. begin
  126.    clearline(25,invf,invb); writeat(1,25,invf,invb,
  127.      ' f1help  f2      f3      f4stat  f5     '+
  128.      ' f6      f7      f8      f9ascii f0menu');
  129.    for i := 0 to 9 do attrib(i*8+2,25,i*8+3,25,8,15)
  130. end;
  131.  
  132.  
  133. function yesanswer(prompt : string) : boolean;
  134. var ch : char;
  135. begin
  136.   writednstat(prompt); repeat ch:=upcase(readkey) until ch in ['y', 'n'];
  137.   yesanswer := ch='y';
  138. end;
  139.  
  140.  
  141. function choose_ascii_char: string;
  142. begin
  143.    setchooseascii(58,4);
  144.    mkwin(65,8,69,15,lc,black,1); delay(50); rmwin;
  145.    mkwin(58,4,76,22,lightgray,blue,0);
  146.    choose_ascii_char := chooseascii ;rmwin
  147. end;
  148.  
  149.  
  150.  
  151. function choose_weird_char: string;
  152. var
  153.   weird : shortint;
  154.   toets :     char;
  155.   i     :  integer;
  156. begin
  157.   mkwin(54,6,60,7,lc,black,1); delay(50); rmwin;
  158.   mkwin(40,5,72,8,lc,black,2); weird := 1;
  159.   writebetween(weird+40,72,5,hc,black,' Choose Weird Char ');
  160.   for i := 1 to 31 do writeat(40+i,6,lc,black,chr(i));
  161.   writeat(weird+40,7,lc+blink,black,''); offcursor;
  162.   repeat
  163.     toets := getkey;
  164.     writeat(weird+40,7,lc,black,' ');
  165.     if (toets=_left) or (toets=mleft) then weird := weird - 1;
  166.     if weird<1 then weird := 31;
  167.     if (toets=_right) or (toets=mright) then weird := weird + 1;
  168.     if weird>31 then weird := 1;
  169.     writeat(weird+40,7,lc+blink,black,'');
  170.   until toets in [_esc, _enter, menter, mesc];
  171.   rmwin;
  172.   if toets in [menter,_enter] then
  173.     choose_weird_char := chr(weird) else choose_weird_char := #00;
  174.   oncursor
  175. end;
  176.  
  177.  
  178.  
  179. function choose_accent_char: string;
  180. const
  181.   accents: array [1..33] of char = (
  182.     'á','à','ä','â','å','æ','Æ','Å','Ä','ç','Ç',
  183.     'é','è','ë','ê','É','í','ì','ï','î','ñ','Ñ',
  184.     'ó','ò','ö','ô','Ö','ú','ù','ü','û','Ü','ÿ'
  185.   );
  186. var
  187.   accent : shortint;
  188.   toets  :     char;
  189.   i      :  integer;
  190. begin
  191.   mkwin(55,6,60,7,lc,black,1); delay(50); rmwin;
  192.   mkwin(40,5,74,8,lc,black,2); accent := 1;
  193.   writebetween(40,74,5,hc,black,' Choose Accent Char ');
  194.   for i := 1 to 33 do writeat(40+i,6,lc,black,accents[i]);
  195.   writeat(accent+40,7,lc+blink,black,''); offcursor;
  196.   repeat
  197.     toets := getkey;
  198.     writeat(accent+40,7,lc,black,' ');
  199.     if toets in [mleft,_left] then accent := accent - 1;
  200.     if accent<1 then accent := 33;
  201.     if toets in [_right,mright] then accent := accent + 1;
  202.     if accent>33 then accent := 1;
  203.     writeat(accent+40,7,lc+blink,black,'');
  204.   until toets in [_esc,_enter,menter,mesc];
  205.   rmwin;
  206.   if toets in [menter,_enter] then choose_accent_char := accents[accent]
  207.                               else choose_accent_char := #00;
  208.   oncursor
  209. end;
  210.  
  211.  
  212. function choose_box_char: string;
  213. const
  214.  boxpos: array[1..4,1..4,1..3] of record x,y: integer end = (
  215.  (((x:27;y:7),(x:30;y:7),(x:33;y:7)),((x:27;y:9),(x:30;y:9),(x:33;y:9)),
  216.   ((x:27;y:11),(x:30;y:11),(x:33;y:11)),((x:27;y:14),(x:30;y:14),(x:30;y:14))),
  217.  (((x:40;y:7),(x:43;y:7),(x:46;y:7)),((x:40;y:9),(x:43;y:9),(x:46;y:9)),
  218.   ((x:40;y:11),(x:43;y:11),(x:46;y:11)),((x:40;y:14),(x:43;y:14),(x:43;y:14))),
  219.  (((x:53;y:7),(x:56;y:7),(x:59;y:7)),((x:53;y:9),(x:56;y:9),(x:59;y:9)),
  220.   ((x:53;y:11),(x:56;y:11),(x:59;y:11)),((x:53;y:14),(x:56;y:14),(x:56;y:14))),
  221.  (((x:66;y:7),(x:69;y:7),(x:72;y:7)),((x:66;y:9),(x:69;y:9),(x:72;y:9)),
  222.   ((x:66;y:11),(x:69;y:11),(x:72;y:11)),((x:66;y:14),(x:69;y:14),(x:69;y:14)))
  223.  );
  224.  
  225. var
  226.   j,a,b,c        :  integer;
  227.   dk,toets       :     char;
  228.   boxx,boxy,boxz : shortint;
  229.  
  230. begin
  231.   mkwin(47,7,52,13,lightgray,black,1); delay(50); rmwin;
  232.   mkwin(24,5,75,15,lightgray,black,2); boxx:=1; boxy:=1; boxz:=1;
  233.   writebetween(24,75,5,yellow,black,' box characters '); j:=0;
  234.   for a:=1 to 4 do begin
  235.     for b:=1 to 3 do
  236.       for c:=1 to 3 do
  237.         writeat(14+a*10+b*3+j,5+c*2,lightgray,black,boxes[a][c][b]);
  238.     inc(j,3);
  239.   end;
  240.   j:=0;
  241.   for a:=1 to 4 do begin
  242.     for b:=1 to 2 do writeat(14+a*10+b*3+j,14,lightgray,black,boxes[a][4][b]);
  243.     inc(j,3);
  244.   end;
  245.  
  246.   repeat
  247.  
  248.     attrib(boxpos[boxx,boxy,boxz].x,boxpos[boxx,boxy,boxz].y,
  249.            boxpos[boxx,boxy,boxz].x,boxpos[boxx,boxy,boxz].y,black+blink,7);
  250.     toets:=getkey;
  251.     attrib(boxpos[boxx,boxy,boxz].x,boxpos[boxx,boxy,boxz].y,
  252.            boxpos[boxx,boxy,boxz].x,boxpos[boxx,boxy,boxz].y,lightgray,black);
  253.  
  254.     case toets of
  255.       mleft,_left: begin
  256.         if boxy<4 then begin
  257.           if boxz>1 then dec(boxz) else begin boxz:=3; dec(boxx) end;
  258.         end else if boxz>1 then dec(boxz) else begin boxz:=2; dec(boxx) end;
  259.         if boxx<1 then boxx:=4
  260.       end;
  261.  
  262.       mright,_right: begin
  263.         if boxy<4 then begin
  264.           if boxz<3 then inc(boxz) else begin boxz:=1; inc(boxx) end;
  265.         end else if boxz<2 then inc(boxz) else begin boxz:=1; inc(boxx) end;
  266.         if boxx>4 then boxx:=1
  267.       end;
  268.  
  269.       mup,_up: if boxy>1 then dec(boxy) else boxy:=4;
  270.  
  271.       mdown,_down: if boxy<4 then inc(boxy) else boxy:=1
  272.  
  273.     end; {case}
  274.  
  275.   until toets in [_enter,_esc,menter,mesc];
  276.  
  277.   rmwin;
  278.   if toets in [_enter,menter] then choose_box_char:=(boxes[boxx,boxy,boxz])
  279.   else choose_box_char:=#00
  280. end; { box }
  281.  
  282.  
  283. procedure removebackup(bakname: string);
  284. var exitcode: word;
  285. begin
  286.   if __existfil(bakname) then begin
  287.     writednstat('Removing backup files...');
  288.     __erasefil(bakname,exitcode); delaykey(1000);
  289.   end;
  290. end;
  291.  
  292.  
  293. procedure show_overall_statistics(filename: string);
  294. var d: string;
  295.     drivechar: char;
  296. const monostr: string[7] = ' Mode  ';
  297. begin
  298.   d := __timestr(hours,minutes,seconds,tics);
  299.   writeat(18,13,lc,black,
  300.     padright(int_to_str(hours),2,'0')+':'+
  301.     padright(int_to_str(minutes),2,'0')+'   '+
  302.     __datestr(year,month,day));
  303.   writeat(18,14,lightgray,black,int_to_str(memavail)+' Bytes free ram-memory.');
  304.   writeat(18,15,lightgray,black,'DOS Version: '+
  305.     int_to_str(_dosmajorver)+'.'+ int_to_str(_dosminorver));
  306.   d := fexpand(filename); drivechar := d[1];
  307.   writeat(18,16,lc,black,
  308.     int_to_str(diskfree( ord(drivechar)-ord('A') + 1 ) ) +
  309.     ' '+drivechar+':');
  310.   writeat(18,17,lc,black,'Current directory:'); getdir(0, d);
  311.   writeat(18,18,lc,black,__packfil(d,46));
  312.   d := 'working on a ';
  313.   case _pcmachine of
  314.     _munknown: d:=d+'MS-DOS';         _mpc: d:=d+'PC';
  315.          _mxt: d:=d+'XT';           _mpcjr: d:=d+'PCJR';
  316.          _mat: d:=d+'AT';          _mat3x9: d:=d+'AT3X9';
  317.         _mxt2: d:=d+'XT2';         _mxt286: d:=d+'XT286';
  318.         _mcvt: d:=d+'CVT';        _mps2_25: d:=d+'PS2_25';
  319.      _mps2_30: d:=d+'PS2_30'; _mps2_30_286: d:=d+'PS2_30_286';
  320.      _mps2_50: d:=d+'PS2_50';     _mps2_60: d:=d+'PS2_60';
  321.      _mps2_70: d:=d+'PS2_70';     _mps2_80: d:=d+'PS2_80'
  322.           else d:=d+' Unknown model'
  323.   end; { case }
  324.   d := d + ' computer with';
  325.   writeat(18,19,lc,black,d); d := 'a ';
  326.   case _pcprocessor of
  327.      _8088: d:=d+'8088';   _80c88: d:=d+'80C88';
  328.      _8086: d:=d+'8086';   _80188: d:=d+'80188';
  329.     _80186: d:=d+'80186';  _80286: d:=d+'80286';
  330.     _80386: d:=d+'80386'      else d:=d+'80486??'
  331.   end; { case }
  332.   d := d + ' processor and ';
  333.   case _test8087 of
  334.     0: d := d + 'no co-processor.'; 1: d := d + 'a 8087 co-processor.';
  335.     2: d := d + 'a 80287 co-processor.'; 3: d := d + 'a 80387 co-processor.'
  336.     else d := d + 'a 80487 extra processor?'
  337.   end; { case }
  338.   writeat(18,20,lc,black,d);
  339.   d := 'Video: ';
  340. {  if _monoadapter <> _absent then
  341.   d := d + 'Monochrome-' +color_type[_monoadapter] + monostr;
  342.   if _coloradapter <> _absent then
  343.   d := d + 'Hercules-' +color_type[_coloradapter] + monostr;
  344.   if _egaadapter <> _absent then
  345.   d := d + 'CGA-' +color_type[_egaadapter] + monostr;
  346.   if _hercadapter <> _absent then
  347.   d := d + 'EGA-' +color_type[_hercadapter] + monostr;
  348.   if _mcgaadapter <> _absent then
  349.   d := d + 'VGA-' +color_type[_mcgaadapter] + monostr;
  350.   if _vgaadapter <> _absent then
  351.   d := d + 'MCGA-' +color_type[_vgaadapter] + monostr;
  352. }  writeat(18,21,lc,black,d);
  353. end;
  354.  
  355.  
  356.  
  357. procedure show_statistics(filename: string);
  358. var key: char;
  359. begin
  360.   mkwin(38,8,42,15,lightgray,black,1); delay(50); rmwin;
  361.   mkwin(15,3,65,23,yellow,black,1);
  362.   writecenter(3,yellow,black,' View statistics ');
  363.   writeat(18,5,lightgray,black,'Current file:');
  364.   writeat(18,6,lightgray,black,__packfil(fexpand(filename),46));
  365.   if eddata.status>0 then writeat(18,7,lightgray,black,'Modified.')
  366.                      else writeat(18,7,lightgray,black,'Not modified.');
  367.   writeat(18,8,lightgray,black,
  368.     int_to_str(eddata.bufsize)+' bytes total buffer size.');
  369.   writeat(18,9,lightgray,black,
  370.     int_to_str(eddata.eotext)+' bytes of text used.');
  371.   writeat(18,10,lightgray,black,
  372.     int_to_str(eddata.bufsize-eddata.eotext)+' bytes still available.');
  373.   if eddata.blockstart<>eddata.blockend then
  374.     writeat(18,11,lightgray,black,'Marked block of '+
  375.     int_to_str(abs(eddata.blockend-eddata.blockstart))+' bytes.')
  376.   else writeat(18,11,lightgray,black,'No marked block.');
  377.   show_overall_statistics(filename); key:= getkey; rmwin;
  378. end;
  379.  
  380.  
  381. procedure checkreadfile(exitcode:word; fname:string);
  382.   {-check the results of the file read}
  383. var f:file;
  384. begin
  385.   if exitcode <> 0 then begin {couldn't read file}
  386.     case exitcode of
  387.      1: begin {new file, assure valid file name}
  388. {$I-}  assign(f, fname); rewrite(f);
  389.        if ioresult <> 0 then begin
  390.          close(f);
  391.          writednstat(' illegal file name '+__packfil(fexpand(fname),38));
  392.        end else begin
  393.          close(f); erase(f); write('new file...'); delay(2000);
  394.          write(^m); gotoxy(1, 1); exit;
  395.        end;
  396. {$I+}end;
  397.      2: writednstat(' insufficient text buffer size.');
  398.      else writednstat(' unknown read error.'); errorbeep;
  399.     end; {case} hidnstat; delay(1500);
  400.   end;
  401. end; {checkreadfile}
  402.  
  403.  
  404.  
  405. procedure readfilefromdisc(var filnam:string);
  406. begin               {filename must be expanded}
  407.   filnam:= fexpand(filnam);
  408.   if __isdrvfil(filnam[1],errorcode) then begin
  409.     if (pos('*',filnam)=0) and (pos('?',filnam)=0) then
  410.       if __existfil(filnam) then begin
  411.         edfilesize:= file_size(filnam);
  412.         writednstat(' sizing buffer attempt to:' +
  413.           int_to_str(edfilesize)+' bytes out of available:' +
  414.           int_to_str(eddata.bufsize)+' bytes.');
  415.         delay(2000); resetbinaryeditor(eddata);
  416.         if edfilesize>eddata.bufsize then begin
  417.           writednstat(' fc cannot read ≥64k files.'); errorbeep;
  418.           hidnstat; delay(3000); initstatusline; exit;
  419.         end;
  420.         writednstat(' reading ' +
  421.           __packfil(filnam,50) + ' into file buffers.');
  422.         exitcode := readfilebinaryeditor(eddata,filename); delay(1000);
  423.         checkreadfile(exitcode,filenamebinaryeditor(eddata));
  424.         if exitcode<2 then begin
  425.           filename:= filnam; resetbinaryeditor(eddata);
  426.           starttimer(editortimer)
  427.         end else begin
  428.           writednstat(' error! - memory adjusted, file not loaded...');
  429.           hidnstat; errorbeep; delay(2000)
  430.         end;
  431.       end else begin
  432.         writednstat(' file not found.');
  433.         hidnstat ;errorbeep; delay(1000);
  434.         if yesanswer(' Create a new file? (y/n) ') then begin
  435.           filename:= filnam; exitcode:= readfilebinaryeditor(eddata,filename);
  436.           starttimer(editortimer)
  437.         end;
  438.       end;
  439.   end else begin
  440.     case errorcode of
  441.       1: writednstat(' drive does not exist, reconsider!');
  442.       2: writednstat(' door of drive is open (360k)'+
  443.                      ' or no disc is mounted (720k)');
  444.       3: writednstat(' disc is not formatted!'+
  445.                      ' format first before use. (dos:format x:)');
  446.     end; {case} errorbeep; hidnstat; delay(2500);
  447.   end;
  448. end;
  449.  
  450.  
  451. procedure checksavefile(exitcode:word; filename:string);
  452.   {-check the results of a file save}
  453. begin                       {checksavefile}
  454.   if exitcode <> 0 then begin
  455.     {couldn't save file}
  456.     case exitcode of
  457.       1: writednstat(' unable to create output file '+__packfil(fexpand(filename),45));
  458.       2: writednstat(' error while writing output to '+__packfil(fexpand(filename),45));
  459.       3: writednstat(' unable to close output file '+__packfil(fexpand(filename),45));
  460.       else writednstat(' unknown write error.');
  461.     end; {case} hidnstat; errorbeep; delay(1500);
  462.   end else starttimer(editortimer);
  463. end;                        {checksavefile}
  464.  
  465.  
  466. function exitbinaryeditor(var eddata:edcb; exitcommand:integer):boolean;
  467.                      {-handle an editor exit - save or abandon file}
  468. var
  469.   exitcode :   word;
  470.   delfil   :boolean;
  471.  
  472.  
  473.   procedure modifywindow(var eddata:edcb);
  474.      {-move or resize editor window interactively}
  475.   var
  476.     ch:char;       { kbflag:word absolute $0040:$0017; }
  477.     redraw, done, scroll:boolean;   { lastkbflag:word; }
  478.  
  479.  
  480.     procedure updatescreen(var eddata:edcb);
  481.      {-update the screen after the window is resized}
  482.     var junk:word;
  483.     begin                   {updatescreen}
  484.       {redraw the window box}
  485.       restorescreen(1);
  486.       writednstat(' '+#24#25#26#27+
  487.         ' to move/resize window. <scrolllock> moves. <enter> accepts.' );
  488.       with eddata do fbox(x1,y1,x2+2,y2+2,yellow,black,1);
  489.       with eddata do writebetween(x1,x2+2,y1,yellow,black,'editor');
  490.       if not(keypressed) then begin
  491.         {force the editor to update the screen and return}
  492.         junk:= usebinaryeditor(eddata, ^k^s); {^k^s is nul optie voor redraw}
  493.         redraw:= false;
  494.         with eddata do writebetween(x1,x2+2,y1,yellow,black,' editor ');
  495.       end;
  496.     end; {updatescreen}
  497.  
  498.   begin {modifywindow}
  499.     with eddata do begin
  500.       {show a prompt for resizing}
  501.       writednstat(' '+#24#25#26#27+
  502.         ' to move/resize window. <scrolllock> moves. <enter> accepts.');
  503.       done:= false; redraw:= false;
  504.       repeat {update the screen}
  505.         if redraw then updatescreen(eddata);
  506.         ch:=getkey; if scrollon then scroll:= true else scroll:= false;
  507.         case ch of
  508.          _left,mleft:
  509.             if scroll then begin
  510.               if x1 > 1 then begin
  511.                 fbox(x1,y1,x2+2,y2+2,yellow,black,0);
  512.                 writebetween(x1,x2+2,y1,yellow,black,' editor ');
  513.                 x1:= pred(x1); x2:= pred(x2); redraw:= true;
  514.               end;
  515.             end else if x2 > x1+30 then begin
  516.               fbox(x1,y1,x2+2,y2+2,yellow,black,0);
  517.               writebetween(x1,x2+2,y1,yellow,black, ' editor ');
  518.               x2:= pred(x2); redraw:= true;
  519.             end;
  520.           mright,_right:
  521.             if scroll then begin
  522.               if x2 < 78 then begin
  523.                 fbox(x1,y1,x2+2,y2+2,yellow,black,0);
  524.                 writebetween(x1,x2+2,y1,yellow,black,' editor ');
  525.                 x1:= succ(x1); x2:= succ(x2); redraw:= true;
  526.               end;
  527.             end else if x2 < 78 then begin
  528.               fbox(x1,y1,x2+2,y2+2,yellow,black,0);
  529.               writebetween(x1,x2+2,y1,yellow,black,' editor ');
  530.               x2:= succ(x2); redraw:= true;
  531.             end;
  532.           mup,_up:
  533.             if scroll then begin
  534.               if y1 > 2 then begin
  535.                 fbox(x1,y1,x2+2,y2+2,yellow,black,0);
  536.                 writebetween(x1,x2+2,y1,yellow,black,' editor ');
  537.                 y1:= pred(y1); y2:= pred(y2); redraw:= true;
  538.               end;
  539.             end else if y2 > y1+3 then begin
  540.               fbox(x1,y1,x2+2,y2+2,yellow,black,0);
  541.               writebetween(x1,x2+2,y1,yellow,black,' editor ');
  542.               y2:= pred(y2); redraw:= true;
  543.             end;
  544.           mdown,_down:          {down arrow}
  545.             if scroll then begin
  546.               if y2 < 22 then begin
  547.                 fbox(x1,y1,x2+2,y2+2,yellow,black,0);
  548.                 writebetween(x1,x2+2,y1,yellow,black,' editor ');
  549.                 y1:= succ(y1); y2:= succ(y2); redraw:= true;
  550.               end;
  551.             end else if y2 < 22 then begin
  552.               fbox(x1,y1,x2+2,y2+2,yellow,black,0);
  553.               writebetween(x1,x2+2,y1,yellow,black,' editor ');
  554.               y2:= succ(y2); redraw:= true;
  555.             end;
  556.         end; {case}
  557.       until ch in [menter,_enter]; initstatusline;
  558.     end;
  559.   end; {modifywindow}
  560.  
  561. begin {exitbinaryeditor}
  562.   exitbinaryeditor:= false; savecursor;
  563.   case exitcommand of
  564.     -1,0: exitbinaryeditor:= true;
  565.     1: begin
  566.          if modifiedfilebinaryeditor(eddata) then begin
  567.            writednstat(' Writing file buffers to disc...');
  568.            exitcode:= savefilebinaryeditor(eddata,makebackup);
  569.            checksavefile(exitcode,filenamebinaryeditor(eddata));
  570.            removebackup(filename);
  571.          end else errorbeep;
  572.        end;
  573.     2: modifywindow(eddata);
  574.     3: ;{ do nothing at all! just force redrawal ^k^s }
  575.     4: st := __stuffkey(choose_accent_char);
  576.     5: st := __stuffkey(chr(16)+choose_ascii_char);
  577.     6: st := __stuffkey(chr(16)+choose_weird_char);
  578.     7: st := __stuffkey(choose_box_char);
  579.     8: show_statistics(filename);
  580.   end; { case }
  581.   if not(exitcommand in [6..9]) then __flushkey;
  582.   loadcursor; initstatusline;
  583. end; {exitbinaryeditor}
  584.  
  585.  
  586.  
  587. procedure call_editor;
  588. var st:string;
  589. begin
  590.   mkwin(38,9,42,16,lightgray,black,1); delay(50); rmwin;
  591.   initstatusline; oncursor;
  592.   with eddata do fbox(x1,y1,x2+2,y2+2,yellow,black,1);
  593.   with eddata do writebetween(x1,x2+2,y1,yellow,black,'[Editor]');
  594.   __flushkey;
  595.   repeat
  596.     loadcursor; with eddata do box(x1,y1,x2+2,y2+2,yellow,black,1);
  597.     with eddata do writebetween(x1,x2+2,y1,yellow,black,'[Editor]');
  598.     exitcommand:= usebinaryeditor(eddata,''); savecursor
  599.   until exitbinaryeditor(eddata,exitcommand); { stuffkey for exitcmd ? }
  600. end;
  601.  
  602.  
  603. procedure writefileonexit;
  604. begin
  605.    if modifiedfilebinaryeditor(eddata)
  606.    then if yesanswer(' File modified. Still want to save it? (y/n)') then begin
  607.      writednstat(' Writing file buffers to disc...');
  608.      exitcode := savefilebinaryeditor(eddata,makebackup);
  609.      checksavefile(exitcode,filenamebinaryeditor(eddata));
  610.      removebackup(filename);
  611.    end else errorbeep;
  612. end;
  613.  
  614.  
  615. function createbackup(var eddata : edcb; bakname: string) : word;
  616. {
  617.  -save the current file as backup, returning a status code
  618.  
  619.      status codes -
  620.       0 = successful save
  621.       1 = file creation error
  622.       2 = disk write error
  623.       3 = error closing file
  624. }
  625. var
  626.  f : file;
  627.  i, byteswritten : word;
  628.  
  629. begin
  630.   with eddata do
  631.   begin
  632.      assign(f, bakname); rewrite(f, 1);
  633.      if ioresult <> 0
  634.      then begin
  635.              createbackup := 1; close(f);
  636.              i := ioresult; {clear ioresult}
  637.              exit;
  638.           end;
  639.      blockwrite(f, buffer^, succ(eotext), byteswritten);
  640.      if (byteswritten <> succ(eotext)) or (ioresult <> 0)
  641.      then begin
  642.              createbackup := 2;
  643.              close(f);
  644.              exit;
  645.            end;
  646.      close(f);
  647.      if ioresult <> 0
  648.      then begin
  649.             createbackup := 3;
  650.             exit;
  651.           end;  {reset editor modified bit}
  652.      status := 0; {success status}
  653.      createbackup := 0;
  654.   end;
  655. end;
  656.  
  657.  
  658. procedure writebackuptodisc;
  659. var
  660.   dotpos    :   byte;
  661.   bakname,
  662.   newname   : string;
  663.   c         :   char;
  664.   retcode   :   word;
  665.  
  666. begin
  667.   mkwin(10,9,70,17,highbkgdf,highbkgdb,1);
  668.   writecenter(9,highbkgdf,highbkgdb,' backup file ');
  669.   writecenter(12,highbkgdf,highbkgdb,' temporarily backing up the file buffers in file:');
  670.   errorbeep; newname:= fexpand(filename);
  671.   dotpos:= succ(length(newname));
  672.   repeat dec(dotpos); c:= newname[dotpos] until (c = '.') or (c = '\') or (c = ':') or (dotpos = 0);
  673.   if (dotpos = 0) or (c <> '.') then bakname:= newname+'.■B■'
  674.   else bakname:= copy(newname, 1, dotpos)+'■B■';
  675.   writecenter(14,highbkgdf,highbkgdb,__packfil(fexpand(bakname),56)); delay(2000);
  676.   retcode:= createbackup(eddata,bakname); errorbeep;
  677.   if retcode>0 then cleartext(15,9,65,17,highbkgdf,highbkgdb);
  678.   case retcode of
  679.    1:writecenter(13,highbkgdf,highbkgdb,' Backup creation error');
  680.    2:writecenter(13,highbkgdf,highbkgdb,' Disk backup write error');
  681.    3:writecenter(13,highbkgdf,highbkgdb,' Error closing backup file.');
  682.   end; { case }
  683.   if retcode>0 then begin
  684.     errorbeep; writednstat(' WATCH OUT!   Inspect this phenomena immediately!');
  685.     hidnstat; delay(3500)
  686.   end; rmwin;
  687. end;
  688.  
  689.  
  690. {$F+}
  691. procedure editor_event_handler;
  692. var length:shortint;
  693. begin
  694.   if str_to_int(copy(getlaptime(editortimer),4,2)) >= backupwait then begin
  695.     writebackuptodisc; starttimer(editortimer); { restart count-down }
  696.   end;
  697. end;
  698. {$F-}
  699.  
  700.  
  701.  
  702. begin
  703.   filename := fexpand('NOTES.TXT');
  704.   exitcode := initbinaryeditor(
  705.     eddata,maxfilesize,windx1,windy1,windx2,windy2,
  706.     colorscreen and not(egavgasystem),
  707.     edoptinsert+edoptindent,extension,exitcommands,@editor_event_handler);
  708.     exitcode := readfilebinaryeditor(eddata,filename);
  709.   {call_editor;}
  710. end.
  711.