1 /* Lisp functions pertaining to editing. -*- coding: utf-8 -*-
3 Copyright (C) 1985-1987, 1989, 1993-2016 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 /* A valid but unlikely setting for the TZ environment variable.
91 It is OK (though a bit slower) if the user chooses this value. */
92 static char dump_tz_string
[] = "TZ=UtC0";
94 /* The cached value of Vsystem_name. This is used only to compare it
95 to Vsystem_name, so it need not be visible to the GC. */
96 static Lisp_Object cached_system_name
;
99 init_and_cache_system_name (void)
102 cached_system_name
= Vsystem_name
;
106 emacs_localtime_rz (timezone_t tz
, time_t const *t
, struct tm
*tm
)
108 tm
= localtime_rz (tz
, t
, tm
);
109 if (!tm
&& errno
== ENOMEM
)
110 memory_full (SIZE_MAX
);
115 emacs_mktime_z (timezone_t tz
, struct tm
*tm
)
118 time_t t
= mktime_z (tz
, tm
);
119 if (t
== (time_t) -1 && errno
== ENOMEM
)
120 memory_full (SIZE_MAX
);
124 /* Allocate a timezone, signaling on failure. */
126 xtzalloc (char const *name
)
128 timezone_t tz
= tzalloc (name
);
130 memory_full (SIZE_MAX
);
134 /* Free a timezone, except do not free the time zone for local time.
135 Freeing utc_tz is also a no-op. */
137 xtzfree (timezone_t tz
)
143 /* Convert the Lisp time zone rule ZONE to a timezone_t object.
144 The returned value either is 0, or is LOCAL_TZ, or is newly allocated.
145 If SETTZ, set Emacs local time to the time zone rule; otherwise,
146 the caller should eventually pass the returned value to xtzfree. */
148 tzlookup (Lisp_Object zone
, bool settz
)
150 static char const tzbuf_format
[] = "<%+.*"pI
"d>%s%"pI
"d:%02d:%02d";
151 char const *trailing_tzbuf_format
= tzbuf_format
+ sizeof "<%+.*"pI
"d" - 1;
152 char tzbuf
[sizeof tzbuf_format
+ 2 * INT_STRLEN_BOUND (EMACS_INT
)];
153 char const *zone_string
;
158 else if (EQ (zone
, Qt
))
160 zone_string
= "UTC0";
165 bool plain_integer
= INTEGERP (zone
);
167 if (EQ (zone
, Qwall
))
169 else if (STRINGP (zone
))
170 zone_string
= SSDATA (ENCODE_SYSTEM (zone
));
171 else if (plain_integer
|| (CONSP (zone
) && INTEGERP (XCAR (zone
))
172 && CONSP (XCDR (zone
))))
177 abbr
= XCAR (XCDR (zone
));
181 EMACS_INT abszone
= eabs (XINT (zone
)), hour
= abszone
/ (60 * 60);
182 int hour_remainder
= abszone
% (60 * 60);
183 int min
= hour_remainder
/ 60, sec
= hour_remainder
% 60;
188 EMACS_INT numzone
= hour
;
189 if (hour_remainder
!= 0)
191 prec
+= 2, numzone
= 100 * numzone
+ min
;
193 prec
+= 2, numzone
= 100 * numzone
+ sec
;
195 sprintf (tzbuf
, tzbuf_format
, prec
, numzone
,
196 &"-"[XINT (zone
) < 0], hour
, min
, sec
);
201 AUTO_STRING (leading
, "<");
202 AUTO_STRING_WITH_LEN (trailing
, tzbuf
,
203 sprintf (tzbuf
, trailing_tzbuf_format
,
204 &"-"[XINT (zone
) < 0],
206 zone_string
= SSDATA (concat3 (leading
, ENCODE_SYSTEM (abbr
),
211 xsignal2 (Qerror
, build_string ("Invalid time zone specification"),
213 new_tz
= xtzalloc (zone_string
);
219 emacs_setenv_TZ (zone_string
);
221 timezone_t old_tz
= local_tz
;
231 init_editfns (bool dumping
)
233 const char *user_name
;
235 struct passwd
*pw
; /* password entry for the current user */
238 /* Set up system_name even when dumping. */
239 init_and_cache_system_name ();
242 /* When just dumping out, set the time zone to a known unlikely value
243 and skip the rest of this function. */
247 xputenv (dump_tz_string
);
254 char *tz
= getenv ("TZ");
256 #if !defined CANNOT_DUMP && defined HAVE_TZSET
257 /* If the execution TZ happens to be the same as the dump TZ,
258 change it to some other value and then change it back,
259 to force the underlying implementation to reload the TZ info.
260 This is needed on implementations that load TZ info from files,
261 since the TZ file contents may differ between dump and execution. */
262 if (tz
&& strcmp (tz
, &dump_tz_string
[tzeqlen
]) == 0)
270 /* Set the time zone rule now, so that the call to putenv is done
271 before multiple threads are active. */
272 wall_clock_tz
= xtzalloc (0);
273 tzlookup (tz
? build_string (tz
) : Qwall
, true);
275 pw
= getpwuid (getuid ());
277 /* We let the real user name default to "root" because that's quite
278 accurate on MS-DOS and because it lets Emacs find the init file.
279 (The DVX libraries override the Djgpp libraries here.) */
280 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
282 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
285 /* Get the effective user name, by consulting environment variables,
286 or the effective uid if those are unset. */
287 user_name
= getenv ("LOGNAME");
290 user_name
= getenv ("USERNAME"); /* it's USERNAME on NT */
291 #else /* WINDOWSNT */
292 user_name
= getenv ("USER");
293 #endif /* WINDOWSNT */
296 pw
= getpwuid (geteuid ());
297 user_name
= pw
? pw
->pw_name
: "unknown";
299 Vuser_login_name
= build_string (user_name
);
301 /* If the user name claimed in the environment vars differs from
302 the real uid, use the claimed name to find the full name. */
303 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
305 tem
= Vuser_login_name
;
308 uid_t euid
= geteuid ();
309 tem
= make_fixnum_or_float (euid
);
311 Vuser_full_name
= Fuser_full_name (tem
);
315 Vuser_full_name
= build_string (p
);
316 else if (NILP (Vuser_full_name
))
317 Vuser_full_name
= build_string ("unknown");
319 #ifdef HAVE_SYS_UTSNAME_H
323 Voperating_system_release
= build_string (uts
.release
);
326 Voperating_system_release
= Qnil
;
330 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
331 doc
: /* Convert arg CHAR to a string containing that character.
332 usage: (char-to-string CHAR) */)
333 (Lisp_Object character
)
336 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
338 CHECK_CHARACTER (character
);
339 c
= XFASTINT (character
);
341 len
= CHAR_STRING (c
, str
);
342 return make_string_from_bytes ((char *) str
, 1, len
);
345 DEFUN ("byte-to-string", Fbyte_to_string
, Sbyte_to_string
, 1, 1, 0,
346 doc
: /* Convert arg BYTE to a unibyte string containing that byte. */)
351 if (XINT (byte
) < 0 || XINT (byte
) > 255)
352 error ("Invalid byte");
354 return make_string_from_bytes ((char *) &b
, 1, 1);
357 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
358 doc
: /* Return the first character in STRING. */)
359 (register Lisp_Object string
)
361 register Lisp_Object val
;
362 CHECK_STRING (string
);
365 if (STRING_MULTIBYTE (string
))
366 XSETFASTINT (val
, STRING_CHAR (SDATA (string
)));
368 XSETFASTINT (val
, SREF (string
, 0));
371 XSETFASTINT (val
, 0);
375 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
376 doc
: /* Return value of point, as an integer.
377 Beginning of buffer is position (point-min). */)
381 XSETFASTINT (temp
, PT
);
385 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
386 doc
: /* Return value of point, as a marker object. */)
389 return build_marker (current_buffer
, PT
, PT_BYTE
);
392 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
393 doc
: /* Set point to POSITION, a number or marker.
394 Beginning of buffer is position (point-min), end is (point-max).
396 The return value is POSITION. */)
397 (register Lisp_Object position
)
399 if (MARKERP (position
))
400 set_point_from_marker (position
);
401 else if (INTEGERP (position
))
402 SET_PT (clip_to_bounds (BEGV
, XINT (position
), ZV
));
404 wrong_type_argument (Qinteger_or_marker_p
, position
);
409 /* Return the start or end position of the region.
410 BEGINNINGP means return the start.
411 If there is no region active, signal an error. */
414 region_limit (bool beginningp
)
418 if (!NILP (Vtransient_mark_mode
)
419 && NILP (Vmark_even_if_inactive
)
420 && NILP (BVAR (current_buffer
, mark_active
)))
421 xsignal0 (Qmark_inactive
);
423 m
= Fmarker_position (BVAR (current_buffer
, mark
));
425 error ("The mark is not set now, so there is no region");
427 /* Clip to the current narrowing (bug#11770). */
428 return make_number ((PT
< XFASTINT (m
)) == beginningp
430 : clip_to_bounds (BEGV
, XFASTINT (m
), ZV
));
433 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
434 doc
: /* Return the integer value of point or mark, whichever is smaller. */)
437 return region_limit (1);
440 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
441 doc
: /* Return the integer value of point or mark, whichever is larger. */)
444 return region_limit (0);
447 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
448 doc
: /* Return this buffer's mark, as a marker object.
449 Watch out! Moving this marker changes the mark position.
450 If you set the marker not to point anywhere, the buffer will have no mark. */)
453 return BVAR (current_buffer
, mark
);
457 /* Find all the overlays in the current buffer that touch position POS.
458 Return the number found, and store them in a vector in VEC
462 overlays_around (EMACS_INT pos
, Lisp_Object
*vec
, ptrdiff_t len
)
464 Lisp_Object overlay
, start
, end
;
465 struct Lisp_Overlay
*tail
;
466 ptrdiff_t startpos
, endpos
;
469 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
471 XSETMISC (overlay
, tail
);
473 end
= OVERLAY_END (overlay
);
474 endpos
= OVERLAY_POSITION (end
);
477 start
= OVERLAY_START (overlay
);
478 startpos
= OVERLAY_POSITION (start
);
483 /* Keep counting overlays even if we can't return them all. */
488 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
490 XSETMISC (overlay
, tail
);
492 start
= OVERLAY_START (overlay
);
493 startpos
= OVERLAY_POSITION (start
);
496 end
= OVERLAY_END (overlay
);
497 endpos
= OVERLAY_POSITION (end
);
509 DEFUN ("get-pos-property", Fget_pos_property
, Sget_pos_property
, 2, 3, 0,
510 doc
: /* Return the value of POSITION's property PROP, in OBJECT.
511 Almost identical to `get-char-property' except for the following difference:
512 Whereas `get-char-property' returns the property of the char at (i.e. right
513 after) POSITION, this pays attention to properties's stickiness and overlays's
514 advancement settings, in order to find the property of POSITION itself,
515 i.e. the property that a char would inherit if it were inserted
517 (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
)
519 CHECK_NUMBER_COERCE_MARKER (position
);
522 XSETBUFFER (object
, current_buffer
);
523 else if (WINDOWP (object
))
524 object
= XWINDOW (object
)->contents
;
526 if (!BUFFERP (object
))
527 /* pos-property only makes sense in buffers right now, since strings
528 have no overlays and no notion of insertion for which stickiness
530 return Fget_text_property (position
, prop
, object
);
533 EMACS_INT posn
= XINT (position
);
535 Lisp_Object
*overlay_vec
, tem
;
536 struct buffer
*obuf
= current_buffer
;
539 set_buffer_temp (XBUFFER (object
));
541 /* First try with room for 40 overlays. */
542 Lisp_Object overlay_vecbuf
[40];
543 noverlays
= ARRAYELTS (overlay_vecbuf
);
544 overlay_vec
= overlay_vecbuf
;
545 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
547 /* If there are more than 40,
548 make enough space for all, and try again. */
549 if (ARRAYELTS (overlay_vecbuf
) < noverlays
)
551 SAFE_ALLOCA_LISP (overlay_vec
, noverlays
);
552 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
554 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
556 set_buffer_temp (obuf
);
558 /* Now check the overlays in order of decreasing priority. */
559 while (--noverlays
>= 0)
561 Lisp_Object ol
= overlay_vec
[noverlays
];
562 tem
= Foverlay_get (ol
, prop
);
565 /* Check the overlay is indeed active at point. */
566 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
567 if ((OVERLAY_POSITION (start
) == posn
568 && XMARKER (start
)->insertion_type
== 1)
569 || (OVERLAY_POSITION (finish
) == posn
570 && XMARKER (finish
)->insertion_type
== 0))
571 ; /* The overlay will not cover a char inserted at point. */
581 { /* Now check the text properties. */
582 int stickiness
= text_property_stickiness (prop
, position
, object
);
584 return Fget_text_property (position
, prop
, object
);
585 else if (stickiness
< 0
586 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
587 return Fget_text_property (make_number (XINT (position
) - 1),
595 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
596 the value of point is used instead. If BEG or END is null,
597 means don't store the beginning or end of the field.
599 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
600 results; they do not effect boundary behavior.
602 If MERGE_AT_BOUNDARY is non-nil, then if POS is at the very first
603 position of a field, then the beginning of the previous field is
604 returned instead of the beginning of POS's field (since the end of a
605 field is actually also the beginning of the next input field, this
606 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
607 non-nil case, if two fields are separated by a field with the special
608 value `boundary', and POS lies within it, then the two separated
609 fields are considered to be adjacent, and POS between them, when
610 finding the beginning and ending of the "merged" field.
612 Either BEG or END may be 0, in which case the corresponding value
616 find_field (Lisp_Object pos
, Lisp_Object merge_at_boundary
,
617 Lisp_Object beg_limit
,
618 ptrdiff_t *beg
, Lisp_Object end_limit
, ptrdiff_t *end
)
620 /* Fields right before and after the point. */
621 Lisp_Object before_field
, after_field
;
622 /* True if POS counts as the start of a field. */
623 bool at_field_start
= 0;
624 /* True if POS counts as the end of a field. */
625 bool at_field_end
= 0;
628 XSETFASTINT (pos
, PT
);
630 CHECK_NUMBER_COERCE_MARKER (pos
);
633 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
635 = (XFASTINT (pos
) > BEGV
636 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
638 /* Using nil here would be a more obvious choice, but it would
639 fail when the buffer starts with a non-sticky field. */
642 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
643 and POS is at beginning of a field, which can also be interpreted
644 as the end of the previous field. Note that the case where if
645 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
646 more natural one; then we avoid treating the beginning of a field
648 if (NILP (merge_at_boundary
))
650 Lisp_Object field
= Fget_pos_property (pos
, Qfield
, Qnil
);
651 if (!EQ (field
, after_field
))
653 if (!EQ (field
, before_field
))
655 if (NILP (field
) && at_field_start
&& at_field_end
)
656 /* If an inserted char would have a nil field while the surrounding
657 text is non-nil, we're probably not looking at a
658 zero-length field, but instead at a non-nil field that's
659 not intended for editing (such as comint's prompts). */
660 at_field_end
= at_field_start
= 0;
663 /* Note about special `boundary' fields:
665 Consider the case where the point (`.') is between the fields `x' and `y':
669 In this situation, if merge_at_boundary is non-nil, consider the
670 `x' and `y' fields as forming one big merged field, and so the end
671 of the field is the end of `y'.
673 However, if `x' and `y' are separated by a special `boundary' field
674 (a field with a `field' char-property of 'boundary), then ignore
675 this special field when merging adjacent fields. Here's the same
676 situation, but with a `boundary' field between the `x' and `y' fields:
680 Here, if point is at the end of `x', the beginning of `y', or
681 anywhere in-between (within the `boundary' field), merge all
682 three fields and consider the beginning as being the beginning of
683 the `x' field, and the end as being the end of the `y' field. */
688 /* POS is at the edge of a field, and we should consider it as
689 the beginning of the following field. */
690 *beg
= XFASTINT (pos
);
692 /* Find the previous field boundary. */
695 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
696 /* Skip a `boundary' field. */
697 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
700 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
702 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
709 /* POS is at the edge of a field, and we should consider it as
710 the end of the previous field. */
711 *end
= XFASTINT (pos
);
713 /* Find the next field boundary. */
715 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
716 /* Skip a `boundary' field. */
717 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
720 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
722 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
728 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
729 doc
: /* Delete the field surrounding POS.
730 A field is a region of text with the same `field' property.
731 If POS is nil, the value of point is used for POS. */)
735 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
737 del_range (beg
, end
);
741 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
742 doc
: /* Return the contents of the field surrounding POS as a string.
743 A field is a region of text with the same `field' property.
744 If POS is nil, the value of point is used for POS. */)
748 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
749 return make_buffer_string (beg
, end
, 1);
752 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
753 doc
: /* Return the contents of the field around POS, without text properties.
754 A field is a region of text with the same `field' property.
755 If POS is nil, the value of point is used for POS. */)
759 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
760 return make_buffer_string (beg
, end
, 0);
763 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
764 doc
: /* Return the beginning of the field surrounding POS.
765 A field is a region of text with the same `field' property.
766 If POS is nil, the value of point is used for POS.
767 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
768 field, then the beginning of the *previous* field is returned.
769 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
770 is before LIMIT, then LIMIT will be returned instead. */)
771 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
774 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
775 return make_number (beg
);
778 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
779 doc
: /* Return the end of the field surrounding POS.
780 A field is a region of text with the same `field' property.
781 If POS is nil, the value of point is used for POS.
782 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
783 then the end of the *following* field is returned.
784 If LIMIT is non-nil, it is a buffer position; if the end of the field
785 is after LIMIT, then LIMIT will be returned instead. */)
786 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
789 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
790 return make_number (end
);
793 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
794 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
795 A field is a region of text with the same `field' property.
797 If NEW-POS is nil, then use the current point instead, and move point
798 to the resulting constrained position, in addition to returning that
801 If OLD-POS is at the boundary of two fields, then the allowable
802 positions for NEW-POS depends on the value of the optional argument
803 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
804 constrained to the field that has the same `field' char-property
805 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
806 is non-nil, NEW-POS is constrained to the union of the two adjacent
807 fields. Additionally, if two fields are separated by another field with
808 the special value `boundary', then any point within this special field is
809 also considered to be `on the boundary'.
811 If the optional argument ONLY-IN-LINE is non-nil and constraining
812 NEW-POS would move it to a different line, NEW-POS is returned
813 unconstrained. This is useful for commands that move by line, like
814 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
815 only in the case where they can still move to the right line.
817 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
818 a non-nil property of that name, then any field boundaries are ignored.
820 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
821 (Lisp_Object new_pos
, Lisp_Object old_pos
, Lisp_Object escape_from_edge
,
822 Lisp_Object only_in_line
, Lisp_Object inhibit_capture_property
)
824 /* If non-zero, then the original point, before re-positioning. */
825 ptrdiff_t orig_point
= 0;
827 Lisp_Object prev_old
, prev_new
;
830 /* Use the current point, and afterwards, set it. */
833 XSETFASTINT (new_pos
, PT
);
836 CHECK_NUMBER_COERCE_MARKER (new_pos
);
837 CHECK_NUMBER_COERCE_MARKER (old_pos
);
839 fwd
= (XINT (new_pos
) > XINT (old_pos
));
841 prev_old
= make_number (XINT (old_pos
) - 1);
842 prev_new
= make_number (XINT (new_pos
) - 1);
844 if (NILP (Vinhibit_field_text_motion
)
845 && !EQ (new_pos
, old_pos
)
846 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
847 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
848 /* To recognize field boundaries, we must also look at the
849 previous positions; we could use `Fget_pos_property'
850 instead, but in itself that would fail inside non-sticky
851 fields (like comint prompts). */
852 || (XFASTINT (new_pos
) > BEGV
853 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
854 || (XFASTINT (old_pos
) > BEGV
855 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
856 && (NILP (inhibit_capture_property
)
857 /* Field boundaries are again a problem; but now we must
858 decide the case exactly, so we need to call
859 `get_pos_property' as well. */
860 || (NILP (Fget_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
861 && (XFASTINT (old_pos
) <= BEGV
862 || NILP (Fget_char_property
863 (old_pos
, inhibit_capture_property
, Qnil
))
864 || NILP (Fget_char_property
865 (prev_old
, inhibit_capture_property
, Qnil
))))))
866 /* It is possible that NEW_POS is not within the same field as
867 OLD_POS; try to move NEW_POS so that it is. */
870 Lisp_Object field_bound
;
873 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
875 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
877 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
878 other side of NEW_POS, which would mean that NEW_POS is
879 already acceptable, and it's not necessary to constrain it
881 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
882 /* NEW_POS should be constrained, but only if either
883 ONLY_IN_LINE is nil (in which case any constraint is OK),
884 or NEW_POS and FIELD_BOUND are on the same line (in which
885 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
886 && (NILP (only_in_line
)
887 /* This is the ONLY_IN_LINE case, check that NEW_POS and
888 FIELD_BOUND are on the same line by seeing whether
889 there's an intervening newline or not. */
890 || (find_newline (XFASTINT (new_pos
), -1,
891 XFASTINT (field_bound
), -1,
892 fwd
? -1 : 1, &shortage
, NULL
, 1),
894 /* Constrain NEW_POS to FIELD_BOUND. */
895 new_pos
= field_bound
;
897 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
898 /* The NEW_POS argument was originally nil, so automatically set PT. */
899 SET_PT (XFASTINT (new_pos
));
906 DEFUN ("line-beginning-position",
907 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
908 doc
: /* Return the character position of the first character on the current line.
909 With optional argument N, scan forward N - 1 lines first.
910 If the scan reaches the end of the buffer, return that position.
912 This function ignores text display directionality; it returns the
913 position of the first character in logical order, i.e. the smallest
914 character position on the line.
916 This function constrains the returned position to the current field
917 unless that position would be on a different line than the original,
918 unconstrained result. If N is nil or 1, and a front-sticky field
919 starts at point, the scan stops as soon as it starts. To ignore field
920 boundaries, bind `inhibit-field-text-motion' to t.
922 This function does not move point. */)
925 ptrdiff_t charpos
, bytepos
;
932 scan_newline_from_point (XINT (n
) - 1, &charpos
, &bytepos
);
934 /* Return END constrained to the current input field. */
935 return Fconstrain_to_field (make_number (charpos
), make_number (PT
),
936 XINT (n
) != 1 ? Qt
: Qnil
,
940 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
941 doc
: /* Return the character position of the last character on the current line.
942 With argument N not nil or 1, move forward N - 1 lines first.
943 If scan reaches end of buffer, return that position.
945 This function ignores text display directionality; it returns the
946 position of the last character in logical order, i.e. the largest
947 character position on the line.
949 This function constrains the returned position to the current field
950 unless that would be on a different line than the original,
951 unconstrained result. If N is nil or 1, and a rear-sticky field ends
952 at point, the scan stops as soon as it starts. To ignore field
953 boundaries bind `inhibit-field-text-motion' to t.
955 This function does not move point. */)
967 clipped_n
= clip_to_bounds (PTRDIFF_MIN
+ 1, XINT (n
), PTRDIFF_MAX
);
968 end_pos
= find_before_next_newline (orig
, 0, clipped_n
- (clipped_n
<= 0),
971 /* Return END_POS constrained to the current input field. */
972 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
976 /* Save current buffer state for `save-excursion' special form.
977 We (ab)use Lisp_Misc_Save_Value to allow explicit free and so
978 offload some work from GC. */
981 save_excursion_save (void)
983 return make_save_obj_obj_obj_obj
986 /* Selected window if current buffer is shown in it, nil otherwise. */
987 (EQ (XWINDOW (selected_window
)->contents
, Fcurrent_buffer ())
988 ? selected_window
: Qnil
),
992 /* Restore saved buffer before leaving `save-excursion' special form. */
995 save_excursion_restore (Lisp_Object info
)
997 Lisp_Object tem
, tem1
;
999 tem
= Fmarker_buffer (XSAVE_OBJECT (info
, 0));
1000 /* If we're unwinding to top level, saved buffer may be deleted. This
1001 means that all of its markers are unchained and so tem is nil. */
1008 tem
= XSAVE_OBJECT (info
, 0);
1010 unchain_marker (XMARKER (tem
));
1012 /* If buffer was visible in a window, and a different window was
1013 selected, and the old selected window is still showing this
1014 buffer, restore point in that window. */
1015 tem
= XSAVE_OBJECT (info
, 2);
1017 && !EQ (tem
, selected_window
)
1018 && (tem1
= XWINDOW (tem
)->contents
,
1019 (/* Window is live... */
1021 /* ...and it shows the current buffer. */
1022 && XBUFFER (tem1
) == current_buffer
)))
1023 Fset_window_point (tem
, make_number (PT
));
1030 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
1031 doc
: /* Save point, and current buffer; execute BODY; restore those things.
1032 Executes BODY just like `progn'.
1033 The values of point and the current buffer are restored
1034 even in case of abnormal exit (throw or error).
1036 If you only want to save the current buffer but not point,
1037 then just use `save-current-buffer', or even `with-current-buffer'.
1039 Before Emacs 25.1, `save-excursion' used to save the mark state.
1040 To save the marker state as well as the point and buffer, use
1041 `save-mark-and-excursion'.
1043 usage: (save-excursion &rest BODY) */)
1046 register Lisp_Object val
;
1047 ptrdiff_t count
= SPECPDL_INDEX ();
1049 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1051 val
= Fprogn (args
);
1052 return unbind_to (count
, val
);
1055 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
1056 doc
: /* Record which buffer is current; execute BODY; make that buffer current.
1057 BODY is executed just like `progn'.
1058 usage: (save-current-buffer &rest BODY) */)
1061 ptrdiff_t count
= SPECPDL_INDEX ();
1063 record_unwind_current_buffer ();
1064 return unbind_to (count
, Fprogn (args
));
1067 DEFUN ("buffer-size", Fbuffer_size
, Sbuffer_size
, 0, 1, 0,
1068 doc
: /* Return the number of characters in the current buffer.
1069 If BUFFER is not nil, return the number of characters in that buffer
1072 This does not take narrowing into account; to count the number of
1073 characters in the accessible portion of the current buffer, use
1074 `(- (point-max) (point-min))', and to count the number of characters
1075 in some other BUFFER, use
1076 `(with-current-buffer BUFFER (- (point-max) (point-min)))'. */)
1077 (Lisp_Object buffer
)
1080 return make_number (Z
- BEG
);
1083 CHECK_BUFFER (buffer
);
1084 return make_number (BUF_Z (XBUFFER (buffer
))
1085 - BUF_BEG (XBUFFER (buffer
)));
1089 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1090 doc
: /* Return the minimum permissible value of point in the current buffer.
1091 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1095 XSETFASTINT (temp
, BEGV
);
1099 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1100 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1101 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1104 return build_marker (current_buffer
, BEGV
, BEGV_BYTE
);
1107 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1108 doc
: /* Return the maximum permissible value of point in the current buffer.
1109 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1110 is in effect, in which case it is less. */)
1114 XSETFASTINT (temp
, ZV
);
1118 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1119 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1120 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1121 is in effect, in which case it is less. */)
1124 return build_marker (current_buffer
, ZV
, ZV_BYTE
);
1127 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1128 doc
: /* Return the position of the gap, in the current buffer.
1129 See also `gap-size'. */)
1133 XSETFASTINT (temp
, GPT
);
1137 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1138 doc
: /* Return the size of the current buffer's gap.
1139 See also `gap-position'. */)
1143 XSETFASTINT (temp
, GAP_SIZE
);
1147 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1148 doc
: /* Return the byte position for character position POSITION.
1149 If POSITION is out of range, the value is nil. */)
1150 (Lisp_Object position
)
1152 CHECK_NUMBER_COERCE_MARKER (position
);
1153 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1155 return make_number (CHAR_TO_BYTE (XINT (position
)));
1158 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1159 doc
: /* Return the character position for byte position BYTEPOS.
1160 If BYTEPOS is out of range, the value is nil. */)
1161 (Lisp_Object bytepos
)
1165 CHECK_NUMBER (bytepos
);
1166 pos_byte
= XINT (bytepos
);
1167 if (pos_byte
< BEG_BYTE
|| pos_byte
> Z_BYTE
)
1170 /* There are multibyte characters in the buffer.
1171 The argument of BYTE_TO_CHAR must be a byte position at
1172 a character boundary, so search for the start of the current
1174 while (!CHAR_HEAD_P (FETCH_BYTE (pos_byte
)))
1176 return make_number (BYTE_TO_CHAR (pos_byte
));
1179 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1180 doc
: /* Return the character following point, as a number.
1181 At the end of the buffer or accessible region, return 0. */)
1186 XSETFASTINT (temp
, 0);
1188 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1192 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1193 doc
: /* Return the character preceding point, as a number.
1194 At the beginning of the buffer or accessible region, return 0. */)
1199 XSETFASTINT (temp
, 0);
1200 else if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
1202 ptrdiff_t pos
= PT_BYTE
;
1204 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1207 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1211 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1212 doc
: /* Return t if point is at the beginning of the buffer.
1213 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1221 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1222 doc
: /* Return t if point is at the end of the buffer.
1223 If the buffer is narrowed, this means the end of the narrowed part. */)
1231 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1232 doc
: /* Return t if point is at the beginning of a line. */)
1235 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1240 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1241 doc
: /* Return t if point is at the end of a line.
1242 `End of a line' includes point being at the end of the buffer. */)
1245 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1250 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1251 doc
: /* Return character in current buffer at position POS.
1252 POS is an integer or a marker and defaults to point.
1253 If POS is out of range, the value is nil. */)
1256 register ptrdiff_t pos_byte
;
1261 XSETFASTINT (pos
, PT
);
1266 pos_byte
= marker_byte_position (pos
);
1267 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1272 CHECK_NUMBER_COERCE_MARKER (pos
);
1273 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1276 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1279 return make_number (FETCH_CHAR (pos_byte
));
1282 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1283 doc
: /* Return character in current buffer preceding position POS.
1284 POS is an integer or a marker and defaults to point.
1285 If POS is out of range, the value is nil. */)
1288 register Lisp_Object val
;
1289 register ptrdiff_t pos_byte
;
1294 XSETFASTINT (pos
, PT
);
1299 pos_byte
= marker_byte_position (pos
);
1301 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1306 CHECK_NUMBER_COERCE_MARKER (pos
);
1308 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1311 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1314 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
1317 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1322 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1327 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1328 doc
: /* Return the name under which the user logged in, as a string.
1329 This is based on the effective uid, not the real uid.
1330 Also, if the environment variables LOGNAME or USER are set,
1331 that determines the value of this function.
1333 If optional argument UID is an integer or a float, return the login name
1334 of the user with that uid, or nil if there is no such user. */)
1340 /* Set up the user name info if we didn't do it before.
1341 (That can happen if Emacs is dumpable
1342 but you decide to run `temacs -l loadup' and not dump. */
1343 if (NILP (Vuser_login_name
))
1344 init_editfns (false);
1347 return Vuser_login_name
;
1349 CONS_TO_INTEGER (uid
, uid_t
, id
);
1353 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1356 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1358 doc
: /* Return the name of the user's real uid, as a string.
1359 This ignores the environment variables LOGNAME and USER, so it differs from
1360 `user-login-name' when running under `su'. */)
1363 /* Set up the user name info if we didn't do it before.
1364 (That can happen if Emacs is dumpable
1365 but you decide to run `temacs -l loadup' and not dump. */
1366 if (NILP (Vuser_login_name
))
1367 init_editfns (false);
1368 return Vuser_real_login_name
;
1371 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1372 doc
: /* Return the effective uid of Emacs.
1373 Value is an integer or a float, depending on the value. */)
1376 uid_t euid
= geteuid ();
1377 return make_fixnum_or_float (euid
);
1380 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1381 doc
: /* Return the real uid of Emacs.
1382 Value is an integer or a float, depending on the value. */)
1385 uid_t uid
= getuid ();
1386 return make_fixnum_or_float (uid
);
1389 DEFUN ("group-gid", Fgroup_gid
, Sgroup_gid
, 0, 0, 0,
1390 doc
: /* Return the effective gid of Emacs.
1391 Value is an integer or a float, depending on the value. */)
1394 gid_t egid
= getegid ();
1395 return make_fixnum_or_float (egid
);
1398 DEFUN ("group-real-gid", Fgroup_real_gid
, Sgroup_real_gid
, 0, 0, 0,
1399 doc
: /* Return the real gid of Emacs.
1400 Value is an integer or a float, depending on the value. */)
1403 gid_t gid
= getgid ();
1404 return make_fixnum_or_float (gid
);
1407 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1408 doc
: /* Return the full name of the user logged in, as a string.
1409 If the full name corresponding to Emacs's userid is not known,
1412 If optional argument UID is an integer or float, return the full name
1413 of the user with that uid, or nil if there is no such user.
1414 If UID is a string, return the full name of the user with that login
1415 name, or nil if there is no such user. */)
1419 register char *p
, *q
;
1423 return Vuser_full_name
;
1424 else if (NUMBERP (uid
))
1427 CONS_TO_INTEGER (uid
, uid_t
, u
);
1432 else if (STRINGP (uid
))
1435 pw
= getpwnam (SSDATA (uid
));
1439 error ("Invalid UID specification");
1445 /* Chop off everything after the first comma. */
1446 q
= strchr (p
, ',');
1447 full
= make_string (p
, q
? q
- p
: strlen (p
));
1449 #ifdef AMPERSAND_FULL_NAME
1451 q
= strchr (p
, '&');
1452 /* Substitute the login name for the &, upcasing the first character. */
1455 Lisp_Object login
= Fuser_login_name (make_number (pw
->pw_uid
));
1457 char *r
= SAFE_ALLOCA (strlen (p
) + SBYTES (login
) + 1);
1458 memcpy (r
, p
, q
- p
);
1459 char *s
= lispstpcpy (&r
[q
- p
], login
);
1460 r
[q
- p
] = upcase ((unsigned char) r
[q
- p
]);
1462 full
= build_string (r
);
1465 #endif /* AMPERSAND_FULL_NAME */
1470 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1471 doc
: /* Return the host name of the machine you are running on, as a string. */)
1474 if (EQ (Vsystem_name
, cached_system_name
))
1475 init_and_cache_system_name ();
1476 return Vsystem_name
;
1479 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1480 doc
: /* Return the process ID of Emacs, as a number. */)
1483 pid_t pid
= getpid ();
1484 return make_fixnum_or_float (pid
);
1490 # define TIME_T_MIN TYPE_MINIMUM (time_t)
1493 # define TIME_T_MAX TYPE_MAXIMUM (time_t)
1496 /* Report that a time value is out of range for Emacs. */
1498 time_overflow (void)
1500 error ("Specified time is not representable");
1503 static _Noreturn
void
1506 error ("Invalid time specification");
1509 /* Check a return value compatible with that of decode_time_components. */
1511 check_time_validity (int validity
)
1522 /* Return the upper part of the time T (everything but the bottom 16 bits). */
1526 time_t hi
= t
>> LO_TIME_BITS
;
1527 if (FIXNUM_OVERFLOW_P (hi
))
1532 /* Return the bottom bits of the time T. */
1536 return t
& ((1 << LO_TIME_BITS
) - 1);
1539 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1540 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1541 The time is returned as a list of integers (HIGH LOW USEC PSEC).
1542 HIGH has the most significant bits of the seconds, while LOW has the
1543 least significant 16 bits. USEC and PSEC are the microsecond and
1544 picosecond counts. */)
1547 return make_lisp_time (current_timespec ());
1550 static struct lisp_time
1551 time_add (struct lisp_time ta
, struct lisp_time tb
)
1553 EMACS_INT hi
= ta
.hi
+ tb
.hi
;
1554 int lo
= ta
.lo
+ tb
.lo
;
1555 int us
= ta
.us
+ tb
.us
;
1556 int ps
= ta
.ps
+ tb
.ps
;
1557 us
+= (1000000 <= ps
);
1558 ps
-= (1000000 <= ps
) * 1000000;
1559 lo
+= (1000000 <= us
);
1560 us
-= (1000000 <= us
) * 1000000;
1561 hi
+= (1 << LO_TIME_BITS
<= lo
);
1562 lo
-= (1 << LO_TIME_BITS
<= lo
) << LO_TIME_BITS
;
1563 return (struct lisp_time
) { hi
, lo
, us
, ps
};
1566 static struct lisp_time
1567 time_subtract (struct lisp_time ta
, struct lisp_time tb
)
1569 EMACS_INT hi
= ta
.hi
- tb
.hi
;
1570 int lo
= ta
.lo
- tb
.lo
;
1571 int us
= ta
.us
- tb
.us
;
1572 int ps
= ta
.ps
- tb
.ps
;
1574 ps
+= (ps
< 0) * 1000000;
1576 us
+= (us
< 0) * 1000000;
1578 lo
+= (lo
< 0) << LO_TIME_BITS
;
1579 return (struct lisp_time
) { hi
, lo
, us
, ps
};
1583 time_arith (Lisp_Object a
, Lisp_Object b
,
1584 struct lisp_time (*op
) (struct lisp_time
, struct lisp_time
))
1587 struct lisp_time ta
= lisp_time_struct (a
, &alen
);
1588 struct lisp_time tb
= lisp_time_struct (b
, &blen
);
1589 struct lisp_time t
= op (ta
, tb
);
1590 if (FIXNUM_OVERFLOW_P (t
.hi
))
1592 Lisp_Object val
= Qnil
;
1594 switch (max (alen
, blen
))
1597 val
= Fcons (make_number (t
.ps
), val
);
1600 val
= Fcons (make_number (t
.us
), val
);
1603 val
= Fcons (make_number (t
.lo
), val
);
1604 val
= Fcons (make_number (t
.hi
), val
);
1611 DEFUN ("time-add", Ftime_add
, Stime_add
, 2, 2, 0,
1612 doc
: /* Return the sum of two time values A and B, as a time value. */)
1613 (Lisp_Object a
, Lisp_Object b
)
1615 return time_arith (a
, b
, time_add
);
1618 DEFUN ("time-subtract", Ftime_subtract
, Stime_subtract
, 2, 2, 0,
1619 doc
: /* Return the difference between two time values A and B, as a time value. */)
1620 (Lisp_Object a
, Lisp_Object b
)
1622 return time_arith (a
, b
, time_subtract
);
1625 DEFUN ("time-less-p", Ftime_less_p
, Stime_less_p
, 2, 2, 0,
1626 doc
: /* Return non-nil if time value T1 is earlier than time value T2. */)
1627 (Lisp_Object t1
, Lisp_Object t2
)
1630 struct lisp_time a
= lisp_time_struct (t1
, &t1len
);
1631 struct lisp_time b
= lisp_time_struct (t2
, &t2len
);
1632 return ((a
.hi
!= b
.hi
? a
.hi
< b
.hi
1633 : a
.lo
!= b
.lo
? a
.lo
< b
.lo
1634 : a
.us
!= b
.us
? a
.us
< b
.us
1640 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1642 doc
: /* Return the current run time used by Emacs.
1643 The time is returned as a list (HIGH LOW USEC PSEC), using the same
1644 style as (current-time).
1646 On systems that can't determine the run time, `get-internal-run-time'
1647 does the same thing as `current-time'. */)
1650 #ifdef HAVE_GETRUSAGE
1651 struct rusage usage
;
1655 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1656 /* This shouldn't happen. What action is appropriate? */
1659 /* Sum up user time and system time. */
1660 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1661 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1662 if (usecs
>= 1000000)
1667 return make_lisp_time (make_timespec (secs
, usecs
* 1000));
1668 #else /* ! HAVE_GETRUSAGE */
1670 return w32_get_internal_run_time ();
1671 #else /* ! WINDOWSNT */
1672 return Fcurrent_time ();
1673 #endif /* WINDOWSNT */
1674 #endif /* HAVE_GETRUSAGE */
1678 /* Make a Lisp list that represents the Emacs time T. T may be an
1679 invalid time, with a slightly negative tv_nsec value such as
1680 UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a
1681 correspondingly negative picosecond count. */
1683 make_lisp_time (struct timespec t
)
1685 time_t s
= t
.tv_sec
;
1687 return list4i (hi_time (s
), lo_time (s
), ns
/ 1000, ns
% 1000 * 1000);
1690 /* Decode a Lisp list SPECIFIED_TIME that represents a time.
1691 Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values.
1692 Return 2, 3, or 4 to indicate the effective length of SPECIFIED_TIME
1693 if successful, 0 if unsuccessful. */
1695 disassemble_lisp_time (Lisp_Object specified_time
, Lisp_Object
*phigh
,
1696 Lisp_Object
*plow
, Lisp_Object
*pusec
,
1699 Lisp_Object high
= make_number (0);
1700 Lisp_Object low
= specified_time
;
1701 Lisp_Object usec
= make_number (0);
1702 Lisp_Object psec
= make_number (0);
1705 if (CONSP (specified_time
))
1707 high
= XCAR (specified_time
);
1708 low
= XCDR (specified_time
);
1711 Lisp_Object low_tail
= XCDR (low
);
1713 if (CONSP (low_tail
))
1715 usec
= XCAR (low_tail
);
1716 low_tail
= XCDR (low_tail
);
1717 if (CONSP (low_tail
))
1718 psec
= XCAR (low_tail
);
1722 else if (!NILP (low_tail
))
1733 /* When combining components, require LOW to be an integer,
1734 as otherwise it would be a pain to add up times. */
1735 if (! INTEGERP (low
))
1738 else if (INTEGERP (specified_time
))
1748 /* Convert T into an Emacs time *RESULT, truncating toward minus infinity.
1749 Return true if T is in range, false otherwise. */
1751 decode_float_time (double t
, struct lisp_time
*result
)
1753 double lo_multiplier
= 1 << LO_TIME_BITS
;
1754 double emacs_time_min
= MOST_NEGATIVE_FIXNUM
* lo_multiplier
;
1755 if (! (emacs_time_min
<= t
&& t
< -emacs_time_min
))
1758 double small_t
= t
/ lo_multiplier
;
1759 EMACS_INT hi
= small_t
;
1760 double t_sans_hi
= t
- hi
* lo_multiplier
;
1762 long double fracps
= (t_sans_hi
- lo
) * 1e12L
;
1763 #ifdef INT_FAST64_MAX
1764 int_fast64_t ifracps
= fracps
;
1765 int us
= ifracps
/ 1000000;
1766 int ps
= ifracps
% 1000000;
1768 int us
= fracps
/ 1e6L
;
1769 int ps
= fracps
- us
* 1e6L
;
1772 ps
+= (ps
< 0) * 1000000;
1774 us
+= (us
< 0) * 1000000;
1776 lo
+= (lo
< 0) << LO_TIME_BITS
;
1784 /* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp
1785 list, generate the corresponding time value.
1786 If LOW is floating point, the other components should be zero.
1788 If RESULT is not null, store into *RESULT the converted time.
1789 If *DRESULT is not null, store into *DRESULT the number of
1790 seconds since the start of the POSIX Epoch.
1792 Return 1 if successful, 0 if the components are of the
1793 wrong type, and -1 if the time is out of range. */
1795 decode_time_components (Lisp_Object high
, Lisp_Object low
, Lisp_Object usec
,
1797 struct lisp_time
*result
, double *dresult
)
1799 EMACS_INT hi
, lo
, us
, ps
;
1800 if (! (INTEGERP (high
)
1801 && INTEGERP (usec
) && INTEGERP (psec
)))
1803 if (! INTEGERP (low
))
1807 double t
= XFLOAT_DATA (low
);
1808 if (result
&& ! decode_float_time (t
, result
))
1814 else if (NILP (low
))
1816 struct timespec now
= current_timespec ();
1819 result
->hi
= hi_time (now
.tv_sec
);
1820 result
->lo
= lo_time (now
.tv_sec
);
1821 result
->us
= now
.tv_nsec
/ 1000;
1822 result
->ps
= now
.tv_nsec
% 1000 * 1000;
1825 *dresult
= now
.tv_sec
+ now
.tv_nsec
/ 1e9
;
1837 /* Normalize out-of-range lower-order components by carrying
1838 each overflow into the next higher-order component. */
1839 us
+= ps
/ 1000000 - (ps
% 1000000 < 0);
1840 lo
+= us
/ 1000000 - (us
% 1000000 < 0);
1841 hi
+= lo
>> LO_TIME_BITS
;
1842 ps
= ps
% 1000000 + 1000000 * (ps
% 1000000 < 0);
1843 us
= us
% 1000000 + 1000000 * (us
% 1000000 < 0);
1844 lo
&= (1 << LO_TIME_BITS
) - 1;
1848 if (FIXNUM_OVERFLOW_P (hi
))
1859 *dresult
= (us
* 1e6
+ ps
) / 1e12
+ lo
+ dhi
* (1 << LO_TIME_BITS
);
1866 lisp_to_timespec (struct lisp_time t
)
1868 if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN
>> LO_TIME_BITS
<= t
.hi
: 0 <= t
.hi
)
1869 && t
.hi
<= TIME_T_MAX
>> LO_TIME_BITS
))
1870 return invalid_timespec ();
1871 time_t s
= (t
.hi
<< LO_TIME_BITS
) + t
.lo
;
1872 int ns
= t
.us
* 1000 + t
.ps
/ 1000;
1873 return make_timespec (s
, ns
);
1876 /* Decode a Lisp list SPECIFIED_TIME that represents a time.
1877 Store its effective length into *PLEN.
1878 If SPECIFIED_TIME is nil, use the current time.
1879 Signal an error if SPECIFIED_TIME does not represent a time. */
1880 static struct lisp_time
1881 lisp_time_struct (Lisp_Object specified_time
, int *plen
)
1883 Lisp_Object high
, low
, usec
, psec
;
1885 int len
= disassemble_lisp_time (specified_time
, &high
, &low
, &usec
, &psec
);
1888 int val
= decode_time_components (high
, low
, usec
, psec
, &t
, 0);
1889 check_time_validity (val
);
1894 /* Like lisp_time_struct, except return a struct timespec.
1895 Discard any low-order digits. */
1897 lisp_time_argument (Lisp_Object specified_time
)
1900 struct lisp_time lt
= lisp_time_struct (specified_time
, &len
);
1901 struct timespec t
= lisp_to_timespec (lt
);
1902 if (! timespec_valid_p (t
))
1907 /* Like lisp_time_argument, except decode only the seconds part,
1908 and do not check the subseconds part. */
1910 lisp_seconds_argument (Lisp_Object specified_time
)
1912 Lisp_Object high
, low
, usec
, psec
;
1915 int val
= disassemble_lisp_time (specified_time
, &high
, &low
, &usec
, &psec
);
1918 val
= decode_time_components (high
, low
, make_number (0),
1919 make_number (0), &t
, 0);
1921 && ! ((TYPE_SIGNED (time_t)
1922 ? TIME_T_MIN
>> LO_TIME_BITS
<= t
.hi
1924 && t
.hi
<= TIME_T_MAX
>> LO_TIME_BITS
))
1927 check_time_validity (val
);
1928 return (t
.hi
<< LO_TIME_BITS
) + t
.lo
;
1931 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1932 doc
: /* Return the current time, as a float number of seconds since the epoch.
1933 If SPECIFIED-TIME is given, it is the time to convert to float
1934 instead of the current time. The argument should have the form
1935 \(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus,
1936 you can use times from `current-time' and from `file-attributes'.
1937 SPECIFIED-TIME can also have the form (HIGH . LOW), but this is
1938 considered obsolete.
1940 WARNING: Since the result is floating point, it may not be exact.
1941 If precise time stamps are required, use either `current-time',
1942 or (if you need time as a string) `format-time-string'. */)
1943 (Lisp_Object specified_time
)
1946 Lisp_Object high
, low
, usec
, psec
;
1947 if (! (disassemble_lisp_time (specified_time
, &high
, &low
, &usec
, &psec
)
1948 && decode_time_components (high
, low
, usec
, psec
, 0, &t
)))
1950 return make_float (t
);
1953 /* Write information into buffer S of size MAXSIZE, according to the
1954 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1955 Use the time zone specified by TZ.
1956 Use NS as the number of nanoseconds in the %N directive.
1957 Return the number of bytes written, not including the terminating
1958 '\0'. If S is NULL, nothing will be written anywhere; so to
1959 determine how many bytes would be written, use NULL for S and
1960 ((size_t) -1) for MAXSIZE.
1962 This function behaves like nstrftime, except it allows null
1963 bytes in FORMAT and it does not support nanoseconds. */
1965 emacs_nmemftime (char *s
, size_t maxsize
, const char *format
,
1966 size_t format_len
, const struct tm
*tp
, timezone_t tz
, int ns
)
1970 /* Loop through all the null-terminated strings in the format
1971 argument. Normally there's just one null-terminated string, but
1972 there can be arbitrarily many, concatenated together, if the
1973 format contains '\0' bytes. nstrftime stops at the first
1974 '\0' byte so we must invoke it separately for each such string. */
1983 result
= nstrftime (s
, maxsize
, format
, tp
, tz
, ns
);
1987 if (result
== 0 && s
[0] != '\0')
1992 maxsize
-= result
+ 1;
1994 len
= strlen (format
);
1995 if (len
== format_len
)
1999 format_len
-= len
+ 1;
2003 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
2004 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
2005 TIME is specified as (HIGH LOW USEC PSEC), as returned by
2006 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
2007 is also still accepted.
2009 The optional ZONE is omitted or nil for Emacs local time, t for
2010 Universal Time, `wall' for system wall clock time, or a string as in
2011 the TZ environment variable. It can also be a list (as from
2012 `current-time-zone') or an integer (as from `decode-time') applied
2013 without consideration for daylight saving time.
2015 The value is a copy of FORMAT-STRING, but with certain constructs replaced
2016 by text that describes the specified date and time in TIME:
2018 %Y is the year, %y within the century, %C the century.
2019 %G is the year corresponding to the ISO week, %g within the century.
2020 %m is the numeric month.
2021 %b and %h are the locale's abbreviated month name, %B the full name.
2022 (%h is not supported on MS-Windows.)
2023 %d is the day of the month, zero-padded, %e is blank-padded.
2024 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
2025 %a is the locale's abbreviated name of the day of week, %A the full name.
2026 %U is the week number starting on Sunday, %W starting on Monday,
2027 %V according to ISO 8601.
2028 %j is the day of the year.
2030 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
2031 only blank-padded, %l is like %I blank-padded.
2032 %p is the locale's equivalent of either AM or PM.
2035 %N is the nanosecond, %6N the microsecond, %3N the millisecond, etc.
2036 %Z is the time zone name, %z is the numeric form.
2037 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
2039 %c is the locale's date and time format.
2040 %x is the locale's "preferred" date format.
2041 %D is like "%m/%d/%y".
2042 %F is the ISO 8601 date format (like "%Y-%m-%d").
2044 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
2045 %X is the locale's "preferred" time format.
2047 Finally, %n is a newline, %t is a tab, %% is a literal %.
2049 Certain flags and modifiers are available with some format controls.
2050 The flags are `_', `-', `^' and `#'. For certain characters X,
2051 %_X is like %X, but padded with blanks; %-X is like %X,
2052 but without padding. %^X is like %X, but with all textual
2053 characters up-cased; %#X is like %X, but with letter-case of
2054 all textual characters reversed.
2055 %NX (where N stands for an integer) is like %X,
2056 but takes up at least N (a number) positions.
2057 The modifiers are `E' and `O'. For certain characters X,
2058 %EX is a locale's alternative version of %X;
2059 %OX is like %X, but uses the locale's number symbols.
2061 For example, to produce full ISO 8601 format, use "%FT%T%z".
2063 usage: (format-time-string FORMAT-STRING &optional TIME ZONE) */)
2064 (Lisp_Object format_string
, Lisp_Object timeval
, Lisp_Object zone
)
2066 struct timespec t
= lisp_time_argument (timeval
);
2069 CHECK_STRING (format_string
);
2070 format_string
= code_convert_string_norecord (format_string
,
2071 Vlocale_coding_system
, 1);
2072 return format_time_string (SSDATA (format_string
), SBYTES (format_string
),
2077 format_time_string (char const *format
, ptrdiff_t formatlen
,
2078 struct timespec t
, Lisp_Object zone
, struct tm
*tmp
)
2082 ptrdiff_t size
= sizeof buffer
;
2087 timezone_t tz
= tzlookup (zone
, false);
2088 tmp
= emacs_localtime_rz (tz
, &t
.tv_sec
, tmp
);
2094 synchronize_system_time_locale ();
2099 len
= emacs_nmemftime (buf
, size
, format
, formatlen
, tmp
, tz
, ns
);
2100 if ((0 < len
&& len
< size
) || (len
== 0 && buf
[0] == '\0'))
2103 /* Buffer was too small, so make it bigger and try again. */
2104 len
= emacs_nmemftime (NULL
, SIZE_MAX
, format
, formatlen
, tmp
, tz
, ns
);
2105 if (STRING_BYTES_BOUND
<= len
)
2111 buf
= SAFE_ALLOCA (size
);
2115 AUTO_STRING_WITH_LEN (bufstring
, buf
, len
);
2116 Lisp_Object result
= code_convert_string_norecord (bufstring
,
2117 Vlocale_coding_system
, 0);
2122 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 2, 0,
2123 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF).
2124 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
2125 as from `current-time' and `file-attributes', or nil to use the
2126 current time. The obsolete form (HIGH . LOW) is also still accepted.
2128 The optional ZONE is omitted or nil for Emacs local time, t for
2129 Universal Time, `wall' for system wall clock time, or a string as in
2130 the TZ environment variable. It can also be a list (as from
2131 `current-time-zone') or an integer (as from `decode-time') applied
2132 without consideration for daylight saving time.
2134 The list has the following nine members: SEC is an integer between 0
2135 and 60; SEC is 60 for a leap second, which only some operating systems
2136 support. MINUTE is an integer between 0 and 59. HOUR is an integer
2137 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
2138 integer between 1 and 12. YEAR is an integer indicating the
2139 four-digit year. DOW is the day of week, an integer between 0 and 6,
2140 where 0 is Sunday. DST is t if daylight saving time is in effect,
2141 otherwise nil. UTCOFF is an integer indicating the UTC offset in
2142 seconds, i.e., the number of seconds east of Greenwich. (Note that
2143 Common Lisp has different meanings for DOW and UTCOFF.)
2145 usage: (decode-time &optional TIME ZONE) */)
2146 (Lisp_Object specified_time
, Lisp_Object zone
)
2148 time_t time_spec
= lisp_seconds_argument (specified_time
);
2149 struct tm local_tm
, gmt_tm
;
2150 timezone_t tz
= tzlookup (zone
, false);
2151 struct tm
*tm
= emacs_localtime_rz (tz
, &time_spec
, &local_tm
);
2155 && MOST_NEGATIVE_FIXNUM
- TM_YEAR_BASE
<= local_tm
.tm_year
2156 && local_tm
.tm_year
<= MOST_POSITIVE_FIXNUM
- TM_YEAR_BASE
))
2159 /* Avoid overflow when INT_MAX < EMACS_INT_MAX. */
2160 EMACS_INT tm_year_base
= TM_YEAR_BASE
;
2162 return CALLN (Flist
,
2163 make_number (local_tm
.tm_sec
),
2164 make_number (local_tm
.tm_min
),
2165 make_number (local_tm
.tm_hour
),
2166 make_number (local_tm
.tm_mday
),
2167 make_number (local_tm
.tm_mon
+ 1),
2168 make_number (local_tm
.tm_year
+ tm_year_base
),
2169 make_number (local_tm
.tm_wday
),
2170 local_tm
.tm_isdst
? Qt
: Qnil
,
2172 ? make_number (tm_gmtoff (&local_tm
))
2173 : gmtime_r (&time_spec
, &gmt_tm
)
2174 ? make_number (tm_diff (&local_tm
, &gmt_tm
))
2178 /* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that
2179 the result is representable as an int. */
2181 check_tm_member (Lisp_Object obj
, int offset
)
2184 EMACS_INT n
= XINT (obj
);
2186 if (INT_SUBTRACT_WRAPV (n
, offset
, &result
))
2191 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
2192 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
2193 This is the reverse operation of `decode-time', which see.
2195 The optional ZONE is omitted or nil for Emacs local time, t for
2196 Universal Time, `wall' for system wall clock time, or a string as in
2197 the TZ environment variable. It can also be a list (as from
2198 `current-time-zone') or an integer (as from `decode-time') applied
2199 without consideration for daylight saving time.
2201 You can pass more than 7 arguments; then the first six arguments
2202 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
2203 The intervening arguments are ignored.
2204 This feature lets (apply \\='encode-time (decode-time ...)) work.
2206 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
2207 for example, a DAY of 0 means the day preceding the given month.
2208 Year numbers less than 100 are treated just like other year numbers.
2209 If you want them to stand for years in this century, you must do that yourself.
2211 Years before 1970 are not guaranteed to work. On some systems,
2212 year values as low as 1901 do work.
2214 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
2215 (ptrdiff_t nargs
, Lisp_Object
*args
)
2219 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
2221 tm
.tm_sec
= check_tm_member (args
[0], 0);
2222 tm
.tm_min
= check_tm_member (args
[1], 0);
2223 tm
.tm_hour
= check_tm_member (args
[2], 0);
2224 tm
.tm_mday
= check_tm_member (args
[3], 0);
2225 tm
.tm_mon
= check_tm_member (args
[4], 1);
2226 tm
.tm_year
= check_tm_member (args
[5], TM_YEAR_BASE
);
2229 timezone_t tz
= tzlookup (zone
, false);
2230 value
= emacs_mktime_z (tz
, &tm
);
2233 if (value
== (time_t) -1)
2236 return list2i (hi_time (value
), lo_time (value
));
2239 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
,
2241 doc
: /* Return the current local time, as a human-readable string.
2242 Programs can use this function to decode a time,
2243 since the number of columns in each field is fixed
2244 if the year is in the range 1000-9999.
2245 The format is `Sun Sep 16 01:03:52 1973'.
2246 However, see also the functions `decode-time' and `format-time-string'
2247 which provide a much more powerful and general facility.
2249 If SPECIFIED-TIME is given, it is a time to format instead of the
2250 current time. The argument should have the form (HIGH LOW . IGNORED).
2251 Thus, you can use times obtained from `current-time' and from
2252 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
2253 but this is considered obsolete.
2255 The optional ZONE is omitted or nil for Emacs local time, t for
2256 Universal Time, `wall' for system wall clock time, or a string as in
2257 the TZ environment variable. It can also be a list (as from
2258 `current-time-zone') or an integer (as from `decode-time') applied
2259 without consideration for daylight saving time. */)
2260 (Lisp_Object specified_time
, Lisp_Object zone
)
2262 time_t value
= lisp_seconds_argument (specified_time
);
2263 timezone_t tz
= tzlookup (zone
, false);
2265 /* Convert to a string in ctime format, except without the trailing
2266 newline, and without the 4-digit year limit. Don't use asctime
2267 or ctime, as they might dump core if the year is outside the
2268 range -999 .. 9999. */
2270 struct tm
*tmp
= emacs_localtime_rz (tz
, &value
, &tm
);
2275 static char const wday_name
[][4] =
2276 { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
2277 static char const mon_name
[][4] =
2278 { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
2279 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
2280 printmax_t year_base
= TM_YEAR_BASE
;
2281 char buf
[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1];
2282 int len
= sprintf (buf
, "%s %s%3d %02d:%02d:%02d %"pMd
,
2283 wday_name
[tm
.tm_wday
], mon_name
[tm
.tm_mon
], tm
.tm_mday
,
2284 tm
.tm_hour
, tm
.tm_min
, tm
.tm_sec
,
2285 tm
.tm_year
+ year_base
);
2287 return make_unibyte_string (buf
, len
);
2290 /* Yield A - B, measured in seconds.
2291 This function is copied from the GNU C Library. */
2293 tm_diff (struct tm
*a
, struct tm
*b
)
2295 /* Compute intervening leap days correctly even if year is negative.
2296 Take care to avoid int overflow in leap day calculations,
2297 but it's OK to assume that A and B are close to each other. */
2298 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
2299 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
2300 int a100
= a4
/ 25 - (a4
% 25 < 0);
2301 int b100
= b4
/ 25 - (b4
% 25 < 0);
2302 int a400
= a100
>> 2;
2303 int b400
= b100
>> 2;
2304 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
2305 int years
= a
->tm_year
- b
->tm_year
;
2306 int days
= (365 * years
+ intervening_leap_days
2307 + (a
->tm_yday
- b
->tm_yday
));
2308 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
2309 + (a
->tm_min
- b
->tm_min
))
2310 + (a
->tm_sec
- b
->tm_sec
));
2313 /* Yield A's UTC offset, or an unspecified value if unknown. */
2315 tm_gmtoff (struct tm
*a
)
2318 return a
->tm_gmtoff
;
2324 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 2, 0,
2325 doc
: /* Return the offset and name for the local time zone.
2326 This returns a list of the form (OFFSET NAME).
2327 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
2328 A negative value means west of Greenwich.
2329 NAME is a string giving the name of the time zone.
2330 If SPECIFIED-TIME is given, the time zone offset is determined from it
2331 instead of using the current time. The argument should have the form
2332 \(HIGH LOW . IGNORED). Thus, you can use times obtained from
2333 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
2334 have the form (HIGH . LOW), but this is considered obsolete.
2336 The optional ZONE is omitted or nil for Emacs local time, t for
2337 Universal Time, `wall' for system wall clock time, or a string as in
2338 the TZ environment variable. It can also be a list (as from
2339 `current-time-zone') or an integer (as from `decode-time') applied
2340 without consideration for daylight saving time.
2342 Some operating systems cannot provide all this information to Emacs;
2343 in this case, `current-time-zone' returns a list containing nil for
2344 the data it can't find. */)
2345 (Lisp_Object specified_time
, Lisp_Object zone
)
2347 struct timespec value
;
2348 struct tm local_tm
, gmt_tm
;
2349 Lisp_Object zone_offset
, zone_name
;
2352 value
= make_timespec (lisp_seconds_argument (specified_time
), 0);
2353 zone_name
= format_time_string ("%Z", sizeof "%Z" - 1, value
,
2356 if (HAVE_TM_GMTOFF
|| gmtime_r (&value
.tv_sec
, &gmt_tm
))
2358 long int offset
= (HAVE_TM_GMTOFF
2359 ? tm_gmtoff (&local_tm
)
2360 : tm_diff (&local_tm
, &gmt_tm
));
2361 zone_offset
= make_number (offset
);
2362 if (SCHARS (zone_name
) == 0)
2364 /* No local time zone name is available; use numeric zone instead. */
2365 long int hour
= offset
/ 3600;
2366 int min_sec
= offset
% 3600;
2367 int amin_sec
= min_sec
< 0 ? - min_sec
: min_sec
;
2368 int min
= amin_sec
/ 60;
2369 int sec
= amin_sec
% 60;
2370 int min_prec
= min_sec
? 2 : 0;
2371 int sec_prec
= sec
? 2 : 0;
2372 char buf
[sizeof "+0000" + INT_STRLEN_BOUND (long int)];
2373 zone_name
= make_formatted_string (buf
, "%c%.2ld%.*d%.*d",
2374 (offset
< 0 ? '-' : '+'),
2375 hour
, min_prec
, min
, sec_prec
, sec
);
2379 return list2 (zone_offset
, zone_name
);
2382 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
2383 doc
: /* Set the Emacs local time zone using TZ, a string specifying a time zone rule.
2384 If TZ is nil or `wall', use system wall clock time; this differs from
2385 the usual Emacs convention where nil means current local time. If TZ
2386 is t, use Universal Time. If TZ is a list (as from
2387 `current-time-zone') or an integer (as from `decode-time'), use the
2388 specified time zone without consideration for daylight saving time.
2390 Instead of calling this function, you typically want something else.
2391 To temporarily use a different time zone rule for just one invocation
2392 of `decode-time', `encode-time', or `format-time-string', pass the
2393 function a ZONE argument. To change local time consistently
2394 throughout Emacs, call (setenv "TZ" TZ): this changes both the
2395 environment of the Emacs process and the variable
2396 `process-environment', whereas `set-time-zone-rule' affects only the
2400 tzlookup (NILP (tz
) ? Qwall
: tz
, true);
2404 /* A buffer holding a string of the form "TZ=value", intended
2405 to be part of the environment. If TZ is supposed to be unset,
2406 the buffer string is "tZ=". */
2407 static char *tzvalbuf
;
2409 /* Get the local time zone rule. */
2411 emacs_getenv_TZ (void)
2413 return tzvalbuf
[0] == 'T' ? tzvalbuf
+ tzeqlen
: 0;
2416 /* Set the local time zone rule to TZSTRING, which can be null to
2417 denote wall clock time. Do not record the setting in LOCAL_TZ.
2419 This function is not thread-safe, in theory because putenv is not,
2420 but mostly because of the static storage it updates. Other threads
2421 that invoke localtime etc. may be adversely affected while this
2422 function is executing. */
2425 emacs_setenv_TZ (const char *tzstring
)
2427 static ptrdiff_t tzvalbufsize
;
2428 ptrdiff_t tzstringlen
= tzstring
? strlen (tzstring
) : 0;
2429 char *tzval
= tzvalbuf
;
2430 bool new_tzvalbuf
= tzvalbufsize
<= tzeqlen
+ tzstringlen
;
2434 /* Do not attempt to free the old tzvalbuf, since another thread
2435 may be using it. In practice, the first allocation is large
2436 enough and memory does not leak. */
2437 tzval
= xpalloc (NULL
, &tzvalbufsize
,
2438 tzeqlen
+ tzstringlen
- tzvalbufsize
+ 1, -1, 1);
2446 /* Modify TZVAL in place. Although this is dicey in a
2447 multithreaded environment, we know of no portable alternative.
2448 Calling putenv or setenv could crash some other thread. */
2450 strcpy (tzval
+ tzeqlen
, tzstring
);
2454 /* Turn 'TZ=whatever' into an empty environment variable 'tZ='.
2455 Although this is also dicey, calling unsetenv here can crash Emacs.
2463 /* Modifying *TZVAL merely requires calling tzset (which is the
2464 caller's responsibility). However, modifying TZVAL requires
2465 calling putenv; although this is not thread-safe, in practice this
2466 runs only on startup when there is only one thread. */
2467 bool need_putenv
= new_tzvalbuf
;
2469 /* MS-Windows 'putenv' copies the argument string into a block it
2470 allocates, so modifying *TZVAL will not change the environment.
2471 However, the other threads run by Emacs on MS-Windows never call
2472 'xputenv' or 'putenv' or 'unsetenv', so the original cause for the
2473 dicey in-place modification technique doesn't exist there in the
2475 bool need_putenv
= true;
2483 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2484 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2485 type of object is Lisp_String). INHERIT is passed to
2486 INSERT_FROM_STRING_FUNC as the last argument. */
2489 general_insert_function (void (*insert_func
)
2490 (const char *, ptrdiff_t),
2491 void (*insert_from_string_func
)
2492 (Lisp_Object
, ptrdiff_t, ptrdiff_t,
2493 ptrdiff_t, ptrdiff_t, bool),
2494 bool inherit
, ptrdiff_t nargs
, Lisp_Object
*args
)
2499 for (argnum
= 0; argnum
< nargs
; argnum
++)
2502 if (CHARACTERP (val
))
2504 int c
= XFASTINT (val
);
2505 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2508 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2509 len
= CHAR_STRING (c
, str
);
2512 str
[0] = CHAR_TO_BYTE8 (c
);
2515 (*insert_func
) ((char *) str
, len
);
2517 else if (STRINGP (val
))
2519 (*insert_from_string_func
) (val
, 0, 0,
2525 wrong_type_argument (Qchar_or_string_p
, val
);
2530 insert1 (Lisp_Object arg
)
2536 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2537 doc
: /* Insert the arguments, either strings or characters, at point.
2538 Point and after-insertion markers move forward to end up
2539 after the inserted text.
2540 Any other markers at the point of insertion remain before the text.
2542 If the current buffer is multibyte, unibyte strings are converted
2543 to multibyte for insertion (see `string-make-multibyte').
2544 If the current buffer is unibyte, multibyte strings are converted
2545 to unibyte for insertion (see `string-make-unibyte').
2547 When operating on binary data, it may be necessary to preserve the
2548 original bytes of a unibyte string when inserting it into a multibyte
2549 buffer; to accomplish this, apply `string-as-multibyte' to the string
2550 and insert the result.
2552 usage: (insert &rest ARGS) */)
2553 (ptrdiff_t nargs
, Lisp_Object
*args
)
2555 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2559 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2561 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2562 Point and after-insertion markers move forward to end up
2563 after the inserted text.
2564 Any other markers at the point of insertion remain before the text.
2566 If the current buffer is multibyte, unibyte strings are converted
2567 to multibyte for insertion (see `unibyte-char-to-multibyte').
2568 If the current buffer is unibyte, multibyte strings are converted
2569 to unibyte for insertion.
2571 usage: (insert-and-inherit &rest ARGS) */)
2572 (ptrdiff_t nargs
, Lisp_Object
*args
)
2574 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2579 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2580 doc
: /* Insert strings or characters at point, relocating markers after the text.
2581 Point and markers move forward to end up after the inserted text.
2583 If the current buffer is multibyte, unibyte strings are converted
2584 to multibyte for insertion (see `unibyte-char-to-multibyte').
2585 If the current buffer is unibyte, multibyte strings are converted
2586 to unibyte for insertion.
2588 If an overlay begins at the insertion point, the inserted text falls
2589 outside the overlay; if a nonempty overlay ends at the insertion
2590 point, the inserted text falls inside that overlay.
2592 usage: (insert-before-markers &rest ARGS) */)
2593 (ptrdiff_t nargs
, Lisp_Object
*args
)
2595 general_insert_function (insert_before_markers
,
2596 insert_from_string_before_markers
, 0,
2601 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2602 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2603 doc
: /* Insert text at point, relocating markers and inheriting properties.
2604 Point and markers move forward to end up after the inserted text.
2606 If the current buffer is multibyte, unibyte strings are converted
2607 to multibyte for insertion (see `unibyte-char-to-multibyte').
2608 If the current buffer is unibyte, multibyte strings are converted
2609 to unibyte for insertion.
2611 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2612 (ptrdiff_t nargs
, Lisp_Object
*args
)
2614 general_insert_function (insert_before_markers_and_inherit
,
2615 insert_from_string_before_markers
, 1,
2620 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 1, 3,
2621 "(list (read-char-by-name \"Insert character (Unicode name or hex): \")\
2622 (prefix-numeric-value current-prefix-arg)\
2624 doc
: /* Insert COUNT copies of CHARACTER.
2625 Interactively, prompt for CHARACTER. You can specify CHARACTER in one
2628 - As its Unicode character name, e.g. \"LATIN SMALL LETTER A\".
2629 Completion is available; if you type a substring of the name
2630 preceded by an asterisk `*', Emacs shows all names which include
2631 that substring, not necessarily at the beginning of the name.
2633 - As a hexadecimal code point, e.g. 263A. Note that code points in
2634 Emacs are equivalent to Unicode up to 10FFFF (which is the limit of
2635 the Unicode code space).
2637 - As a code point with a radix specified with #, e.g. #o21430
2638 (octal), #x2318 (hex), or #10r8984 (decimal).
2640 If called interactively, COUNT is given by the prefix argument. If
2641 omitted or nil, it defaults to 1.
2643 Inserting the character(s) relocates point and before-insertion
2644 markers in the same ways as the function `insert'.
2646 The optional third argument INHERIT, if non-nil, says to inherit text
2647 properties from adjoining text, if those properties are sticky. If
2648 called interactively, INHERIT is t. */)
2649 (Lisp_Object character
, Lisp_Object count
, Lisp_Object inherit
)
2652 register ptrdiff_t n
;
2654 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2657 CHECK_CHARACTER (character
);
2659 XSETFASTINT (count
, 1);
2660 CHECK_NUMBER (count
);
2661 c
= XFASTINT (character
);
2663 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2664 len
= CHAR_STRING (c
, str
);
2666 str
[0] = c
, len
= 1;
2667 if (XINT (count
) <= 0)
2669 if (BUF_BYTES_MAX
/ len
< XINT (count
))
2671 n
= XINT (count
) * len
;
2672 stringlen
= min (n
, sizeof string
- sizeof string
% len
);
2673 for (i
= 0; i
< stringlen
; i
++)
2674 string
[i
] = str
[i
% len
];
2675 while (n
> stringlen
)
2678 if (!NILP (inherit
))
2679 insert_and_inherit (string
, stringlen
);
2681 insert (string
, stringlen
);
2684 if (!NILP (inherit
))
2685 insert_and_inherit (string
, n
);
2691 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2692 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2693 Both arguments are required.
2694 BYTE is a number of the range 0..255.
2696 If BYTE is 128..255 and the current buffer is multibyte, the
2697 corresponding eight-bit character is inserted.
2699 Point, and before-insertion markers, are relocated as in the function `insert'.
2700 The optional third arg INHERIT, if non-nil, says to inherit text properties
2701 from adjoining text, if those properties are sticky. */)
2702 (Lisp_Object byte
, Lisp_Object count
, Lisp_Object inherit
)
2704 CHECK_NUMBER (byte
);
2705 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2706 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2707 if (XINT (byte
) >= 128
2708 && ! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2709 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2710 return Finsert_char (byte
, count
, inherit
);
2714 /* Making strings from buffer contents. */
2716 /* Return a Lisp_String containing the text of the current buffer from
2717 START to END. If text properties are in use and the current buffer
2718 has properties in the range specified, the resulting string will also
2719 have them, if PROPS is true.
2721 We don't want to use plain old make_string here, because it calls
2722 make_uninit_string, which can cause the buffer arena to be
2723 compacted. make_string has no way of knowing that the data has
2724 been moved, and thus copies the wrong data into the string. This
2725 doesn't effect most of the other users of make_string, so it should
2726 be left as is. But we should use this function when conjuring
2727 buffer substrings. */
2730 make_buffer_string (ptrdiff_t start
, ptrdiff_t end
, bool props
)
2732 ptrdiff_t start_byte
= CHAR_TO_BYTE (start
);
2733 ptrdiff_t end_byte
= CHAR_TO_BYTE (end
);
2735 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2738 /* Return a Lisp_String containing the text of the current buffer from
2739 START / START_BYTE to END / END_BYTE.
2741 If text properties are in use and the current buffer
2742 has properties in the range specified, the resulting string will also
2743 have them, if PROPS is true.
2745 We don't want to use plain old make_string here, because it calls
2746 make_uninit_string, which can cause the buffer arena to be
2747 compacted. make_string has no way of knowing that the data has
2748 been moved, and thus copies the wrong data into the string. This
2749 doesn't effect most of the other users of make_string, so it should
2750 be left as is. But we should use this function when conjuring
2751 buffer substrings. */
2754 make_buffer_string_both (ptrdiff_t start
, ptrdiff_t start_byte
,
2755 ptrdiff_t end
, ptrdiff_t end_byte
, bool props
)
2757 Lisp_Object result
, tem
, tem1
;
2758 ptrdiff_t beg0
, end0
, beg1
, end1
, size
;
2760 if (start_byte
< GPT_BYTE
&& GPT_BYTE
< end_byte
)
2762 /* Two regions, before and after the gap. */
2765 beg1
= GPT_BYTE
+ GAP_SIZE
- BEG_BYTE
;
2766 end1
= end_byte
+ GAP_SIZE
- BEG_BYTE
;
2770 /* The only region. */
2777 if (! NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2778 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2780 result
= make_uninit_string (end
- start
);
2783 memcpy (SDATA (result
), BYTE_POS_ADDR (beg0
), size
);
2785 memcpy (SDATA (result
) + size
, BEG_ADDR
+ beg1
, end1
- beg1
);
2787 /* If desired, update and copy the text properties. */
2790 update_buffer_properties (start
, end
);
2792 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2793 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2795 if (XINT (tem
) != end
|| !NILP (tem1
))
2796 copy_intervals_to_string (result
, current_buffer
, start
,
2803 /* Call Vbuffer_access_fontify_functions for the range START ... END
2804 in the current buffer, if necessary. */
2807 update_buffer_properties (ptrdiff_t start
, ptrdiff_t end
)
2809 /* If this buffer has some access functions,
2810 call them, specifying the range of the buffer being accessed. */
2811 if (!NILP (Vbuffer_access_fontify_functions
))
2813 /* But don't call them if we can tell that the work
2814 has already been done. */
2815 if (!NILP (Vbuffer_access_fontified_property
))
2818 = Ftext_property_any (make_number (start
), make_number (end
),
2819 Vbuffer_access_fontified_property
,
2825 CALLN (Frun_hook_with_args
, Qbuffer_access_fontify_functions
,
2826 make_number (start
), make_number (end
));
2830 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2831 doc
: /* Return the contents of part of the current buffer as a string.
2832 The two arguments START and END are character positions;
2833 they can be in either order.
2834 The string returned is multibyte if the buffer is multibyte.
2836 This function copies the text properties of that part of the buffer
2837 into the result string; if you don't want the text properties,
2838 use `buffer-substring-no-properties' instead. */)
2839 (Lisp_Object start
, Lisp_Object end
)
2841 register ptrdiff_t b
, e
;
2843 validate_region (&start
, &end
);
2847 return make_buffer_string (b
, e
, 1);
2850 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2851 Sbuffer_substring_no_properties
, 2, 2, 0,
2852 doc
: /* Return the characters of part of the buffer, without the text properties.
2853 The two arguments START and END are character positions;
2854 they can be in either order. */)
2855 (Lisp_Object start
, Lisp_Object end
)
2857 register ptrdiff_t b
, e
;
2859 validate_region (&start
, &end
);
2863 return make_buffer_string (b
, e
, 0);
2866 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2867 doc
: /* Return the contents of the current buffer as a string.
2868 If narrowing is in effect, this function returns only the visible part
2872 return make_buffer_string_both (BEGV
, BEGV_BYTE
, ZV
, ZV_BYTE
, 1);
2875 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2877 doc
: /* Insert before point a substring of the contents of BUFFER.
2878 BUFFER may be a buffer or a buffer name.
2879 Arguments START and END are character positions specifying the substring.
2880 They default to the values of (point-min) and (point-max) in BUFFER.
2882 Point and before-insertion markers move forward to end up after the
2884 Any other markers at the point of insertion remain before the text.
2886 If the current buffer is multibyte and BUFFER is unibyte, or vice
2887 versa, strings are converted from unibyte to multibyte or vice versa
2888 using `string-make-multibyte' or `string-make-unibyte', which see. */)
2889 (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
2891 register EMACS_INT b
, e
, temp
;
2892 register struct buffer
*bp
, *obuf
;
2895 buf
= Fget_buffer (buffer
);
2899 if (!BUFFER_LIVE_P (bp
))
2900 error ("Selecting deleted buffer");
2906 CHECK_NUMBER_COERCE_MARKER (start
);
2913 CHECK_NUMBER_COERCE_MARKER (end
);
2918 temp
= b
, b
= e
, e
= temp
;
2920 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2921 args_out_of_range (start
, end
);
2923 obuf
= current_buffer
;
2924 set_buffer_internal_1 (bp
);
2925 update_buffer_properties (b
, e
);
2926 set_buffer_internal_1 (obuf
);
2928 insert_from_buffer (bp
, b
, e
- b
, 0);
2932 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2934 doc
: /* Compare two substrings of two buffers; return result as number.
2935 Return -N if first string is less after N-1 chars, +N if first string is
2936 greater after N-1 chars, or 0 if strings match.
2937 The first substring is in BUFFER1 from START1 to END1 and the second
2938 is in BUFFER2 from START2 to END2.
2939 All arguments may be nil. If BUFFER1 or BUFFER2 is nil, the current
2940 buffer is used. If START1 or START2 is nil, the value of `point-min'
2941 in the respective buffers is used. If END1 or END2 is nil, the value
2942 of `point-max' in the respective buffers is used.
2943 The value of `case-fold-search' in the current buffer
2944 determines whether case is significant or ignored. */)
2945 (Lisp_Object buffer1
, Lisp_Object start1
, Lisp_Object end1
, Lisp_Object buffer2
, Lisp_Object start2
, Lisp_Object end2
)
2947 register EMACS_INT begp1
, endp1
, begp2
, endp2
, temp
;
2948 register struct buffer
*bp1
, *bp2
;
2949 register Lisp_Object trt
2950 = (!NILP (BVAR (current_buffer
, case_fold_search
))
2951 ? BVAR (current_buffer
, case_canon_table
) : Qnil
);
2952 ptrdiff_t chars
= 0;
2953 ptrdiff_t i1
, i2
, i1_byte
, i2_byte
;
2955 /* Find the first buffer and its substring. */
2958 bp1
= current_buffer
;
2962 buf1
= Fget_buffer (buffer1
);
2965 bp1
= XBUFFER (buf1
);
2966 if (!BUFFER_LIVE_P (bp1
))
2967 error ("Selecting deleted buffer");
2971 begp1
= BUF_BEGV (bp1
);
2974 CHECK_NUMBER_COERCE_MARKER (start1
);
2975 begp1
= XINT (start1
);
2978 endp1
= BUF_ZV (bp1
);
2981 CHECK_NUMBER_COERCE_MARKER (end1
);
2982 endp1
= XINT (end1
);
2986 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2988 if (!(BUF_BEGV (bp1
) <= begp1
2990 && endp1
<= BUF_ZV (bp1
)))
2991 args_out_of_range (start1
, end1
);
2993 /* Likewise for second substring. */
2996 bp2
= current_buffer
;
3000 buf2
= Fget_buffer (buffer2
);
3003 bp2
= XBUFFER (buf2
);
3004 if (!BUFFER_LIVE_P (bp2
))
3005 error ("Selecting deleted buffer");
3009 begp2
= BUF_BEGV (bp2
);
3012 CHECK_NUMBER_COERCE_MARKER (start2
);
3013 begp2
= XINT (start2
);
3016 endp2
= BUF_ZV (bp2
);
3019 CHECK_NUMBER_COERCE_MARKER (end2
);
3020 endp2
= XINT (end2
);
3024 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
3026 if (!(BUF_BEGV (bp2
) <= begp2
3028 && endp2
<= BUF_ZV (bp2
)))
3029 args_out_of_range (start2
, end2
);
3033 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
3034 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
3036 while (i1
< endp1
&& i2
< endp2
)
3038 /* When we find a mismatch, we must compare the
3039 characters, not just the bytes. */
3044 if (! NILP (BVAR (bp1
, enable_multibyte_characters
)))
3046 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
3047 BUF_INC_POS (bp1
, i1_byte
);
3052 c1
= BUF_FETCH_BYTE (bp1
, i1
);
3053 MAKE_CHAR_MULTIBYTE (c1
);
3057 if (! NILP (BVAR (bp2
, enable_multibyte_characters
)))
3059 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
3060 BUF_INC_POS (bp2
, i2_byte
);
3065 c2
= BUF_FETCH_BYTE (bp2
, i2
);
3066 MAKE_CHAR_MULTIBYTE (c2
);
3072 c1
= char_table_translate (trt
, c1
);
3073 c2
= char_table_translate (trt
, c2
);
3076 return make_number (- 1 - chars
);
3078 return make_number (chars
+ 1);
3083 /* The strings match as far as they go.
3084 If one is shorter, that one is less. */
3085 if (chars
< endp1
- begp1
)
3086 return make_number (chars
+ 1);
3087 else if (chars
< endp2
- begp2
)
3088 return make_number (- chars
- 1);
3090 /* Same length too => they are equal. */
3091 return make_number (0);
3095 subst_char_in_region_unwind (Lisp_Object arg
)
3097 bset_undo_list (current_buffer
, arg
);
3101 subst_char_in_region_unwind_1 (Lisp_Object arg
)
3103 bset_filename (current_buffer
, arg
);
3106 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
3107 Ssubst_char_in_region
, 4, 5, 0,
3108 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
3109 If optional arg NOUNDO is non-nil, don't record this change for undo
3110 and don't mark the buffer as really changed.
3111 Both characters must have the same length of multi-byte form. */)
3112 (Lisp_Object start
, Lisp_Object end
, Lisp_Object fromchar
, Lisp_Object tochar
, Lisp_Object noundo
)
3114 register ptrdiff_t pos
, pos_byte
, stop
, i
, len
, end_byte
;
3115 /* Keep track of the first change in the buffer:
3116 if 0 we haven't found it yet.
3117 if < 0 we've found it and we've run the before-change-function.
3118 if > 0 we've actually performed it and the value is its position. */
3119 ptrdiff_t changed
= 0;
3120 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
3122 ptrdiff_t count
= SPECPDL_INDEX ();
3123 #define COMBINING_NO 0
3124 #define COMBINING_BEFORE 1
3125 #define COMBINING_AFTER 2
3126 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
3127 int maybe_byte_combining
= COMBINING_NO
;
3128 ptrdiff_t last_changed
= 0;
3130 = !NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3135 validate_region (&start
, &end
);
3136 CHECK_CHARACTER (fromchar
);
3137 CHECK_CHARACTER (tochar
);
3138 fromc
= XFASTINT (fromchar
);
3139 toc
= XFASTINT (tochar
);
3143 len
= CHAR_STRING (fromc
, fromstr
);
3144 if (CHAR_STRING (toc
, tostr
) != len
)
3145 error ("Characters in `subst-char-in-region' have different byte-lengths");
3146 if (!ASCII_CHAR_P (*tostr
))
3148 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
3149 complete multibyte character, it may be combined with the
3150 after bytes. If it is in the range 0xA0..0xFF, it may be
3151 combined with the before and after bytes. */
3152 if (!CHAR_HEAD_P (*tostr
))
3153 maybe_byte_combining
= COMBINING_BOTH
;
3154 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
3155 maybe_byte_combining
= COMBINING_AFTER
;
3166 pos_byte
= CHAR_TO_BYTE (pos
);
3167 stop
= CHAR_TO_BYTE (XINT (end
));
3170 /* If we don't want undo, turn off putting stuff on the list.
3171 That's faster than getting rid of things,
3172 and it prevents even the entry for a first change.
3173 Also inhibit locking the file. */
3174 if (!changed
&& !NILP (noundo
))
3176 record_unwind_protect (subst_char_in_region_unwind
,
3177 BVAR (current_buffer
, undo_list
));
3178 bset_undo_list (current_buffer
, Qt
);
3179 /* Don't do file-locking. */
3180 record_unwind_protect (subst_char_in_region_unwind_1
,
3181 BVAR (current_buffer
, filename
));
3182 bset_filename (current_buffer
, Qnil
);
3185 if (pos_byte
< GPT_BYTE
)
3186 stop
= min (stop
, GPT_BYTE
);
3189 ptrdiff_t pos_byte_next
= pos_byte
;
3191 if (pos_byte
>= stop
)
3193 if (pos_byte
>= end_byte
) break;
3196 p
= BYTE_POS_ADDR (pos_byte
);
3198 INC_POS (pos_byte_next
);
3201 if (pos_byte_next
- pos_byte
== len
3202 && p
[0] == fromstr
[0]
3204 || (p
[1] == fromstr
[1]
3205 && (len
== 2 || (p
[2] == fromstr
[2]
3206 && (len
== 3 || p
[3] == fromstr
[3]))))))
3209 /* We've already seen this and run the before-change-function;
3210 this time we only need to record the actual position. */
3215 modify_text (pos
, XINT (end
));
3217 if (! NILP (noundo
))
3219 if (MODIFF
- 1 == SAVE_MODIFF
)
3221 if (MODIFF
- 1 == BUF_AUTOSAVE_MODIFF (current_buffer
))
3222 BUF_AUTOSAVE_MODIFF (current_buffer
)++;
3225 /* The before-change-function may have moved the gap
3226 or even modified the buffer so we should start over. */
3230 /* Take care of the case where the new character
3231 combines with neighboring bytes. */
3232 if (maybe_byte_combining
3233 && (maybe_byte_combining
== COMBINING_AFTER
3234 ? (pos_byte_next
< Z_BYTE
3235 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
3236 : ((pos_byte_next
< Z_BYTE
3237 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
3238 || (pos_byte
> BEG_BYTE
3239 && ! ASCII_CHAR_P (FETCH_BYTE (pos_byte
- 1))))))
3241 Lisp_Object tem
, string
;
3243 tem
= BVAR (current_buffer
, undo_list
);
3245 /* Make a multibyte string containing this single character. */
3246 string
= make_multibyte_string ((char *) tostr
, 1, len
);
3247 /* replace_range is less efficient, because it moves the gap,
3248 but it handles combining correctly. */
3249 replace_range (pos
, pos
+ 1, string
,
3251 pos_byte_next
= CHAR_TO_BYTE (pos
);
3252 if (pos_byte_next
> pos_byte
)
3253 /* Before combining happened. We should not increment
3254 POS. So, to cancel the later increment of POS,
3258 INC_POS (pos_byte_next
);
3260 if (! NILP (noundo
))
3261 bset_undo_list (current_buffer
, tem
);
3266 record_change (pos
, 1);
3267 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
3269 last_changed
= pos
+ 1;
3271 pos_byte
= pos_byte_next
;
3277 signal_after_change (changed
,
3278 last_changed
- changed
, last_changed
- changed
);
3279 update_compositions (changed
, last_changed
, CHECK_ALL
);
3282 unbind_to (count
, Qnil
);
3287 static Lisp_Object
check_translation (ptrdiff_t, ptrdiff_t, ptrdiff_t,
3290 /* Helper function for Ftranslate_region_internal.
3292 Check if a character sequence at POS (POS_BYTE) matches an element
3293 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
3294 element is found, return it. Otherwise return Qnil. */
3297 check_translation (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t end
,
3300 int initial_buf
[16];
3301 int *buf
= initial_buf
;
3302 ptrdiff_t buf_size
= ARRAYELTS (initial_buf
);
3304 ptrdiff_t buf_used
= 0;
3305 Lisp_Object result
= Qnil
;
3307 for (; CONSP (val
); val
= XCDR (val
))
3316 if (! VECTORP (elt
))
3319 if (len
<= end
- pos
)
3321 for (i
= 0; i
< len
; i
++)
3325 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3328 if (buf_used
== buf_size
)
3330 bufalloc
= xpalloc (bufalloc
, &buf_size
, 1, -1,
3332 if (buf
== initial_buf
)
3333 memcpy (bufalloc
, buf
, sizeof initial_buf
);
3336 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, len1
);
3339 if (XINT (AREF (elt
, i
)) != buf
[i
])
3344 result
= XCAR (val
);
3355 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
3356 Stranslate_region_internal
, 3, 3, 0,
3357 doc
: /* Internal use only.
3358 From START to END, translate characters according to TABLE.
3359 TABLE is a string or a char-table; the Nth character in it is the
3360 mapping for the character with code N.
3361 It returns the number of characters changed. */)
3362 (Lisp_Object start
, Lisp_Object end
, register Lisp_Object table
)
3364 register unsigned char *tt
; /* Trans table. */
3365 register int nc
; /* New character. */
3366 int cnt
; /* Number of changes made. */
3367 ptrdiff_t size
; /* Size of translate table. */
3368 ptrdiff_t pos
, pos_byte
, end_pos
;
3369 bool multibyte
= !NILP (BVAR (current_buffer
, enable_multibyte_characters
));
3370 bool string_multibyte UNINIT
;
3372 validate_region (&start
, &end
);
3373 if (CHAR_TABLE_P (table
))
3375 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
3376 error ("Not a translation table");
3382 CHECK_STRING (table
);
3384 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
3385 table
= string_make_unibyte (table
);
3386 string_multibyte
= SCHARS (table
) < SBYTES (table
);
3387 size
= SBYTES (table
);
3392 pos_byte
= CHAR_TO_BYTE (pos
);
3393 end_pos
= XINT (end
);
3394 modify_text (pos
, end_pos
);
3397 for (; pos
< end_pos
; )
3399 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3400 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
3406 oc
= STRING_CHAR_AND_LENGTH (p
, len
);
3413 /* Reload as signal_after_change in last iteration may GC. */
3415 if (string_multibyte
)
3417 str
= tt
+ string_char_to_byte (table
, oc
);
3418 nc
= STRING_CHAR_AND_LENGTH (str
, str_len
);
3423 if (! ASCII_CHAR_P (nc
) && multibyte
)
3425 str_len
= BYTE8_STRING (nc
, buf
);
3438 val
= CHAR_TABLE_REF (table
, oc
);
3439 if (CHARACTERP (val
))
3441 nc
= XFASTINT (val
);
3442 str_len
= CHAR_STRING (nc
, buf
);
3445 else if (VECTORP (val
) || (CONSP (val
)))
3447 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3448 where TO is TO-CHAR or [TO-CHAR ...]. */
3453 if (nc
!= oc
&& nc
>= 0)
3455 /* Simple one char to one char translation. */
3460 /* This is less efficient, because it moves the gap,
3461 but it should handle multibyte characters correctly. */
3462 string
= make_multibyte_string ((char *) str
, 1, str_len
);
3463 replace_range (pos
, pos
+ 1, string
, 1, 0, 1, 0);
3468 record_change (pos
, 1);
3469 while (str_len
-- > 0)
3471 signal_after_change (pos
, 1, 1);
3472 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3482 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3489 /* VAL is ([FROM-CHAR ...] . TO). */
3490 len
= ASIZE (XCAR (val
));
3498 string
= Fconcat (1, &val
);
3502 string
= Fmake_string (make_number (1), val
);
3504 replace_range (pos
, pos
+ len
, string
, 1, 0, 1, 0);
3505 pos_byte
+= SBYTES (string
);
3506 pos
+= SCHARS (string
);
3507 cnt
+= SCHARS (string
);
3508 end_pos
+= SCHARS (string
) - len
;
3516 return make_number (cnt
);
3519 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3520 doc
: /* Delete the text between START and END.
3521 If called interactively, delete the region between point and mark.
3522 This command deletes buffer text without modifying the kill ring. */)
3523 (Lisp_Object start
, Lisp_Object end
)
3525 validate_region (&start
, &end
);
3526 del_range (XINT (start
), XINT (end
));
3530 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3531 Sdelete_and_extract_region
, 2, 2, 0,
3532 doc
: /* Delete the text between START and END and return it. */)
3533 (Lisp_Object start
, Lisp_Object end
)
3535 validate_region (&start
, &end
);
3536 if (XINT (start
) == XINT (end
))
3537 return empty_unibyte_string
;
3538 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3541 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3542 doc
: /* Remove restrictions (narrowing) from current buffer.
3543 This allows the buffer's full text to be seen and edited. */)
3546 if (BEG
!= BEGV
|| Z
!= ZV
)
3547 current_buffer
->clip_changed
= 1;
3549 BEGV_BYTE
= BEG_BYTE
;
3550 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3551 /* Changing the buffer bounds invalidates any recorded current column. */
3552 invalidate_current_column ();
3556 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3557 doc
: /* Restrict editing in this buffer to the current region.
3558 The rest of the text becomes temporarily invisible and untouchable
3559 but is not deleted; if you save the buffer in a file, the invisible
3560 text is included in the file. \\[widen] makes all visible again.
3561 See also `save-restriction'.
3563 When calling from a program, pass two arguments; positions (integers
3564 or markers) bounding the text that should remain visible. */)
3565 (register Lisp_Object start
, Lisp_Object end
)
3567 CHECK_NUMBER_COERCE_MARKER (start
);
3568 CHECK_NUMBER_COERCE_MARKER (end
);
3570 if (XINT (start
) > XINT (end
))
3573 tem
= start
; start
= end
; end
= tem
;
3576 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3577 args_out_of_range (start
, end
);
3579 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3580 current_buffer
->clip_changed
= 1;
3582 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3583 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3584 if (PT
< XFASTINT (start
))
3585 SET_PT (XFASTINT (start
));
3586 if (PT
> XFASTINT (end
))
3587 SET_PT (XFASTINT (end
));
3588 /* Changing the buffer bounds invalidates any recorded current column. */
3589 invalidate_current_column ();
3594 save_restriction_save (void)
3596 if (BEGV
== BEG
&& ZV
== Z
)
3597 /* The common case that the buffer isn't narrowed.
3598 We return just the buffer object, which save_restriction_restore
3599 recognizes as meaning `no restriction'. */
3600 return Fcurrent_buffer ();
3602 /* We have to save a restriction, so return a pair of markers, one
3603 for the beginning and one for the end. */
3605 Lisp_Object beg
, end
;
3607 beg
= build_marker (current_buffer
, BEGV
, BEGV_BYTE
);
3608 end
= build_marker (current_buffer
, ZV
, ZV_BYTE
);
3610 /* END must move forward if text is inserted at its exact location. */
3611 XMARKER (end
)->insertion_type
= 1;
3613 return Fcons (beg
, end
);
3618 save_restriction_restore (Lisp_Object data
)
3620 struct buffer
*cur
= NULL
;
3621 struct buffer
*buf
= (CONSP (data
)
3622 ? XMARKER (XCAR (data
))->buffer
3625 if (buf
&& buf
!= current_buffer
&& !NILP (BVAR (buf
, pt_marker
)))
3626 { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
3627 is the case if it is or has an indirect buffer), then make
3628 sure it is current before we update BEGV, so
3629 set_buffer_internal takes care of managing those markers. */
3630 cur
= current_buffer
;
3631 set_buffer_internal (buf
);
3635 /* A pair of marks bounding a saved restriction. */
3637 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3638 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3639 eassert (buf
== end
->buffer
);
3641 if (buf
/* Verify marker still points to a buffer. */
3642 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3643 /* The restriction has changed from the saved one, so restore
3644 the saved restriction. */
3646 ptrdiff_t pt
= BUF_PT (buf
);
3648 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3649 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3651 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3652 /* The point is outside the new visible range, move it inside. */
3653 SET_BUF_PT_BOTH (buf
,
3654 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3655 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3658 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3660 /* These aren't needed anymore, so don't wait for GC. */
3661 free_marker (XCAR (data
));
3662 free_marker (XCDR (data
));
3663 free_cons (XCONS (data
));
3666 /* A buffer, which means that there was no old restriction. */
3668 if (buf
/* Verify marker still points to a buffer. */
3669 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3670 /* The buffer has been narrowed, get rid of the narrowing. */
3672 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3673 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3675 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3679 /* Changing the buffer bounds invalidates any recorded current column. */
3680 invalidate_current_column ();
3683 set_buffer_internal (cur
);
3686 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3687 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3688 The buffer's restrictions make parts of the beginning and end invisible.
3689 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3690 This special form, `save-restriction', saves the current buffer's restrictions
3691 when it is entered, and restores them when it is exited.
3692 So any `narrow-to-region' within BODY lasts only until the end of the form.
3693 The old restrictions settings are restored
3694 even in case of abnormal exit (throw or error).
3696 The value returned is the value of the last form in BODY.
3698 Note: if you are using both `save-excursion' and `save-restriction',
3699 use `save-excursion' outermost:
3700 (save-excursion (save-restriction ...))
3702 usage: (save-restriction &rest BODY) */)
3705 register Lisp_Object val
;
3706 ptrdiff_t count
= SPECPDL_INDEX ();
3708 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3709 val
= Fprogn (body
);
3710 return unbind_to (count
, val
);
3713 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3714 doc
: /* Display a message at the bottom of the screen.
3715 The message also goes into the `*Messages*' buffer, if `message-log-max'
3716 is non-nil. (In keyboard macros, that's all it does.)
3719 In batch mode, the message is printed to the standard error stream,
3720 followed by a newline.
3722 The first argument is a format control string, and the rest are data
3723 to be formatted under control of the string. See `format-message' for
3726 Note: (message "%s" VALUE) displays the string VALUE without
3727 interpreting format characters like `%', `\\=`', and `\\=''.
3729 If the first argument is nil or the empty string, the function clears
3730 any existing message; this lets the minibuffer contents show. See
3731 also `current-message'.
3733 usage: (message FORMAT-STRING &rest ARGS) */)
3734 (ptrdiff_t nargs
, Lisp_Object
*args
)
3737 || (STRINGP (args
[0])
3738 && SBYTES (args
[0]) == 0))
3745 Lisp_Object val
= Fformat_message (nargs
, args
);
3751 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3752 doc
: /* Display a message, in a dialog box if possible.
3753 If a dialog box is not available, use the echo area.
3754 The first argument is a format control string, and the rest are data
3755 to be formatted under control of the string. See `format-message' for
3758 If the first argument is nil or the empty string, clear any existing
3759 message; let the minibuffer contents show.
3761 usage: (message-box FORMAT-STRING &rest ARGS) */)
3762 (ptrdiff_t nargs
, Lisp_Object
*args
)
3771 Lisp_Object val
= Fformat_message (nargs
, args
);
3772 Lisp_Object pane
, menu
;
3774 pane
= list1 (Fcons (build_string ("OK"), Qt
));
3775 menu
= Fcons (val
, pane
);
3776 Fx_popup_dialog (Qt
, menu
, Qt
);
3781 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3782 doc
: /* Display a message in a dialog box or in the echo area.
3783 If this command was invoked with the mouse, use a dialog box if
3784 `use-dialog-box' is non-nil.
3785 Otherwise, use the echo area.
3786 The first argument is a format control string, and the rest are data
3787 to be formatted under control of the string. See `format-message' for
3790 If the first argument is nil or the empty string, clear any existing
3791 message; let the minibuffer contents show.
3793 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3794 (ptrdiff_t nargs
, Lisp_Object
*args
)
3796 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3798 return Fmessage_box (nargs
, args
);
3799 return Fmessage (nargs
, args
);
3802 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3803 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3806 return current_message ();
3810 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3811 doc
: /* Return a copy of STRING with text properties added.
3812 First argument is the string to copy.
3813 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3814 properties to add to the result.
3815 usage: (propertize STRING &rest PROPERTIES) */)
3816 (ptrdiff_t nargs
, Lisp_Object
*args
)
3818 Lisp_Object properties
, string
;
3821 /* Number of args must be odd. */
3822 if ((nargs
& 1) == 0)
3823 error ("Wrong number of arguments");
3825 properties
= string
= Qnil
;
3827 /* First argument must be a string. */
3828 CHECK_STRING (args
[0]);
3829 string
= Fcopy_sequence (args
[0]);
3831 for (i
= 1; i
< nargs
; i
+= 2)
3832 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3834 Fadd_text_properties (make_number (0),
3835 make_number (SCHARS (string
)),
3836 properties
, string
);
3840 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3841 doc
: /* Format a string out of a format-string and arguments.
3842 The first argument is a format control string.
3843 The other arguments are substituted into it to make the result, a string.
3845 The format control string may contain %-sequences meaning to substitute
3846 the next available argument:
3848 %s means print a string argument. Actually, prints any object, with `princ'.
3849 %d means print as number in decimal (%o octal, %x hex).
3850 %X is like %x, but uses upper case.
3851 %e means print a number in exponential notation.
3852 %f means print a number in decimal-point notation.
3853 %g means print a number in exponential notation
3854 or decimal-point notation, whichever uses fewer characters.
3855 %c means print a number as a single character.
3856 %S means print any object as an s-expression (using `prin1').
3858 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3859 Use %% to put a single % into the output.
3861 A %-sequence may contain optional flag, width, and precision
3862 specifiers, as follows:
3864 %<flags><width><precision>character
3866 where flags is [+ #-0]+, width is [0-9]+, and precision is a literal
3867 period "." followed by [0-9]+
3869 The + flag character inserts a + before any positive number, while a
3870 space inserts a space before any positive number; these flags only
3871 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3872 The - and 0 flags affect the width specifier, as described below.
3874 The # flag means to use an alternate display form for %o, %x, %X, %e,
3875 %f, and %g sequences: for %o, it ensures that the result begins with
3876 \"0\"; for %x and %X, it prefixes the result with \"0x\" or \"0X\";
3877 for %e, %f, and %g, it causes a decimal point to be included even if
3878 the precision is zero.
3880 The width specifier supplies a lower limit for the length of the
3881 printed representation. The padding, if any, normally goes on the
3882 left, but it goes on the right if the - flag is present. The padding
3883 character is normally a space, but it is 0 if the 0 flag is present.
3884 The 0 flag is ignored if the - flag is present, or the format sequence
3885 is something other than %d, %e, %f, and %g.
3887 For %e, %f, and %g sequences, the number after the "." in the
3888 precision specifier says how many decimal places to show; if zero, the
3889 decimal point itself is omitted. For %s and %S, the precision
3890 specifier truncates the string to the given width.
3892 Text properties, if any, are copied from the format-string to the
3895 usage: (format STRING &rest OBJECTS) */)
3896 (ptrdiff_t nargs
, Lisp_Object
*args
)
3898 return styled_format (nargs
, args
, false);
3901 DEFUN ("format-message", Fformat_message
, Sformat_message
, 1, MANY
, 0,
3902 doc
: /* Format a string out of a format-string and arguments.
3903 The first argument is a format control string.
3904 The other arguments are substituted into it to make the result, a string.
3906 This acts like `format', except it also replaces each grave accent (\\=`)
3907 by a left quote, and each apostrophe (\\=') by a right quote. The left
3908 and right quote replacement characters are specified by
3909 `text-quoting-style'.
3911 usage: (format-message STRING &rest OBJECTS) */)
3912 (ptrdiff_t nargs
, Lisp_Object
*args
)
3914 return styled_format (nargs
, args
, true);
3917 /* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise. */
3920 styled_format (ptrdiff_t nargs
, Lisp_Object
*args
, bool message
)
3922 ptrdiff_t n
; /* The number of the next arg to substitute. */
3923 char initial_buffer
[4000];
3924 char *buf
= initial_buffer
;
3925 ptrdiff_t bufsize
= sizeof initial_buffer
;
3926 ptrdiff_t max_bufsize
= STRING_BYTES_BOUND
+ 1;
3928 ptrdiff_t buf_save_value_index UNINIT
;
3931 /* When we make a multibyte string, we must pay attention to the
3932 byte combining problem, i.e., a byte may be combined with a
3933 multibyte character of the previous string. This flag tells if we
3934 must consider such a situation or not. */
3935 bool maybe_combine_byte
;
3936 bool arg_intervals
= false;
3939 /* Each element records, for one argument,
3940 the start and end bytepos in the output string,
3941 whether the argument has been converted to string (e.g., due to "%S"),
3942 and whether the argument is a string with intervals. */
3945 ptrdiff_t start
, end
;
3946 bool_bf converted_to_string
: 1;
3947 bool_bf intervals
: 1;
3950 CHECK_STRING (args
[0]);
3951 char *format_start
= SSDATA (args
[0]);
3952 ptrdiff_t formatlen
= SBYTES (args
[0]);
3954 /* Allocate the info and discarded tables. */
3955 ptrdiff_t alloca_size
;
3956 if (INT_MULTIPLY_WRAPV (nargs
, sizeof *info
, &alloca_size
)
3957 || INT_ADD_WRAPV (sizeof *info
, alloca_size
, &alloca_size
)
3958 || INT_ADD_WRAPV (formatlen
, alloca_size
, &alloca_size
)
3959 || SIZE_MAX
< alloca_size
)
3960 memory_full (SIZE_MAX
);
3961 /* info[0] is unused. Unused elements have -1 for start. */
3962 info
= SAFE_ALLOCA (alloca_size
);
3963 memset (info
, 0, alloca_size
);
3964 for (ptrdiff_t i
= 0; i
< nargs
+ 1; i
++)
3966 /* discarded[I] is 1 if byte I of the format
3967 string was not copied into the output.
3968 It is 2 if byte I was not the first byte of its character. */
3969 char *discarded
= (char *) &info
[nargs
+ 1];
3971 /* Try to determine whether the result should be multibyte.
3972 This is not always right; sometimes the result needs to be multibyte
3973 because of an object that we will pass through prin1.
3974 or because a grave accent or apostrophe is requoted,
3975 and in that case, we won't know it here. */
3977 /* True if the format is multibyte. */
3978 bool multibyte_format
= STRING_MULTIBYTE (args
[0]);
3979 /* True if the output should be a multibyte string,
3980 which is true if any of the inputs is one. */
3981 bool multibyte
= multibyte_format
;
3982 for (ptrdiff_t i
= 1; !multibyte
&& i
< nargs
; i
++)
3983 if (STRINGP (args
[i
]) && STRING_MULTIBYTE (args
[i
]))
3986 int quoting_style
= message
? text_quoting_style () : -1;
3988 /* If we start out planning a unibyte result,
3989 then discover it has to be multibyte, we jump back to retry. */
3996 /* Scan the format and store result in BUF. */
3997 format
= format_start
;
3998 end
= format
+ formatlen
;
3999 maybe_combine_byte
= false;
4001 while (format
!= end
)
4003 /* The values of N and FORMAT when the loop body is entered. */
4005 char *format0
= format
;
4006 char const *convsrc
= format
;
4007 unsigned char format_char
= *format
++;
4009 /* Bytes needed to represent the output of this conversion. */
4010 ptrdiff_t convbytes
= 1;
4012 if (format_char
== '%')
4014 /* General format specifications look like
4016 '%' [flags] [field-width] [precision] format
4021 field-width ::= [0-9]+
4022 precision ::= '.' [0-9]*
4024 If a field-width is specified, it specifies to which width
4025 the output should be padded with blanks, if the output
4026 string is shorter than field-width.
4028 If precision is specified, it specifies the number of
4029 digits to print after the '.' for floats, or the max.
4030 number of chars to print from a string. */
4032 bool minus_flag
= false;
4033 bool plus_flag
= false;
4034 bool space_flag
= false;
4035 bool sharp_flag
= false;
4036 bool zero_flag
= false;
4042 case '-': minus_flag
= true; continue;
4043 case '+': plus_flag
= true; continue;
4044 case ' ': space_flag
= true; continue;
4045 case '#': sharp_flag
= true; continue;
4046 case '0': zero_flag
= true; continue;
4051 /* Ignore flags when sprintf ignores them. */
4052 space_flag
&= ~ plus_flag
;
4053 zero_flag
&= ~ minus_flag
;
4056 uintmax_t raw_field_width
= strtoumax (format
, &num_end
, 10);
4057 if (max_bufsize
<= raw_field_width
)
4059 ptrdiff_t field_width
= raw_field_width
;
4061 bool precision_given
= *num_end
== '.';
4062 uintmax_t precision
= (precision_given
4063 ? strtoumax (num_end
+ 1, &num_end
, 10)
4068 error ("Format string ends in middle of format specifier");
4070 char conversion
= *format
++;
4071 memset (&discarded
[format0
- format_start
], 1,
4072 format
- format0
- (conversion
== '%'));
4073 if (conversion
== '%')
4078 error ("Not enough arguments for format string");
4080 /* For 'S', prin1 the argument, and then treat like 's'.
4081 For 's', princ any argument that is not a string or
4082 symbol. But don't do this conversion twice, which might
4083 happen after retrying. */
4084 if ((conversion
== 'S'
4085 || (conversion
== 's'
4086 && ! STRINGP (args
[n
]) && ! SYMBOLP (args
[n
]))))
4088 if (! info
[n
].converted_to_string
)
4090 Lisp_Object noescape
= conversion
== 'S' ? Qnil
: Qt
;
4091 args
[n
] = Fprin1_to_string (args
[n
], noescape
);
4092 info
[n
].converted_to_string
= true;
4093 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
4101 else if (conversion
== 'c')
4103 if (FLOATP (args
[n
]))
4105 double d
= XFLOAT_DATA (args
[n
]);
4106 args
[n
] = make_number (FIXNUM_OVERFLOW_P (d
) ? -1 : d
);
4109 if (INTEGERP (args
[n
]) && ! ASCII_CHAR_P (XINT (args
[n
])))
4116 args
[n
] = Fchar_to_string (args
[n
]);
4117 info
[n
].converted_to_string
= true;
4120 if (info
[n
].converted_to_string
)
4125 if (SYMBOLP (args
[n
]))
4127 args
[n
] = SYMBOL_NAME (args
[n
]);
4128 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
4135 if (conversion
== 's')
4137 /* handle case (precision[n] >= 0) */
4139 ptrdiff_t prec
= -1;
4140 if (precision_given
&& precision
<= TYPE_MAXIMUM (ptrdiff_t))
4143 /* lisp_string_width ignores a precision of 0, but GNU
4144 libc functions print 0 characters when the precision
4145 is 0. Imitate libc behavior here. Changing
4146 lisp_string_width is the right thing, and will be
4147 done, but meanwhile we work with it. */
4149 ptrdiff_t width
, nbytes
;
4150 ptrdiff_t nchars_string
;
4152 width
= nchars_string
= nbytes
= 0;
4156 width
= lisp_string_width (args
[n
], prec
, &nch
, &nby
);
4159 nchars_string
= SCHARS (args
[n
]);
4160 nbytes
= SBYTES (args
[n
]);
4164 nchars_string
= nch
;
4170 if (convbytes
&& multibyte
&& ! STRING_MULTIBYTE (args
[n
]))
4171 convbytes
= count_size_as_multibyte (SDATA (args
[n
]), nbytes
);
4174 = width
< field_width
? field_width
- width
: 0;
4176 if (max_bufsize
- padding
<= convbytes
)
4178 convbytes
+= padding
;
4179 if (convbytes
<= buf
+ bufsize
- p
)
4183 memset (p
, ' ', padding
);
4187 info
[n
].start
= nchars
;
4191 && !ASCII_CHAR_P (*((unsigned char *) p
- 1))
4192 && STRING_MULTIBYTE (args
[n
])
4193 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
4194 maybe_combine_byte
= true;
4196 p
+= copy_text (SDATA (args
[n
]), (unsigned char *) p
,
4198 STRING_MULTIBYTE (args
[n
]), multibyte
);
4200 nchars
+= nchars_string
;
4204 memset (p
, ' ', padding
);
4208 info
[n
].end
= nchars
;
4210 /* If this argument has text properties, record where
4211 in the result string it appears. */
4212 if (string_intervals (args
[n
]))
4213 info
[n
].intervals
= arg_intervals
= true;
4218 else if (! (conversion
== 'c' || conversion
== 'd'
4219 || conversion
== 'e' || conversion
== 'f'
4220 || conversion
== 'g' || conversion
== 'i'
4221 || conversion
== 'o' || conversion
== 'x'
4222 || conversion
== 'X'))
4223 error ("Invalid format operation %%%c",
4224 STRING_CHAR ((unsigned char *) format
- 1));
4225 else if (! NUMBERP (args
[n
]))
4226 error ("Format specifier doesn't match argument type");
4231 /* Maximum precision for a %f conversion such that the
4232 trailing output digit might be nonzero. Any precision
4233 larger than this will not yield useful information. */
4234 USEFUL_PRECISION_MAX
=
4236 * (FLT_RADIX
== 2 || FLT_RADIX
== 10 ? 1
4237 : FLT_RADIX
== 16 ? 4
4240 /* Maximum number of bytes generated by any format, if
4241 precision is no more than USEFUL_PRECISION_MAX.
4242 On all practical hosts, %f is the worst case. */
4244 sizeof "-." + (DBL_MAX_10_EXP
+ 1) + USEFUL_PRECISION_MAX
,
4246 /* Length of pM (that is, of pMd without the
4248 pMlen
= sizeof pMd
- 2
4250 verify (USEFUL_PRECISION_MAX
> 0);
4252 /* Avoid undefined behavior in underlying sprintf. */
4253 if (conversion
== 'd' || conversion
== 'i')
4256 /* Create the copy of the conversion specification, with
4257 any width and precision removed, with ".*" inserted,
4258 and with pM inserted for integer formats.
4259 At most three flags F can be specified at once. */
4260 char convspec
[sizeof "%FFF.*d" + pMlen
];
4264 *f
= '-'; f
+= minus_flag
;
4265 *f
= '+'; f
+= plus_flag
;
4266 *f
= ' '; f
+= space_flag
;
4267 *f
= '#'; f
+= sharp_flag
;
4268 *f
= '0'; f
+= zero_flag
;
4271 if (conversion
== 'd' || conversion
== 'i'
4272 || conversion
== 'o' || conversion
== 'x'
4273 || conversion
== 'X')
4275 memcpy (f
, pMd
, pMlen
);
4277 zero_flag
&= ~ precision_given
;
4284 if (precision_given
)
4285 prec
= min (precision
, USEFUL_PRECISION_MAX
);
4287 /* Use sprintf to format this number into sprintf_buf. Omit
4288 padding and excess precision, though, because sprintf limits
4289 output length to INT_MAX.
4291 There are four types of conversion: double, unsigned
4292 char (passed as int), wide signed int, and wide
4293 unsigned int. Treat them separately because the
4294 sprintf ABI is sensitive to which type is passed. Be
4295 careful about integer overflow, NaNs, infinities, and
4296 conversions; for example, the min and max macros are
4297 not suitable here. */
4298 char sprintf_buf
[SPRINTF_BUFSIZE
];
4299 ptrdiff_t sprintf_bytes
;
4300 if (conversion
== 'e' || conversion
== 'f' || conversion
== 'g')
4302 double x
= (INTEGERP (args
[n
])
4304 : XFLOAT_DATA (args
[n
]));
4305 sprintf_bytes
= sprintf (sprintf_buf
, convspec
, prec
, x
);
4307 else if (conversion
== 'c')
4309 /* Don't use sprintf here, as it might mishandle prec. */
4310 sprintf_buf
[0] = XINT (args
[n
]);
4311 sprintf_bytes
= prec
!= 0;
4313 else if (conversion
== 'd')
4315 /* For float, maybe we should use "%1.0f"
4316 instead so it also works for values outside
4317 the integer range. */
4319 if (INTEGERP (args
[n
]))
4323 double d
= XFLOAT_DATA (args
[n
]);
4326 x
= TYPE_MINIMUM (printmax_t
);
4332 x
= TYPE_MAXIMUM (printmax_t
);
4337 sprintf_bytes
= sprintf (sprintf_buf
, convspec
, prec
, x
);
4341 /* Don't sign-extend for octal or hex printing. */
4343 if (INTEGERP (args
[n
]))
4344 x
= XUINT (args
[n
]);
4347 double d
= XFLOAT_DATA (args
[n
]);
4352 x
= TYPE_MAXIMUM (uprintmax_t
);
4357 sprintf_bytes
= sprintf (sprintf_buf
, convspec
, prec
, x
);
4360 /* Now the length of the formatted item is known, except it omits
4361 padding and excess precision. Deal with excess precision
4362 first. This happens only when the format specifies
4363 ridiculously large precision. */
4364 uintmax_t excess_precision
= precision
- prec
;
4365 uintmax_t leading_zeros
= 0, trailing_zeros
= 0;
4366 if (excess_precision
)
4368 if (conversion
== 'e' || conversion
== 'f'
4369 || conversion
== 'g')
4371 if ((conversion
== 'g' && ! sharp_flag
)
4372 || ! ('0' <= sprintf_buf
[sprintf_bytes
- 1]
4373 && sprintf_buf
[sprintf_bytes
- 1] <= '9'))
4374 excess_precision
= 0;
4377 if (conversion
== 'g')
4379 char *dot
= strchr (sprintf_buf
, '.');
4381 excess_precision
= 0;
4384 trailing_zeros
= excess_precision
;
4387 leading_zeros
= excess_precision
;
4390 /* Compute the total bytes needed for this item, including
4391 excess precision and padding. */
4392 uintmax_t numwidth
= sprintf_bytes
+ excess_precision
;
4394 = numwidth
< field_width
? field_width
- numwidth
: 0;
4395 if (max_bufsize
- sprintf_bytes
<= excess_precision
4396 || max_bufsize
- padding
<= numwidth
)
4398 convbytes
= numwidth
+ padding
;
4400 if (convbytes
<= buf
+ bufsize
- p
)
4402 /* Copy the formatted item from sprintf_buf into buf,
4403 inserting padding and excess-precision zeros. */
4405 char *src
= sprintf_buf
;
4407 int exponent_bytes
= 0;
4408 bool signedp
= src0
== '-' || src0
== '+' || src0
== ' ';
4410 && ((src
[signedp
] >= '0' && src
[signedp
] <= '9')
4411 || (src
[signedp
] >= 'a' && src
[signedp
] <= 'f')
4412 || (src
[signedp
] >= 'A' && src
[signedp
] <= 'F')))
4414 leading_zeros
+= padding
;
4418 if (excess_precision
4419 && (conversion
== 'e' || conversion
== 'g'))
4421 char *e
= strchr (src
, 'e');
4423 exponent_bytes
= src
+ sprintf_bytes
- e
;
4426 info
[n
].start
= nchars
;
4429 memset (p
, ' ', padding
);
4437 memset (p
, '0', leading_zeros
);
4439 int significand_bytes
4440 = sprintf_bytes
- signedp
- exponent_bytes
;
4441 memcpy (p
, src
, significand_bytes
);
4442 p
+= significand_bytes
;
4443 src
+= significand_bytes
;
4444 memset (p
, '0', trailing_zeros
);
4445 p
+= trailing_zeros
;
4446 memcpy (p
, src
, exponent_bytes
);
4447 p
+= exponent_bytes
;
4449 nchars
+= leading_zeros
+ sprintf_bytes
+ trailing_zeros
;
4453 memset (p
, ' ', padding
);
4457 info
[n
].end
= nchars
;
4465 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
4467 if ((format_char
== '`' || format_char
== '\'')
4468 && quoting_style
== CURVE_QUOTING_STYLE
)
4475 convsrc
= format_char
== '`' ? uLSQM
: uRSQM
;
4478 else if (format_char
== '`' && quoting_style
== STRAIGHT_QUOTING_STYLE
)
4482 /* Copy a single character from format to buf. */
4483 if (multibyte_format
)
4485 /* Copy a whole multibyte character. */
4487 && !ASCII_CHAR_P (*((unsigned char *) p
- 1))
4488 && !CHAR_HEAD_P (format_char
))
4489 maybe_combine_byte
= true;
4491 while (! CHAR_HEAD_P (*format
))
4494 convbytes
= format
- format0
;
4495 memset (&discarded
[format0
+ 1 - format_start
], 2,
4498 else if (multibyte
&& !ASCII_CHAR_P (format_char
))
4500 int c
= BYTE8_TO_CHAR (format_char
);
4501 convbytes
= CHAR_STRING (c
, str
);
4502 convsrc
= (char *) str
;
4507 if (convbytes
<= buf
+ bufsize
- p
)
4509 memcpy (p
, convsrc
, convbytes
);
4516 /* There wasn't enough room to store this conversion or single
4517 character. CONVBYTES says how much room is needed. Allocate
4518 enough room (and then some) and do it again. */
4520 ptrdiff_t used
= p
- buf
;
4521 if (max_bufsize
- used
< convbytes
)
4523 bufsize
= used
+ convbytes
;
4524 bufsize
= bufsize
< max_bufsize
/ 2 ? bufsize
* 2 : max_bufsize
;
4526 if (buf
== initial_buffer
)
4528 buf
= xmalloc (bufsize
);
4529 sa_must_free
= true;
4530 buf_save_value_index
= SPECPDL_INDEX ();
4531 record_unwind_protect_ptr (xfree
, buf
);
4532 memcpy (buf
, initial_buffer
, used
);
4536 buf
= xrealloc (buf
, bufsize
);
4537 set_unwind_protect_ptr (buf_save_value_index
, xfree
, buf
);
4545 if (bufsize
< p
- buf
)
4548 if (maybe_combine_byte
)
4549 nchars
= multibyte_chars_in_text ((unsigned char *) buf
, p
- buf
);
4550 Lisp_Object val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4552 /* If the format string has text properties, or any of the string
4553 arguments has text properties, set up text properties of the
4556 if (string_intervals (args
[0]) || arg_intervals
)
4558 /* Add text properties from the format string. */
4559 Lisp_Object len
= make_number (SCHARS (args
[0]));
4560 Lisp_Object props
= text_property_list (args
[0], make_number (0),
4564 ptrdiff_t bytepos
= 0, position
= 0, translated
= 0;
4567 /* Adjust the bounds of each text property
4568 to the proper start and end in the output string. */
4570 /* Put the positions in PROPS in increasing order, so that
4571 we can do (effectively) one scan through the position
4572 space of the format string. */
4573 props
= Fnreverse (props
);
4575 /* BYTEPOS is the byte position in the format string,
4576 POSITION is the untranslated char position in it,
4577 TRANSLATED is the translated char position in BUF,
4578 and ARGN is the number of the next arg we will come to. */
4579 for (Lisp_Object list
= props
; CONSP (list
); list
= XCDR (list
))
4581 Lisp_Object item
= XCAR (list
);
4583 /* First adjust the property start position. */
4584 ptrdiff_t pos
= XINT (XCAR (item
));
4586 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4587 up to this position. */
4588 for (; position
< pos
; bytepos
++)
4590 if (! discarded
[bytepos
])
4591 position
++, translated
++;
4592 else if (discarded
[bytepos
] == 1)
4595 if (translated
== info
[argn
].start
)
4597 translated
+= info
[argn
].end
- info
[argn
].start
;
4603 XSETCAR (item
, make_number (translated
));
4605 /* Likewise adjust the property end position. */
4606 pos
= XINT (XCAR (XCDR (item
)));
4608 for (; position
< pos
; bytepos
++)
4610 if (! discarded
[bytepos
])
4611 position
++, translated
++;
4612 else if (discarded
[bytepos
] == 1)
4615 if (translated
== info
[argn
].start
)
4617 translated
+= info
[argn
].end
- info
[argn
].start
;
4623 XSETCAR (XCDR (item
), make_number (translated
));
4626 add_text_properties_from_list (val
, props
, make_number (0));
4629 /* Add text properties from arguments. */
4631 for (ptrdiff_t i
= 1; i
< nargs
; i
++)
4632 if (info
[i
].intervals
)
4634 len
= make_number (SCHARS (args
[i
]));
4635 Lisp_Object new_len
= make_number (info
[i
].end
- info
[i
].start
);
4636 props
= text_property_list (args
[i
], make_number (0), len
, Qnil
);
4637 props
= extend_property_ranges (props
, len
, new_len
);
4638 /* If successive arguments have properties, be sure that
4639 the value of `composition' property be the copy. */
4640 if (1 < i
&& info
[i
- 1].end
)
4641 make_composition_value_copy (props
);
4642 add_text_properties_from_list (val
, props
,
4643 make_number (info
[i
].start
));
4647 /* If we allocated BUF or INFO with malloc, free it too. */
4653 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4654 doc
: /* Return t if two characters match, optionally ignoring case.
4655 Both arguments must be characters (i.e. integers).
4656 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4657 (register Lisp_Object c1
, Lisp_Object c2
)
4660 /* Check they're chars, not just integers, otherwise we could get array
4661 bounds violations in downcase. */
4662 CHECK_CHARACTER (c1
);
4663 CHECK_CHARACTER (c2
);
4665 if (XINT (c1
) == XINT (c2
))
4667 if (NILP (BVAR (current_buffer
, case_fold_search
)))
4673 /* FIXME: It is possible to compare multibyte characters even when
4674 the current buffer is unibyte. Unfortunately this is ambiguous
4675 for characters between 128 and 255, as they could be either
4676 eight-bit raw bytes or Latin-1 characters. Assume the former for
4677 now. See Bug#17011, and also see casefiddle.c's casify_object,
4678 which has a similar problem. */
4679 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
4681 if (SINGLE_BYTE_CHAR_P (i1
))
4682 i1
= UNIBYTE_TO_CHAR (i1
);
4683 if (SINGLE_BYTE_CHAR_P (i2
))
4684 i2
= UNIBYTE_TO_CHAR (i2
);
4687 return (downcase (i1
) == downcase (i2
) ? Qt
: Qnil
);
4690 /* Transpose the markers in two regions of the current buffer, and
4691 adjust the ones between them if necessary (i.e.: if the regions
4694 START1, END1 are the character positions of the first region.
4695 START1_BYTE, END1_BYTE are the byte positions.
4696 START2, END2 are the character positions of the second region.
4697 START2_BYTE, END2_BYTE are the byte positions.
4699 Traverses the entire marker list of the buffer to do so, adding an
4700 appropriate amount to some, subtracting from some, and leaving the
4701 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4703 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4706 transpose_markers (ptrdiff_t start1
, ptrdiff_t end1
,
4707 ptrdiff_t start2
, ptrdiff_t end2
,
4708 ptrdiff_t start1_byte
, ptrdiff_t end1_byte
,
4709 ptrdiff_t start2_byte
, ptrdiff_t end2_byte
)
4711 register ptrdiff_t amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4712 register struct Lisp_Marker
*marker
;
4714 /* Update point as if it were a marker. */
4718 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4719 PT_BYTE
+ (end2_byte
- end1_byte
));
4720 else if (PT
< start2
)
4721 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4722 (PT_BYTE
+ (end2_byte
- start2_byte
)
4723 - (end1_byte
- start1_byte
)));
4725 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4726 PT_BYTE
- (start2_byte
- start1_byte
));
4728 /* We used to adjust the endpoints here to account for the gap, but that
4729 isn't good enough. Even if we assume the caller has tried to move the
4730 gap out of our way, it might still be at start1 exactly, for example;
4731 and that places it `inside' the interval, for our purposes. The amount
4732 of adjustment is nontrivial if there's a `denormalized' marker whose
4733 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4734 the dirty work to Fmarker_position, below. */
4736 /* The difference between the region's lengths */
4737 diff
= (end2
- start2
) - (end1
- start1
);
4738 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4740 /* For shifting each marker in a region by the length of the other
4741 region plus the distance between the regions. */
4742 amt1
= (end2
- start2
) + (start2
- end1
);
4743 amt2
= (end1
- start1
) + (start2
- end1
);
4744 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4745 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4747 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4749 mpos
= marker
->bytepos
;
4750 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4752 if (mpos
< end1_byte
)
4754 else if (mpos
< start2_byte
)
4758 marker
->bytepos
= mpos
;
4760 mpos
= marker
->charpos
;
4761 if (mpos
>= start1
&& mpos
< end2
)
4765 else if (mpos
< start2
)
4770 marker
->charpos
= mpos
;
4774 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4775 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4776 The regions should not be overlapping, because the size of the buffer is
4777 never changed in a transposition.
4779 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4780 any markers that happen to be located in the regions.
4782 Transposing beyond buffer boundaries is an error. */)
4783 (Lisp_Object startr1
, Lisp_Object endr1
, Lisp_Object startr2
, Lisp_Object endr2
, Lisp_Object leave_markers
)
4785 register ptrdiff_t start1
, end1
, start2
, end2
;
4786 ptrdiff_t start1_byte
, start2_byte
, len1_byte
, len2_byte
, end2_byte
;
4787 ptrdiff_t gap
, len1
, len_mid
, len2
;
4788 unsigned char *start1_addr
, *start2_addr
, *temp
;
4790 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4793 XSETBUFFER (buf
, current_buffer
);
4794 cur_intv
= buffer_intervals (current_buffer
);
4796 validate_region (&startr1
, &endr1
);
4797 validate_region (&startr2
, &endr2
);
4799 start1
= XFASTINT (startr1
);
4800 end1
= XFASTINT (endr1
);
4801 start2
= XFASTINT (startr2
);
4802 end2
= XFASTINT (endr2
);
4805 /* Swap the regions if they're reversed. */
4808 register ptrdiff_t glumph
= start1
;
4816 len1
= end1
- start1
;
4817 len2
= end2
- start2
;
4820 error ("Transposed regions overlap");
4821 /* Nothing to change for adjacent regions with one being empty */
4822 else if ((start1
== end1
|| start2
== end2
) && end1
== start2
)
4825 /* The possibilities are:
4826 1. Adjacent (contiguous) regions, or separate but equal regions
4827 (no, really equal, in this case!), or
4828 2. Separate regions of unequal size.
4830 The worst case is usually No. 2. It means that (aside from
4831 potential need for getting the gap out of the way), there also
4832 needs to be a shifting of the text between the two regions. So
4833 if they are spread far apart, we are that much slower... sigh. */
4835 /* It must be pointed out that the really studly thing to do would
4836 be not to move the gap at all, but to leave it in place and work
4837 around it if necessary. This would be extremely efficient,
4838 especially considering that people are likely to do
4839 transpositions near where they are working interactively, which
4840 is exactly where the gap would be found. However, such code
4841 would be much harder to write and to read. So, if you are
4842 reading this comment and are feeling squirrely, by all means have
4843 a go! I just didn't feel like doing it, so I will simply move
4844 the gap the minimum distance to get it out of the way, and then
4845 deal with an unbroken array. */
4847 start1_byte
= CHAR_TO_BYTE (start1
);
4848 end2_byte
= CHAR_TO_BYTE (end2
);
4850 /* Make sure the gap won't interfere, by moving it out of the text
4851 we will operate on. */
4852 if (start1
< gap
&& gap
< end2
)
4854 if (gap
- start1
< end2
- gap
)
4855 move_gap_both (start1
, start1_byte
);
4857 move_gap_both (end2
, end2_byte
);
4860 start2_byte
= CHAR_TO_BYTE (start2
);
4861 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4862 len2_byte
= end2_byte
- start2_byte
;
4864 #ifdef BYTE_COMBINING_DEBUG
4867 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4868 len2_byte
, start1
, start1_byte
)
4869 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4870 len1_byte
, end2
, start2_byte
+ len2_byte
)
4871 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4872 len1_byte
, end2
, start2_byte
+ len2_byte
))
4877 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4878 len2_byte
, start1
, start1_byte
)
4879 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4880 len1_byte
, start2
, start2_byte
)
4881 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4882 len2_byte
, end1
, start1_byte
+ len1_byte
)
4883 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4884 len1_byte
, end2
, start2_byte
+ len2_byte
))
4889 /* Hmmm... how about checking to see if the gap is large
4890 enough to use as the temporary storage? That would avoid an
4891 allocation... interesting. Later, don't fool with it now. */
4893 /* Working without memmove, for portability (sigh), so must be
4894 careful of overlapping subsections of the array... */
4896 if (end1
== start2
) /* adjacent regions */
4898 modify_text (start1
, end2
);
4899 record_change (start1
, len1
+ len2
);
4901 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4902 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4903 /* Don't use Fset_text_properties: that can cause GC, which can
4904 clobber objects stored in the tmp_intervals. */
4905 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4907 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4911 /* First region smaller than second. */
4912 if (len1_byte
< len2_byte
)
4914 temp
= SAFE_ALLOCA (len2_byte
);
4916 /* Don't precompute these addresses. We have to compute them
4917 at the last minute, because the relocating allocator might
4918 have moved the buffer around during the xmalloc. */
4919 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4920 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4922 memcpy (temp
, start2_addr
, len2_byte
);
4923 memcpy (start1_addr
+ len2_byte
, start1_addr
, len1_byte
);
4924 memcpy (start1_addr
, temp
, len2_byte
);
4927 /* First region not smaller than second. */
4929 temp
= SAFE_ALLOCA (len1_byte
);
4930 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4931 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4932 memcpy (temp
, start1_addr
, len1_byte
);
4933 memcpy (start1_addr
, start2_addr
, len2_byte
);
4934 memcpy (start1_addr
+ len2_byte
, temp
, len1_byte
);
4938 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4939 len1
, current_buffer
, 0);
4940 graft_intervals_into_buffer (tmp_interval2
, start1
,
4941 len2
, current_buffer
, 0);
4942 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4943 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4945 /* Non-adjacent regions, because end1 != start2, bleagh... */
4948 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4950 if (len1_byte
== len2_byte
)
4951 /* Regions are same size, though, how nice. */
4955 modify_text (start1
, end1
);
4956 modify_text (start2
, end2
);
4957 record_change (start1
, len1
);
4958 record_change (start2
, len2
);
4959 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4960 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4962 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4964 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4966 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4968 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4970 temp
= SAFE_ALLOCA (len1_byte
);
4971 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4972 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4973 memcpy (temp
, start1_addr
, len1_byte
);
4974 memcpy (start1_addr
, start2_addr
, len2_byte
);
4975 memcpy (start2_addr
, temp
, len1_byte
);
4978 graft_intervals_into_buffer (tmp_interval1
, start2
,
4979 len1
, current_buffer
, 0);
4980 graft_intervals_into_buffer (tmp_interval2
, start1
,
4981 len2
, current_buffer
, 0);
4984 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4985 /* Non-adjacent & unequal size, area between must also be shifted. */
4989 modify_text (start1
, end2
);
4990 record_change (start1
, (end2
- start1
));
4991 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4992 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4993 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4995 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4997 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4999 /* holds region 2 */
5000 temp
= SAFE_ALLOCA (len2_byte
);
5001 start1_addr
= BYTE_POS_ADDR (start1_byte
);
5002 start2_addr
= BYTE_POS_ADDR (start2_byte
);
5003 memcpy (temp
, start2_addr
, len2_byte
);
5004 memcpy (start1_addr
+ len_mid
+ len2_byte
, start1_addr
, len1_byte
);
5005 memmove (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
5006 memcpy (start1_addr
, temp
, len2_byte
);
5009 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
5010 len1
, current_buffer
, 0);
5011 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
5012 len_mid
, current_buffer
, 0);
5013 graft_intervals_into_buffer (tmp_interval2
, start1
,
5014 len2
, current_buffer
, 0);
5017 /* Second region smaller than first. */
5021 record_change (start1
, (end2
- start1
));
5022 modify_text (start1
, end2
);
5024 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
5025 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
5026 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
5028 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
5030 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
5032 /* holds region 1 */
5033 temp
= SAFE_ALLOCA (len1_byte
);
5034 start1_addr
= BYTE_POS_ADDR (start1_byte
);
5035 start2_addr
= BYTE_POS_ADDR (start2_byte
);
5036 memcpy (temp
, start1_addr
, len1_byte
);
5037 memcpy (start1_addr
, start2_addr
, len2_byte
);
5038 memmove (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
5039 memcpy (start1_addr
+ len2_byte
+ len_mid
, temp
, len1_byte
);
5042 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
5043 len1
, current_buffer
, 0);
5044 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
5045 len_mid
, current_buffer
, 0);
5046 graft_intervals_into_buffer (tmp_interval2
, start1
,
5047 len2
, current_buffer
, 0);
5050 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
5051 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
5054 /* When doing multiple transpositions, it might be nice
5055 to optimize this. Perhaps the markers in any one buffer
5056 should be organized in some sorted data tree. */
5057 if (NILP (leave_markers
))
5059 transpose_markers (start1
, end1
, start2
, end2
,
5060 start1_byte
, start1_byte
+ len1_byte
,
5061 start2_byte
, start2_byte
+ len2_byte
);
5062 fix_start_end_in_overlays (start1
, end2
);
5066 /* The character positions of the markers remain intact, but we
5067 still need to update their byte positions, because the
5068 transposed regions might include multibyte sequences which
5069 make some original byte positions of the markers invalid. */
5070 adjust_markers_bytepos (start1
, start1_byte
, end2
, end2_byte
, 0);
5073 signal_after_change (start1
, end2
- start1
, end2
- start1
);
5079 syms_of_editfns (void)
5081 DEFSYM (Qbuffer_access_fontify_functions
, "buffer-access-fontify-functions");
5082 DEFSYM (Qwall
, "wall");
5084 DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion
,
5085 doc
: /* Non-nil means text motion commands don't notice fields. */);
5086 Vinhibit_field_text_motion
= Qnil
;
5088 DEFVAR_LISP ("buffer-access-fontify-functions",
5089 Vbuffer_access_fontify_functions
,
5090 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
5091 Each function is called with two arguments which specify the range
5092 of the buffer being accessed. */);
5093 Vbuffer_access_fontify_functions
= Qnil
;
5097 obuf
= Fcurrent_buffer ();
5098 /* Do this here, because init_buffer_once is too early--it won't work. */
5099 Fset_buffer (Vprin1_to_string_buffer
);
5100 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
5101 Fset (Fmake_local_variable (Qbuffer_access_fontify_functions
), Qnil
);
5105 DEFVAR_LISP ("buffer-access-fontified-property",
5106 Vbuffer_access_fontified_property
,
5107 doc
: /* Property which (if non-nil) indicates text has been fontified.
5108 `buffer-substring' need not call the `buffer-access-fontify-functions'
5109 functions if all the text being accessed has this property. */);
5110 Vbuffer_access_fontified_property
= Qnil
;
5112 DEFVAR_LISP ("system-name", Vsystem_name
,
5113 doc
: /* The host name of the machine Emacs is running on. */);
5114 Vsystem_name
= cached_system_name
= Qnil
;
5116 DEFVAR_LISP ("user-full-name", Vuser_full_name
,
5117 doc
: /* The full name of the user logged in. */);
5119 DEFVAR_LISP ("user-login-name", Vuser_login_name
,
5120 doc
: /* The user's name, taken from environment variables if possible. */);
5121 Vuser_login_name
= Qnil
;
5123 DEFVAR_LISP ("user-real-login-name", Vuser_real_login_name
,
5124 doc
: /* The user's name, based upon the real uid only. */);
5126 DEFVAR_LISP ("operating-system-release", Voperating_system_release
,
5127 doc
: /* The release of the operating system Emacs is running on. */);
5129 defsubr (&Spropertize
);
5130 defsubr (&Schar_equal
);
5131 defsubr (&Sgoto_char
);
5132 defsubr (&Sstring_to_char
);
5133 defsubr (&Schar_to_string
);
5134 defsubr (&Sbyte_to_string
);
5135 defsubr (&Sbuffer_substring
);
5136 defsubr (&Sbuffer_substring_no_properties
);
5137 defsubr (&Sbuffer_string
);
5138 defsubr (&Sget_pos_property
);
5140 defsubr (&Spoint_marker
);
5141 defsubr (&Smark_marker
);
5143 defsubr (&Sregion_beginning
);
5144 defsubr (&Sregion_end
);
5146 /* Symbol for the text property used to mark fields. */
5147 DEFSYM (Qfield
, "field");
5149 /* A special value for Qfield properties. */
5150 DEFSYM (Qboundary
, "boundary");
5152 defsubr (&Sfield_beginning
);
5153 defsubr (&Sfield_end
);
5154 defsubr (&Sfield_string
);
5155 defsubr (&Sfield_string_no_properties
);
5156 defsubr (&Sdelete_field
);
5157 defsubr (&Sconstrain_to_field
);
5159 defsubr (&Sline_beginning_position
);
5160 defsubr (&Sline_end_position
);
5162 defsubr (&Ssave_excursion
);
5163 defsubr (&Ssave_current_buffer
);
5165 defsubr (&Sbuffer_size
);
5166 defsubr (&Spoint_max
);
5167 defsubr (&Spoint_min
);
5168 defsubr (&Spoint_min_marker
);
5169 defsubr (&Spoint_max_marker
);
5170 defsubr (&Sgap_position
);
5171 defsubr (&Sgap_size
);
5172 defsubr (&Sposition_bytes
);
5173 defsubr (&Sbyte_to_position
);
5179 defsubr (&Sfollowing_char
);
5180 defsubr (&Sprevious_char
);
5181 defsubr (&Schar_after
);
5182 defsubr (&Schar_before
);
5184 defsubr (&Sinsert_before_markers
);
5185 defsubr (&Sinsert_and_inherit
);
5186 defsubr (&Sinsert_and_inherit_before_markers
);
5187 defsubr (&Sinsert_char
);
5188 defsubr (&Sinsert_byte
);
5190 defsubr (&Suser_login_name
);
5191 defsubr (&Suser_real_login_name
);
5192 defsubr (&Suser_uid
);
5193 defsubr (&Suser_real_uid
);
5194 defsubr (&Sgroup_gid
);
5195 defsubr (&Sgroup_real_gid
);
5196 defsubr (&Suser_full_name
);
5197 defsubr (&Semacs_pid
);
5198 defsubr (&Scurrent_time
);
5199 defsubr (&Stime_add
);
5200 defsubr (&Stime_subtract
);
5201 defsubr (&Stime_less_p
);
5202 defsubr (&Sget_internal_run_time
);
5203 defsubr (&Sformat_time_string
);
5204 defsubr (&Sfloat_time
);
5205 defsubr (&Sdecode_time
);
5206 defsubr (&Sencode_time
);
5207 defsubr (&Scurrent_time_string
);
5208 defsubr (&Scurrent_time_zone
);
5209 defsubr (&Sset_time_zone_rule
);
5210 defsubr (&Ssystem_name
);
5211 defsubr (&Smessage
);
5212 defsubr (&Smessage_box
);
5213 defsubr (&Smessage_or_box
);
5214 defsubr (&Scurrent_message
);
5216 defsubr (&Sformat_message
);
5218 defsubr (&Sinsert_buffer_substring
);
5219 defsubr (&Scompare_buffer_substrings
);
5220 defsubr (&Ssubst_char_in_region
);
5221 defsubr (&Stranslate_region_internal
);
5222 defsubr (&Sdelete_region
);
5223 defsubr (&Sdelete_and_extract_region
);
5225 defsubr (&Snarrow_to_region
);
5226 defsubr (&Ssave_restriction
);
5227 defsubr (&Stranspose_regions
);