editfns.c 149 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Lisp functions pertaining to editing.
2

3
Copyright (C) 1985-1987, 1989, 1993-2014 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 <http://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 39 40 41
/* systime.h includes <sys/time.h> which, on some systems, is required
   for <sys/resource.h>; thus systime.h must be included before
   <sys/resource.h> */
#include "systime.h"
42 43

#if defined HAVE_SYS_RESOURCE_H
44
#include <sys/resource.h>
45 46
#endif

47
#include <float.h>
48 49
#include <limits.h>
#include <intprops.h>
Paul Eggert's avatar
Paul Eggert committed
50
#include <strftime.h>
51
#include <verify.h>
52

53
#include "intervals.h"
54
#include "character.h"
55
#include "buffer.h"
56
#include "coding.h"
57
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
58
#include "window.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
59
#include "blockinput.h"
Jim Blandy's avatar
Jim Blandy committed
60

61 62
#define TM_YEAR_BASE 1900

63
#ifdef WINDOWSNT
64
extern Lisp_Object w32_get_internal_run_time (void);
65 66
#endif

67
static void set_time_zone_rule (char const *);
68
static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec,
69
				       bool, struct tm *);
70
static long int tm_gmtoff (struct tm *);
71
static int tm_diff (struct tm *, struct tm *);
72
static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
73

74 75 76 77
#ifndef HAVE_TM_GMTOFF
# define HAVE_TM_GMTOFF false
#endif

78
static Lisp_Object Qbuffer_access_fontify_functions;
79

80 81 82 83 84 85
/* Symbol for the text property used to mark fields.  */

Lisp_Object Qfield;

/* A special value for Qfield properties.  */

86
static Lisp_Object Qboundary;
87

88
/* The startup value of the TZ environment variable; null if unset.  */
89 90
static char const *initial_tz;

91 92
/* A valid but unlikely setting for the TZ environment variable.
   It is OK (though a bit slower) if the user chooses this value.  */
93
static char dump_tz_string[] = "TZ=UtC0";
94

Jim Blandy's avatar
Jim Blandy committed
95
void
96
init_editfns (void)
Jim Blandy's avatar
Jim Blandy committed
97
{
98
  const char *user_name;
99
  register char *p;
Jim Blandy's avatar
Jim Blandy committed
100 101 102 103
  struct passwd *pw;	/* password entry for the current user */
  Lisp_Object tem;

  /* Set up system_name even when dumping.  */
104
  init_system_name ();
Jim Blandy's avatar
Jim Blandy committed
105 106

#ifndef CANNOT_DUMP
107 108
  /* When just dumping out, set the time zone to a known unlikely value
     and skip the rest of this function.  */
Jim Blandy's avatar
Jim Blandy committed
109
  if (!initialized)
110 111
    {
# ifdef HAVE_TZSET
112
      xputenv (dump_tz_string);
113 114 115 116 117 118 119 120
      tzset ();
# endif
      return;
    }
#endif

  char *tz = getenv ("TZ");
  initial_tz = tz;
Jim Blandy's avatar
Jim Blandy committed
121

122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
#if !defined CANNOT_DUMP && defined HAVE_TZSET
  /* If the execution TZ happens to be the same as the dump TZ,
     change it to some other value and then change it back,
     to force the underlying implementation to reload the TZ info.
     This is needed on implementations that load TZ info from files,
     since the TZ file contents may differ between dump and execution.  */
  if (tz && strcmp (tz, &dump_tz_string[sizeof "TZ=" - 1]) == 0)
    {
      ++*tz;
      tzset ();
      --*tz;
    }
#endif

  /* Call set_time_zone_rule now, so that its call to putenv is done
     before multiple threads are active.  */
  set_time_zone_rule (tz);
139

140
  pw = getpwuid (getuid ());
Morten Welinder's avatar
Morten Welinder committed
141 142
#ifdef MSDOS
  /* We let the real user name default to "root" because that's quite
143
     accurate on MS-DOS and because it lets Emacs find the init file.
Morten Welinder's avatar
Morten Welinder committed
144
     (The DVX libraries override the Djgpp libraries here.)  */
145
  Vuser_real_login_name = build_string (pw ? pw->pw_name : "root");
Morten Welinder's avatar
Morten Welinder committed
146
#else
147
  Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown");
Morten Welinder's avatar
Morten Welinder committed
148
#endif
Jim Blandy's avatar
Jim Blandy committed
149

Jim Blandy's avatar
Jim Blandy committed
150 151
  /* Get the effective user name, by consulting environment variables,
     or the effective uid if those are unset.  */
152
  user_name = getenv ("LOGNAME");
Jim Blandy's avatar
Jim Blandy committed
153
  if (!user_name)
154
#ifdef WINDOWSNT
155
    user_name = getenv ("USERNAME");	/* it's USERNAME on NT */
156
#else  /* WINDOWSNT */
157
    user_name = getenv ("USER");
158
#endif /* WINDOWSNT */
Jim Blandy's avatar
Jim Blandy committed
159 160
  if (!user_name)
    {
161 162
      pw = getpwuid (geteuid ());
      user_name = pw ? pw->pw_name : "unknown";
Jim Blandy's avatar
Jim Blandy committed
163
    }
164
  Vuser_login_name = build_string (user_name);
Jim Blandy's avatar
Jim Blandy committed
165

Jim Blandy's avatar
Jim Blandy committed
166 167
  /* If the user name claimed in the environment vars differs from
     the real uid, use the claimed name to find the full name.  */
168
  tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name);
