{ ROSMSG.INC - Remote Operating System Message Sub-system }

overlay procedure mesg_enter(comment: boolean);
{ Enter a new message }
  type
    TextPtr     = ^TextRecord;
    TextRecord  =
      record
        LineNo  : integer;                  { Line number }
        TextMsg : message;                  { Summary index }
        next    : TextPtr                   { Pointer to next element on list }
      end;
  var
    stop_msg: boolean;
    ch: char;
    last_line, to_loc: integer;
    TextBase, TextLast, this: TextPtr;
    to_fn: firstname;
    to_ln: lastname;
    subj: subject;
    key: StrName;

  procedure mesg_input(var last_line: integer);
  { Input message }
    var
      ch: char;
      this: TextPtr;
      msg: StrStd;
    begin
      writeln(USR);
      msg := ' ';
      next_inpstr := '';
      while (not brk) and (msg <> '') do
        begin
          msg := next_inpstr;
          write(USR, last_line:2, ': ');
          GetStr(msg, ch, len_msg, 'AEW');
          writeln(USR);
          if msg <> ''
            then
              begin
                new(this);
                if TextBase = nil
                  then TextBase := this
                  else TextLast^.next := this;
                TextLast := this;
                TextLast^.LineNo := last_line;
                TextLast^.TextMsg := msg;
                TextLast^.next := nil;
                last_line := succ(last_line)
              end
        end
    end;

  procedure mesg_print;
  { Display message currently being edited }
    var
      this: TextPtr;
    begin
      writeln(USR, 'From: ', user_rec.fn, ' ', user_rec.ln);
      writeln(USR, '  To: ', to_fn, ' ', to_ln);
      writeln(USR, '  Re: ', subj);
      writeln(USR);
      this := TextBase;
      while (not brk) and (this <> nil) do
        begin
          writeln(USR, this^.LineNo:2, ': ', this^.TextMsg);
          this := this^.next
        end
    end;

  procedure mesg_edit;
  { Edit selected line from message }
    var
      ch: char;
      i: integer;
      this: TextPtr;
      msg: StrStd;
    begin
      writeln(USR);
      i := strint(prompt('Line number: ', 2, 'E'));
      writeln(USR);
      this := TextBase;
      while (i <> this^.LineNo) and (this <> nil) do
        this := this^.next;
      if this <> nil
        then
          begin
            msg := this^.TextMsg;
            write(USR, i:2, ': ');
            GetStr(msg, ch, len_msg, 'AEW');
            writeln(USR);
            if msg <> ''
              then this^.TextMsg := msg;
          end
        else writeln(USR, 'Line not found.')
    end;

  procedure mesg_save(to_num: integer; subj: subject; var stop_msg: boolean);
  { Save message to disk }
    var
      start, line_count: integer;
      this: TextPtr;
      file_time: tad_array;
      st: StrTAD;
    begin
      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;

      writeln(USR);
      if line_count > 0
        then
          begin
            GetTAD(file_time);
            st := FormTAD(file_time);
            seek(summ_file, 0);
            read(summ_file, summ_rec);
            with summ_rec do
              begin
                summ_area     := AreaSet;
                summ_num      := succ(summ_num);
                summ_date     := file_time;
                summ_from_num := user_loc;
                summ_to_num   := to_num;
                summ_subject  := subj;
                summ_st_rec   := start;
                summ_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);

            writeln(USR, 'Message ', summ_rec.summ_num, ' filed ', st)
          end
        else writeln(USR, 'Empty message not filed.');
      stop_msg := TRUE
    end;

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

  begin { mesg_enter }
    if user_rec.access < 20
      then list('D');
    writeln(USR);
    writeln(USR, 'From: ', user_rec.fn, ' ', user_rec.ln);
    repeat
      if comment or (user_rec.access < 20)
        then
          begin
            to_fn := 'SYSOP';
            writeln(USR, '  To: ', to_fn)
          end
        else
          begin
            to_fn := prompt('To FIRST name or <RETURN> for ALL: ', len_fn, 'ES');
            writeln(USR)
          end;
      if to_fn = ''
        then
          begin
            to_loc := mesg_pub;
            OK := TRUE
          end
        else
          begin
            if to_fn = 'SYSOP'
              then to_ln := ''
              else
                begin
                  to_ln := prompt('LAST name: ', len_ln, 'ES');
                  writeln(USR)
                end;
            key := pad(to_ln, len_ln) + pad(to_fn, len_fn);
            FindKey(IdxF, to_loc, key);
            if not OK
              then writeln(USR, to_fn, ' ', to_ln, ' not known on system.')
          end
    until (not online) or OK;
    if user_rec.access < 20
      then
        begin
          subj := 'New user';
          writeln(USR, '  Re: ', subj)
        end
      else
        begin
          subj := prompt('Subject: ', len_subj, 'E');
          writeln(USR)
        end;
    writeln(USR);
    writeln(USR, 'To return to command mode, enter an empty line.');
    writeln(USR, 'Ready for message...');
    TextBase := nil;
    last_line := 1;
    mesg_input(last_line);
    stop_msg := FALSE;
    repeat
      writeln(USR);
      case select('Command', 'ListEditContinueSaveQuit') of
        'L': mesg_print;
        'E': mesg_edit;
        'C': mesg_input(last_line);
        'S': mesg_save(to_loc, subj, stop_msg);
        'Q': mesg_quit(stop_msg);
        '?': list('E')
      end
    until (not online) or stop_msg;
    while TextBase <> nil do
      begin
        this := TextBase;                   { Get rid of list elements }
        TextBase := TextBase^.next;
        dispose(this)
      end
  end;

