1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
25 #include <sys/types.h>
36 #ifdef HAVE_SYS_UTSNAME_H
37 #include <sys/utsname.h>
42 /* systime.h includes <sys/time.h> which, on some systems, is required
43 for <sys/resource.h>; thus systime.h must be included before
47 #if defined HAVE_SYS_RESOURCE_H
48 #include <sys/resource.h>
53 #include "intervals.h"
55 #include "character.h"
59 #include "blockinput.h"
63 #define MAX_10_EXP DBL_MAX_10_EXP
65 #define MAX_10_EXP 310
73 extern char **environ
;
76 #define TM_YEAR_BASE 1900
78 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
79 asctime to have well-defined behavior. */
80 #ifndef TM_YEAR_IN_ASCTIME_RANGE
81 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
82 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
85 extern size_t emacs_strftimeu
P_ ((char *, size_t, const char *,
86 const struct tm
*, int));
89 extern Lisp_Object
w32_get_internal_run_time ();
92 static int tm_diff
P_ ((struct tm
*, struct tm
*));
93 static void find_field
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *));
94 static void update_buffer_properties
P_ ((int, int));
95 static Lisp_Object region_limit
P_ ((int));
96 int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
97 static size_t emacs_memftimeu
P_ ((char *, size_t, const char *,
98 size_t, const struct tm
*, int));
99 static void general_insert_function
P_ ((void (*) (const unsigned char *, int),
100 void (*) (Lisp_Object
, int, int, int,
102 int, int, Lisp_Object
*));
103 static Lisp_Object subst_char_in_region_unwind
P_ ((Lisp_Object
));
104 static Lisp_Object subst_char_in_region_unwind_1
P_ ((Lisp_Object
));
105 static void transpose_markers
P_ ((int, int, int, int, int, int, int, int));
108 extern char *index
P_ ((const char *, int));
111 Lisp_Object Vbuffer_access_fontify_functions
;
112 Lisp_Object Qbuffer_access_fontify_functions
;
113 Lisp_Object Vbuffer_access_fontified_property
;
115 Lisp_Object Fuser_full_name
P_ ((Lisp_Object
));
117 /* Non-nil means don't stop at field boundary in text motion commands. */
119 Lisp_Object Vinhibit_field_text_motion
;
121 /* Some static data, and a function to initialize it for each run */
123 Lisp_Object Vsystem_name
;
124 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
125 Lisp_Object Vuser_full_name
; /* full name of current user */
126 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
127 Lisp_Object Voperating_system_release
; /* Operating System Release */
129 /* Symbol for the text property used to mark fields. */
133 /* A special value for Qfield properties. */
135 Lisp_Object Qboundary
;
142 register unsigned char *p
;
143 struct passwd
*pw
; /* password entry for the current user */
146 /* Set up system_name even when dumping. */
150 /* Don't bother with this on initial start when just dumping out */
153 #endif /* not CANNOT_DUMP */
155 pw
= (struct passwd
*) getpwuid (getuid ());
157 /* We let the real user name default to "root" because that's quite
158 accurate on MSDOG and because it lets Emacs find the init file.
159 (The DVX libraries override the Djgpp libraries here.) */
160 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
162 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
165 /* Get the effective user name, by consulting environment variables,
166 or the effective uid if those are unset. */
167 user_name
= (char *) getenv ("LOGNAME");
170 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
171 #else /* WINDOWSNT */
172 user_name
= (char *) getenv ("USER");
173 #endif /* WINDOWSNT */
176 pw
= (struct passwd
*) getpwuid (geteuid ());
177 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
179 Vuser_login_name
= build_string (user_name
);
181 /* If the user name claimed in the environment vars differs from
182 the real uid, use the claimed name to find the full name. */
183 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
184 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
187 p
= (unsigned char *) getenv ("NAME");
189 Vuser_full_name
= build_string (p
);
190 else if (NILP (Vuser_full_name
))
191 Vuser_full_name
= build_string ("unknown");
193 #ifdef HAVE_SYS_UTSNAME_H
197 Voperating_system_release
= build_string (uts
.release
);
200 Voperating_system_release
= Qnil
;
204 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
205 doc
: /* Convert arg CHAR to a string containing that character.
206 usage: (char-to-string CHAR) */)
208 Lisp_Object character
;
211 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
213 CHECK_CHARACTER (character
);
215 len
= CHAR_STRING (XFASTINT (character
), str
);
216 return make_string_from_bytes (str
, 1, len
);
219 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
220 doc
: /* Convert arg STRING to a character, the first character of that string.
221 A multibyte character is handled correctly. */)
223 register Lisp_Object string
;
225 register Lisp_Object val
;
226 CHECK_STRING (string
);
229 if (STRING_MULTIBYTE (string
))
230 XSETFASTINT (val
, STRING_CHAR (SDATA (string
), SBYTES (string
)));
232 XSETFASTINT (val
, SREF (string
, 0));
235 XSETFASTINT (val
, 0);
240 buildmark (charpos
, bytepos
)
241 int charpos
, bytepos
;
243 register Lisp_Object mark
;
244 mark
= Fmake_marker ();
245 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
249 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
250 doc
: /* Return value of point, as an integer.
251 Beginning of buffer is position (point-min). */)
255 XSETFASTINT (temp
, PT
);
259 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
260 doc
: /* Return value of point, as a marker object. */)
263 return buildmark (PT
, PT_BYTE
);
267 clip_to_bounds (lower
, num
, upper
)
268 int lower
, num
, upper
;
272 else if (num
> upper
)
278 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
279 doc
: /* Set point to POSITION, a number or marker.
280 Beginning of buffer is position (point-min), end is (point-max).
282 The return value is POSITION. */)
284 register Lisp_Object position
;
288 if (MARKERP (position
)
289 && current_buffer
== XMARKER (position
)->buffer
)
291 pos
= marker_position (position
);
293 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
295 SET_PT_BOTH (ZV
, ZV_BYTE
);
297 SET_PT_BOTH (pos
, marker_byte_position (position
));
302 CHECK_NUMBER_COERCE_MARKER (position
);
304 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
310 /* Return the start or end position of the region.
311 BEGINNINGP non-zero means return the start.
312 If there is no region active, signal an error. */
315 region_limit (beginningp
)
318 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
321 if (!NILP (Vtransient_mark_mode
)
322 && NILP (Vmark_even_if_inactive
)
323 && NILP (current_buffer
->mark_active
))
324 xsignal0 (Qmark_inactive
);
326 m
= Fmarker_position (current_buffer
->mark
);
328 error ("The mark is not set now, so there is no region");
330 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
331 m
= make_number (PT
);
335 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
336 doc
: /* Return position of beginning of region, as an integer. */)
339 return region_limit (1);
342 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
343 doc
: /* Return position of end of region, as an integer. */)
346 return region_limit (0);
349 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
350 doc
: /* Return this buffer's mark, as a marker object.
351 Watch out! Moving this marker changes the mark position.
352 If you set the marker not to point anywhere, the buffer will have no mark. */)
355 return current_buffer
->mark
;
359 /* Find all the overlays in the current buffer that touch position POS.
360 Return the number found, and store them in a vector in VEC
364 overlays_around (pos
, vec
, len
)
369 Lisp_Object overlay
, start
, end
;
370 struct Lisp_Overlay
*tail
;
371 int startpos
, endpos
;
374 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
376 XSETMISC (overlay
, tail
);
378 end
= OVERLAY_END (overlay
);
379 endpos
= OVERLAY_POSITION (end
);
382 start
= OVERLAY_START (overlay
);
383 startpos
= OVERLAY_POSITION (start
);
388 /* Keep counting overlays even if we can't return them all. */
393 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
395 XSETMISC (overlay
, tail
);
397 start
= OVERLAY_START (overlay
);
398 startpos
= OVERLAY_POSITION (start
);
401 end
= OVERLAY_END (overlay
);
402 endpos
= OVERLAY_POSITION (end
);
414 /* Return the value of property PROP, in OBJECT at POSITION.
415 It's the value of PROP that a char inserted at POSITION would get.
416 OBJECT is optional and defaults to the current buffer.
417 If OBJECT is a buffer, then overlay properties are considered as well as
419 If OBJECT is a window, then that window's buffer is used, but
420 window-specific overlays are considered only if they are associated
423 get_pos_property (position
, prop
, object
)
424 Lisp_Object position
, object
;
425 register Lisp_Object prop
;
427 CHECK_NUMBER_COERCE_MARKER (position
);
430 XSETBUFFER (object
, current_buffer
);
431 else if (WINDOWP (object
))
432 object
= XWINDOW (object
)->buffer
;
434 if (!BUFFERP (object
))
435 /* pos-property only makes sense in buffers right now, since strings
436 have no overlays and no notion of insertion for which stickiness
438 return Fget_text_property (position
, prop
, object
);
441 int posn
= XINT (position
);
443 Lisp_Object
*overlay_vec
, tem
;
444 struct buffer
*obuf
= current_buffer
;
446 set_buffer_temp (XBUFFER (object
));
448 /* First try with room for 40 overlays. */
450 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
451 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
453 /* If there are more than 40,
454 make enough space for all, and try again. */
457 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
458 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
460 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
462 set_buffer_temp (obuf
);
464 /* Now check the overlays in order of decreasing priority. */
465 while (--noverlays
>= 0)
467 Lisp_Object ol
= overlay_vec
[noverlays
];
468 tem
= Foverlay_get (ol
, prop
);
471 /* Check the overlay is indeed active at point. */
472 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
473 if ((OVERLAY_POSITION (start
) == posn
474 && XMARKER (start
)->insertion_type
== 1)
475 || (OVERLAY_POSITION (finish
) == posn
476 && XMARKER (finish
)->insertion_type
== 0))
477 ; /* The overlay will not cover a char inserted at point. */
485 { /* Now check the text-properties. */
486 int stickiness
= text_property_stickiness (prop
, position
, object
);
488 return Fget_text_property (position
, prop
, object
);
489 else if (stickiness
< 0
490 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
491 return Fget_text_property (make_number (XINT (position
) - 1),
499 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
500 the value of point is used instead. If BEG or END is null,
501 means don't store the beginning or end of the field.
503 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
504 results; they do not effect boundary behavior.
506 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
507 position of a field, then the beginning of the previous field is
508 returned instead of the beginning of POS's field (since the end of a
509 field is actually also the beginning of the next input field, this
510 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
511 true case, if two fields are separated by a field with the special
512 value `boundary', and POS lies within it, then the two separated
513 fields are considered to be adjacent, and POS between them, when
514 finding the beginning and ending of the "merged" field.
516 Either BEG or END may be 0, in which case the corresponding value
520 find_field (pos
, merge_at_boundary
, beg_limit
, beg
, end_limit
, end
)
522 Lisp_Object merge_at_boundary
;
523 Lisp_Object beg_limit
, end_limit
;
526 /* Fields right before and after the point. */
527 Lisp_Object before_field
, after_field
;
528 /* 1 if POS counts as the start of a field. */
529 int at_field_start
= 0;
530 /* 1 if POS counts as the end of a field. */
531 int at_field_end
= 0;
534 XSETFASTINT (pos
, PT
);
536 CHECK_NUMBER_COERCE_MARKER (pos
);
539 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
541 = (XFASTINT (pos
) > BEGV
542 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
544 /* Using nil here would be a more obvious choice, but it would
545 fail when the buffer starts with a non-sticky field. */
548 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
549 and POS is at beginning of a field, which can also be interpreted
550 as the end of the previous field. Note that the case where if
551 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
552 more natural one; then we avoid treating the beginning of a field
554 if (NILP (merge_at_boundary
))
556 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
557 if (!EQ (field
, after_field
))
559 if (!EQ (field
, before_field
))
561 if (NILP (field
) && at_field_start
&& at_field_end
)
562 /* If an inserted char would have a nil field while the surrounding
563 text is non-nil, we're probably not looking at a
564 zero-length field, but instead at a non-nil field that's
565 not intended for editing (such as comint's prompts). */
566 at_field_end
= at_field_start
= 0;
569 /* Note about special `boundary' fields:
571 Consider the case where the point (`.') is between the fields `x' and `y':
575 In this situation, if merge_at_boundary is true, we consider the
576 `x' and `y' fields as forming one big merged field, and so the end
577 of the field is the end of `y'.
579 However, if `x' and `y' are separated by a special `boundary' field
580 (a field with a `field' char-property of 'boundary), then we ignore
581 this special field when merging adjacent fields. Here's the same
582 situation, but with a `boundary' field between the `x' and `y' fields:
586 Here, if point is at the end of `x', the beginning of `y', or
587 anywhere in-between (within the `boundary' field), we merge all
588 three fields and consider the beginning as being the beginning of
589 the `x' field, and the end as being the end of the `y' field. */
594 /* POS is at the edge of a field, and we should consider it as
595 the beginning of the following field. */
596 *beg
= XFASTINT (pos
);
598 /* Find the previous field boundary. */
601 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
602 /* Skip a `boundary' field. */
603 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
606 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
608 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
615 /* POS is at the edge of a field, and we should consider it as
616 the end of the previous field. */
617 *end
= XFASTINT (pos
);
619 /* Find the next field boundary. */
621 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
622 /* Skip a `boundary' field. */
623 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
626 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
628 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
634 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
635 doc
: /* Delete the field surrounding POS.
636 A field is a region of text with the same `field' property.
637 If POS is nil, the value of point is used for POS. */)
642 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
644 del_range (beg
, end
);
648 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
649 doc
: /* Return the contents of the field surrounding POS as a string.
650 A field is a region of text with the same `field' property.
651 If POS is nil, the value of point is used for POS. */)
656 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
657 return make_buffer_string (beg
, end
, 1);
660 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
661 doc
: /* Return the contents of the field around POS, without text-properties.
662 A field is a region of text with the same `field' property.
663 If POS is nil, the value of point is used for POS. */)
668 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
669 return make_buffer_string (beg
, end
, 0);
672 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
673 doc
: /* Return the beginning of the field surrounding POS.
674 A field is a region of text with the same `field' property.
675 If POS is nil, the value of point is used for POS.
676 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
677 field, then the beginning of the *previous* field is returned.
678 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
679 is before LIMIT, then LIMIT will be returned instead. */)
680 (pos
, escape_from_edge
, limit
)
681 Lisp_Object pos
, escape_from_edge
, limit
;
684 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
685 return make_number (beg
);
688 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
689 doc
: /* Return the end of the field surrounding POS.
690 A field is a region of text with the same `field' property.
691 If POS is nil, the value of point is used for POS.
692 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
693 then the end of the *following* field is returned.
694 If LIMIT is non-nil, it is a buffer position; if the end of the field
695 is after LIMIT, then LIMIT will be returned instead. */)
696 (pos
, escape_from_edge
, limit
)
697 Lisp_Object pos
, escape_from_edge
, limit
;
700 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
701 return make_number (end
);
704 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
705 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
707 A field is a region of text with the same `field' property.
708 If NEW-POS is nil, then the current point is used instead, and set to the
709 constrained position if that is different.
711 If OLD-POS is at the boundary of two fields, then the allowable
712 positions for NEW-POS depends on the value of the optional argument
713 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
714 constrained to the field that has the same `field' char-property
715 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
716 is non-nil, NEW-POS is constrained to the union of the two adjacent
717 fields. Additionally, if two fields are separated by another field with
718 the special value `boundary', then any point within this special field is
719 also considered to be `on the boundary'.
721 If the optional argument ONLY-IN-LINE is non-nil and constraining
722 NEW-POS would move it to a different line, NEW-POS is returned
723 unconstrained. This useful for commands that move by line, like
724 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
725 only in the case where they can still move to the right line.
727 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
728 a non-nil property of that name, then any field boundaries are ignored.
730 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
731 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
732 Lisp_Object new_pos
, old_pos
;
733 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
735 /* If non-zero, then the original point, before re-positioning. */
738 Lisp_Object prev_old
, prev_new
;
741 /* Use the current point, and afterwards, set it. */
744 XSETFASTINT (new_pos
, PT
);
747 CHECK_NUMBER_COERCE_MARKER (new_pos
);
748 CHECK_NUMBER_COERCE_MARKER (old_pos
);
750 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
752 prev_old
= make_number (XFASTINT (old_pos
) - 1);
753 prev_new
= make_number (XFASTINT (new_pos
) - 1);
755 if (NILP (Vinhibit_field_text_motion
)
756 && !EQ (new_pos
, old_pos
)
757 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
758 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
759 /* To recognize field boundaries, we must also look at the
760 previous positions; we could use `get_pos_property'
761 instead, but in itself that would fail inside non-sticky
762 fields (like comint prompts). */
763 || (XFASTINT (new_pos
) > BEGV
764 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
765 || (XFASTINT (old_pos
) > BEGV
766 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
767 && (NILP (inhibit_capture_property
)
768 /* Field boundaries are again a problem; but now we must
769 decide the case exactly, so we need to call
770 `get_pos_property' as well. */
771 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
772 && (XFASTINT (old_pos
) <= BEGV
773 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
774 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
775 /* It is possible that NEW_POS is not within the same field as
776 OLD_POS; try to move NEW_POS so that it is. */
779 Lisp_Object field_bound
;
782 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
784 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
786 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
787 other side of NEW_POS, which would mean that NEW_POS is
788 already acceptable, and it's not necessary to constrain it
790 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
791 /* NEW_POS should be constrained, but only if either
792 ONLY_IN_LINE is nil (in which case any constraint is OK),
793 or NEW_POS and FIELD_BOUND are on the same line (in which
794 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
795 && (NILP (only_in_line
)
796 /* This is the ONLY_IN_LINE case, check that NEW_POS and
797 FIELD_BOUND are on the same line by seeing whether
798 there's an intervening newline or not. */
799 || (scan_buffer ('\n',
800 XFASTINT (new_pos
), XFASTINT (field_bound
),
801 fwd
? -1 : 1, &shortage
, 1),
803 /* Constrain NEW_POS to FIELD_BOUND. */
804 new_pos
= field_bound
;
806 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
807 /* The NEW_POS argument was originally nil, so automatically set PT. */
808 SET_PT (XFASTINT (new_pos
));
815 DEFUN ("line-beginning-position",
816 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
817 doc
: /* Return the character position of the first character on the current line.
818 With argument N not nil or 1, move forward N - 1 lines first.
819 If scan reaches end of buffer, return that position.
821 This function constrains the returned position to the current field
822 unless that would be on a different line than the original,
823 unconstrained result. If N is nil or 1, and a front-sticky field
824 starts at point, the scan stops as soon as it starts. To ignore field
825 boundaries bind `inhibit-field-text-motion' to t.
827 This function does not move point. */)
831 int orig
, orig_byte
, end
;
832 int count
= SPECPDL_INDEX ();
833 specbind (Qinhibit_point_motion_hooks
, Qt
);
842 Fforward_line (make_number (XINT (n
) - 1));
845 SET_PT_BOTH (orig
, orig_byte
);
847 unbind_to (count
, Qnil
);
849 /* Return END constrained to the current input field. */
850 return Fconstrain_to_field (make_number (end
), make_number (orig
),
851 XINT (n
) != 1 ? Qt
: Qnil
,
855 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
856 doc
: /* Return the character position of the last character on the current line.
857 With argument N not nil or 1, move forward N - 1 lines first.
858 If scan reaches end of buffer, return that position.
860 This function constrains the returned position to the current field
861 unless that would be on a different line than the original,
862 unconstrained result. If N is nil or 1, and a rear-sticky field ends
863 at point, the scan stops as soon as it starts. To ignore field
864 boundaries bind `inhibit-field-text-motion' to t.
866 This function does not move point. */)
878 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
880 /* Return END_POS constrained to the current input field. */
881 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
887 save_excursion_save ()
889 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
892 return Fcons (Fpoint_marker (),
893 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
894 Fcons (visible
? Qt
: Qnil
,
895 Fcons (current_buffer
->mark_active
,
900 save_excursion_restore (info
)
903 Lisp_Object tem
, tem1
, omark
, nmark
;
904 struct gcpro gcpro1
, gcpro2
, gcpro3
;
907 tem
= Fmarker_buffer (XCAR (info
));
908 /* If buffer being returned to is now deleted, avoid error */
909 /* Otherwise could get error here while unwinding to top level
911 /* In that case, Fmarker_buffer returns nil now. */
915 omark
= nmark
= Qnil
;
916 GCPRO3 (info
, omark
, nmark
);
923 unchain_marker (XMARKER (tem
));
928 omark
= Fmarker_position (current_buffer
->mark
);
929 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
930 nmark
= Fmarker_position (tem
);
931 unchain_marker (XMARKER (tem
));
935 visible_p
= !NILP (XCAR (info
));
937 #if 0 /* We used to make the current buffer visible in the selected window
938 if that was true previously. That avoids some anomalies.
939 But it creates others, and it wasn't documented, and it is simpler
940 and cleaner never to alter the window/buffer connections. */
943 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
944 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
950 tem1
= current_buffer
->mark_active
;
951 current_buffer
->mark_active
= tem
;
953 if (!NILP (Vrun_hooks
))
955 /* If mark is active now, and either was not active
956 or was at a different place, run the activate hook. */
957 if (! NILP (current_buffer
->mark_active
))
959 if (! EQ (omark
, nmark
))
960 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
962 /* If mark has ceased to be active, run deactivate hook. */
963 else if (! NILP (tem1
))
964 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
967 /* If buffer was visible in a window, and a different window was
968 selected, and the old selected window is still showing this
969 buffer, restore point in that window. */
972 && !EQ (tem
, selected_window
)
973 && (tem1
= XWINDOW (tem
)->buffer
,
974 (/* Window is live... */
976 /* ...and it shows the current buffer. */
977 && XBUFFER (tem1
) == current_buffer
)))
978 Fset_window_point (tem
, make_number (PT
));
984 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
985 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
986 Executes BODY just like `progn'.
987 The values of point, mark and the current buffer are restored
988 even in case of abnormal exit (throw or error).
989 The state of activation of the mark is also restored.
991 This construct does not save `deactivate-mark', and therefore
992 functions that change the buffer will still cause deactivation
993 of the mark at the end of the command. To prevent that, bind
994 `deactivate-mark' with `let'.
996 usage: (save-excursion &rest BODY) */)
1000 register Lisp_Object val
;
1001 int count
= SPECPDL_INDEX ();
1003 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1005 val
= Fprogn (args
);
1006 return unbind_to (count
, val
);
1009 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
1010 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
1011 Executes BODY just like `progn'.
1012 usage: (save-current-buffer &rest BODY) */)
1017 int count
= SPECPDL_INDEX ();
1019 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
1021 val
= Fprogn (args
);
1022 return unbind_to (count
, val
);
1025 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1026 doc
: /* Return the number of characters in the current buffer.
1027 If BUFFER, return the number of characters in that buffer instead. */)
1032 return make_number (Z
- BEG
);
1035 CHECK_BUFFER (buffer
);
1036 return make_number (BUF_Z (XBUFFER (buffer
))
1037 - BUF_BEG (XBUFFER (buffer
)));
1041 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1042 doc
: /* Return the minimum permissible value of point in the current buffer.
1043 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1047 XSETFASTINT (temp
, BEGV
);
1051 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1052 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1053 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1056 return buildmark (BEGV
, BEGV_BYTE
);
1059 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1060 doc
: /* Return the maximum permissible value of point in the current buffer.
1061 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1062 is in effect, in which case it is less. */)
1066 XSETFASTINT (temp
, ZV
);
1070 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1071 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1072 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1073 is in effect, in which case it is less. */)
1076 return buildmark (ZV
, ZV_BYTE
);
1079 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1080 doc
: /* Return the position of the gap, in the current buffer.
1081 See also `gap-size'. */)
1085 XSETFASTINT (temp
, GPT
);
1089 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1090 doc
: /* Return the size of the current buffer's gap.
1091 See also `gap-position'. */)
1095 XSETFASTINT (temp
, GAP_SIZE
);
1099 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1100 doc
: /* Return the byte position for character position POSITION.
1101 If POSITION is out of range, the value is nil. */)
1103 Lisp_Object position
;
1105 CHECK_NUMBER_COERCE_MARKER (position
);
1106 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1108 return make_number (CHAR_TO_BYTE (XINT (position
)));
1111 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1112 doc
: /* Return the character position for byte position BYTEPOS.
1113 If BYTEPOS is out of range, the value is nil. */)
1115 Lisp_Object bytepos
;
1117 CHECK_NUMBER (bytepos
);
1118 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1120 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1123 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1124 doc
: /* Return the character following point, as a number.
1125 At the end of the buffer or accessible region, return 0. */)
1130 XSETFASTINT (temp
, 0);
1132 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1136 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1137 doc
: /* Return the character preceding point, as a number.
1138 At the beginning of the buffer or accessible region, return 0. */)
1143 XSETFASTINT (temp
, 0);
1144 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1148 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1151 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1155 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1156 doc
: /* Return t if point is at the beginning of the buffer.
1157 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1165 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1166 doc
: /* Return t if point is at the end of the buffer.
1167 If the buffer is narrowed, this means the end of the narrowed part. */)
1175 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1176 doc
: /* Return t if point is at the beginning of a line. */)
1179 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1184 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1185 doc
: /* Return t if point is at the end of a line.
1186 `End of a line' includes point being at the end of the buffer. */)
1189 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1194 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1195 doc
: /* Return character in current buffer at position POS.
1196 POS is an integer or a marker and defaults to point.
1197 If POS is out of range, the value is nil. */)
1201 register int pos_byte
;
1206 XSETFASTINT (pos
, PT
);
1211 pos_byte
= marker_byte_position (pos
);
1212 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1217 CHECK_NUMBER_COERCE_MARKER (pos
);
1218 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1221 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1224 return make_number (FETCH_CHAR (pos_byte
));
1227 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1228 doc
: /* Return character in current buffer preceding position POS.
1229 POS is an integer or a marker and defaults to point.
1230 If POS is out of range, the value is nil. */)
1234 register Lisp_Object val
;
1235 register int pos_byte
;
1240 XSETFASTINT (pos
, PT
);
1245 pos_byte
= marker_byte_position (pos
);
1247 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1252 CHECK_NUMBER_COERCE_MARKER (pos
);
1254 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1257 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1260 if (!NILP (current_buffer
->enable_multibyte_characters
))
1263 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1268 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1273 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1274 doc
: /* Return the name under which the user logged in, as a string.
1275 This is based on the effective uid, not the real uid.
1276 Also, if the environment variables LOGNAME or USER are set,
1277 that determines the value of this function.
1279 If optional argument UID is an integer, return the login name of the user
1280 with that uid, or nil if there is no such user. */)
1286 /* Set up the user name info if we didn't do it before.
1287 (That can happen if Emacs is dumpable
1288 but you decide to run `temacs -l loadup' and not dump. */
1289 if (INTEGERP (Vuser_login_name
))
1293 return Vuser_login_name
;
1297 pw
= (struct passwd
*) getpwuid (XINT (uid
));
1299 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1302 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1304 doc
: /* Return the name of the user's real uid, as a string.
1305 This ignores the environment variables LOGNAME and USER, so it differs from
1306 `user-login-name' when running under `su'. */)
1309 /* Set up the user name info if we didn't do it before.
1310 (That can happen if Emacs is dumpable
1311 but you decide to run `temacs -l loadup' and not dump. */
1312 if (INTEGERP (Vuser_login_name
))
1314 return Vuser_real_login_name
;
1317 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1318 doc
: /* Return the effective uid of Emacs.
1319 Value is an integer or float, depending on the value. */)
1322 /* Assignment to EMACS_INT stops GCC whining about limited range of
1324 EMACS_INT euid
= geteuid ();
1325 return make_fixnum_or_float (euid
);
1328 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1329 doc
: /* Return the real uid of Emacs.
1330 Value is an integer or float, depending on the value. */)
1333 /* Assignment to EMACS_INT stops GCC whining about limited range of
1335 EMACS_INT uid
= getuid ();
1336 return make_fixnum_or_float (uid
);
1339 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1340 doc
: /* Return the full name of the user logged in, as a string.
1341 If the full name corresponding to Emacs's userid is not known,
1344 If optional argument UID is an integer or float, return the full name
1345 of the user with that uid, or nil if there is no such user.
1346 If UID is a string, return the full name of the user with that login
1347 name, or nil if there is no such user. */)
1352 register unsigned char *p
, *q
;
1356 return Vuser_full_name
;
1357 else if (NUMBERP (uid
))
1360 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1363 else if (STRINGP (uid
))
1366 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1370 error ("Invalid UID specification");
1375 p
= (unsigned char *) USER_FULL_NAME
;
1376 /* Chop off everything after the first comma. */
1377 q
= (unsigned char *) index (p
, ',');
1378 full
= make_string (p
, q
? q
- p
: strlen (p
));
1380 #ifdef AMPERSAND_FULL_NAME
1382 q
= (unsigned char *) index (p
, '&');
1383 /* Substitute the login name for the &, upcasing the first character. */
1386 register unsigned char *r
;
1389 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1390 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1391 bcopy (p
, r
, q
- p
);
1393 strcat (r
, SDATA (login
));
1394 r
[q
- p
] = UPCASE (r
[q
- p
]);
1396 full
= build_string (r
);
1398 #endif /* AMPERSAND_FULL_NAME */
1403 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1404 doc
: /* Return the host name of the machine you are running on, as a string. */)
1407 return Vsystem_name
;
1410 /* For the benefit of callers who don't want to include lisp.h */
1415 if (STRINGP (Vsystem_name
))
1416 return (char *) SDATA (Vsystem_name
);
1422 get_operating_system_release()
1424 if (STRINGP (Voperating_system_release
))
1425 return (char *) SDATA (Voperating_system_release
);
1430 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1431 doc
: /* Return the process ID of Emacs, as an integer. */)
1434 return make_number (getpid ());
1437 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1438 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1439 The time is returned as a list of three integers. The first has the
1440 most significant 16 bits of the seconds, while the second has the
1441 least significant 16 bits. The third integer gives the microsecond
1444 The microsecond count is zero on systems that do not provide
1445 resolution finer than a second. */)
1451 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1452 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1453 make_number (EMACS_USECS (t
)));
1456 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1458 doc
: /* Return the current run time used by Emacs.
1459 The time is returned as a list of three integers. The first has the
1460 most significant 16 bits of the seconds, while the second has the
1461 least significant 16 bits. The third integer gives the microsecond
1464 On systems that can't determine the run time, `get-internal-run-time'
1465 does the same thing as `current-time'. The microsecond count is zero
1466 on systems that do not provide resolution finer than a second. */)
1469 #ifdef HAVE_GETRUSAGE
1470 struct rusage usage
;
1473 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1474 /* This shouldn't happen. What action is appropriate? */
1477 /* Sum up user time and system time. */
1478 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1479 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1480 if (usecs
>= 1000000)
1486 return list3 (make_number ((secs
>> 16) & 0xffff),
1487 make_number ((secs
>> 0) & 0xffff),
1488 make_number (usecs
));
1489 #else /* ! HAVE_GETRUSAGE */
1491 return w32_get_internal_run_time ();
1492 #else /* ! WINDOWSNT */
1493 return Fcurrent_time ();
1494 #endif /* WINDOWSNT */
1495 #endif /* HAVE_GETRUSAGE */
1500 lisp_time_argument (specified_time
, result
, usec
)
1501 Lisp_Object specified_time
;
1505 if (NILP (specified_time
))
1512 *usec
= EMACS_USECS (t
);
1513 *result
= EMACS_SECS (t
);
1517 return time (result
) != -1;
1521 Lisp_Object high
, low
;
1522 high
= Fcar (specified_time
);
1523 CHECK_NUMBER (high
);
1524 low
= Fcdr (specified_time
);
1529 Lisp_Object usec_l
= Fcdr (low
);
1531 usec_l
= Fcar (usec_l
);
1536 CHECK_NUMBER (usec_l
);
1537 *usec
= XINT (usec_l
);
1545 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1546 return *result
>> 16 == XINT (high
);
1550 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1551 doc
: /* Return the current time, as a float number of seconds since the epoch.
1552 If SPECIFIED-TIME is given, it is the time to convert to float
1553 instead of the current time. The argument should have the form
1554 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1555 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1556 have the form (HIGH . LOW), but this is considered obsolete.
1558 WARNING: Since the result is floating point, it may not be exact.
1559 Do not use this function if precise time stamps are required. */)
1561 Lisp_Object specified_time
;
1566 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1567 error ("Invalid time specification");
1569 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1572 /* Write information into buffer S of size MAXSIZE, according to the
1573 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1574 Default to Universal Time if UT is nonzero, local time otherwise.
1575 Return the number of bytes written, not including the terminating
1576 '\0'. If S is NULL, nothing will be written anywhere; so to
1577 determine how many bytes would be written, use NULL for S and
1578 ((size_t) -1) for MAXSIZE.
1580 This function behaves like emacs_strftimeu, except it allows null
1583 emacs_memftimeu (s
, maxsize
, format
, format_len
, tp
, ut
)
1588 const struct tm
*tp
;
1593 /* Loop through all the null-terminated strings in the format
1594 argument. Normally there's just one null-terminated string, but
1595 there can be arbitrarily many, concatenated together, if the
1596 format contains '\0' bytes. emacs_strftimeu stops at the first
1597 '\0' byte so we must invoke it separately for each such string. */
1606 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1610 if (result
== 0 && s
[0] != '\0')
1615 maxsize
-= result
+ 1;
1617 len
= strlen (format
);
1618 if (len
== format_len
)
1622 format_len
-= len
+ 1;
1626 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1627 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1628 TIME is specified as (HIGH LOW . IGNORED), as returned by
1629 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1630 is also still accepted.
1631 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1632 as Universal Time; nil means describe TIME in the local time zone.
1633 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1634 by text that describes the specified date and time in TIME:
1636 %Y is the year, %y within the century, %C the century.
1637 %G is the year corresponding to the ISO week, %g within the century.
1638 %m is the numeric month.
1639 %b and %h are the locale's abbreviated month name, %B the full name.
1640 %d is the day of the month, zero-padded, %e is blank-padded.
1641 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1642 %a is the locale's abbreviated name of the day of week, %A the full name.
1643 %U is the week number starting on Sunday, %W starting on Monday,
1644 %V according to ISO 8601.
1645 %j is the day of the year.
1647 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1648 only blank-padded, %l is like %I blank-padded.
1649 %p is the locale's equivalent of either AM or PM.
1652 %Z is the time zone name, %z is the numeric form.
1653 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1655 %c is the locale's date and time format.
1656 %x is the locale's "preferred" date format.
1657 %D is like "%m/%d/%y".
1659 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1660 %X is the locale's "preferred" time format.
1662 Finally, %n is a newline, %t is a tab, %% is a literal %.
1664 Certain flags and modifiers are available with some format controls.
1665 The flags are `_', `-', `^' and `#'. For certain characters X,
1666 %_X is like %X, but padded with blanks; %-X is like %X,
1667 but without padding. %^X is like %X, but with all textual
1668 characters up-cased; %#X is like %X, but with letter-case of
1669 all textual characters reversed.
1670 %NX (where N stands for an integer) is like %X,
1671 but takes up at least N (a number) positions.
1672 The modifiers are `E' and `O'. For certain characters X,
1673 %EX is a locale's alternative version of %X;
1674 %OX is like %X, but uses the locale's number symbols.
1676 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1677 (format_string
, time
, universal
)
1678 Lisp_Object format_string
, time
, universal
;
1683 int ut
= ! NILP (universal
);
1685 CHECK_STRING (format_string
);
1687 if (! lisp_time_argument (time
, &value
, NULL
))
1688 error ("Invalid time specification");
1690 format_string
= code_convert_string_norecord (format_string
,
1691 Vlocale_coding_system
, 1);
1693 /* This is probably enough. */
1694 size
= SBYTES (format_string
) * 6 + 50;
1697 tm
= ut
? gmtime (&value
) : localtime (&value
);
1700 error ("Specified time is not representable");
1702 synchronize_system_time_locale ();
1706 char *buf
= (char *) alloca (size
+ 1);
1711 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1712 SBYTES (format_string
),
1715 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1716 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1717 Vlocale_coding_system
, 0);
1719 /* If buffer was too small, make it bigger and try again. */
1721 result
= emacs_memftimeu (NULL
, (size_t) -1,
1722 SDATA (format_string
),
1723 SBYTES (format_string
),
1730 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1731 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1732 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1733 as from `current-time' and `file-attributes', or nil to use the
1734 current time. The obsolete form (HIGH . LOW) is also still accepted.
1735 The list has the following nine members: SEC is an integer between 0
1736 and 60; SEC is 60 for a leap second, which only some operating systems
1737 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1738 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1739 integer between 1 and 12. YEAR is an integer indicating the
1740 four-digit year. DOW is the day of week, an integer between 0 and 6,
1741 where 0 is Sunday. DST is t if daylight saving time is in effect,
1742 otherwise nil. ZONE is an integer indicating the number of seconds
1743 east of Greenwich. (Note that Common Lisp has different meanings for
1746 Lisp_Object specified_time
;
1750 struct tm
*decoded_time
;
1751 Lisp_Object list_args
[9];
1753 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1754 error ("Invalid time specification");
1757 decoded_time
= localtime (&time_spec
);
1760 error ("Specified time is not representable");
1761 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1762 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1763 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1764 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1765 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1766 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1767 cast below avoids overflow in int arithmetics. */
1768 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1769 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1770 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1772 /* Make a copy, in case gmtime modifies the struct. */
1773 save_tm
= *decoded_time
;
1775 decoded_time
= gmtime (&time_spec
);
1777 if (decoded_time
== 0)
1778 list_args
[8] = Qnil
;
1780 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1781 return Flist (9, list_args
);
1784 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1785 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1786 This is the reverse operation of `decode-time', which see.
1787 ZONE defaults to the current time zone rule. This can
1788 be a string or t (as from `set-time-zone-rule'), or it can be a list
1789 \(as from `current-time-zone') or an integer (as from `decode-time')
1790 applied without consideration for daylight saving time.
1792 You can pass more than 7 arguments; then the first six arguments
1793 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1794 The intervening arguments are ignored.
1795 This feature lets (apply 'encode-time (decode-time ...)) work.
1797 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1798 for example, a DAY of 0 means the day preceding the given month.
1799 Year numbers less than 100 are treated just like other year numbers.
1800 If you want them to stand for years in this century, you must do that yourself.
1802 Years before 1970 are not guaranteed to work. On some systems,
1803 year values as low as 1901 do work.
1805 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1808 register Lisp_Object
*args
;
1812 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1814 CHECK_NUMBER (args
[0]); /* second */
1815 CHECK_NUMBER (args
[1]); /* minute */
1816 CHECK_NUMBER (args
[2]); /* hour */
1817 CHECK_NUMBER (args
[3]); /* day */
1818 CHECK_NUMBER (args
[4]); /* month */
1819 CHECK_NUMBER (args
[5]); /* year */
1821 tm
.tm_sec
= XINT (args
[0]);
1822 tm
.tm_min
= XINT (args
[1]);
1823 tm
.tm_hour
= XINT (args
[2]);
1824 tm
.tm_mday
= XINT (args
[3]);
1825 tm
.tm_mon
= XINT (args
[4]) - 1;
1826 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1834 time
= mktime (&tm
);
1841 char **oldenv
= environ
, **newenv
;
1845 else if (STRINGP (zone
))
1846 tzstring
= (char *) SDATA (zone
);
1847 else if (INTEGERP (zone
))
1849 int abszone
= eabs (XINT (zone
));
1850 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1851 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1855 error ("Invalid time zone specification");
1857 /* Set TZ before calling mktime; merely adjusting mktime's returned
1858 value doesn't suffice, since that would mishandle leap seconds. */
1859 set_time_zone_rule (tzstring
);
1862 time
= mktime (&tm
);
1865 /* Restore TZ to previous value. */
1869 #ifdef LOCALTIME_CACHE
1874 if (time
== (time_t) -1)
1875 error ("Specified time is not representable");
1877 return make_time (time
);
1880 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1881 doc
: /* Return the current time, as a human-readable string.
1882 Programs can use this function to decode a time,
1883 since the number of columns in each field is fixed
1884 if the year is in the range 1000-9999.
1885 The format is `Sun Sep 16 01:03:52 1973'.
1886 However, see also the functions `decode-time' and `format-time-string'
1887 which provide a much more powerful and general facility.
1889 If SPECIFIED-TIME is given, it is a time to format instead of the
1890 current time. The argument should have the form (HIGH LOW . IGNORED).
1891 Thus, you can use times obtained from `current-time' and from
1892 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1893 but this is considered obsolete. */)
1895 Lisp_Object specified_time
;
1901 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1902 error ("Invalid time specification");
1904 /* Convert to a string, checking for out-of-range time stamps.
1905 Don't use 'ctime', as that might dump core if VALUE is out of
1908 tm
= localtime (&value
);
1910 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1911 error ("Specified time is not representable");
1913 /* Remove the trailing newline. */
1914 tem
[strlen (tem
) - 1] = '\0';
1916 return build_string (tem
);
1919 /* Yield A - B, measured in seconds.
1920 This function is copied from the GNU C Library. */
1925 /* Compute intervening leap days correctly even if year is negative.
1926 Take care to avoid int overflow in leap day calculations,
1927 but it's OK to assume that A and B are close to each other. */
1928 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1929 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1930 int a100
= a4
/ 25 - (a4
% 25 < 0);
1931 int b100
= b4
/ 25 - (b4
% 25 < 0);
1932 int a400
= a100
>> 2;
1933 int b400
= b100
>> 2;
1934 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1935 int years
= a
->tm_year
- b
->tm_year
;
1936 int days
= (365 * years
+ intervening_leap_days
1937 + (a
->tm_yday
- b
->tm_yday
));
1938 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1939 + (a
->tm_min
- b
->tm_min
))
1940 + (a
->tm_sec
- b
->tm_sec
));
1943 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1944 doc
: /* Return the offset and name for the local time zone.
1945 This returns a list of the form (OFFSET NAME).
1946 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1947 A negative value means west of Greenwich.
1948 NAME is a string giving the name of the time zone.
1949 If SPECIFIED-TIME is given, the time zone offset is determined from it
1950 instead of using the current time. The argument should have the form
1951 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1952 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1953 have the form (HIGH . LOW), but this is considered obsolete.
1955 Some operating systems cannot provide all this information to Emacs;
1956 in this case, `current-time-zone' returns a list containing nil for
1957 the data it can't find. */)
1959 Lisp_Object specified_time
;
1965 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1970 t
= gmtime (&value
);
1974 t
= localtime (&value
);
1981 int offset
= tm_diff (t
, &gmt
);
1987 s
= (char *)t
->tm_zone
;
1988 #else /* not HAVE_TM_ZONE */
1990 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1991 s
= tzname
[t
->tm_isdst
];
1993 #endif /* not HAVE_TM_ZONE */
1997 /* No local time zone name is available; use "+-NNNN" instead. */
1998 int am
= (offset
< 0 ? -offset
: offset
) / 60;
1999 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
2003 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
2006 return Fmake_list (make_number (2), Qnil
);
2009 /* This holds the value of `environ' produced by the previous
2010 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
2011 has never been called. */
2012 static char **environbuf
;
2014 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
2015 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
2016 If TZ is nil, use implementation-defined default time zone information.
2017 If TZ is t, use Universal Time. */)
2025 else if (EQ (tz
, Qt
))
2030 tzstring
= (char *) SDATA (tz
);
2033 set_time_zone_rule (tzstring
);
2036 environbuf
= environ
;
2041 #ifdef LOCALTIME_CACHE
2043 /* These two values are known to load tz files in buggy implementations,
2044 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2045 Their values shouldn't matter in non-buggy implementations.
2046 We don't use string literals for these strings,
2047 since if a string in the environment is in readonly
2048 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2049 See Sun bugs 1113095 and 1114114, ``Timezone routines
2050 improperly modify environment''. */
2052 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2053 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2057 /* Set the local time zone rule to TZSTRING.
2058 This allocates memory into `environ', which it is the caller's
2059 responsibility to free. */
2062 set_time_zone_rule (tzstring
)
2066 char **from
, **to
, **newenv
;
2068 /* Make the ENVIRON vector longer with room for TZSTRING. */
2069 for (from
= environ
; *from
; from
++)
2071 envptrs
= from
- environ
+ 2;
2072 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2073 + (tzstring
? strlen (tzstring
) + 4 : 0));
2075 /* Add TZSTRING to the end of environ, as a value for TZ. */
2078 char *t
= (char *) (to
+ envptrs
);
2080 strcat (t
, tzstring
);
2084 /* Copy the old environ vector elements into NEWENV,
2085 but don't copy the TZ variable.
2086 So we have only one definition of TZ, which came from TZSTRING. */
2087 for (from
= environ
; *from
; from
++)
2088 if (strncmp (*from
, "TZ=", 3) != 0)
2094 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2095 the TZ variable is stored. If we do not have a TZSTRING,
2096 TO points to the vector slot which has the terminating null. */
2098 #ifdef LOCALTIME_CACHE
2100 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2101 "US/Pacific" that loads a tz file, then changes to a value like
2102 "XXX0" that does not load a tz file, and then changes back to
2103 its original value, the last change is (incorrectly) ignored.
2104 Also, if TZ changes twice in succession to values that do
2105 not load a tz file, tzset can dump core (see Sun bug#1225179).
2106 The following code works around these bugs. */
2110 /* Temporarily set TZ to a value that loads a tz file
2111 and that differs from tzstring. */
2113 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2114 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2120 /* The implied tzstring is unknown, so temporarily set TZ to
2121 two different values that each load a tz file. */
2122 *to
= set_time_zone_rule_tz1
;
2125 *to
= set_time_zone_rule_tz2
;
2130 /* Now TZ has the desired value, and tzset can be invoked safely. */
2137 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2138 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2139 type of object is Lisp_String). INHERIT is passed to
2140 INSERT_FROM_STRING_FUNC as the last argument. */
2143 general_insert_function (insert_func
, insert_from_string_func
,
2144 inherit
, nargs
, args
)
2145 void (*insert_func
) P_ ((const unsigned char *, int));
2146 void (*insert_from_string_func
) P_ ((Lisp_Object
, int, int, int, int, int));
2148 register Lisp_Object
*args
;
2150 register int argnum
;
2151 register Lisp_Object val
;
2153 for (argnum
= 0; argnum
< nargs
; argnum
++)
2156 if (CHARACTERP (val
))
2158 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2161 if (!NILP (current_buffer
->enable_multibyte_characters
))
2162 len
= CHAR_STRING (XFASTINT (val
), str
);
2165 str
[0] = (ASCII_CHAR_P (XINT (val
))
2167 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2170 (*insert_func
) (str
, len
);
2172 else if (STRINGP (val
))
2174 (*insert_from_string_func
) (val
, 0, 0,
2180 wrong_type_argument (Qchar_or_string_p
, val
);
2192 /* Callers passing one argument to Finsert need not gcpro the
2193 argument "array", since the only element of the array will
2194 not be used after calling insert or insert_from_string, so
2195 we don't care if it gets trashed. */
2197 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2198 doc
: /* Insert the arguments, either strings or characters, at point.
2199 Point and before-insertion markers move forward to end up
2200 after the inserted text.
2201 Any other markers at the point of insertion remain before the text.
2203 If the current buffer is multibyte, unibyte strings are converted
2204 to multibyte for insertion (see `string-make-multibyte').
2205 If the current buffer is unibyte, multibyte strings are converted
2206 to unibyte for insertion (see `string-make-unibyte').
2208 When operating on binary data, it may be necessary to preserve the
2209 original bytes of a unibyte string when inserting it into a multibyte
2210 buffer; to accomplish this, apply `string-as-multibyte' to the string
2211 and insert the result.
2213 usage: (insert &rest ARGS) */)
2216 register Lisp_Object
*args
;
2218 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2222 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2224 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2225 Point and before-insertion markers move forward to end up
2226 after the inserted text.
2227 Any other markers at the point of insertion remain before the text.
2229 If the current buffer is multibyte, unibyte strings are converted
2230 to multibyte for insertion (see `unibyte-char-to-multibyte').
2231 If the current buffer is unibyte, multibyte strings are converted
2232 to unibyte for insertion.
2234 usage: (insert-and-inherit &rest ARGS) */)
2237 register Lisp_Object
*args
;
2239 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2244 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2245 doc
: /* Insert strings or characters at point, relocating markers after the text.
2246 Point and markers move forward to end up after the inserted text.
2248 If the current buffer is multibyte, unibyte strings are converted
2249 to multibyte for insertion (see `unibyte-char-to-multibyte').
2250 If the current buffer is unibyte, multibyte strings are converted
2251 to unibyte for insertion.
2253 usage: (insert-before-markers &rest ARGS) */)
2256 register Lisp_Object
*args
;
2258 general_insert_function (insert_before_markers
,
2259 insert_from_string_before_markers
, 0,
2264 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2265 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2266 doc
: /* Insert text at point, relocating markers and inheriting properties.
2267 Point and markers move forward to end up after the inserted text.
2269 If the current buffer is multibyte, unibyte strings are converted
2270 to multibyte for insertion (see `unibyte-char-to-multibyte').
2271 If the current buffer is unibyte, multibyte strings are converted
2272 to unibyte for insertion.
2274 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2277 register Lisp_Object
*args
;
2279 general_insert_function (insert_before_markers_and_inherit
,
2280 insert_from_string_before_markers
, 1,
2285 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2286 doc
: /* Insert COUNT copies of CHARACTER.
2287 Point, and before-insertion markers, are relocated as in the function `insert'.
2288 The optional third arg INHERIT, if non-nil, says to inherit text properties
2289 from adjoining text, if those properties are sticky. */)
2290 (character
, count
, inherit
)
2291 Lisp_Object character
, count
, inherit
;
2293 register unsigned char *string
;
2294 register int strlen
;
2297 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2299 CHECK_NUMBER (character
);
2300 CHECK_NUMBER (count
);
2302 if (!NILP (current_buffer
->enable_multibyte_characters
))
2303 len
= CHAR_STRING (XFASTINT (character
), str
);
2305 str
[0] = XFASTINT (character
), len
= 1;
2306 n
= XINT (count
) * len
;
2309 strlen
= min (n
, 256 * len
);
2310 string
= (unsigned char *) alloca (strlen
);
2311 for (i
= 0; i
< strlen
; i
++)
2312 string
[i
] = str
[i
% len
];
2316 if (!NILP (inherit
))
2317 insert_and_inherit (string
, strlen
);
2319 insert (string
, strlen
);
2324 if (!NILP (inherit
))
2325 insert_and_inherit (string
, n
);
2332 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2333 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2334 Both arguments are required.
2335 BYTE is a number of the range 0..255.
2337 If BYTE is 128..255 and the current buffer is multibyte, the
2338 corresponding eight-bit character is inserted.
2340 Point, and before-insertion markers, are relocated as in the function `insert'.
2341 The optional third arg INHERIT, if non-nil, says to inherit text properties
2342 from adjoining text, if those properties are sticky. */)
2343 (byte
, count
, inherit
)
2344 Lisp_Object byte
, count
, inherit
;
2346 CHECK_NUMBER (byte
);
2347 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2348 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2349 if (XINT (byte
) >= 128
2350 && ! NILP (current_buffer
->enable_multibyte_characters
))
2351 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2352 return Finsert_char (byte
, count
, inherit
);
2356 /* Making strings from buffer contents. */
2358 /* Return a Lisp_String containing the text of the current buffer from
2359 START to END. If text properties are in use and the current buffer
2360 has properties in the range specified, the resulting string will also
2361 have them, if PROPS is nonzero.
2363 We don't want to use plain old make_string here, because it calls
2364 make_uninit_string, which can cause the buffer arena to be
2365 compacted. make_string has no way of knowing that the data has
2366 been moved, and thus copies the wrong data into the string. This
2367 doesn't effect most of the other users of make_string, so it should
2368 be left as is. But we should use this function when conjuring
2369 buffer substrings. */
2372 make_buffer_string (start
, end
, props
)
2376 int start_byte
= CHAR_TO_BYTE (start
);
2377 int end_byte
= CHAR_TO_BYTE (end
);
2379 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2382 /* Return a Lisp_String containing the text of the current buffer from
2383 START / START_BYTE to END / END_BYTE.
2385 If text properties are in use and the current buffer
2386 has properties in the range specified, the resulting string will also
2387 have them, if PROPS is nonzero.
2389 We don't want to use plain old make_string here, because it calls
2390 make_uninit_string, which can cause the buffer arena to be
2391 compacted. make_string has no way of knowing that the data has
2392 been moved, and thus copies the wrong data into the string. This
2393 doesn't effect most of the other users of make_string, so it should
2394 be left as is. But we should use this function when conjuring
2395 buffer substrings. */
2398 make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
)
2399 int start
, start_byte
, end
, end_byte
;
2402 Lisp_Object result
, tem
, tem1
;
2404 if (start
< GPT
&& GPT
< end
)
2407 if (! NILP (current_buffer
->enable_multibyte_characters
))
2408 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2410 result
= make_uninit_string (end
- start
);
2411 bcopy (BYTE_POS_ADDR (start_byte
), SDATA (result
),
2412 end_byte
- start_byte
);
2414 /* If desired, update and copy the text properties. */
2417 update_buffer_properties (start
, end
);
2419 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2420 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2422 if (XINT (tem
) != end
|| !NILP (tem1
))
2423 copy_intervals_to_string (result
, current_buffer
, start
,
2430 /* Call Vbuffer_access_fontify_functions for the range START ... END
2431 in the current buffer, if necessary. */
2434 update_buffer_properties (start
, end
)
2437 /* If this buffer has some access functions,
2438 call them, specifying the range of the buffer being accessed. */
2439 if (!NILP (Vbuffer_access_fontify_functions
))
2441 Lisp_Object args
[3];
2444 args
[0] = Qbuffer_access_fontify_functions
;
2445 XSETINT (args
[1], start
);
2446 XSETINT (args
[2], end
);
2448 /* But don't call them if we can tell that the work
2449 has already been done. */
2450 if (!NILP (Vbuffer_access_fontified_property
))
2452 tem
= Ftext_property_any (args
[1], args
[2],
2453 Vbuffer_access_fontified_property
,
2456 Frun_hook_with_args (3, args
);
2459 Frun_hook_with_args (3, args
);
2463 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2464 doc
: /* Return the contents of part of the current buffer as a string.
2465 The two arguments START and END are character positions;
2466 they can be in either order.
2467 The string returned is multibyte if the buffer is multibyte.
2469 This function copies the text properties of that part of the buffer
2470 into the result string; if you don't want the text properties,
2471 use `buffer-substring-no-properties' instead. */)
2473 Lisp_Object start
, end
;
2477 validate_region (&start
, &end
);
2481 return make_buffer_string (b
, e
, 1);
2484 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2485 Sbuffer_substring_no_properties
, 2, 2, 0,
2486 doc
: /* Return the characters of part of the buffer, without the text properties.
2487 The two arguments START and END are character positions;
2488 they can be in either order. */)
2490 Lisp_Object start
, end
;
2494 validate_region (&start
, &end
);
2498 return make_buffer_string (b
, e
, 0);
2501 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2502 doc
: /* Return the contents of the current buffer as a string.
2503 If narrowing is in effect, this function returns only the visible part
2507 return make_buffer_string (BEGV
, ZV
, 1);
2510 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2512 doc
: /* Insert before point a substring of the contents of BUFFER.
2513 BUFFER may be a buffer or a buffer name.
2514 Arguments START and END are character positions specifying the substring.
2515 They default to the values of (point-min) and (point-max) in BUFFER. */)
2516 (buffer
, start
, end
)
2517 Lisp_Object buffer
, start
, end
;
2519 register int b
, e
, temp
;
2520 register struct buffer
*bp
, *obuf
;
2523 buf
= Fget_buffer (buffer
);
2527 if (NILP (bp
->name
))
2528 error ("Selecting deleted buffer");
2534 CHECK_NUMBER_COERCE_MARKER (start
);
2541 CHECK_NUMBER_COERCE_MARKER (end
);
2546 temp
= b
, b
= e
, e
= temp
;
2548 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2549 args_out_of_range (start
, end
);
2551 obuf
= current_buffer
;
2552 set_buffer_internal_1 (bp
);
2553 update_buffer_properties (b
, e
);
2554 set_buffer_internal_1 (obuf
);
2556 insert_from_buffer (bp
, b
, e
- b
, 0);
2560 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2562 doc
: /* Compare two substrings of two buffers; return result as number.
2563 the value is -N if first string is less after N-1 chars,
2564 +N if first string is greater after N-1 chars, or 0 if strings match.
2565 Each substring is represented as three arguments: BUFFER, START and END.
2566 That makes six args in all, three for each substring.
2568 The value of `case-fold-search' in the current buffer
2569 determines whether case is significant or ignored. */)
2570 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2571 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2573 register int begp1
, endp1
, begp2
, endp2
, temp
;
2574 register struct buffer
*bp1
, *bp2
;
2575 register Lisp_Object trt
2576 = (!NILP (current_buffer
->case_fold_search
)
2577 ? current_buffer
->case_canon_table
: Qnil
);
2579 int i1
, i2
, i1_byte
, i2_byte
;
2581 /* Find the first buffer and its substring. */
2584 bp1
= current_buffer
;
2588 buf1
= Fget_buffer (buffer1
);
2591 bp1
= XBUFFER (buf1
);
2592 if (NILP (bp1
->name
))
2593 error ("Selecting deleted buffer");
2597 begp1
= BUF_BEGV (bp1
);
2600 CHECK_NUMBER_COERCE_MARKER (start1
);
2601 begp1
= XINT (start1
);
2604 endp1
= BUF_ZV (bp1
);
2607 CHECK_NUMBER_COERCE_MARKER (end1
);
2608 endp1
= XINT (end1
);
2612 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2614 if (!(BUF_BEGV (bp1
) <= begp1
2616 && endp1
<= BUF_ZV (bp1
)))
2617 args_out_of_range (start1
, end1
);
2619 /* Likewise for second substring. */
2622 bp2
= current_buffer
;
2626 buf2
= Fget_buffer (buffer2
);
2629 bp2
= XBUFFER (buf2
);
2630 if (NILP (bp2
->name
))
2631 error ("Selecting deleted buffer");
2635 begp2
= BUF_BEGV (bp2
);
2638 CHECK_NUMBER_COERCE_MARKER (start2
);
2639 begp2
= XINT (start2
);
2642 endp2
= BUF_ZV (bp2
);
2645 CHECK_NUMBER_COERCE_MARKER (end2
);
2646 endp2
= XINT (end2
);
2650 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2652 if (!(BUF_BEGV (bp2
) <= begp2
2654 && endp2
<= BUF_ZV (bp2
)))
2655 args_out_of_range (start2
, end2
);
2659 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2660 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2662 while (i1
< endp1
&& i2
< endp2
)
2664 /* When we find a mismatch, we must compare the
2665 characters, not just the bytes. */
2670 if (! NILP (bp1
->enable_multibyte_characters
))
2672 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2673 BUF_INC_POS (bp1
, i1_byte
);
2678 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2679 c1
= unibyte_char_to_multibyte (c1
);
2683 if (! NILP (bp2
->enable_multibyte_characters
))
2685 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2686 BUF_INC_POS (bp2
, i2_byte
);
2691 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2692 c2
= unibyte_char_to_multibyte (c2
);
2698 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2699 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2702 return make_number (- 1 - chars
);
2704 return make_number (chars
+ 1);
2709 /* The strings match as far as they go.
2710 If one is shorter, that one is less. */
2711 if (chars
< endp1
- begp1
)
2712 return make_number (chars
+ 1);
2713 else if (chars
< endp2
- begp2
)
2714 return make_number (- chars
- 1);
2716 /* Same length too => they are equal. */
2717 return make_number (0);
2721 subst_char_in_region_unwind (arg
)
2724 return current_buffer
->undo_list
= arg
;
2728 subst_char_in_region_unwind_1 (arg
)
2731 return current_buffer
->filename
= arg
;
2734 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2735 Ssubst_char_in_region
, 4, 5, 0,
2736 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2737 If optional arg NOUNDO is non-nil, don't record this change for undo
2738 and don't mark the buffer as really changed.
2739 Both characters must have the same length of multi-byte form. */)
2740 (start
, end
, fromchar
, tochar
, noundo
)
2741 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2743 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2744 /* Keep track of the first change in the buffer:
2745 if 0 we haven't found it yet.
2746 if < 0 we've found it and we've run the before-change-function.
2747 if > 0 we've actually performed it and the value is its position. */
2749 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2751 int count
= SPECPDL_INDEX ();
2752 #define COMBINING_NO 0
2753 #define COMBINING_BEFORE 1
2754 #define COMBINING_AFTER 2
2755 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2756 int maybe_byte_combining
= COMBINING_NO
;
2757 int last_changed
= 0;
2758 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2762 validate_region (&start
, &end
);
2763 CHECK_NUMBER (fromchar
);
2764 CHECK_NUMBER (tochar
);
2768 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2769 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2770 error ("Characters in `subst-char-in-region' have different byte-lengths");
2771 if (!ASCII_BYTE_P (*tostr
))
2773 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2774 complete multibyte character, it may be combined with the
2775 after bytes. If it is in the range 0xA0..0xFF, it may be
2776 combined with the before and after bytes. */
2777 if (!CHAR_HEAD_P (*tostr
))
2778 maybe_byte_combining
= COMBINING_BOTH
;
2779 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2780 maybe_byte_combining
= COMBINING_AFTER
;
2786 fromstr
[0] = XFASTINT (fromchar
);
2787 tostr
[0] = XFASTINT (tochar
);
2791 pos_byte
= CHAR_TO_BYTE (pos
);
2792 stop
= CHAR_TO_BYTE (XINT (end
));
2795 /* If we don't want undo, turn off putting stuff on the list.
2796 That's faster than getting rid of things,
2797 and it prevents even the entry for a first change.
2798 Also inhibit locking the file. */
2799 if (!changed
&& !NILP (noundo
))
2801 record_unwind_protect (subst_char_in_region_unwind
,
2802 current_buffer
->undo_list
);
2803 current_buffer
->undo_list
= Qt
;
2804 /* Don't do file-locking. */
2805 record_unwind_protect (subst_char_in_region_unwind_1
,
2806 current_buffer
->filename
);
2807 current_buffer
->filename
= Qnil
;
2810 if (pos_byte
< GPT_BYTE
)
2811 stop
= min (stop
, GPT_BYTE
);
2814 int pos_byte_next
= pos_byte
;
2816 if (pos_byte
>= stop
)
2818 if (pos_byte
>= end_byte
) break;
2821 p
= BYTE_POS_ADDR (pos_byte
);
2823 INC_POS (pos_byte_next
);
2826 if (pos_byte_next
- pos_byte
== len
2827 && p
[0] == fromstr
[0]
2829 || (p
[1] == fromstr
[1]
2830 && (len
== 2 || (p
[2] == fromstr
[2]
2831 && (len
== 3 || p
[3] == fromstr
[3]))))))
2834 /* We've already seen this and run the before-change-function;
2835 this time we only need to record the actual position. */
2840 modify_region (current_buffer
, pos
, XINT (end
), 0);
2842 if (! NILP (noundo
))
2844 if (MODIFF
- 1 == SAVE_MODIFF
)
2846 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
2847 current_buffer
->auto_save_modified
++;
2850 /* The before-change-function may have moved the gap
2851 or even modified the buffer so we should start over. */
2855 /* Take care of the case where the new character
2856 combines with neighboring bytes. */
2857 if (maybe_byte_combining
2858 && (maybe_byte_combining
== COMBINING_AFTER
2859 ? (pos_byte_next
< Z_BYTE
2860 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2861 : ((pos_byte_next
< Z_BYTE
2862 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2863 || (pos_byte
> BEG_BYTE
2864 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2866 Lisp_Object tem
, string
;
2868 struct gcpro gcpro1
;
2870 tem
= current_buffer
->undo_list
;
2873 /* Make a multibyte string containing this single character. */
2874 string
= make_multibyte_string (tostr
, 1, len
);
2875 /* replace_range is less efficient, because it moves the gap,
2876 but it handles combining correctly. */
2877 replace_range (pos
, pos
+ 1, string
,
2879 pos_byte_next
= CHAR_TO_BYTE (pos
);
2880 if (pos_byte_next
> pos_byte
)
2881 /* Before combining happened. We should not increment
2882 POS. So, to cancel the later increment of POS,
2886 INC_POS (pos_byte_next
);
2888 if (! NILP (noundo
))
2889 current_buffer
->undo_list
= tem
;
2896 record_change (pos
, 1);
2897 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2899 last_changed
= pos
+ 1;
2901 pos_byte
= pos_byte_next
;
2907 signal_after_change (changed
,
2908 last_changed
- changed
, last_changed
- changed
);
2909 update_compositions (changed
, last_changed
, CHECK_ALL
);
2912 unbind_to (count
, Qnil
);
2917 static Lisp_Object check_translation
P_ ((int, int, int, Lisp_Object
));
2919 /* Helper function for Ftranslate_region_internal.
2921 Check if a character sequence at POS (POS_BYTE) matches an element
2922 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2923 element is found, return it. Otherwise return Qnil. */
2926 check_translation (pos
, pos_byte
, end
, val
)
2927 int pos
, pos_byte
, end
;
2930 int buf_size
= 16, buf_used
= 0;
2931 int *buf
= alloca (sizeof (int) * buf_size
);
2933 for (; CONSP (val
); val
= XCDR (val
))
2942 if (! VECTORP (elt
))
2945 if (len
<= end
- pos
)
2947 for (i
= 0; i
< len
; i
++)
2951 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2954 if (buf_used
== buf_size
)
2959 newbuf
= alloca (sizeof (int) * buf_size
);
2960 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2963 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, 0, len
);
2966 if (XINT (AREF (elt
, i
)) != buf
[i
])
2977 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
2978 Stranslate_region_internal
, 3, 3, 0,
2979 doc
: /* Internal use only.
2980 From START to END, translate characters according to TABLE.
2981 TABLE is a string or a char-table; the Nth character in it is the
2982 mapping for the character with code N.
2983 It returns the number of characters changed. */)
2987 register Lisp_Object table
;
2989 register unsigned char *tt
; /* Trans table. */
2990 register int nc
; /* New character. */
2991 int cnt
; /* Number of changes made. */
2992 int size
; /* Size of translate table. */
2993 int pos
, pos_byte
, end_pos
;
2994 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2995 int string_multibyte
;
2998 validate_region (&start
, &end
);
2999 if (CHAR_TABLE_P (table
))
3001 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
3002 error ("Not a translation table");
3008 CHECK_STRING (table
);
3010 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
3011 table
= string_make_unibyte (table
);
3012 string_multibyte
= SCHARS (table
) < SBYTES (table
);
3013 size
= SBYTES (table
);
3018 pos_byte
= CHAR_TO_BYTE (pos
);
3019 end_pos
= XINT (end
);
3020 modify_region (current_buffer
, pos
, end_pos
, 0);
3023 for (; pos
< end_pos
; )
3025 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3026 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
3032 oc
= STRING_CHAR_AND_LENGTH (p
, MAX_MULTIBYTE_LENGTH
, len
);
3039 /* Reload as signal_after_change in last iteration may GC. */
3041 if (string_multibyte
)
3043 str
= tt
+ string_char_to_byte (table
, oc
);
3044 nc
= STRING_CHAR_AND_LENGTH (str
, MAX_MULTIBYTE_LENGTH
,
3050 if (! ASCII_BYTE_P (nc
) && multibyte
)
3052 str_len
= BYTE8_STRING (nc
, buf
);
3067 val
= CHAR_TABLE_REF (table
, oc
);
3068 if (CHARACTERP (val
)
3069 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3072 str_len
= CHAR_STRING (nc
, buf
);
3075 else if (VECTORP (val
) || (CONSP (val
)))
3077 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3078 where TO is TO-CHAR or [TO-CHAR ...]. */
3083 if (nc
!= oc
&& nc
>= 0)
3085 /* Simple one char to one char translation. */
3090 /* This is less efficient, because it moves the gap,
3091 but it should handle multibyte characters correctly. */
3092 string
= make_multibyte_string (str
, 1, str_len
);
3093 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3098 record_change (pos
, 1);
3099 while (str_len
-- > 0)
3101 signal_after_change (pos
, 1, 1);
3102 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3112 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3119 /* VAL is ([FROM-CHAR ...] . TO). */
3120 len
= ASIZE (XCAR (val
));
3130 string
= Fmake_string (make_number (ASIZE (val
)),
3132 for (i
= 1; i
< ASIZE (val
); i
++)
3133 Faset (string
, make_number (i
), AREF (val
, i
));
3137 string
= Fmake_string (make_number (1), val
);
3139 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3140 pos_byte
+= SBYTES (string
);
3141 pos
+= SCHARS (string
);
3142 cnt
+= SCHARS (string
);
3143 end_pos
+= SCHARS (string
) - len
;
3151 return make_number (cnt
);
3154 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3155 doc
: /* Delete the text between point and mark.
3157 When called from a program, expects two arguments,
3158 positions (integers or markers) specifying the stretch to be deleted. */)
3160 Lisp_Object start
, end
;
3162 validate_region (&start
, &end
);
3163 del_range (XINT (start
), XINT (end
));
3167 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3168 Sdelete_and_extract_region
, 2, 2, 0,
3169 doc
: /* Delete the text between START and END and return it. */)
3171 Lisp_Object start
, end
;
3173 validate_region (&start
, &end
);
3174 if (XINT (start
) == XINT (end
))
3175 return empty_unibyte_string
;
3176 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3179 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3180 doc
: /* Remove restrictions (narrowing) from current buffer.
3181 This allows the buffer's full text to be seen and edited. */)
3184 if (BEG
!= BEGV
|| Z
!= ZV
)
3185 current_buffer
->clip_changed
= 1;
3187 BEGV_BYTE
= BEG_BYTE
;
3188 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3189 /* Changing the buffer bounds invalidates any recorded current column. */
3190 invalidate_current_column ();
3194 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3195 doc
: /* Restrict editing in this buffer to the current region.
3196 The rest of the text becomes temporarily invisible and untouchable
3197 but is not deleted; if you save the buffer in a file, the invisible
3198 text is included in the file. \\[widen] makes all visible again.
3199 See also `save-restriction'.
3201 When calling from a program, pass two arguments; positions (integers
3202 or markers) bounding the text that should remain visible. */)
3204 register Lisp_Object start
, end
;
3206 CHECK_NUMBER_COERCE_MARKER (start
);
3207 CHECK_NUMBER_COERCE_MARKER (end
);
3209 if (XINT (start
) > XINT (end
))
3212 tem
= start
; start
= end
; end
= tem
;
3215 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3216 args_out_of_range (start
, end
);
3218 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3219 current_buffer
->clip_changed
= 1;
3221 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3222 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3223 if (PT
< XFASTINT (start
))
3224 SET_PT (XFASTINT (start
));
3225 if (PT
> XFASTINT (end
))
3226 SET_PT (XFASTINT (end
));
3227 /* Changing the buffer bounds invalidates any recorded current column. */
3228 invalidate_current_column ();
3233 save_restriction_save ()
3235 if (BEGV
== BEG
&& ZV
== Z
)
3236 /* The common case that the buffer isn't narrowed.
3237 We return just the buffer object, which save_restriction_restore
3238 recognizes as meaning `no restriction'. */
3239 return Fcurrent_buffer ();
3241 /* We have to save a restriction, so return a pair of markers, one
3242 for the beginning and one for the end. */
3244 Lisp_Object beg
, end
;
3246 beg
= buildmark (BEGV
, BEGV_BYTE
);
3247 end
= buildmark (ZV
, ZV_BYTE
);
3249 /* END must move forward if text is inserted at its exact location. */
3250 XMARKER(end
)->insertion_type
= 1;
3252 return Fcons (beg
, end
);
3257 save_restriction_restore (data
)
3261 /* A pair of marks bounding a saved restriction. */
3263 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3264 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3265 struct buffer
*buf
= beg
->buffer
; /* END should have the same buffer. */
3267 if (buf
/* Verify marker still points to a buffer. */
3268 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3269 /* The restriction has changed from the saved one, so restore
3270 the saved restriction. */
3272 int pt
= BUF_PT (buf
);
3274 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3275 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3277 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3278 /* The point is outside the new visible range, move it inside. */
3279 SET_BUF_PT_BOTH (buf
,
3280 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3281 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3284 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3288 /* A buffer, which means that there was no old restriction. */
3290 struct buffer
*buf
= XBUFFER (data
);
3292 if (buf
/* Verify marker still points to a buffer. */
3293 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3294 /* The buffer has been narrowed, get rid of the narrowing. */
3296 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3297 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3299 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3306 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3307 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3308 The buffer's restrictions make parts of the beginning and end invisible.
3309 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3310 This special form, `save-restriction', saves the current buffer's restrictions
3311 when it is entered, and restores them when it is exited.
3312 So any `narrow-to-region' within BODY lasts only until the end of the form.
3313 The old restrictions settings are restored
3314 even in case of abnormal exit (throw or error).
3316 The value returned is the value of the last form in BODY.
3318 Note: if you are using both `save-excursion' and `save-restriction',
3319 use `save-excursion' outermost:
3320 (save-excursion (save-restriction ...))
3322 usage: (save-restriction &rest BODY) */)
3326 register Lisp_Object val
;
3327 int count
= SPECPDL_INDEX ();
3329 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3330 val
= Fprogn (body
);
3331 return unbind_to (count
, val
);
3334 /* Buffer for the most recent text displayed by Fmessage_box. */
3335 static char *message_text
;
3337 /* Allocated length of that buffer. */
3338 static int message_length
;
3340 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3341 doc
: /* Display a message at the bottom of the screen.
3342 The message also goes into the `*Messages*' buffer.
3343 \(In keyboard macros, that's all it does.)
3346 The first argument is a format control string, and the rest are data
3347 to be formatted under control of the string. See `format' for details.
3349 Note: Use (message "%s" VALUE) to print the value of expressions and
3350 variables to avoid accidentally interpreting `%' as format specifiers.
3352 If the first argument is nil or the empty string, the function clears
3353 any existing message; this lets the minibuffer contents show. See
3354 also `current-message'.
3356 usage: (message FORMAT-STRING &rest ARGS) */)
3362 || (STRINGP (args
[0])
3363 && SBYTES (args
[0]) == 0))
3370 register Lisp_Object val
;
3371 val
= Fformat (nargs
, args
);
3372 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3377 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3378 doc
: /* Display a message, in a dialog box if possible.
3379 If a dialog box is not available, use the echo area.
3380 The first argument is a format control string, and the rest are data
3381 to be formatted under control of the string. See `format' for details.
3383 If the first argument is nil or the empty string, clear any existing
3384 message; let the minibuffer contents show.
3386 usage: (message-box FORMAT-STRING &rest ARGS) */)
3398 register Lisp_Object val
;
3399 val
= Fformat (nargs
, args
);
3401 /* The MS-DOS frames support popup menus even though they are
3402 not FRAME_WINDOW_P. */
3403 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3404 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3406 Lisp_Object pane
, menu
, obj
;
3407 struct gcpro gcpro1
;
3408 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3410 menu
= Fcons (val
, pane
);
3411 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3415 #endif /* HAVE_MENUS */
3416 /* Copy the data so that it won't move when we GC. */
3419 message_text
= (char *)xmalloc (80);
3420 message_length
= 80;
3422 if (SBYTES (val
) > message_length
)
3424 message_length
= SBYTES (val
);
3425 message_text
= (char *)xrealloc (message_text
, message_length
);
3427 bcopy (SDATA (val
), message_text
, SBYTES (val
));
3428 message2 (message_text
, SBYTES (val
),
3429 STRING_MULTIBYTE (val
));
3434 extern Lisp_Object last_nonmenu_event
;
3437 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3438 doc
: /* Display a message in a dialog box or in the echo area.
3439 If this command was invoked with the mouse, use a dialog box if
3440 `use-dialog-box' is non-nil.
3441 Otherwise, use the echo area.
3442 The first argument is a format control string, and the rest are data
3443 to be formatted under control of the string. See `format' for details.
3445 If the first argument is nil or the empty string, clear any existing
3446 message; let the minibuffer contents show.
3448 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3454 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3456 return Fmessage_box (nargs
, args
);
3458 return Fmessage (nargs
, args
);
3461 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3462 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3465 return current_message ();
3469 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3470 doc
: /* Return a copy of STRING with text properties added.
3471 First argument is the string to copy.
3472 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3473 properties to add to the result.
3474 usage: (propertize STRING &rest PROPERTIES) */)
3479 Lisp_Object properties
, string
;
3480 struct gcpro gcpro1
, gcpro2
;
3483 /* Number of args must be odd. */
3484 if ((nargs
& 1) == 0 || nargs
< 1)
3485 error ("Wrong number of arguments");
3487 properties
= string
= Qnil
;
3488 GCPRO2 (properties
, string
);
3490 /* First argument must be a string. */
3491 CHECK_STRING (args
[0]);
3492 string
= Fcopy_sequence (args
[0]);
3494 for (i
= 1; i
< nargs
; i
+= 2)
3495 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3497 Fadd_text_properties (make_number (0),
3498 make_number (SCHARS (string
)),
3499 properties
, string
);
3500 RETURN_UNGCPRO (string
);
3504 /* Number of bytes that STRING will occupy when put into the result.
3505 MULTIBYTE is nonzero if the result should be multibyte. */
3507 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3508 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3509 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3512 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3513 doc
: /* Format a string out of a format-string and arguments.
3514 The first argument is a format control string.
3515 The other arguments are substituted into it to make the result, a string.
3516 It may contain %-sequences meaning to substitute the next argument.
3517 %s means print a string argument. Actually, prints any object, with `princ'.
3518 %d means print as number in decimal (%o octal, %x hex).
3519 %X is like %x, but uses upper case.
3520 %e means print a number in exponential notation.
3521 %f means print a number in decimal-point notation.
3522 %g means print a number in exponential notation
3523 or decimal-point notation, whichever uses fewer characters.
3524 %c means print a number as a single character.
3525 %S means print any object as an s-expression (using `prin1').
3526 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3527 Use %% to put a single % into the output.
3529 The basic structure of a %-sequence is
3530 % <flags> <width> <precision> character
3531 where flags is [-+ #0]+, width is [0-9]+, and precision is .[0-9]+
3533 usage: (format STRING &rest OBJECTS) */)
3536 register Lisp_Object
*args
;
3538 register int n
; /* The number of the next arg to substitute */
3539 register int total
; /* An estimate of the final length */
3541 register unsigned char *format
, *end
, *format_start
;
3543 /* Nonzero if the output should be a multibyte string,
3544 which is true if any of the inputs is one. */
3546 /* When we make a multibyte string, we must pay attention to the
3547 byte combining problem, i.e., a byte may be combined with a
3548 multibyte charcter of the previous string. This flag tells if we
3549 must consider such a situation or not. */
3550 int maybe_combine_byte
;
3551 unsigned char *this_format
;
3552 /* Precision for each spec, or -1, a flag value meaning no precision
3553 was given in that spec. Element 0, corresonding to the format
3554 string itself, will not be used. Element NARGS, corresponding to
3555 no argument, *will* be assigned to in the case that a `%' and `.'
3556 occur after the final format specifier. */
3557 int *precision
= (int *) (alloca((nargs
+ 1) * sizeof (int)));
3560 int arg_intervals
= 0;
3563 /* discarded[I] is 1 if byte I of the format
3564 string was not copied into the output.
3565 It is 2 if byte I was not the first byte of its character. */
3566 char *discarded
= 0;
3568 /* Each element records, for one argument,
3569 the start and end bytepos in the output string,
3570 and whether the argument is a string with intervals.
3571 info[0] is unused. Unused elements have -1 for start. */
3574 int start
, end
, intervals
;
3577 /* It should not be necessary to GCPRO ARGS, because
3578 the caller in the interpreter should take care of that. */
3580 /* Try to determine whether the result should be multibyte.
3581 This is not always right; sometimes the result needs to be multibyte
3582 because of an object that we will pass through prin1,
3583 and in that case, we won't know it here. */
3584 for (n
= 0; n
< nargs
; n
++)
3586 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3588 /* Piggyback on this loop to initialize precision[N]. */
3591 precision
[nargs
] = -1;
3593 CHECK_STRING (args
[0]);
3594 /* We may have to change "%S" to "%s". */
3595 args
[0] = Fcopy_sequence (args
[0]);
3597 /* GC should never happen here, so abort if it does. */
3600 /* If we start out planning a unibyte result,
3601 then discover it has to be multibyte, we jump back to retry.
3602 That can only happen from the first large while loop below. */
3605 format
= SDATA (args
[0]);
3606 format_start
= format
;
3607 end
= format
+ SBYTES (args
[0]);
3610 /* Make room in result for all the non-%-codes in the control string. */
3611 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3613 /* Allocate the info and discarded tables. */
3615 int nbytes
= (nargs
+1) * sizeof *info
;
3618 info
= (struct info
*) alloca (nbytes
);
3619 bzero (info
, nbytes
);
3620 for (i
= 0; i
<= nargs
; i
++)
3623 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3624 bzero (discarded
, SBYTES (args
[0]));
3627 /* Add to TOTAL enough space to hold the converted arguments. */
3630 while (format
!= end
)
3631 if (*format
++ == '%')
3634 int actual_width
= 0;
3635 unsigned char *this_format_start
= format
- 1;
3636 int field_width
= 0;
3638 /* General format specifications look like
3640 '%' [flags] [field-width] [precision] format
3645 field-width ::= [0-9]+
3646 precision ::= '.' [0-9]*
3648 If a field-width is specified, it specifies to which width
3649 the output should be padded with blanks, if the output
3650 string is shorter than field-width.
3652 If precision is specified, it specifies the number of
3653 digits to print after the '.' for floats, or the max.
3654 number of chars to print from a string. */
3656 while (format
!= end
3657 && (*format
== '-' || *format
== '0' || *format
== '#'
3658 || * format
== ' ' || *format
== '+'))
3661 if (*format
>= '0' && *format
<= '9')
3663 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3664 field_width
= 10 * field_width
+ *format
- '0';
3667 /* N is not incremented for another few lines below, so refer to
3668 element N+1 (which might be precision[NARGS]). */
3672 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3673 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3676 /* Extra +1 for 'l' that we may need to insert into the
3678 if (format
- this_format_start
+ 2 > longest_format
)
3679 longest_format
= format
- this_format_start
+ 2;
3682 error ("Format string ends in middle of format specifier");
3685 else if (++n
>= nargs
)
3686 error ("Not enough arguments for format string");
3687 else if (*format
== 'S')
3689 /* For `S', prin1 the argument and then treat like a string. */
3690 register Lisp_Object tem
;
3691 tem
= Fprin1_to_string (args
[n
], Qnil
);
3692 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3698 /* If we restart the loop, we should not come here again
3699 because args[n] is now a string and calling
3700 Fprin1_to_string on it produces superflous double
3701 quotes. So, change "%S" to "%s" now. */
3705 else if (SYMBOLP (args
[n
]))
3707 args
[n
] = SYMBOL_NAME (args
[n
]);
3708 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3715 else if (STRINGP (args
[n
]))
3718 if (*format
!= 's' && *format
!= 'S')
3719 error ("Format specifier doesn't match argument type");
3720 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3721 to be as large as is calculated here. Easy check for
3722 the case PRECISION = 0. */
3723 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3724 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3726 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3727 else if (INTEGERP (args
[n
]) && *format
!= 's')
3729 /* The following loop assumes the Lisp type indicates
3730 the proper way to pass the argument.
3731 So make sure we have a flonum if the argument should
3733 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3734 args
[n
] = Ffloat (args
[n
]);
3736 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3737 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3738 error ("Invalid format operation %%%c", *format
);
3740 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3743 if (! ASCII_CHAR_P (XINT (args
[n
]))
3744 /* Note: No one can remeber why we have to treat
3745 the character 0 as a multibyte character here.
3746 But, until it causes a real problem, let's
3748 || XINT (args
[n
]) == 0)
3755 args
[n
] = Fchar_to_string (args
[n
]);
3756 thissize
= SBYTES (args
[n
]);
3758 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3761 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3762 thissize
= SBYTES (args
[n
]);
3766 else if (FLOATP (args
[n
]) && *format
!= 's')
3768 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3770 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3771 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3772 error ("Invalid format operation %%%c", *format
);
3773 /* This fails unnecessarily if args[n] is bigger than
3774 most-positive-fixnum but smaller than MAXINT.
3775 These cases are important because we sometimes use floats
3776 to represent such integer values (typically such values
3777 come from UIDs or PIDs). */
3778 /* args[n] = Ftruncate (args[n], Qnil); */
3781 /* Note that we're using sprintf to print floats,
3782 so we have to take into account what that function
3784 /* Filter out flag value of -1. */
3785 thissize
= (MAX_10_EXP
+ 100
3786 + (precision
[n
] > 0 ? precision
[n
] : 0));
3790 /* Anything but a string, convert to a string using princ. */
3791 register Lisp_Object tem
;
3792 tem
= Fprin1_to_string (args
[n
], Qt
);
3793 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3802 thissize
+= max (0, field_width
- actual_width
);
3803 total
+= thissize
+ 4;
3808 /* Now we can no longer jump to retry.
3809 TOTAL and LONGEST_FORMAT are known for certain. */
3811 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3813 /* Allocate the space for the result.
3814 Note that TOTAL is an overestimate. */
3815 SAFE_ALLOCA (buf
, char *, total
);
3821 /* Scan the format and store result in BUF. */
3822 format
= SDATA (args
[0]);
3823 format_start
= format
;
3824 end
= format
+ SBYTES (args
[0]);
3825 maybe_combine_byte
= 0;
3826 while (format
!= end
)
3832 unsigned char *this_format_start
= format
;
3834 discarded
[format
- format_start
] = 1;
3837 while (index("-+0# ", *format
))
3843 discarded
[format
- format_start
] = 1;
3847 minlen
= atoi (format
);
3849 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3851 discarded
[format
- format_start
] = 1;
3855 if (*format
++ == '%')
3864 discarded
[format
- format_start
- 1] = 1;
3865 info
[n
].start
= nchars
;
3867 if (STRINGP (args
[n
]))
3869 /* handle case (precision[n] >= 0) */
3872 int nbytes
, start
, end
;
3875 /* lisp_string_width ignores a precision of 0, but GNU
3876 libc functions print 0 characters when the precision
3877 is 0. Imitate libc behavior here. Changing
3878 lisp_string_width is the right thing, and will be
3879 done, but meanwhile we work with it. */
3881 if (precision
[n
] == 0)
3882 width
= nchars_string
= nbytes
= 0;
3883 else if (precision
[n
] > 0)
3884 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3886 { /* no precision spec given for this argument */
3887 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3888 nbytes
= SBYTES (args
[n
]);
3889 nchars_string
= SCHARS (args
[n
]);
3892 /* If spec requires it, pad on right with spaces. */
3893 padding
= minlen
- width
;
3895 while (padding
-- > 0)
3901 info
[n
].start
= start
= nchars
;
3902 nchars
+= nchars_string
;
3907 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3908 && STRING_MULTIBYTE (args
[n
])
3909 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3910 maybe_combine_byte
= 1;
3912 p
+= copy_text (SDATA (args
[n
]), p
,
3914 STRING_MULTIBYTE (args
[n
]), multibyte
);
3916 info
[n
].end
= nchars
;
3919 while (padding
-- > 0)
3925 /* If this argument has text properties, record where
3926 in the result string it appears. */
3927 if (STRING_INTERVALS (args
[n
]))
3928 info
[n
].intervals
= arg_intervals
= 1;
3930 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3934 bcopy (this_format_start
, this_format
,
3935 format
- this_format_start
);
3936 this_format
[format
- this_format_start
] = 0;
3938 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
3939 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3942 if (sizeof (EMACS_INT
) > sizeof (int)
3943 && format
[-1] != 'c')
3945 /* Insert 'l' before format spec. */
3946 this_format
[format
- this_format_start
]
3947 = this_format
[format
- this_format_start
- 1];
3948 this_format
[format
- this_format_start
- 1] = 'l';
3949 this_format
[format
- this_format_start
+ 1] = 0;
3952 if (INTEGERP (args
[n
]))
3954 if (format
[-1] == 'c')
3955 sprintf (p
, this_format
, (int) XINT (args
[n
]));
3956 else if (format
[-1] == 'd')
3957 sprintf (p
, this_format
, XINT (args
[n
]));
3958 /* Don't sign-extend for octal or hex printing. */
3960 sprintf (p
, this_format
, XUINT (args
[n
]));
3962 else if (format
[-1] == 'c')
3963 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
3964 else if (format
[-1] == 'd')
3965 /* Maybe we should use "%1.0f" instead so it also works
3966 for values larger than MAXINT. */
3967 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
3969 /* Don't sign-extend for octal or hex printing. */
3970 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
3975 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3976 && !CHAR_HEAD_P (*((unsigned char *) p
)))
3977 maybe_combine_byte
= 1;
3978 this_nchars
= strlen (p
);
3980 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
3983 nchars
+= this_nchars
;
3984 info
[n
].end
= nchars
;
3988 else if (STRING_MULTIBYTE (args
[0]))
3990 /* Copy a whole multibyte character. */
3993 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3994 && !CHAR_HEAD_P (*format
))
3995 maybe_combine_byte
= 1;
3997 while (! CHAR_HEAD_P (*format
))
3999 discarded
[format
- format_start
] = 2;
4006 /* Convert a single-byte character to multibyte. */
4007 int len
= copy_text (format
, p
, 1, 0, 1);
4014 *p
++ = *format
++, nchars
++;
4017 if (p
> buf
+ total
)
4020 if (maybe_combine_byte
)
4021 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
4022 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4024 /* If we allocated BUF with malloc, free it too. */
4027 /* If the format string has text properties, or any of the string
4028 arguments has text properties, set up text properties of the
4031 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4033 Lisp_Object len
, new_len
, props
;
4034 struct gcpro gcpro1
;
4036 /* Add text properties from the format string. */
4037 len
= make_number (SCHARS (args
[0]));
4038 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4043 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4046 /* Adjust the bounds of each text property
4047 to the proper start and end in the output string. */
4049 /* Put the positions in PROPS in increasing order, so that
4050 we can do (effectively) one scan through the position
4051 space of the format string. */
4052 props
= Fnreverse (props
);
4054 /* BYTEPOS is the byte position in the format string,
4055 POSITION is the untranslated char position in it,
4056 TRANSLATED is the translated char position in BUF,
4057 and ARGN is the number of the next arg we will come to. */
4058 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4065 /* First adjust the property start position. */
4066 pos
= XINT (XCAR (item
));
4068 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4069 up to this position. */
4070 for (; position
< pos
; bytepos
++)
4072 if (! discarded
[bytepos
])
4073 position
++, translated
++;
4074 else if (discarded
[bytepos
] == 1)
4077 if (translated
== info
[argn
].start
)
4079 translated
+= info
[argn
].end
- info
[argn
].start
;
4085 XSETCAR (item
, make_number (translated
));
4087 /* Likewise adjust the property end position. */
4088 pos
= XINT (XCAR (XCDR (item
)));
4090 for (; position
< pos
; bytepos
++)
4092 if (! discarded
[bytepos
])
4093 position
++, translated
++;
4094 else if (discarded
[bytepos
] == 1)
4097 if (translated
== info
[argn
].start
)
4099 translated
+= info
[argn
].end
- info
[argn
].start
;
4105 XSETCAR (XCDR (item
), make_number (translated
));
4108 add_text_properties_from_list (val
, props
, make_number (0));
4111 /* Add text properties from arguments. */
4113 for (n
= 1; n
< nargs
; ++n
)
4114 if (info
[n
].intervals
)
4116 len
= make_number (SCHARS (args
[n
]));
4117 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4118 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4119 extend_property_ranges (props
, len
, new_len
);
4120 /* If successive arguments have properites, be sure that
4121 the value of `composition' property be the copy. */
4122 if (n
> 1 && info
[n
- 1].end
)
4123 make_composition_value_copy (props
);
4124 add_text_properties_from_list (val
, props
,
4125 make_number (info
[n
].start
));
4135 format2 (string1
, arg0
, arg1
)
4137 Lisp_Object arg0
, arg1
;
4139 Lisp_Object args
[3];
4140 args
[0] = build_string (string1
);
4143 return Fformat (3, args
);
4146 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4147 doc
: /* Return t if two characters match, optionally ignoring case.
4148 Both arguments must be characters (i.e. integers).
4149 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4151 register Lisp_Object c1
, c2
;
4157 if (XINT (c1
) == XINT (c2
))
4159 if (NILP (current_buffer
->case_fold_search
))
4162 /* Do these in separate statements,
4163 then compare the variables.
4164 because of the way DOWNCASE uses temp variables. */
4166 if (NILP (current_buffer
->enable_multibyte_characters
)
4167 && ! ASCII_CHAR_P (i1
))
4169 MAKE_CHAR_MULTIBYTE (i1
);
4172 if (NILP (current_buffer
->enable_multibyte_characters
)
4173 && ! ASCII_CHAR_P (i2
))
4175 MAKE_CHAR_MULTIBYTE (i2
);
4179 return (i1
== i2
? Qt
: Qnil
);
4182 /* Transpose the markers in two regions of the current buffer, and
4183 adjust the ones between them if necessary (i.e.: if the regions
4186 START1, END1 are the character positions of the first region.
4187 START1_BYTE, END1_BYTE are the byte positions.
4188 START2, END2 are the character positions of the second region.
4189 START2_BYTE, END2_BYTE are the byte positions.
4191 Traverses the entire marker list of the buffer to do so, adding an
4192 appropriate amount to some, subtracting from some, and leaving the
4193 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4195 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4198 transpose_markers (start1
, end1
, start2
, end2
,
4199 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
4200 register int start1
, end1
, start2
, end2
;
4201 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
4203 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4204 register struct Lisp_Marker
*marker
;
4206 /* Update point as if it were a marker. */
4210 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4211 PT_BYTE
+ (end2_byte
- end1_byte
));
4212 else if (PT
< start2
)
4213 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4214 (PT_BYTE
+ (end2_byte
- start2_byte
)
4215 - (end1_byte
- start1_byte
)));
4217 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4218 PT_BYTE
- (start2_byte
- start1_byte
));
4220 /* We used to adjust the endpoints here to account for the gap, but that
4221 isn't good enough. Even if we assume the caller has tried to move the
4222 gap out of our way, it might still be at start1 exactly, for example;
4223 and that places it `inside' the interval, for our purposes. The amount
4224 of adjustment is nontrivial if there's a `denormalized' marker whose
4225 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4226 the dirty work to Fmarker_position, below. */
4228 /* The difference between the region's lengths */
4229 diff
= (end2
- start2
) - (end1
- start1
);
4230 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4232 /* For shifting each marker in a region by the length of the other
4233 region plus the distance between the regions. */
4234 amt1
= (end2
- start2
) + (start2
- end1
);
4235 amt2
= (end1
- start1
) + (start2
- end1
);
4236 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4237 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4239 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4241 mpos
= marker
->bytepos
;
4242 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4244 if (mpos
< end1_byte
)
4246 else if (mpos
< start2_byte
)
4250 marker
->bytepos
= mpos
;
4252 mpos
= marker
->charpos
;
4253 if (mpos
>= start1
&& mpos
< end2
)
4257 else if (mpos
< start2
)
4262 marker
->charpos
= mpos
;
4266 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4267 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4268 The regions may not be overlapping, because the size of the buffer is
4269 never changed in a transposition.
4271 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4272 any markers that happen to be located in the regions.
4274 Transposing beyond buffer boundaries is an error. */)
4275 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
4276 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
4278 register EMACS_INT start1
, end1
, start2
, end2
;
4279 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4280 EMACS_INT gap
, len1
, len_mid
, len2
;
4281 unsigned char *start1_addr
, *start2_addr
, *temp
;
4283 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4286 XSETBUFFER (buf
, current_buffer
);
4287 cur_intv
= BUF_INTERVALS (current_buffer
);
4289 validate_region (&startr1
, &endr1
);
4290 validate_region (&startr2
, &endr2
);
4292 start1
= XFASTINT (startr1
);
4293 end1
= XFASTINT (endr1
);
4294 start2
= XFASTINT (startr2
);
4295 end2
= XFASTINT (endr2
);
4298 /* Swap the regions if they're reversed. */
4301 register int glumph
= start1
;
4309 len1
= end1
- start1
;
4310 len2
= end2
- start2
;
4313 error ("Transposed regions overlap");
4314 else if (start1
== end1
|| start2
== end2
)
4315 error ("Transposed region has length 0");
4317 /* The possibilities are:
4318 1. Adjacent (contiguous) regions, or separate but equal regions
4319 (no, really equal, in this case!), or
4320 2. Separate regions of unequal size.
4322 The worst case is usually No. 2. It means that (aside from
4323 potential need for getting the gap out of the way), there also
4324 needs to be a shifting of the text between the two regions. So
4325 if they are spread far apart, we are that much slower... sigh. */
4327 /* It must be pointed out that the really studly thing to do would
4328 be not to move the gap at all, but to leave it in place and work
4329 around it if necessary. This would be extremely efficient,
4330 especially considering that people are likely to do
4331 transpositions near where they are working interactively, which
4332 is exactly where the gap would be found. However, such code
4333 would be much harder to write and to read. So, if you are
4334 reading this comment and are feeling squirrely, by all means have
4335 a go! I just didn't feel like doing it, so I will simply move
4336 the gap the minimum distance to get it out of the way, and then
4337 deal with an unbroken array. */
4339 /* Make sure the gap won't interfere, by moving it out of the text
4340 we will operate on. */
4341 if (start1
< gap
&& gap
< end2
)
4343 if (gap
- start1
< end2
- gap
)
4349 start1_byte
= CHAR_TO_BYTE (start1
);
4350 start2_byte
= CHAR_TO_BYTE (start2
);
4351 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4352 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4354 #ifdef BYTE_COMBINING_DEBUG
4357 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4358 len2_byte
, start1
, start1_byte
)
4359 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4360 len1_byte
, end2
, start2_byte
+ len2_byte
)
4361 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4362 len1_byte
, end2
, start2_byte
+ len2_byte
))
4367 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4368 len2_byte
, start1
, start1_byte
)
4369 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4370 len1_byte
, start2
, start2_byte
)
4371 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4372 len2_byte
, end1
, start1_byte
+ len1_byte
)
4373 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4374 len1_byte
, end2
, start2_byte
+ len2_byte
))
4379 /* Hmmm... how about checking to see if the gap is large
4380 enough to use as the temporary storage? That would avoid an
4381 allocation... interesting. Later, don't fool with it now. */
4383 /* Working without memmove, for portability (sigh), so must be
4384 careful of overlapping subsections of the array... */
4386 if (end1
== start2
) /* adjacent regions */
4388 modify_region (current_buffer
, start1
, end2
, 0);
4389 record_change (start1
, len1
+ len2
);
4391 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4392 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4393 /* Don't use Fset_text_properties: that can cause GC, which can
4394 clobber objects stored in the tmp_intervals. */
4395 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4396 if (!NULL_INTERVAL_P (tmp_interval3
))
4397 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4399 /* First region smaller than second. */
4400 if (len1_byte
< len2_byte
)
4404 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4406 /* Don't precompute these addresses. We have to compute them
4407 at the last minute, because the relocating allocator might
4408 have moved the buffer around during the xmalloc. */
4409 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4410 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4412 bcopy (start2_addr
, temp
, len2_byte
);
4413 bcopy (start1_addr
, start1_addr
+ len2_byte
, len1_byte
);
4414 bcopy (temp
, start1_addr
, len2_byte
);
4418 /* First region not smaller than second. */
4422 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4423 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4424 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4425 bcopy (start1_addr
, temp
, len1_byte
);
4426 bcopy (start2_addr
, start1_addr
, len2_byte
);
4427 bcopy (temp
, start1_addr
+ len2_byte
, len1_byte
);
4430 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4431 len1
, current_buffer
, 0);
4432 graft_intervals_into_buffer (tmp_interval2
, start1
,
4433 len2
, current_buffer
, 0);
4434 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4435 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4437 /* Non-adjacent regions, because end1 != start2, bleagh... */
4440 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4442 if (len1_byte
== len2_byte
)
4443 /* Regions are same size, though, how nice. */
4447 modify_region (current_buffer
, start1
, end1
, 0);
4448 modify_region (current_buffer
, start2
, end2
, 0);
4449 record_change (start1
, len1
);
4450 record_change (start2
, len2
);
4451 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4452 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4454 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4455 if (!NULL_INTERVAL_P (tmp_interval3
))
4456 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4458 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4459 if (!NULL_INTERVAL_P (tmp_interval3
))
4460 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4462 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4463 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4464 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4465 bcopy (start1_addr
, temp
, len1_byte
);
4466 bcopy (start2_addr
, start1_addr
, len2_byte
);
4467 bcopy (temp
, start2_addr
, len1_byte
);
4470 graft_intervals_into_buffer (tmp_interval1
, start2
,
4471 len1
, current_buffer
, 0);
4472 graft_intervals_into_buffer (tmp_interval2
, start1
,
4473 len2
, current_buffer
, 0);
4476 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4477 /* Non-adjacent & unequal size, area between must also be shifted. */
4481 modify_region (current_buffer
, start1
, end2
, 0);
4482 record_change (start1
, (end2
- start1
));
4483 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4484 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4485 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4487 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4488 if (!NULL_INTERVAL_P (tmp_interval3
))
4489 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4491 /* holds region 2 */
4492 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4493 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4494 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4495 bcopy (start2_addr
, temp
, len2_byte
);
4496 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2_byte
, len1_byte
);
4497 safe_bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4498 bcopy (temp
, start1_addr
, len2_byte
);
4501 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4502 len1
, current_buffer
, 0);
4503 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4504 len_mid
, current_buffer
, 0);
4505 graft_intervals_into_buffer (tmp_interval2
, start1
,
4506 len2
, current_buffer
, 0);
4509 /* Second region smaller than first. */
4513 record_change (start1
, (end2
- start1
));
4514 modify_region (current_buffer
, start1
, end2
, 0);
4516 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4517 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4518 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4520 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4521 if (!NULL_INTERVAL_P (tmp_interval3
))
4522 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4524 /* holds region 1 */
4525 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4526 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4527 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4528 bcopy (start1_addr
, temp
, len1_byte
);
4529 bcopy (start2_addr
, start1_addr
, len2_byte
);
4530 bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4531 bcopy (temp
, start1_addr
+ len2_byte
+ len_mid
, len1_byte
);
4534 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4535 len1
, current_buffer
, 0);
4536 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4537 len_mid
, current_buffer
, 0);
4538 graft_intervals_into_buffer (tmp_interval2
, start1
,
4539 len2
, current_buffer
, 0);
4542 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4543 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4546 /* When doing multiple transpositions, it might be nice
4547 to optimize this. Perhaps the markers in any one buffer
4548 should be organized in some sorted data tree. */
4549 if (NILP (leave_markers
))
4551 transpose_markers (start1
, end1
, start2
, end2
,
4552 start1_byte
, start1_byte
+ len1_byte
,
4553 start2_byte
, start2_byte
+ len2_byte
);
4554 fix_start_end_in_overlays (start1
, end2
);
4557 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4567 Qbuffer_access_fontify_functions
4568 = intern ("buffer-access-fontify-functions");
4569 staticpro (&Qbuffer_access_fontify_functions
);
4571 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4572 doc
: /* Non-nil means text motion commands don't notice fields. */);
4573 Vinhibit_field_text_motion
= Qnil
;
4575 DEFVAR_LISP ("buffer-access-fontify-functions",
4576 &Vbuffer_access_fontify_functions
,
4577 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4578 Each function is called with two arguments which specify the range
4579 of the buffer being accessed. */);
4580 Vbuffer_access_fontify_functions
= Qnil
;
4584 extern Lisp_Object Vprin1_to_string_buffer
;
4585 obuf
= Fcurrent_buffer ();
4586 /* Do this here, because init_buffer_once is too early--it won't work. */
4587 Fset_buffer (Vprin1_to_string_buffer
);
4588 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4589 Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
4594 DEFVAR_LISP ("buffer-access-fontified-property",
4595 &Vbuffer_access_fontified_property
,
4596 doc
: /* Property which (if non-nil) indicates text has been fontified.
4597 `buffer-substring' need not call the `buffer-access-fontify-functions'
4598 functions if all the text being accessed has this property. */);
4599 Vbuffer_access_fontified_property
= Qnil
;
4601 DEFVAR_LISP ("system-name", &Vsystem_name
,
4602 doc
: /* The host name of the machine Emacs is running on. */);
4604 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4605 doc
: /* The full name of the user logged in. */);
4607 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4608 doc
: /* The user's name, taken from environment variables if possible. */);
4610 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4611 doc
: /* The user's name, based upon the real uid only. */);
4613 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4614 doc
: /* The release of the operating system Emacs is running on. */);
4616 defsubr (&Spropertize
);
4617 defsubr (&Schar_equal
);
4618 defsubr (&Sgoto_char
);
4619 defsubr (&Sstring_to_char
);
4620 defsubr (&Schar_to_string
);
4621 defsubr (&Sbuffer_substring
);
4622 defsubr (&Sbuffer_substring_no_properties
);
4623 defsubr (&Sbuffer_string
);
4625 defsubr (&Spoint_marker
);
4626 defsubr (&Smark_marker
);
4628 defsubr (&Sregion_beginning
);
4629 defsubr (&Sregion_end
);
4631 staticpro (&Qfield
);
4632 Qfield
= intern ("field");
4633 staticpro (&Qboundary
);
4634 Qboundary
= intern ("boundary");
4635 defsubr (&Sfield_beginning
);
4636 defsubr (&Sfield_end
);
4637 defsubr (&Sfield_string
);
4638 defsubr (&Sfield_string_no_properties
);
4639 defsubr (&Sdelete_field
);
4640 defsubr (&Sconstrain_to_field
);
4642 defsubr (&Sline_beginning_position
);
4643 defsubr (&Sline_end_position
);
4645 /* defsubr (&Smark); */
4646 /* defsubr (&Sset_mark); */
4647 defsubr (&Ssave_excursion
);
4648 defsubr (&Ssave_current_buffer
);
4650 defsubr (&Sbufsize
);
4651 defsubr (&Spoint_max
);
4652 defsubr (&Spoint_min
);
4653 defsubr (&Spoint_min_marker
);
4654 defsubr (&Spoint_max_marker
);
4655 defsubr (&Sgap_position
);
4656 defsubr (&Sgap_size
);
4657 defsubr (&Sposition_bytes
);
4658 defsubr (&Sbyte_to_position
);
4664 defsubr (&Sfollowing_char
);
4665 defsubr (&Sprevious_char
);
4666 defsubr (&Schar_after
);
4667 defsubr (&Schar_before
);
4669 defsubr (&Sinsert_before_markers
);
4670 defsubr (&Sinsert_and_inherit
);
4671 defsubr (&Sinsert_and_inherit_before_markers
);
4672 defsubr (&Sinsert_char
);
4673 defsubr (&Sinsert_byte
);
4675 defsubr (&Suser_login_name
);
4676 defsubr (&Suser_real_login_name
);
4677 defsubr (&Suser_uid
);
4678 defsubr (&Suser_real_uid
);
4679 defsubr (&Suser_full_name
);
4680 defsubr (&Semacs_pid
);
4681 defsubr (&Scurrent_time
);
4682 defsubr (&Sget_internal_run_time
);
4683 defsubr (&Sformat_time_string
);
4684 defsubr (&Sfloat_time
);
4685 defsubr (&Sdecode_time
);
4686 defsubr (&Sencode_time
);
4687 defsubr (&Scurrent_time_string
);
4688 defsubr (&Scurrent_time_zone
);
4689 defsubr (&Sset_time_zone_rule
);
4690 defsubr (&Ssystem_name
);
4691 defsubr (&Smessage
);
4692 defsubr (&Smessage_box
);
4693 defsubr (&Smessage_or_box
);
4694 defsubr (&Scurrent_message
);
4697 defsubr (&Sinsert_buffer_substring
);
4698 defsubr (&Scompare_buffer_substrings
);
4699 defsubr (&Ssubst_char_in_region
);
4700 defsubr (&Stranslate_region_internal
);
4701 defsubr (&Sdelete_region
);
4702 defsubr (&Sdelete_and_extract_region
);
4704 defsubr (&Snarrow_to_region
);
4705 defsubr (&Ssave_restriction
);
4706 defsubr (&Stranspose_regions
);
4709 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4710 (do not change this comment) */