169 170 171 172 173 174 175 176
  if (! NILP (tem))
    tem = Vuser_login_name;
  else
    {
      uid_t euid = geteuid ();
      tem = make_fixnum_or_float (euid);
    }
  Vuser_full_name = Fuser_full_name (tem);
Sam Steingold's avatar
Sam Steingold committed
177

178
  p = getenv ("NAME");
179 180
  if (p)
    Vuser_full_name = build_string (p);
181 182
  else if (NILP (Vuser_full_name))
    Vuser_full_name = build_string ("unknown");
183 184 185 186 187 188 189 190 191 192

#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
193 194
}

Paul Eggert's avatar
Paul Eggert committed
195
DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
196 197
       doc: /* Convert arg CHAR to a string containing that character.
usage: (char-to-string CHAR)  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
198
  (Lisp_Object character)
Jim Blandy's avatar
Jim Blandy committed
199
{
200
  int c, len;
201
  unsigned char str[MAX_MULTIBYTE_LENGTH];
Karl Heuer's avatar
Karl Heuer committed
202

203
  CHECK_CHARACTER (character);
204
  c = XFASTINT (character);
Jim Blandy's avatar
Jim Blandy committed
205

206
  len = CHAR_STRING (c, str);
207
  return make_string_from_bytes ((char *) str, 1, len);
Jim Blandy's avatar
Jim Blandy committed
208 209
}

210
DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0,
211
       doc: /* Convert arg BYTE to a unibyte string containing that byte.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
212
  (Lisp_Object byte)
213
{
214
  unsigned char b;
215
  CHECK_NUMBER (byte);
216 217
  if (XINT (byte) < 0 || XINT (byte) > 255)
    error ("Invalid byte");
218
  b = XINT (byte);
219
  return make_string_from_bytes ((char *) &b, 1, 1);
220 221
}

Jim Blandy's avatar
Jim Blandy committed
222
DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
223
       doc: /* Return the first character in STRING.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
224
  (register Lisp_Object string)
Jim Blandy's avatar
Jim Blandy committed
225 226
{
  register Lisp_Object val;
227
  CHECK_STRING (string);
228
  if (SCHARS (string))
229 230
    {
      if (STRING_MULTIBYTE (string))
231
	XSETFASTINT (val, STRING_CHAR (SDATA (string)));
232
      else
233
	XSETFASTINT (val, SREF (string, 0));
234
    }
Jim Blandy's avatar
Jim Blandy committed
235
  else
236
    XSETFASTINT (val, 0);
Jim Blandy's avatar
Jim Blandy committed
237 238 239
  return val;
}

Paul Eggert's avatar
Paul Eggert committed
240
DEFUN ("point", Fpoint, Spoint, 0, 0, 0,
241 242
       doc: /* Return value of point, as an integer.
Beginning of buffer is position (point-min).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
243
  (void)
Jim Blandy's avatar
Jim Blandy committed
244 245
{
  Lisp_Object temp;
246
  XSETFASTINT (temp, PT);
Jim Blandy's avatar
Jim Blandy committed
247 248 249
  return temp;
}

Paul Eggert's avatar
Paul Eggert committed
250
DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
251
       doc: /* Return value of point, as a marker object.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
252
  (void)
Jim Blandy's avatar
Jim Blandy committed
253
{
254
  return build_marker (current_buffer, PT, PT_BYTE);
Jim Blandy's avatar
Jim Blandy committed
255 256
}

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

The return value is POSITION.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
262
  (register Lisp_Object position)
Jim Blandy's avatar
Jim Blandy committed
263
{
264 265 266 267 268 269
  if (MARKERP (position))
    set_point_from_marker (position);
  else if (INTEGERP (position))
    SET_PT (clip_to_bounds (BEGV, XINT (position), ZV));
  else
    wrong_type_argument (Qinteger_or_marker_p, position);
270
  return position;
Jim Blandy's avatar
Jim Blandy committed
271 272
}

273 274

/* Return the start or end position of the region.
275
   BEGINNINGP means return the start.
276 277
   If there is no region active, signal an error. */

