1 /* Lisp functions pertaining to editing. -*- coding: utf-8 -*-
3 Copyright (C) 1985-1987, 1989, 1993-2017 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 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/>. */
22 #include <sys/types.h>
32 #ifdef HAVE_SYS_UTSNAME_H
33 #include <sys/utsname.h>
38 /* systime.h includes <sys/time.h> which, on some systems, is required
39 for <sys/resource.h>; thus systime.h must be included before
43 #if defined HAVE_SYS_RESOURCE_H
44 #include <sys/resource.h>
56 #include "composite.h"
57 #include "intervals.h"
58 #include "character.h"
62 #include "blockinput.h"
64 #define TM_YEAR_BASE 1900
67 extern Lisp_Object
w32_get_internal_run_time (void);
70 static struct lisp_time
lisp_time_struct (Lisp_Object
, int *);
71 static Lisp_Object
format_time_string (char const *, ptrdiff_t, struct timespec
,
72 Lisp_Object
, struct tm
*);
73 static long int tm_gmtoff (struct tm
*);
74 static int tm_diff (struct tm
*, struct tm
*);
75 static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
76 static Lisp_Object
styled_format (ptrdiff_t, Lisp_Object
*, bool);
78 #ifndef HAVE_TM_GMTOFF
79 # define HAVE_TM_GMTOFF false
82 enum { tzeqlen
= sizeof "TZ=" - 1 };
84 /* Time zones equivalent to current local time, to wall clock time,
85 and to UTC, respectively. */
86 static timezone_t local_tz
;
87 static timezone_t wall_clock_tz
;
88 static timezone_t
const utc_tz
= 0;
90 /* The cached value of Vsystem_name. This is used only to compare it
91 to Vsystem_name, so it need not be visible to the GC. */
92 static Lisp_Object cached_system_name
;
95 init_and_cache_system_name (void)
98 cached_system_name
= Vsystem_name
;
102 emacs_localtime_rz (timezone_t tz
, time_t const *t
, struct tm
*tm
)
104 tm
= localtime_rz (tz
, t
, tm
);
105 if (!tm
&& errno
== ENOMEM
)
106 memory_full (SIZE_MAX
);
111 emacs_mktime_z (timezone_t tz
, struct tm
*tm
)
114 time_t t
= mktime_z (tz
, tm
);
115 if (t
== (time_t) -1 && errno
== ENOMEM
)
116 memory_full (SIZE_MAX
);
120 /* Allocate a timezone, signaling on failure. */
122 xtzalloc (char const *name
)
124 timezone_t tz
= tzalloc (name
);
126 memory_full (SIZE_MAX
);
130 /* Free a timezone, except do not free the time zone for local time.
131 Freeing utc_tz is also a no-op. */
133 xtzfree (timezone_t tz
)
139 /* Convert the Lisp time zone rule ZONE to a timezone_t object.
140 The returned value either is 0, or is LOCAL_TZ, or is newly allocated.
141 If SETTZ, set Emacs local time to the time zone rule; otherwise,
142 the caller should eventually pass the returned value to xtzfree. */
144 tzlookup (Lisp_Object zone
, bool settz
)
146 static char const tzbuf_format
[] = "<%+.*"pI
"d>%s%"pI
"d:%02d:%02d";
147 char const *trailing_tzbuf_format
= tzbuf_format
+ sizeof "<%+.*"pI
"d" - 1;
148 char tzbuf
[sizeof tzbuf_format
+ 2 * INT_STRLEN_BOUND (EMACS_INT
)];
149 char const *zone_string
;
154 else if (EQ (zone
, Qt
))
156 zone_string
= "UTC0";
161 bool plain_integer
= INTEGERP (zone
);
163 if (EQ (zone
, Qwall
))
165 else if (STRINGP (zone
))
166 zone_string
= SSDATA (ENCODE_SYSTEM (zone
));
167 else if (plain_integer
|| (CONSP (zone
) && INTEGERP (XCAR (zone
))
168 && CONSP (XCDR (zone
))))
173 abbr
= XCAR (XCDR (zone
));
177 EMACS_INT abszone
= eabs (XINT (zone
)), hour
= abszone
/ (60 * 60);
178 int hour_remainder
= abszone
% (60 * 60);
179 int min
= hour_remainder
/ 60, sec
= hour_remainder
% 60;
184 EMACS_INT numzone
= hour
;
185 if (hour_remainder
!= 0)
187 prec
+= 2, numzone
= 100 * numzone
+ min
;
189 prec
+= 2, numzone
= 100 * numzone
+ sec
;
191 sprintf (tzbuf
, tzbuf_format
, prec
, numzone
,
192 &"-"[XINT (zone
) < 0], hour
, min
, sec
);
197 AUTO_STRING (leading
, "<");
198 AUTO_STRING_WITH_LEN (trailing
, tzbuf
,
199 sprintf (tzbuf
, trailing_tzbuf_format
,
200 &"-"[XINT (zone
) < 0],
202 zone_string
= SSDATA (concat3 (leading
, ENCODE_SYSTEM (abbr
),
207 xsignal2 (Qerror
, build_string ("Invalid time zone specification"),
209 new_tz
= xtzalloc (zone_string
);
215 emacs_setenv_TZ (zone_string
);
217 timezone_t old_tz
= local_tz
;
227 init_editfns (bool dumping
)
229 #if !defined CANNOT_DUMP && defined HAVE_TZSET
230 /* A valid but unlikely setting for the TZ environment variable.
231 It is OK (though a bit slower) if the user chooses this value. */
232 static char dump_tz_string
[] = "TZ=UtC0";
235 const char *user_name
;
237 struct passwd
*pw
; /* password entry for the current user */
240 /* Set up system_name even when dumping. */
241 init_and_cache_system_name ();
244 /* When just dumping out, set the time zone to a known unlikely value
245 and skip the rest of this function. */
249 xputenv (dump_tz_string
);
256 char *tz
= getenv ("TZ");
258 #if !defined CANNOT_DUMP && defined HAVE_TZSET
259 /* If the execution TZ happens to be the same as the dump TZ,
260 change it to some other value and then change it back,
261 to force the underlying implementation to reload the TZ info.
262 This is needed on implementations that load TZ info from files,
263 since the TZ file contents may differ between dump and execution. */
264 if (tz
&& strcmp (tz
, &dump_tz_string
[tzeqlen
]) == 0)
272 /* Set the time zone rule now, so that the call to putenv is done
273 before multiple threads are active. */
274 wall_clock_tz
= xtzalloc (0);
275 tzlookup (tz
? build_string (tz
) : Qwall
, true);
277 pw
= getpwuid (getuid ());
279 /* We let the real user name default to "root" because that's quite
280 accurate on MS-DOS and because it lets Emacs find the init file.
281 (The DVX libraries override the Djgpp libraries here.) */
282 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
284 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
287 /* Get the effective user name, by consulting environment variables,
288 or the effective uid if those are unset. */
289 user_name
= getenv ("LOGNAME");
292 user_name
= getenv ("USERNAME"); /* it's USERNAME on NT */
293 #else /* WINDOWSNT */
294 user_name
= getenv ("USER");
295 #endif /* WINDOWSNT */
298 pw
= getpwuid (geteuid ());
299 user_name
= pw
? pw
->pw_name
: "unknown";
301 Vuser_login_name
= build_string (user_name
);
303 /* If the user name claimed in the environment vars differs from
304 the real uid, use the claimed name to find the full name. */
305 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
307 tem
= Vuser_login_name
;
310 uid_t euid
= geteuid ();
311 tem
= make_fixnum_or_float (euid
);
313 Vuser_full_name
= Fuser_full_name (tem
);
317 Vuser_full_name
= build_string (p
);
318 else if (NILP (Vuser_full_name
))
319 Vuser_full_name
= build_string ("unknown");
321 #ifdef HAVE_SYS_UTSNAME_H
325 Voperating_system_release
= build_string (uts
.release
);
328 Voperating_system_release
= Qnil
;
332 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
333 doc
: /* Convert arg CHAR to a string containing that character.
334 usage: (char-to-string CHAR) */)
335 (Lisp_Object character
)
338 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
340 CHECK_CHARACTER (character
);
341 c
= XFASTINT (character
);
343 len
= CHAR_STRING (c
, str
);
344 return make_string_from_bytes ((char *) str
, 1, len
);
347 DEFUN ("byte-to-string", Fbyte_to_string
, Sbyte_to_string
, 1, 1, 0,
348 doc
: /* Convert arg BYTE to a unibyte string containing that byte. */)
353 if (XINT (byte
) < 0 || XINT (byte
) > 255)
354 error ("Invalid byte");
356 return make_string_from_bytes ((char *) &b
, 1, 1);
359 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
360 doc
: /* Return the first character in STRING. */)
361 (register Lisp_Object string
)
363 register Lisp_Object val
;
364 CHECK_STRING (string
);
367 if (STRING_MULTIBYTE (string
))
368 XSETFASTINT (val
, STRING_CHAR (SDATA (string
)));
370 XSETFASTINT (val
, SREF (string
, 0));
373 XSETFASTINT (val
, 0);
377 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
378 doc
: /* Return value of point, as an integer.
379 Beginning of buffer is position (point-min). */)
383 XSETFASTINT (temp
, PT
);
387 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
388 doc
: /* Return value of point, as a marker object. */)
391 return build_marker (current_buffer
, PT
, PT_BYTE
);
394 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
395 doc
: /* Set point to POSITION, a number or marker.
396 Beginning of buffer is position (point-min), end is (point-max).
398 The return value is POSITION. */)
399 (register Lisp_Object position
)
401 if (MARKERP (position
))
402 set_point_from_marker (position
);
403 else if (INTEGERP (position
))
404 SET_PT (clip_to_bounds (BEGV
, XINT (position
), ZV
));
406 wrong_type_argument (Qinteger_or_marker_p
, position
);
411 /* Return the start or end position of the region.
412 BEGINNINGP means return the start.
413 If there is no region active, signal an error. */
416 region_limit (bool beginningp
)
420 if (!NILP (Vtransient_mark_mode
)
421 && NILP (Vmark_even_if_inactive
)
422 && NILP (BVAR (current_buffer
, mark_active
)))
423 xsignal0 (Qmark_inactive
);
425 m
= Fmarker_position (BVAR (current_buffer
, mark
));
427 error ("The mark is not set now, so there is no region");
429 /* Clip to the current narrowing (bug#11770). */
430 return make_number ((PT
< XFASTINT (m
)) == beginningp
432 : clip_to_bounds (BEGV
, XFASTINT (m
), ZV
));
435 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
436 doc
: /* Return the integer value of point or mark, whichever is smaller. */)
439 return region_limit (1);
442 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
443 doc
: /* Return the integer value of point or mark, whichever is larger. */)
446 return region_limit (0);
449 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
450 doc
: /* Return this buffer's mark, as a marker object.
451 Watch out! Moving this marker changes the mark position.
452 If you set the marker not to point anywhere, the buffer will have no mark. */)
455 return BVAR (current_buffer
, mark
);
459 /* Find all the overlays in the current buffer that touch position POS.
460 Return the number found, and store them in a vector in VEC
464 overlays_around (EMACS_INT pos
, Lisp_Object
*vec
, ptrdiff_t len
)
466 Lisp_Object overlay
, start
, end
;
467 struct Lisp_Overlay
*tail
;
468 ptrdiff_t startpos
, endpos
;
471 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
473 XSETMISC (overlay
, tail
);
475 end
= OVERLAY_END (overlay
);
476 endpos
= OVERLAY_POSITION (end
);
479 start
= OVERLAY_START (overlay
);
480 startpos
= OVERLAY_POSITION (start
);
485 /* Keep counting overlays even if we can't return them all. */
490 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
492 XSETMISC (overlay
, tail
);
494 start
= OVERLAY_START (overlay
);
495 startpos
= OVERLAY_POSITION (start
);
498 end
= OVERLAY_END (overlay
);
499 endpos
= OVERLAY_POSITION (end
);
511 DEFUN ("get-pos-property", Fget_pos_property
, Sget_pos_property
, 2, 3, 0,
512 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
513 Almost identical to `get-char-property' except for the following difference:
514 Whereas `get-char-property' returns the property of the char at (i.e. right
515 after) POSITION, this pays attention to properties's stickiness and overlays's
516 advancement settings, in order to find the property of POSITION itself,
517 i.e. the property that a char would inherit if it were inserted
519 (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
)
521 CHECK_NUMBER_COERCE_MARKER (position
);
524 XSETBUFFER (object
, current_buffer
);
525 else if (WINDOWP (object
))
526 object
= XWINDOW (object
)->contents
;
528 if (!BUFFERP (object
))
529 /* pos-property only makes sense in buffers right now, since strings
530 have no overlays and no notion of insertion for which stickiness
532 return Fget_text_property (position
, prop
, object
);
535 EMACS_INT posn
= XINT (position
);
537 Lisp_Object
*overlay_vec
, tem
;
538 struct buffer
*obuf
= current_buffer
;
541 set_buffer_temp (XBUFFER (object
));
543 /* First try with room for 40 overlays. */
544 Lisp_Object overlay_vecbuf
[40];
545 noverlays
= ARRAYELTS (overlay_vecbuf
);
546 overlay_vec
= overlay_vecbuf
;
547 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
549 /* If there are more than 40,
550 make enough space for all, and try again. */
551 if (ARRAYELTS (overlay_vecbuf
) < noverlays
)
553 SAFE_ALLOCA_LISP (overlay_vec
, noverlays
);
554 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
556 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
558 set_buffer_temp (obuf
);
560 /* Now check the overlays in order of decreasing priority. */
561 while (--noverlays
>= 0)
563 Lisp_Object ol
= overlay_vec
[noverlays
];
564 tem
= Foverlay_get (ol
, prop
);
567 /* Check the overlay is indeed active at point. */
568 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
569 if ((OVERLAY_POSITION (start
) == posn
570 && XMARKER (start
)->insertion_type
== 1)
571 || (OVERLAY_POSITION (finish
) == posn
572 && XMARKER (finish
)->insertion_type
== 0))
573 ; /* The overlay will not cover a char inserted at point. */
583 { /* Now check the text properties. */
584 int stickiness
= text_property_stickiness (prop
, position
, object
);
586 return Fget_text_property (position
, prop
, object
);
587 else if (stickiness
< 0
588 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
589 return Fget_text_property (make_number (XINT (position
) - 1),
597 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
598 the value of point is used instead. If BEG or END is null,
599 means don't store the beginning or end of the field.
601 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
602 results; they do not effect boundary behavior.
604 If MERGE_AT_BOUNDARY is non-nil, then if POS is at the very first
605 position of a field, then the beginning of the previous field is
606 returned instead of the beginning of POS's field (since the end of a
607 field is actually also the beginning of the next input field, this
608 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
609 non-nil case, if two fields are separated by a field with the special
610 value `boundary', and POS lies within it, then the two separated
611 fields are considered to be adjacent, and POS between them, when
612 finding the beginning and ending of the "merged" field.
614 Either BEG or END may be 0, in which case the corresponding value
618 find_field (Lisp_Object pos
, Lisp_Object merge_at_boundary
,
619 Lisp_Object beg_limit
,
620 ptrdiff_t *beg
, Lisp_Object end_limit
, ptrdiff_t *end
)
622 /* Fields right before and after the point. */
623 Lisp_Object before_field
, after_field
;
624 /* True if POS counts as the start of a field. */
625 bool at_field_start
= 0;
626 /* True if POS counts as the end of a field. */
627 bool at_field_end
= 0;
630 XSETFASTINT (pos
, PT
);
632 CHECK_NUMBER_COERCE_MARKER (pos
);
635 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
637 = (XFASTINT (pos
) > BEGV
638 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
640 /* Using nil here would be a more obvious choice, but it would
641 fail when the buffer starts with a non-sticky field. */
644 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
645 and POS is at beginning of a field, which can also be interpreted
646 as the end of the previous field. Note that the case where if
647 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
648 more natural one; then we avoid treating the beginning of a field
650 if (NILP (merge_at_boundary
))
652 Lisp_Object field
= Fget_pos_property (pos
, Qfield
, Qnil
);
653 if (!EQ (field
, after_field
))
655 if (!EQ (field
, before_field
))
657 if (NILP (field
) && at_field_start
&& at_field_end
)
658 /* If an inserted char would have a nil field while the surrounding
659 text is non-nil, we're probably not looking at a
660 zero-length field, but instead at a non-nil field that's
661 not intended for editing (such as comint's prompts). */
662 at_field_end
= at_field_start
= 0;
665 /* Note about special `boundary' fields:
667 Consider the case where the point (`.') is between the fields `x' and `y':
671 In this situation, if merge_at_boundary is non-nil, consider the
672 `x' and `y' fields as forming one big merged field, and so the end
673 of the field is the end of `y'.
675 However, if `x' and `y' are separated by a special `boundary' field
676 (a field with a `field' char-property of 'boundary), then ignore
677 this special field when merging adjacent fields. Here's the same
678 situation, but with a `boundary' field between the `x' and `y' fields:
682 Here, if point is at the end of `x', the beginning of `y', or
683 anywhere in-between (within the `boundary' field), merge all
684 three fields and consider the beginning as being the beginning of
685 the `x' field, and the end as being the end of the `y' field. */
690 /* POS is at the edge of a field, and we should consider it as
691 the beginning of the following field. */
692 *beg
= XFASTINT (pos
);
694 /* Find the previous field boundary. */
697 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
698 /* Skip a `boundary' field. */
699 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
702 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
704 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
711 /* POS is at the edge of a field, and we should consider it as
712 the end of the previous field. */
713 *end
= XFASTINT (pos
);
715 /* Find the next field boundary. */
717 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
718 /* Skip a `boundary' field. */
719 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
722 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
724 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
730 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
731 doc
: /* Delete the field surrounding POS.
732 A field is a region of text with the same `field' property.
733 If POS is nil, the value of point is used for POS. */)
737 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
739 del_range (beg
, end
);
743 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
744 doc
: /* Return the contents of the field surrounding POS as a string.
745 A field is a region of text with the same `field' property.
746 If POS is nil, the value of point is used for POS. */)
750 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
751 return make_buffer_string (beg
, end
, 1);
754 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
755 doc
: /* Return the contents of the field around POS, without text properties.
756 A field is a region of text with the same `field' property.
757 If POS is nil, the value of point is used for POS. */)
761 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
762 return make_buffer_string (beg
, end
, 0);
765 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
766 doc
: /* Return the beginning of the field surrounding POS.
767 A field is a region of text with the same `field' property.
768 If POS is nil, the value of point is used for POS.
769 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
770 field, then the beginning of the *previous* field is returned.
771 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
772 is before LIMIT, then LIMIT will be returned instead. */)
773 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
776 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
777 return make_number (beg
);
780 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
781 doc
: /* Return the end of the field surrounding POS.
782 A field is a region of text with the same `field' property.
783 If POS is nil, the value of point is used for POS.
784 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
785 then the end of the *following* field is returned.
786 If LIMIT is non-nil, it is a buffer position; if the end of the field
787 is after LIMIT, then LIMIT will be returned instead. */)
788 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
791 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
792 return make_number (end
);
795 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
796 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
797 A field is a region of text with the same `field' property.
799 If NEW-POS is nil, then use the current point instead, and move point
800 to the resulting constrained position, in addition to returning that
803 If OLD-POS is at the boundary of two fields, then the allowable
804 positions for NEW-POS depends on the value of the optional argument
805 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
806 constrained to the field that has the same `field' char-property
807 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
808 is non-nil, NEW-POS is constrained to the union of the two adjacent
809 fields. Additionally, if two fields are separated by another field with
810 the special value `boundary', then any point within this special field is
811 also considered to be `on the boundary'.
813 If the optional argument ONLY-IN-LINE is non-nil and constraining
814 NEW-POS would move it to a different line, NEW-POS is returned
815 unconstrained. This is useful for commands that move by line, like
816 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
817 only in the case where they can still move to the right line.
819 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
820 a non-nil property of that name, then any field boundaries are ignored.
822 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
823 (Lisp_Object new_pos
, Lisp_Object old_pos
, Lisp_Object escape_from_edge
,
824 Lisp_Object only_in_line
, Lisp_Object inhibit_capture_property
)
826 /* If non-zero, then the original point, before re-positioning. */
827 ptrdiff_t orig_point
= 0;
829 Lisp_Object prev_old
, prev_new
;
832 /* Use the current point, and afterwards, set it. */
835 XSETFASTINT (new_pos
, PT
);
838 CHECK_NUMBER_COERCE_MARKER (new_pos
);
839 CHECK_NUMBER_COERCE_MARKER (old_pos
);
841 fwd
= (XINT (new_pos
) > XINT (old_pos
));
843 prev_old
= make_number (XINT (old_pos
) - 1);
844 prev_new
= make_number (XINT (new_pos
) - 1);
846 if (NILP (Vinhibit_field_text_motion
)
847 && !EQ (new_pos
, old_pos
)
848 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
849 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
850 /* To recognize field boundaries, we must also look at the
851 previous positions; we could use `Fget_pos_property'
852 instead, but in itself that would fail inside non-sticky
853 fields (like comint prompts). */
854 || (XFASTINT (new_pos
) > BEGV
855 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
856 || (XFASTINT (old_pos
) > BEGV
857 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
858 && (NILP (inhibit_capture_property
)
859 /* Field boundaries are again a problem; but now we must
860 decide the case exactly, so we need to call
861 `get_pos_property' as well. */
862 || (NILP (Fget_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
863 && (XFASTINT (old_pos
) <= BEGV
864 || NILP (Fget_char_property
865 (old_pos
, inhibit_capture_property
, Qnil
))
866 || NILP (Fget_char_property
867 (prev_old
, inhibit_capture_property
, Qnil
))))))
868 /* It is possible that NEW_POS is not within the same field as
869 OLD_POS; try to move NEW_POS so that it is. */
872 Lisp_Object field_bound
;
875 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
877 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
879 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
880 other side of NEW_POS, which would mean that NEW_POS is
881 already acceptable, and it's not necessary to constrain it
883 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
884 /* NEW_POS should be constrained, but only if either
885 ONLY_IN_LINE is nil (in which case any constraint is OK),
886 or NEW_POS and FIELD_BOUND are on the same line (in which
887 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
888 && (NILP (only_in_line
)
889 /* This is the ONLY_IN_LINE case, check that NEW_POS and
890 FIELD_BOUND are on the same line by seeing whether
891 there's an intervening newline or not. */
892 || (find_newline (XFASTINT (new_pos
), -1,
893 XFASTINT (field_bound
), -1,
894 fwd
? -1 : 1, &shortage
, NULL
, 1),
896 /* Constrain NEW_POS to FIELD_BOUND. */
897 new_pos
= field_bound
;
899 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
900 /* The NEW_POS argument was originally nil, so automatically set PT. */
901 SET_PT (XFASTINT (new_pos
));
908 DEFUN ("line-beginning-position",
909 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
910 doc
: /* Return the character position of the first character on the current line.
911 With optional argument N, scan forward N - 1 lines first.
912 If the scan reaches the end of the buffer, return that position.
914 This function ignores text display directionality; it returns the
915 position of the first character in logical order, i.e. the smallest
916 character position on the line.
918 This function constrains the returned position to the current field
919 unless that position would be on a different line than the original,
920 unconstrained result. If N is nil or 1, and a front-sticky field
921 starts at point, the scan stops as soon as it starts. To ignore field
922 boundaries, bind `inhibit-field-text-motion' to t.
924 This function does not move point. */)
927 ptrdiff_t charpos
, bytepos
;
934 scan_newline_from_point (XINT (n
) - 1, &charpos
, &bytepos
);
936 /* Return END constrained to the current input field. */
937 return Fconstrain_to_field (make_number (charpos
), make_number (PT
),
938 XINT (n
) != 1 ? Qt
: Qnil
,
942 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
943 doc
: /* Return the character position of the last character on the current line.
944 With argument N not nil or 1, move forward N - 1 lines first.
945 If scan reaches end of buffer, return that position.
947 This function ignores text display directionality; it returns the
948 position of the last character in logical order, i.e. the largest
949 character position on the line.
951 This function constrains the returned position to the current field
952 unless that would be on a different line than the original,
953 unconstrained result. If N is nil or 1, and a rear-sticky field ends
954 at point, the scan stops as soon as it starts. To ignore field
955 boundaries bind `inhibit-field-text-motion' to t.
957 This function does not move point. */)
969 clipped_n
= clip_to_bounds (PTRDIFF_MIN
+ 1, XINT (n
), PTRDIFF_MAX
);
970 end_pos
= find_before_next_newline (orig
, 0, clipped_n
- (clipped_n
<= 0),
973 /* Return END_POS constrained to the current input field. */
974 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
978 /* Save current buffer state for `save-excursion' special form.
979 We (ab)use Lisp_Misc_Save_Value to allow explicit free and so
980 offload some work from GC. */
983 save_excursion_save (void)
985 return make_save_obj_obj_obj_obj
988 /* Selected window if current buffer is shown in it, nil otherwise. */
989 (EQ (XWINDOW (selected_window
)->contents
, Fcurrent_buffer ())
990 ? selected_window
: Qnil
),
994 /* Restore saved buffer before leaving `save-excursion' special form. */
997 save_excursion_restore (Lisp_Object info
)
999 Lisp_Object tem
, tem1
;
1001 tem
= Fmarker_buffer (XSAVE_OBJECT (info
, 0));
1002 /* If we're unwinding to top level, saved buffer may be deleted. This
1003 means that all of its markers are unchained and so tem is nil. */
1010 tem
= XSAVE_OBJECT (info
, 0);
1012 unchain_marker (XMARKER (tem
));
1014 /* If buffer was visible in a window, and a different window was
1015 selected, and the old selected window is still showing this
1016 buffer, restore point in that window. */
1017 tem
= XSAVE_OBJECT (info
, 2);
1019 && !EQ (tem
, selected_window
)
1020 && (tem1
= XWINDOW (tem
)->contents
,
1021 (/* Window is live... */
1023 /* ...and it shows the current buffer. */
1024 && XBUFFER (tem1
) == current_buffer
)))
1025 Fset_window_point (tem
, make_number (PT
));
1032 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
1033 doc
: /* Save point, and current buffer; execute BODY; restore those things.
1034 Executes BODY just like `progn'.
1035 The values of point and the current buffer are restored
1036 even in case of abnormal exit (throw or error).
1038 If you only want to save the current buffer but not point,
1039 then just use `save-current-buffer', or even `with-current-buffer'.
1041 Before Emacs 25.1, `save-excursion' used to save the mark state.
1042 To save the marker state as well as the point and buffer, use
1043 `save-mark-and-excursion'.
1045 usage: (save-excursion &rest BODY) */)
1048 register Lisp_Object val
;
1049 ptrdiff_t count
= SPECPDL_INDEX ();
1051 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1053 val
= Fprogn (args
);
1054 return unbind_to (count
, val
);
1057 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
1058 doc
: /* Record which buffer is current; execute BODY; make that buffer current.
1059 BODY is executed just like `progn'.
1060 usage: (save-current-buffer &rest BODY) */)
1063 ptrdiff_t count
= SPECPDL_INDEX ();
1065 record_unwind_current_buffer ();
1066 return unbind_to (count
, Fprogn (args
));
1069 DEFUN ("buffer-size", Fbuffer_size
, Sbuffer_size
, 0, 1, 0,
1070 doc
: /* Return the number of characters in the current buffer.
1071 If BUFFER is not nil, return the number of characters in that buffer
1074 This does not take narrowing into account; to count the number of
1075 characters in the accessible portion of the current buffer, use
1076 `(- (point-max) (point-min))', and to count the number of characters
1077 in some other BUFFER, use
1078 `(with-current-buffer BUFFER (- (point-max) (point-min)))'. */)
1079 (Lisp_Object buffer
)
1082 return make_number (Z
- BEG
);
1085 CHECK_BUFFER (buffer
);
1086 return make_number (BUF_Z (XBUFFER (buffer
))
1087 - BUF_BEG (XBUFFER (buffer
)));
1091 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1092 doc
: /* Return the minimum permissible value of point in the current buffer.
1093 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1097 XSETFASTINT (temp
, BEGV
);
1101 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1102 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1103 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1106 return build_marker (current_buffer
, BEGV
, BEGV_BYTE
);
1109 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1110 doc
: /* Return the maximum permissible value of point in the current buffer.
1111 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1112 is in effect, in which case it is less. */)
1116 XSETFASTINT (temp
, ZV
);
1120 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1121 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1122 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1123 is in effect, in which case it is less. */)
1126 return build_marker (current_buffer
, ZV
, ZV_BYTE
);
1129 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1130 doc
: /* Return the position of the gap, in the current buffer.
1131 See also `gap-size'. */)
1135 XSETFASTINT (temp
, GPT
);
1139 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1140 doc
: /* Return the size of the current buffer's gap.
1141 See also `gap-position'. */)
1145 XSETFASTINT (temp
, GAP_SIZE
);
1149 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1150 doc
: /* Return the byte position for character position POSITION.
1151 If POSITION is out of range, the value is nil. */)
1152 (Lisp_Object position
)
1154 CHECK_NUMBER_COERCE_MARKER (position
);
1155 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1157 return make_number (CHAR_TO_BYTE (XINT (position
)));
1160 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1161 doc
: /* Return the character position for byte position BYTEPOS.
1162 If BYTEPOS is out of range, the value is nil. */)
1163 (Lisp_Object bytepos
)
1167 CHECK_NUMBER (bytepos
);
1168 pos_byte
= XINT (bytepos
);
1169 if (pos_byte
< BEG_BYTE
|| pos_byte
> Z_BYTE
)
1172 /* There are multibyte characters in the buffer.
1173 The argument of BYTE_TO_CHAR must be a byte position at
1174 a character boundary, so search for the start of the current
1176 while (!CHAR_HEAD_P (FETCH_BYTE (pos_byte
)))
1178 return make_number (BYTE_TO_CHAR (pos_byte
));
1181 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1182 doc
: /* Return the character following point, as a number.
1183 At the end of the buffer or accessible region, return 0. */)
1188 XSETFASTINT (temp
, 0);
1190 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1194 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1195 doc
: /* Return the character preceding point, as a number.
1196 At the beginning of the buffer or accessible region, return 0. */)
1201 XSETFASTINT (temp
, 0);
1202 else if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
1204 ptrdiff_t pos
= PT_BYTE
;
1206 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1209 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1213 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1214 doc
: /* Return t if point is at the beginning of the buffer.
1215 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1223 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1224 doc
: /* Return t if point is at the end of the buffer.
1225 If the buffer is narrowed, this means the end of the narrowed part. */)
1233 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1234 doc
: /* Return t if point is at the beginning of a line. */)
1237 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1242 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1243 doc
: /* Return t if point is at the end of a line.
1244 `End of a line' includes point being at the end of the buffer. */)
1247 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1252 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1253 doc
: /* Return character in current buffer at position POS.
1254 POS is an integer or a marker and defaults to point.
1255 If POS is out of range, the value is nil. */)
1258 register ptrdiff_t pos_byte
;
1263 XSETFASTINT (pos
, PT
);
1268 pos_byte
= marker_byte_position (pos
);
1269 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1274 CHECK_NUMBER_COERCE_MARKER (pos
);
1275 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1278 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1281 return make_number (FETCH_CHAR (pos_byte
));
1284 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1285 doc
: /* Return character in current buffer preceding position POS.
1286 POS is an integer or a marker and defaults to point.
1287 If POS is out of range, the value is nil. */)
1290 register Lisp_Object val
;
1291 register ptrdiff_t pos_byte
;
1296 XSETFASTINT (pos
, PT
);
1301 pos_byte
= marker_byte_position (pos
);
1303 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1308 CHECK_NUMBER_COERCE_MARKER (pos
);
1310 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1313 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1316 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
1319 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1324 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1329 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1330 doc
: /* Return the name under which the user logged in, as a string.
1331 This is based on the effective uid, not the real uid.
1332 Also, if the environment variables LOGNAME or USER are set,
1333 that determines the value of this function.
1335 If optional argument UID is an integer or a float, return the login name
1336 of the user with that uid, or nil if there is no such user. */)
1342 /* Set up the user name info if we didn't do it before.
1343 (That can happen if Emacs is dumpable
1344 but you decide to run `temacs -l loadup' and not dump. */
1345 if (NILP (Vuser_login_name
))
1346 init_editfns (false);
1349 return Vuser_login_name
;
1351 CONS_TO_INTEGER (uid
, uid_t
, id
);
1355 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1358 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1360 doc
: /* Return the name of the user's real uid, as a string.
1361 This ignores the environment variables LOGNAME and USER, so it differs from
1362 `user-login-name' when running under `su'. */)
1365 /* Set up the user name info if we didn't do it before.
1366 (That can happen if Emacs is dumpable
1367 but you decide to run `temacs -l loadup' and not dump. */
1368 if (NILP (Vuser_login_name
))
1369 init_editfns (false);
1370 return Vuser_real_login_name
;
1373 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1374 doc
: /* Return the effective uid of Emacs.
1375 Value is an integer or a float, depending on the value. */)
1378 uid_t euid
= geteuid ();
1379 return make_fixnum_or_float (euid
);
1382 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1383 doc
: /* Return the real uid of Emacs.
1384 Value is an integer or a float, depending on the value. */)
1387 uid_t uid
= getuid ();
1388 return make_fixnum_or_float (uid
);
1391 DEFUN ("group-gid", Fgroup_gid
, Sgroup_gid
, 0, 0, 0,
1392 doc
: /* Return the effective gid of Emacs.
1393 Value is an integer or a float, depending on the value. */)
1396 gid_t egid
= getegid ();
1397 return make_fixnum_or_float (egid
);
1400 DEFUN ("group-real-gid", Fgroup_real_gid
, Sgroup_real_gid
, 0, 0, 0,
1401 doc
: /* Return the real gid of Emacs.
1402 Value is an integer or a float, depending on the value. */)
1405 gid_t gid
= getgid ();
1406 return make_fixnum_or_float (gid
);
1409 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1410 doc
: /* Return the full name of the user logged in, as a string.
1411 If the full name corresponding to Emacs's userid is not known,
1414 If optional argument UID is an integer or float, return the full name
1415 of the user with that uid, or nil if there is no such user.
1416 If UID is a string, return the full name of the user with that login
1417 name, or nil if there is no such user. */)
1421 register char *p
, *q
;
1425 return Vuser_full_name
;
1426 else if (NUMBERP (uid
))
1429 CONS_TO_INTEGER (uid
, uid_t
, u
);
1434 else if (STRINGP (uid
))
1437 pw
= getpwnam (SSDATA (uid
));
1441 error ("Invalid UID specification");
1447 /* Chop off everything after the first comma. */
1448 q
= strchr (p
, ',');
1449 full
= make_string (p
, q
? q
- p
: strlen (p
));
1451 #ifdef AMPERSAND_FULL_NAME
1453 q
= strchr (p
, '&');
1454 /* Substitute the login name for the &, upcasing the first character. */
1457 Lisp_Object login
= Fuser_login_name (make_number (pw
->pw_uid
));
1459 char *r
= SAFE_ALLOCA (strlen (p
) + SBYTES (login
) + 1);
1460 memcpy (r
, p
, q
- p
);
1461 char *s
= lispstpcpy (&r
[q
- p
], login
);
1462 r
[q
- p
] = upcase ((unsigned char) r
[q
- p
]);
1464 full
= build_string (r
);
1467 #endif /* AMPERSAND_FULL_NAME */
1472 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1473 doc
: /* Return the host name of the machine you are running on, as a string. */)
1476 if (EQ (Vsystem_name
, cached_system_name
))
1477 init_and_cache_system_name ();
1478 return Vsystem_name
;
1481 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1482 doc
: /* Return the process ID of Emacs, as a number. */)
1485 pid_t pid
= getpid ();
1486 return make_fixnum_or_float (pid
);
1492 # define TIME_T_MIN TYPE_MINIMUM (time_t)
1495 # define TIME_T_MAX TYPE_MAXIMUM (time_t)
1498 /* Report that a time value is out of range for Emacs. */
1500 time_overflow (void)
1502 error ("Specified time is not representable");
1505 static _Noreturn
void
1508 error ("Invalid time specification");
1511 /* Check a return value compatible with that of decode_time_components. */
1513 check_time_validity (int validity
)
1524 /* Return the upper part of the time T (everything but the bottom 16 bits). */
1528 time_t hi
= t
>> LO_TIME_BITS
;
1529 if (FIXNUM_OVERFLOW_P (hi
))
1534 /* Return the bottom bits of the time T. */
1538 return t
& ((1 << LO_TIME_BITS
) - 1);
1541 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1542 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1543 The time is returned as a list of integers (HIGH LOW USEC PSEC).
1544 HIGH has the most significant bits of the seconds, while LOW has the
1545 least significant 16 bits. USEC and PSEC are the microsecond and
1546 picosecond counts. */)
1549 return make_lisp_time (current_timespec ());
1552 static struct lisp_time
1553 time_add (struct lisp_time ta
, struct lisp_time tb
)
1555 EMACS_INT hi
= ta
.hi
+ tb
.hi
;
1556 int lo
= ta
.lo
+ tb
.lo
;
1557 int us
= ta
.us
+ tb
.us
;
1558 int ps
= ta
.ps
+ tb
.ps
;
1559 us
+= (1000000 <= ps
);
1560 ps
-= (1000000 <= ps
) * 1000000;
1561 lo
+= (1000000 <= us
);
1562 us
-= (1000000 <= us
) * 1000000;
1563 hi
+= (1 << LO_TIME_BITS
<= lo
);
1564 lo
-= (1 << LO_TIME_BITS
<= lo
) << LO_TIME_BITS
;
1565 return (struct lisp_time
) { hi
, lo
, us
, ps
};
1568 static struct lisp_time
1569 time_subtract (struct lisp_time ta
, struct lisp_time tb
)
1571 EMACS_INT hi
= ta
.hi
- tb
.hi
;
1572 int lo
= ta
.lo
- tb
.lo
;
1573 int us
= ta
.us
- tb
.us
;
1574 int ps
= ta
.ps
- tb
.ps
;
1576 ps
+= (ps
< 0) * 1000000;
1578 us
+= (us
< 0) * 1000000;
1580 lo
+= (lo
< 0) << LO_TIME_BITS
;
1581 return (struct lisp_time
) { hi
, lo
, us
, ps
};
1585 time_arith (Lisp_Object a
, Lisp_Object b
,
1586 struct lisp_time (*op
) (struct lisp_time
, struct lisp_time
))
1589 struct lisp_time ta
= lisp_time_struct (a
, &alen
);
1590 struct lisp_time tb
= lisp_time_struct (b
, &blen
);
1591 struct lisp_time t
= op (ta
, tb
);
1592 if (FIXNUM_OVERFLOW_P (t
.hi
))
1594 Lisp_Object val
= Qnil
;
1596 switch (max (alen
, blen
))
1599 val
= Fcons (make_number (t
.ps
), val
);
1602 val
= Fcons (make_number (t
.us
), val
);
1605 val
= Fcons (make_number (t
.lo
), val
);
1606 val
= Fcons (make_number (t
.hi
), val
);
1613 DEFUN ("time-add", Ftime_add
, Stime_add
, 2, 2, 0,
1614 doc
: /* Return the sum of two time values A and B, as a time value.
1615 A nil value for either argument stands for the current time.
1616 See `current-time-string' for the various forms of a time value. */)
1617 (Lisp_Object a
, Lisp_Object b
)
1619 return time_arith (a
, b
, time_add
);
1622 DEFUN ("time-subtract", Ftime_subtract
, Stime_subtract
, 2, 2, 0,
1623 doc
: /* Return the difference between two time values A and B, as a time value.
1624 Use `float-time' to convert the difference into elapsed seconds.
1625 A nil value for either argument stands for the current time.
1626 See `current-time-string' for the various forms of a time value. */)
1627 (Lisp_Object a
, Lisp_Object b
)
1629 return time_arith (a
, b
, time_subtract
);
1632 DEFUN ("time-less-p", Ftime_less_p
, Stime_less_p
, 2, 2, 0,
1633 doc
: /* Return non-nil if time value T1 is earlier than time value T2.
1634 A nil value for either argument stands for the current time.
1635 See `current-time-string' for the various forms of a time value. */)
1636 (Lisp_Object t1
, Lisp_Object t2
)
1639 struct lisp_time a
= lisp_time_struct (t1
, &t1len
);
1640 struct lisp_time b
= lisp_time_struct (t2
, &t2len
);
1641 return ((a
.hi
!= b
.hi
? a
.hi
< b
.hi
1642 : a
.lo
!= b
.lo
? a
.lo
< b
.lo
1643 : a
.us
!= b
.us
? a
.us
< b
.us
1649 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1651 doc
: /* Return the current run time used by Emacs.
1652 The time is returned as a list (HIGH LOW USEC PSEC), using the same
1653 style as (current-time).
1655 On systems that can't determine the run time, `get-internal-run-time'
1656 does the same thing as `current-time'. */)
1659 #ifdef HAVE_GETRUSAGE
1660 struct rusage usage
;
1664 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1665 /* This shouldn't happen. What action is appropriate? */
1668 /* Sum up user time and system time. */
1669 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1670 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1671 if (usecs
>= 1000000)
1676 return make_lisp_time (make_timespec (secs
, usecs
* 1000));
1677 #else /* ! HAVE_GETRUSAGE */
1679 return w32_get_internal_run_time ();
1680 #else /* ! WINDOWSNT */
1681 return Fcurrent_time ();
1682 #endif /* WINDOWSNT */
1683 #endif /* HAVE_GETRUSAGE */
1687 /* Make a Lisp list that represents the Emacs time T. T may be an
1688 invalid time, with a slightly negative tv_nsec value such as
1689 UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a
1690 correspondingly negative picosecond count. */
1692 make_lisp_time (struct timespec t
)
1694 time_t s
= t
.tv_sec
;
1696 return list4i (hi_time (s
), lo_time (s
), ns
/ 1000, ns
% 1000 * 1000);
1699 /* Decode a Lisp list SPECIFIED_TIME that represents a time.
1700 Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values.
1701 Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME
1702 if successful, 0 if unsuccessful. */
1704 disassemble_lisp_time (Lisp_Object specified_time
, Lisp_Object
*phigh
,
1705 Lisp_Object
*plow
, Lisp_Object
*pusec
,
1708 Lisp_Object high
= make_number (0);
1709 Lisp_Object low
= specified_time
;
1710 Lisp_Object usec
= make_number (0);
1711 Lisp_Object psec
= make_number (0);
1714 if (CONSP (specified_time
))
1716 high
= XCAR (specified_time
);
1717 low
= XCDR (specified_time
);
1720 Lisp_Object low_tail
= XCDR (low
);
1722 if (CONSP (low_tail
))
1724 usec
= XCAR (low_tail
);
1725 low_tail
= XCDR (low_tail
);
1726 if (CONSP (low_tail
))
1727 psec
= XCAR (low_tail
);
1731 else if (!NILP (low_tail
))
1742 /* When combining components, require LOW to be an integer,
1743 as otherwise it would be a pain to add up times. */
1744 if (! INTEGERP (low
))
1747 else if (INTEGERP (specified_time
))
1757 /* Convert T into an Emacs time *RESULT, truncating toward minus infinity.
1758 Return true if T is in range, false otherwise. */
1760 decode_float_time (double t
, struct lisp_time
*result
)
1762 double lo_multiplier
= 1 << LO_TIME_BITS
;
1763 double emacs_time_min
= MOST_NEGATIVE_FIXNUM
* lo_multiplier
;
1764 if (! (emacs_time_min
<= t
&& t
< -emacs_time_min
))
1767 double small_t
= t
/ lo_multiplier
;
1768 EMACS_INT hi
= small_t
;
1769 double t_sans_hi
= t
- hi
* lo_multiplier
;
1771 long double fracps
= (t_sans_hi
- lo
) * 1e12L
;
1772 #ifdef INT_FAST64_MAX
1773 int_fast64_t ifracps
= fracps
;
1774 int us
= ifracps
/ 1000000;
1775 int ps
= ifracps
% 1000000;
1777 int us
= fracps
/ 1e6L
;
1778 int ps
= fracps
- us
* 1e6L
;
1781 ps
+= (ps
< 0) * 1000000;
1783 us
+= (us
< 0) * 1000000;
1785 lo
+= (lo
< 0) << LO_TIME_BITS
;
1793 /* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp
1794 list, generate the corresponding time value.
1795 If LOW is floating point, the other components should be zero.
1797 If RESULT is not null, store into *RESULT the converted time.
1798 If *DRESULT is not null, store into *DRESULT the number of
1799 seconds since the start of the POSIX Epoch.
1801 Return 1 if successful, 0 if the components are of the
1802 wrong type, and -1 if the time is out of range. */
1804 decode_time_components (Lisp_Object high
, Lisp_Object low
, Lisp_Object usec
,
1806 struct lisp_time
*result
, double *dresult
)
1808 EMACS_INT hi
, lo
, us
, ps
;
1809 if (! (INTEGERP (high
)
1810 && INTEGERP (usec
) && INTEGERP (psec
)))
1812 if (! INTEGERP (low
))
1816 double t
= XFLOAT_DATA (low
);
1817 if (result
&& ! decode_float_time (t
, result
))
1823 else if (NILP (low
))
1825 struct timespec now
= current_timespec ();
1828 result
->hi
= hi_time (now
.tv_sec
);
1829 result
->lo
= lo_time (now
.tv_sec
);
1830 result
->us
= now
.tv_nsec
/ 1000;
1831 result
->ps
= now
.tv_nsec
% 1000 * 1000;
1834 *dresult
= now
.tv_sec
+ now
.tv_nsec
/ 1e9
;
1846 /* Normalize out-of-range lower-order components by carrying
1847 each overflow into the next higher-order component. */
1848 us
+= ps
/ 1000000 - (ps
% 1000000 < 0);
1849 lo
+= us
/ 1000000 - (us
% 1000000 < 0);
1850 hi
+= lo
>> LO_TIME_BITS
;
1851 ps
= ps
% 1000000 + 1000000 * (ps
% 1000000 < 0);
1852 us
= us
% 1000000 + 1000000 * (us
% 1000000 < 0);
1853 lo
&= (1 << LO_TIME_BITS
) - 1;
1857 if (FIXNUM_OVERFLOW_P (hi
))
1868 *dresult
= (us
* 1e6
+ ps
) / 1e12
+ lo
+ dhi
* (1 << LO_TIME_BITS
);
1875 lisp_to_timespec (struct lisp_time t
)
1877 if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN
>> LO_TIME_BITS
<= t
.hi
: 0 <= t
.hi
)
1878 && t
.hi
<= TIME_T_MAX
>> LO_TIME_BITS
))
1879 return invalid_timespec ();
1880 time_t s
= (t
.hi
<< LO_TIME_BITS
) + t
.lo
;
1881 int ns
= t
.us
* 1000 + t
.ps
/ 1000;
1882 return make_timespec (s
, ns
);
1885 /* Decode a Lisp list SPECIFIED_TIME that represents a time.
1886 Store its effective length into *PLEN.
1887 If SPECIFIED_TIME is nil, use the current time.
1888 Signal an error if SPECIFIED_TIME does not represent a time. */
1889 static struct lisp_time
1890 lisp_time_struct (Lisp_Object specified_time
, int *plen
)
1892 Lisp_Object high
, low
, usec
, psec
;
1894 int len
= disassemble_lisp_time (specified_time
, &high
, &low
, &usec
, &psec
);
1897 int val
= decode_time_components (high
, low
, usec
, psec
, &t
, 0);
1898 check_time_validity (val
);
1903 /* Like lisp_time_struct, except return a struct timespec.
1904 Discard any low-order digits. */
1906 lisp_time_argument (Lisp_Object specified_time
)
1909 struct lisp_time lt
= lisp_time_struct (specified_time
, &len
);
1910 struct timespec t
= lisp_to_timespec (lt
);
1911 if (! timespec_valid_p (t
))
1916 /* Like lisp_time_argument, except decode only the seconds part,
1917 and do not check the subseconds part. */
1919 lisp_seconds_argument (Lisp_Object specified_time
)
1921 Lisp_Object high
, low
, usec
, psec
;
1924 int val
= disassemble_lisp_time (specified_time
, &high
, &low
, &usec
, &psec
);
1927 val
= decode_time_components (high
, low
, make_number (0),
1928 make_number (0), &t
, 0);
1930 && ! ((TYPE_SIGNED (time_t)
1931 ? TIME_T_MIN
>> LO_TIME_BITS
<= t
.hi
1933 && t
.hi
<= TIME_T_MAX
>> LO_TIME_BITS
))
1936 check_time_validity (val
);
1937 return (t
.hi
<< LO_TIME_BITS
) + t
.lo
;
1940 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1941 doc
: /* Return the current time, as a float number of seconds since the epoch.
1942 If SPECIFIED-TIME is given, it is the time to convert to float
1943 instead of the current time. The argument should have the form
1944 \(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus,
1945 you can use times from `current-time' and from `file-attributes'.
1946 SPECIFIED-TIME can also have the form (HIGH . LOW), but this is
1947 considered obsolete.
1949 WARNING: Since the result is floating point, it may not be exact.
1950 If precise time stamps are required, use either `current-time',
1951 or (if you need time as a string) `format-time-string'. */)
1952 (Lisp_Object specified_time
)
1955 Lisp_Object high
, low
, usec
, psec
;
1956 if (! (disassemble_lisp_time (specified_time
, &high
, &low
, &usec
, &psec
)
1957 && decode_time_components (high
, low
, usec
, psec
, 0, &t
)))
1959 return make_float (t
);
1962 /* Write information into buffer S of size MAXSIZE, according to the
1963 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1964 Use the time zone specified by TZ.
1965 Use NS as the number of nanoseconds in the %N directive.
1966 Return the number of bytes written, not including the terminating
1967 '\0'. If S is NULL, nothing will be written anywhere; so to
1968 determine how many bytes would be written, use NULL for S and
1969 ((size_t) -1) for MAXSIZE.
1971 This function behaves like nstrftime, except it allows null
1972 bytes in FORMAT and it does not support nanoseconds. */
1974 emacs_nmemftime (char *s
, size_t maxsize
, const char *format
,
1975 size_t format_len
, const struct tm
*tp
, timezone_t tz
, int ns
)
1979 /* Loop through all the null-terminated strings in the format
1980 argument. Normally there's just one null-terminated string, but
1981 there can be arbitrarily many, concatenated together, if the
1982 format contains '\0' bytes. nstrftime stops at the first
1983 '\0' byte so we must invoke it separately for each such string. */
1992 result
= nstrftime (s
, maxsize
, format
, tp
, tz
, ns
);
1996 if (result
== 0 && s
[0] != '\0')
2001 maxsize
-= result
+ 1;
2003 len
= strlen (format
);
2004 if (len
== format_len
)
2008 format_len
-= len
+ 1;
2012 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
2013 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted or nil.
2014 TIME is specified as (HIGH LOW USEC PSEC), as returned by
2015 `current-time' or `file-attributes'. It can also be a single integer
2016 number of seconds since the epoch. The obsolete form (HIGH . LOW) is
2017 also still accepted.
2019 The optional ZONE is omitted or nil for Emacs local time, t for
2020 Universal Time, `wall' for system wall clock time, or a string as in
2021 the TZ environment variable. It can also be a list (as from
2022 `current-time-zone') or an integer (as from `decode-time') applied
2023 without consideration for daylight saving time.
2025 The value is a copy of FORMAT-STRING, but with certain constructs replaced
2026 by text that describes the specified date and time in TIME:
2028 %Y is the year, %y within the century, %C the century.
2029 %G is the year corresponding to the ISO week, %g within the century.
2030 %m is the numeric month.
2031 %b and %h are the locale's abbreviated month name, %B the full name.
2032 (%h is not supported on MS-Windows.)
2033 %d is the day of the month, zero-padded, %e is blank-padded.
2034 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
2035 %a is the locale's abbreviated name of the day of week, %A the full name.
2036 %U is the week number starting on Sunday, %W starting on Monday,
2037 %V according to ISO 8601.
2038 %j is the day of the year.
2040 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
2041 only blank-padded, %l is like %I blank-padded.
2042 %p is the locale's equivalent of either AM or PM.
2043 %q is the calendar quarter (1–4).
2046 %N is the nanosecond, %6N the microsecond, %3N the millisecond, etc.
2047 %Z is the time zone name, %z is the numeric form.
2048 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
2050 %c is the locale's date and time format.
2051 %x is the locale's "preferred" date format.
2052 %D is like "%m/%d/%y".
2053 %F is the ISO 8601 date format (like "%Y-%m-%d").
2055 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
2056 %X is the locale's "preferred" time format.
2058 Finally, %n is a newline, %t is a tab, %% is a literal %.
2060 Certain flags and modifiers are available with some format controls.
2061 The flags are `_', `-', `^' and `#'. For certain characters X,
2062 %_X is like %X, but padded with blanks; %-X is like %X,
2063 but without padding. %^X is like %X, but with all textual
2064 characters up-cased; %#X is like %X, but with letter-case of
2065 all textual characters reversed.
2066 %NX (where N stands for an integer) is like %X,
2067 but takes up at least N (a number) positions.
2068 The modifiers are `E' and `O'. For certain characters X,
2069 %EX is a locale's alternative version of %X;
2070 %OX is like %X, but uses the locale's number symbols.
2072 For example, to produce full ISO 8601 format, use "%FT%T%z".
2074 usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */)
2075 (Lisp_Object format_string
, Lisp_Object timeval
, Lisp_Object zone
)
2077 struct timespec t
= lisp_time_argument (timeval
);
2080 CHECK_STRING (format_string
);
2081 format_string
= code_convert_string_norecord (format_string
,
2082 Vlocale_coding_system
, 1);
2083 return format_time_string (SSDATA (format_string
), SBYTES (format_string
),
2088 format_time_string (char const *format
, ptrdiff_t formatlen
,
2089 struct timespec t
, Lisp_Object zone
, struct tm
*tmp
)
2093 ptrdiff_t size
= sizeof buffer
;
2098 timezone_t tz
= tzlookup (zone
, false);
2099 /* On some systems, like 32-bit MinGW, tv_sec of struct timespec is
2100 a 64-bit type, but time_t is a 32-bit type. emacs_localtime_rz
2101 expects a pointer to time_t value. */
2102 time_t tsec
= t
.tv_sec
;
2103 tmp
= emacs_localtime_rz (tz
, &tsec
, tmp
);
2109 synchronize_system_time_locale ();
2114 len
= emacs_nmemftime (buf
, size
, format
, formatlen
, tmp
, tz
, ns
);
2115 if ((0 < len
&& len
< size
) || (len
== 0 && buf
[0] == '\0'))
2118 /* Buffer was too small, so make it bigger and try again. */
2119 len
= emacs_nmemftime (NULL
, SIZE_MAX
, format
, formatlen
, tmp
, tz
, ns
);
2120 if (STRING_BYTES_BOUND
<= len
)
2126 buf
= SAFE_ALLOCA (size
);
2130 AUTO_STRING_WITH_LEN (bufstring
, buf
, len
);
2131 Lisp_Object result
= code_convert_string_norecord (bufstring
,
2132 Vlocale_coding_system
, 0);
2137 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 2, 0,
2138 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF).
2139 The optional TIME should be a list of (HIGH LOW . IGNORED),
2140 as from `current-time' and `file-attributes', or nil to use the
2141 current time. It can also be a single integer number of seconds since
2142 the epoch. The obsolete form (HIGH . LOW) is also still accepted.
2144 The optional ZONE is omitted or nil for Emacs local time, t for
2145 Universal Time, `wall' for system wall clock time, or a string as in
2146 the TZ environment variable. It can also be a list (as from
2147 `current-time-zone') or an integer (as from `decode-time') applied
2148 without consideration for daylight saving time.
2150 The list has the following nine members: SEC is an integer between 0
2151 and 60; SEC is 60 for a leap second, which only some operating systems
2152 support. MINUTE is an integer between 0 and 59. HOUR is an integer
2153 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
2154 integer between 1 and 12. YEAR is an integer indicating the
2155 four-digit year. DOW is the day of week, an integer between 0 and 6,
2156 where 0 is Sunday. DST is t if daylight saving time is in effect,
2157 otherwise nil. UTCOFF is an integer indicating the UTC offset in
2158 seconds, i.e., the number of seconds east of Greenwich. (Note that
2159 Common Lisp has different meanings for DOW and UTCOFF.)
2161 usage: (decode-time &optional TIME ZONE) */)
2162 (Lisp_Object specified_time
, Lisp_Object zone
)
2164 time_t time_spec
= lisp_seconds_argument (specified_time
);
2165 struct tm local_tm
, gmt_tm
;
2166 timezone_t tz
= tzlookup (zone
, false);
2167 struct tm
*tm
= emacs_localtime_rz (tz
, &time_spec
, &local_tm
);
2171 && MOST_NEGATIVE_FIXNUM
- TM_YEAR_BASE
<= local_tm
.tm_year
2172 && local_tm
.tm_year
<= MOST_POSITIVE_FIXNUM
- TM_YEAR_BASE
))
2175 /* Avoid overflow when INT_MAX < EMACS_INT_MAX. */
2176 EMACS_INT tm_year_base
= TM_YEAR_BASE
;
2178 return CALLN (Flist
,
2179 make_number (local_tm
.tm_sec
),
2180 make_number (local_tm
.tm_min
),
2181 make_number (local_tm
.tm_hour
),
2182 make_number (local_tm
.tm_mday
),
2183 make_number (local_tm
.tm_mon
+ 1),
2184 make_number (local_tm
.tm_year
+ tm_year_base
),
2185 make_number (local_tm
.tm_wday
),
2186 local_tm
.tm_isdst
? Qt
: Qnil
,
2188 ? make_number (tm_gmtoff (&local_tm
))
2189 : gmtime_r (&time_spec
, &gmt_tm
)
2190 ? make_number (tm_diff (&local_tm
, &gmt_tm
))
2194 /* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that
2195 the result is representable as an int. */
2197 check_tm_member (Lisp_Object obj
, int offset
)
2200 EMACS_INT n
= XINT (obj
);
2202 if (INT_SUBTRACT_WRAPV (n
, offset
, &result
))
2207 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
2208 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
2209 This is the reverse operation of `decode-time', which see.
2211 The optional ZONE is omitted or nil for Emacs local time, t for
2212 Universal Time, `wall' for system wall clock time, or a string as in
2213 the TZ environment variable. It can also be a list (as from
2214 `current-time-zone') or an integer (as from `decode-time') applied
2215 without consideration for daylight saving time.
2217 You can pass more than 7 arguments; then the first six arguments
2218 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
2219 The intervening arguments are ignored.
2220 This feature lets (apply \\='encode-time (decode-time ...)) work.
2222 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
2223 for example, a DAY of 0 means the day preceding the given month.
2224 Year numbers less than 100 are treated just like other year numbers.
2225 If you want them to stand for years in this century, you must do that yourself.
2227 Years before 1970 are not guaranteed to work. On some systems,
2228 year values as low as 1901 do work.
2230 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
2231 (ptrdiff_t nargs
, Lisp_Object
*args
)
2235 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
2237 tm
.tm_sec
= check_tm_member (args
[0], 0);
2238 tm
.tm_min
= check_tm_member (args
[1], 0);
2239 tm
.tm_hour
= check_tm_member (args
[2], 0);
2240 tm
.tm_mday
= check_tm_member (args
[3], 0);
2241 tm
.tm_mon
= check_tm_member (args
[4], 1);
2242 tm
.tm_year
= check_tm_member (args
[5], TM_YEAR_BASE
);
2245 timezone_t tz
= tzlookup (zone
, false);
2246 value
= emacs_mktime_z (tz
, &tm
);
2249 if (value
== (time_t) -1)
2252 return list2i (hi_time (value
), lo_time (value
));
2255 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
,
2257 doc
: /* Return the current local time, as a human-readable string.
2258 Programs can use this function to decode a time,
2259 since the number of columns in each field is fixed
2260 if the year is in the range 1000-9999.
2261 The format is `Sun Sep 16 01:03:52 1973'.
2262 However, see also the functions `decode-time' and `format-time-string'
2263 which provide a much more powerful and general facility.
2265 If SPECIFIED-TIME is given, it is a time to format instead of the
2266 current time. The argument should have the form (HIGH LOW . IGNORED).
2267 Thus, you can use times obtained from `current-time' and from
2268 `file-attributes'. SPECIFIED-TIME can also be a single integer number
2269 of seconds since the epoch. The obsolete form (HIGH . LOW) is also
2272 The optional ZONE is omitted or nil for Emacs local time, t for
2273 Universal Time, `wall' for system wall clock time, or a string as in
2274 the TZ environment variable. It can also be a list (as from
2275 `current-time-zone') or an integer (as from `decode-time') applied
2276 without consideration for daylight saving time. */)
2277 (Lisp_Object specified_time
, Lisp_Object zone
)
2279 time_t value
= lisp_seconds_argument (specified_time
);
2280 timezone_t tz
= tzlookup (zone
, false);
2282 /* Convert to a string in ctime format, except without the trailing
2283 newline, and without the 4-digit year limit. Don't use asctime
2284 or ctime, as they might dump core if the year is outside the
2285 range -999 .. 9999. */
2287 struct tm
*tmp
= emacs_localtime_rz (tz
, &value
, &tm
);
2292 static char const wday_name
[][4] =
2293 { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
2294 static char const mon_name
[][4] =
2295 { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
2296 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
2297 printmax_t year_base
= TM_YEAR_BASE
;
2298 char buf
[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1];
2299 int len
= sprintf (buf
, "%s %s%3d %02d:%02d:%02d %"pMd
,
2300 wday_name
[tm
.tm_wday
], mon_name
[tm
.tm_mon
], tm
.tm_mday
,
2301 tm
.tm_hour
, tm
.tm_min
, tm
.tm_sec
,
2302 tm
.tm_year
+ year_base
);
2304 return make_unibyte_string (buf
, len
);
2307 /* Yield A - B, measured in seconds.
2308 This function is copied from the GNU C Library. */
2310 tm_diff (struct tm
*a
, struct tm
*b
)
2312 /* Compute intervening leap days correctly even if year is negative.
2313 Take care to avoid int overflow in leap day calculations,
2314 but it's OK to assume that A and B are close to each other. */
2315 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
2316 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
2317 int a100
= a4
/ 25 - (a4
% 25 < 0);
2318 int b100
= b4
/ 25 - (b4
% 25 < 0);
2319 int a400
= a100
>> 2;
2320 int b400
= b100
>> 2;
2321 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
2322 int years
= a
->tm_year
- b
->tm_year
;
2323 int days
= (365 * years
+ intervening_leap_days
2324 + (a
->tm_yday
- b
->tm_yday
));
2325 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
2326 + (a
->tm_min
- b
->tm_min
))
2327 + (a
->tm_sec
- b
->tm_sec
));
2330 /* Yield A's UTC offset, or an unspecified value if unknown. */
2332 tm_gmtoff (struct tm
*a
)
2335 return a
->tm_gmtoff
;
2341 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 2, 0,
2342 doc
: /* Return the offset and name for the local time zone.
2343 This returns a list of the form (OFFSET NAME).
2344 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
2345 A negative value means west of Greenwich.
2346 NAME is a string giving the name of the time zone.
2347 If SPECIFIED-TIME is given, the time zone offset is determined from it
2348 instead of using the current time. The argument should have the form
2349 \(HIGH LOW . IGNORED). Thus, you can use times obtained from
2350 `current-time' and from `file-attributes'. SPECIFIED-TIME can also be
2351 a single integer number of seconds since the epoch. The obsolete form
2352 (HIGH . LOW) is also still accepted.
2354 The optional ZONE is omitted or nil for Emacs local time, t for
2355 Universal Time, `wall' for system wall clock time, or a string as in
2356 the TZ environment variable. It can also be a list (as from
2357 `current-time-zone') or an integer (as from `decode-time') applied
2358 without consideration for daylight saving time.
2360 Some operating systems cannot provide all this information to Emacs;
2361 in this case, `current-time-zone' returns a list containing nil for
2362 the data it can't find. */)
2363 (Lisp_Object specified_time
, Lisp_Object zone
)
2365 struct timespec value
;
2366 struct tm local_tm
, gmt_tm
;
2367 Lisp_Object zone_offset
, zone_name
;
2370 value
= make_timespec (lisp_seconds_argument (specified_time
), 0);
2371 zone_name
= format_time_string ("%Z", sizeof "%Z" - 1, value
,
2374 /* gmtime_r expects a pointer to time_t, but tv_sec of struct
2375 timespec on some systems (MinGW) is a 64-bit field. */
2376 time_t tsec
= value
.tv_sec
;
2377 if (HAVE_TM_GMTOFF
|| gmtime_r (&tsec
, &gmt_tm
))
2379 long int offset
= (HAVE_TM_GMTOFF
2380 ? tm_gmtoff (&local_tm
)
2381 : tm_diff (&local_tm
, &gmt_tm
));
2382 zone_offset
= make_number (offset
);
2383 if (SCHARS (zone_name
) == 0)
2385 /* No local time zone name is available; use numeric zone instead. */
2386 long int hour
= offset
/ 3600;
2387 int min_sec
= offset
% 3600;
2388 int amin_sec
= min_sec
< 0 ? - min_sec
: min_sec
;
2389 int min
= amin_sec
/ 60;
2390 int sec
= amin_sec
% 60;
2391 int min_prec
= min_sec
? 2 : 0;
2392 int sec_prec
= sec
? 2 : 0;
2393 char buf
[sizeof "+0000" + INT_STRLEN_BOUND (long int)];
2394 zone_name
= make_formatted_string (buf
, "%c%.2ld%.*d%.*d",
2395 (offset
< 0 ? '-' : '+'),
2396 hour
, min_prec
, min
, sec_prec
, sec
);
2400 return list2 (zone_offset
, zone_name
);
2403 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
2404 doc
: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule.
2405 If TZ is nil or `wall', use system wall clock time; this differs from
2406 the usual Emacs convention where nil means current local time. If TZ
2407 is t, use Universal Time. If TZ is a list (as from
2408 `current-time-zone') or an integer (as from `decode-time'), use the
2409 specified time zone without consideration for daylight saving time.
2411 Instead of calling this function, you typically want something else.
2412 To temporarily use a different time zone rule for just one invocation
2413 of `decode-time', `encode-time', or `format-time-string', pass the
2414 function a ZONE argument. To change local time consistently
2415 throughout Emacs, call (setenv "TZ" TZ): this changes both the
2416 environment of the Emacs process and the variable
2417 `process-environment', whereas `set-time-zone-rule' affects only the
2421 tzlookup (NILP (tz
) ? Qwall
: tz
, true);
2425 /* A buffer holding a string of the form "TZ=value", intended
2426 to be part of the environment. If TZ is supposed to be unset,
2427 the buffer string is "tZ=". */
2428 static char *tzvalbuf
;
2430 /* Get the local time zone rule. */
2432 emacs_getenv_TZ (void)
2434 return tzvalbuf
[0] == 'T' ? tzvalbuf
+ tzeqlen
: 0;
2437 /* Set the local time zone rule to TZSTRING, which can be null to
2438 denote wall clock time. Do not record the setting in LOCAL_TZ.
2440 This function is not thread-safe, in theory because putenv is not,
2441 but mostly because of the static storage it updates. Other threads
2442 that invoke localtime etc. may be adversely affected while this
2443 function is executing. */
2446 emacs_setenv_TZ (const char *tzstring
)
2448 static ptrdiff_t tzvalbufsize
;
2449 ptrdiff_t tzstringlen
= tzstring
? strlen (tzstring
) : 0;
2450 char *tzval
= tzvalbuf
;
2451 bool new_tzvalbuf
= tzvalbufsize
<= tzeqlen
+ tzstringlen
;
2455 /* Do not attempt to free the old tzvalbuf, since another thread
2456 may be using it. In practice, the first allocation is large
2457 enough and memory does not leak. */
2458 tzval
= xpalloc (NULL
, &tzvalbufsize
,
2459 tzeqlen
+ tzstringlen
- tzvalbufsize
+ 1, -1, 1);
2467 /* Modify TZVAL in place. Although this is dicey in a
2468 multithreaded environment, we know of no portable alternative.
2469 Calling putenv or setenv could crash some other thread. */
2471 strcpy (tzval
+ tzeqlen
, tzstring
);
2475 /* Turn 'TZ=whatever' into an empty environment variable 'tZ='.
2476 Although this is also dicey, calling unsetenv here can crash Emacs.
2484 /* Modifying *TZVAL merely requires calling tzset (which is the
2485 caller's responsibility). However, modifying TZVAL requires
2486 calling putenv; although this is not thread-safe, in practice this
2487 runs only on startup when there is only one thread. */
2488 bool need_putenv
= new_tzvalbuf
;
2490 /* MS-Windows 'putenv' copies the argument string into a block it
2491 allocates, so modifying *TZVAL will not change the environment.
2492 However, the other threads run by Emacs on MS-Windows never call
2493 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the
2494 dicey in-place modification technique doesn't exist there in the
2496 bool need_putenv
= true;
2504 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2505 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2506 type of object is Lisp_String). INHERIT is passed to
2507 INSERT_FROM_STRING_FUNC as the last argument. */
2510 general_insert_function (void (*insert_func
)
2511 (const char *, ptrdiff_t),
2512 void (*insert_from_string_func
)
2513 (Lisp_Object
, ptrdiff_t, ptrdiff_t,
2514 ptrdiff_t, ptrdiff_t, bool),
2515 bool inherit
, ptrdiff_t nargs
, Lisp_Object
*args
)
2520 for (argnum
= 0; argnum
< nargs
; argnum
++)
2523 if (CHARACTERP (val
))
2525 int c
= XFASTINT (val
);
2526 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2529 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2530 len
= CHAR_STRING (c
, str
);
2533 str
[0] = CHAR_TO_BYTE8 (c
);
2536 (*insert_func
) ((char *) str
, len
);
2538 else if (STRINGP (val
))
2540 (*insert_from_string_func
) (val
, 0, 0,
2546 wrong_type_argument (Qchar_or_string_p
, val
);
2551 insert1 (Lisp_Object arg
)
2557 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2558 doc
: /* Insert the arguments, either strings or characters, at point.
2559 Point and after-insertion markers move forward to end up
2560 after the inserted text.
2561 Any other markers at the point of insertion remain before the text.
2563 If the current buffer is multibyte, unibyte strings are converted
2564 to multibyte for insertion (see `string-make-multibyte').
2565 If the current buffer is unibyte, multibyte strings are converted
2566 to unibyte for insertion (see `string-make-unibyte').
2568 When operating on binary data, it may be necessary to preserve the
2569 original bytes of a unibyte string when inserting it into a multibyte
2570 buffer; to accomplish this, apply `string-as-multibyte' to the string
2571 and insert the result.
2573 usage: (insert &rest ARGS) */)
2574 (ptrdiff_t nargs
, Lisp_Object
*args
)
2576 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2580 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2582 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2583 Point and after-insertion markers move forward to end up
2584 after the inserted text.
2585 Any other markers at the point of insertion remain before the text.
2587 If the current buffer is multibyte, unibyte strings are converted
2588 to multibyte for insertion (see `unibyte-char-to-multibyte').
2589 If the current buffer is unibyte, multibyte strings are converted
2590 to unibyte for insertion.
2592 usage: (insert-and-inherit &rest ARGS) */)
2593 (ptrdiff_t nargs
, Lisp_Object
*args
)
2595 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2600 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2601 doc
: /* Insert strings or characters at point, relocating markers after the text.
2602 Point and markers move forward to end up after the inserted text.
2604 If the current buffer is multibyte, unibyte strings are converted
2605 to multibyte for insertion (see `unibyte-char-to-multibyte').
2606 If the current buffer is unibyte, multibyte strings are converted
2607 to unibyte for insertion.
2609 If an overlay begins at the insertion point, the inserted text falls
2610 outside the overlay; if a nonempty overlay ends at the insertion
2611 point, the inserted text falls inside that overlay.
2613 usage: (insert-before-markers &rest ARGS) */)
2614 (ptrdiff_t nargs
, Lisp_Object
*args
)
2616 general_insert_function (insert_before_markers
,
2617 insert_from_string_before_markers
, 0,
2622 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2623 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2624 doc
: /* Insert text at point, relocating markers and inheriting properties.
2625 Point and markers move forward to end up after the inserted text.
2627 If the current buffer is multibyte, unibyte strings are converted
2628 to multibyte for insertion (see `unibyte-char-to-multibyte').
2629 If the current buffer is unibyte, multibyte strings are converted
2630 to unibyte for insertion.
2632 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2633 (ptrdiff_t nargs
, Lisp_Object
*args
)
2635 general_insert_function (insert_before_markers_and_inherit
,
2636 insert_from_string_before_markers
, 1,
2641 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 1, 3,
2642 "(list (read-char-by-name \"Insert character (Unicode name or hex): \")\
2643 (prefix-numeric-value current-prefix-arg)\
2645 doc
: /* Insert COUNT copies of CHARACTER.
2646 Interactively, prompt for CHARACTER. You can specify CHARACTER in one
2649 - As its Unicode character name, e.g. \"LATIN SMALL LETTER A\".
2650 Completion is available; if you type a substring of the name
2651 preceded by an asterisk `*', Emacs shows all names which include
2652 that substring, not necessarily at the beginning of the name.
2654 - As a hexadecimal code point, e.g. 263A. Note that code points in
2655 Emacs are equivalent to Unicode up to 10FFFF (which is the limit of
2656 the Unicode code space).
2658 - As a code point with a radix specified with #, e.g. #o21430
2659 (octal), #x2318 (hex), or #10r8984 (decimal).
2661 If called interactively, COUNT is given by the prefix argument. If
2662 omitted or nil, it defaults to 1.
2664 Inserting the character(s) relocates point and before-insertion
2665 markers in the same ways as the function `insert'.
2667 The optional third argument INHERIT, if non-nil, says to inherit text
2668 properties from adjoining text, if those properties are sticky. If
2669 called interactively, INHERIT is t. */)
2670 (Lisp_Object character
, Lisp_Object count
, Lisp_Object inherit
)
2673 register ptrdiff_t n
;
2675 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2678 CHECK_CHARACTER (character
);
2680 XSETFASTINT (count
, 1);
2681 CHECK_NUMBER (count
);
2682 c
= XFASTINT (character
);
2684 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2685 len
= CHAR_STRING (c
, str
);
2687 str
[0] = c
, len
= 1;
2688 if (XINT (count
) <= 0)
2690 if (BUF_BYTES_MAX
/ len
< XINT (count
))
2692 n
= XINT (count
) * len
;
2693 stringlen
= min (n
, sizeof string
- sizeof string
% len
);
2694 for (i
= 0; i
< stringlen
; i
++)
2695 string
[i
] = str
[i
% len
];
2696 while (n
> stringlen
)
2699 if (!NILP (inherit
))
2700 insert_and_inherit (string
, stringlen
);
2702 insert (string
, stringlen
);
2705 if (!NILP (inherit
))
2706 insert_and_inherit (string
, n
);
2712 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2713 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2714 Both arguments are required.
2715 BYTE is a number of the range 0..255.
2717 If BYTE is 128..255 and the current buffer is multibyte, the
2718 corresponding eight-bit character is inserted.
2720 Point, and before-insertion markers, are relocated as in the function `insert'.
2721 The optional third arg INHERIT, if non-nil, says to inherit text properties
2722 from adjoining text, if those properties are sticky. */)
2723 (Lisp_Object byte
, Lisp_Object count
, Lisp_Object inherit
)
2725 CHECK_NUMBER (byte
);
2726 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2727 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2728 if (XINT (byte
) >= 128
2729 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2730 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2731 return Finsert_char (byte
, count
, inherit
);
2735 /* Making strings from buffer contents. */
2737 /* Return a Lisp_String containing the text of the current buffer from
2738 START to END. If text properties are in use and the current buffer
2739 has properties in the range specified, the resulting string will also
2740 have them, if PROPS is true.
2742 We don't want to use plain old make_string here, because it calls
2743 make_uninit_string, which can cause the buffer arena to be
2744 compacted. make_string has no way of knowing that the data has
2745 been moved, and thus copies the wrong data into the string. This
2746 doesn't effect most of the other users of make_string, so it should
2747 be left as is. But we should use this function when conjuring
2748 buffer substrings. */
2751 make_buffer_string (ptrdiff_t start
, ptrdiff_t end
, bool props
)
2753 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
2754 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
2756 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2759 /* Return a Lisp_String containing the text of the current buffer from
2760 START / START_BYTE to END / END_BYTE.
2762 If text properties are in use and the current buffer
2763 has properties in the range specified, the resulting string will also
2764 have them, if PROPS is true.
2766 We don't want to use plain old make_string here, because it calls
2767 make_uninit_string, which can cause the buffer arena to be
2768 compacted. make_string has no way of knowing that the data has
2769 been moved, and thus copies the wrong data into the string. This
2770 doesn't effect most of the other users of make_string, so it should
2771 be left as is. But we should use this function when conjuring
2772 buffer substrings. */
2775 make_buffer_string_both (ptrdiff_t start
, ptrdiff_t start_byte
,
2776 ptrdiff_t end
, ptrdiff_t end_byte
, bool props
)
2778 Lisp_Object result
, tem
, tem1
;
2779 ptrdiff_t beg0
, end0
, beg1
, end1
, size
;
2781 if (start_byte
< GPT_BYTE
&& GPT_BYTE
< end_byte
)
2783 /* Two regions, before and after the gap. */
2786 beg1
= GPT_BYTE
+ GAP_SIZE
- BEG_BYTE
;
2787 end1
= end_byte
+ GAP_SIZE
- BEG_BYTE
;
2791 /* The only region. */
2798 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2799 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2801 result
= make_uninit_string (end
- start
);
2804 memcpy (SDATA (result
), BYTE_POS_ADDR (beg0
), size
);
2806 memcpy (SDATA (result
) + size
, BEG_ADDR
+ beg1
, end1
- beg1
);
2808 /* If desired, update and copy the text properties. */
2811 update_buffer_properties (start
, end
);
2813 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2814 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2816 if (XINT (tem
) != end
|| !NILP (tem1
))
2817 copy_intervals_to_string (result
, current_buffer
, start
,
2824 /* Call Vbuffer_access_fontify_functions for the range START ... END
2825 in the current buffer, if necessary. */
2828 update_buffer_properties (ptrdiff_t start
, ptrdiff_t end
)
2830 /* If this buffer has some access functions,
2831 call them, specifying the range of the buffer being accessed. */
2832 if (!NILP (Vbuffer_access_fontify_functions
))
2834 /* But don't call them if we can tell that the work
2835 has already been done. */
2836 if (!NILP (Vbuffer_access_fontified_property
))
2839 = Ftext_property_any (make_number (start
), make_number (end
),
2840 Vbuffer_access_fontified_property
,
2846 CALLN (Frun_hook_with_args
, Qbuffer_access_fontify_functions
,
2847 make_number (start
), make_number (end
));
2851 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2852 doc
: /* Return the contents of part of the current buffer as a string.
2853 The two arguments START and END are character positions;
2854 they can be in either order.
2855 The string returned is multibyte if the buffer is multibyte.
2857 This function copies the text properties of that part of the buffer
2858 into the result string; if you don't want the text properties,
2859 use `buffer-substring-no-properties' instead. */)
2860 (Lisp_Object start
, Lisp_Object end
)
2862 register ptrdiff_t b
, e
;
2864 validate_region (&start
, &end
);
2868 return make_buffer_string (b
, e
, 1);
2871 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2872 Sbuffer_substring_no_properties
, 2, 2, 0,
2873 doc
: /* Return the characters of part of the buffer, without the text properties.
2874 The two arguments START and END are character positions;
2875 they can be in either order. */)
2876 (Lisp_Object start
, Lisp_Object end
)
2878 register ptrdiff_t b
, e
;
2880 validate_region (&start
, &end
);
2884 return make_buffer_string (b
, e
, 0);
2887 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2888 doc
: /* Return the contents of the current buffer as a string.
2889 If narrowing is in effect, this function returns only the visible part
2893 return make_buffer_string_both (BEGV
, BEGV_BYTE
, ZV
, ZV_BYTE
, 1);
2896 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2898 doc
: /* Insert before point a substring of the contents of BUFFER.
2899 BUFFER may be a buffer or a buffer name.
2900 Arguments START and END are character positions specifying the substring.
2901 They default to the values of (point-min) and (point-max) in BUFFER.
2903 Point and before-insertion markers move forward to end up after the
2905 Any other markers at the point of insertion remain before the text.
2907 If the current buffer is multibyte and BUFFER is unibyte, or vice
2908 versa, strings are converted from unibyte to multibyte or vice versa
2909 using `string-make-multibyte' or `string-make-unibyte', which see. */)
2910 (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
2912 register EMACS_INT b
, e
, temp
;
2913 register struct buffer
*bp
, *obuf
;
2916 buf
= Fget_buffer (buffer
);
2920 if (!BUFFER_LIVE_P (bp
))
2921 error ("Selecting deleted buffer");
2927 CHECK_NUMBER_COERCE_MARKER (start
);
2934 CHECK_NUMBER_COERCE_MARKER (end
);
2939 temp
= b
, b
= e
, e
= temp
;
2941 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2942 args_out_of_range (start
, end
);
2944 obuf
= current_buffer
;
2945 set_buffer_internal_1 (bp
);
2946 update_buffer_properties (b
, e
);
2947 set_buffer_internal_1 (obuf
);
2949 insert_from_buffer (bp
, b
, e
- b
, 0);
2953 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2955 doc
: /* Compare two substrings of two buffers; return result as number.
2956 Return -N if first string is less after N-1 chars, +N if first string is
2957 greater after N-1 chars, or 0 if strings match.
2958 The first substring is in BUFFER1 from START1 to END1 and the second
2959 is in BUFFER2 from START2 to END2.
2960 All arguments may be nil. If BUFFER1 or BUFFER2 is nil, the current
2961 buffer is used. If START1 or START2 is nil, the value of `point-min'
2962 in the respective buffers is used. If END1 or END2 is nil, the value
2963 of `point-max' in the respective buffers is used.
2964 The value of `case-fold-search' in the current buffer
2965 determines whether case is significant or ignored. */)
2966 (Lisp_Object buffer1
, Lisp_Object start1
, Lisp_Object end1
, Lisp_Object buffer2
, Lisp_Object start2
, Lisp_Object end2
)
2968 register EMACS_INT begp1
, endp1
, begp2
, endp2
, temp
;
2969 register struct buffer
*bp1
, *bp2
;
2970 register Lisp_Object trt
2971 = (!NILP (BVAR (current_buffer
, case_fold_search
))
2972 ? BVAR (current_buffer
, case_canon_table
) : Qnil
);
2973 ptrdiff_t chars
= 0;
2974 ptrdiff_t i1
, i2
, i1_byte
, i2_byte
;
2976 /* Find the first buffer and its substring. */
2979 bp1
= current_buffer
;
2983 buf1
= Fget_buffer (buffer1
);
2986 bp1
= XBUFFER (buf1
);
2987 if (!BUFFER_LIVE_P (bp1
))
2988 error ("Selecting deleted buffer");
2992 begp1
= BUF_BEGV (bp1
);
2995 CHECK_NUMBER_COERCE_MARKER (start1
);
2996 begp1
= XINT (start1
);
2999 endp1
= BUF_ZV (bp1
);
3002 CHECK_NUMBER_COERCE_MARKER (end1
);
3003 endp1
= XINT (end1
);
3007 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
3009 if (!(BUF_BEGV (bp1
) <= begp1
3011 && endp1
<= BUF_ZV (bp1
)))
3012 args_out_of_range (start1
, end1
);
3014 /* Likewise for second substring. */
3017 bp2
= current_buffer
;
3021 buf2
= Fget_buffer (buffer2
);
3024 bp2
= XBUFFER (buf2
);
3025 if (!BUFFER_LIVE_P (bp2
))
3026 error ("Selecting deleted buffer");
3030 begp2
= BUF_BEGV (bp2
);
3033 CHECK_NUMBER_COERCE_MARKER (start2
);
3034 begp2
= XINT (start2
);
3037 endp2
= BUF_ZV (bp2
);
3040 CHECK_NUMBER_COERCE_MARKER (end2
);
3041 endp2
= XINT (end2
);
3045 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
3047 if (!(BUF_BEGV (bp2
) <= begp2
3049 && endp2
<= BUF_ZV (bp2
)))
3050 args_out_of_range (start2
, end2
);
3054 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
3055 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
3057 while (i1
< endp1
&& i2
< endp2
)
3059 /* When we find a mismatch, we must compare the
3060 characters, not just the bytes. */
3063 if (! NILP (BVAR (bp1
, enable_multibyte_characters
)))
3065 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
3066 BUF_INC_POS (bp1
, i1_byte
);
3071 c1
= BUF_FETCH_BYTE (bp1
, i1
);
3072 MAKE_CHAR_MULTIBYTE (c1
);
3076 if (! NILP (BVAR (bp2
, enable_multibyte_characters
)))
3078 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
3079 BUF_INC_POS (bp2
, i2_byte
);
3084 c2
= BUF_FETCH_BYTE (bp2
, i2
);
3085 MAKE_CHAR_MULTIBYTE (c2
);
3091 c1
= char_table_translate (trt
, c1
);
3092 c2
= char_table_translate (trt
, c2
);
3096 return make_number (c1
< c2
? -1 - chars
: chars
+ 1);
3099 rarely_quit (chars
);
3102 /* The strings match as far as they go.
3103 If one is shorter, that one is less. */
3104 if (chars
< endp1
- begp1
)
3105 return make_number (chars
+ 1);
3106 else if (chars
< endp2
- begp2
)
3107 return make_number (- chars
- 1);
3109 /* Same length too => they are equal. */
3110 return make_number (0);
3114 subst_char_in_region_unwind (Lisp_Object arg
)
3116 bset_undo_list (current_buffer
, arg
);
3120 subst_char_in_region_unwind_1 (Lisp_Object arg
)
3122 bset_filename (current_buffer
, arg
);
3125 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
3126 Ssubst_char_in_region
, 4, 5, 0,
3127 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
3128 If optional arg NOUNDO is non-nil, don't record this change for undo
3129 and don't mark the buffer as really changed.
3130 Both characters must have the same length of multi-byte form. */)
3131 (Lisp_Object start
, Lisp_Object end
, Lisp_Object fromchar
, Lisp_Object tochar
, Lisp_Object noundo
)
3133 register ptrdiff_t pos
, pos_byte
, stop
, i
, len
, end_byte
;
3134 /* Keep track of the first change in the buffer:
3135 if 0 we haven't found it yet.
3136 if < 0 we've found it and we've run the before-change-function.
3137 if > 0 we've actually performed it and the value is its position. */
3138 ptrdiff_t changed
= 0;
3139 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
3141 ptrdiff_t count
= SPECPDL_INDEX ();
3142 #define COMBINING_NO 0
3143 #define COMBINING_BEFORE 1
3144 #define COMBINING_AFTER 2
3145 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
3146 int maybe_byte_combining
= COMBINING_NO
;
3147 ptrdiff_t last_changed
= 0;
3149 = !NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3154 validate_region (&start
, &end
);
3155 CHECK_CHARACTER (fromchar
);
3156 CHECK_CHARACTER (tochar
);
3157 fromc
= XFASTINT (fromchar
);
3158 toc
= XFASTINT (tochar
);
3162 len
= CHAR_STRING (fromc
, fromstr
);
3163 if (CHAR_STRING (toc
, tostr
) != len
)
3164 error ("Characters in `subst-char-in-region' have different byte-lengths");
3165 if (!ASCII_CHAR_P (*tostr
))
3167 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
3168 complete multibyte character, it may be combined with the
3169 after bytes. If it is in the range 0xA0..0xFF, it may be
3170 combined with the before and after bytes. */
3171 if (!CHAR_HEAD_P (*tostr
))
3172 maybe_byte_combining
= COMBINING_BOTH
;
3173 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
3174 maybe_byte_combining
= COMBINING_AFTER
;
3185 pos_byte
= CHAR_TO_BYTE (pos
);
3186 stop
= CHAR_TO_BYTE (XINT (end
));
3189 /* If we don't want undo, turn off putting stuff on the list.
3190 That's faster than getting rid of things,
3191 and it prevents even the entry for a first change.
3192 Also inhibit locking the file. */
3193 if (!changed
&& !NILP (noundo
))
3195 record_unwind_protect (subst_char_in_region_unwind
,
3196 BVAR (current_buffer
, undo_list
));
3197 bset_undo_list (current_buffer
, Qt
);
3198 /* Don't do file-locking. */
3199 record_unwind_protect (subst_char_in_region_unwind_1
,
3200 BVAR (current_buffer
, filename
));
3201 bset_filename (current_buffer
, Qnil
);
3204 if (pos_byte
< GPT_BYTE
)
3205 stop
= min (stop
, GPT_BYTE
);
3208 ptrdiff_t pos_byte_next
= pos_byte
;
3210 if (pos_byte
>= stop
)
3212 if (pos_byte
>= end_byte
) break;
3215 p
= BYTE_POS_ADDR (pos_byte
);
3217 INC_POS (pos_byte_next
);
3220 if (pos_byte_next
- pos_byte
== len
3221 && p
[0] == fromstr
[0]
3223 || (p
[1] == fromstr
[1]
3224 && (len
== 2 || (p
[2] == fromstr
[2]
3225 && (len
== 3 || p
[3] == fromstr
[3]))))))
3228 /* We've already seen this and run the before-change-function;
3229 this time we only need to record the actual position. */
3234 modify_text (pos
, XINT (end
));
3236 if (! NILP (noundo
))
3238 if (MODIFF
- 1 == SAVE_MODIFF
)
3240 if (MODIFF
- 1 == BUF_AUTOSAVE_MODIFF (current_buffer
))
3241 BUF_AUTOSAVE_MODIFF (current_buffer
)++;
3244 /* The before-change-function may have moved the gap
3245 or even modified the buffer so we should start over. */
3249 /* Take care of the case where the new character
3250 combines with neighboring bytes. */
3251 if (maybe_byte_combining
3252 && (maybe_byte_combining
== COMBINING_AFTER
3253 ? (pos_byte_next
< Z_BYTE
3254 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
3255 : ((pos_byte_next
< Z_BYTE
3256 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
3257 || (pos_byte
> BEG_BYTE
3258 && ! ASCII_CHAR_P (FETCH_BYTE (pos_byte
- 1))))))
3260 Lisp_Object tem
, string
;
3262 tem
= BVAR (current_buffer
, undo_list
);
3264 /* Make a multibyte string containing this single character. */
3265 string
= make_multibyte_string ((char *) tostr
, 1, len
);
3266 /* replace_range is less efficient, because it moves the gap,
3267 but it handles combining correctly. */
3268 replace_range (pos
, pos
+ 1, string
,
3270 pos_byte_next
= CHAR_TO_BYTE (pos
);
3271 if (pos_byte_next
> pos_byte
)
3272 /* Before combining happened. We should not increment
3273 POS. So, to cancel the later increment of POS,
3277 INC_POS (pos_byte_next
);
3279 if (! NILP (noundo
))
3280 bset_undo_list (current_buffer
, tem
);
3285 record_change (pos
, 1);
3286 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
3288 last_changed
= pos
+ 1;
3290 pos_byte
= pos_byte_next
;
3296 signal_after_change (changed
,
3297 last_changed
- changed
, last_changed
- changed
);
3298 update_compositions (changed
, last_changed
, CHECK_ALL
);
3301 unbind_to (count
, Qnil
);
3306 static Lisp_Object
check_translation (ptrdiff_t, ptrdiff_t, ptrdiff_t,
3309 /* Helper function for Ftranslate_region_internal.
3311 Check if a character sequence at POS (POS_BYTE) matches an element
3312 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
3313 element is found, return it. Otherwise return Qnil. */
3316 check_translation (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t end
,
3319 int initial_buf
[16];
3320 int *buf
= initial_buf
;
3321 ptrdiff_t buf_size
= ARRAYELTS (initial_buf
);
3323 ptrdiff_t buf_used
= 0;
3324 Lisp_Object result
= Qnil
;
3326 for (; CONSP (val
); val
= XCDR (val
))
3335 if (! VECTORP (elt
))
3338 if (len
<= end
- pos
)
3340 for (i
= 0; i
< len
; i
++)
3344 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3347 if (buf_used
== buf_size
)
3349 bufalloc
= xpalloc (bufalloc
, &buf_size
, 1, -1,
3351 if (buf
== initial_buf
)
3352 memcpy (bufalloc
, buf
, sizeof initial_buf
);
3355 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, len1
);
3358 if (XINT (AREF (elt
, i
)) != buf
[i
])
3363 result
= XCAR (val
);
3374 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
3375 Stranslate_region_internal
, 3, 3, 0,
3376 doc
: /* Internal use only.
3377 From START to END, translate characters according to TABLE.
3378 TABLE is a string or a char-table; the Nth character in it is the
3379 mapping for the character with code N.
3380 It returns the number of characters changed. */)
3381 (Lisp_Object start
, Lisp_Object end
, register Lisp_Object table
)
3383 register unsigned char *tt
; /* Trans table. */
3384 register int nc
; /* New character. */
3385 int cnt
; /* Number of changes made. */
3386 ptrdiff_t size
; /* Size of translate table. */
3387 ptrdiff_t pos
, pos_byte
, end_pos
;
3388 bool multibyte
= !NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3389 bool string_multibyte UNINIT
;
3391 validate_region (&start
, &end
);
3392 if (CHAR_TABLE_P (table
))
3394 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
3395 error ("Not a translation table");
3401 CHECK_STRING (table
);
3403 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
3404 table
= string_make_unibyte (table
);
3405 string_multibyte
= SCHARS (table
) < SBYTES (table
);
3406 size
= SBYTES (table
);
3411 pos_byte
= CHAR_TO_BYTE (pos
);
3412 end_pos
= XINT (end
);
3413 modify_text (pos
, end_pos
);
3416 for (; pos
< end_pos
; )
3418 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3419 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
3425 oc
= STRING_CHAR_AND_LENGTH (p
, len
);
3432 /* Reload as signal_after_change in last iteration may GC. */
3434 if (string_multibyte
)
3436 str
= tt
+ string_char_to_byte (table
, oc
);
3437 nc
= STRING_CHAR_AND_LENGTH (str
, str_len
);
3442 if (! ASCII_CHAR_P (nc
) && multibyte
)
3444 str_len
= BYTE8_STRING (nc
, buf
);
3457 val
= CHAR_TABLE_REF (table
, oc
);
3458 if (CHARACTERP (val
))
3460 nc
= XFASTINT (val
);
3461 str_len
= CHAR_STRING (nc
, buf
);
3464 else if (VECTORP (val
) || (CONSP (val
)))
3466 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3467 where TO is TO-CHAR or [TO-CHAR ...]. */
3472 if (nc
!= oc
&& nc
>= 0)
3474 /* Simple one char to one char translation. */
3479 /* This is less efficient, because it moves the gap,
3480 but it should handle multibyte characters correctly. */
3481 string
= make_multibyte_string ((char *) str
, 1, str_len
);
3482 replace_range (pos
, pos
+ 1, string
, 1, 0, 1, 0);
3487 record_change (pos
, 1);
3488 while (str_len
-- > 0)
3490 signal_after_change (pos
, 1, 1);
3491 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3501 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3508 /* VAL is ([FROM-CHAR ...] . TO). */
3509 len
= ASIZE (XCAR (val
));
3517 string
= Fconcat (1, &val
);
3521 string
= Fmake_string (make_number (1), val
);
3523 replace_range (pos
, pos
+ len
, string
, 1, 0, 1, 0);
3524 pos_byte
+= SBYTES (string
);
3525 pos
+= SCHARS (string
);
3526 cnt
+= SCHARS (string
);
3527 end_pos
+= SCHARS (string
) - len
;
3535 return make_number (cnt
);
3538 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3539 doc
: /* Delete the text between START and END.
3540 If called interactively, delete the region between point and mark.
3541 This command deletes buffer text without modifying the kill ring. */)
3542 (Lisp_Object start
, Lisp_Object end
)
3544 validate_region (&start
, &end
);
3545 del_range (XINT (start
), XINT (end
));
3549 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3550 Sdelete_and_extract_region
, 2, 2, 0,
3551 doc
: /* Delete the text between START and END and return it. */)
3552 (Lisp_Object start
, Lisp_Object end
)
3554 validate_region (&start
, &end
);
3555 if (XINT (start
) == XINT (end
))
3556 return empty_unibyte_string
;
3557 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3560 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3561 doc
: /* Remove restrictions (narrowing) from current buffer.
3562 This allows the buffer's full text to be seen and edited. */)
3565 if (BEG
!= BEGV
|| Z
!= ZV
)
3566 current_buffer
->clip_changed
= 1;
3568 BEGV_BYTE
= BEG_BYTE
;
3569 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3570 /* Changing the buffer bounds invalidates any recorded current column. */
3571 invalidate_current_column ();
3575 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3576 doc
: /* Restrict editing in this buffer to the current region.
3577 The rest of the text becomes temporarily invisible and untouchable
3578 but is not deleted; if you save the buffer in a file, the invisible
3579 text is included in the file. \\[widen] makes all visible again.
3580 See also `save-restriction'.
3582 When calling from a program, pass two arguments; positions (integers
3583 or markers) bounding the text that should remain visible. */)
3584 (register Lisp_Object start
, Lisp_Object end
)
3586 CHECK_NUMBER_COERCE_MARKER (start
);
3587 CHECK_NUMBER_COERCE_MARKER (end
);
3589 if (XINT (start
) > XINT (end
))
3592 tem
= start
; start
= end
; end
= tem
;
3595 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3596 args_out_of_range (start
, end
);
3598 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3599 current_buffer
->clip_changed
= 1;
3601 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3602 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3603 if (PT
< XFASTINT (start
))
3604 SET_PT (XFASTINT (start
));
3605 if (PT
> XFASTINT (end
))
3606 SET_PT (XFASTINT (end
));
3607 /* Changing the buffer bounds invalidates any recorded current column. */
3608 invalidate_current_column ();
3613 save_restriction_save (void)
3615 if (BEGV
== BEG
&& ZV
== Z
)
3616 /* The common case that the buffer isn't narrowed.
3617 We return just the buffer object, which save_restriction_restore
3618 recognizes as meaning `no restriction'. */
3619 return Fcurrent_buffer ();
3621 /* We have to save a restriction, so return a pair of markers, one
3622 for the beginning and one for the end. */
3624 Lisp_Object beg
, end
;
3626 beg
= build_marker (current_buffer
, BEGV
, BEGV_BYTE
);
3627 end
= build_marker (current_buffer
, ZV
, ZV_BYTE
);
3629 /* END must move forward if text is inserted at its exact location. */
3630 XMARKER (end
)->insertion_type
= 1;
3632 return Fcons (beg
, end
);
3637 save_restriction_restore (Lisp_Object data
)
3639 struct buffer
*cur
= NULL
;
3640 struct buffer
*buf
= (CONSP (data
)
3641 ? XMARKER (XCAR (data
))->buffer
3644 if (buf
&& buf
!= current_buffer
&& !NILP (BVAR (buf
, pt_marker
)))
3645 { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
3646 is the case if it is or has an indirect buffer), then make
3647 sure it is current before we update BEGV, so
3648 set_buffer_internal takes care of managing those markers. */
3649 cur
= current_buffer
;
3650 set_buffer_internal (buf
);
3654 /* A pair of marks bounding a saved restriction. */
3656 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3657 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3658 eassert (buf
== end
->buffer
);
3660 if (buf
/* Verify marker still points to a buffer. */
3661 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3662 /* The restriction has changed from the saved one, so restore
3663 the saved restriction. */
3665 ptrdiff_t pt
= BUF_PT (buf
);
3667 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3668 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3670 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3671 /* The point is outside the new visible range, move it inside. */
3672 SET_BUF_PT_BOTH (buf
,
3673 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3674 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3677 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3679 /* These aren't needed anymore, so don't wait for GC. */
3680 free_marker (XCAR (data
));
3681 free_marker (XCDR (data
));
3682 free_cons (XCONS (data
));
3685 /* A buffer, which means that there was no old restriction. */
3687 if (buf
/* Verify marker still points to a buffer. */
3688 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3689 /* The buffer has been narrowed, get rid of the narrowing. */
3691 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3692 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3694 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3698 /* Changing the buffer bounds invalidates any recorded current column. */
3699 invalidate_current_column ();
3702 set_buffer_internal (cur
);
3705 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3706 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3707 The buffer's restrictions make parts of the beginning and end invisible.
3708 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3709 This special form, `save-restriction', saves the current buffer's restrictions
3710 when it is entered, and restores them when it is exited.
3711 So any `narrow-to-region' within BODY lasts only until the end of the form.
3712 The old restrictions settings are restored
3713 even in case of abnormal exit (throw or error).
3715 The value returned is the value of the last form in BODY.
3717 Note: if you are using both `save-excursion' and `save-restriction',
3718 use `save-excursion' outermost:
3719 (save-excursion (save-restriction ...))
3721 usage: (save-restriction &rest BODY) */)
3724 register Lisp_Object val
;
3725 ptrdiff_t count
= SPECPDL_INDEX ();
3727 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3728 val
= Fprogn (body
);
3729 return unbind_to (count
, val
);
3732 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3733 doc
: /* Display a message at the bottom of the screen.
3734 The message also goes into the `*Messages*' buffer, if `message-log-max'
3735 is non-nil. (In keyboard macros, that's all it does.)
3738 In batch mode, the message is printed to the standard error stream,
3739 followed by a newline.
3741 The first argument is a format control string, and the rest are data
3742 to be formatted under control of the string. See `format-message' for
3745 Note: (message "%s" VALUE) displays the string VALUE without
3746 interpreting format characters like `%', `\\=`', and `\\=''.
3748 If the first argument is nil or the empty string, the function clears
3749 any existing message; this lets the minibuffer contents show. See
3750 also `current-message'.
3752 usage: (message FORMAT-STRING &rest ARGS) */)
3753 (ptrdiff_t nargs
, Lisp_Object
*args
)
3756 || (STRINGP (args
[0])
3757 && SBYTES (args
[0]) == 0))
3764 Lisp_Object val
= Fformat_message (nargs
, args
);
3770 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3771 doc
: /* Display a message, in a dialog box if possible.
3772 If a dialog box is not available, use the echo area.
3773 The first argument is a format control string, and the rest are data
3774 to be formatted under control of the string. See `format-message' for
3777 If the first argument is nil or the empty string, clear any existing
3778 message; let the minibuffer contents show.
3780 usage: (message-box FORMAT-STRING &rest ARGS) */)
3781 (ptrdiff_t nargs
, Lisp_Object
*args
)
3790 Lisp_Object val
= Fformat_message (nargs
, args
);
3791 Lisp_Object pane
, menu
;
3793 pane
= list1 (Fcons (build_string ("OK"), Qt
));
3794 menu
= Fcons (val
, pane
);
3795 Fx_popup_dialog (Qt
, menu
, Qt
);
3800 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3801 doc
: /* Display a message in a dialog box or in the echo area.
3802 If this command was invoked with the mouse, use a dialog box if
3803 `use-dialog-box' is non-nil.
3804 Otherwise, use the echo area.
3805 The first argument is a format control string, and the rest are data
3806 to be formatted under control of the string. See `format-message' for
3809 If the first argument is nil or the empty string, clear any existing
3810 message; let the minibuffer contents show.
3812 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3813 (ptrdiff_t nargs
, Lisp_Object
*args
)
3815 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3817 return Fmessage_box (nargs
, args
);
3818 return Fmessage (nargs
, args
);
3821 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3822 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3825 return current_message ();
3829 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3830 doc
: /* Return a copy of STRING with text properties added.
3831 First argument is the string to copy.
3832 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3833 properties to add to the result.
3834 usage: (propertize STRING &rest PROPERTIES) */)
3835 (ptrdiff_t nargs
, Lisp_Object
*args
)
3837 Lisp_Object properties
, string
;
3840 /* Number of args must be odd. */
3841 if ((nargs
& 1) == 0)
3842 error ("Wrong number of arguments");
3844 properties
= string
= Qnil
;
3846 /* First argument must be a string. */
3847 CHECK_STRING (args
[0]);
3848 string
= Fcopy_sequence (args
[0]);
3850 for (i
= 1; i
< nargs
; i
+= 2)
3851 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3853 Fadd_text_properties (make_number (0),
3854 make_number (SCHARS (string
)),
3855 properties
, string
);
3859 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3860 doc
: /* Format a string out of a format-string and arguments.
3861 The first argument is a format control string.
3862 The other arguments are substituted into it to make the result, a string.
3864 The format control string may contain %-sequences meaning to substitute
3865 the next available argument:
3867 %s means print a string argument. Actually, prints any object, with `princ'.
3868 %d means print as number in decimal (%o octal, %x hex).
3869 %X is like %x, but uses upper case.
3870 %e means print a number in exponential notation.
3871 %f means print a number in decimal-point notation.
3872 %g means print a number in exponential notation
3873 or decimal-point notation, whichever uses fewer characters.
3874 %c means print a number as a single character.
3875 %S means print any object as an s-expression (using `prin1').
3877 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3878 Use %% to put a single % into the output.
3880 A %-sequence may contain optional flag, width, and precision
3881 specifiers, as follows:
3883 %<flags><width><precision>character
3885 where flags is [+ #-0]+, width is [0-9]+, and precision is a literal
3886 period "." followed by [0-9]+
3888 The + flag character inserts a + before any positive number, while a
3889 space inserts a space before any positive number; these flags only
3890 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3891 The - and 0 flags affect the width specifier, as described below.
3893 The # flag means to use an alternate display form for %o, %x, %X, %e,
3894 %f, and %g sequences: for %o, it ensures that the result begins with
3895 \"0\"; for %x and %X, it prefixes the result with \"0x\" or \"0X\";
3896 for %e, %f, and %g, it causes a decimal point to be included even if
3897 the precision is zero.
3899 The width specifier supplies a lower limit for the length of the
3900 printed representation. The padding, if any, normally goes on the
3901 left, but it goes on the right if the - flag is present. The padding
3902 character is normally a space, but it is 0 if the 0 flag is present.
3903 The 0 flag is ignored if the - flag is present, or the format sequence
3904 is something other than %d, %e, %f, and %g.
3906 For %e, %f, and %g sequences, the number after the "." in the
3907 precision specifier says how many decimal places to show; if zero, the
3908 decimal point itself is omitted. For %s and %S, the precision
3909 specifier truncates the string to the given width.
3911 Text properties, if any, are copied from the format-string to the
3914 usage: (format STRING &rest OBJECTS) */)
3915 (ptrdiff_t nargs
, Lisp_Object
*args
)
3917 return styled_format (nargs
, args
, false);
3920 DEFUN ("format-message", Fformat_message
, Sformat_message
, 1, MANY
, 0,
3921 doc
: /* Format a string out of a format-string and arguments.
3922 The first argument is a format control string.
3923 The other arguments are substituted into it to make the result, a string.
3925 This acts like `format', except it also replaces each grave accent (\\=`)
3926 by a left quote, and each apostrophe (\\=') by a right quote. The left
3927 and right quote replacement characters are specified by
3928 `text-quoting-style'.
3930 usage: (format-message STRING &rest OBJECTS) */)
3931 (ptrdiff_t nargs
, Lisp_Object
*args
)
3933 return styled_format (nargs
, args
, true);
3936 /* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise. */
3939 styled_format (ptrdiff_t nargs
, Lisp_Object
*args
, bool message
)
3941 ptrdiff_t n
; /* The number of the next arg to substitute. */
3942 char initial_buffer
[4000];
3943 char *buf
= initial_buffer
;
3944 ptrdiff_t bufsize
= sizeof initial_buffer
;
3945 ptrdiff_t max_bufsize
= STRING_BYTES_BOUND
+ 1;
3947 ptrdiff_t buf_save_value_index UNINIT
;
3950 /* When we make a multibyte string, we must pay attention to the
3951 byte combining problem, i.e., a byte may be combined with a
3952 multibyte character of the previous string. This flag tells if we
3953 must consider such a situation or not. */
3954 bool maybe_combine_byte
;
3955 bool arg_intervals
= false;
3958 /* Each element records, for one argument,
3959 the start and end bytepos in the output string,
3960 whether the argument has been converted to string (e.g., due to "%S"),
3961 and whether the argument is a string with intervals. */
3964 ptrdiff_t start
, end
;
3965 bool_bf converted_to_string
: 1;
3966 bool_bf intervals
: 1;
3969 CHECK_STRING (args
[0]);
3970 char *format_start
= SSDATA (args
[0]);
3971 ptrdiff_t formatlen
= SBYTES (args
[0]);
3973 /* Allocate the info and discarded tables. */
3974 ptrdiff_t alloca_size
;
3975 if (INT_MULTIPLY_WRAPV (nargs
, sizeof *info
, &alloca_size
)
3976 || INT_ADD_WRAPV (sizeof *info
, alloca_size
, &alloca_size
)
3977 || INT_ADD_WRAPV (formatlen
, alloca_size
, &alloca_size
)
3978 || SIZE_MAX
< alloca_size
)
3979 memory_full (SIZE_MAX
);
3980 /* info[0] is unused. Unused elements have -1 for start. */
3981 info
= SAFE_ALLOCA (alloca_size
);
3982 memset (info
, 0, alloca_size
);
3983 for (ptrdiff_t i
= 0; i
< nargs
+ 1; i
++)
3985 /* discarded[I] is 1 if byte I of the format
3986 string was not copied into the output.
3987 It is 2 if byte I was not the first byte of its character. */
3988 char *discarded
= (char *) &info
[nargs
+ 1];
3990 /* Try to determine whether the result should be multibyte.
3991 This is not always right; sometimes the result needs to be multibyte
3992 because of an object that we will pass through prin1.
3993 or because a grave accent or apostrophe is requoted,
3994 and in that case, we won't know it here. */
3996 /* True if the format is multibyte. */
3997 bool multibyte_format
= STRING_MULTIBYTE (args
[0]);
3998 /* True if the output should be a multibyte string,
3999 which is true if any of the inputs is one. */
4000 bool multibyte
= multibyte_format
;
4001 for (ptrdiff_t i
= 1; !multibyte
&& i
< nargs
; i
++)
4002 if (STRINGP (args
[i
]) && STRING_MULTIBYTE (args
[i
]))
4005 int quoting_style
= message
? text_quoting_style () : -1;
4007 /* If we start out planning a unibyte result,
4008 then discover it has to be multibyte, we jump back to retry. */
4015 /* Scan the format and store result in BUF. */
4016 format
= format_start
;
4017 end
= format
+ formatlen
;
4018 maybe_combine_byte
= false;
4020 while (format
!= end
)
4022 /* The values of N and FORMAT when the loop body is entered. */
4024 char *format0
= format
;
4025 char const *convsrc
= format
;
4026 unsigned char format_char
= *format
++;
4028 /* Bytes needed to represent the output of this conversion. */
4029 ptrdiff_t convbytes
= 1;
4031 if (format_char
== '%')
4033 /* General format specifications look like
4035 '%' [flags] [field-width] [precision] format
4040 field-width ::= [0-9]+
4041 precision ::= '.' [0-9]*
4043 If a field-width is specified, it specifies to which width
4044 the output should be padded with blanks, if the output
4045 string is shorter than field-width.
4047 If precision is specified, it specifies the number of
4048 digits to print after the '.' for floats, or the max.
4049 number of chars to print from a string. */
4051 bool minus_flag
= false;
4052 bool plus_flag
= false;
4053 bool space_flag
= false;
4054 bool sharp_flag
= false;
4055 bool zero_flag
= false;
4061 case '-': minus_flag
= true; continue;
4062 case '+': plus_flag
= true; continue;
4063 case ' ': space_flag
= true; continue;
4064 case '#': sharp_flag
= true; continue;
4065 case '0': zero_flag
= true; continue;
4070 /* Ignore flags when sprintf ignores them. */
4071 space_flag
&= ~ plus_flag
;
4072 zero_flag
&= ~ minus_flag
;
4075 uintmax_t raw_field_width
= strtoumax (format
, &num_end
, 10);
4076 if (max_bufsize
<= raw_field_width
)
4078 ptrdiff_t field_width
= raw_field_width
;
4080 bool precision_given
= *num_end
== '.';
4081 uintmax_t precision
= (precision_given
4082 ? strtoumax (num_end
+ 1, &num_end
, 10)
4087 error ("Format string ends in middle of format specifier");
4089 char conversion
= *format
++;
4090 memset (&discarded
[format0
- format_start
], 1,
4091 format
- format0
- (conversion
== '%'));
4092 if (conversion
== '%')
4097 error ("Not enough arguments for format string");
4099 /* For 'S', prin1 the argument, and then treat like 's'.
4100 For 's', princ any argument that is not a string or
4101 symbol. But don't do this conversion twice, which might
4102 happen after retrying. */
4103 if ((conversion
== 'S'
4104 || (conversion
== 's'
4105 && ! STRINGP (args
[n
]) && ! SYMBOLP (args
[n
]))))
4107 if (! info
[n
].converted_to_string
)
4109 Lisp_Object noescape
= conversion
== 'S' ? Qnil
: Qt
;
4110 args
[n
] = Fprin1_to_string (args
[n
], noescape
);
4111 info
[n
].converted_to_string
= true;
4112 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
4120 else if (conversion
== 'c')
4122 if (INTEGERP (args
[n
]) && ! ASCII_CHAR_P (XINT (args
[n
])))
4129 args
[n
] = Fchar_to_string (args
[n
]);
4130 info
[n
].converted_to_string
= true;
4133 if (info
[n
].converted_to_string
)
4138 if (SYMBOLP (args
[n
]))
4140 args
[n
] = SYMBOL_NAME (args
[n
]);
4141 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
4148 bool float_conversion
4149 = conversion
== 'e' || conversion
== 'f' || conversion
== 'g';
4151 if (conversion
== 's')
4153 /* handle case (precision[n] >= 0) */
4155 ptrdiff_t prec
= -1;
4156 if (precision_given
&& precision
<= TYPE_MAXIMUM (ptrdiff_t))
4159 /* lisp_string_width ignores a precision of 0, but GNU
4160 libc functions print 0 characters when the precision
4161 is 0. Imitate libc behavior here. Changing
4162 lisp_string_width is the right thing, and will be
4163 done, but meanwhile we work with it. */
4165 ptrdiff_t width
, nbytes
;
4166 ptrdiff_t nchars_string
;
4168 width
= nchars_string
= nbytes
= 0;
4172 width
= lisp_string_width (args
[n
], prec
, &nch
, &nby
);
4175 nchars_string
= SCHARS (args
[n
]);
4176 nbytes
= SBYTES (args
[n
]);
4180 nchars_string
= nch
;
4186 if (convbytes
&& multibyte
&& ! STRING_MULTIBYTE (args
[n
]))
4187 convbytes
= count_size_as_multibyte (SDATA (args
[n
]), nbytes
);
4190 = width
< field_width
? field_width
- width
: 0;
4192 if (max_bufsize
- padding
<= convbytes
)
4194 convbytes
+= padding
;
4195 if (convbytes
<= buf
+ bufsize
- p
)
4199 memset (p
, ' ', padding
);
4203 info
[n
].start
= nchars
;
4207 && !ASCII_CHAR_P (*((unsigned char *) p
- 1))
4208 && STRING_MULTIBYTE (args
[n
])
4209 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
4210 maybe_combine_byte
= true;
4212 p
+= copy_text (SDATA (args
[n
]), (unsigned char *) p
,
4214 STRING_MULTIBYTE (args
[n
]), multibyte
);
4216 nchars
+= nchars_string
;
4220 memset (p
, ' ', padding
);
4224 info
[n
].end
= nchars
;
4226 /* If this argument has text properties, record where
4227 in the result string it appears. */
4228 if (string_intervals (args
[n
]))
4229 info
[n
].intervals
= arg_intervals
= true;
4234 else if (! (conversion
== 'c' || conversion
== 'd'
4235 || float_conversion
|| conversion
== 'i'
4236 || conversion
== 'o' || conversion
== 'x'
4237 || conversion
== 'X'))
4238 error ("Invalid format operation %%%c",
4239 STRING_CHAR ((unsigned char *) format
- 1));
4240 else if (! (INTEGERP (args
[n
])
4241 || (FLOATP (args
[n
]) && conversion
!= 'c')))
4242 error ("Format specifier doesn't match argument type");
4247 /* Lower bound on the number of bits per
4248 base-FLT_RADIX digit. */
4249 DIG_BITS_LBOUND
= FLT_RADIX
< 16 ? 1 : 4,
4251 /* 1 if integers should be formatted as long doubles,
4252 because they may be so large that there is a rounding
4253 error when converting them to double, and long doubles
4254 are wider than doubles. */
4255 INT_AS_LDBL
= (DIG_BITS_LBOUND
* DBL_MANT_DIG
< FIXNUM_BITS
- 1
4256 && DBL_MANT_DIG
< LDBL_MANT_DIG
),
4258 /* Maximum precision for a %f conversion such that the
4259 trailing output digit might be nonzero. Any precision
4260 larger than this will not yield useful information. */
4261 USEFUL_PRECISION_MAX
=
4263 * (FLT_RADIX
== 2 || FLT_RADIX
== 10 ? 1
4264 : FLT_RADIX
== 16 ? 4
4267 /* Maximum number of bytes generated by any format, if
4268 precision is no more than USEFUL_PRECISION_MAX.
4269 On all practical hosts, %f is the worst case. */
4271 sizeof "-." + (LDBL_MAX_10_EXP
+ 1) + USEFUL_PRECISION_MAX
,
4273 /* Length of pM (that is, of pMd without the
4275 pMlen
= sizeof pMd
- 2
4277 verify (USEFUL_PRECISION_MAX
> 0);
4279 /* Avoid undefined behavior in underlying sprintf. */
4280 if (conversion
== 'd' || conversion
== 'i')
4283 /* Create the copy of the conversion specification, with
4284 any width and precision removed, with ".*" inserted,
4285 with "L" possibly inserted for floating-point formats,
4286 and with pM inserted for integer formats.
4287 At most two flags F can be specified at once. */
4288 char convspec
[sizeof "%FF.*d" + max (INT_AS_LDBL
, pMlen
)];
4292 /* MINUS_FLAG and ZERO_FLAG are dealt with later. */
4293 *f
= '+'; f
+= plus_flag
;
4294 *f
= ' '; f
+= space_flag
;
4295 *f
= '#'; f
+= sharp_flag
;
4298 if (float_conversion
)
4303 f
+= INTEGERP (args
[n
]);
4306 else if (conversion
!= 'c')
4308 memcpy (f
, pMd
, pMlen
);
4310 zero_flag
&= ~ precision_given
;
4317 if (precision_given
)
4318 prec
= min (precision
, USEFUL_PRECISION_MAX
);
4320 /* Use sprintf to format this number into sprintf_buf. Omit
4321 padding and excess precision, though, because sprintf limits
4322 output length to INT_MAX.
4324 There are four types of conversion: double, unsigned
4325 char (passed as int), wide signed int, and wide
4326 unsigned int. Treat them separately because the
4327 sprintf ABI is sensitive to which type is passed. Be
4328 careful about integer overflow, NaNs, infinities, and
4329 conversions; for example, the min and max macros are
4330 not suitable here. */
4331 char sprintf_buf
[SPRINTF_BUFSIZE
];
4332 ptrdiff_t sprintf_bytes
;
4333 if (float_conversion
)
4335 if (INT_AS_LDBL
&& INTEGERP (args
[n
]))
4337 /* Although long double may have a rounding error if
4338 DIG_BITS_LBOUND * LDBL_MANT_DIG < FIXNUM_BITS - 1,
4339 it is more accurate than plain 'double'. */
4340 long double x
= XINT (args
[n
]);
4341 sprintf_bytes
= sprintf (sprintf_buf
, convspec
, prec
, x
);
4344 sprintf_bytes
= sprintf (sprintf_buf
, convspec
, prec
,
4345 XFLOATINT (args
[n
]));
4347 else if (conversion
== 'c')
4349 /* Don't use sprintf here, as it might mishandle prec. */
4350 sprintf_buf
[0] = XINT (args
[n
]);
4351 sprintf_bytes
= prec
!= 0;
4353 else if (conversion
== 'd')
4355 /* For float, maybe we should use "%1.0f"
4356 instead so it also works for values outside
4357 the integer range. */
4359 if (INTEGERP (args
[n
]))
4363 double d
= XFLOAT_DATA (args
[n
]);
4366 x
= TYPE_MINIMUM (printmax_t
);
4372 x
= TYPE_MAXIMUM (printmax_t
);
4377 sprintf_bytes
= sprintf (sprintf_buf
, convspec
, prec
, x
);
4381 /* Don't sign-extend for octal or hex printing. */
4383 if (INTEGERP (args
[n
]))
4384 x
= XUINT (args
[n
]);
4387 double d
= XFLOAT_DATA (args
[n
]);
4392 x
= TYPE_MAXIMUM (uprintmax_t
);
4397 sprintf_bytes
= sprintf (sprintf_buf
, convspec
, prec
, x
);
4400 /* Now the length of the formatted item is known, except it omits
4401 padding and excess precision. Deal with excess precision
4402 first. This happens only when the format specifies
4403 ridiculously large precision. */
4404 uintmax_t excess_precision
= precision
- prec
;
4405 uintmax_t leading_zeros
= 0, trailing_zeros
= 0;
4406 if (excess_precision
)
4408 if (float_conversion
)
4410 if ((conversion
== 'g' && ! sharp_flag
)
4411 || ! ('0' <= sprintf_buf
[sprintf_bytes
- 1]
4412 && sprintf_buf
[sprintf_bytes
- 1] <= '9'))
4413 excess_precision
= 0;
4416 if (conversion
== 'g')
4418 char *dot
= strchr (sprintf_buf
, '.');
4420 excess_precision
= 0;
4423 trailing_zeros
= excess_precision
;
4426 leading_zeros
= excess_precision
;
4429 /* Compute the total bytes needed for this item, including
4430 excess precision and padding. */
4431 uintmax_t numwidth
= sprintf_bytes
+ excess_precision
;
4433 = numwidth
< field_width
? field_width
- numwidth
: 0;
4434 if (max_bufsize
- sprintf_bytes
<= excess_precision
4435 || max_bufsize
- padding
<= numwidth
)
4437 convbytes
= numwidth
+ padding
;
4439 if (convbytes
<= buf
+ bufsize
- p
)
4441 /* Copy the formatted item from sprintf_buf into buf,
4442 inserting padding and excess-precision zeros. */
4444 char *src
= sprintf_buf
;
4446 int exponent_bytes
= 0;
4447 bool signedp
= src0
== '-' || src0
== '+' || src0
== ' ';
4449 && ((src
[signedp
] >= '0' && src
[signedp
] <= '9')
4450 || (src
[signedp
] >= 'a' && src
[signedp
] <= 'f')
4451 || (src
[signedp
] >= 'A' && src
[signedp
] <= 'F')))
4453 leading_zeros
+= padding
;
4457 if (excess_precision
4458 && (conversion
== 'e' || conversion
== 'g'))
4460 char *e
= strchr (src
, 'e');
4462 exponent_bytes
= src
+ sprintf_bytes
- e
;
4465 info
[n
].start
= nchars
;
4468 memset (p
, ' ', padding
);
4476 memset (p
, '0', leading_zeros
);
4478 int significand_bytes
4479 = sprintf_bytes
- signedp
- exponent_bytes
;
4480 memcpy (p
, src
, significand_bytes
);
4481 p
+= significand_bytes
;
4482 src
+= significand_bytes
;
4483 memset (p
, '0', trailing_zeros
);
4484 p
+= trailing_zeros
;
4485 memcpy (p
, src
, exponent_bytes
);
4486 p
+= exponent_bytes
;
4488 nchars
+= leading_zeros
+ sprintf_bytes
+ trailing_zeros
;
4492 memset (p
, ' ', padding
);
4496 info
[n
].end
= nchars
;
4504 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
4506 if ((format_char
== '`' || format_char
== '\'')
4507 && quoting_style
== CURVE_QUOTING_STYLE
)
4514 convsrc
= format_char
== '`' ? uLSQM
: uRSQM
;
4517 else if (format_char
== '`' && quoting_style
== STRAIGHT_QUOTING_STYLE
)
4521 /* Copy a single character from format to buf. */
4522 if (multibyte_format
)
4524 /* Copy a whole multibyte character. */
4526 && !ASCII_CHAR_P (*((unsigned char *) p
- 1))
4527 && !CHAR_HEAD_P (format_char
))
4528 maybe_combine_byte
= true;
4530 while (! CHAR_HEAD_P (*format
))
4533 convbytes
= format
- format0
;
4534 memset (&discarded
[format0
+ 1 - format_start
], 2,
4537 else if (multibyte
&& !ASCII_CHAR_P (format_char
))
4539 int c
= BYTE8_TO_CHAR (format_char
);
4540 convbytes
= CHAR_STRING (c
, str
);
4541 convsrc
= (char *) str
;
4546 if (convbytes
<= buf
+ bufsize
- p
)
4548 memcpy (p
, convsrc
, convbytes
);
4555 /* There wasn't enough room to store this conversion or single
4556 character. CONVBYTES says how much room is needed. Allocate
4557 enough room (and then some) and do it again. */
4559 ptrdiff_t used
= p
- buf
;
4560 if (max_bufsize
- used
< convbytes
)
4562 bufsize
= used
+ convbytes
;
4563 bufsize
= bufsize
< max_bufsize
/ 2 ? bufsize
* 2 : max_bufsize
;
4565 if (buf
== initial_buffer
)
4567 buf
= xmalloc (bufsize
);
4568 sa_must_free
= true;
4569 buf_save_value_index
= SPECPDL_INDEX ();
4570 record_unwind_protect_ptr (xfree
, buf
);
4571 memcpy (buf
, initial_buffer
, used
);
4575 buf
= xrealloc (buf
, bufsize
);
4576 set_unwind_protect_ptr (buf_save_value_index
, xfree
, buf
);
4584 if (bufsize
< p
- buf
)
4587 if (maybe_combine_byte
)
4588 nchars
= multibyte_chars_in_text ((unsigned char *) buf
, p
- buf
);
4589 Lisp_Object val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4591 /* If the format string has text properties, or any of the string
4592 arguments has text properties, set up text properties of the
4595 if (string_intervals (args
[0]) || arg_intervals
)
4597 /* Add text properties from the format string. */
4598 Lisp_Object len
= make_number (SCHARS (args
[0]));
4599 Lisp_Object props
= text_property_list (args
[0], make_number (0),
4603 ptrdiff_t bytepos
= 0, position
= 0, translated
= 0;
4606 /* Adjust the bounds of each text property
4607 to the proper start and end in the output string. */
4609 /* Put the positions in PROPS in increasing order, so that
4610 we can do (effectively) one scan through the position
4611 space of the format string. */
4612 props
= Fnreverse (props
);
4614 /* BYTEPOS is the byte position in the format string,
4615 POSITION is the untranslated char position in it,
4616 TRANSLATED is the translated char position in BUF,
4617 and ARGN is the number of the next arg we will come to. */
4618 for (Lisp_Object list
= props
; CONSP (list
); list
= XCDR (list
))
4620 Lisp_Object item
= XCAR (list
);
4622 /* First adjust the property start position. */
4623 ptrdiff_t pos
= XINT (XCAR (item
));
4625 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4626 up to this position. */
4627 for (; position
< pos
; bytepos
++)
4629 if (! discarded
[bytepos
])
4630 position
++, translated
++;
4631 else if (discarded
[bytepos
] == 1)
4634 if (translated
== info
[argn
].start
)
4636 translated
+= info
[argn
].end
- info
[argn
].start
;
4642 XSETCAR (item
, make_number (translated
));
4644 /* Likewise adjust the property end position. */
4645 pos
= XINT (XCAR (XCDR (item
)));
4647 for (; position
< pos
; bytepos
++)
4649 if (! discarded
[bytepos
])
4650 position
++, translated
++;
4651 else if (discarded
[bytepos
] == 1)
4654 if (translated
== info
[argn
].start
)
4656 translated
+= info
[argn
].end
- info
[argn
].start
;
4662 XSETCAR (XCDR (item
), make_number (translated
));
4665 add_text_properties_from_list (val
, props
, make_number (0));
4668 /* Add text properties from arguments. */
4670 for (ptrdiff_t i
= 1; i
< nargs
; i
++)
4671 if (info
[i
].intervals
)
4673 len
= make_number (SCHARS (args
[i
]));
4674 Lisp_Object new_len
= make_number (info
[i
].end
- info
[i
].start
);
4675 props
= text_property_list (args
[i
], make_number (0), len
, Qnil
);
4676 props
= extend_property_ranges (props
, len
, new_len
);
4677 /* If successive arguments have properties, be sure that
4678 the value of `composition' property be the copy. */
4679 if (1 < i
&& info
[i
- 1].end
)
4680 make_composition_value_copy (props
);
4681 add_text_properties_from_list (val
, props
,
4682 make_number (info
[i
].start
));
4686 /* If we allocated BUF or INFO with malloc, free it too. */
4692 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4693 doc
: /* Return t if two characters match, optionally ignoring case.
4694 Both arguments must be characters (i.e. integers).
4695 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4696 (register Lisp_Object c1
, Lisp_Object c2
)
4699 /* Check they're chars, not just integers, otherwise we could get array
4700 bounds violations in downcase. */
4701 CHECK_CHARACTER (c1
);
4702 CHECK_CHARACTER (c2
);
4704 if (XINT (c1
) == XINT (c2
))
4706 if (NILP (BVAR (current_buffer
, case_fold_search
)))
4712 /* FIXME: It is possible to compare multibyte characters even when
4713 the current buffer is unibyte. Unfortunately this is ambiguous
4714 for characters between 128 and 255, as they could be either
4715 eight-bit raw bytes or Latin-1 characters. Assume the former for
4716 now. See Bug#17011, and also see casefiddle.c's casify_object,
4717 which has a similar problem. */
4718 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4720 if (SINGLE_BYTE_CHAR_P (i1
))
4721 i1
= UNIBYTE_TO_CHAR (i1
);
4722 if (SINGLE_BYTE_CHAR_P (i2
))
4723 i2
= UNIBYTE_TO_CHAR (i2
);
4726 return (downcase (i1
) == downcase (i2
) ? Qt
: Qnil
);
4729 /* Transpose the markers in two regions of the current buffer, and
4730 adjust the ones between them if necessary (i.e.: if the regions
4733 START1, END1 are the character positions of the first region.
4734 START1_BYTE, END1_BYTE are the byte positions.
4735 START2, END2 are the character positions of the second region.
4736 START2_BYTE, END2_BYTE are the byte positions.
4738 Traverses the entire marker list of the buffer to do so, adding an
4739 appropriate amount to some, subtracting from some, and leaving the
4740 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4742 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4745 transpose_markers (ptrdiff_t start1
, ptrdiff_t end1
,
4746 ptrdiff_t start2
, ptrdiff_t end2
,
4747 ptrdiff_t start1_byte
, ptrdiff_t end1_byte
,
4748 ptrdiff_t start2_byte
, ptrdiff_t end2_byte
)
4750 register ptrdiff_t amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4751 register struct Lisp_Marker
*marker
;
4753 /* Update point as if it were a marker. */
4757 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4758 PT_BYTE
+ (end2_byte
- end1_byte
));
4759 else if (PT
< start2
)
4760 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4761 (PT_BYTE
+ (end2_byte
- start2_byte
)
4762 - (end1_byte
- start1_byte
)));
4764 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4765 PT_BYTE
- (start2_byte
- start1_byte
));
4767 /* We used to adjust the endpoints here to account for the gap, but that
4768 isn't good enough. Even if we assume the caller has tried to move the
4769 gap out of our way, it might still be at start1 exactly, for example;
4770 and that places it `inside' the interval, for our purposes. The amount
4771 of adjustment is nontrivial if there's a `denormalized' marker whose
4772 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4773 the dirty work to Fmarker_position, below. */
4775 /* The difference between the region's lengths */
4776 diff
= (end2
- start2
) - (end1
- start1
);
4777 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4779 /* For shifting each marker in a region by the length of the other
4780 region plus the distance between the regions. */
4781 amt1
= (end2
- start2
) + (start2
- end1
);
4782 amt2
= (end1
- start1
) + (start2
- end1
);
4783 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4784 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4786 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4788 mpos
= marker
->bytepos
;
4789 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4791 if (mpos
< end1_byte
)
4793 else if (mpos
< start2_byte
)
4797 marker
->bytepos
= mpos
;
4799 mpos
= marker
->charpos
;
4800 if (mpos
>= start1
&& mpos
< end2
)
4804 else if (mpos
< start2
)
4809 marker
->charpos
= mpos
;
4813 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4814 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4815 The regions should not be overlapping, because the size of the buffer is
4816 never changed in a transposition.
4818 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4819 any markers that happen to be located in the regions.
4821 Transposing beyond buffer boundaries is an error. */)
4822 (Lisp_Object startr1
, Lisp_Object endr1
, Lisp_Object startr2
, Lisp_Object endr2
, Lisp_Object leave_markers
)
4824 register ptrdiff_t start1
, end1
, start2
, end2
;
4825 ptrdiff_t start1_byte
, start2_byte
, len1_byte
, len2_byte
, end2_byte
;
4826 ptrdiff_t gap
, len1
, len_mid
, len2
;
4827 unsigned char *start1_addr
, *start2_addr
, *temp
;
4829 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4832 XSETBUFFER (buf
, current_buffer
);
4833 cur_intv
= buffer_intervals (current_buffer
);
4835 validate_region (&startr1
, &endr1
);
4836 validate_region (&startr2
, &endr2
);
4838 start1
= XFASTINT (startr1
);
4839 end1
= XFASTINT (endr1
);
4840 start2
= XFASTINT (startr2
);
4841 end2
= XFASTINT (endr2
);
4844 /* Swap the regions if they're reversed. */
4847 register ptrdiff_t glumph
= start1
;
4855 len1
= end1
- start1
;
4856 len2
= end2
- start2
;
4859 error ("Transposed regions overlap");
4860 /* Nothing to change for adjacent regions with one being empty */
4861 else if ((start1
== end1
|| start2
== end2
) && end1
== start2
)
4864 /* The possibilities are:
4865 1. Adjacent (contiguous) regions, or separate but equal regions
4866 (no, really equal, in this case!), or
4867 2. Separate regions of unequal size.
4869 The worst case is usually No. 2. It means that (aside from
4870 potential need for getting the gap out of the way), there also
4871 needs to be a shifting of the text between the two regions. So
4872 if they are spread far apart, we are that much slower... sigh. */
4874 /* It must be pointed out that the really studly thing to do would
4875 be not to move the gap at all, but to leave it in place and work
4876 around it if necessary. This would be extremely efficient,
4877 especially considering that people are likely to do
4878 transpositions near where they are working interactively, which
4879 is exactly where the gap would be found. However, such code
4880 would be much harder to write and to read. So, if you are
4881 reading this comment and are feeling squirrely, by all means have
4882 a go! I just didn't feel like doing it, so I will simply move
4883 the gap the minimum distance to get it out of the way, and then
4884 deal with an unbroken array. */
4886 start1_byte
= CHAR_TO_BYTE (start1
);
4887 end2_byte
= CHAR_TO_BYTE (end2
);
4889 /* Make sure the gap won't interfere, by moving it out of the text
4890 we will operate on. */
4891 if (start1
< gap
&& gap
< end2
)
4893 if (gap
- start1
< end2
- gap
)
4894 move_gap_both (start1
, start1_byte
);
4896 move_gap_both (end2
, end2_byte
);
4899 start2_byte
= CHAR_TO_BYTE (start2
);
4900 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4901 len2_byte
= end2_byte
- start2_byte
;
4903 #ifdef BYTE_COMBINING_DEBUG
4906 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4907 len2_byte
, start1
, start1_byte
)
4908 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4909 len1_byte
, end2
, start2_byte
+ len2_byte
)
4910 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4911 len1_byte
, end2
, start2_byte
+ len2_byte
))
4916 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4917 len2_byte
, start1
, start1_byte
)
4918 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4919 len1_byte
, start2
, start2_byte
)
4920 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4921 len2_byte
, end1
, start1_byte
+ len1_byte
)
4922 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4923 len1_byte
, end2
, start2_byte
+ len2_byte
))
4928 /* Hmmm... how about checking to see if the gap is large
4929 enough to use as the temporary storage? That would avoid an
4930 allocation... interesting. Later, don't fool with it now. */
4932 /* Working without memmove, for portability (sigh), so must be
4933 careful of overlapping subsections of the array... */
4935 if (end1
== start2
) /* adjacent regions */
4937 modify_text (start1
, end2
);
4938 record_change (start1
, len1
+ len2
);
4940 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4941 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4942 /* Don't use Fset_text_properties: that can cause GC, which can
4943 clobber objects stored in the tmp_intervals. */
4944 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4946 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4950 /* First region smaller than second. */
4951 if (len1_byte
< len2_byte
)
4953 temp
= SAFE_ALLOCA (len2_byte
);
4955 /* Don't precompute these addresses. We have to compute them
4956 at the last minute, because the relocating allocator might
4957 have moved the buffer around during the xmalloc. */
4958 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4959 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4961 memcpy (temp
, start2_addr
, len2_byte
);
4962 memcpy (start1_addr
+ len2_byte
, start1_addr
, len1_byte
);
4963 memcpy (start1_addr
, temp
, len2_byte
);
4966 /* First region not smaller than second. */
4968 temp
= SAFE_ALLOCA (len1_byte
);
4969 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4970 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4971 memcpy (temp
, start1_addr
, len1_byte
);
4972 memcpy (start1_addr
, start2_addr
, len2_byte
);
4973 memcpy (start1_addr
+ len2_byte
, temp
, len1_byte
);
4977 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4978 len1
, current_buffer
, 0);
4979 graft_intervals_into_buffer (tmp_interval2
, start1
,
4980 len2
, current_buffer
, 0);
4981 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4982 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4984 /* Non-adjacent regions, because end1 != start2, bleagh... */
4987 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4989 if (len1_byte
== len2_byte
)
4990 /* Regions are same size, though, how nice. */
4994 modify_text (start1
, end1
);
4995 modify_text (start2
, end2
);
4996 record_change (start1
, len1
);
4997 record_change (start2
, len2
);
4998 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4999 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
5001 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
5003 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
5005 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
5007 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
5009 temp
= SAFE_ALLOCA (len1_byte
);
5010 start1_addr
= BYTE_POS_ADDR (start1_byte
);
5011 start2_addr
= BYTE_POS_ADDR (start2_byte
);
5012 memcpy (temp
, start1_addr
, len1_byte
);
5013 memcpy (start1_addr
, start2_addr
, len2_byte
);
5014 memcpy (start2_addr
, temp
, len1_byte
);
5017 graft_intervals_into_buffer (tmp_interval1
, start2
,
5018 len1
, current_buffer
, 0);
5019 graft_intervals_into_buffer (tmp_interval2
, start1
,
5020 len2
, current_buffer
, 0);
5023 else if (len1_byte
< len2_byte
) /* Second region larger than first */
5024 /* Non-adjacent & unequal size, area between must also be shifted. */
5028 modify_text (start1
, end2
);
5029 record_change (start1
, (end2
- start1
));
5030 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
5031 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
5032 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
5034 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
5036 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
5038 /* holds region 2 */
5039 temp
= SAFE_ALLOCA (len2_byte
);
5040 start1_addr
= BYTE_POS_ADDR (start1_byte
);
5041 start2_addr
= BYTE_POS_ADDR (start2_byte
);
5042 memcpy (temp
, start2_addr
, len2_byte
);
5043 memcpy (start1_addr
+ len_mid
+ len2_byte
, start1_addr
, len1_byte
);
5044 memmove (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
5045 memcpy (start1_addr
, temp
, len2_byte
);
5048 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
5049 len1
, current_buffer
, 0);
5050 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
5051 len_mid
, current_buffer
, 0);
5052 graft_intervals_into_buffer (tmp_interval2
, start1
,
5053 len2
, current_buffer
, 0);
5056 /* Second region smaller than first. */
5060 record_change (start1
, (end2
- start1
));
5061 modify_text (start1
, end2
);
5063 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
5064 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
5065 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
5067 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
5069 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
5071 /* holds region 1 */
5072 temp
= SAFE_ALLOCA (len1_byte
);
5073 start1_addr
= BYTE_POS_ADDR (start1_byte
);
5074 start2_addr
= BYTE_POS_ADDR (start2_byte
);
5075 memcpy (temp
, start1_addr
, len1_byte
);
5076 memcpy (start1_addr
, start2_addr
, len2_byte
);
5077 memmove (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
5078 memcpy (start1_addr
+ len2_byte
+ len_mid
, temp
, len1_byte
);
5081 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
5082 len1
, current_buffer
, 0);
5083 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
5084 len_mid
, current_buffer
, 0);
5085 graft_intervals_into_buffer (tmp_interval2
, start1
,
5086 len2
, current_buffer
, 0);
5089 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
5090 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
5093 /* When doing multiple transpositions, it might be nice
5094 to optimize this. Perhaps the markers in any one buffer
5095 should be organized in some sorted data tree. */
5096 if (NILP (leave_markers
))
5098 transpose_markers (start1
, end1
, start2
, end2
,
5099 start1_byte
, start1_byte
+ len1_byte
,
5100 start2_byte
, start2_byte
+ len2_byte
);
5101 fix_start_end_in_overlays (start1
, end2
);
5105 /* The character positions of the markers remain intact, but we
5106 still need to update their byte positions, because the
5107 transposed regions might include multibyte sequences which
5108 make some original byte positions of the markers invalid. */
5109 adjust_markers_bytepos (start1
, start1_byte
, end2
, end2_byte
, 0);
5112 signal_after_change (start1
, end2
- start1
, end2
- start1
);
5118 syms_of_editfns (void)
5120 DEFSYM (Qbuffer_access_fontify_functions
, "buffer-access-fontify-functions");
5121 DEFSYM (Qwall
, "wall");
5123 DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion
,
5124 doc
: /* Non-nil means text motion commands don't notice fields. */);
5125 Vinhibit_field_text_motion
= Qnil
;
5127 DEFVAR_LISP ("buffer-access-fontify-functions",
5128 Vbuffer_access_fontify_functions
,
5129 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
5130 Each function is called with two arguments which specify the range
5131 of the buffer being accessed. */);
5132 Vbuffer_access_fontify_functions
= Qnil
;
5136 obuf
= Fcurrent_buffer ();
5137 /* Do this here, because init_buffer_once is too early--it won't work. */
5138 Fset_buffer (Vprin1_to_string_buffer
);
5139 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
5140 Fset (Fmake_local_variable (Qbuffer_access_fontify_functions
), Qnil
);
5144 DEFVAR_LISP ("buffer-access-fontified-property",
5145 Vbuffer_access_fontified_property
,
5146 doc
: /* Property which (if non-nil) indicates text has been fontified.
5147 `buffer-substring' need not call the `buffer-access-fontify-functions'
5148 functions if all the text being accessed has this property. */);
5149 Vbuffer_access_fontified_property
= Qnil
;
5151 DEFVAR_LISP ("system-name", Vsystem_name
,
5152 doc
: /* The host name of the machine Emacs is running on. */);
5153 Vsystem_name
= cached_system_name
= Qnil
;
5155 DEFVAR_LISP ("user-full-name", Vuser_full_name
,
5156 doc
: /* The full name of the user logged in. */);
5158 DEFVAR_LISP ("user-login-name", Vuser_login_name
,
5159 doc
: /* The user's name, taken from environment variables if possible. */);
5160 Vuser_login_name
= Qnil
;
5162 DEFVAR_LISP ("user-real-login-name", Vuser_real_login_name
,
5163 doc
: /* The user's name, based upon the real uid only. */);
5165 DEFVAR_LISP ("operating-system-release", Voperating_system_release
,
5166 doc
: /* The release of the operating system Emacs is running on. */);
5168 defsubr (&Spropertize
);
5169 defsubr (&Schar_equal
);
5170 defsubr (&Sgoto_char
);
5171 defsubr (&Sstring_to_char
);
5172 defsubr (&Schar_to_string
);
5173 defsubr (&Sbyte_to_string
);
5174 defsubr (&Sbuffer_substring
);
5175 defsubr (&Sbuffer_substring_no_properties
);
5176 defsubr (&Sbuffer_string
);
5177 defsubr (&Sget_pos_property
);
5179 defsubr (&Spoint_marker
);
5180 defsubr (&Smark_marker
);
5182 defsubr (&Sregion_beginning
);
5183 defsubr (&Sregion_end
);
5185 /* Symbol for the text property used to mark fields. */
5186 DEFSYM (Qfield
, "field");
5188 /* A special value for Qfield properties. */
5189 DEFSYM (Qboundary
, "boundary");
5191 defsubr (&Sfield_beginning
);
5192 defsubr (&Sfield_end
);
5193 defsubr (&Sfield_string
);
5194 defsubr (&Sfield_string_no_properties
);
5195 defsubr (&Sdelete_field
);
5196 defsubr (&Sconstrain_to_field
);
5198 defsubr (&Sline_beginning_position
);
5199 defsubr (&Sline_end_position
);
5201 defsubr (&Ssave_excursion
);
5202 defsubr (&Ssave_current_buffer
);
5204 defsubr (&Sbuffer_size
);
5205 defsubr (&Spoint_max
);
5206 defsubr (&Spoint_min
);
5207 defsubr (&Spoint_min_marker
);
5208 defsubr (&Spoint_max_marker
);
5209 defsubr (&Sgap_position
);
5210 defsubr (&Sgap_size
);
5211 defsubr (&Sposition_bytes
);
5212 defsubr (&Sbyte_to_position
);
5218 defsubr (&Sfollowing_char
);
5219 defsubr (&Sprevious_char
);
5220 defsubr (&Schar_after
);
5221 defsubr (&Schar_before
);
5223 defsubr (&Sinsert_before_markers
);
5224 defsubr (&Sinsert_and_inherit
);
5225 defsubr (&Sinsert_and_inherit_before_markers
);
5226 defsubr (&Sinsert_char
);
5227 defsubr (&Sinsert_byte
);
5229 defsubr (&Suser_login_name
);
5230 defsubr (&Suser_real_login_name
);
5231 defsubr (&Suser_uid
);
5232 defsubr (&Suser_real_uid
);
5233 defsubr (&Sgroup_gid
);
5234 defsubr (&Sgroup_real_gid
);
5235 defsubr (&Suser_full_name
);
5236 defsubr (&Semacs_pid
);
5237 defsubr (&Scurrent_time
);
5238 defsubr (&Stime_add
);
5239 defsubr (&Stime_subtract
);
5240 defsubr (&Stime_less_p
);
5241 defsubr (&Sget_internal_run_time
);
5242 defsubr (&Sformat_time_string
);
5243 defsubr (&Sfloat_time
);
5244 defsubr (&Sdecode_time
);
5245 defsubr (&Sencode_time
);
5246 defsubr (&Scurrent_time_string
);
5247 defsubr (&Scurrent_time_zone
);
5248 defsubr (&Sset_time_zone_rule
);
5249 defsubr (&Ssystem_name
);
5250 defsubr (&Smessage
);
5251 defsubr (&Smessage_box
);
5252 defsubr (&Smessage_or_box
);
5253 defsubr (&Scurrent_message
);
5255 defsubr (&Sformat_message
);
5257 defsubr (&Sinsert_buffer_substring
);
5258 defsubr (&Scompare_buffer_substrings
);
5259 defsubr (&Ssubst_char_in_region
);
5260 defsubr (&Stranslate_region_internal
);
5261 defsubr (&Sdelete_region
);
5262 defsubr (&Sdelete_and_extract_region
);
5264 defsubr (&Snarrow_to_region
);
5265 defsubr (&Ssave_restriction
);
5266 defsubr (&Stranspose_regions
);