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