editfns.c 143 KB
Newer Older
1
/* Lisp functions pertaining to editing.                 -*- coding: utf-8 -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1987, 1989, 1993-2019 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
18
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
19 20


21
#include <config.h>
22
#include <sys/types.h>
23
#include <stdio.h>
Jim Blandy's avatar
Jim Blandy committed
24

25
#ifdef HAVE_PWD_H
Jim Blandy's avatar
Jim Blandy committed
26
#include <pwd.h>
27
#include <grp.h>
Jim Blandy's avatar
Jim Blandy committed
28 29
#endif

Andreas Schwab's avatar
Andreas Schwab committed
30 31
#include <unistd.h>

32 33 34 35
#ifdef HAVE_SYS_UTSNAME_H
#include <sys/utsname.h>
#endif

36 37
#include "lisp.h"

38
#include <float.h>
39
#include <limits.h>
40
#include <math.h>
41

42
#include <c-ctype.h>
43
#include <intprops.h>
Paul Eggert's avatar
Paul Eggert committed
44
#include <stdlib.h>
45
#include <verify.h>
46

47
#include "composite.h"
48
#include "intervals.h"
49
#include "ptr-bounds.h"
50
#include "systime.h"
51
#include "character.h"
52
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
53
#include "window.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
54
#include "blockinput.h"
Jim Blandy's avatar
Jim Blandy committed
55

56
static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
57
static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);
58

59 60 61 62 63 64 65 66 67 68 69
/* The cached value of Vsystem_name.  This is used only to compare it
   to Vsystem_name, so it need not be visible to the GC.  */
static Lisp_Object cached_system_name;

static void
init_and_cache_system_name (void)
{
  init_system_name ();
  cached_system_name = Vsystem_name;
}

Jim Blandy's avatar
Jim Blandy committed
70
void
71
init_editfns (void)
Jim Blandy's avatar
Jim Blandy committed
72
{
73
  const char *user_name;
74
  register char *p;
Jim Blandy's avatar
Jim Blandy committed
75 76 77 78
  struct passwd *pw;	/* password entry for the current user */
  Lisp_Object tem;

  /* Set up system_name even when dumping.  */
79
  init_and_cache_system_name ();
Jim Blandy's avatar
Jim Blandy committed
80

81
  pw = getpwuid (getuid ());
Morten Welinder's avatar
Morten Welinder committed
82 83
#ifdef MSDOS
  /* We let the real user name default to "root" because that's quite
84
     accurate on MS-DOS and because it lets Emacs find the init file.
Morten Welinder's avatar
Morten Welinder committed
85
     (The DVX libraries override the Djgpp libraries here.)  */
86
  Vuser_real_login_name = build_string (pw ? pw->pw_name : "root");
Morten Welinder's avatar
Morten Welinder committed
87
#else
88
  Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown");
Morten Welinder's avatar
Morten Welinder committed
89
#endif
Jim Blandy's avatar
Jim Blandy committed
90

Jim Blandy's avatar
Jim Blandy committed
91 92
  /* Get the effective user name, by consulting environment variables,
     or the effective uid if those are unset.  */
93
  user_name = getenv ("LOGNAME");
Jim Blandy's avatar
Jim Blandy committed
94
  if (!user_name)
95
#ifdef WINDOWSNT
96
    user_name = getenv ("USERNAME");	/* it's USERNAME on NT */
97
#else  /* WINDOWSNT */
98
    user_name = getenv ("USER");
99
#endif /* WINDOWSNT */
Jim Blandy's avatar
Jim Blandy committed
100 101
  if (!user_name)
    {
102 103
      pw = getpwuid (geteuid ());
      user_name = pw ? pw->pw_name : "unknown";
Jim Blandy's avatar
Jim Blandy committed
104
    }
105
  Vuser_login_name = build_string (user_name);
Jim Blandy's avatar
Jim Blandy committed
106

Jim Blandy's avatar
Jim Blandy committed
107 108
  /* If the user name claimed in the environment vars differs from
     the real uid, use the claimed name to find the full name.  */
109
  tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name);
110 111 112 113 114
  if (! NILP (tem))
    tem = Vuser_login_name;
  else
    {
      uid_t euid = geteuid ();
115
      tem = INT_TO_INTEGER (euid);
116 117
    }
  Vuser_full_name = Fuser_full_name (tem);
Sam Steingold's avatar
Sam Steingold committed
118

119
  p = getenv ("NAME");
120 121
  if (p)
    Vuser_full_name = build_string (p);