Jim Blandy's avatar
Jim Blandy committed
278
static Lisp_Object
279
region_limit (bool beginningp)
Jim Blandy's avatar
Jim Blandy committed
280
{
281
  Lisp_Object m;
282

283 284
  if (!NILP (Vtransient_mark_mode)
      && NILP (Vmark_even_if_inactive)
Tom Tromey's avatar
Tom Tromey committed
285
      && NILP (BVAR (current_buffer, mark_active)))
286
    xsignal0 (Qmark_inactive);
287

Tom Tromey's avatar
Tom Tromey committed
288
  m = Fmarker_position (BVAR (current_buffer, mark));
289
  if (NILP (m))
290
    error ("The mark is not set now, so there is no region");
291

292
  /* Clip to the current narrowing (bug#11770).  */
293
  return make_number ((PT < XFASTINT (m)) == beginningp
294 295
		      ? PT
		      : clip_to_bounds (BEGV, XFASTINT (m), ZV));
Jim Blandy's avatar
Jim Blandy committed
296 297 298
}

DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,
299
       doc: /* Return the integer value of point or mark, whichever is smaller.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
300
  (void)
Jim Blandy's avatar
Jim Blandy committed
301
{
302
  return region_limit (1);
Jim Blandy's avatar
Jim Blandy committed
303 304 305
}

DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0,
306
       doc: /* Return the integer value of point or mark, whichever is larger.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
307
  (void)
Jim Blandy's avatar
Jim Blandy committed
308
{
309
  return region_limit (0);
Jim Blandy's avatar
Jim Blandy committed
310 311 312
}

DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0,
313
       doc: /* Return this buffer's mark, as a marker object.
Pavel Janík's avatar
Pavel Janík committed
314
Watch out!  Moving this marker changes the mark position.
315
If you set the marker not to point anywhere, the buffer will have no mark.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
316
  (void)
Jim Blandy's avatar
Jim Blandy committed
317
{
Tom Tromey's avatar
Tom Tromey committed
318
  return BVAR (current_buffer, mark);
Jim Blandy's avatar
Jim Blandy committed
319
}
320 321


322 323 324 325
/* 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.  */

