| 1 | /* undo handling for GNU Emacs. |
| 2 | Copyright (C) 1990 Free Software Foundation, Inc. |
| 3 | |
| 4 | This file is part of GNU Emacs. |
| 5 | |
| 6 | GNU Emacs is distributed in the hope that it will be useful, |
| 7 | but WITHOUT ANY WARRANTY. No author or distributor |
| 8 | accepts responsibility to anyone for the consequences of using it |
| 9 | or for whether it serves any particular purpose or works at all, |
| 10 | unless he says so in writing. Refer to the GNU Emacs General Public |
| 11 | License for full details. |
| 12 | |
| 13 | Everyone is granted permission to copy, modify and redistribute |
| 14 | GNU Emacs, but only under the conditions described in the |
| 15 | GNU Emacs General Public License. A copy of this license is |
| 16 | supposed to have been given to you along with GNU Emacs so you |
| 17 | can know your rights and responsibilities. It should be in a |
| 18 | file named COPYING. Among other things, the copyright notice |
| 19 | and this notice must be preserved on all copies. */ |
| 20 | |
| 21 | |
| 22 | #include "config.h" |
| 23 | #include "lisp.h" |
| 24 | #include "buffer.h" |
| 25 | |
| 26 | /* Last buffer for which undo information was recorded. */ |
| 27 | Lisp_Object last_undo_buffer; |
| 28 | |
| 29 | /* Record an insertion that just happened or is about to happen, |
| 30 | for LENGTH characters at position BEG. |
| 31 | (It is possible to record an insertion before or after the fact |
| 32 | because we don't need to record the contents.) */ |
| 33 | |
| 34 | record_insert (beg, length) |
| 35 | Lisp_Object beg, length; |
| 36 | { |
| 37 | Lisp_Object lbeg, lend; |
| 38 | |
| 39 | if (current_buffer != XBUFFER (last_undo_buffer)) |
| 40 | Fundo_boundary (); |
| 41 | XSET (last_undo_buffer, Lisp_Buffer, current_buffer); |
| 42 | |
| 43 | if (EQ (current_buffer->undo_list, Qt)) |
| 44 | return; |
| 45 | if (MODIFF <= current_buffer->save_modified) |
| 46 | record_first_change (); |
| 47 | |
| 48 | /* If this is following another insertion and consecutive with it |
| 49 | in the buffer, combine the two. */ |
| 50 | if (XTYPE (current_buffer->undo_list) == Lisp_Cons) |
| 51 | { |
| 52 | Lisp_Object elt; |
| 53 | elt = XCONS (current_buffer->undo_list)->car; |
| 54 | if (XTYPE (elt) == Lisp_Cons |
| 55 | && XTYPE (XCONS (elt)->car) == Lisp_Int |
| 56 | && XTYPE (XCONS (elt)->cdr) == Lisp_Int |
| 57 | && XINT (XCONS (elt)->cdr) == beg) |
| 58 | { |
| 59 | XSETINT (XCONS (elt)->cdr, beg + length); |
| 60 | return; |
| 61 | } |
| 62 | } |
| 63 | |
| 64 | XFASTINT (lbeg) = beg; |
| 65 | XFASTINT (lend) = beg + length; |
| 66 | current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list); |
| 67 | } |
| 68 | |
| 69 | /* Record that a deletion is about to take place, |
| 70 | for LENGTH characters at location BEG. */ |
| 71 | |
| 72 | record_delete (beg, length) |
| 73 | int beg, length; |
| 74 | { |
| 75 | Lisp_Object lbeg, lend, sbeg; |
| 76 | |
| 77 | if (current_buffer != XBUFFER (last_undo_buffer)) |
| 78 | Fundo_boundary (); |
| 79 | XSET (last_undo_buffer, Lisp_Buffer, current_buffer); |
| 80 | |
| 81 | if (EQ (current_buffer->undo_list, Qt)) |
| 82 | return; |
| 83 | if (MODIFF <= current_buffer->save_modified) |
| 84 | record_first_change (); |
| 85 | |
| 86 | if (point == beg + length) |
| 87 | XSET (sbeg, Lisp_Int, -beg); |
| 88 | else |
| 89 | XFASTINT (sbeg) = beg; |
| 90 | XFASTINT (lbeg) = beg; |
| 91 | XFASTINT (lend) = beg + length; |
| 92 | current_buffer->undo_list |
| 93 | = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg), |
| 94 | current_buffer->undo_list); |
| 95 | } |
| 96 | |
| 97 | /* Record that a replacement is about to take place, |
| 98 | for LENGTH characters at location BEG. |
| 99 | The replacement does not change the number of characters. */ |
| 100 | |
| 101 | record_change (beg, length) |
| 102 | int beg, length; |
| 103 | { |
| 104 | record_delete (beg, length); |
| 105 | record_insert (beg, length); |
| 106 | } |
| 107 | \f |
| 108 | /* Record that an unmodified buffer is about to be changed. |
| 109 | Record the file modification date so that when undoing this entry |
| 110 | we can tell whether it is obsolete because the file was saved again. */ |
| 111 | |
| 112 | record_first_change () |
| 113 | { |
| 114 | Lisp_Object high, low; |
| 115 | XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff; |
| 116 | XFASTINT (low) = current_buffer->modtime & 0xffff; |
| 117 | current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list); |
| 118 | } |
| 119 | |
| 120 | DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0, |
| 121 | "Mark a boundary between units of undo.\n\ |
| 122 | An undo command will stop at this point,\n\ |
| 123 | but another undo command will undo to the previous boundary.") |
| 124 | () |
| 125 | { |
| 126 | Lisp_Object tem; |
| 127 | if (EQ (current_buffer->undo_list, Qt)) |
| 128 | return Qnil; |
| 129 | tem = Fcar (current_buffer->undo_list); |
| 130 | if (!NULL (tem)) |
| 131 | current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list); |
| 132 | return Qnil; |
| 133 | } |
| 134 | |
| 135 | /* At garbage collection time, make an undo list shorter at the end, |
| 136 | returning the truncated list. |
| 137 | MINSIZE and MAXSIZE are the limits on size allowed, as described below. |
| 138 | In practice, these are the values of undo-threshold and |
| 139 | undo-high-threshold. */ |
| 140 | |
| 141 | Lisp_Object |
| 142 | truncate_undo_list (list, minsize, maxsize) |
| 143 | Lisp_Object list; |
| 144 | int minsize, maxsize; |
| 145 | { |
| 146 | Lisp_Object prev, next, last_boundary; |
| 147 | int size_so_far = 0; |
| 148 | |
| 149 | prev = Qnil; |
| 150 | next = list; |
| 151 | last_boundary = Qnil; |
| 152 | |
| 153 | /* Always preserve at least the most recent undo record. |
| 154 | If the first element is an undo boundary, skip past it. |
| 155 | |
| 156 | Skip, skip, skip the undo, skip, skip, skip the undo, |
| 157 | Skip, skip, skip the undo, skip to the undo bound'ry. */ |
| 158 | if (XTYPE (next) == Lisp_Cons |
| 159 | && XCONS (next)->car == Qnil) |
| 160 | { |
| 161 | /* Add in the space occupied by this element and its chain link. */ |
| 162 | size_so_far += sizeof (struct Lisp_Cons); |
| 163 | |
| 164 | /* Advance to next element. */ |
| 165 | prev = next; |
| 166 | next = XCONS (next)->cdr; |
| 167 | } |
| 168 | while (XTYPE (next) == Lisp_Cons |
| 169 | && XCONS (next)->car != Qnil) |
| 170 | { |
| 171 | Lisp_Object elt; |
| 172 | elt = XCONS (next)->car; |
| 173 | |
| 174 | /* Add in the space occupied by this element and its chain link. */ |
| 175 | size_so_far += sizeof (struct Lisp_Cons); |
| 176 | if (XTYPE (elt) == Lisp_Cons) |
| 177 | { |
| 178 | size_so_far += sizeof (struct Lisp_Cons); |
| 179 | if (XTYPE (XCONS (elt)->car) == Lisp_String) |
| 180 | size_so_far += (sizeof (struct Lisp_String) - 1 |
| 181 | + XSTRING (XCONS (elt)->car)->size); |
| 182 | } |
| 183 | |
| 184 | /* Advance to next element. */ |
| 185 | prev = next; |
| 186 | next = XCONS (next)->cdr; |
| 187 | } |
| 188 | if (XTYPE (next) == Lisp_Cons) |
| 189 | last_boundary = prev; |
| 190 | |
| 191 | while (XTYPE (next) == Lisp_Cons) |
| 192 | { |
| 193 | Lisp_Object elt; |
| 194 | elt = XCONS (next)->car; |
| 195 | |
| 196 | /* When we get to a boundary, decide whether to truncate |
| 197 | either before or after it. The lower threshold, MINSIZE, |
| 198 | tells us to truncate after it. If its size pushes past |
| 199 | the higher threshold MAXSIZE as well, we truncate before it. */ |
| 200 | if (NULL (elt)) |
| 201 | { |
| 202 | if (size_so_far > maxsize) |
| 203 | break; |
| 204 | last_boundary = prev; |
| 205 | if (size_so_far > minsize) |
| 206 | break; |
| 207 | } |
| 208 | |
| 209 | /* Add in the space occupied by this element and its chain link. */ |
| 210 | size_so_far += sizeof (struct Lisp_Cons); |
| 211 | if (XTYPE (elt) == Lisp_Cons) |
| 212 | { |
| 213 | size_so_far += sizeof (struct Lisp_Cons); |
| 214 | if (XTYPE (XCONS (elt)->car) == Lisp_String) |
| 215 | size_so_far += (sizeof (struct Lisp_String) - 1 |
| 216 | + XSTRING (XCONS (elt)->car)->size); |
| 217 | } |
| 218 | |
| 219 | /* Advance to next element. */ |
| 220 | prev = next; |
| 221 | next = XCONS (next)->cdr; |
| 222 | } |
| 223 | |
| 224 | /* If we scanned the whole list, it is short enough; don't change it. */ |
| 225 | if (NULL (next)) |
| 226 | return list; |
| 227 | |
| 228 | /* Truncate at the boundary where we decided to truncate. */ |
| 229 | if (!NULL (last_boundary)) |
| 230 | { |
| 231 | XCONS (last_boundary)->cdr = Qnil; |
| 232 | return list; |
| 233 | } |
| 234 | else |
| 235 | return Qnil; |
| 236 | } |
| 237 | \f |
| 238 | DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0, |
| 239 | "Undo N records from the front of the list LIST.\n\ |
| 240 | Return what remains of the list.") |
| 241 | (count, list) |
| 242 | Lisp_Object count, list; |
| 243 | { |
| 244 | register int arg = XINT (count); |
| 245 | #if 0 /* This is a good feature, but would make undo-start |
| 246 | unable to do what is expected. */ |
| 247 | Lisp_Object tem; |
| 248 | |
| 249 | /* If the head of the list is a boundary, it is the boundary |
| 250 | preceding this command. Get rid of it and don't count it. */ |
| 251 | tem = Fcar (list); |
| 252 | if (NULL (tem)) |
| 253 | list = Fcdr (list); |
| 254 | #endif |
| 255 | |
| 256 | while (arg > 0) |
| 257 | { |
| 258 | while (1) |
| 259 | { |
| 260 | Lisp_Object next, car, cdr; |
| 261 | next = Fcar (list); |
| 262 | list = Fcdr (list); |
| 263 | if (NULL (next)) |
| 264 | break; |
| 265 | car = Fcar (next); |
| 266 | cdr = Fcdr (next); |
| 267 | if (EQ (car, Qt)) |
| 268 | { |
| 269 | Lisp_Object high, low; |
| 270 | int mod_time; |
| 271 | high = Fcar (cdr); |
| 272 | low = Fcdr (cdr); |
| 273 | mod_time = (high << 16) + low; |
| 274 | /* If this records an obsolete save |
| 275 | (not matching the actual disk file) |
| 276 | then don't mark unmodified. */ |
| 277 | if (mod_time != current_buffer->modtime) |
| 278 | break; |
| 279 | #ifdef CLASH_DETECTION |
| 280 | Funlock_buffer (); |
| 281 | #endif /* CLASH_DETECTION */ |
| 282 | Fset_buffer_modified_p (Qnil); |
| 283 | } |
| 284 | else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int) |
| 285 | { |
| 286 | Lisp_Object end; |
| 287 | if (XINT (car) < BEGV |
| 288 | || XINT (cdr) > ZV) |
| 289 | error ("Changes to be undone are outside visible portion of buffer"); |
| 290 | Fdelete_region (car, cdr); |
| 291 | Fgoto_char (car); |
| 292 | } |
| 293 | else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int) |
| 294 | { |
| 295 | Lisp_Object membuf; |
| 296 | int pos = XINT (cdr); |
| 297 | membuf = car; |
| 298 | if (pos < 0) |
| 299 | { |
| 300 | if (-pos < BEGV || -pos > ZV) |
| 301 | error ("Changes to be undone are outside visible portion of buffer"); |
| 302 | SET_PT (-pos); |
| 303 | Finsert (1, &membuf); |
| 304 | } |
| 305 | else |
| 306 | { |
| 307 | if (pos < BEGV || pos > ZV) |
| 308 | error ("Changes to be undone are outside visible portion of buffer"); |
| 309 | SET_PT (pos); |
| 310 | Finsert (1, &membuf); |
| 311 | SET_PT (pos); |
| 312 | } |
| 313 | } |
| 314 | } |
| 315 | arg--; |
| 316 | } |
| 317 | |
| 318 | return list; |
| 319 | } |
| 320 | |
| 321 | syms_of_undo () |
| 322 | { |
| 323 | defsubr (&Sprimitive_undo); |
| 324 | defsubr (&Sundo_boundary); |
| 325 | } |