122 123
  else if (NILP (Vuser_full_name))
    Vuser_full_name = build_string ("unknown");
124 125 126 127 128 129 130 131 132 133

#ifdef HAVE_SYS_UTSNAME_H
  {
    struct utsname uts;
    uname (&uts);
    Voperating_system_release = build_string (uts.release);
  }
#else
  Voperating_system_release = Qnil;
#endif
Jim Blandy's avatar
Jim Blandy committed
134 135
}

Paul Eggert's avatar
Paul Eggert committed
136
DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
137 138
       doc: /* Convert arg CHAR to a string containing that character.
usage: (char-to-string CHAR)  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
139
  (Lisp_Object character)
Jim Blandy's avatar
Jim Blandy committed
140
{
141
  int c, len;
142
  unsigned char str[MAX_MULTIBYTE_LENGTH];
Karl Heuer's avatar
Karl Heuer committed
143

144
  CHECK_CHARACTER (character);
Tom Tromey's avatar
Tom Tromey committed
145
  c = XFIXNAT (character);
Jim Blandy's avatar
Jim Blandy committed
146

147
  len = CHAR_STRING (c, str);
148
  return make_string_from_bytes ((char *) str, 1, len);
Jim Blandy's avatar
Jim Blandy committed
149 150
}

151
DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0,
152
       doc: /* Convert arg BYTE to a unibyte string containing that byte.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
153
  (Lisp_Object byte)
154
{
155
  unsigned char b;
156
  CHECK_FIXNUM (byte);
Tom Tromey's avatar
Tom Tromey committed
157
  if (XFIXNUM (byte) < 0 || XFIXNUM (byte) > 255)
158
    error ("Invalid byte");
Tom Tromey's avatar
Tom Tromey committed
159
  b = XFIXNUM (byte);
160
  return make_string_from_bytes ((char *) &b, 1, 1);
161 162
}

Jim Blandy's avatar
Jim Blandy committed
163
DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
164
       doc: /* Return the first character in STRING.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
165
  (register Lisp_Object string)
Jim Blandy's avatar
Jim Blandy committed
166 167
{
  register Lisp_Object val;
168
  CHECK_STRING (string);
169
  if (SCHARS (string))
170 171
    {
      if (STRING_MULTIBYTE (string))
172
	XSETFASTINT (val, STRING_CHAR (SDATA (string)));
173
      else
174
	XSETFASTINT (val, SREF (string, 0));
175
    }
Jim Blandy's avatar
Jim Blandy committed
176
  else
177
    XSETFASTINT (val, 0);
Jim Blandy's avatar
Jim Blandy committed
178 179 180
  return val;
}

Paul Eggert's avatar
Paul Eggert committed
181
DEFUN ("point", Fpoint, Spoint, 0, 0, 0,
182 183
       doc: /* Return value of point, as an integer.
Beginning of buffer is position (point-min).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
184
  (void)
Jim Blandy's avatar
Jim Blandy committed
185 186
{
  Lisp_Object temp;
187
  XSETFASTINT (temp, PT);
Jim Blandy's avatar
Jim Blandy committed
188 189 190
  return temp;
}

Paul Eggert's avatar
Paul Eggert committed
191
DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
192
       doc: /* Return value of point, as a marker object.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
193
  (void)
Jim Blandy's avatar
Jim Blandy committed
194
{
195
  return build_marker (current_buffer, PT, PT_BYTE);
Jim Blandy's avatar
Jim Blandy committed
196 197
}

Paul Eggert's avatar
Paul Eggert committed
198
DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
199
       doc: /* Set point to POSITION, a number or marker.
Eli Zaretskii's avatar
Eli Zaretskii committed
200 201 202
Beginning of buffer is position (point-min), end is (point-max).

The return value is POSITION.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
203
  (register Lisp_Object position)
Jim Blandy's avatar
Jim Blandy committed
204
{
205 206
  if (MARKERP (position))
    set_point_from_marker (position);
207
  else if (FIXNUMP (position))
Tom Tromey's avatar
Tom Tromey committed
208
    SET_PT (clip_to_bounds (BEGV, XFIXNUM (position), ZV));
209 210
  else
    wrong_type_argument (Qinteger_or_marker_p, position);
211
  return position;
Jim Blandy's avatar
Jim Blandy committed
212 213
}

214 215

/* Return the start or end position of the region.
216
   BEGINNINGP means return the start.
217 218
   If there is no region active, signal an error. */