326 327
static ptrdiff_t
overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len)
328
{
329 330
  Lisp_Object overlay, start, end;
  struct Lisp_Overlay *tail;
331
  ptrdiff_t startpos, endpos;
332
  ptrdiff_t idx = 0;
333

334
  for (tail = current_buffer->overlays_before; tail; tail = tail->next)
335
    {
336
      XSETMISC (overlay, tail);
337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352

      end = OVERLAY_END (overlay);
      endpos = OVERLAY_POSITION (end);
      if (endpos < pos)
	  break;
      start = OVERLAY_START (overlay);
      startpos = OVERLAY_POSITION (start);
      if (startpos <= pos)
	{
	  if (idx < len)
	    vec[idx] = overlay;
	  /* Keep counting overlays even if we can't return them all.  */
	  idx++;
	}
    }

353
  for (tail = current_buffer->overlays_after; tail; tail = tail->next)
354
    {
355
      XSETMISC (overlay, tail);
356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373

      start = OVERLAY_START (overlay);
      startpos = OVERLAY_POSITION (start);
      if (pos < startpos)
	break;
      end = OVERLAY_END (overlay);
      endpos = OVERLAY_POSITION (end);
      if (pos <= endpos)
	{
	  if (idx < len)
	    vec[idx] = overlay;
	  idx++;
	}
    }

  return idx;
}

374 375 376 377 378 379 380 381 382
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)
383 384 385 386 387
{
  CHECK_NUMBER_COERCE_MARKER (position);

  if (NILP (object))
    XSETBUFFER (object, current_buffer);
388
  else if (WINDOWP (object))
389
    object = XWINDOW (object)->contents;
390 391 392 393 394 395 396

  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
397
    {
398
      EMACS_INT posn = XINT (position);
399
      ptrdiff_t noverlays;
400 401
      Lisp_Object *overlay_vec, tem;
      struct buffer *obuf = current_buffer;
402
      USE_SAFE_ALLOCA;
403 404 405 406

      set_buffer_temp (XBUFFER (object));

      /* First try with room for 40 overlays.  */
407 408 409
      Lisp_Object overlay_vecbuf[40];
      noverlays = ARRAYELTS (overlay_vecbuf);
      overlay_vec = overlay_vecbuf;
410 411 412 413
      noverlays = overlays_around (posn, overlay_vec, noverlays);

      /* If there are more than 40,
	 make enough space for all, and try again.  */
414
      if (ARRAYELTS (overlay_vecbuf) < noverlays)
415
	{
416
	  SAFE_ALLOCA_LISP (overlay_vec, noverlays);
417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438
	  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
		{
439
		  SAFE_FREE ();
440 441 442 443
		  return tem;
		}
	    }
	}
444
      SAFE_FREE ();
445

446
      { /* Now check the text properties.  */
447 448 449 450 451 452 453 454 455 456
	int stickiness = text_property_stickiness (prop, position, object);
	if (stickiness > 0)
	  return Fget_text_property (position, prop, object);
	else if (stickiness < 0
		 && XINT (position) > BUF_BEGV (XBUFFER (object)))
	  return Fget_text_property (make_number (XINT (position) - 1),
				     prop, object);
	else
	  return Qnil;
      }
457 458 459
    }
}

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

464 465 466
   BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
   results; they do not effect boundary behavior.

467
   If MERGE_AT_BOUNDARY is non-nil, then if POS is at the very first
468 469 470 471
   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
472
   non-nil case, if two fields are separated by a field with the special
473 474 475
   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.
476 477 478 479

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

480
static void
481 482
find_field (Lisp_Object pos, Lisp_Object merge_at_boundary,
	    Lisp_Object beg_limit,
483
	    ptrdiff_t *beg, Lisp_Object end_limit, ptrdiff_t *end)
484
{
485 486
  /* Fields right before and after the point.  */
  Lisp_Object before_field, after_field;
487 488 489 490
  /* 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;
491

492 493 494
  if (NILP (pos))
    XSETFASTINT (pos, PT);
  else
495
    CHECK_NUMBER_COERCE_MARKER (pos);
496

497
  after_field
498
    = get_char_property_and_overlay (pos, Qfield, Qnil, NULL);
499 500
  before_field
    = (XFASTINT (pos) > BEGV
Miles Bader's avatar
Miles Bader committed
501
       ? get_char_property_and_overlay (make_number (XINT (pos) - 1),
502
					Qfield, Qnil, NULL)
503 504 505
       /* Using nil here would be a more obvious choice, but it would
          fail when the buffer starts with a non-sticky field.  */
       : after_field);
506 507 508 509 510 511 512

  /* 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.  */
