CP/M/CPM_CDROM.iso/beehive/bbs/rosuncr.arc/ROSMSG.INC

Text File | 1991-08-11 | 18KB | 576 lines

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

{ 09dec87 wb - Modified to access section file data from disk instead of
  heap to reduce ram requirements.
}

overlay procedure mesg_enter(to_ctrl: char);
{ 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;
    msg_status: record_status;
    ch: char;
    last_line, to_loc: integer;
    TextBase, TextLast, this: TextPtr;
    to_fn: firstname;
    to_ln: lastname;
    subj: subject;
    key: StrName;
    temp_user_rec: user_list;

  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 if MaxAvail > 256
                 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
                 else
                   begin
                     Writeln(USR, 'Insufficient memory to continue message entry.');
                     msg := ''
                   end
        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'));
      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_print;
  { Display message currently being edited }
    var
      this: TextPtr;
    begin
      Writeln(USR, 'From: ', user_rec.fn, ' ', user_rec.ln);
      if to_fn = ''
        then Writeln(USR, '  To: ALL')
        else 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_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 (user_rec.access >= 20) and (valid_pw)
        then if ask('Do you want this message to be public')
               then msg_status := public;
      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      := AreaSet;
                num       := succ(num);
                num_prev  := 0;
                num_next  := 0;
                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:  Write(USR, 'Public')
            end;
            Writeln(USR, ' message ', summ_rec.num, ' filed ', str)
          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);
    OK := FALSE;
    msg_status := private;
    repeat
      if (user_rec.access < 20) or
         (to_ctrl = 'S') or
         ((to_ctrl = 'A') and (summ_rec.user_from = 0))
        then
          begin
            to_fn := 'SYSOP';
            Writeln(USR, '  To: ', to_fn)
          end
      else if (to_ctrl = 'A') and (summ_rec.user_from > 0)
        then
          begin
            to_loc := summ_rec.user_from;
            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 to_fn := prompt('To FIRST name [C/R for ALL]', len_fn, 'ES');
      if to_fn = ''
        then
          begin
            to_loc := 0;
            msg_status := public;
            OK := TRUE
          end
      else if to_fn = 'SYSOP'
        then to_ln := ''
      else if to_ctrl <> 'A'
        then to_ln := prompt('LAST name', len_ln, 'ES');
      if not OK
        then
          begin
            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 not valid_pw
      then
        begin
          subj := 'Password problem';
          Writeln(USR, '  Re: ', subj)
        end
    else if user_rec.access < 20
      then
        begin
          subj := 'New user';
          Writeln(USR, '  Re: ', subj)
        end
      else subj := prompt('Subject', len_subj, 'E');
    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('Edit command', 'ContinueEditListSaveQuit') of
        'C': mesg_input(last_line);
        'E': mesg_edit;
        'L': mesg_print;
        '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;
    num, line_count: integer;
  begin
    line_count := 0;
    private := FALSE;
    num := mesg_start('Start');
    MesgCurr := MesgBase;
    while (MesgCurr <> nil) and (MesgCurr^.MesgNo < num) do
      MesgCurr := MesgCurr^.next;
    Writeln(USR);
    while (not brk) and (MesgCurr <> nil) do
      begin
        if (MesgCurr^.TypMsg = 1) or (MesgCurr^.TypMsg = 2)
          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.subject);
        MesgCurr := MesgCurr^.next;
        if user_rec.lines <> 99
          then
            begin
              line_count := succ(line_count);
              if line_count mod user_rec.lines = 0
                then pause
            end
      end;
    if private
      then
        begin
          Writeln(USR);
          Writeln(USR, '"*" marks messages to or from you.')
        end
  end;

overlay procedure mesg_summary;
{ Message summary }
  var
    num, first_line, last_line, line_count: integer;
  begin
    line_count := 0;
    num := mesg_start('Start');
    MesgCurr := MesgBase;
    while (MesgCurr <> nil) and (MesgCurr^.MesgNo < num) do
      MesgCurr := MesgCurr^.next;
    while (not brk) and (MesgCurr <> nil) do
      begin
        mesg_header_list(MesgCurr^.SummLoc, first_line, last_line);
        MesgCurr := MesgCurr^.next;
        if user_rec.lines <> 99
          then
            begin
              line_count := succ(line_count);
              if line_count mod (user_rec.lines div 5) = 0
                then pause
            end
      end
  end;

