%  rcs.sl			-*- slang -*-
%
%  This file provides an interface to RCS a la Emacs (sort of).
%
%  Written by Guido Gonzato  <guido@ibogeo.df.unibo.it>
%  Last updated: 27 June 1999
%
%  To use this facility, put this in your .jedrc:
%  () = evalfile("rcs.sl");
%
%  Commands available:
%  ^X^F (rcs_open_file())    -- open an RCS file
%  ^Xvv (rcs_check_in_and_out()) -- check in or out an RCS file


static variable file, dir, name, flags;
static variable comment = "";

static define num_elements (name, delim)
{
  variable nth = 0;
  while (NULL != extract_element (name, nth, delim))
    nth++;
  return nth;
}

define rcs_open_file ()		% ^X^F
{
  variable rcs_file, cmd, n;
  
  file = read_file_from_mini ("RCS open file:");
  rcs_file = file;

  % check whether the file exists; if not, try the RCS version

  if (1 == file_status (file)) {
    () = find_file (file);
    return;
  }
  
  % file not found. Build a file name like "/home/guido/RCS/file.txt,v"
  
  n = num_elements(file, '/');
  name = extract_element (rcs_file, n - 1, '/');
  str_replace_all (rcs_file, name, "");
  rcs_file = sprintf ("%s%s%s%s", rcs_file, "RCS/", name, ",v");
  
  % now check if this file exists
  
  if (0 == file_status (rcs_file)) {
    error ("RCS file not found.");
  }
  else {
    cmd = Sprintf ("co %s > /dev/null 2>&1", name, 1);
    if (0 != run_shell_cmd (cmd)) {
      error (Sprintf("Error checking out %s!", name, 1));
      return;
    }
    () = find_file (name);
    flush ("Note: file is write protected.");
  }
  
}

define rcs_check_in_and_out ()	% ^X-v-v
{
  variable cmd, tmp, ch, f;

  USER_BLOCK0 {
     (file, dir, name, flags) = getbuf_info();
     file = strcat (dir, file);
     () = write_buffer (file);
     comment = read_mini ("Enter a change comment:", "", "");
     cmd = Sprintf ("echo \"%s\" | ci %s > /dev/null 2>&1", comment, file, 2);
    if (0 != run_shell_cmd (cmd)) {
      error (Sprintf("Error checking in %s!", name, 1));
      return;
    }
    setbuf_info (getbuf_info () | 0x8);
    flush ("Note: file is write protected.");
  }

  % check if the current buffer is attached to an RCS file.
  
  (f, dir, name, flags) = getbuf_info();
  tmp = Sprintf("%sRCS/%s,v", dir, f, 2);
  
  % if it doesn't exist, then create the RCS, check in, and exit
  
  if (0 == file_status (tmp)) {
    if (0 == file_status ("RCS")) {
      if (0 != mkdir ("RCS", 0777)) {
	error ("Error creating RCS directory!");
	return;
      }
    }
    X_USER_BLOCK0;
    return;
  }
  
  % the RCS file exists; if the buffer is read only, then check it out
  
  if (flags & (1 shl 3)) { % read only
    cmd = Sprintf ("co -l %s > /dev/null 2>&1", file, 1);
    if (0 != run_shell_cmd (cmd)) {
      error (Sprintf("Error checking out %s!", name, 1));
      return;
    }
    delbuf (whatbuf());
    () = find_file (file);
    flush (Sprintf ("Checking out %s...done.", file, 1));
  }
  else { % check it in
    X_USER_BLOCK0;
  }
  
}

% these are the two commands

%setkey ("rcs_open_file", 	"^X^F");
%setkey ("rcs_check_in_and_out",	"^Xvv");

% --- End of file rcs.sl ---