513
  if (NILP (merge_at_boundary))
514
    {
515
      Lisp_Object field = Fget_pos_property (pos, Qfield, Qnil);
516
      if (!EQ (field, after_field))
517
	at_field_end = 1;
518 519
      if (!EQ (field, before_field))
	at_field_start = 1;
520 521 522 523 524 525
      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;
526 527
    }

528 529 530 531 532 533
  /* Note about special `boundary' fields:

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

	xxxx.yyyy

534
     In this situation, if merge_at_boundary is non-nil, consider the
535 536 537 538
     `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
539
     (a field with a `field' char-property of 'boundary), then ignore
540 541 542 543 544 545
     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
546
     anywhere in-between (within the `boundary' field), merge all
547 548 549
     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.  */

550
  if (beg)
551 552 553 554 555 556 557 558
    {
      if (at_field_start)
	/* POS is at the edge of a field, and we should consider it as
	   the beginning of the following field.  */
	*beg = XFASTINT (pos);
      else
	/* Find the previous field boundary.  */
	{
559
	  Lisp_Object p = pos;
560 561
	  if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary))
	    /* Skip a `boundary' field.  */
562
	    p = Fprevious_single_char_property_change (p, Qfield, Qnil,
563
						       beg_limit);
564 565 566 567

	  p = Fprevious_single_char_property_change (p, Qfield, Qnil,
						     beg_limit);
	  *beg = NILP (p) ? BEGV : XFASTINT (p);
568 569
	}
    }
570 571

  if (end)
572 573 574 575 576 577 578 579 580 581
    {
      if (at_field_end)
	/* POS is at the edge of a field, and we should consider it as
	   the end of the previous field.  */
	*end = XFASTINT (pos);
      else
	/* Find the next field boundary.  */
	{
	  if (!NILP (merge_at_boundary) && EQ (after_field, Qboundary))
	    /* Skip a `boundary' field.  */
582 583
	    pos = Fnext_single_char_property_change (pos, Qfield, Qnil,
						     end_limit);
584

585 586
	  pos = Fnext_single_char_property_change (pos, Qfield, Qnil,
						   end_limit);
587 588 589
	  *end = NILP (pos) ? ZV : XFASTINT (pos);
	}
    }
590
}
591

592

593
DEFUN ("delete-field", Fdelete_field, Sdelete_field, 0, 1, 0,
594
       doc: /* Delete the field surrounding POS.
Pavel Janík's avatar
Pavel Janík committed
595
A field is a region of text with the same `field' property.
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
596
If POS is nil, the value of point is used for POS.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
597
  (Lisp_Object pos)
598
{
599
  ptrdiff_t beg, end;
600
  find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
601 602
  if (beg != end)
    del_range (beg, end);
603
  return Qnil;
604 605 606
}

DEFUN ("field-string", Ffield_string, Sfield_string, 0, 1, 0,
607
       doc: /* Return the contents of the field surrounding POS as a string.
Pavel Janík's avatar
Pavel Janík committed
608
A field is a region of text with the same `field' property.
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
609
If POS is nil, the value of point is used for POS.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
610
  (Lisp_Object pos)
611
{
612
  ptrdiff_t beg, end;
613
  find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
614 615 616 617
  return make_buffer_string (beg, end, 1);
}

DEFUN ("field-string-no-properties", Ffield_string_no_properties, Sfield_string_no_properties, 0, 1, 0,
618
       doc: /* Return the contents of the field around POS, without text properties.
Pavel Janík's avatar
Pavel Janík committed
619
A field is a region of text with the same `field' property.
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
620
If POS is nil, the value of point is used for POS.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
621
  (Lisp_Object pos)
622
{
623
  ptrdiff_t beg, end;
624
  find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
625 626 627
  return make_buffer_string (beg, end, 0);
}

628
DEFUN ("field-beginning", Ffield_beginning, Sfield_beginning, 0, 3, 0,
629
       doc: /* Return the beginning of the field surrounding POS.
Pavel Janík's avatar
Pavel Janík committed
630 631 632
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
633 634
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
635
is before LIMIT, then LIMIT will be returned instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
636
  (Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit)
637
{
638
  ptrdiff_t beg;
639
  find_field (pos, escape_from_edge, limit, &beg, Qnil, 0);
640 641 642
  return make_number (beg);
}

Paul Eggert's avatar
Paul Eggert committed
643
DEFUN ("field-end", Ffield_end, Sfield_end, 0, 3, 0,
644
       doc: /* Return the end of the field surrounding POS.
Pavel Janík's avatar
Pavel Janík committed
645 646 647
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,
648 649
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
650
is after LIMIT, then LIMIT will be returned instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
651
  (Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit)
652
{
653
  ptrdiff_t end;
654
  find_field (pos, escape_from_edge, Qnil, 0, limit, &end);
655 656 657
  return make_number (end);
}

Paul Eggert's avatar
Paul Eggert committed
658
DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0,
659
       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
660
A field is a region of text with the same `field' property.
661 662 663 664

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
665 666 667 668 669 670 671 672 673 674 675 676 677

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
678
unconstrained.  This is useful for commands that move by line, like
Pavel Janík's avatar
Pavel Janík committed
679 680 681 682 683 684
\\[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.

685
Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil.  */)
686 687
  (Lisp_Object new_pos, Lisp_Object old_pos, Lisp_Object escape_from_edge,
   Lisp_Object only_in_line, Lisp_Object inhibit_capture_property)