overlay procedure mesg_read;
{ Read message }
  var
    ch: char;
    update: boolean;
    i, num, first_line, last_line, line_count: integer;
  begin
    OK := TRUE;
    num := mesg_start('Start');
    MesgCurr := MesgBase;
    while (MesgCurr <> nil) and (MesgCurr^.MesgNo < num) do
      MesgCurr := MesgCurr^.next;
    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);
        line_count := 4;
        i := 1;
        seek(mesg_file, first_line);
        while (not brk) and (i <= last_line) do
          begin
            read(mesg_file, mesg_rec);
            Writeln(USR, mesg_rec);
            i := succ(i);
            if user_rec.lines <> 99
              then
                begin
                  line_count := succ(line_count);
                  if line_count mod user_rec.lines = 0
                    then pause
                end
          end;
        update := (summ_rec.user_to = user_loc) and (summ_rec.status = private);
        if update
          then summ_rec.status := read;
        if user_rec.access >= 250
          then
            begin
              repeat
                Writeln(USR);
                ch := select('Message command', 'DeleteIndividualMovePublicRead');
                case ch of
                  'D': mesg_delete;
                  'I': summ_rec.status := private;
                  'M': summ_rec.area := strint(prompt('Message area', 3, 'E'));
                  'P': summ_rec.status := public;
                  'R': summ_rec.status := read;
                  '?': Writeln(USR, '<D>elete, <I>ndividual (private), <M>ove, <P>ublic, <R>ead')
                end
              until (not online) or (ch <> '?');
              if ch <> 'D'
                then MesgCurr := MesgCurr^.next;
              update := update or (ch in ['I', 'M', 'P', 'R'])
            end
        else if (summ_rec.user_from = user_loc) or (summ_rec.user_to = user_loc)
          then
            begin
              Writeln(USR);
              if ask('DELETE this message')
                then mesg_delete
                else
                  begin
                    Writeln(USR, 'Message retained.');
                    MesgCurr := MesgCurr^.next
                  end
            end
          else MesgCurr := MesgCurr^.next;
        if update
          then
            begin
              seek(summ_file, pred(FilePos(summ_file)));
              Write(summ_file, summ_rec)
            end;
        Writeln(USR);
        if MesgCurr <> nil
          then if user_rec.lines = 99
                 then OK := TRUE
                 else OK := ask('READ next message')
      end
  end;

overlay procedure mesg_kill;
{ Delete message }
  var
    num: integer;
  begin
    num := mesg_start('Message');
    MesgCurr := MesgBase;
    while (MesgCurr <> nil) and (MesgCurr^.MesgNo < num) do
      MesgCurr := MesgCurr^.next;
    if MesgCurr^.MesgNo = num
      then
        begin
          read(summ_file, summ_rec);
          if (user_loc = summ_rec.user_from) or (user_loc = summ_rec.user_to) or
             (user_rec.access >= 250)
            then mesg_delete
            else Writeln(USR, 'Message not to or from you.')
        end
      else Writeln(USR, 'Message not found.')
  end;

overlay procedure mesg_area_change(req: Str10);
{ Change message area }
  const
    col_width = 12;
  var
    col_count, col_limit: integer;
    pr: StrPr;
  begin
    col_limit := max(1, user_rec.columns div col_width);
    pr := 'Message area';
    if user_rec.help_level > 1
      then pr := pr + ' [press "?" for menu]';
    if req = ''
      then req := prompt(pr, 10, 'ES?');
    while req <> '' do
      begin
        if req = '?'
          then
            begin
              Writeln(USR, 'Available message areas:');
              Writeln(USR);
              reset(sect_file);
              while (not brk) and (not eof(sect_file)) do
                begin
                  readln(sect_file, SDrive, SUser, SAccs, SName, SDesc);
                  if (user_rec.access >= SAccs) and (SDrive = ' ')
                    then Writeln(USR, pad(SNAme, 14), SDesc);
                end;
              Writeln(USR);
              req := prompt(pr, 10, 'ES?')
            end
        else if req <> ''
          then
            begin
              reset(sect_file);
              while ((req <> trim(SName)) or (SDrive <> ' ')) and (not eof(sect_file)) do
                readln(sect_file, SDrive, SUser, SAccs, SName, SDesc);
              if (req = trim(SName)) and (user_rec.access >= SAccs)
                then
                  begin
                    AreaSet := SUser;
                    AreaReq := req;
                    req := '';
                    mesg_build_index(AreaSet);
                    mesg_directory
                  end
                else
                  begin
                    Writeln(USR, '"', req, '" not found.  Available message areas:');
                    Writeln(USR);
                    col_count := 0;
                    reset(sect_file);
                    while (not brk) and (not eof(sect_file)) do
                      begin
                        readln(sect_file, SDrive, SUser, SAccs, SName, SDesc);
                        if (user_rec.access >= SAccs) and (SDrive = ' ')
                          then
                            begin
                              Write(USR, pad(SName, col_width));
                              col_count := succ(col_count);
                              if 0 = col_count mod col_limit
                                then Writeln(USR)
                            end;
                      end;
                    if 0 <> col_count mod col_limit
                      then Writeln(USR);
                    Writeln(USR);
                    req := prompt(pr, 10, 'ES?')
                  end
            end
      end
  end;

{
  begin
    col_limit := max(1, user_rec.columns div col_width);
    pr := 'Message area';
    if user_rec.help_level > 1
      then pr := pr + ' [press "?" for menu]';
    if req = ''
      then req := prompt(pr, 10, 'ES?');
    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 := prompt(pr, 10, 'ES?')
            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);
                    col_count := 0;
                    this := AreaBase;
                    while (not brk) and (this <> nil) do
                      begin
                        if user_rec.access >= this^.AreaAccs
                          then
                            begin
                              Write(USR, pad(this^.AreaName, col_width));
                              col_count := succ(col_count);
                              if 0 = col_count mod col_limit
                                then Writeln(USR)
                            end;
                        this := this^.next
                      end;
                    if 0 <> col_count mod col_limit
                      then Writeln(USR);
                    Writeln(USR);
                    req := prompt(pr, 10, 'ES?')
                  end
            end
      end
  end;
 }