overlay procedure mesg_quick_scan;
{ Print abbreviated summary of messages }
  var
    private: boolean;
    sep: char;
  begin
    private := FALSE;
    mesg_find(mesg_start('Start'));
    writeln(USR);
    while (not brk) and (MesgCurr <> nil) do
      begin
        if MesgCurr^.TypMsg <> 0
          then
            begin
              private := TRUE;
              sep := '*'
            end
          else sep := ':';
        seek(summ_file, MesgCurr^.SummLoc);
        read(summ_file, summ_rec);
        writeln(USR, MesgCurr^.MesgNo, sep, ' ', summ_rec.summ_subject);
        MesgCurr := MesgCurr^.next
      end;
    if private
      then
        begin
          writeln(USR);
          writeln(USR, '"*" indicates a private message.')
        end
  end;

overlay procedure mesg_summary;
{ Message summary }
  var
    first_line, last_line: integer;
  begin
    mesg_find(mesg_start('Start'));
    while (not brk) and (MesgCurr <> nil) do
      begin
        mesg_header_list(MesgCurr^.SummLoc, first_line, last_line);
        MesgCurr := MesgCurr^.next
      end
  end;

overlay procedure mesg_read;
{ Read message }
  var
    i, first_line, last_line: integer;
  begin
    OK := TRUE;
    mesg_find(mesg_start('Start'));
    while (not brk) and (MesgCurr <> nil) and OK do
      begin
        if MesgCurr^.MesgNo > user_rec.lasthi
          then user_rec.lasthi := MesgCurr^.MesgNo;
        mesg_header_list(MesgCurr^.SummLoc, first_line, last_line);
        seek(mesg_file, first_line);
        i := 1;
        while (not brk) and (i <= last_line) do
          begin
            read(mesg_file, mesg_rec);
            writeln(USR, mesg_rec);
            i := succ(i)
          end;
        if (user_loc = summ_rec.summ_from_num) or
           (user_loc = summ_rec.summ_to_num) or
           (user_rec.access = 255)
          then if ask('Do you wish to ERASE this message')
                 then mesg_delete(0)
                 else
                   begin
                     writeln(USR, 'Message retained.');
                     if area_assign and (user_rec.access = 255)
                       then
                         begin
                           summ_rec.summ_area := strint(prompt('Message area # ', 3, 'E'));
                           writeln(USR);
                           seek(summ_file, pred(FilePos(summ_file)));
                           Write(summ_file, summ_rec)
                         end;
                     MesgCurr := MesgCurr^.next
                   end
          else MesgCurr := MesgCurr^.next;
        if MesgCurr <> nil
          then OK := ask('Read next message')
      end
  end;

overlay procedure mesg_kill;
{ Delete message }
  var
    start: integer;
  begin
    start := mesg_start('Message');
    mesg_find(start);
    if (MesgCurr^.MesgNo = start) and
       ((user_loc = summ_rec.summ_from_num) or
        (user_loc = summ_rec.summ_to_num) or
        (user_rec.access >= 200))
      then mesg_delete(start)
      else writeln(USR, 'Not found.')
  end;