688 689
{
  /* If non-zero, then the original point, before re-positioning.  */
690
  ptrdiff_t orig_point = 0;
691
  bool fwd;
692
  Lisp_Object prev_old, prev_new;
693

694 695 696 697 698 699 700
  if (NILP (new_pos))
    /* Use the current point, and afterwards, set it.  */
    {
      orig_point = PT;
      XSETFASTINT (new_pos, PT);
    }

701 702 703
  CHECK_NUMBER_COERCE_MARKER (new_pos);
  CHECK_NUMBER_COERCE_MARKER (old_pos);

704
  fwd = (XINT (new_pos) > XINT (old_pos));
705

706 707
  prev_old = make_number (XINT (old_pos) - 1);
  prev_new = make_number (XINT (new_pos) - 1);
708

709 710
  if (NILP (Vinhibit_field_text_motion)
      && !EQ (new_pos, old_pos)
711 712
      && (!NILP (Fget_char_property (new_pos, Qfield, Qnil))
          || !NILP (Fget_char_property (old_pos, Qfield, Qnil))
713
          /* To recognize field boundaries, we must also look at the
714
             previous positions; we could use `Fget_pos_property'
715 716 717
             instead, but in itself that would fail inside non-sticky
             fields (like comint prompts).  */
          || (XFASTINT (new_pos) > BEGV
718
              && !NILP (Fget_char_property (prev_new, Qfield, Qnil)))
719
          || (XFASTINT (old_pos) > BEGV
720
              && !NILP (Fget_char_property (prev_old, Qfield, Qnil))))
721
      && (NILP (inhibit_capture_property)
722 723 724
          /* Field boundaries are again a problem; but now we must
             decide the case exactly, so we need to call
             `get_pos_property' as well.  */
725
          || (NILP (Fget_pos_property (old_pos, inhibit_capture_property, Qnil))
726
              && (XFASTINT (old_pos) <= BEGV
727 728 729 730
                  || NILP (Fget_char_property
			   (old_pos, inhibit_capture_property, Qnil))
                  || NILP (Fget_char_property
			   (prev_old, inhibit_capture_property, Qnil))))))
731 732
    /* It is possible that NEW_POS is not within the same field as
       OLD_POS; try to move NEW_POS so that it is.  */
733
    {
734
      ptrdiff_t shortage;
735 736 737
      Lisp_Object field_bound;

      if (fwd)
738
	field_bound = Ffield_end (old_pos, escape_from_edge, new_pos);
739
      else
740
	field_bound = Ffield_beginning (old_pos, escape_from_edge, new_pos);
741

742 743 744 745 746 747 748 749
      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.  */
	  ((XFASTINT (field_bound) < XFASTINT (new_pos)) ? fwd : !fwd)
	  /* 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
750
	     case the constraint is OK even if ONLY_IN_LINE is non-nil).  */
751 752 753 754
	  && (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.  */
755 756
	      || (find_newline (XFASTINT (new_pos), -1,
				XFASTINT (field_bound), -1,
757
				fwd ? -1 : 1, &shortage, NULL, 1),
758
		  shortage != 0)))
759 760 761 762 763 764 765 766 767 768
	/* Constrain NEW_POS to FIELD_BOUND.  */
	new_pos = field_bound;

      if (orig_point && XFASTINT (new_pos) != orig_point)
	/* The NEW_POS argument was originally nil, so automatically set PT. */
	SET_PT (XFASTINT (new_pos));
    }

  return new_pos;
}
769

