Напечатать заданный текст, удалив из него лишние пробелы

VAR
  s, TempWord, LastWord: STRING;
  i: BYTE;
  
FUNCTION Last(c: STRING): BOOLEAN;
{Ôóíêöèÿ ðàâíà true, åñëè àðãóìåíò ðàâåí ïîñëåäíåìó ñëîâó}
BEGIN{Last}
  IF c = LastWord
  THEN
    Last := TRUE
  ELSE
    Last := FALSE
END;{Last}  
  
FUNCTION Repeating(c: STRING): BOOLEAN;
{Ôóíêöèÿ ðàâíà true, åñëè åñòü ïîâòîðÿþùèåñÿ áóêâû â àðãóìåíòå}
VAR
  j, k: BYTE;
BEGIN{Repeating} 
  Repeating := FALSE; 
  FOR j := 1 TO Length(c) - 1
  DO
    FOR k := j + 1 TO Length(c)
    DO
      IF c[j] = c[k]
      THEN
        Repeating := TRUE
END;{Repeating}  
  
BEGIN
  READ(s);
  s := ' ' + s + ' ';
  
  BEGIN{Íàõîäèì ïîñëåíåå ñëîâî}
    i := Length(s) - 1;
    LastWord := '';
    REPEAT
      LastWord := s[i] + LastWord;
      Dec(i)
    UNTIL s[i] = ' '
  END;
 
  TempWord := '';
  FOR i := 1 TO Length(s){Ïðîñìàòðèâàåì ñòðîêó}
  DO 
    BEGIN
      IF s[i] <> ' '
      THEN
        TempWord := TempWord + s[i]
      ELSE
        BEGIN
          IF NOT Last(TempWord)
          THEN
            IF NOT Repeating(TempWord)
            THEN
              WRITE(TempWord, ' ');
          TempWord := ''
        END
    END 
END.

VAR
  s, TempWord: STRING;
  i: BYTE;
  
FUNCTION ContainsK(c: STRING): BOOLEAN;
{Ôóíêöèÿ ðàâíà true, åñëè åñòü áóêâà k â àðãóìåíòå}
VAR
  j: BYTE;
BEGIN{ContainsK} 
  ContainsK := FALSE; 
  FOR j := 1 TO Length(c)
  DO
    IF c[j] = 'k'
    THEN
      ContainsK := TRUE
END;{ContainsK}  
  
BEGIN
  READ(s);
  s := s + ' ';  
  TempWord := '';
  
  FOR i := 1 TO Length(s){Ïðîñìàòðèâàåì ñòðîêó}
  DO 
    BEGIN
      IF s[i] <> ' '
      THEN
        TempWord := TempWord + s[i]
      ELSE
        BEGIN
          IF ContainsK(TempWord)
          THEN
            WRITE(TempWord, ' ');
          TempWord := ''
        END     
    END 
END.

VAR
  s: STRING;
  i: INTEGER;
BEGIN
  READ(s);
  IF s[1] <> ' '
  THEN
    WRITE(s[1]);
  FOR i := 2 TO Length(s)
  DO
    IF s[i] = ' '
    THEN
      BEGIN
        IF s[i - 1] <> ' '
        THEN
          WRITE(s[i])
      END
    ELSE
      WRITE(s[i])
END.

var
a:string;
i:integer;
begin
readln(a);
for i:=length(a) downto 2 do
if (a[i]=' ')and(a[i-1]=' ')then delete(a,i,1); 
writeln(a);
readln;
end.