1%  rcs.sl			-*- slang -*-
2%
3%  This file provides an interface to RCS a la Emacs (sort of).
4%
5%  Written by Guido Gonzato  <guido@ibogeo.df.unibo.it>
6%  Last updated: 27 June 1999
7%
8%  To use this facility, put this in your .jedrc:
9%  () = evalfile("rcs.sl");
10%
11%  Commands available:
12%  ^X^F (rcs_open_file())    -- open an RCS file
13%  ^Xvv (rcs_check_in_and_out()) -- check in or out an RCS file
14
15
16static variable file, dir, name, flags;
17static variable comment = "";
18
19static define num_elements (name, delim)
20{
21  variable nth = 0;
22  while (NULL != extract_element (name, nth, delim))
23    nth++;
24  return nth;
25}
26
27define rcs_open_file ()		% ^X^F
28{
29  variable rcs_file, cmd, n;
30
31  file = read_file_from_mini ("RCS open file:");
32  rcs_file = file;
33
34  % check whether the file exists; if not, try the RCS version
35
36  if (1 == file_status (file)) {
37    () = find_file (file);
38    return;
39  }
40
41  % file not found. Build a file name like "/home/guido/RCS/file.txt,v"
42
43  n = num_elements(file, '/');
44  name = extract_element (rcs_file, n - 1, '/');
45  str_replace_all (rcs_file, name, "");
46  rcs_file = sprintf ("%s%s%s%s", rcs_file, "RCS/", name, ",v");
47
48  % now check if this file exists
49
50  if (0 == file_status (rcs_file)) {
51    error ("RCS file not found.");
52  }
53  else {
54    cmd = Sprintf ("co %s > /dev/null 2>&1", name, 1);
55    if (0 != run_shell_cmd (cmd)) {
56      error (Sprintf("Error checking out %s!", name, 1));
57      return;
58    }
59    () = find_file (name);
60    flush ("Note: file is write protected.");
61  }
62
63}
64
65define rcs_check_in_and_out ()	% ^X-v-v
66{
67  variable cmd, tmp, ch;
68
69  USER_BLOCK0 {
70    () = write_buffer (file);
71     comment = read_mini ("Enter a change comment:", "", comment);
72     cmd = Sprintf ("echo \"%s\" | ci %s > /dev/null 2>&1", comment, name);
73    if (0 != run_shell_cmd (cmd)) {
74      error (Sprintf("Error checking in %s!", name, 1));
75      return;
76    }
77    setbuf_info (getbuf_info () | 0x8);
78    flush ("Note: file is write protected.");
79  }
80
81  % check if the current buffer is attached to an RCS file.
82
83  (file, dir, name, flags) = getbuf_info();
84  tmp = Sprintf("%sRCS/%s,v", dir, file, 2);
85
86  % if it doesn't exist, then create the RCS, check in, and exit
87
88  if (0 == file_status (tmp)) {
89    if (0 == file_status ("RCS")) {
90      if (0 != mkdir ("RCS", 0777)) {
91	error ("Error creating RCS directory!");
92	return;
93      }
94    }
95    X_USER_BLOCK0;
96    return;
97  }
98
99  % the RCS file exists; if the buffer is read only, then check it out
100
101  if (flags & (1 shl 3)) { % read only
102    cmd = Sprintf ("co -l %s > /dev/null 2>&1", name, 1);
103    if (0 != run_shell_cmd (cmd)) {
104      error (Sprintf("Error checking out %s!", name, 1));
105      return;
106    }
107    delbuf (whatbuf());
108    () = find_file (name);
109    tmp = Sprintf ("%s%s", dir, file, 2);
110    flush (Sprintf ("Checking out %s...done.", tmp, 1));
111  }
112  else { % check it in
113    X_USER_BLOCK0;
114  }
115
116}
117
118% these are the two commands
119
120%setkey ("rcs_open_file", 	"^X^F");
121%setkey ("rcs_check_in_and_out",	"^Xvv");
122
123% --- End of file rcs.sl ---
124