{PICS0H1.INC  Pascal Integrated Communications System}
{ 6/4/87 vers 1.6 Copyright 1987 by Les Archambault}

Overlay  procedure mesg_save(to_loc: integer; subj: subject; var stop_msg: boolean);
  { Save message to disk }
    var
      start, line_count: integer;
      this: TextPtr;
      file_time: tad_array;
      str: StrTAD;
    begin
      Writeln(USR);
      if (msg_status=private) and (test_bit(user_rec.flags,2)) then
        msg_status:=restricted;
      if (msg_status = private) and (user_rec.access >= val_acc) and
      (valid_pw) and (not test_bit(user_rec.flags,3))
        then if ask('Want Mesg. public') then
          begin
            if restrict_public then msg_status:=restricted
            else msg_status:=public;
          end;
      if msg_status=restricted then
        writeln(usr,'Msg. available after Sysop OK');
      start := filesize(mesg_file);
      seek(mesg_file, start);
      line_count := 0;
      this := TextBase;
      while this <> nil do
        begin
          Write(mesg_file, this^.TextMsg);
          line_count := succ(line_count);
          this := this^.next
        end;
      if line_count > 0
        then
          begin
            GetTAD(file_time);
            str := FormTAD(file_time);
            seek(summ_file, 0);
            read(summ_file, summ_rec);
            with summ_rec do
              begin
                date      := file_time;
                status    := msg_status;
                area      := to_area;
                num       := succ(num);
                num_prev  := 0;   { used for protecting public msgs}
                if user_rec.access>=250 then num_next:=255
                else num_next  := 0;   {used for foward file references}
                user_from := user_loc;
                user_to   := to_loc;
                subject   := subj;
                st_rec    := start;
                size      := line_count
              end;
            seek(summ_file, 0);
            Write(summ_file, summ_rec);
            seek(summ_file, filesize(summ_file));
            Write(summ_file, summ_rec);
            mesg_insert(2);
            case msg_status of
              private: Write(USR, 'Private');
              public,restricted:  Write(USR, 'Public')
            end;
            Writeln(USR, ' message ', summ_rec.num, ' filed ', str)
          end;
      stop_msg := TRUE;
    end;

Overlay procedure mesg_quit(var stop_msg: boolean);
  { Return to command mode }
    begin
      Writeln(USR);
      Writeln(USR, 'Message not filed.');
      stop_msg := TRUE;
      mult_cmds:=false; cmd_queue:='';
    end;

procedure dummy_one;
   begin
   end;

begin  {message enter}
 abort:=false;
 if (diskfree(homdrv,homusr)>maxfree_abs) or
       (not test_bit(user_rec.flags,4)) then
  begin
    if diskfree(homdrv,homusr)<=maxfree_mslimit then
      begin
        limit_lines:=true;
        max_msg_lines:=maxfree_lines; {restrict because not enough space left on disk}
      end;
    if user_rec.access < val_acc
      then list('D');
    Writeln(USR);
    Writeln(USR, 'From: ', user_rec.fn, ' ', user_rec.ln);
    OK := FALSE;
    if in_conference then msg_status := public
    else msg_status:=private;
    repeat
      if (user_rec.access < val_acc) or
         (to_ctrl = 'S') or
         ((to_ctrl = 'A') and (summ_rec.user_from = 0))
        then
          begin
            to_fn := 'SYSOP';
            Writeln(USR, '  To: ', to_fn);
            to_area:=1;                     {Post area}
          end
      else if (to_ctrl = 'A') and (summ_rec.user_from > 0)
        then
          begin
            to_loc := summ_rec.user_from;
            to_area:=summ_rec.area;
            OK := TRUE;
            GetRec(DatF, to_loc, temp_user_rec);
            to_fn := temp_user_rec.fn;
            to_ln := temp_user_rec.ln;
            Writeln(USR, '  To: ', to_fn, ' ', to_ln)
          end
        else
          begin
            to_fn := prompt('To FIRST name [CR for ALL]', len_fn, 'ESL');
            if to_fn='QUIT' then abort:=true;
            if (user_rec.fn='SYSOP') and (areaset=0) then to_area:=1
            else to_area:=areaset;
          end;
      if to_fn = ''
        then
          begin
            to_loc := 0;
            if (restrict_public or test_bit(user_rec.flags,3))
            and (not in_conference) then
              msg_status:=restricted
            else
              msg_status := public;
            OK := TRUE
          end
      else if to_fn = 'SYSOP'
        then to_ln := ''
      else if (to_ctrl <> 'A') and (not abort) then
         begin
           to_ln := prompt('LAST name', len_ln, 'ESL');
           if to_ln='QUIT' then abort:=true;
         end;
       if (not OK) and (not abort) then
         begin
           key := pad(to_ln, len_ln) + pad(to_fn, len_fn);
           FindKey(IdxF, to_loc, key);
           if not OK then
             begin
               Writeln(USR, to_fn, ' ', to_ln, ' not known on system.');
               writeln(usr,'type QUIT to exit .');
             end;
         end;
    until (not online) or OK or abort;
    if abort then OK:=false;
    if OK then
      begin
        if not valid_pw
          then
            begin
              subj := 'Password problem';
              Writeln(USR, '  Re: ', subj)
            end
        else if user_rec.access < val_acc
          then
            begin
              subj := 'New user';
              Writeln(USR, '  Re: ', subj)
            end
        else if To_Ctrl='A' then
            begin
             X:= Pos('Reply To - ',summ_rec.subject);
             If X>0 then subj:= summ_rec.subject
             else
             subj:= 'Reply To - ' + summ_rec.subject;
             Writeln(USR, subj);
            end
        else subj := prompt('Subject', len_subj, 'EL');
        if subj='' then subj:='NONE';
        Writeln(USR);
        if limit_lines then
           begin
            writeln(usr,'Message is limited to ',max_msg_lines,' lines.');
            writeln(usr);
           end;
        Writeln(USR, 'When Message finished, enter an empty line. <CR>');
        Writeln(USR, 'Ready for message...');
        TextBase := nil;
        last_line := 1;
        mesg_input(last_line);
        stop_msg := FALSE;
        if TextBase<>nil then
          begin
            repeat
              Writeln(USR);
              st:=prompt('Edit command <C><D><E><I><L><S><Q><?>',80, 'ES?');
              if length(st)=1 then ch:=st[1]
              else st:=' ';
              case ch of
                'C': mesg_input(last_line);
                'D': begin
                       mesg_edit('D');
                       mesg_print;
                     end;
                'E': mesg_edit('E');
                'I': begin
                       mesg_insert_line;
                       mesg_print;
                     end;
                'L': mesg_print;
                'S': mesg_save(to_loc, subj, stop_msg);
                'Q': mesg_quit(stop_msg)
              else  list('E');
              end;
            until (not online) or (stop_msg and (ch in ['C','D','E','I','L','S','Q']));
          end
        else
         Writeln(usr,'Unable to continue message  - aborting. ');
        while TextBase <> nil do
          begin
            this := TextBase;                   { Get rid of list elements }
            TextBase := TextBase^.next;
            dispose(this)
          end;
      end;        {OK}
  end          {enough disk space and allowed}
  else
    begin
      if test_bit(user_rec.flags,4) then
       writeln(usr,'Unable to accept messages.')
      else
       Writeln(usr,'Not enough disk space for messages.');
    end;
end;

{ end of PICS0H1.inc }