aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/cmds.c180
1 files changed, 142 insertions, 38 deletions
diff --git a/src/cmds.c b/src/cmds.c
index db05b38460e..c6e5edba7b5 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -23,6 +23,7 @@ Boston, MA 02111-1307, USA. */
23#include "lisp.h" 23#include "lisp.h"
24#include "commands.h" 24#include "commands.h"
25#include "buffer.h" 25#include "buffer.h"
26#include "charset.h"
26#include "syntax.h" 27#include "syntax.h"
27#include "window.h" 28#include "window.h"
28#include "keyboard.h" 29#include "keyboard.h"
@@ -40,6 +41,45 @@ Lisp_Object Vself_insert_face_command;
40 41
41extern Lisp_Object Qface; 42extern Lisp_Object Qface;
42 43
44/* Return buffer position which is N characters after `point'. */
45int
46forward_point (n)
47 int n;
48{
49 int pos = PT, c;
50
51 if (!NILP (current_buffer->enable_multibyte_characters))
52 {
53 /* Simply adding N to `point' doesn't work because of multi-byte
54 form. We had better not use INC_POS and DEC_POS because they
55 check the gap position every time. But, for the moment, we
56 need working code. */
57 if (n > 0)
58 {
59 while (pos < ZV && n--) INC_POS (pos);
60 if (pos < ZV) n++;
61 }
62 else
63 {
64 while (pos > BEGV && n++) DEC_POS (pos);
65 if (pos > BEGV) n--;
66 }
67 }
68 pos += n;
69
70 return pos;
71}
72
73DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
74 "Return buffer position N characters after (before if N negative) point.")
75 (n)
76 Lisp_Object n;
77{
78 CHECK_NUMBER (n, 0);
79
80 return make_number (forward_point (XINT (n)));
81}
82
43DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p", 83DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
44 "Move point right N characters (left if N is negative).\n\ 84 "Move point right N characters (left if N is negative).\n\
45On reaching end of buffer, stop and signal error.") 85On reaching end of buffer, stop and signal error.")
@@ -57,7 +97,7 @@ On reaching end of buffer, stop and signal error.")
57 hooks, etcetera), that's not a good approach. So we validate the 97 hooks, etcetera), that's not a good approach. So we validate the
58 proposed position, then set point. */ 98 proposed position, then set point. */
59 { 99 {
60 int new_point = PT + XINT (n); 100 int new_point = forward_point (XINT (n));
61 101
62 if (new_point < BEGV) 102 if (new_point < BEGV)
63 { 103 {
@@ -120,7 +160,7 @@ With positive N, a non-empty line at the end counts as one line\n\
120 && (negp 160 && (negp
121 || (ZV > BEGV 161 || (ZV > BEGV
122 && pos != pos2 162 && pos != pos2
123 && FETCH_CHAR (pos - 1) != '\n'))) 163 && FETCH_BYTE (pos - 1) != '\n')))
124 shortage--; 164 shortage--;
125 SET_PT (pos); 165 SET_PT (pos);
126 return make_number (negp ? - shortage : shortage); 166 return make_number (negp ? - shortage : shortage);
@@ -172,23 +212,26 @@ N was explicitly specified.")
172 (n, killflag) 212 (n, killflag)
173 Lisp_Object n, killflag; 213 Lisp_Object n, killflag;
174{ 214{
215 int pos;
216
175 CHECK_NUMBER (n, 0); 217 CHECK_NUMBER (n, 0);
176 218
219 pos = forward_point (XINT (n));
177 if (NILP (killflag)) 220 if (NILP (killflag))
178 { 221 {
179 if (XINT (n) < 0) 222 if (XINT (n) < 0)
180 { 223 {
181 if (PT + XINT (n) < BEGV) 224 if (pos < BEGV)
182 Fsignal (Qbeginning_of_buffer, Qnil); 225 Fsignal (Qbeginning_of_buffer, Qnil);
183 else 226 else
184 del_range (PT + XINT (n), PT); 227 del_range (pos, PT);
185 } 228 }
186 else 229 else
187 { 230 {
188 if (PT + XINT (n) > ZV) 231 if (pos > ZV)
189 Fsignal (Qend_of_buffer, Qnil); 232 Fsignal (Qend_of_buffer, Qnil);
190 else 233 else
191 del_range (PT, PT + XINT (n)); 234 del_range (PT, pos);
192 } 235 }
193 } 236 }
194 else 237 else
@@ -209,34 +252,41 @@ N was explicitly specified.")
209{ 252{
210 Lisp_Object value; 253 Lisp_Object value;
211 int deleted_special = 0; 254 int deleted_special = 0;
212 int i; 255 int pos, i;
213 256
214 CHECK_NUMBER (n, 0); 257 CHECK_NUMBER (n, 0);
215 258
216 /* See if we are about to delete a tab or newline backwards. */ 259 /* See if we are about to delete a tab or newline backwards. */
217 for (i = 1; i <= XINT (n); i++) 260 pos = PT;
261 for (i = 0; i < XINT (n) && pos > BEGV; i++)
218 { 262 {
219 if (PT - i < BEGV) 263 int c;
220 break; 264
221 if (FETCH_CHAR (PT - i) == '\t' || FETCH_CHAR (PT - i) == '\n') 265 DEC_POS (pos);
266 c = FETCH_BYTE (pos);
267 if (c == '\t' || c == '\n')
222 { 268 {
223 deleted_special = 1; 269 deleted_special = 1;
224 break; 270 break;
225 } 271 }
226 } 272 }
227 273
228 value = Fdelete_char (make_number (-XINT (n)), killflag);
229
230 /* In overwrite mode, back over columns while clearing them out, 274 /* In overwrite mode, back over columns while clearing them out,
231 unless at end of line. */ 275 unless at end of line. */
232 if (XINT (n) > 0 276 if (XINT (n) > 0
233 && ! NILP (current_buffer->overwrite_mode) 277 && ! NILP (current_buffer->overwrite_mode)
234 && ! deleted_special 278 && ! deleted_special
235 && ! (PT == ZV || FETCH_CHAR (PT) == '\n')) 279 && ! (PT == ZV || FETCH_BYTE (PT) == '\n'))
236 { 280 {
237 Finsert_char (make_number (' '), XINT (n)); 281 int column = current_column ();
238 SET_PT (PT - XINT (n)); 282
283 value = Fdelete_char (make_number (-XINT (n)), killflag);
284 i = column - current_column ();
285 Finsert_char (make_number (' '), i);
286 SET_PT (PT - i);
239 } 287 }
288 else
289 value = Fdelete_char (make_number (-XINT (n)), killflag);
240 290
241 return value; 291 return value;
242} 292}
@@ -275,49 +325,102 @@ Whichever character you type to run this command is inserted.")
275 return Qnil; 325 return Qnil;
276} 326}
277 327
278/* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill 328/* Insert character C. If NOAUTOFILL is nonzero, don't do autofill
279 even if it is enabled. 329 even if it is enabled.
280 330
281 If this insertion is suitable for direct output (completely simple), 331 If this insertion is suitable for direct output (completely simple),
282 return 0. A value of 1 indicates this *might* not have been simple. 332 return 0. A value of 1 indicates this *might* not have been simple.
283 A value of 2 means this did things that call for an undo boundary. */ 333 A value of 2 means this did things that call for an undo boundary. */
284 334
285internal_self_insert (c1, noautofill) 335internal_self_insert (c, noautofill)
286 /* This has to be unsigned char; when it is char, 336 int c;
287 some compilers sign-extend it in SYNTAX_ENTRY, despite
288 the casts to unsigned char there. */
289 unsigned char c1;
290 int noautofill; 337 int noautofill;
291{ 338{
292 extern Lisp_Object Fexpand_abbrev (); 339 extern Lisp_Object Fexpand_abbrev ();
293 int hairy = 0; 340 int hairy = 0;
294 Lisp_Object tem; 341 Lisp_Object tem;
295 register enum syntaxcode synt; 342 register enum syntaxcode synt;
296 register int c = c1;
297 Lisp_Object overwrite; 343 Lisp_Object overwrite;
344 /* Length of multi-byte form of C. */
345 int len;
346 /* Working buffer and pointer for multi-byte form of C. */
347 unsigned char workbuf[4], *str;
298 348
299 overwrite = current_buffer->overwrite_mode; 349 overwrite = current_buffer->overwrite_mode;
300 if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function) 350 if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function)
301 || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)) 351 || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
302 hairy = 1; 352 hairy = 1;
303 353
354 /* At first, get multi-byte form of C in STR. */
355 if (!NILP (current_buffer->enable_multibyte_characters))
356 len = CHAR_STRING (c, workbuf, str);
357 else
358 workbuf[0] = c, str = workbuf, len = 1;
359
304 if (!NILP (overwrite) 360 if (!NILP (overwrite)
305 && PT < ZV 361 && PT < ZV)
306 && (EQ (overwrite, Qoverwrite_mode_binary)
307 || (c != '\n' && FETCH_CHAR (PT) != '\n'))
308 && (EQ (overwrite, Qoverwrite_mode_binary)
309 || FETCH_CHAR (PT) != '\t'
310 || XINT (current_buffer->tab_width) <= 0
311 || XFASTINT (current_buffer->tab_width) > 20
312 || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
313 { 362 {
314 del_range (PT, PT + 1); 363 /* In overwrite-mode, we substitute a character at point (C2,
364 hereafter) by C. For that, we delete C2 in advance. But,
365 just substituting C2 by C may move a remaining text in the
366 line to the right or to the left, which is not preferable.
367 So we insert more spaces or delete more characters in the
368 following cases: if C is narrower than C2, after deleting C2,
369 we fill columns with spaces, if C is wider than C2, we delete
370 C2 and several characters following C2. */
371
372 /* A code at `point'. Since this is checked only against
373 NEWLINE and TAB, we don't need a character code but only the
374 first byte of multi-byte form. */
375 unsigned char c2 = FETCH_BYTE (PT);
376 /* A column the cursor should be placed at after this insertion.
377 The correct value should be calculated only when necessary. */
378 int target_clm = 0;
379
380 /* Overwriting in binary-mode always substitute C2 by C. But,
381 overwriting in textual-mode does this substitution in the
382 case that C is not NEWLINE and C2 is not NEWLINE nor TAB. If
383 C2 is TAB, the substitution is done only when C2 is currently
384 expanded to 0 column, or more than 20 columns, or more than
385 the width of C. */
386 if (EQ (overwrite, Qoverwrite_mode_binary)
387 || (c != '\n'
388 && c2 != '\n'
389 && (target_clm = current_column() + WIDTH_BY_CHAR_HEAD (str[0]),
390 (c2 != '\t'
391 || XINT (current_buffer->tab_width) <= 0
392 || XFASTINT (current_buffer->tab_width) > 20
393 || !(target_clm % XFASTINT (current_buffer->tab_width))))))
394 {
395 if (target_clm == 0)
396 del_range (PT, forward_point (1));
397 else
398 {
399 int pos = point;
400 /* The actual cursor position after the trial of moving
401 to column TARGET_CLM. It is greater than TARGET_CLM
402 if the TARGET_CLM is middle of multi-column
403 character. In that case, the new point is set after
404 that character. */
405 int actual_clm = XFASTINT (Fmove_to_column (target_clm));
406
407 del_range (pos, PT);
408 if (actual_clm > target_clm)
409 {
410 /* We deleted too many columns. Let's fill columns
411 by spaces so that the remaining text won't move. */
412 insert(" ", actual_clm - target_clm);
413 SET_PT (pos);
414 }
415 }
416 hairy = 2;
417 }
315 hairy = 2; 418 hairy = 2;
316 } 419 }
317 if (!NILP (current_buffer->abbrev_mode) 420 if (!NILP (current_buffer->abbrev_mode)
318 && SYNTAX (c) != Sword 421 && SYNTAX (c) != Sword
319 && NILP (current_buffer->read_only) 422 && NILP (current_buffer->read_only)
320 && PT > BEGV && SYNTAX (FETCH_CHAR (PT - 1)) == Sword) 423 && PT > BEGV && SYNTAX (XFASTINT (Fprevious_char ())) == Sword)
321 { 424 {
322 int modiff = MODIFF; 425 int modiff = MODIFF;
323 Lisp_Object sym; 426 Lisp_Object sym;
@@ -345,20 +448,20 @@ internal_self_insert (c1, noautofill)
345 { 448 {
346 Lisp_Object tem; 449 Lisp_Object tem;
347 450
348 insert_and_inherit (&c1, 1); 451 insert_and_inherit (str, len);
349 if (c1 == '\n') 452 if (c == '\n')
350 /* After inserting a newline, move to previous line and fill */ 453 /* After inserting a newline, move to previous line and fill */
351 /* that. Must have the newline in place already so filling and */ 454 /* that. Must have the newline in place already so filling and */
352 /* justification, if any, know where the end is going to be. */ 455 /* justification, if any, know where the end is going to be. */
353 SET_PT (PT - 1); 456 SET_PT (PT - 1);
354 tem = call0 (current_buffer->auto_fill_function); 457 tem = call0 (current_buffer->auto_fill_function);
355 if (c1 == '\n') 458 if (c == '\n')
356 SET_PT (PT + 1); 459 SET_PT (PT + 1);
357 if (!NILP (tem)) 460 if (!NILP (tem))
358 hairy = 2; 461 hairy = 2;
359 } 462 }
360 else 463 else
361 insert_and_inherit (&c1, 1); 464 insert_and_inherit (str, len);
362 465
363#ifdef HAVE_FACES 466#ifdef HAVE_FACES
364 /* If previous command specified a face to use, use it. */ 467 /* If previous command specified a face to use, use it. */
@@ -366,7 +469,7 @@ internal_self_insert (c1, noautofill)
366 && EQ (current_kboard->Vlast_command, Vself_insert_face_command)) 469 && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
367 { 470 {
368 Lisp_Object before, after; 471 Lisp_Object before, after;
369 XSETINT (before, PT - 1); 472 XSETINT (before, PT - len);
370 XSETINT (after, PT); 473 XSETINT (after, PT);
371 Fput_text_property (before, after, Qface, Vself_insert_face, Qnil); 474 Fput_text_property (before, after, Qface, Vself_insert_face, Qnil);
372 Vself_insert_face = Qnil; 475 Vself_insert_face = Qnil;
@@ -411,6 +514,7 @@ If `last-command' does not equal this value, we ignore `self-insert-face'.");
411More precisely, a char with closeparen syntax is self-inserted."); 514More precisely, a char with closeparen syntax is self-inserted.");
412 Vblink_paren_function = Qnil; 515 Vblink_paren_function = Qnil;
413 516
517 defsubr (&Sforward_point);
414 defsubr (&Sforward_char); 518 defsubr (&Sforward_char);
415 defsubr (&Sbackward_char); 519 defsubr (&Sbackward_char);
416 defsubr (&Sforward_line); 520 defsubr (&Sforward_line);