Jim Blandy's avatar
Jim Blandy committed
219
static Lisp_Object
220
region_limit (bool beginningp)
Jim Blandy's avatar
Jim Blandy committed
221
{
222
  Lisp_Object m;
223

224 225
  if (!NILP (Vtransient_mark_mode)
      && NILP (Vmark_even_if_inactive)
Tom Tromey's avatar
Tom Tromey committed
226
      && NILP (BVAR (current_buffer, mark_active)))
227
    xsignal0 (Qmark_inactive);
228

Tom Tromey's avatar
Tom Tromey committed
229
  m = Fmarker_position (BVAR (current_buffer, mark));
230
  if (NILP (m))
231
    error ("The mark is not set now, so there is no region");
232

233
  /* Clip to the current narrowing (bug#11770).  */
Tom Tromey's avatar
Tom Tromey committed
234
  return make_fixnum ((PT < XFIXNAT (m)) == beginningp
235
		      ? PT
Tom Tromey's avatar
Tom Tromey committed
236
		      : clip_to_bounds (BEGV, XFIXNAT (m), ZV));
Jim Blandy's avatar
Jim Blandy committed
237 238 239
}

DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,
240
       doc: /* Return the integer value of point or mark, whichever is smaller.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
241
  (void)
Jim Blandy's avatar
Jim Blandy committed
242
{
243
  return region_limit (1);
Jim Blandy's avatar
Jim Blandy committed
244 245 246
}

DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0,
247
       doc: /* Return the integer value of point or mark, whichever is larger.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
248
  (void)
Jim Blandy's avatar
Jim Blandy committed
249
{
250
  return region_limit (0);
Jim Blandy's avatar
Jim Blandy committed
251 252 253
}

DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0,
254
       doc: /* Return this buffer's mark, as a marker object.
Pavel Janík's avatar
Pavel Janík committed
255
Watch out!  Moving this marker changes the mark position.
256
If you set the marker not to point anywhere, the buffer will have no mark.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
257
  (void)
Jim Blandy's avatar
Jim Blandy committed
258
{
Tom Tromey's avatar
Tom Tromey committed
259
  return BVAR (current_buffer, mark);
Jim Blandy's avatar
Jim Blandy committed
260
}
261 262


263 264 265 266
/* Find all the overlays in the current buffer that touch position POS.
   Return the number found, and store them in a vector in VEC
   of length LEN.  */

267 268
static ptrdiff_t
overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len)
269
{
270
  ptrdiff_t idx = 0;
271

272 273
  for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
       tail; tail = tail->next)
274
    {
275 276 277
      Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
      Lisp_Object end = OVERLAY_END (overlay);
      ptrdiff_t endpos = OVERLAY_POSITION (end);
278 279
      if (endpos < pos)
	  break;
280 281
      Lisp_Object start = OVERLAY_START (overlay);
      ptrdiff_t startpos = OVERLAY_POSITION (start);
282 283 284 285 286 287 288 289 290
      if (startpos <= pos)
	{
	  if (idx < len)
	    vec[idx] = overlay;
	  /* Keep counting overlays even if we can't return them all.  */
	  idx++;
	}
    }

291 292
  for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
       tail; tail = tail->next)
293
    {
294 295 296
      Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
      Lisp_Object start = OVERLAY_START (overlay);
      ptrdiff_t startpos = OVERLAY_POSITION (start);
297 298
      if (pos < startpos)
	break;
299 300
      Lisp_Object end = OVERLAY_END (overlay);
      ptrdiff_t endpos = OVERLAY_POSITION (end);
301 302 303 304 305 306 307 308 309 310 311
      if (pos <= endpos)
	{
	  if (idx < len)
	    vec[idx] = overlay;
	  idx++;
	}
    }

  return idx;
}

312 313 314 315 316 317 318 319 320
DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0,
       doc: /* Return the value of POSITION's property PROP, in OBJECT.
Almost identical to `get-char-property' except for the following difference:
Whereas `get-char-property' returns the property of the char at (i.e. right
after) POSITION, this pays attention to properties's stickiness and overlays's
advancement settings, in order to find the property of POSITION itself,
i.e. the property that a char would inherit if it were inserted
at POSITION.  */)
  (Lisp_Object position, register Lisp_Object prop, Lisp_Object object)
