Program Totalogram;
Var ch:string;
(**************************************)
Function lettre_maj_esp (ch:string):boolean;
Var i:integer;
test:boolean;
Begin
i:=1;
test:=true;
While (i<=length(ch)) and (test) do 
if ch[i] in ['A'..'Z',' '] Then i:=i+1 
Else test:=false;
lettre_maj_esp:=test;
End;
(************************************)
Function totalogramme (ch:string):boolean;
Var p:integer;
test:boolean;
Begin
ch:=ch+' ';
Repeat
p:=pos(' ',ch);
test:=ch[1]=ch[p-1];
delete(ch,1,p);
Until (test=false) or (ch='');
totalogramme:=test;
End;
(**************** P.P ******************)
Begin
Repeat
Writeln('Saisir une chaîne en majuscule :');
Readln(ch);
Until lettre_maj_esp(ch);
If totalogramme(ch) Then writeln('totalogramme')
Else writeln('non totalogramme');
End.