(********************************************************************
      *                                                                  *
      *         Copyright (c) 1985 by                                    *
      *            Lewis Makepeace and Stan Zanarotti                    *
      *                                                                  *
      *                                                                  *
      *         All rights reserved.                                     *
      *                                                                  *
      ********************************************************************)


{ cmds - interface between command interpreter and core

  History:
        23-Nov-84 RDJ Copied from SRZ.
        24-Nov-84 RDJ Setup [inherit] logicals, removed [environment].
        28-Nov-84 LCM Modified all commands to use cli routines, fixed formats.
        30-Nov-84 RDJ Copied to CS:[DISCUSS].
        30-Nov-84 RDJ Replaced logicals with .pen file names.
        04-Dec-84 LCM Rewrote error_handler and other misc. changes. Updated
                      pen file list.
        05-Dec-84 SRZ Made some user interface changes and fixed various bugs.
        05-Dec-84 SRZ Added su_cmd.
        05-Jan-85 SRZ Fixed up return and moved string handling to strings.
        06-Jan-85 SRZ Added FUTIL file handling.
        29-Mar-85 SRZ Fixed FILE /filename handling
}

[inherit (
                'types.pen',
                'umtgs.pen',
                'mmtgs.pen',
                'cmdint.pen',
                'system.pen',
                'core.pen',
                'cli.pen',
                'io.pen',
                'error.pen',
                'strings.pen'
)]
module cmds;

[hidden] const
       temp_filename = 'SYS$SCRATCH:TEMP.TMP';