321
{
322
  CHECK_FIXNUM_COERCE_MARKER (position);
323 324 325

  if (NILP (object))
    XSETBUFFER (object, current_buffer);
326
  else if (WINDOWP (object))
327
    object = XWINDOW (object)->contents;
328 329 330 331 332 333 334

  if (!BUFFERP (object))
    /* pos-property only makes sense in buffers right now, since strings
       have no overlays and no notion of insertion for which stickiness
       could be obeyed.  */
    return Fget_text_property (position, prop, object);
  else
335
    {
Tom Tromey's avatar
Tom Tromey committed
336
      EMACS_INT posn = XFIXNUM (position);
337
      ptrdiff_t noverlays;
338 339
      Lisp_Object *overlay_vec, tem;
      struct buffer *obuf = current_buffer;
340
      USE_SAFE_ALLOCA;
341 342 343 344

      set_buffer_temp (XBUFFER (object));

      /* First try with room for 40 overlays.  */
345 346 347
      Lisp_Object overlay_vecbuf[40];
      noverlays = ARRAYELTS (overlay_vecbuf);
      overlay_vec = overlay_vecbuf;
348 349 350 351
      noverlays = overlays_around (posn, overlay_vec, noverlays);

      /* If there are more than 40,
	 make enough space for all, and try again.  */
352
      if (ARRAYELTS (overlay_vecbuf) < noverlays)
353
	{
354
	  SAFE_ALLOCA_LISP (overlay_vec, noverlays);
355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376
	  noverlays = overlays_around (posn, overlay_vec, noverlays);
	}
      noverlays = sort_overlays (overlay_vec, noverlays, NULL);

      set_buffer_temp (obuf);

      /* Now check the overlays in order of decreasing priority.  */
      while (--noverlays >= 0)
	{
	  Lisp_Object ol = overlay_vec[noverlays];
	  tem = Foverlay_get (ol, prop);
	  if (!NILP (tem))
	    {
	      /* Check the overlay is indeed active at point.  */
	      Lisp_Object start = OVERLAY_START (ol), finish = OVERLAY_END (ol);
	      if ((OVERLAY_POSITION (start) == posn
		   && XMARKER (start)->insertion_type == 1)
		  || (OVERLAY_POSITION (finish) == posn
		      && XMARKER (finish)->insertion_type == 0))
		; /* The overlay will not cover a char inserted at point.  */
	      else
		{
377
		  SAFE_FREE ();
378 379 380 381
		  return tem;
		}
	    }
	}
382
      SAFE_FREE ();
383

384
      { /* Now check the text properties.  */
385 386 387 388
	int stickiness = text_property_stickiness (prop, position, object);
	if (stickiness > 0)
	  return Fget_text_property (position, prop, object);
	else if (stickiness < 0
Tom Tromey's avatar
Tom Tromey committed
389 390
		 && XFIXNUM (position) > BUF_BEGV (XBUFFER (object)))
	  return Fget_text_property (make_fixnum (XFIXNUM (position) - 1),
391 392 393 394
				     prop, object);
	else
	  return Qnil;
      }
395 396 397
    }
}

398
/* Find the field surrounding POS in *BEG and *END.  If POS is nil,
Lars Hansen's avatar
Lars Hansen committed
399
   the value of point is used instead.  If BEG or END is null,
400
   means don't store the beginning or end of the field.
401

402 403 404
   BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
   results; they do not effect boundary behavior.

405
   If MERGE_AT_BOUNDARY is non-nil, then if POS is at the very first
406 407 408 409
   position of a field, then the beginning of the previous field is
   returned instead of the beginning of POS's field (since the end of a
   field is actually also the beginning of the next input field, this
   behavior is sometimes useful).  Additionally in the MERGE_AT_BOUNDARY
410
   non-nil case, if two fields are separated by a field with the special
411 412 413
   value `boundary', and POS lies within it, then the two separated
   fields are considered to be adjacent, and POS between them, when
   finding the beginning and ending of the "merged" field.
414 415 416 417

   Either BEG or END may be 0, in which case the corresponding value
   is not stored.  */

418
static void
419 420
find_field (Lisp_Object pos, Lisp_Object merge_at_boundary,
	    Lisp_Object beg_limit,
421
	    ptrdiff_t *beg, Lisp_Object end_limit, ptrdiff_t *end)