overlay procedure mesg_area_change(req: Str10);
{ Change message area }
  var
    i: integer;
    this: AreaPtr;
    pr: StrPr;

  procedure mesg_build_index(area: byte);
  { Scan summary file and build message index list.  Public messages are
    tied to message area.  Private and authored messages are accessible
    from all areas.  All messages are viewable from area #0 (SYSTEM). }
    var
      this: MesgPtr;
    begin
      while MesgBase <> nil do              { Delete old messages }
        begin
          this := MesgBase;
          MesgBase := MesgBase^.next;       { Go to next on list }
          dispose(this)                     { Reclaim space }
        end;
      msg_all := 0;
      msg_ind := 0;
      msg_aut := 0;
      msg_sys := 0;
      seek(summ_file, 1);
      while not EOF(summ_file) do
        with summ_rec do
          begin
            read(summ_file, summ_rec);
            if (summ_to_num = mesg_pub) and (area = summ_area)
              then
                begin                       { Public message }
                  msg_all := succ(msg_all);
                  mesg_insert(0)
                end
            else if summ_to_num = user_loc
              then
                begin                       { Private message }
                  msg_ind := succ(msg_ind);
                  mesg_insert(1)
                end
            else if (summ_from_num = user_loc) and (summ_to_num <> mesg_era)
              then
                begin                       { Author of message }
                  msg_aut := succ(msg_aut);
                  mesg_insert(2)
                end
            else if area = 0
              then
                begin                       { Sysop can view all messages }
                  msg_sys := succ(msg_sys);
                  mesg_insert(3)
                end
          end
      end;

  procedure mesg_directory;
  { Display directory of messages }
    var
      hi: integer;
    begin
      if MesgBase = nil
        then hi := 0
        else hi := MesgLast^.MesgNo;
      writeln(USR, 'High message now  : ', hi);
      writeln(USR, 'Public messages   : ', msg_all);
      writeln(USR);
      if msg_ind = 0
        then writeln(USR, user_rec.fn, ', no personal mail for you today.')
        else
          begin
            writeln(USR, user_rec.fn, ', the following messages are addressed to you personally:');
            MesgCurr := MesgBase;
            while (not brk) and (MesgCurr <> nil) do
              begin
                if MesgCurr^.TypMsg = 1
                  then write(USR, MesgCurr^.MesgNo, '  ');
                MesgCurr := MesgCurr^.next
              end;
            writeln(USR)
          end;
      if msg_aut > 0
        then
          begin
            writeln(USR, user_rec.fn, ', the following messages were sent by you:');
            MesgCurr := MesgBase;
            while (not brk) and (MesgCurr <> nil) do
              begin
                if MesgCurr^.TypMsg = 2
                  then write(USR, MesgCurr^.MesgNo, '  ');
                MesgCurr := MesgCurr^.next
              end;
            writeln(USR)
          end
    end;

  begin { mesg_area_change }
    pr := 'Message area: ';
    if user_rec.help_level > 0
      then insert(' [press "?" for menu]', pr, 13);
    if req = ''
      then
        begin
          req := compress(prompt(pr, 10, 'ES?'));
          writeln(USR)
        end;
    while req <> '' do
      begin
        this := AreaBase;
        if req = '?'
          then
            begin
              writeln(USR, 'Available message areas:');
              writeln(USR);
              while (not brk) and (this <> nil) do
                begin
                  if user_rec.access >= this^.AreaAccs
                    then writeln(USR, pad(this^.AreaName, 14), this^.AreaDesc);
                  this := this^.next
                end;
              writeln(USR);
              req := compress(prompt(pr, 10, 'ES?'));
              writeln(USR)
            end
        else if req <> ''
          then
            begin
              while (req <> this^.AreaName) and (this <> nil) do
                this := this^.next;
              if (req = this^.AreaName) and (user_rec.access >= this^.AreaAccs)
                then
                  begin
                    AreaSet := this^.Area;
                    AreaReq := req;
                    req := '';
                    mesg_build_index(AreaSet);
                    mesg_directory
                  end
                else
                  begin
                    writeln(USR, '"', req, '" not found.  Available message areas:');
                    writeln(USR);
                    i := 0;
                    this := AreaBase;
                    while (not brk) and (this <> nil) do
                      begin
                        if user_rec.access >= this^.AreaAccs
                          then
                            begin
                              write(USR, pad(this^.AreaName, 12));
                              i := succ(i);
                              if 0 = i mod 6
                                then writeln(USR)
                            end;
                        this := this^.next
                      end;
                    if 0 <> i mod 6
                      then writeln(USR);
                    writeln(USR);
                    req := compress(prompt(pr, 10, 'ES?'));
                    writeln(USR)
                  end
            end
      end
  end;