var
   dummy      : string;             {dummy string for cli_get_token}
   remove_file,helpfile,trn_file,memberfile : integer;  {file id's}

[hidden] var
   quitting : [external] boolean;










{**********************************************************************}

[hidden]
function tab(i:integer):string;
var
  j:integer;
  temp:string;

begin
  temp:='';
  for j:=1 to i do
    temp:=temp+' ';
  tab:=temp
end; {tab}









[hidden]
function trn_num_fmt(trn_num:trn_nums):string;

var
  temp_str:string;

  function l_pad(str:varying[len]of char;
                 pc:char;
                 ln:integer):string;

  var
    i:integer;
    temp:string;

  begin
    temp:=str;
{srz: s/ln/ln-1/}
    for i:=length(temp) to ln-1 do
       temp:=pc+temp;
    l_pad:=temp
  end; {l_pad}









begin  {trn_num_fmt}
  writev(temp_str,trn_num:0);
  trn_num_fmt:='['+l_pad(temp_str,'0',4)+']'
end;  {trn_num_fmt}









[hidden]
function up_shift(c:char):char;
begin
  if (ord(c)>=ord('a')) and (ord(c)<=ord('z')) then
    up_shift:=chr((ord(c)-ord('a'))+ord('A'))
  else
    up_shift:=c
end;  {up_shift}



















[global]
procedure attend_cmd;
(*****************************************
 * procedure is used to attend a meeting *
 *****************************************)
var
   m_name : string;         { contains name of meeting to attend }
   mtg_name     : mtg_names;
   code         : codes;          { completion codes from functions    }
   i            : integer;
   out_line     : string;
   temp_line    : string;

begin
   cli_get_token('mtg',m_name,code);        { get name of meeting    }
   if (code <> success) then begin
      error_handler(code,'attend');           { couldn't get name, so  }
      return;                         { error & abort process  }
      end
   else begin
      str_to_pkd(m_name,mtg_name);
      if (core_public.attending) then begin   { if already attending a }
         leave(code);                         { meeting then leave it; }
         if (code <> success) then begin      { if couldn't leave,     }
            error_handler(code,'attend');     { signal error & abort   }
            return;
            end;
         end
   end;
   attend(mtg_name,code);
   if (code <> success) then               { if couldn't attend,    }
      error_handler(code,'attend')         { signal error           }
   else begin
      out_line := rtrim (core_public.mtg_name) + ' meeting. Current = ';
      writev (temp_line, core_public.highest_seen:0);
      out_line := out_line + temp_line + ', Last = ';
      writev (temp_line, trn_num_last:0);
      out_line := out_line + temp_line + '.';
      put_output ('');
      put_output (out_line);
      set_current(core_public.highest_seen);
      put_output ('');
   end;
end; {attend_cmd}










[global]
procedure create_cmd;
(*************************
 * creates a new meeting *
 *************************)

var
   short_name             : short_names;    { short version of meeting title  }
   meeting_name           : mtg_names;    { full length meeting title       }
   s_name,
   m_name                 : string;    {string vars for names}
   code                   : codes;     { condition code from other exec  }
   hidden_flag,                        { flags meeting is hidden from
                                         prying eyes. }
   public_flag            : boolean;   { flags public is allowed access  }











     procedure build_member_file;
     const
        init_prompt    = 'Enter initial members.  Hit <RETURN> when done';
        user_prompt    = 'Enter username (max 32 char)';
        accs_prompt    = 'Enter access privilege ("", "R", "RW")';
        accs_warn      = 'Must be "", "R", or "RW" !  Re-enter';

        quit_mark      = '.';
        no_access      = '  ';
        rd_access      = 'R ';
        rw_access      = 'RW';

     var
        goodaccess,
        alldone  : boolean;                       {flags when entry complete}
        username : packed array [1..32] of char;   {name of each user entered}
        access   : packed array[1..2] of char;    {access allowed each user }
        memberfile_name : string;
        i : integer;
        len, userlen : integer;
        rms_code : integer;

     begin
        memberfile_name:=rtrim(short_name);
        futil$open_write(memberfile,memberfile_name,'.ACL',rms_code);
        if (rms_code <> 0) then
           error_handler(fstatus(rms_code),'create')
        else begin
           put_output(init_prompt);
           alldone:=false;
           repeat                                 {get all inputs           }
              put_output(user_prompt);
              get_input(username,%immed 0,userlen);
              if userlen = 0 then
                 alldone := true
              else begin
                 put_output(accs_prompt);
                 repeat                           {keep getting access lvls }
                    get_input(access,%immed 0,len);
                    str_to_pkd(substr(access,1,len),access);
                    if (access[1] = 'r') then     {convert lc to uc         }
                       access[1] := 'R';
                    if (access[2] = 'w') then
                       access[2] := 'W';
                    goodaccess := true;
                    if (access <> no_access) and
                       (access <> rd_access) and
                       (access <> rw_access) then begin
                       put_output(accs_warn);        {re-prompt due to bad input
}
                       goodaccess := false;
                    end;
                 until goodaccess;
                 put_line(memberfile,substr(username,1,userlen)+':'+rtrim(access
),rms_code);
              end;
              until alldone;
              futil$close(memberfile,rms_code);
           end;
        end; {build_member_file}











begin   { create-cmd }
   if (core_public.attending) then begin
      leave(code);
      if code <> success then
         error_handler(code,'CREATE');
   end;
{srz:  Fixed else which was under (if attending)}
   cli_get_token('mtg',m_name,code);
   cli_get_token('smtg',s_name,code);
   cli_get_token('public',dummy,code);
   if code=cli_absent then
      public_flag:=false
   else
      public_flag:=true;
   cli_get_token('hidden',dummy,code);
   if code=cli_absent then
      hidden_flag:=false
   else
      hidden_flag:=true;
   str_to_pkd(m_name,meeting_name);
   str_to_pkd(s_name,short_name);
   create(meeting_name,short_name,public_flag,hidden_flag,code);
   if (code <> success) then
      error_handler(code,'create')
   else begin
      if not public_flag then              { if not public get members}
         build_member_file;
      attend(meeting_name,code);        { and attend this new one}
      if (code <> success) then
         error_handler(code,'create')
      else
         set_current(0);
   end
end; {create_cmd}











[global]
procedure delete_cmd;
  { this procedure is used to delete transactions. }
  var  code:codes;
       denied_access : boolean;
       trn_num:trn_nums;
       deleted:boolean;

begin   { delete_cmd }
  deleted := false;
  get_trn_num (trn_num,code);
  if (code <> success) then begin
    error_handler (code, 'delete');
    return;
   end;

  denied_access := false;
  while (code <> no_more_trns) do begin
    delete_trn (trn_num,code);
    if ((code <> success) and (code <> no_access) and (code <> deleted_trn))
      then begin
        error_handler (code, 'delete');
        return;
    end
    else if (code = success) then
      deleted := true
    else
    if code = no_access then
       denied_access := true;
    get_trn_num (trn_num,code);
    if ((code <> success) and (code <> no_more_trns)) then begin
      error_handler (code, 'delete');
      return;
     end;
  end;  { while loop }
  if (not deleted) then begin
    if not denied_access then
       error_handler (no_trns_selected,'delete')
    else
       error_handler (no_access,'delete');
    return;
  end;

  set_current (0);


end;    { delete_cmd }












[hidden]
procedure set_dir_flags (var change_flg,
                                      attend_flg,
                                      full_flg  : boolean;
                                  var code:codes);
  { this procedure reads the options and sets the appropriate flags }


begin   { set_dir_flags }
  change_flg := false;
  attend_flg := false;
  full_flg := false;

  cli_get_token('attend',dummy,code);
  if code=success then
    attend_flg:=true;
  cli_get_token('changed',dummy,code);
  if code=success then
    change_flg:=true;
  cli_get_token('full',dummy,code);
  if code=success then
    full_flg:=true;
  code:=success
end;    { set_dir_flags }









[hidden]
function meeting_changed (mtg_m_info:master_recs;
                          mtg_u_info:user_recs) : boolean;
  { this function checks to see if a meeting has changed since the last
    time the user has visited the system. }

begin   { meeting_changed }

  if (core_public.attending) and (mtg_m_info.mtg_name = core_public.mtg_name) th
en begin {attending meeting}
     meeting_changed := (mtg_m_info.last > core_public.highest_seen);
  end
  else begin
     meeting_changed := (mtg_m_info.last > mtg_u_info.highest_seen);
  end;

end;    { meeting_changed }










[global]
procedure directory_cmd;
  { this procedure is used to get a directory of meetings on the system }
  var  code      : codes;
       printed,
       param_flg,
       full_flg,
       attend_flg,
       change_flg : boolean;
       param      : string;
       mtg_name   : mtg_names;
       i          : integer;
       mtg_m_info : master_recs;
       mtg_u_info : user_recs;










   procedure print_mtg (mtg_m_rec:master_recs; full_flg:boolean);
  { this procedure is used to print the master dir meeting information
    without any user specific info. }

     var out_line : string;

  begin   { print_mtg }
    if mtg_m_rec.invisible then
       if not sys_admin then begin
       return;
    end;

    if (not printed) and (not full_flg) then begin
       put_output ('Flag Meeting Name:                        Short Name:');
    end;

    with mtg_m_rec do begin
      out_line := tab(5)+mtg_name+tab(5)+short_name;

      if (full_flg) then begin
        out_line := out_line+tab(5)+'Chairman: '+rtrim(chairman);
        put_output(out_line);
        put_output('     Created: '+date_created+'      Modified: '+date_modifie
d);
        put_output('     '+rtrim(mtg_m_rec.vax_filename));
        if (public_flag) then
           out_line := '     Public'
        else
           out_line := '     Non-public';
        if invisible then
           out_line := out_line + ',hidden';
        out_line := out_line+' contains '+trn_num_fmt(last)+' transaction';
        if last <> 1 then out_line := out_line+'s';
        put_output(out_line+'.');
        put_output('');
      end
      else
        put_output(out_line);
    end
  end;    { print_mtg }












   procedure print_user_mtg (mtg_m_rec:master_recs; mtg_u_rec:user_recs;
                          full_flg:boolean);
  { this procedure is used to print the master dir meeting information
    with user specific info }

     var out_line : string;
         cur_mtg  : boolean;

  begin   { print_user_mtg }
    if (not printed) and (not full_flg) then begin
       put_output ('Flag Meeting Name:                        Short Name:');
    end;

    cur_mtg := core_public.attending and (mtg_m_rec.mtg_name = core_public.mtg_n
ame);

    with mtg_m_rec do begin
      out_line := '     ';
      if meeting_changed(mtg_m_rec,mtg_u_rec) then
        out_line [1] := 'C';
      out_line [2] := 'A';

      if cur_mtg then
         out_line [5] := '*';
      out_line := out_line+mtg_name+tab(5)+rtrim(short_name);
      if (full_flg) then begin
        put_output (out_line+tab(5)+'Chairman: '+rtrim(chairman));
        put_output (tab(5)+'Created: '+date_created+tab(6)+'Modified: '+date_mod
ified);
        put_output(tab(5)+rtrim(mtg_m_rec.vax_filename));
        if (public_flag) then
           out_line := tab(5)+'Public'
        else
           out_line := tab(5)+'Non-public';
        if invisible then
           out_line := out_line + ',hidden';
        out_line := out_line+' contains '+trn_num_fmt(last)+' transaction';
        if last <> 1 then out_line := out_line+'s';
        put_output(out_line+'.');
        if cur_mtg then begin
           put_output(tab(5)+'Now attending');
        end
        else begin
           put_output(tab(5)+'Last attended: '+mtg_u_rec.last_time_attend);
        end;
        out_line := tab(5)+'Last access: ';
        if mtg_u_rec.last_access = [] then out_line := out_line+'NULL'
        else begin
           if rd in mtg_u_rec.last_access then out_line := out_line+'R';
           if wr in mtg_u_rec.last_access then out_line := out_line+'W';
           if cm in mtg_u_rec.last_access then out_line := out_line+'C';
        end;
        put_output(out_line);
        put_output('');
      end
      else
        put_output (out_line);
    end
  end;    { print_user_mtg }










begin   { directory_cmd }
  printed := false;
  set_dir_flags (change_flg,attend_flg,full_flg,code);
  attend_flg := (attend_flg or change_flg);
  cli_get_token('mtg',param,code);
  if (code = success) then begin         { have a meeting parameter }
      str_to_pkd(param,mtg_name);
      core$get_master_mtg ( mtg_name,mtg_m_info,code);
      if (code <> success) then begin
        error_handler (code, 'directory');
        return;
      end;
      get_user_mtg (mtg_m_info.mtg_name,mtg_u_info,code);
      if ((code <> success) and (code <> no_such_mtg)) then begin
        error_handler (code, 'directory');
        return;
      end;
      if ((code = no_such_mtg) and (mtg_m_info.invisible)) and not sys_admin the
n begin
           error_handler (code, 'directory');
           return;
      end;
      if ((code = no_such_mtg) and (attend_flg)) then begin
          error_handler (not_attend,'directory');
          return;
      end
      else
        if ((not meeting_changed(mtg_m_info,mtg_u_info)) and (change_flg)) then
begin
          error_handler (not_changed,'directory');
          return;
        end
        else
          if (code = no_such_mtg) then begin
            print_mtg (mtg_m_info,full_flg);
            printed := true;
          end
          else begin
            print_user_mtg (mtg_m_info,mtg_u_info,full_flg);
            printed := true;
          end
  end
  else
    if (attend_flg) then begin
        start_user_mtg;
        next_user_mtg (mtg_u_info,code);
        while (code = success) do begin
          core$get_master_mtg (mtg_u_info.mtg_name,mtg_m_info,code);
          if (code = no_such_mtg)then begin      { in user base but not in maste
r base }
              put_output (tab(5)+mtg_u_info.mtg_name+tab(5)+'*DELETED*');
              printed := true;
          end
          else
            if (((meeting_changed(mtg_m_info,mtg_u_info)) or not (change_flg)))
then begin
              print_user_mtg (mtg_m_info,mtg_u_info,full_flg);
              printed := true;
            end;
          next_user_mtg (mtg_u_info,code);
        end;    { while loop }
        if (code <> no_more_mtgs) then begin
          error_handler (code, 'directory');
          return;
        end
      end
      else begin
        core$start_master_mtg;
        core$next_master_mtg (mtg_m_info,code);
        while (code = success) do begin
          get_user_mtg (mtg_m_info.mtg_name,mtg_u_info,code);
          if (code = success) then begin
              print_user_mtg (mtg_m_info,mtg_u_info,full_flg);
              printed := true;
          end
          else begin
              print_mtg (mtg_m_info,full_flg);
              printed := true;
          end;
          core$next_master_mtg (mtg_m_info,code);
        end;    { while loop }
        if (code <> no_more_mtgs) then begin
          error_handler (code, 'directory');
          return;
        end;
      end;
  if (not printed) then
     error_handler (no_meetings, 'directory');


end;    { directory_cmd }










[global]
procedure exit_cmd;
(*****************************************
 * procedure takes you out of the system *
 *****************************************)
var
   code : codes;

begin
   if (core_public.attending) then begin
   leave(code);                         { leave meeting in progress }
   if (code <> success) then
      error_handler(code,'exit');
   end;
   quitting := true;
end; {exit_cmd}











[global]
procedure help_cmd;
(********************************************
 * procedure reads & displays the help file *
 ********************************************)
var
   line       : packed array [1..132] of char; { 1 line of the file }
   file_name  : string;             { vax pathname to file}
   rms_code   : integer;
   len        : integer;

begin
   sys_reset_interrupt;                      {activate ctrl-c trap}
   file_name := system_dir + 'discuss.hlp';  {build path-name     }
   futil$open_read(helpfile,file_name,'',rms_code);
   if rms_code <> 0 then begin
     error_handler(fstatus(rms_code),'Help');
     return;
   end;
   {read from file until eof or until ctrl-c pressed}
   get_line (helpfile, line, len, rms_code);
   while ((rms_code <> rms_eof) and (not sys_interrupt)) do begin
      put_output(substr(line,1,len));
      get_line (helpfile, line, len, rms_code);
   end;
   futil$close(helpfile, rms_code);             {close path to file  }
end; {help_cmd}












[hidden]
procedure write_out_header (header_info:trn_recs; out_file:integer);
  { this procedure prints out the header in a one line form at the
    beginning of a transaction when it is printed (to screen or file) .}

     var rms_code : integer;
         out_line : string;
         temp_line : string;

begin   { write_out_header }
  put_line(out_file,'',rms_code);
  out_line := trn_num_fmt(header_info.trn_num)+' '+header_info.author+' '+
              rtrim(core_public.mtg_name)+' '+substr(header_info.date_entered,1,
17)+
              ' (';
  writev (temp_line,header_info.num_lines:0);
  out_line := out_line + temp_line + ' line';
  if header_info.num_lines <> 1 then
     out_line := out_line + 's';
  put_line (out_file, out_line+')', rms_code);
  put_line (out_file, 'Subject: '+rtrim(header_info.subject),rms_code);
end;    { write_out_header }












[hidden]
procedure write_out_trailer (trailer_info:trn_recs; out_file:integer);

  { this procedure prints out the trailer in a one line form.}

     var rms_code : integer;

begin   { write_out_trailer }
  put_line (out_file, '--'+trn_num_fmt(trailer_info.trn_num)+'--', rms_code);
  put_line (out_file, '', rms_code);
end;    { write_out_trailer }












[hidden]
procedure set_file_flags (var append_flg,
                                       header_flg:boolean;
                                   var file_name_flg:boolean;
                                   var file_name:string;
                                   var code:codes);
  { this procedure gets the options for the command and sets the option flags }


begin   { set_file_flags }
  header_flg := false;
  append_flg := false;
  file_name_flg := false;
  cli_get_token('name',file_name,code);   {don't want to retrieve file name yet}
  if code=success then
    file_name_flg:=true;
  cli_get_token('append',dummy,code);
  if code=success then
    append_flg:=true;
  cli_get_token('header',dummy,code);
  if code = success then
    header_flg:=true;
  code:=success
end;    { set_file_flags }











[global]
procedure file_cmd;
  { this procedure is used to write a transaction to a text file.}

  var  code      : codes;
       append_flg,
       file_name_flg : boolean;
       file_name : string;
       header_flg : boolean;
       opened    : boolean;
       trn_cnt : integer;
       trn_num : trn_nums;
       header_info : trn_recs;
       out_line,
       temp_line : string;
       rms_code : integer;

begin   { file_cmd }
  opened := false;
  trn_cnt := 0;
  set_file_flags (append_flg,header_flg,file_name_flg,file_name,code);
  if not file_name_flg then file_name := rtrim (core_public.short_name);
  get_trn_num(trn_num,code);
  sys_reset_interrupt;
  while (code = success) and (not sys_interrupt) do begin
     get_trn_rec (trn_num,header_info,code);
     if (code = success) then begin
        if (not opened) then begin
           if (append_flg) then begin
              futil$open_append(trn_file,file_name,'.trn',rms_code);
           end
           else begin
              futil$open_write(trn_file,file_name,'.trn',rms_code);
           end;
           if rms_code<>0 then begin
              error_handler(fstatus(rms_code),'file');
              return;
           end;
           opened:=true;
        end;
        if header_flg then
           write_out_header (header_info,trn_file);
        copy_trn (trn_num,trn_file,code);
        if (code <> success) then begin
           error_handler (code, 'file');
           futil$close(trn_file,rms_code);
           return;
        end
        else
        if header_flg then
           write_out_trailer (header_info,trn_file);
        set_current (trn_num);
        trn_cnt := trn_cnt + 1;
     end;
     get_trn_num (trn_num,code);
  end;    { while loop }
  if (not sys_interrupt) and (code <> no_more_trns) then
     error_handler (code, 'file')
  else
  if (not opened) then
     error_handler (deleted_trn,'file')
  else begin
     writev (temp_line, trn_cnt:0);
     out_line := 'Wrote ' + temp_line + ' transaction';
     if trn_cnt <> 1 then out_line := out_line + 's';
     out_line := out_line + ' to ';
     out_line := out_line + rtrim (file_name);
     put_output (out_line);
  end;
  if (opened) then futil$close(trn_file,rms_code);

end;    { file_cmd }











[hidden]
procedure write_list_header (header_info:trn_recs);
  { this procedure prints the header info for list purposes }

     var out_line : string;
         temp_line : string;

begin   { write_list_header }
  with header_info do begin
    out_line := trn_num_fmt(trn_num)+' '+author+' '+substr(date_entered,1,17);
    writev (temp_line, num_lines:5);
    out_line := out_line+temp_line+' line';
    if num_lines <> 1 then begin
       out_line := out_line+'s';
    end
    else begin
       out_line := out_line+' ';
    end;
    put_output (out_line+' '+rtrim(subject));
   end;
end;    { write_list_header }












[global]
procedure list_cmd;
  { this procedure is used to print the header information of the transactions}

  var  trn_num    : trn_nums;
       chain_flg  : boolean;
       listed     : boolean;
       code       : codes;
       header_info : trn_recs;

begin   { list_cmd }
  chain_flg := false;
  listed := false;
  cli_get_token('chain',dummy,code);
  if code=success then
    chain_flg:=true;
  get_trn_num (trn_num,code);
  if (code <> success)
    then error_handler (code, 'list')
    else begin
      sys_reset_interrupt;
      while ((not sys_interrupt) and (code = success)) do begin
        get_trn_rec (trn_num,header_info,code);
        if ((code <> success) and (code <> deleted_trn)) then begin
            error_handler (code, 'list');
            return;
        end
        else
          if code=success then begin
            if (not chain_flg)
              then begin
                if not listed then begin
                   put_output (
'Trans: Name:         Date:      Time: Lines:     Subject:');
                end;
                write_list_header (header_info);
                listed := true;
                set_current (trn_num);
               end
              else if (trn_num_pref(trn_num) = 0)
                then begin
                  write_list_header (header_info);
                  listed := true;
                  set_current (trn_num);
                 end;
          end;
          get_trn_num (trn_num,code);
          if ((code <> success) and (code <> no_more_trns)) then begin
            error_handler (code, 'list');
            return;
          end;
        end;    { while loop }
        if ((not sys_interrupt) and (not listed))
          then error_handler (no_trns_selected,'list');
       end;

end;    { list_cmd }











[global]
procedure remove_cmd;
(************************************
 * delete a meeting from the system *
 ************************************)
var
   save_flg     : boolean;
   trn_num      : trn_nums;
   m_name     : string;
   meeting_name : mtg_names;
   i            : integer;
   mtg_g_info   : master_recs;
   code         : codes;
   rms_code     : integer;
   confirm      : packed array [1..10] of char;
   len          : integer;

begin
   save_flg := false;
   cli_get_token('save',dummy,code);
   if code=success then
     save_flg := true;
   cli_get_token('mtg',m_name,code);
   if (code <> success) then
      error_handler(code,'remove')
   else begin
     str_to_pkd(m_name,meeting_name);
     core$get_master_mtg(meeting_name,mtg_g_info,code);
     if code <> success then begin
        error_handler(code,'remove');
        return;
     end;
     if (core_public.attending) and (mtg_g_info.mtg_name = core_public.mtg_name)
 then
       leave(code);
     if (code <> success) then
        error_handler(code,'remove')
     else begin
        str_to_pkd ('', confirm);
        while (confirm[1]<>'Y') and (confirm[1]<>'N') do begin
          get_input (confirm, 'Are you sure (Y/N)? ', len);
          confirm[1]:=up_shift(confirm[1]);
        end;
        if confirm[1]<>'Y' then begin
          put_output('Aborting.');
          return
        end;
        remove(mtg_g_info.mtg_name,code);
        if (code <> success) then
          error_handler(code,'remove')
        else begin
          resign(mtg_g_info.mtg_name,code);
          if (code <> success) and (code <> no_such_mtg) then
             error_handler(code,'remove')
          else if not save_flg then begin
             futil$delete(rtrim(mtg_g_info.vax_filename)+'.mtg','',rms_code);
             if rms_code <> 0 then begin
                 error_handler (fstatus(rms_code),'remove');
                 return;
             end;
          end;
       end;
     end;
   end;
end; {remove_cmd}











[hidden]
procedure enter_text(var trn_file : integer;
                         edit_flg : boolean;
                     var code     : codes);
(***********************************************************************
 * enter text into a file which is to be the text of a new transaction *
 ***********************************************************************)
var
   done      : boolean;
   editing   : boolean;
   len       : integer;
   rms_code  : integer;
   textline  : packed array [1..132] of char;

begin
   editing := false;
   if not edit_flg then begin {if /EDIT qualifier not given}
      futil$open_temp (trn_file,temp_filename,'',rms_code);
      if rms_code <> 0 then begin
         code := fstatus(rms_code);
         return;
      end;

      put_output('Enter text of transaction below, type CTRL-Z when done, CTRL-C
 to quit.');
      sys_reset_interrupt;
      done := false;            {get input from terminal}
      while not done do begin
         rms_code := get_input (textline,%immed 0,len);
         if rms_code = rms_eof then
            done := true
         else
         if (len = 1) and (textline [1] = '.') then begin       { start editing
transaction }
            editing := true;
            done := true;
         end
         else begin
            put_line (trn_file,substr(textline,1,len),rms_code);
            if (rms_code <> 0) then begin
               code := fstatus(rms_code);
               futil$close(trn_file,rms_code);
               futil$delete(temp_filename,'',rms_code);
               return;
            end;
            if sys_interrupt then done := true;
         end;
      end;
      if (sys_interrupt) then begin
            code := cancel_text;
            futil$close(trn_file,rms_code);
            futil$delete(temp_filename,'',rms_code);
            return;
      end
      else
      if not editing then begin { done with transaction }
         code := success;
         return;
      end;
      futil$close(trn_file,rms_code);           {close file to edit}
   end;

   {Now, the user wants to edit the transaction from a subprocess.
    spawn the edit session and open the destination file when we're done.}
   Sys_spawn_editor(rms_code);
   code := fstatus (rms_code);
   if code <> success then begin
      if editing then futil$delete (temp_filename,'',rms_code);
      return;
   end;


   futil$open_read(trn_file,temp_filename,'',rms_code); {open destination}
   if rms_code <> 0 then begin
      code := fstatus(rms_code);
      return;
   end;

   code := success;
end; {enter_text}











[global]
procedure reply_cmd;
(********************************
 * add a transaction to a chain *
 ********************************)
var
   trn_num       : trn_nums;
   trn_rec       : trn_recs;
   fnl_trn       : trn_nums;
   file_name     : string;
   include_flg   : boolean;
   edit_flg      : boolean;
   code          : codes;
   rms_code      : integer;
   subject       : subjects;
   in_line       : packed array [1..10] of char;
   inlen         : integer;

begin
   include_flg := false;
   edit_flg := false;
   cli_get_token('include',file_name,code);
   if code = success then
      include_flg:=true;
   cli_get_token('edit',dummy,code);
   if code = success then
      edit_flg := true;
   get_trn_num(trn_num,code);
   if (code <> success) then begin
      error_handler(code,'reply');
      return;
   end;
   get_trn_rec(trn_num,trn_rec,code);
   if (code <> success) then begin
      error_handler(code,'reply');
      return;
   end;
   subject := trn_rec.subject;
   if (substr(subject,1,3) <> 'RE:') then
      subject := substr('RE: '+subject,1,length(subject));
   if include_flg then begin
      futil$open_read(trn_file,file_name,'.trn',rms_code);
      if (rms_code <> 0) then begin
         error_handler(fstatus(rms_code),'reply');
         return;
      end
      else
         put_output('Subject: '+rtrim(subject));
   end
   else
      put_output('Subject: '+rtrim(subject));
   if not include_flg then begin
     enter_text(trn_file,edit_flg,code);
     if (code <> success) then begin
        if (code <> cancel_text) then
           error_handler(code,'reply');
        return;
     end;
   end;
   futil$rewind(trn_file,rms_code);
   if rms_code <> 0 then
      error_handler(fstatus(rms_code),'reply')
   else begin
      futil$get_line(trn_file,in_line,inlen, rms_code);
      if rms_code = rms_eof then begin
         error_handler (empty_trn,'reply');
      end
      else begin
         futil$rewind(trn_file,rms_code);
         add_trn(trn_file,subject,trn_num,fnl_trn,code);
         if (code <> success) then
            error_handler(code,'reply')
         else
            put_output('Transaction number '+trn_num_fmt(fnl_trn)+' added');
      end;
   end;
   futil$close(trn_file,rms_code);
   if not include_flg then
      futil$delete(temp_filename,'',rms_code);
   set_current(trn_num);
end; {reply_cmd}











[global]
procedure resign_cmd;
(*****************************************
 * remove a meeting from user's dir file *
 *****************************************)
var
   code           : codes;
   m_name   : string;
   mtg_name       : mtg_names;
   i              : integer;

begin
   cli_get_token('mtg',m_name,code);
   if (code = cli_absent) and (core_public.attending) then
      mtg_name := core_public.mtg_name
   else
   if (code <> success) then begin
      error_handler (code, 'resign');
      return;
   end
   else begin
      str_to_pkd(m_name,mtg_name);
   end;
   if (mtg_name = core_public.mtg_name) or (equals (rtrim(mtg_name),rtrim(core_p
ublic.short_name))) then
         leave(code);
   if (code <> success) then
       error_handler(code,'resign')
   else begin
       resign(mtg_name,code);
       if (code <> success) then
          error_handler(code,'resign');
   end;
end; {resign_cmd}










[global]
procedure retrieve_cmd;
  { this procedure is used to retrieve transactions }

  var   code       : codes;
        denied_access : boolean;
        trn_num    : trn_nums;
        retrieved  : boolean;

begin   { retrieve_cmd }
  retrieved := false;
  get_trn_num (trn_num,code);
  if (code <> success) then begin
    error_handler (code, 'retrieve');
    return;
   end;
  denied_access:=false;
  while (code <> no_more_trns) do begin
    retrieve_trn (trn_num,code);
    if ((code <> success) and (code <> no_access) and (code <> not_deleted))
      then begin
        error_handler (code, 'retrieve');
        return;
       end
      else if (code = success) then begin
        retrieved := true;
        set_current (trn_num);
      end
      else
      if code = no_access then
         denied_access := true;
    get_trn_num (trn_num,code);
    if ((code <> success) and (code <> no_more_trns)) then begin
      error_handler (code, 'retrieve');
      return;
     end;
   end;    { while loop }
  if (not retrieved) then begin
     if denied_access then
        error_handler (no_access, 'retrieve')
     else
        error_handler (not_deleted, 'retrieve');
  end;

end;    { retrieve_cmd }










[global]
procedure su_cmd;

        { Undocumented procedure to set core_public.username to a given
          parameter. Nifty for creating fake transactions.  If user is not
          sys_admin, then just print out error message. }

   var username : string;
       code : codes;

begin
   if not sys_admin then begin
      put_output ('Unrecognized command');
   end
   else begin
      cli_get_token('username',username,code);
      if code = success then begin
         str_to_pkd (username,core_public.username);
      end;
   end;
end; {su_cmd}


[global]
procedure talk_cmd;
(*************************
 * add a new transaction *
 *************************)

var
   code        : codes;
   file_name   : string;
   include_flg : boolean;
   edit_flg    : boolean;
   len         : integer;
   fnl_trn     : trn_nums;
   rms_code    : integer;
   subject     : subjects;
   in_line     : packed array [1..10] of char;
   inlen       : integer;

begin
   if not core_public.attending then begin
      error_handler(no_current_mtg,'Talk');
      return
   end;
   include_flg := false;
   edit_flg := false;
   cli_get_token('include',file_name,code);
   if (code = success) then
       include_flg := true;
   cli_get_token('edit',dummy,code);
   if (code = success) then
      edit_flg := true;
   if include_flg then begin
      futil$open_read(trn_file,file_name,'.trn',rms_code);
      if (rms_code <> 0) then begin
         error_handler(fstatus(rms_code),'talk');
         return;
      end
      else begin
         get_input (subject,'Subject: ',len);
         str_to_pkd (substr (subject,1,len),subject);
      end;
   end
   else begin
      get_input(subject,'Subject: ',len);
      str_to_pkd(substr(subject,1,len),subject);
      enter_text(trn_file,edit_flg,code);
      if (code <> success) then begin
         if (code <> cancel_text) then
            error_handler(code,'talk');
         return;
      end;
   end;
   futil$rewind(trn_file,rms_code);
   if rms_code <> 0 then
      error_handler (fstatus(rms_code),'talk')
   else begin
      futil$get_line(trn_file,in_line,inlen, rms_code);
      if rms_code = rms_eof then begin
         error_handler (empty_trn,'talk');
      end
      else begin
         futil$rewind(trn_file,rms_code);
         add_trn(trn_file,subject,0,fnl_trn,code);
         if (code <> success) then
            error_handler(code,'talk')
         else
            put_output('Transaction number '+trn_num_fmt(fnl_trn)+' added');
      end;
   end;
   futil$close(trn_file,rms_code);
   if not include_flg then
      futil$delete(temp_filename,'',rms_code);
   set_current(fnl_trn);
end; {talk_cmd}











[global]
procedure type_cmd;
  { this procedure is used to print a transaction to the screen }

  var    trn_num      : trn_nums;
         code         : codes;
         header_info  : trn_recs;
         printed      : boolean;
         header_flg   : boolean;

begin   { type_cmd }
   cli_get_token('header',dummy,code);
   if code = success then header_flg := true
                     else header_flg := false;
   printed:=false;
   sys_reset_interrupt;
   get_trn_num (trn_num,code);
   if (code <> success) then
      error_handler (code, 'type')
   else begin
      while ((not sys_interrupt) and (code <> no_more_trns)) do begin
         get_trn_rec (trn_num,header_info,code);
         if (code <> success) and (code<>deleted_trn) then begin
            error_handler (code, 'type');
            return;
         end
         else
         if code=success then begin
            printed:=true;
            if header_flg then
               write_out_header (header_info,user_io);
            copy_trn (trn_num,user_io,code);
            if (code <> success) then begin
               error_handler (code, 'type');
               return;
            end
            else begin
               if header_flg then
                  write_out_trailer (header_info,user_io);
               set_current (trn_num);
            end;
         end;
         get_trn_num (trn_num,code);
         if ((code <> success) and (code <> no_more_trns)) then begin
            error_handler (code, 'type');
            return;
         end;
      end;    { while loop }
      if not printed then
         error_handler(no_trns_selected,'type');
   end;
end;    { type_cmd }
end.