770

Paul Eggert's avatar
Paul Eggert committed
771
DEFUN ("line-beginning-position",
772
       Fline_beginning_position, Sline_beginning_position, 0, 1, 0,
773
       doc: /* Return the character position of the first character on the current line.
Chong Yidong's avatar
Chong Yidong committed
774 775
With optional argument N, scan forward N - 1 lines first.
If the scan reaches the end of the buffer, return that position.
776

Chong Yidong's avatar
Chong Yidong committed
777 778 779
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.
780

781
This function constrains the returned position to the current field
Chong Yidong's avatar
Chong Yidong committed
782
unless that position would be on a different line than the original,
783 784
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
785
boundaries, bind `inhibit-field-text-motion' to t.
Pavel Janík's avatar
Pavel Janík committed
786

787
This function does not move point.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
788
  (Lisp_Object n)
789
{
790 791
  ptrdiff_t orig, orig_byte, end;
  ptrdiff_t count = SPECPDL_INDEX ();
792
  specbind (Qinhibit_point_motion_hooks, Qt);
793 794 795 796

  if (NILP (n))
    XSETFASTINT (n, 1);
  else
797
    CHECK_NUMBER (n);
798 799

  orig = PT;
800
  orig_byte = PT_BYTE;
801 802
  Fforward_line (make_number (XINT (n) - 1));
  end = PT;
803

804
  SET_PT_BOTH (orig, orig_byte);
Jim Blandy's avatar
Jim Blandy committed
805

806 807
  unbind_to (count, Qnil);

808
  /* Return END constrained to the current input field.  */
809 810
  return Fconstrain_to_field (make_number (end), make_number (orig),
			      XINT (n) != 1 ? Qt : Qnil,
811
			      Qt, Qnil);
812 813
}

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

Chong Yidong's avatar
Chong Yidong committed
819 820 821
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.
822

823 824 825 826
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
827 828
boundaries bind `inhibit-field-text-motion' to t.

829
This function does not move point.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
830
  (Lisp_Object n)
831
{
832 833 834
  ptrdiff_t clipped_n;
  ptrdiff_t end_pos;
  ptrdiff_t orig = PT;
835

836 837 838
  if (NILP (n))
    XSETFASTINT (n, 1);
  else
839
    CHECK_NUMBER (n);
840

841
  clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XINT (n), PTRDIFF_MAX);
842 843
  end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0),
				      NULL);
844 845

  /* Return END_POS constrained to the current input field.  */
846
  return Fconstrain_to_field (make_number (end_pos), make_number (orig),
847
			      Qnil, Qt, Qnil);
848
}
849

850 851 852 853
/* Save current buffer state for `save-excursion' special form.
   We (ab)use Lisp_Misc_Save_Value to allow explicit free and so
   offload some work from GC.  */

Jim Blandy's avatar
Jim Blandy committed
854
Lisp_Object
855
save_excursion_save (void)
Jim Blandy's avatar
Jim Blandy committed
856
{
857 858
  return make_save_obj_obj_obj_obj
    (Fpoint_marker (),
859 860 861 862 863
     /* Do not copy the mark if it points to nowhere.  */
     (XMARKER (BVAR (current_buffer, mark))->buffer
      ? Fcopy_marker (BVAR (current_buffer, mark), Qnil)
      : Qnil),
     /* Selected window if current buffer is shown in it, nil otherwise.  */