menus3.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
(*****************************************************************************)
(*> <*)
(*> MENUS3 .PAS - Written by Eric Oman <*)
(*> <*)
(*> Menu command execution routines. <*)
(*> <*)
(*****************************************************************************)
{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit menus3;
interface
uses
crt, dos,
{rcg11172000 no overlay under Linux.}
{overlay,}
file0,
common;
procedure dochangemenu(var done:boolean; var newmenucmd:astr;
c2:char; mstr:astr);
implementation
procedure dochangemenu(var done:boolean; var newmenucmd:astr;
c2:char; mstr:astr);
var s,s1:astr;
begin
case c2 of
'^':begin
s1:=mstr;
if (pos(';',s1)<>0) then s1:=copy(s1,1,pos(';',s1)-1);
if (mstr<>'') then begin
s:=mstr;
if (pos(';',s)<>0) then s:=copy(s,pos(';',s)+1,length(s));
if (copy(s,1,1)='C') then menustackptr:=0;
if (pos(';',s)=0) or (length(s)=1) then s:=''
else s:=copy(s,pos(';',s)+1,length(s));
end;
if (s1<>'') then begin
last_menu:=curmenu; curmenu:=systat.menupath+s1+'.mnu';
done:=TRUE;
if (s<>'') then newmenucmd:=allcaps(s);
newmenutoload:=TRUE;
end;
end;
'/':begin
s1:=mstr;
if (pos(';',s1)<>0) then s1:=copy(s1,1,pos(';',s1)-1);
if ((mstr<>'') and (menustackptr<>8)) then begin
s:=mstr;
if (pos(';',s)<>0) then s:=copy(s,pos(';',s)+1,length(s));
if (copy(s,1,1)='C') then menustackptr:=0;
if (pos(';',s)=0) or (length(s)=1) then s:=''
else s:=copy(s,pos(';',s)+1,length(s));
inc(menustackptr);
menustack[menustackptr]:=stripname(curmenu);
end;
if (s1<>'') then begin
last_menu:=curmenu; curmenu:=systat.menupath+s1+'.mnu';
done:=TRUE;
if (s<>'') then newmenucmd:=allcaps(s);
newmenutoload:=TRUE;
end;
end;
'\':begin
s:=mstr;
if (menustackptr<>0) then begin
last_menu:=curmenu;
curmenu:=systat.menupath+menustack[menustackptr];
dec(menustackptr);
end;
if (copy(s,1,1)='C') then menustackptr:=0;
done:=TRUE;
if (pos(';',s)=0) then s:='' else
newmenucmd:=allcaps(copy(s,pos(';',s)+1,length(s)));
newmenutoload:=TRUE;
end;
end;
end;
end.