422
{
423 424
  /* Fields right before and after the point.  */
  Lisp_Object before_field, after_field;
425 426 427 428
  /* True if POS counts as the start of a field.  */
  bool at_field_start = 0;
  /* True if POS counts as the end of a field.  */
  bool at_field_end = 0;
429

430 431 432
  if (NILP (pos))
    XSETFASTINT (pos, PT);
  else
433
    CHECK_FIXNUM_COERCE_MARKER (pos);
434

435
  after_field
436
    = get_char_property_and_overlay (pos, Qfield, Qnil, NULL);
437
  before_field
Tom Tromey's avatar
Tom Tromey committed
438 439
    = (XFIXNAT (pos) > BEGV
       ? get_char_property_and_overlay (make_fixnum (XFIXNUM (pos) - 1),
440
					Qfield, Qnil, NULL)
441 442 443
       /* Using nil here would be a more obvious choice, but it would
          fail when the buffer starts with a non-sticky field.  */
       : after_field);
444 445 446 447 448 449 450

  /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
     and POS is at beginning of a field, which can also be interpreted
     as the end of the previous field.  Note that the case where if
     MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
     more natural one; then we avoid treating the beginning of a field
     specially.  */
451
  if (NILP (merge_at_boundary))
452
    {
453
      Lisp_Object field = Fget_pos_property (pos, Qfield, Qnil);
454
      if (!EQ (field, after_field))
455
	at_field_end = 1;
456 457
      if (!EQ (field, before_field))
	at_field_start = 1;
458 459 460 461 462 463
      if (NILP (field) && at_field_start && at_field_end)
	/* If an inserted char would have a nil field while the surrounding
	   text is non-nil, we're probably not looking at a
	   zero-length field, but instead at a non-nil field that's
	   not intended for editing (such as comint's prompts).  */
	at_field_end = at_field_start = 0;
464 465
    }

466 467 468 469 470 471
  /* Note about special `boundary' fields:

     Consider the case where the point (`.') is between the fields `x' and `y':

	xxxx.yyyy

472
     In this situation, if merge_at_boundary is non-nil, consider the
473 474 475 476
     `x' and `y' fields as forming one big merged field, and so the end
     of the field is the end of `y'.

     However, if `x' and `y' are separated by a special `boundary' field
477
     (a field with a `field' char-property of 'boundary), then ignore
478 479 480 481 482 483
     this special field when merging adjacent fields.  Here's the same
     situation, but with a `boundary' field between the `x' and `y' fields:

	xxx.BBBByyyy

     Here, if point is at the end of `x', the beginning of `y', or
484
     anywhere in-between (within the `boundary' field), merge all
485 486 487
     three fields and consider the beginning as being the beginning of
     the `x' field, and the end as being the end of the `y' field.  */

488
  if (beg)
489 490 491 492
    {
      if (at_field_start)
	/* POS is at the edge of a field, and we should consider it as
	   the beginning of the following field.  */
Tom Tromey's avatar
Tom Tromey committed
493
	*beg = XFIXNAT (pos);
494 495 496
      else
	/* Find the previous field boundary.  */
	{
497
	  Lisp_Object p = pos;
498 499
	  if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary))
	    /* Skip a `boundary' field.  */
500
	    p = Fprevious_single_char_property_change (p, Qfield, Qnil,
501
						       beg_limit);
502 503 504

	  p = Fprevious_single_char_property_change (p, Qfield, Qnil,
						     beg_limit);
Tom Tromey's avatar
Tom Tromey committed
505
	  *beg = NILP (p) ? BEGV : XFIXNAT (p);
506 507
	}
    }
508 509

  if (end)
510 511 512 513
    {
      if (at_field_end)
	/* POS is at the edge of a field, and we should consider it as
	   the end of the previous field.  */
Tom Tromey's avatar
Tom Tromey committed
514
	*end = XFIXNAT (pos);
515 516 517 518 519
      else
	/* Find the next field boundary.  */
	{
	  if (!NILP (merge_at_boundary) && EQ (after_field, Qboundary))
	    /* Skip a `boundary' field.  */
520 521
	    pos = Fnext_single_char_property_change (pos, Qfield, Qnil,
						     end_limit);
522

523 524
	  pos = Fnext_single_char_property_change (pos, Qfield, Qnil,
						   end_limit);
Tom Tromey's avatar
Tom Tromey committed
525
	  *end = NILP (pos) ? ZV : XFIXNAT (pos);
526 527
	}
    }
528
}
529

530

531
DEFUN ("delete-field", Fdelete_field, Sdelete_field, 0, 1, 0,
532
       doc: /* Delete the field surrounding POS.
Pavel Janík's avatar
Pavel Janík committed
533
A field is a region of text with the same `field' property.
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
534
If POS is nil, the value of point is used for POS.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
535
  (Lisp_Object pos)
536
{
537
  ptrdiff_t beg, end;
538
  find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
539 540
  if (beg != end)
    del_range (beg, end);
541
  return Qnil;
542 543 544
}

DEFUN ("field-string", Ffield_string, Sfield_string, 0, 1, 0,
545
       doc: /* Return the contents of the field surrounding POS as a string.
Pavel Janík's avatar
Pavel Janík committed
546
A field is a region of text with the same `field' property.
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
547
If POS is nil, the value of point is used for POS.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
548
  (Lisp_Object pos)
549
{
550
  ptrdiff_t beg, end;
551
  find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
552 553 554 555
  return make_buffer_string (beg, end, 1);
}

DEFUN ("field-string-no-properties", Ffield_string_no_properties, Sfield_string_no_properties, 0, 1, 0,
556
       doc: /* Return the contents of the field around POS, without text properties.
Pavel Janík's avatar
Pavel Janík committed
557
A field is a region of text with the same `field' property.
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
558
If POS is nil, the value of point is used for POS.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
559
  (Lisp_Object pos)
560
{
561
  ptrdiff_t beg, end;
562
  find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
563 564 565
  return make_buffer_string (beg, end, 0);
}

566
DEFUN ("field-beginning", Ffield_beginning, Sfield_beginning, 0, 3, 0,
567
       doc: /* Return the beginning of the field surrounding POS.
Pavel Janík's avatar
Pavel Janík committed
568 569 570
A field is a region of text with the same `field' property.
If POS is nil, the value of point is used for POS.
If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
571 572
field, then the beginning of the *previous* field is returned.
If LIMIT is non-nil, it is a buffer position; if the beginning of the field
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
573
is before LIMIT, then LIMIT will be returned instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
574
  (Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit)
575
{
576
  ptrdiff_t beg;
577
  find_field (pos, escape_from_edge, limit, &beg, Qnil, 0);
578
  return make_fixnum (beg);
579 580
}

Paul Eggert's avatar
Paul Eggert committed
581
DEFUN ("field-end", Ffield_end, Sfield_end, 0, 3, 0,
582
       doc: /* Return the end of the field surrounding POS.
Pavel Janík's avatar
Pavel Janík committed
583 584 585
A field is a region of text with the same `field' property.
If POS is nil, the value of point is used for POS.
If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
586 587
then the end of the *following* field is returned.
If LIMIT is non-nil, it is a buffer position; if the end of the field
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
588
is after LIMIT, then LIMIT will be returned instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
589
  (Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit)
590
{
591
  ptrdiff_t end;
592
  find_field (pos, escape_from_edge, Qnil, 0, limit, &end);
593
  return make_fixnum (end);
594 595
}

Paul Eggert's avatar
Paul Eggert committed
596
DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0,
597
       doc: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
Pavel Janík's avatar
Pavel Janík committed
598
A field is a region of text with the same `field' property.
599 600 601 602

If NEW-POS is nil, then use the current point instead, and move point
to the resulting constrained position, in addition to returning that
position.
Pavel Janík's avatar
Pavel Janík committed
603 604 605 606 607 608 609 610 611 612 613 614 615

If OLD-POS is at the boundary of two fields, then the allowable
positions for NEW-POS depends on the value of the optional argument
ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
constrained to the field that has the same `field' char-property
as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
is non-nil, NEW-POS is constrained to the union of the two adjacent
fields.  Additionally, if two fields are separated by another field with
the special value `boundary', then any point within this special field is
also considered to be `on the boundary'.

If the optional argument ONLY-IN-LINE is non-nil and constraining
NEW-POS would move it to a different line, NEW-POS is returned
616
unconstrained.  This is useful for commands that move by line, like
Pavel Janík's avatar
Pavel Janík committed
617 618 619 620 621 622
\\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
only in the case where they can still move to the right line.

If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
a non-nil property of that name, then any field boundaries are ignored.

623
Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil.  */)
624 625
  (Lisp_Object new_pos, Lisp_Object old_pos, Lisp_Object escape_from_edge,
   Lisp_Object only_in_line, Lisp_Object inhibit_capture_property)
626 627
{
  /* If non-zero, then the original point, before re-positioning.  */
628
  ptrdiff_t orig_point = 0;
629
  bool fwd;
630
  Lisp_Object prev_old, prev_new;
631

632 633 634 635 636 637 638
  if (NILP (new_pos))
    /* Use the current point, and afterwards, set it.  */
    {
      orig_point = PT;
      XSETFASTINT (new_pos, PT);
    }

639 640
  CHECK_FIXNUM_COERCE_MARKER (new_pos);
  CHECK_FIXNUM_COERCE_MARKER (old_pos);
641

Tom Tromey's avatar
Tom Tromey committed
642
  fwd = (XFIXNUM (new_pos) > XFIXNUM (old_pos));
643

Tom Tromey's avatar
Tom Tromey committed
644 645
  prev_old = make_fixnum (XFIXNUM (old_pos) - 1);
  prev_new = make_fixnum (XFIXNUM (new_pos) - 1);
646

647 648
  if (NILP (Vinhibit_field_text_motion)
      && !EQ (new_pos, old_pos)
649 650
      && (!NILP (Fget_char_property (new_pos, Qfield, Qnil))
          || !NILP (Fget_char_property (old_pos, Qfield, Qnil))
651
          /* To recognize field boundaries, we must also look at the
652
             previous positions; we could use `Fget_pos_property'
653 654
             instead, but in itself that would fail inside non-sticky
             fields (like comint prompts).  */
Tom Tromey's avatar
Tom Tromey committed
655
          || (XFIXNAT (new_pos) > BEGV
656
              && !NILP (Fget_char_property (prev_new, Qfield, Qnil)))
Tom Tromey's avatar
Tom Tromey committed
657
          || (XFIXNAT (old_pos) > BEGV
658
              && !NILP (Fget_char_property (prev_old, Qfield, Qnil))))
659
      && (NILP (inhibit_capture_property)
660 661 662
          /* Field boundaries are again a problem; but now we must
             decide the case exactly, so we need to call
             `get_pos_property' as well.  */
663
          || (NILP (Fget_pos_property (old_pos, inhibit_capture_property, Qnil))
Tom Tromey's avatar
Tom Tromey committed
664
              && (XFIXNAT (old_pos) <= BEGV
665 666 667 668
                  || NILP (Fget_char_property
			   (old_pos, inhibit_capture_property, Qnil))
                  || NILP (Fget_char_property
			   (prev_old, inhibit_capture_property, Qnil))))))
669 670
    /* It is possible that NEW_POS is not within the same field as
       OLD_POS; try to move NEW_POS so that it is.  */
671
    {
672
      ptrdiff_t counted;
673 674 675
      Lisp_Object field_bound;

      if (fwd)
676
	field_bound = Ffield_end (old_pos, escape_from_edge, new_pos);
677
      else
678
	field_bound = Ffield_beginning (old_pos, escape_from_edge, new_pos);
679

680 681 682 683
      if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
             other side of NEW_POS, which would mean that NEW_POS is
             already acceptable, and it's not necessary to constrain it
             to FIELD_BOUND.  */
Tom Tromey's avatar
Tom Tromey committed
684
	  ((XFIXNAT (field_bound) < XFIXNAT (new_pos)) ? fwd : !fwd)
685 686 687
	  /* NEW_POS should be constrained, but only if either
	     ONLY_IN_LINE is nil (in which case any constraint is OK),
	     or NEW_POS and FIELD_BOUND are on the same line (in which
688
	     case the constraint is OK even if ONLY_IN_LINE is non-nil).  */
689 690 691 692
	  && (NILP (only_in_line)
	      /* This is the ONLY_IN_LINE case, check that NEW_POS and
		 FIELD_BOUND are on the same line by seeing whether
		 there's an intervening newline or not.  */
Tom Tromey's avatar
Tom Tromey committed
693 694
	      || (find_newline (XFIXNAT (new_pos), -1,
				XFIXNAT (field_bound), -1,
695 696
				fwd ? -1 : 1, &counted, NULL, 1),
		  counted == 0)))
697 698 699
	/* Constrain NEW_POS to FIELD_BOUND.  */
	new_pos = field_bound;

Tom Tromey's avatar
Tom Tromey committed
700
      if (orig_point && XFIXNAT (new_pos) != orig_point)
701
	/* The NEW_POS argument was originally nil, so automatically set PT. */
Tom Tromey's avatar
Tom Tromey committed
702
	SET_PT (XFIXNAT (new_pos));
703 704 705 706
    }

  return new_pos;
}
707

708

Paul Eggert's avatar
Paul Eggert committed
709
DEFUN ("line-beginning-position",
710
       Fline_beginning_position, Sline_beginning_position, 0, 1, 0,
711
       doc: /* Return the character position of the first character on the current line.
Chong Yidong's avatar
Chong Yidong committed
712 713
With optional argument N, scan forward N - 1 lines first.
If the scan reaches the end of the buffer, return that position.
714

Chong Yidong's avatar
Chong Yidong committed
715 716 717
This function ignores text display directionality; it returns the
position of the first character in logical order, i.e. the smallest
character position on the line.
718

719
This function constrains the returned position to the current field
Chong Yidong's avatar
Chong Yidong committed
720
unless that position would be on a different line than the original,
721 722
unconstrained result.  If N is nil or 1, and a front-sticky field
starts at point, the scan stops as soon as it starts.  To ignore field
Chong Yidong's avatar
Chong Yidong committed
723
boundaries, bind `inhibit-field-text-motion' to t.
Pavel Janík's avatar
Pavel Janík committed
724

725
This function does not move point.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
726
  (Lisp_Object n)
727
{
728
  ptrdiff_t charpos, bytepos;
729 730 731 732

  if (NILP (n))
    XSETFASTINT (n, 1);
  else
733
    CHECK_FIXNUM (n);
734

Tom Tromey's avatar
Tom Tromey committed
735
  scan_newline_from_point (XFIXNUM (n) - 1, &charpos, &bytepos);
736

737
  /* Return END constrained to the current input field.  */
738
  return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT),
Tom Tromey's avatar
Tom Tromey committed
739
			      XFIXNUM (n) != 1 ? Qt : Qnil,
740
			      Qt, Qnil);
741 742
}

Paul Eggert's avatar
Paul Eggert committed
743
DEFUN ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0,
744
       doc: /* Return the character position of the last character on the current line.
Pavel Janík's avatar
Pavel Janík committed
745 746
With argument N not nil or 1, move forward N - 1 lines first.
If scan reaches end of buffer, return that position.
747

Chong Yidong's avatar
Chong Yidong committed
748 749 750
This function ignores text display directionality; it returns the
position of the last character in logical order, i.e. the largest
character position on the line.
751

752 753 754 755
This function constrains the returned position to the current field
unless that would be on a different line than the original,
unconstrained result.  If N is nil or 1, and a rear-sticky field ends
at point, the scan stops as soon as it starts.  To ignore field
756 757
boundaries bind `inhibit-field-text-motion' to t.

758
This function does not move point.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
759
  (Lisp_Object n)
760
{
761 762 763
  ptrdiff_t clipped_n;
  ptrdiff_t end_pos;
  ptrdiff_t orig = PT;
764

765 766 767
  if (NILP (n))
    XSETFASTINT (n, 1);
  else
768
    CHECK_FIXNUM (n);
769

Tom Tromey's avatar
Tom Tromey committed
770
  clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XFIXNUM (n), PTRDIFF_MAX);
771 772
  end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0),
				      NULL);
773 774

  /* Return END_POS constrained to the current input field.  */
775
  return Fconstrain_to_field (make_fixnum (end_pos), make_fixnum (orig),
776
			      Qnil, Qt, Qnil);
777
}
778

779
/* Save current buffer state for save-excursion special form.  */
780

781 782
void
save_excursion_save (union specbinding *pdl)
Jim Blandy's avatar
Jim Blandy committed
783
{
784 785 786 787 788 789
  eassert (pdl->unwind_excursion.kind == SPECPDL_UNWIND_EXCURSION);
  pdl->unwind_excursion.marker = Fpoint_marker ();
  /* Selected window if current buffer is shown in it, nil otherwise.  */
  pdl->unwind_excursion.window
    = (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ())
       ? selected_window : Qnil);
Jim Blandy's avatar
Jim Blandy committed
790 791
}

792 793
/* Restore saved buffer before leaving `save-excursion' special form.  */

794
void
795
save_excursion_restore (Lisp_Object marker, Lisp_Object window)
Jim Blandy's avatar
Jim Blandy committed
796
{
797
  Lisp_Object buffer = Fmarker_buffer (marker);
798
  /* If we're unwinding to top level, saved buffer may be deleted.  This
799 800 801
     means that all of its markers are unchained and so BUFFER is nil.  */
  if (NILP (buffer))
    return;
802

803
  Fset_buffer (buffer);
804

805
  /* Point marker.  */
806 807
  Fgoto_char (marker);
  unchain_marker (XMARKER (marker));
808 809 810 811

  /* If buffer was visible in a window, and a different window was
     selected, and the old selected window is still showing this
     buffer, restore point in that window.  */
812 813 814 815 816
  if (WINDOWP (window) && !EQ (window