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, 2009 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 of the License, or
11 (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
34 #ifdef HAVE_SYS_UTSNAME_H
35 #include <sys/utsname.h>
40 /* systime.h includes <sys/time.h> which, on some systems, is required
41 for <sys/resource.h>; thus systime.h must be included before
45 #if defined HAVE_SYS_RESOURCE_H
46 #include <sys/resource.h>
51 #include "intervals.h"
53 #include "character.h"
57 #include "blockinput.h"
61 #define MAX_10_EXP DBL_MAX_10_EXP
63 #define MAX_10_EXP 310
70 #ifndef USER_FULL_NAME
71 #define USER_FULL_NAME pw->pw_gecos
75 extern char **environ
;
78 #define TM_YEAR_BASE 1900
80 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
81 asctime to have well-defined behavior. */
82 #ifndef TM_YEAR_IN_ASCTIME_RANGE
83 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
84 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
87 extern size_t emacs_strftimeu
P_ ((char *, size_t, const char *,
88 const struct tm
*, int));
91 extern Lisp_Object
w32_get_internal_run_time ();
94 static int tm_diff
P_ ((struct tm
*, struct tm
*));
95 static void find_field
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *));
96 static void update_buffer_properties
P_ ((int, int));
97 static Lisp_Object region_limit
P_ ((int));
98 int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
99 static size_t emacs_memftimeu
P_ ((char *, size_t, const char *,
100 size_t, const struct tm
*, int));
101 static void general_insert_function (void (*) (const unsigned char *, EMACS_INT
),
102 void (*) (Lisp_Object
, EMACS_INT
,
103 EMACS_INT
, EMACS_INT
,
105 int, int, Lisp_Object
*);
106 static Lisp_Object subst_char_in_region_unwind
P_ ((Lisp_Object
));
107 static Lisp_Object subst_char_in_region_unwind_1
P_ ((Lisp_Object
));
108 static void transpose_markers
P_ ((int, int, int, int, int, int, int, int));
111 extern char *index
P_ ((const char *, int));
114 Lisp_Object Vbuffer_access_fontify_functions
;
115 Lisp_Object Qbuffer_access_fontify_functions
;
116 Lisp_Object Vbuffer_access_fontified_property
;
118 Lisp_Object Fuser_full_name
P_ ((Lisp_Object
));
120 /* Non-nil means don't stop at field boundary in text motion commands. */
122 Lisp_Object Vinhibit_field_text_motion
;
124 /* Some static data, and a function to initialize it for each run */
126 Lisp_Object Vsystem_name
;
127 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
128 Lisp_Object Vuser_full_name
; /* full name of current user */
129 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
130 Lisp_Object Voperating_system_release
; /* Operating System Release */
132 /* Symbol for the text property used to mark fields. */
136 /* A special value for Qfield properties. */
138 Lisp_Object Qboundary
;
145 register unsigned char *p
;
146 struct passwd
*pw
; /* password entry for the current user */
149 /* Set up system_name even when dumping. */
153 /* Don't bother with this on initial start when just dumping out */
156 #endif /* not CANNOT_DUMP */
158 pw
= (struct passwd
*) getpwuid (getuid ());
160 /* We let the real user name default to "root" because that's quite
161 accurate on MSDOG and because it lets Emacs find the init file.
162 (The DVX libraries override the Djgpp libraries here.) */
163 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
165 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
168 /* Get the effective user name, by consulting environment variables,
169 or the effective uid if those are unset. */
170 user_name
= (char *) getenv ("LOGNAME");
173 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
174 #else /* WINDOWSNT */
175 user_name
= (char *) getenv ("USER");
176 #endif /* WINDOWSNT */
179 pw
= (struct passwd
*) getpwuid (geteuid ());
180 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
182 Vuser_login_name
= build_string (user_name
);
184 /* If the user name claimed in the environment vars differs from
185 the real uid, use the claimed name to find the full name. */
186 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
187 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
190 p
= (unsigned char *) getenv ("NAME");
192 Vuser_full_name
= build_string (p
);
193 else if (NILP (Vuser_full_name
))
194 Vuser_full_name
= build_string ("unknown");
196 #ifdef HAVE_SYS_UTSNAME_H
200 Voperating_system_release
= build_string (uts
.release
);
203 Voperating_system_release
= Qnil
;
207 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
208 doc
: /* Convert arg CHAR to a string containing that character.
209 usage: (char-to-string CHAR) */)
211 Lisp_Object character
;
214 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
216 CHECK_CHARACTER (character
);
218 len
= CHAR_STRING (XFASTINT (character
), str
);
219 return make_string_from_bytes (str
, 1, len
);
222 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
223 doc
: /* Convert arg STRING to a character, the first character of that string.
224 A multibyte character is handled correctly. */)
226 register Lisp_Object string
;
228 register Lisp_Object val
;
229 CHECK_STRING (string
);
232 if (STRING_MULTIBYTE (string
))
233 XSETFASTINT (val
, STRING_CHAR (SDATA (string
), SBYTES (string
)));
235 XSETFASTINT (val
, SREF (string
, 0));
238 XSETFASTINT (val
, 0);
243 buildmark (charpos
, bytepos
)
244 int charpos
, bytepos
;
246 register Lisp_Object mark
;
247 mark
= Fmake_marker ();
248 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
252 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
253 doc
: /* Return value of point, as an integer.
254 Beginning of buffer is position (point-min). */)
258 XSETFASTINT (temp
, PT
);
262 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
263 doc
: /* Return value of point, as a marker object. */)
266 return buildmark (PT
, PT_BYTE
);
270 clip_to_bounds (lower
, num
, upper
)
271 int lower
, num
, upper
;
275 else if (num
> upper
)
281 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
282 doc
: /* Set point to POSITION, a number or marker.
283 Beginning of buffer is position (point-min), end is (point-max).
285 The return value is POSITION. */)
287 register Lisp_Object position
;
291 if (MARKERP (position
)
292 && current_buffer
== XMARKER (position
)->buffer
)
294 pos
= marker_position (position
);
296 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
298 SET_PT_BOTH (ZV
, ZV_BYTE
);
300 SET_PT_BOTH (pos
, marker_byte_position (position
));
305 CHECK_NUMBER_COERCE_MARKER (position
);
307 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
313 /* Return the start or end position of the region.
314 BEGINNINGP non-zero means return the start.
315 If there is no region active, signal an error. */
318 region_limit (beginningp
)
321 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
324 if (!NILP (Vtransient_mark_mode
)
325 && NILP (Vmark_even_if_inactive
)
326 && NILP (current_buffer
->mark_active
))
327 xsignal0 (Qmark_inactive
);
329 m
= Fmarker_position (current_buffer
->mark
);
331 error ("The mark is not set now, so there is no region");
333 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
334 m
= make_number (PT
);
338 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
339 doc
: /* Return position of beginning of region, as an integer. */)
342 return region_limit (1);
345 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
346 doc
: /* Return position of end of region, as an integer. */)
349 return region_limit (0);
352 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
353 doc
: /* Return this buffer's mark, as a marker object.
354 Watch out! Moving this marker changes the mark position.
355 If you set the marker not to point anywhere, the buffer will have no mark. */)
358 return current_buffer
->mark
;
362 /* Find all the overlays in the current buffer that touch position POS.
363 Return the number found, and store them in a vector in VEC
367 overlays_around (pos
, vec
, len
)
372 Lisp_Object overlay
, start
, end
;
373 struct Lisp_Overlay
*tail
;
374 int startpos
, endpos
;
377 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
379 XSETMISC (overlay
, tail
);
381 end
= OVERLAY_END (overlay
);
382 endpos
= OVERLAY_POSITION (end
);
385 start
= OVERLAY_START (overlay
);
386 startpos
= OVERLAY_POSITION (start
);
391 /* Keep counting overlays even if we can't return them all. */
396 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
398 XSETMISC (overlay
, tail
);
400 start
= OVERLAY_START (overlay
);
401 startpos
= OVERLAY_POSITION (start
);
404 end
= OVERLAY_END (overlay
);
405 endpos
= OVERLAY_POSITION (end
);
417 /* Return the value of property PROP, in OBJECT at POSITION.
418 It's the value of PROP that a char inserted at POSITION would get.
419 OBJECT is optional and defaults to the current buffer.
420 If OBJECT is a buffer, then overlay properties are considered as well as
422 If OBJECT is a window, then that window's buffer is used, but
423 window-specific overlays are considered only if they are associated
426 get_pos_property (position
, prop
, object
)
427 Lisp_Object position
, object
;
428 register Lisp_Object prop
;
430 CHECK_NUMBER_COERCE_MARKER (position
);
433 XSETBUFFER (object
, current_buffer
);
434 else if (WINDOWP (object
))
435 object
= XWINDOW (object
)->buffer
;
437 if (!BUFFERP (object
))
438 /* pos-property only makes sense in buffers right now, since strings
439 have no overlays and no notion of insertion for which stickiness
441 return Fget_text_property (position
, prop
, object
);
444 int posn
= XINT (position
);
446 Lisp_Object
*overlay_vec
, tem
;
447 struct buffer
*obuf
= current_buffer
;
449 set_buffer_temp (XBUFFER (object
));
451 /* First try with room for 40 overlays. */
453 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
454 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
456 /* If there are more than 40,
457 make enough space for all, and try again. */
460 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
461 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
463 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
465 set_buffer_temp (obuf
);
467 /* Now check the overlays in order of decreasing priority. */
468 while (--noverlays
>= 0)
470 Lisp_Object ol
= overlay_vec
[noverlays
];
471 tem
= Foverlay_get (ol
, prop
);
474 /* Check the overlay is indeed active at point. */
475 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
476 if ((OVERLAY_POSITION (start
) == posn
477 && XMARKER (start
)->insertion_type
== 1)
478 || (OVERLAY_POSITION (finish
) == posn
479 && XMARKER (finish
)->insertion_type
== 0))
480 ; /* The overlay will not cover a char inserted at point. */
488 { /* Now check the text properties. */
489 int stickiness
= text_property_stickiness (prop
, position
, object
);
491 return Fget_text_property (position
, prop
, object
);
492 else if (stickiness
< 0
493 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
494 return Fget_text_property (make_number (XINT (position
) - 1),
502 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
503 the value of point is used instead. If BEG or END is null,
504 means don't store the beginning or end of the field.
506 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
507 results; they do not effect boundary behavior.
509 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
510 position of a field, then the beginning of the previous field is
511 returned instead of the beginning of POS's field (since the end of a
512 field is actually also the beginning of the next input field, this
513 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
514 true case, if two fields are separated by a field with the special
515 value `boundary', and POS lies within it, then the two separated
516 fields are considered to be adjacent, and POS between them, when
517 finding the beginning and ending of the "merged" field.
519 Either BEG or END may be 0, in which case the corresponding value
523 find_field (pos
, merge_at_boundary
, beg_limit
, beg
, end_limit
, end
)
525 Lisp_Object merge_at_boundary
;
526 Lisp_Object beg_limit
, end_limit
;
529 /* Fields right before and after the point. */
530 Lisp_Object before_field
, after_field
;
531 /* 1 if POS counts as the start of a field. */
532 int at_field_start
= 0;
533 /* 1 if POS counts as the end of a field. */
534 int at_field_end
= 0;
537 XSETFASTINT (pos
, PT
);
539 CHECK_NUMBER_COERCE_MARKER (pos
);
542 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
544 = (XFASTINT (pos
) > BEGV
545 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
547 /* Using nil here would be a more obvious choice, but it would
548 fail when the buffer starts with a non-sticky field. */
551 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
552 and POS is at beginning of a field, which can also be interpreted
553 as the end of the previous field. Note that the case where if
554 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
555 more natural one; then we avoid treating the beginning of a field
557 if (NILP (merge_at_boundary
))
559 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
560 if (!EQ (field
, after_field
))
562 if (!EQ (field
, before_field
))
564 if (NILP (field
) && at_field_start
&& at_field_end
)
565 /* If an inserted char would have a nil field while the surrounding
566 text is non-nil, we're probably not looking at a
567 zero-length field, but instead at a non-nil field that's
568 not intended for editing (such as comint's prompts). */
569 at_field_end
= at_field_start
= 0;
572 /* Note about special `boundary' fields:
574 Consider the case where the point (`.') is between the fields `x' and `y':
578 In this situation, if merge_at_boundary is true, we consider the
579 `x' and `y' fields as forming one big merged field, and so the end
580 of the field is the end of `y'.
582 However, if `x' and `y' are separated by a special `boundary' field
583 (a field with a `field' char-property of 'boundary), then we ignore
584 this special field when merging adjacent fields. Here's the same
585 situation, but with a `boundary' field between the `x' and `y' fields:
589 Here, if point is at the end of `x', the beginning of `y', or
590 anywhere in-between (within the `boundary' field), we merge all
591 three fields and consider the beginning as being the beginning of
592 the `x' field, and the end as being the end of the `y' field. */
597 /* POS is at the edge of a field, and we should consider it as
598 the beginning of the following field. */
599 *beg
= XFASTINT (pos
);
601 /* Find the previous field boundary. */
604 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
605 /* Skip a `boundary' field. */
606 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
609 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
611 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
618 /* POS is at the edge of a field, and we should consider it as
619 the end of the previous field. */
620 *end
= XFASTINT (pos
);
622 /* Find the next field boundary. */
624 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
625 /* Skip a `boundary' field. */
626 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
629 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
631 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
637 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
638 doc
: /* Delete the field surrounding POS.
639 A field is a region of text with the same `field' property.
640 If POS is nil, the value of point is used for POS. */)
645 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
647 del_range (beg
, end
);
651 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
652 doc
: /* Return the contents of the field surrounding POS as a string.
653 A field is a region of text with the same `field' property.
654 If POS is nil, the value of point is used for POS. */)
659 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
660 return make_buffer_string (beg
, end
, 1);
663 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
664 doc
: /* Return the contents of the field around POS, without text properties.
665 A field is a region of text with the same `field' property.
666 If POS is nil, the value of point is used for POS. */)
671 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
672 return make_buffer_string (beg
, end
, 0);
675 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
676 doc
: /* Return the beginning of the field surrounding POS.
677 A field is a region of text with the same `field' property.
678 If POS is nil, the value of point is used for POS.
679 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
680 field, then the beginning of the *previous* field is returned.
681 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
682 is before LIMIT, then LIMIT will be returned instead. */)
683 (pos
, escape_from_edge
, limit
)
684 Lisp_Object pos
, escape_from_edge
, limit
;
687 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
688 return make_number (beg
);
691 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
692 doc
: /* Return the end of the field surrounding POS.
693 A field is a region of text with the same `field' property.
694 If POS is nil, the value of point is used for POS.
695 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
696 then the end of the *following* field is returned.
697 If LIMIT is non-nil, it is a buffer position; if the end of the field
698 is after LIMIT, then LIMIT will be returned instead. */)
699 (pos
, escape_from_edge
, limit
)
700 Lisp_Object pos
, escape_from_edge
, limit
;
703 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
704 return make_number (end
);
707 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
708 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
710 A field is a region of text with the same `field' property.
711 If NEW-POS is nil, then the current point is used instead, and set to the
712 constrained position if that is different.
714 If OLD-POS is at the boundary of two fields, then the allowable
715 positions for NEW-POS depends on the value of the optional argument
716 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
717 constrained to the field that has the same `field' char-property
718 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
719 is non-nil, NEW-POS is constrained to the union of the two adjacent
720 fields. Additionally, if two fields are separated by another field with
721 the special value `boundary', then any point within this special field is
722 also considered to be `on the boundary'.
724 If the optional argument ONLY-IN-LINE is non-nil and constraining
725 NEW-POS would move it to a different line, NEW-POS is returned
726 unconstrained. This useful for commands that move by line, like
727 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
728 only in the case where they can still move to the right line.
730 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
731 a non-nil property of that name, then any field boundaries are ignored.
733 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
734 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
735 Lisp_Object new_pos
, old_pos
;
736 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
738 /* If non-zero, then the original point, before re-positioning. */
741 Lisp_Object prev_old
, prev_new
;
744 /* Use the current point, and afterwards, set it. */
747 XSETFASTINT (new_pos
, PT
);
750 CHECK_NUMBER_COERCE_MARKER (new_pos
);
751 CHECK_NUMBER_COERCE_MARKER (old_pos
);
753 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
755 prev_old
= make_number (XFASTINT (old_pos
) - 1);
756 prev_new
= make_number (XFASTINT (new_pos
) - 1);
758 if (NILP (Vinhibit_field_text_motion
)
759 && !EQ (new_pos
, old_pos
)
760 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
761 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
762 /* To recognize field boundaries, we must also look at the
763 previous positions; we could use `get_pos_property'
764 instead, but in itself that would fail inside non-sticky
765 fields (like comint prompts). */
766 || (XFASTINT (new_pos
) > BEGV
767 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
768 || (XFASTINT (old_pos
) > BEGV
769 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
770 && (NILP (inhibit_capture_property
)
771 /* Field boundaries are again a problem; but now we must
772 decide the case exactly, so we need to call
773 `get_pos_property' as well. */
774 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
775 && (XFASTINT (old_pos
) <= BEGV
776 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
777 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
778 /* It is possible that NEW_POS is not within the same field as
779 OLD_POS; try to move NEW_POS so that it is. */
782 Lisp_Object field_bound
;
785 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
787 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
789 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
790 other side of NEW_POS, which would mean that NEW_POS is
791 already acceptable, and it's not necessary to constrain it
793 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
794 /* NEW_POS should be constrained, but only if either
795 ONLY_IN_LINE is nil (in which case any constraint is OK),
796 or NEW_POS and FIELD_BOUND are on the same line (in which
797 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
798 && (NILP (only_in_line
)
799 /* This is the ONLY_IN_LINE case, check that NEW_POS and
800 FIELD_BOUND are on the same line by seeing whether
801 there's an intervening newline or not. */
802 || (scan_buffer ('\n',
803 XFASTINT (new_pos
), XFASTINT (field_bound
),
804 fwd
? -1 : 1, &shortage
, 1),
806 /* Constrain NEW_POS to FIELD_BOUND. */
807 new_pos
= field_bound
;
809 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
810 /* The NEW_POS argument was originally nil, so automatically set PT. */
811 SET_PT (XFASTINT (new_pos
));
818 DEFUN ("line-beginning-position",
819 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
820 doc
: /* Return the character position of the first character on the current line.
821 With argument N not nil or 1, move forward N - 1 lines first.
822 If scan reaches end of buffer, return that position.
824 This function constrains the returned position to the current field
825 unless that would be on a different line than the original,
826 unconstrained result. If N is nil or 1, and a front-sticky field
827 starts at point, the scan stops as soon as it starts. To ignore field
828 boundaries bind `inhibit-field-text-motion' to t.
830 This function does not move point. */)
834 int orig
, orig_byte
, end
;
835 int count
= SPECPDL_INDEX ();
836 specbind (Qinhibit_point_motion_hooks
, Qt
);
845 Fforward_line (make_number (XINT (n
) - 1));
848 SET_PT_BOTH (orig
, orig_byte
);
850 unbind_to (count
, Qnil
);
852 /* Return END constrained to the current input field. */
853 return Fconstrain_to_field (make_number (end
), make_number (orig
),
854 XINT (n
) != 1 ? Qt
: Qnil
,
858 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
859 doc
: /* Return the character position of the last character on the current line.
860 With argument N not nil or 1, move forward N - 1 lines first.
861 If scan reaches end of buffer, return that position.
863 This function constrains the returned position to the current field
864 unless that would be on a different line than the original,
865 unconstrained result. If N is nil or 1, and a rear-sticky field ends
866 at point, the scan stops as soon as it starts. To ignore field
867 boundaries bind `inhibit-field-text-motion' to t.
869 This function does not move point. */)
881 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
883 /* Return END_POS constrained to the current input field. */
884 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
890 save_excursion_save ()
892 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
895 return Fcons (Fpoint_marker (),
896 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
897 Fcons (visible
? Qt
: Qnil
,
898 Fcons (current_buffer
->mark_active
,
903 save_excursion_restore (info
)
906 Lisp_Object tem
, tem1
, omark
, nmark
;
907 struct gcpro gcpro1
, gcpro2
, gcpro3
;
910 tem
= Fmarker_buffer (XCAR (info
));
911 /* If buffer being returned to is now deleted, avoid error */
912 /* Otherwise could get error here while unwinding to top level
914 /* In that case, Fmarker_buffer returns nil now. */
918 omark
= nmark
= Qnil
;
919 GCPRO3 (info
, omark
, nmark
);
926 unchain_marker (XMARKER (tem
));
931 omark
= Fmarker_position (current_buffer
->mark
);
932 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
933 nmark
= Fmarker_position (tem
);
934 unchain_marker (XMARKER (tem
));
938 visible_p
= !NILP (XCAR (info
));
940 #if 0 /* We used to make the current buffer visible in the selected window
941 if that was true previously. That avoids some anomalies.
942 But it creates others, and it wasn't documented, and it is simpler
943 and cleaner never to alter the window/buffer connections. */
946 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
947 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
953 tem1
= current_buffer
->mark_active
;
954 current_buffer
->mark_active
= tem
;
956 if (!NILP (Vrun_hooks
))
958 /* If mark is active now, and either was not active
959 or was at a different place, run the activate hook. */
960 if (! NILP (current_buffer
->mark_active
))
962 if (! EQ (omark
, nmark
))
963 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
965 /* If mark has ceased to be active, run deactivate hook. */
966 else if (! NILP (tem1
))
967 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
970 /* If buffer was visible in a window, and a different window was
971 selected, and the old selected window is still showing this
972 buffer, restore point in that window. */
975 && !EQ (tem
, selected_window
)
976 && (tem1
= XWINDOW (tem
)->buffer
,
977 (/* Window is live... */
979 /* ...and it shows the current buffer. */
980 && XBUFFER (tem1
) == current_buffer
)))
981 Fset_window_point (tem
, make_number (PT
));
987 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
988 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
989 Executes BODY just like `progn'.
990 The values of point, mark and the current buffer are restored
991 even in case of abnormal exit (throw or error).
992 The state of activation of the mark is also restored.
994 This construct does not save `deactivate-mark', and therefore
995 functions that change the buffer will still cause deactivation
996 of the mark at the end of the command. To prevent that, bind
997 `deactivate-mark' with `let'.
999 usage: (save-excursion &rest BODY) */)
1003 register Lisp_Object val
;
1004 int count
= SPECPDL_INDEX ();
1006 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1008 val
= Fprogn (args
);
1009 return unbind_to (count
, val
);
1012 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
1013 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
1014 Executes BODY just like `progn'.
1015 usage: (save-current-buffer &rest BODY) */)
1020 int count
= SPECPDL_INDEX ();
1022 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
1024 val
= Fprogn (args
);
1025 return unbind_to (count
, val
);
1028 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1029 doc
: /* Return the number of characters in the current buffer.
1030 If BUFFER, return the number of characters in that buffer instead. */)
1035 return make_number (Z
- BEG
);
1038 CHECK_BUFFER (buffer
);
1039 return make_number (BUF_Z (XBUFFER (buffer
))
1040 - BUF_BEG (XBUFFER (buffer
)));
1044 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1045 doc
: /* Return the minimum permissible value of point in the current buffer.
1046 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1050 XSETFASTINT (temp
, BEGV
);
1054 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1055 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1056 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1059 return buildmark (BEGV
, BEGV_BYTE
);
1062 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1063 doc
: /* Return the maximum permissible value of point in the current buffer.
1064 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1065 is in effect, in which case it is less. */)
1069 XSETFASTINT (temp
, ZV
);
1073 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1074 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1075 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1076 is in effect, in which case it is less. */)
1079 return buildmark (ZV
, ZV_BYTE
);
1082 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1083 doc
: /* Return the position of the gap, in the current buffer.
1084 See also `gap-size'. */)
1088 XSETFASTINT (temp
, GPT
);
1092 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1093 doc
: /* Return the size of the current buffer's gap.
1094 See also `gap-position'. */)
1098 XSETFASTINT (temp
, GAP_SIZE
);
1102 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1103 doc
: /* Return the byte position for character position POSITION.
1104 If POSITION is out of range, the value is nil. */)
1106 Lisp_Object position
;
1108 CHECK_NUMBER_COERCE_MARKER (position
);
1109 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1111 return make_number (CHAR_TO_BYTE (XINT (position
)));
1114 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1115 doc
: /* Return the character position for byte position BYTEPOS.
1116 If BYTEPOS is out of range, the value is nil. */)
1118 Lisp_Object bytepos
;
1120 CHECK_NUMBER (bytepos
);
1121 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1123 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1126 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1127 doc
: /* Return the character following point, as a number.
1128 At the end of the buffer or accessible region, return 0. */)
1133 XSETFASTINT (temp
, 0);
1135 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1139 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1140 doc
: /* Return the character preceding point, as a number.
1141 At the beginning of the buffer or accessible region, return 0. */)
1146 XSETFASTINT (temp
, 0);
1147 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1151 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1154 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1158 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1159 doc
: /* Return t if point is at the beginning of the buffer.
1160 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1168 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1169 doc
: /* Return t if point is at the end of the buffer.
1170 If the buffer is narrowed, this means the end of the narrowed part. */)
1178 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1179 doc
: /* Return t if point is at the beginning of a line. */)
1182 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1187 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1188 doc
: /* Return t if point is at the end of a line.
1189 `End of a line' includes point being at the end of the buffer. */)
1192 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1197 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1198 doc
: /* Return character in current buffer at position POS.
1199 POS is an integer or a marker and defaults to point.
1200 If POS is out of range, the value is nil. */)
1204 register int pos_byte
;
1209 XSETFASTINT (pos
, PT
);
1214 pos_byte
= marker_byte_position (pos
);
1215 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1220 CHECK_NUMBER_COERCE_MARKER (pos
);
1221 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1224 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1227 return make_number (FETCH_CHAR (pos_byte
));
1230 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1231 doc
: /* Return character in current buffer preceding position POS.
1232 POS is an integer or a marker and defaults to point.
1233 If POS is out of range, the value is nil. */)
1237 register Lisp_Object val
;
1238 register int pos_byte
;
1243 XSETFASTINT (pos
, PT
);
1248 pos_byte
= marker_byte_position (pos
);
1250 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1255 CHECK_NUMBER_COERCE_MARKER (pos
);
1257 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1260 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1263 if (!NILP (current_buffer
->enable_multibyte_characters
))
1266 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1271 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1276 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1277 doc
: /* Return the name under which the user logged in, as a string.
1278 This is based on the effective uid, not the real uid.
1279 Also, if the environment variables LOGNAME or USER are set,
1280 that determines the value of this function.
1282 If optional argument UID is an integer or a float, return the login name
1283 of the user with that uid, or nil if there is no such user. */)
1290 /* Set up the user name info if we didn't do it before.
1291 (That can happen if Emacs is dumpable
1292 but you decide to run `temacs -l loadup' and not dump. */
1293 if (INTEGERP (Vuser_login_name
))
1297 return Vuser_login_name
;
1299 id
= (uid_t
)XFLOATINT (uid
);
1301 pw
= (struct passwd
*) getpwuid (id
);
1303 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1306 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1308 doc
: /* Return the name of the user's real uid, as a string.
1309 This ignores the environment variables LOGNAME and USER, so it differs from
1310 `user-login-name' when running under `su'. */)
1313 /* Set up the user name info if we didn't do it before.
1314 (That can happen if Emacs is dumpable
1315 but you decide to run `temacs -l loadup' and not dump. */
1316 if (INTEGERP (Vuser_login_name
))
1318 return Vuser_real_login_name
;
1321 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1322 doc
: /* Return the effective uid of Emacs.
1323 Value is an integer or a float, depending on the value. */)
1326 /* Assignment to EMACS_INT stops GCC whining about limited range of
1328 EMACS_INT euid
= geteuid ();
1330 /* Make sure we don't produce a negative UID due to signed integer
1333 return make_float ((double)geteuid ());
1334 return make_fixnum_or_float (euid
);
1337 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1338 doc
: /* Return the real uid of Emacs.
1339 Value is an integer or a float, depending on the value. */)
1342 /* Assignment to EMACS_INT stops GCC whining about limited range of
1344 EMACS_INT uid
= getuid ();
1346 /* Make sure we don't produce a negative UID due to signed integer
1349 return make_float ((double)getuid ());
1350 return make_fixnum_or_float (uid
);
1353 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1354 doc
: /* Return the full name of the user logged in, as a string.
1355 If the full name corresponding to Emacs's userid is not known,
1358 If optional argument UID is an integer or float, return the full name
1359 of the user with that uid, or nil if there is no such user.
1360 If UID is a string, return the full name of the user with that login
1361 name, or nil if there is no such user. */)
1366 register unsigned char *p
, *q
;
1370 return Vuser_full_name
;
1371 else if (NUMBERP (uid
))
1374 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1377 else if (STRINGP (uid
))
1380 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1384 error ("Invalid UID specification");
1389 p
= (unsigned char *) USER_FULL_NAME
;
1390 /* Chop off everything after the first comma. */
1391 q
= (unsigned char *) index (p
, ',');
1392 full
= make_string (p
, q
? q
- p
: strlen (p
));
1394 #ifdef AMPERSAND_FULL_NAME
1396 q
= (unsigned char *) index (p
, '&');
1397 /* Substitute the login name for the &, upcasing the first character. */
1400 register unsigned char *r
;
1403 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1404 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1405 bcopy (p
, r
, q
- p
);
1407 strcat (r
, SDATA (login
));
1408 r
[q
- p
] = UPCASE (r
[q
- p
]);
1410 full
= build_string (r
);
1412 #endif /* AMPERSAND_FULL_NAME */
1417 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1418 doc
: /* Return the host name of the machine you are running on, as a string. */)
1421 return Vsystem_name
;
1424 /* For the benefit of callers who don't want to include lisp.h */
1429 if (STRINGP (Vsystem_name
))
1430 return (char *) SDATA (Vsystem_name
);
1436 get_operating_system_release()
1438 if (STRINGP (Voperating_system_release
))
1439 return (char *) SDATA (Voperating_system_release
);
1444 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1445 doc
: /* Return the process ID of Emacs, as an integer. */)
1448 return make_number (getpid ());
1451 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1452 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1453 The time is returned as a list of three integers. The first has the
1454 most significant 16 bits of the seconds, while the second has the
1455 least significant 16 bits. The third integer gives the microsecond
1458 The microsecond count is zero on systems that do not provide
1459 resolution finer than a second. */)
1465 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1466 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1467 make_number (EMACS_USECS (t
)));
1470 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1472 doc
: /* Return the current run time used by Emacs.
1473 The time is returned as a list of three integers. The first has the
1474 most significant 16 bits of the seconds, while the second has the
1475 least significant 16 bits. The third integer gives the microsecond
1478 On systems that can't determine the run time, `get-internal-run-time'
1479 does the same thing as `current-time'. The microsecond count is zero
1480 on systems that do not provide resolution finer than a second. */)
1483 #ifdef HAVE_GETRUSAGE
1484 struct rusage usage
;
1487 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1488 /* This shouldn't happen. What action is appropriate? */
1491 /* Sum up user time and system time. */
1492 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1493 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1494 if (usecs
>= 1000000)
1500 return list3 (make_number ((secs
>> 16) & 0xffff),
1501 make_number ((secs
>> 0) & 0xffff),
1502 make_number (usecs
));
1503 #else /* ! HAVE_GETRUSAGE */
1505 return w32_get_internal_run_time ();
1506 #else /* ! WINDOWSNT */
1507 return Fcurrent_time ();
1508 #endif /* WINDOWSNT */
1509 #endif /* HAVE_GETRUSAGE */
1514 lisp_time_argument (specified_time
, result
, usec
)
1515 Lisp_Object specified_time
;
1519 if (NILP (specified_time
))
1526 *usec
= EMACS_USECS (t
);
1527 *result
= EMACS_SECS (t
);
1531 return time (result
) != -1;
1535 Lisp_Object high
, low
;
1536 high
= Fcar (specified_time
);
1537 CHECK_NUMBER (high
);
1538 low
= Fcdr (specified_time
);
1543 Lisp_Object usec_l
= Fcdr (low
);
1545 usec_l
= Fcar (usec_l
);
1550 CHECK_NUMBER (usec_l
);
1551 *usec
= XINT (usec_l
);
1559 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1560 return *result
>> 16 == XINT (high
);
1564 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1565 doc
: /* Return the current time, as a float number of seconds since the epoch.
1566 If SPECIFIED-TIME is given, it is the time to convert to float
1567 instead of the current time. The argument should have the form
1568 (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
1569 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1570 have the form (HIGH . LOW), but this is considered obsolete.
1572 WARNING: Since the result is floating point, it may not be exact.
1573 Do not use this function if precise time stamps are required. */)
1575 Lisp_Object specified_time
;
1580 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1581 error ("Invalid time specification");
1583 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1586 /* Write information into buffer S of size MAXSIZE, according to the
1587 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1588 Default to Universal Time if UT is nonzero, local time otherwise.
1589 Return the number of bytes written, not including the terminating
1590 '\0'. If S is NULL, nothing will be written anywhere; so to
1591 determine how many bytes would be written, use NULL for S and
1592 ((size_t) -1) for MAXSIZE.
1594 This function behaves like emacs_strftimeu, except it allows null
1597 emacs_memftimeu (s
, maxsize
, format
, format_len
, tp
, ut
)
1602 const struct tm
*tp
;
1607 /* Loop through all the null-terminated strings in the format
1608 argument. Normally there's just one null-terminated string, but
1609 there can be arbitrarily many, concatenated together, if the
1610 format contains '\0' bytes. emacs_strftimeu stops at the first
1611 '\0' byte so we must invoke it separately for each such string. */
1620 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1624 if (result
== 0 && s
[0] != '\0')
1629 maxsize
-= result
+ 1;
1631 len
= strlen (format
);
1632 if (len
== format_len
)
1636 format_len
-= len
+ 1;
1640 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1641 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1642 TIME is specified as (HIGH LOW . IGNORED), as returned by
1643 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1644 is also still accepted.
1645 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1646 as Universal Time; nil means describe TIME in the local time zone.
1647 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1648 by text that describes the specified date and time in TIME:
1650 %Y is the year, %y within the century, %C the century.
1651 %G is the year corresponding to the ISO week, %g within the century.
1652 %m is the numeric month.
1653 %b and %h are the locale's abbreviated month name, %B the full name.
1654 %d is the day of the month, zero-padded, %e is blank-padded.
1655 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1656 %a is the locale's abbreviated name of the day of week, %A the full name.
1657 %U is the week number starting on Sunday, %W starting on Monday,
1658 %V according to ISO 8601.
1659 %j is the day of the year.
1661 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1662 only blank-padded, %l is like %I blank-padded.
1663 %p is the locale's equivalent of either AM or PM.
1666 %Z is the time zone name, %z is the numeric form.
1667 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1669 %c is the locale's date and time format.
1670 %x is the locale's "preferred" date format.
1671 %D is like "%m/%d/%y".
1673 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1674 %X is the locale's "preferred" time format.
1676 Finally, %n is a newline, %t is a tab, %% is a literal %.
1678 Certain flags and modifiers are available with some format controls.
1679 The flags are `_', `-', `^' and `#'. For certain characters X,
1680 %_X is like %X, but padded with blanks; %-X is like %X,
1681 but without padding. %^X is like %X, but with all textual
1682 characters up-cased; %#X is like %X, but with letter-case of
1683 all textual characters reversed.
1684 %NX (where N stands for an integer) is like %X,
1685 but takes up at least N (a number) positions.
1686 The modifiers are `E' and `O'. For certain characters X,
1687 %EX is a locale's alternative version of %X;
1688 %OX is like %X, but uses the locale's number symbols.
1690 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1691 (format_string
, time
, universal
)
1692 Lisp_Object format_string
, time
, universal
;
1697 int ut
= ! NILP (universal
);
1699 CHECK_STRING (format_string
);
1701 if (! lisp_time_argument (time
, &value
, NULL
))
1702 error ("Invalid time specification");
1704 format_string
= code_convert_string_norecord (format_string
,
1705 Vlocale_coding_system
, 1);
1707 /* This is probably enough. */
1708 size
= SBYTES (format_string
) * 6 + 50;
1711 tm
= ut
? gmtime (&value
) : localtime (&value
);
1714 error ("Specified time is not representable");
1716 synchronize_system_time_locale ();
1720 char *buf
= (char *) alloca (size
+ 1);
1725 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1726 SBYTES (format_string
),
1729 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1730 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1731 Vlocale_coding_system
, 0);
1733 /* If buffer was too small, make it bigger and try again. */
1735 result
= emacs_memftimeu (NULL
, (size_t) -1,
1736 SDATA (format_string
),
1737 SBYTES (format_string
),
1744 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1745 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1746 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1747 as from `current-time' and `file-attributes', or nil to use the
1748 current time. The obsolete form (HIGH . LOW) is also still accepted.
1749 The list has the following nine members: SEC is an integer between 0
1750 and 60; SEC is 60 for a leap second, which only some operating systems
1751 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1752 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1753 integer between 1 and 12. YEAR is an integer indicating the
1754 four-digit year. DOW is the day of week, an integer between 0 and 6,
1755 where 0 is Sunday. DST is t if daylight saving time is in effect,
1756 otherwise nil. ZONE is an integer indicating the number of seconds
1757 east of Greenwich. (Note that Common Lisp has different meanings for
1760 Lisp_Object specified_time
;
1764 struct tm
*decoded_time
;
1765 Lisp_Object list_args
[9];
1767 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1768 error ("Invalid time specification");
1771 decoded_time
= localtime (&time_spec
);
1774 error ("Specified time is not representable");
1775 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1776 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1777 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1778 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1779 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1780 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1781 cast below avoids overflow in int arithmetics. */
1782 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1783 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1784 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1786 /* Make a copy, in case gmtime modifies the struct. */
1787 save_tm
= *decoded_time
;
1789 decoded_time
= gmtime (&time_spec
);
1791 if (decoded_time
== 0)
1792 list_args
[8] = Qnil
;
1794 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1795 return Flist (9, list_args
);
1798 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1799 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1800 This is the reverse operation of `decode-time', which see.
1801 ZONE defaults to the current time zone rule. This can
1802 be a string or t (as from `set-time-zone-rule'), or it can be a list
1803 \(as from `current-time-zone') or an integer (as from `decode-time')
1804 applied without consideration for daylight saving time.
1806 You can pass more than 7 arguments; then the first six arguments
1807 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1808 The intervening arguments are ignored.
1809 This feature lets (apply 'encode-time (decode-time ...)) work.
1811 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1812 for example, a DAY of 0 means the day preceding the given month.
1813 Year numbers less than 100 are treated just like other year numbers.
1814 If you want them to stand for years in this century, you must do that yourself.
1816 Years before 1970 are not guaranteed to work. On some systems,
1817 year values as low as 1901 do work.
1819 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1822 register Lisp_Object
*args
;
1826 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1828 CHECK_NUMBER (args
[0]); /* second */
1829 CHECK_NUMBER (args
[1]); /* minute */
1830 CHECK_NUMBER (args
[2]); /* hour */
1831 CHECK_NUMBER (args
[3]); /* day */
1832 CHECK_NUMBER (args
[4]); /* month */
1833 CHECK_NUMBER (args
[5]); /* year */
1835 tm
.tm_sec
= XINT (args
[0]);
1836 tm
.tm_min
= XINT (args
[1]);
1837 tm
.tm_hour
= XINT (args
[2]);
1838 tm
.tm_mday
= XINT (args
[3]);
1839 tm
.tm_mon
= XINT (args
[4]) - 1;
1840 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1848 time
= mktime (&tm
);
1855 char **oldenv
= environ
, **newenv
;
1859 else if (STRINGP (zone
))
1860 tzstring
= (char *) SDATA (zone
);
1861 else if (INTEGERP (zone
))
1863 int abszone
= eabs (XINT (zone
));
1864 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1865 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1869 error ("Invalid time zone specification");
1871 /* Set TZ before calling mktime; merely adjusting mktime's returned
1872 value doesn't suffice, since that would mishandle leap seconds. */
1873 set_time_zone_rule (tzstring
);
1876 time
= mktime (&tm
);
1879 /* Restore TZ to previous value. */
1883 #ifdef LOCALTIME_CACHE
1888 if (time
== (time_t) -1)
1889 error ("Specified time is not representable");
1891 return make_time (time
);
1894 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1895 doc
: /* Return the current time, as a human-readable string.
1896 Programs can use this function to decode a time,
1897 since the number of columns in each field is fixed
1898 if the year is in the range 1000-9999.
1899 The format is `Sun Sep 16 01:03:52 1973'.
1900 However, see also the functions `decode-time' and `format-time-string'
1901 which provide a much more powerful and general facility.
1903 If SPECIFIED-TIME is given, it is a time to format instead of the
1904 current time. The argument should have the form (HIGH LOW . IGNORED).
1905 Thus, you can use times obtained from `current-time' and from
1906 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1907 but this is considered obsolete. */)
1909 Lisp_Object specified_time
;
1915 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1916 error ("Invalid time specification");
1918 /* Convert to a string, checking for out-of-range time stamps.
1919 Don't use 'ctime', as that might dump core if VALUE is out of
1922 tm
= localtime (&value
);
1924 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1925 error ("Specified time is not representable");
1927 /* Remove the trailing newline. */
1928 tem
[strlen (tem
) - 1] = '\0';
1930 return build_string (tem
);
1933 /* Yield A - B, measured in seconds.
1934 This function is copied from the GNU C Library. */
1939 /* Compute intervening leap days correctly even if year is negative.
1940 Take care to avoid int overflow in leap day calculations,
1941 but it's OK to assume that A and B are close to each other. */
1942 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1943 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1944 int a100
= a4
/ 25 - (a4
% 25 < 0);
1945 int b100
= b4
/ 25 - (b4
% 25 < 0);
1946 int a400
= a100
>> 2;
1947 int b400
= b100
>> 2;
1948 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1949 int years
= a
->tm_year
- b
->tm_year
;
1950 int days
= (365 * years
+ intervening_leap_days
1951 + (a
->tm_yday
- b
->tm_yday
));
1952 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1953 + (a
->tm_min
- b
->tm_min
))
1954 + (a
->tm_sec
- b
->tm_sec
));
1957 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1958 doc
: /* Return the offset and name for the local time zone.
1959 This returns a list of the form (OFFSET NAME).
1960 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1961 A negative value means west of Greenwich.
1962 NAME is a string giving the name of the time zone.
1963 If SPECIFIED-TIME is given, the time zone offset is determined from it
1964 instead of using the current time. The argument should have the form
1965 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1966 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1967 have the form (HIGH . LOW), but this is considered obsolete.
1969 Some operating systems cannot provide all this information to Emacs;
1970 in this case, `current-time-zone' returns a list containing nil for
1971 the data it can't find. */)
1973 Lisp_Object specified_time
;
1979 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1984 t
= gmtime (&value
);
1988 t
= localtime (&value
);
1995 int offset
= tm_diff (t
, &gmt
);
2001 s
= (char *)t
->tm_zone
;
2002 #else /* not HAVE_TM_ZONE */
2004 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
2005 s
= tzname
[t
->tm_isdst
];
2007 #endif /* not HAVE_TM_ZONE */
2011 /* No local time zone name is available; use "+-NNNN" instead. */
2012 int am
= (offset
< 0 ? -offset
: offset
) / 60;
2013 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
2017 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
2020 return Fmake_list (make_number (2), Qnil
);
2023 /* This holds the value of `environ' produced by the previous
2024 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
2025 has never been called. */
2026 static char **environbuf
;
2028 /* This holds the startup value of the TZ environment variable so it
2029 can be restored if the user calls set-time-zone-rule with a nil
2031 static char *initial_tz
;
2033 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
2034 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
2035 If TZ is nil, use implementation-defined default time zone information.
2036 If TZ is t, use Universal Time. */)
2042 /* When called for the first time, save the original TZ. */
2044 initial_tz
= (char *) getenv ("TZ");
2047 tzstring
= initial_tz
;
2048 else if (EQ (tz
, Qt
))
2053 tzstring
= (char *) SDATA (tz
);
2056 set_time_zone_rule (tzstring
);
2058 environbuf
= environ
;
2063 #ifdef LOCALTIME_CACHE
2065 /* These two values are known to load tz files in buggy implementations,
2066 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2067 Their values shouldn't matter in non-buggy implementations.
2068 We don't use string literals for these strings,
2069 since if a string in the environment is in readonly
2070 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2071 See Sun bugs 1113095 and 1114114, ``Timezone routines
2072 improperly modify environment''. */
2074 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2075 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2079 /* Set the local time zone rule to TZSTRING.
2080 This allocates memory into `environ', which it is the caller's
2081 responsibility to free. */
2084 set_time_zone_rule (tzstring
)
2088 char **from
, **to
, **newenv
;
2090 /* Make the ENVIRON vector longer with room for TZSTRING. */
2091 for (from
= environ
; *from
; from
++)
2093 envptrs
= from
- environ
+ 2;
2094 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2095 + (tzstring
? strlen (tzstring
) + 4 : 0));
2097 /* Add TZSTRING to the end of environ, as a value for TZ. */
2100 char *t
= (char *) (to
+ envptrs
);
2102 strcat (t
, tzstring
);
2106 /* Copy the old environ vector elements into NEWENV,
2107 but don't copy the TZ variable.
2108 So we have only one definition of TZ, which came from TZSTRING. */
2109 for (from
= environ
; *from
; from
++)
2110 if (strncmp (*from
, "TZ=", 3) != 0)
2116 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2117 the TZ variable is stored. If we do not have a TZSTRING,
2118 TO points to the vector slot which has the terminating null. */
2120 #ifdef LOCALTIME_CACHE
2122 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2123 "US/Pacific" that loads a tz file, then changes to a value like
2124 "XXX0" that does not load a tz file, and then changes back to
2125 its original value, the last change is (incorrectly) ignored.
2126 Also, if TZ changes twice in succession to values that do
2127 not load a tz file, tzset can dump core (see Sun bug#1225179).
2128 The following code works around these bugs. */
2132 /* Temporarily set TZ to a value that loads a tz file
2133 and that differs from tzstring. */
2135 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2136 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2142 /* The implied tzstring is unknown, so temporarily set TZ to
2143 two different values that each load a tz file. */
2144 *to
= set_time_zone_rule_tz1
;
2147 *to
= set_time_zone_rule_tz2
;
2152 /* Now TZ has the desired value, and tzset can be invoked safely. */
2159 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2160 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2161 type of object is Lisp_String). INHERIT is passed to
2162 INSERT_FROM_STRING_FUNC as the last argument. */
2165 general_insert_function (void (*insert_func
)
2166 (const unsigned char *, EMACS_INT
),
2167 void (*insert_from_string_func
)
2168 (Lisp_Object
, EMACS_INT
, EMACS_INT
,
2169 EMACS_INT
, EMACS_INT
, int),
2170 int inherit
, int nargs
, Lisp_Object
*args
)
2172 register int argnum
;
2173 register Lisp_Object val
;
2175 for (argnum
= 0; argnum
< nargs
; argnum
++)
2178 if (CHARACTERP (val
))
2180 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2183 if (!NILP (current_buffer
->enable_multibyte_characters
))
2184 len
= CHAR_STRING (XFASTINT (val
), str
);
2187 str
[0] = (ASCII_CHAR_P (XINT (val
))
2189 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2192 (*insert_func
) (str
, len
);
2194 else if (STRINGP (val
))
2196 (*insert_from_string_func
) (val
, 0, 0,
2202 wrong_type_argument (Qchar_or_string_p
, val
);
2214 /* Callers passing one argument to Finsert need not gcpro the
2215 argument "array", since the only element of the array will
2216 not be used after calling insert or insert_from_string, so
2217 we don't care if it gets trashed. */
2219 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2220 doc
: /* Insert the arguments, either strings or characters, at point.
2221 Point and before-insertion markers move forward to end up
2222 after the inserted text.
2223 Any other markers at the point of insertion remain before the text.
2225 If the current buffer is multibyte, unibyte strings are converted
2226 to multibyte for insertion (see `string-make-multibyte').
2227 If the current buffer is unibyte, multibyte strings are converted
2228 to unibyte for insertion (see `string-make-unibyte').
2230 When operating on binary data, it may be necessary to preserve the
2231 original bytes of a unibyte string when inserting it into a multibyte
2232 buffer; to accomplish this, apply `string-as-multibyte' to the string
2233 and insert the result.
2235 usage: (insert &rest ARGS) */)
2238 register Lisp_Object
*args
;
2240 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2244 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2246 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2247 Point and before-insertion markers move forward to end up
2248 after the inserted text.
2249 Any other markers at the point of insertion remain before the text.
2251 If the current buffer is multibyte, unibyte strings are converted
2252 to multibyte for insertion (see `unibyte-char-to-multibyte').
2253 If the current buffer is unibyte, multibyte strings are converted
2254 to unibyte for insertion.
2256 usage: (insert-and-inherit &rest ARGS) */)
2259 register Lisp_Object
*args
;
2261 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2266 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2267 doc
: /* Insert strings or characters at point, relocating markers after the text.
2268 Point and markers move forward to end up after the inserted text.
2270 If the current buffer is multibyte, unibyte strings are converted
2271 to multibyte for insertion (see `unibyte-char-to-multibyte').
2272 If the current buffer is unibyte, multibyte strings are converted
2273 to unibyte for insertion.
2275 usage: (insert-before-markers &rest ARGS) */)
2278 register Lisp_Object
*args
;
2280 general_insert_function (insert_before_markers
,
2281 insert_from_string_before_markers
, 0,
2286 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2287 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2288 doc
: /* Insert text at point, relocating markers and inheriting properties.
2289 Point and markers move forward to end up after the inserted text.
2291 If the current buffer is multibyte, unibyte strings are converted
2292 to multibyte for insertion (see `unibyte-char-to-multibyte').
2293 If the current buffer is unibyte, multibyte strings are converted
2294 to unibyte for insertion.
2296 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2299 register Lisp_Object
*args
;
2301 general_insert_function (insert_before_markers_and_inherit
,
2302 insert_from_string_before_markers
, 1,
2307 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2308 doc
: /* Insert COUNT copies of CHARACTER.
2309 Point, and before-insertion markers, are relocated as in the function `insert'.
2310 The optional third arg INHERIT, if non-nil, says to inherit text properties
2311 from adjoining text, if those properties are sticky. */)
2312 (character
, count
, inherit
)
2313 Lisp_Object character
, count
, inherit
;
2315 register unsigned char *string
;
2316 register int strlen
;
2319 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2321 CHECK_NUMBER (character
);
2322 CHECK_NUMBER (count
);
2324 if (!NILP (current_buffer
->enable_multibyte_characters
))
2325 len
= CHAR_STRING (XFASTINT (character
), str
);
2327 str
[0] = XFASTINT (character
), len
= 1;
2328 n
= XINT (count
) * len
;
2331 strlen
= min (n
, 256 * len
);
2332 string
= (unsigned char *) alloca (strlen
);
2333 for (i
= 0; i
< strlen
; i
++)
2334 string
[i
] = str
[i
% len
];
2338 if (!NILP (inherit
))
2339 insert_and_inherit (string
, strlen
);
2341 insert (string
, strlen
);
2346 if (!NILP (inherit
))
2347 insert_and_inherit (string
, n
);
2354 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2355 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2356 Both arguments are required.
2357 BYTE is a number of the range 0..255.
2359 If BYTE is 128..255 and the current buffer is multibyte, the
2360 corresponding eight-bit character is inserted.
2362 Point, and before-insertion markers, are relocated as in the function `insert'.
2363 The optional third arg INHERIT, if non-nil, says to inherit text properties
2364 from adjoining text, if those properties are sticky. */)
2365 (byte
, count
, inherit
)
2366 Lisp_Object byte
, count
, inherit
;
2368 CHECK_NUMBER (byte
);
2369 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2370 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2371 if (XINT (byte
) >= 128
2372 && ! NILP (current_buffer
->enable_multibyte_characters
))
2373 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2374 return Finsert_char (byte
, count
, inherit
);
2378 /* Making strings from buffer contents. */
2380 /* Return a Lisp_String containing the text of the current buffer from
2381 START to END. If text properties are in use and the current buffer
2382 has properties in the range specified, the resulting string will also
2383 have them, if PROPS is nonzero.
2385 We don't want to use plain old make_string here, because it calls
2386 make_uninit_string, which can cause the buffer arena to be
2387 compacted. make_string has no way of knowing that the data has
2388 been moved, and thus copies the wrong data into the string. This
2389 doesn't effect most of the other users of make_string, so it should
2390 be left as is. But we should use this function when conjuring
2391 buffer substrings. */
2394 make_buffer_string (start
, end
, props
)
2398 int start_byte
= CHAR_TO_BYTE (start
);
2399 int end_byte
= CHAR_TO_BYTE (end
);
2401 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2404 /* Return a Lisp_String containing the text of the current buffer from
2405 START / START_BYTE to END / END_BYTE.
2407 If text properties are in use and the current buffer
2408 has properties in the range specified, the resulting string will also
2409 have them, if PROPS is nonzero.
2411 We don't want to use plain old make_string here, because it calls
2412 make_uninit_string, which can cause the buffer arena to be
2413 compacted. make_string has no way of knowing that the data has
2414 been moved, and thus copies the wrong data into the string. This
2415 doesn't effect most of the other users of make_string, so it should
2416 be left as is. But we should use this function when conjuring
2417 buffer substrings. */
2420 make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
)
2421 int start
, start_byte
, end
, end_byte
;
2424 Lisp_Object result
, tem
, tem1
;
2426 if (start
< GPT
&& GPT
< end
)
2429 if (! NILP (current_buffer
->enable_multibyte_characters
))
2430 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2432 result
= make_uninit_string (end
- start
);
2433 bcopy (BYTE_POS_ADDR (start_byte
), SDATA (result
),
2434 end_byte
- start_byte
);
2436 /* If desired, update and copy the text properties. */
2439 update_buffer_properties (start
, end
);
2441 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2442 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2444 if (XINT (tem
) != end
|| !NILP (tem1
))
2445 copy_intervals_to_string (result
, current_buffer
, start
,
2452 /* Call Vbuffer_access_fontify_functions for the range START ... END
2453 in the current buffer, if necessary. */
2456 update_buffer_properties (start
, end
)
2459 /* If this buffer has some access functions,
2460 call them, specifying the range of the buffer being accessed. */
2461 if (!NILP (Vbuffer_access_fontify_functions
))
2463 Lisp_Object args
[3];
2466 args
[0] = Qbuffer_access_fontify_functions
;
2467 XSETINT (args
[1], start
);
2468 XSETINT (args
[2], end
);
2470 /* But don't call them if we can tell that the work
2471 has already been done. */
2472 if (!NILP (Vbuffer_access_fontified_property
))
2474 tem
= Ftext_property_any (args
[1], args
[2],
2475 Vbuffer_access_fontified_property
,
2478 Frun_hook_with_args (3, args
);
2481 Frun_hook_with_args (3, args
);
2485 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2486 doc
: /* Return the contents of part of the current buffer as a string.
2487 The two arguments START and END are character positions;
2488 they can be in either order.
2489 The string returned is multibyte if the buffer is multibyte.
2491 This function copies the text properties of that part of the buffer
2492 into the result string; if you don't want the text properties,
2493 use `buffer-substring-no-properties' instead. */)
2495 Lisp_Object start
, end
;
2499 validate_region (&start
, &end
);
2503 return make_buffer_string (b
, e
, 1);
2506 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2507 Sbuffer_substring_no_properties
, 2, 2, 0,
2508 doc
: /* Return the characters of part of the buffer, without the text properties.
2509 The two arguments START and END are character positions;
2510 they can be in either order. */)
2512 Lisp_Object start
, end
;
2516 validate_region (&start
, &end
);
2520 return make_buffer_string (b
, e
, 0);
2523 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2524 doc
: /* Return the contents of the current buffer as a string.
2525 If narrowing is in effect, this function returns only the visible part
2529 return make_buffer_string (BEGV
, ZV
, 1);
2532 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2534 doc
: /* Insert before point a substring of the contents of BUFFER.
2535 BUFFER may be a buffer or a buffer name.
2536 Arguments START and END are character positions specifying the substring.
2537 They default to the values of (point-min) and (point-max) in BUFFER. */)
2538 (buffer
, start
, end
)
2539 Lisp_Object buffer
, start
, end
;
2541 register int b
, e
, temp
;
2542 register struct buffer
*bp
, *obuf
;
2545 buf
= Fget_buffer (buffer
);
2549 if (NILP (bp
->name
))
2550 error ("Selecting deleted buffer");
2556 CHECK_NUMBER_COERCE_MARKER (start
);
2563 CHECK_NUMBER_COERCE_MARKER (end
);
2568 temp
= b
, b
= e
, e
= temp
;
2570 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2571 args_out_of_range (start
, end
);
2573 obuf
= current_buffer
;
2574 set_buffer_internal_1 (bp
);
2575 update_buffer_properties (b
, e
);
2576 set_buffer_internal_1 (obuf
);
2578 insert_from_buffer (bp
, b
, e
- b
, 0);
2582 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2584 doc
: /* Compare two substrings of two buffers; return result as number.
2585 the value is -N if first string is less after N-1 chars,
2586 +N if first string is greater after N-1 chars, or 0 if strings match.
2587 Each substring is represented as three arguments: BUFFER, START and END.
2588 That makes six args in all, three for each substring.
2590 The value of `case-fold-search' in the current buffer
2591 determines whether case is significant or ignored. */)
2592 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2593 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2595 register int begp1
, endp1
, begp2
, endp2
, temp
;
2596 register struct buffer
*bp1
, *bp2
;
2597 register Lisp_Object trt
2598 = (!NILP (current_buffer
->case_fold_search
)
2599 ? current_buffer
->case_canon_table
: Qnil
);
2601 int i1
, i2
, i1_byte
, i2_byte
;
2603 /* Find the first buffer and its substring. */
2606 bp1
= current_buffer
;
2610 buf1
= Fget_buffer (buffer1
);
2613 bp1
= XBUFFER (buf1
);
2614 if (NILP (bp1
->name
))
2615 error ("Selecting deleted buffer");
2619 begp1
= BUF_BEGV (bp1
);
2622 CHECK_NUMBER_COERCE_MARKER (start1
);
2623 begp1
= XINT (start1
);
2626 endp1
= BUF_ZV (bp1
);
2629 CHECK_NUMBER_COERCE_MARKER (end1
);
2630 endp1
= XINT (end1
);
2634 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2636 if (!(BUF_BEGV (bp1
) <= begp1
2638 && endp1
<= BUF_ZV (bp1
)))
2639 args_out_of_range (start1
, end1
);
2641 /* Likewise for second substring. */
2644 bp2
= current_buffer
;
2648 buf2
= Fget_buffer (buffer2
);
2651 bp2
= XBUFFER (buf2
);
2652 if (NILP (bp2
->name
))
2653 error ("Selecting deleted buffer");
2657 begp2
= BUF_BEGV (bp2
);
2660 CHECK_NUMBER_COERCE_MARKER (start2
);
2661 begp2
= XINT (start2
);
2664 endp2
= BUF_ZV (bp2
);
2667 CHECK_NUMBER_COERCE_MARKER (end2
);
2668 endp2
= XINT (end2
);
2672 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2674 if (!(BUF_BEGV (bp2
) <= begp2
2676 && endp2
<= BUF_ZV (bp2
)))
2677 args_out_of_range (start2
, end2
);
2681 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2682 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2684 while (i1
< endp1
&& i2
< endp2
)
2686 /* When we find a mismatch, we must compare the
2687 characters, not just the bytes. */
2692 if (! NILP (bp1
->enable_multibyte_characters
))
2694 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2695 BUF_INC_POS (bp1
, i1_byte
);
2700 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2701 c1
= unibyte_char_to_multibyte (c1
);
2705 if (! NILP (bp2
->enable_multibyte_characters
))
2707 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2708 BUF_INC_POS (bp2
, i2_byte
);
2713 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2714 c2
= unibyte_char_to_multibyte (c2
);
2720 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2721 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2724 return make_number (- 1 - chars
);
2726 return make_number (chars
+ 1);
2731 /* The strings match as far as they go.
2732 If one is shorter, that one is less. */
2733 if (chars
< endp1
- begp1
)
2734 return make_number (chars
+ 1);
2735 else if (chars
< endp2
- begp2
)
2736 return make_number (- chars
- 1);
2738 /* Same length too => they are equal. */
2739 return make_number (0);
2743 subst_char_in_region_unwind (arg
)
2746 return current_buffer
->undo_list
= arg
;
2750 subst_char_in_region_unwind_1 (arg
)
2753 return current_buffer
->filename
= arg
;
2756 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2757 Ssubst_char_in_region
, 4, 5, 0,
2758 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2759 If optional arg NOUNDO is non-nil, don't record this change for undo
2760 and don't mark the buffer as really changed.
2761 Both characters must have the same length of multi-byte form. */)
2762 (start
, end
, fromchar
, tochar
, noundo
)
2763 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2765 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2766 /* Keep track of the first change in the buffer:
2767 if 0 we haven't found it yet.
2768 if < 0 we've found it and we've run the before-change-function.
2769 if > 0 we've actually performed it and the value is its position. */
2771 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2773 int count
= SPECPDL_INDEX ();
2774 #define COMBINING_NO 0
2775 #define COMBINING_BEFORE 1
2776 #define COMBINING_AFTER 2
2777 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2778 int maybe_byte_combining
= COMBINING_NO
;
2779 int last_changed
= 0;
2780 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2784 validate_region (&start
, &end
);
2785 CHECK_NUMBER (fromchar
);
2786 CHECK_NUMBER (tochar
);
2790 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2791 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2792 error ("Characters in `subst-char-in-region' have different byte-lengths");
2793 if (!ASCII_BYTE_P (*tostr
))
2795 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2796 complete multibyte character, it may be combined with the
2797 after bytes. If it is in the range 0xA0..0xFF, it may be
2798 combined with the before and after bytes. */
2799 if (!CHAR_HEAD_P (*tostr
))
2800 maybe_byte_combining
= COMBINING_BOTH
;
2801 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2802 maybe_byte_combining
= COMBINING_AFTER
;
2808 fromstr
[0] = XFASTINT (fromchar
);
2809 tostr
[0] = XFASTINT (tochar
);
2813 pos_byte
= CHAR_TO_BYTE (pos
);
2814 stop
= CHAR_TO_BYTE (XINT (end
));
2817 /* If we don't want undo, turn off putting stuff on the list.
2818 That's faster than getting rid of things,
2819 and it prevents even the entry for a first change.
2820 Also inhibit locking the file. */
2821 if (!changed
&& !NILP (noundo
))
2823 record_unwind_protect (subst_char_in_region_unwind
,
2824 current_buffer
->undo_list
);
2825 current_buffer
->undo_list
= Qt
;
2826 /* Don't do file-locking. */
2827 record_unwind_protect (subst_char_in_region_unwind_1
,
2828 current_buffer
->filename
);
2829 current_buffer
->filename
= Qnil
;
2832 if (pos_byte
< GPT_BYTE
)
2833 stop
= min (stop
, GPT_BYTE
);
2836 int pos_byte_next
= pos_byte
;
2838 if (pos_byte
>= stop
)
2840 if (pos_byte
>= end_byte
) break;
2843 p
= BYTE_POS_ADDR (pos_byte
);
2845 INC_POS (pos_byte_next
);
2848 if (pos_byte_next
- pos_byte
== len
2849 && p
[0] == fromstr
[0]
2851 || (p
[1] == fromstr
[1]
2852 && (len
== 2 || (p
[2] == fromstr
[2]
2853 && (len
== 3 || p
[3] == fromstr
[3]))))))
2856 /* We've already seen this and run the before-change-function;
2857 this time we only need to record the actual position. */
2862 modify_region (current_buffer
, pos
, XINT (end
), 0);
2864 if (! NILP (noundo
))
2866 if (MODIFF
- 1 == SAVE_MODIFF
)
2868 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
2869 current_buffer
->auto_save_modified
++;
2872 /* The before-change-function may have moved the gap
2873 or even modified the buffer so we should start over. */
2877 /* Take care of the case where the new character
2878 combines with neighboring bytes. */
2879 if (maybe_byte_combining
2880 && (maybe_byte_combining
== COMBINING_AFTER
2881 ? (pos_byte_next
< Z_BYTE
2882 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2883 : ((pos_byte_next
< Z_BYTE
2884 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2885 || (pos_byte
> BEG_BYTE
2886 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2888 Lisp_Object tem
, string
;
2890 struct gcpro gcpro1
;
2892 tem
= current_buffer
->undo_list
;
2895 /* Make a multibyte string containing this single character. */
2896 string
= make_multibyte_string (tostr
, 1, len
);
2897 /* replace_range is less efficient, because it moves the gap,
2898 but it handles combining correctly. */
2899 replace_range (pos
, pos
+ 1, string
,
2901 pos_byte_next
= CHAR_TO_BYTE (pos
);
2902 if (pos_byte_next
> pos_byte
)
2903 /* Before combining happened. We should not increment
2904 POS. So, to cancel the later increment of POS,
2908 INC_POS (pos_byte_next
);
2910 if (! NILP (noundo
))
2911 current_buffer
->undo_list
= tem
;
2918 record_change (pos
, 1);
2919 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2921 last_changed
= pos
+ 1;
2923 pos_byte
= pos_byte_next
;
2929 signal_after_change (changed
,
2930 last_changed
- changed
, last_changed
- changed
);
2931 update_compositions (changed
, last_changed
, CHECK_ALL
);
2934 unbind_to (count
, Qnil
);
2939 static Lisp_Object check_translation
P_ ((int, int, int, Lisp_Object
));
2941 /* Helper function for Ftranslate_region_internal.
2943 Check if a character sequence at POS (POS_BYTE) matches an element
2944 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2945 element is found, return it. Otherwise return Qnil. */
2948 check_translation (pos
, pos_byte
, end
, val
)
2949 int pos
, pos_byte
, end
;
2952 int buf_size
= 16, buf_used
= 0;
2953 int *buf
= alloca (sizeof (int) * buf_size
);
2955 for (; CONSP (val
); val
= XCDR (val
))
2964 if (! VECTORP (elt
))
2967 if (len
<= end
- pos
)
2969 for (i
= 0; i
< len
; i
++)
2973 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2976 if (buf_used
== buf_size
)
2981 newbuf
= alloca (sizeof (int) * buf_size
);
2982 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2985 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, 0, len
);
2988 if (XINT (AREF (elt
, i
)) != buf
[i
])
2999 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
3000 Stranslate_region_internal
, 3, 3, 0,
3001 doc
: /* Internal use only.
3002 From START to END, translate characters according to TABLE.
3003 TABLE is a string or a char-table; the Nth character in it is the
3004 mapping for the character with code N.
3005 It returns the number of characters changed. */)
3009 register Lisp_Object table
;
3011 register unsigned char *tt
; /* Trans table. */
3012 register int nc
; /* New character. */
3013 int cnt
; /* Number of changes made. */
3014 int size
; /* Size of translate table. */
3015 int pos
, pos_byte
, end_pos
;
3016 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
3017 int string_multibyte
;
3020 validate_region (&start
, &end
);
3021 if (CHAR_TABLE_P (table
))
3023 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
3024 error ("Not a translation table");
3030 CHECK_STRING (table
);
3032 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
3033 table
= string_make_unibyte (table
);
3034 string_multibyte
= SCHARS (table
) < SBYTES (table
);
3035 size
= SBYTES (table
);
3040 pos_byte
= CHAR_TO_BYTE (pos
);
3041 end_pos
= XINT (end
);
3042 modify_region (current_buffer
, pos
, end_pos
, 0);
3045 for (; pos
< end_pos
; )
3047 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3048 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
3054 oc
= STRING_CHAR_AND_LENGTH (p
, MAX_MULTIBYTE_LENGTH
, len
);
3061 /* Reload as signal_after_change in last iteration may GC. */
3063 if (string_multibyte
)
3065 str
= tt
+ string_char_to_byte (table
, oc
);
3066 nc
= STRING_CHAR_AND_LENGTH (str
, MAX_MULTIBYTE_LENGTH
,
3072 if (! ASCII_BYTE_P (nc
) && multibyte
)
3074 str_len
= BYTE8_STRING (nc
, buf
);
3089 val
= CHAR_TABLE_REF (table
, oc
);
3090 if (CHARACTERP (val
)
3091 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3094 str_len
= CHAR_STRING (nc
, buf
);
3097 else if (VECTORP (val
) || (CONSP (val
)))
3099 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3100 where TO is TO-CHAR or [TO-CHAR ...]. */
3105 if (nc
!= oc
&& nc
>= 0)
3107 /* Simple one char to one char translation. */
3112 /* This is less efficient, because it moves the gap,
3113 but it should handle multibyte characters correctly. */
3114 string
= make_multibyte_string (str
, 1, str_len
);
3115 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3120 record_change (pos
, 1);
3121 while (str_len
-- > 0)
3123 signal_after_change (pos
, 1, 1);
3124 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3134 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3141 /* VAL is ([FROM-CHAR ...] . TO). */
3142 len
= ASIZE (XCAR (val
));
3150 string
= Fconcat (1, &val
);
3154 string
= Fmake_string (make_number (1), val
);
3156 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3157 pos_byte
+= SBYTES (string
);
3158 pos
+= SCHARS (string
);
3159 cnt
+= SCHARS (string
);
3160 end_pos
+= SCHARS (string
) - len
;
3168 return make_number (cnt
);
3171 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3172 doc
: /* Delete the text between point and mark.
3174 When called from a program, expects two arguments,
3175 positions (integers or markers) specifying the stretch to be deleted. */)
3177 Lisp_Object start
, end
;
3179 validate_region (&start
, &end
);
3180 del_range (XINT (start
), XINT (end
));
3184 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3185 Sdelete_and_extract_region
, 2, 2, 0,
3186 doc
: /* Delete the text between START and END and return it. */)
3188 Lisp_Object start
, end
;
3190 validate_region (&start
, &end
);
3191 if (XINT (start
) == XINT (end
))
3192 return empty_unibyte_string
;
3193 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3196 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3197 doc
: /* Remove restrictions (narrowing) from current buffer.
3198 This allows the buffer's full text to be seen and edited. */)
3201 if (BEG
!= BEGV
|| Z
!= ZV
)
3202 current_buffer
->clip_changed
= 1;
3204 BEGV_BYTE
= BEG_BYTE
;
3205 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3206 /* Changing the buffer bounds invalidates any recorded current column. */
3207 invalidate_current_column ();
3211 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3212 doc
: /* Restrict editing in this buffer to the current region.
3213 The rest of the text becomes temporarily invisible and untouchable
3214 but is not deleted; if you save the buffer in a file, the invisible
3215 text is included in the file. \\[widen] makes all visible again.
3216 See also `save-restriction'.
3218 When calling from a program, pass two arguments; positions (integers
3219 or markers) bounding the text that should remain visible. */)
3221 register Lisp_Object start
, end
;
3223 CHECK_NUMBER_COERCE_MARKER (start
);
3224 CHECK_NUMBER_COERCE_MARKER (end
);
3226 if (XINT (start
) > XINT (end
))
3229 tem
= start
; start
= end
; end
= tem
;
3232 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3233 args_out_of_range (start
, end
);
3235 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3236 current_buffer
->clip_changed
= 1;
3238 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3239 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3240 if (PT
< XFASTINT (start
))
3241 SET_PT (XFASTINT (start
));
3242 if (PT
> XFASTINT (end
))
3243 SET_PT (XFASTINT (end
));
3244 /* Changing the buffer bounds invalidates any recorded current column. */
3245 invalidate_current_column ();
3250 save_restriction_save ()
3252 if (BEGV
== BEG
&& ZV
== Z
)
3253 /* The common case that the buffer isn't narrowed.
3254 We return just the buffer object, which save_restriction_restore
3255 recognizes as meaning `no restriction'. */
3256 return Fcurrent_buffer ();
3258 /* We have to save a restriction, so return a pair of markers, one
3259 for the beginning and one for the end. */
3261 Lisp_Object beg
, end
;
3263 beg
= buildmark (BEGV
, BEGV_BYTE
);
3264 end
= buildmark (ZV
, ZV_BYTE
);
3266 /* END must move forward if text is inserted at its exact location. */
3267 XMARKER(end
)->insertion_type
= 1;
3269 return Fcons (beg
, end
);
3274 save_restriction_restore (data
)
3278 /* A pair of marks bounding a saved restriction. */
3280 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3281 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3282 struct buffer
*buf
= beg
->buffer
; /* END should have the same buffer. */
3284 if (buf
/* Verify marker still points to a buffer. */
3285 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3286 /* The restriction has changed from the saved one, so restore
3287 the saved restriction. */
3289 int pt
= BUF_PT (buf
);
3291 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3292 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3294 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3295 /* The point is outside the new visible range, move it inside. */
3296 SET_BUF_PT_BOTH (buf
,
3297 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3298 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3301 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3305 /* A buffer, which means that there was no old restriction. */
3307 struct buffer
*buf
= XBUFFER (data
);
3309 if (buf
/* Verify marker still points to a buffer. */
3310 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3311 /* The buffer has been narrowed, get rid of the narrowing. */
3313 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3314 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3316 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3323 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3324 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3325 The buffer's restrictions make parts of the beginning and end invisible.
3326 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3327 This special form, `save-restriction', saves the current buffer's restrictions
3328 when it is entered, and restores them when it is exited.
3329 So any `narrow-to-region' within BODY lasts only until the end of the form.
3330 The old restrictions settings are restored
3331 even in case of abnormal exit (throw or error).
3333 The value returned is the value of the last form in BODY.
3335 Note: if you are using both `save-excursion' and `save-restriction',
3336 use `save-excursion' outermost:
3337 (save-excursion (save-restriction ...))
3339 usage: (save-restriction &rest BODY) */)
3343 register Lisp_Object val
;
3344 int count
= SPECPDL_INDEX ();
3346 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3347 val
= Fprogn (body
);
3348 return unbind_to (count
, val
);
3351 /* Buffer for the most recent text displayed by Fmessage_box. */
3352 static char *message_text
;
3354 /* Allocated length of that buffer. */
3355 static int message_length
;
3357 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3358 doc
: /* Display a message at the bottom of the screen.
3359 The message also goes into the `*Messages*' buffer.
3360 \(In keyboard macros, that's all it does.)
3363 The first argument is a format control string, and the rest are data
3364 to be formatted under control of the string. See `format' for details.
3366 Note: Use (message "%s" VALUE) to print the value of expressions and
3367 variables to avoid accidentally interpreting `%' as format specifiers.
3369 If the first argument is nil or the empty string, the function clears
3370 any existing message; this lets the minibuffer contents show. See
3371 also `current-message'.
3373 usage: (message FORMAT-STRING &rest ARGS) */)
3379 || (STRINGP (args
[0])
3380 && SBYTES (args
[0]) == 0))
3387 register Lisp_Object val
;
3388 val
= Fformat (nargs
, args
);
3389 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3394 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3395 doc
: /* Display a message, in a dialog box if possible.
3396 If a dialog box is not available, use the echo area.
3397 The first argument is a format control string, and the rest are data
3398 to be formatted under control of the string. See `format' for details.
3400 If the first argument is nil or the empty string, clear any existing
3401 message; let the minibuffer contents show.
3403 usage: (message-box FORMAT-STRING &rest ARGS) */)
3415 register Lisp_Object val
;
3416 val
= Fformat (nargs
, args
);
3418 /* The MS-DOS frames support popup menus even though they are
3419 not FRAME_WINDOW_P. */
3420 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3421 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3423 Lisp_Object pane
, menu
, obj
;
3424 struct gcpro gcpro1
;
3425 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3427 menu
= Fcons (val
, pane
);
3428 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3432 #endif /* HAVE_MENUS */
3433 /* Copy the data so that it won't move when we GC. */
3436 message_text
= (char *)xmalloc (80);
3437 message_length
= 80;
3439 if (SBYTES (val
) > message_length
)
3441 message_length
= SBYTES (val
);
3442 message_text
= (char *)xrealloc (message_text
, message_length
);
3444 bcopy (SDATA (val
), message_text
, SBYTES (val
));
3445 message2 (message_text
, SBYTES (val
),
3446 STRING_MULTIBYTE (val
));
3451 extern Lisp_Object last_nonmenu_event
;
3454 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3455 doc
: /* Display a message in a dialog box or in the echo area.
3456 If this command was invoked with the mouse, use a dialog box if
3457 `use-dialog-box' is non-nil.
3458 Otherwise, use the echo area.
3459 The first argument is a format control string, and the rest are data
3460 to be formatted under control of the string. See `format' for details.
3462 If the first argument is nil or the empty string, clear any existing
3463 message; let the minibuffer contents show.
3465 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3471 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3473 return Fmessage_box (nargs
, args
);
3475 return Fmessage (nargs
, args
);
3478 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3479 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3482 return current_message ();
3486 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3487 doc
: /* Return a copy of STRING with text properties added.
3488 First argument is the string to copy.
3489 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3490 properties to add to the result.
3491 usage: (propertize STRING &rest PROPERTIES) */)
3496 Lisp_Object properties
, string
;
3497 struct gcpro gcpro1
, gcpro2
;
3500 /* Number of args must be odd. */
3501 if ((nargs
& 1) == 0 || nargs
< 1)
3502 error ("Wrong number of arguments");
3504 properties
= string
= Qnil
;
3505 GCPRO2 (properties
, string
);
3507 /* First argument must be a string. */
3508 CHECK_STRING (args
[0]);
3509 string
= Fcopy_sequence (args
[0]);
3511 for (i
= 1; i
< nargs
; i
+= 2)
3512 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3514 Fadd_text_properties (make_number (0),
3515 make_number (SCHARS (string
)),
3516 properties
, string
);
3517 RETURN_UNGCPRO (string
);
3521 /* Number of bytes that STRING will occupy when put into the result.
3522 MULTIBYTE is nonzero if the result should be multibyte. */
3524 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3525 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3526 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3529 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3530 doc
: /* Format a string out of a format-string and arguments.
3531 The first argument is a format control string.
3532 The other arguments are substituted into it to make the result, a string.
3534 The format control string may contain %-sequences meaning to substitute
3535 the next available argument:
3537 %s means print a string argument. Actually, prints any object, with `princ'.
3538 %d means print as number in decimal (%o octal, %x hex).
3539 %X is like %x, but uses upper case.
3540 %e means print a number in exponential notation.
3541 %f means print a number in decimal-point notation.
3542 %g means print a number in exponential notation
3543 or decimal-point notation, whichever uses fewer characters.
3544 %c means print a number as a single character.
3545 %S means print any object as an s-expression (using `prin1').
3547 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3548 Use %% to put a single % into the output.
3550 A %-sequence may contain optional flag, width, and precision
3551 specifiers, as follows:
3553 %<flags><width><precision>character
3555 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3557 The + flag character inserts a + before any positive number, while a
3558 space inserts a space before any positive number; these flags only
3559 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3560 The # flag means to use an alternate display form for %o, %x, %X, %e,
3561 %f, and %g sequences. The - and 0 flags affect the width specifier,
3564 The width specifier supplies a lower limit for the length of the
3565 printed representation. The padding, if any, normally goes on the
3566 left, but it goes on the right if the - flag is present. The padding
3567 character is normally a space, but it is 0 if the 0 flag is present.
3568 The - flag takes precedence over the 0 flag.
3570 For %e, %f, and %g sequences, the number after the "." in the
3571 precision specifier says how many decimal places to show; if zero, the
3572 decimal point itself is omitted. For %s and %S, the precision
3573 specifier truncates the string to the given width.
3575 usage: (format STRING &rest OBJECTS) */)
3578 register Lisp_Object
*args
;
3580 register int n
; /* The number of the next arg to substitute */
3581 register int total
; /* An estimate of the final length */
3583 register unsigned char *format
, *end
, *format_start
;
3585 /* Nonzero if the output should be a multibyte string,
3586 which is true if any of the inputs is one. */
3588 /* When we make a multibyte string, we must pay attention to the
3589 byte combining problem, i.e., a byte may be combined with a
3590 multibyte charcter of the previous string. This flag tells if we
3591 must consider such a situation or not. */
3592 int maybe_combine_byte
;
3593 unsigned char *this_format
;
3594 /* Precision for each spec, or -1, a flag value meaning no precision
3595 was given in that spec. Element 0, corresonding to the format
3596 string itself, will not be used. Element NARGS, corresponding to
3597 no argument, *will* be assigned to in the case that a `%' and `.'
3598 occur after the final format specifier. */
3599 int *precision
= (int *) (alloca((nargs
+ 1) * sizeof (int)));
3602 int arg_intervals
= 0;
3605 /* discarded[I] is 1 if byte I of the format
3606 string was not copied into the output.
3607 It is 2 if byte I was not the first byte of its character. */
3608 char *discarded
= 0;
3610 /* Each element records, for one argument,
3611 the start and end bytepos in the output string,
3612 and whether the argument is a string with intervals.
3613 info[0] is unused. Unused elements have -1 for start. */
3616 int start
, end
, intervals
;
3619 /* It should not be necessary to GCPRO ARGS, because
3620 the caller in the interpreter should take care of that. */
3622 /* Try to determine whether the result should be multibyte.
3623 This is not always right; sometimes the result needs to be multibyte
3624 because of an object that we will pass through prin1,
3625 and in that case, we won't know it here. */
3626 for (n
= 0; n
< nargs
; n
++)
3628 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3630 /* Piggyback on this loop to initialize precision[N]. */
3633 precision
[nargs
] = -1;
3635 CHECK_STRING (args
[0]);
3636 /* We may have to change "%S" to "%s". */
3637 args
[0] = Fcopy_sequence (args
[0]);
3639 /* GC should never happen here, so abort if it does. */
3642 /* If we start out planning a unibyte result,
3643 then discover it has to be multibyte, we jump back to retry.
3644 That can only happen from the first large while loop below. */
3647 format
= SDATA (args
[0]);
3648 format_start
= format
;
3649 end
= format
+ SBYTES (args
[0]);
3652 /* Make room in result for all the non-%-codes in the control string. */
3653 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3655 /* Allocate the info and discarded tables. */
3657 int nbytes
= (nargs
+1) * sizeof *info
;
3660 info
= (struct info
*) alloca (nbytes
);
3661 bzero (info
, nbytes
);
3662 for (i
= 0; i
<= nargs
; i
++)
3665 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3666 bzero (discarded
, SBYTES (args
[0]));
3669 /* Add to TOTAL enough space to hold the converted arguments. */
3672 while (format
!= end
)
3673 if (*format
++ == '%')
3676 int actual_width
= 0;
3677 unsigned char *this_format_start
= format
- 1;
3678 int field_width
= 0;
3680 /* General format specifications look like
3682 '%' [flags] [field-width] [precision] format
3687 field-width ::= [0-9]+
3688 precision ::= '.' [0-9]*
3690 If a field-width is specified, it specifies to which width
3691 the output should be padded with blanks, if the output
3692 string is shorter than field-width.
3694 If precision is specified, it specifies the number of
3695 digits to print after the '.' for floats, or the max.
3696 number of chars to print from a string. */
3698 while (format
!= end
3699 && (*format
== '-' || *format
== '0' || *format
== '#'
3700 || * format
== ' ' || *format
== '+'))
3703 if (*format
>= '0' && *format
<= '9')
3705 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3706 field_width
= 10 * field_width
+ *format
- '0';
3709 /* N is not incremented for another few lines below, so refer to
3710 element N+1 (which might be precision[NARGS]). */
3714 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3715 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3718 /* Extra +1 for 'l' that we may need to insert into the
3720 if (format
- this_format_start
+ 2 > longest_format
)
3721 longest_format
= format
- this_format_start
+ 2;
3724 error ("Format string ends in middle of format specifier");
3727 else if (++n
>= nargs
)
3728 error ("Not enough arguments for format string");
3729 else if (*format
== 'S')
3731 /* For `S', prin1 the argument and then treat like a string. */
3732 register Lisp_Object tem
;
3733 tem
= Fprin1_to_string (args
[n
], Qnil
);
3734 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3740 /* If we restart the loop, we should not come here again
3741 because args[n] is now a string and calling
3742 Fprin1_to_string on it produces superflous double
3743 quotes. So, change "%S" to "%s" now. */
3747 else if (SYMBOLP (args
[n
]))
3749 args
[n
] = SYMBOL_NAME (args
[n
]);
3750 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3757 else if (STRINGP (args
[n
]))
3760 if (*format
!= 's' && *format
!= 'S')
3761 error ("Format specifier doesn't match argument type");
3762 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3763 to be as large as is calculated here. Easy check for
3764 the case PRECISION = 0. */
3765 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3766 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3768 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3769 else if (INTEGERP (args
[n
]) && *format
!= 's')
3771 /* The following loop assumes the Lisp type indicates
3772 the proper way to pass the argument.
3773 So make sure we have a flonum if the argument should
3775 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3776 args
[n
] = Ffloat (args
[n
]);
3778 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3779 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3780 error ("Invalid format operation %%%c", *format
);
3782 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3785 if (! ASCII_CHAR_P (XINT (args
[n
]))
3786 /* Note: No one can remeber why we have to treat
3787 the character 0 as a multibyte character here.
3788 But, until it causes a real problem, let's
3790 || XINT (args
[n
]) == 0)
3797 args
[n
] = Fchar_to_string (args
[n
]);
3798 thissize
= SBYTES (args
[n
]);
3800 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3803 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3804 thissize
= SBYTES (args
[n
]);
3808 else if (FLOATP (args
[n
]) && *format
!= 's')
3810 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3812 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3813 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3814 error ("Invalid format operation %%%c", *format
);
3815 /* This fails unnecessarily if args[n] is bigger than
3816 most-positive-fixnum but smaller than MAXINT.
3817 These cases are important because we sometimes use floats
3818 to represent such integer values (typically such values
3819 come from UIDs or PIDs). */
3820 /* args[n] = Ftruncate (args[n], Qnil); */
3823 /* Note that we're using sprintf to print floats,
3824 so we have to take into account what that function
3826 /* Filter out flag value of -1. */
3827 thissize
= (MAX_10_EXP
+ 100
3828 + (precision
[n
] > 0 ? precision
[n
] : 0));
3832 /* Anything but a string, convert to a string using princ. */
3833 register Lisp_Object tem
;
3834 tem
= Fprin1_to_string (args
[n
], Qt
);
3835 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3844 thissize
+= max (0, field_width
- actual_width
);
3845 total
+= thissize
+ 4;
3850 /* Now we can no longer jump to retry.
3851 TOTAL and LONGEST_FORMAT are known for certain. */
3853 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3855 /* Allocate the space for the result.
3856 Note that TOTAL is an overestimate. */
3857 SAFE_ALLOCA (buf
, char *, total
);
3863 /* Scan the format and store result in BUF. */
3864 format
= SDATA (args
[0]);
3865 format_start
= format
;
3866 end
= format
+ SBYTES (args
[0]);
3867 maybe_combine_byte
= 0;
3868 while (format
!= end
)
3874 unsigned char *this_format_start
= format
;
3876 discarded
[format
- format_start
] = 1;
3879 while (index("-+0# ", *format
))
3885 discarded
[format
- format_start
] = 1;
3889 minlen
= atoi (format
);
3891 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3893 discarded
[format
- format_start
] = 1;
3897 if (*format
++ == '%')
3906 discarded
[format
- format_start
- 1] = 1;
3907 info
[n
].start
= nchars
;
3909 if (STRINGP (args
[n
]))
3911 /* handle case (precision[n] >= 0) */
3914 int nbytes
, start
, end
;
3917 /* lisp_string_width ignores a precision of 0, but GNU
3918 libc functions print 0 characters when the precision
3919 is 0. Imitate libc behavior here. Changing
3920 lisp_string_width is the right thing, and will be
3921 done, but meanwhile we work with it. */
3923 if (precision
[n
] == 0)
3924 width
= nchars_string
= nbytes
= 0;
3925 else if (precision
[n
] > 0)
3926 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3928 { /* no precision spec given for this argument */
3929 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3930 nbytes
= SBYTES (args
[n
]);
3931 nchars_string
= SCHARS (args
[n
]);
3934 /* If spec requires it, pad on right with spaces. */
3935 padding
= minlen
- width
;
3937 while (padding
-- > 0)
3943 info
[n
].start
= start
= nchars
;
3944 nchars
+= nchars_string
;
3949 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3950 && STRING_MULTIBYTE (args
[n
])
3951 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3952 maybe_combine_byte
= 1;
3954 p
+= copy_text (SDATA (args
[n
]), p
,
3956 STRING_MULTIBYTE (args
[n
]), multibyte
);
3958 info
[n
].end
= nchars
;
3961 while (padding
-- > 0)
3967 /* If this argument has text properties, record where
3968 in the result string it appears. */
3969 if (STRING_INTERVALS (args
[n
]))
3970 info
[n
].intervals
= arg_intervals
= 1;
3972 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3976 bcopy (this_format_start
, this_format
,
3977 format
- this_format_start
);
3978 this_format
[format
- this_format_start
] = 0;
3980 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
3981 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3984 if (sizeof (EMACS_INT
) > sizeof (int)
3985 && format
[-1] != 'c')
3987 /* Insert 'l' before format spec. */
3988 this_format
[format
- this_format_start
]
3989 = this_format
[format
- this_format_start
- 1];
3990 this_format
[format
- this_format_start
- 1] = 'l';
3991 this_format
[format
- this_format_start
+ 1] = 0;
3994 if (INTEGERP (args
[n
]))
3996 if (format
[-1] == 'c')
3997 sprintf (p
, this_format
, (int) XINT (args
[n
]));
3998 else if (format
[-1] == 'd')
3999 sprintf (p
, this_format
, XINT (args
[n
]));
4000 /* Don't sign-extend for octal or hex printing. */
4002 sprintf (p
, this_format
, XUINT (args
[n
]));
4004 else if (format
[-1] == 'c')
4005 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
4006 else if (format
[-1] == 'd')
4007 /* Maybe we should use "%1.0f" instead so it also works
4008 for values larger than MAXINT. */
4009 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
4011 /* Don't sign-extend for octal or hex printing. */
4012 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
4017 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4018 && !CHAR_HEAD_P (*((unsigned char *) p
)))
4019 maybe_combine_byte
= 1;
4020 this_nchars
= strlen (p
);
4022 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
4025 nchars
+= this_nchars
;
4026 info
[n
].end
= nchars
;
4030 else if (STRING_MULTIBYTE (args
[0]))
4032 /* Copy a whole multibyte character. */
4035 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4036 && !CHAR_HEAD_P (*format
))
4037 maybe_combine_byte
= 1;
4039 while (! CHAR_HEAD_P (*format
))
4041 discarded
[format
- format_start
] = 2;
4048 /* Convert a single-byte character to multibyte. */
4049 int len
= copy_text (format
, p
, 1, 0, 1);
4056 *p
++ = *format
++, nchars
++;
4059 if (p
> buf
+ total
)
4062 if (maybe_combine_byte
)
4063 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
4064 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4066 /* If we allocated BUF with malloc, free it too. */
4069 /* If the format string has text properties, or any of the string
4070 arguments has text properties, set up text properties of the
4073 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4075 Lisp_Object len
, new_len
, props
;
4076 struct gcpro gcpro1
;
4078 /* Add text properties from the format string. */
4079 len
= make_number (SCHARS (args
[0]));
4080 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4085 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4088 /* Adjust the bounds of each text property
4089 to the proper start and end in the output string. */
4091 /* Put the positions in PROPS in increasing order, so that
4092 we can do (effectively) one scan through the position
4093 space of the format string. */
4094 props
= Fnreverse (props
);
4096 /* BYTEPOS is the byte position in the format string,
4097 POSITION is the untranslated char position in it,
4098 TRANSLATED is the translated char position in BUF,
4099 and ARGN is the number of the next arg we will come to. */
4100 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4107 /* First adjust the property start position. */
4108 pos
= XINT (XCAR (item
));
4110 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4111 up to this position. */
4112 for (; position
< pos
; bytepos
++)
4114 if (! discarded
[bytepos
])
4115 position
++, translated
++;
4116 else if (discarded
[bytepos
] == 1)
4119 if (translated
== info
[argn
].start
)
4121 translated
+= info
[argn
].end
- info
[argn
].start
;
4127 XSETCAR (item
, make_number (translated
));
4129 /* Likewise adjust the property end position. */
4130 pos
= XINT (XCAR (XCDR (item
)));
4132 for (; position
< pos
; bytepos
++)
4134 if (! discarded
[bytepos
])
4135 position
++, translated
++;
4136 else if (discarded
[bytepos
] == 1)
4139 if (translated
== info
[argn
].start
)
4141 translated
+= info
[argn
].end
- info
[argn
].start
;
4147 XSETCAR (XCDR (item
), make_number (translated
));
4150 add_text_properties_from_list (val
, props
, make_number (0));
4153 /* Add text properties from arguments. */
4155 for (n
= 1; n
< nargs
; ++n
)
4156 if (info
[n
].intervals
)
4158 len
= make_number (SCHARS (args
[n
]));
4159 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4160 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4161 extend_property_ranges (props
, len
, new_len
);
4162 /* If successive arguments have properites, be sure that
4163 the value of `composition' property be the copy. */
4164 if (n
> 1 && info
[n
- 1].end
)
4165 make_composition_value_copy (props
);
4166 add_text_properties_from_list (val
, props
,
4167 make_number (info
[n
].start
));
4177 format2 (string1
, arg0
, arg1
)
4179 Lisp_Object arg0
, arg1
;
4181 Lisp_Object args
[3];
4182 args
[0] = build_string (string1
);
4185 return Fformat (3, args
);
4188 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4189 doc
: /* Return t if two characters match, optionally ignoring case.
4190 Both arguments must be characters (i.e. integers).
4191 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4193 register Lisp_Object c1
, c2
;
4196 /* Check they're chars, not just integers, otherwise we could get array
4197 bounds violations in DOWNCASE. */
4198 CHECK_CHARACTER (c1
);
4199 CHECK_CHARACTER (c2
);
4201 if (XINT (c1
) == XINT (c2
))
4203 if (NILP (current_buffer
->case_fold_search
))
4206 /* Do these in separate statements,
4207 then compare the variables.
4208 because of the way DOWNCASE uses temp variables. */
4210 if (NILP (current_buffer
->enable_multibyte_characters
)
4211 && ! ASCII_CHAR_P (i1
))
4213 MAKE_CHAR_MULTIBYTE (i1
);
4216 if (NILP (current_buffer
->enable_multibyte_characters
)
4217 && ! ASCII_CHAR_P (i2
))
4219 MAKE_CHAR_MULTIBYTE (i2
);
4223 return (i1
== i2
? Qt
: Qnil
);
4226 /* Transpose the markers in two regions of the current buffer, and
4227 adjust the ones between them if necessary (i.e.: if the regions
4230 START1, END1 are the character positions of the first region.
4231 START1_BYTE, END1_BYTE are the byte positions.
4232 START2, END2 are the character positions of the second region.
4233 START2_BYTE, END2_BYTE are the byte positions.
4235 Traverses the entire marker list of the buffer to do so, adding an
4236 appropriate amount to some, subtracting from some, and leaving the
4237 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4239 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4242 transpose_markers (start1
, end1
, start2
, end2
,
4243 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
4244 register int start1
, end1
, start2
, end2
;
4245 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
4247 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4248 register struct Lisp_Marker
*marker
;
4250 /* Update point as if it were a marker. */
4254 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4255 PT_BYTE
+ (end2_byte
- end1_byte
));
4256 else if (PT
< start2
)
4257 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4258 (PT_BYTE
+ (end2_byte
- start2_byte
)
4259 - (end1_byte
- start1_byte
)));
4261 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4262 PT_BYTE
- (start2_byte
- start1_byte
));
4264 /* We used to adjust the endpoints here to account for the gap, but that
4265 isn't good enough. Even if we assume the caller has tried to move the
4266 gap out of our way, it might still be at start1 exactly, for example;
4267 and that places it `inside' the interval, for our purposes. The amount
4268 of adjustment is nontrivial if there's a `denormalized' marker whose
4269 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4270 the dirty work to Fmarker_position, below. */
4272 /* The difference between the region's lengths */
4273 diff
= (end2
- start2
) - (end1
- start1
);
4274 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4276 /* For shifting each marker in a region by the length of the other
4277 region plus the distance between the regions. */
4278 amt1
= (end2
- start2
) + (start2
- end1
);
4279 amt2
= (end1
- start1
) + (start2
- end1
);
4280 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4281 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4283 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4285 mpos
= marker
->bytepos
;
4286 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4288 if (mpos
< end1_byte
)
4290 else if (mpos
< start2_byte
)
4294 marker
->bytepos
= mpos
;
4296 mpos
= marker
->charpos
;
4297 if (mpos
>= start1
&& mpos
< end2
)
4301 else if (mpos
< start2
)
4306 marker
->charpos
= mpos
;
4310 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4311 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4312 The regions should not be overlapping, because the size of the buffer is
4313 never changed in a transposition.
4315 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4316 any markers that happen to be located in the regions.
4318 Transposing beyond buffer boundaries is an error. */)
4319 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
4320 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
4322 register EMACS_INT start1
, end1
, start2
, end2
;
4323 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4324 EMACS_INT gap
, len1
, len_mid
, len2
;
4325 unsigned char *start1_addr
, *start2_addr
, *temp
;
4327 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4330 XSETBUFFER (buf
, current_buffer
);
4331 cur_intv
= BUF_INTERVALS (current_buffer
);
4333 validate_region (&startr1
, &endr1
);
4334 validate_region (&startr2
, &endr2
);
4336 start1
= XFASTINT (startr1
);
4337 end1
= XFASTINT (endr1
);
4338 start2
= XFASTINT (startr2
);
4339 end2
= XFASTINT (endr2
);
4342 /* Swap the regions if they're reversed. */
4345 register int glumph
= start1
;
4353 len1
= end1
- start1
;
4354 len2
= end2
- start2
;
4357 error ("Transposed regions overlap");
4358 else if (start1
== end1
|| start2
== end2
)
4359 error ("Transposed region has length 0");
4361 /* The possibilities are:
4362 1. Adjacent (contiguous) regions, or separate but equal regions
4363 (no, really equal, in this case!), or
4364 2. Separate regions of unequal size.
4366 The worst case is usually No. 2. It means that (aside from
4367 potential need for getting the gap out of the way), there also
4368 needs to be a shifting of the text between the two regions. So
4369 if they are spread far apart, we are that much slower... sigh. */
4371 /* It must be pointed out that the really studly thing to do would
4372 be not to move the gap at all, but to leave it in place and work
4373 around it if necessary. This would be extremely efficient,
4374 especially considering that people are likely to do
4375 transpositions near where they are working interactively, which
4376 is exactly where the gap would be found. However, such code
4377 would be much harder to write and to read. So, if you are
4378 reading this comment and are feeling squirrely, by all means have
4379 a go! I just didn't feel like doing it, so I will simply move
4380 the gap the minimum distance to get it out of the way, and then
4381 deal with an unbroken array. */
4383 /* Make sure the gap won't interfere, by moving it out of the text
4384 we will operate on. */
4385 if (start1
< gap
&& gap
< end2
)
4387 if (gap
- start1
< end2
- gap
)
4393 start1_byte
= CHAR_TO_BYTE (start1
);
4394 start2_byte
= CHAR_TO_BYTE (start2
);
4395 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4396 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4398 #ifdef BYTE_COMBINING_DEBUG
4401 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4402 len2_byte
, start1
, start1_byte
)
4403 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4404 len1_byte
, end2
, start2_byte
+ len2_byte
)
4405 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4406 len1_byte
, end2
, start2_byte
+ len2_byte
))
4411 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4412 len2_byte
, start1
, start1_byte
)
4413 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4414 len1_byte
, start2
, start2_byte
)
4415 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4416 len2_byte
, end1
, start1_byte
+ len1_byte
)
4417 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4418 len1_byte
, end2
, start2_byte
+ len2_byte
))
4423 /* Hmmm... how about checking to see if the gap is large
4424 enough to use as the temporary storage? That would avoid an
4425 allocation... interesting. Later, don't fool with it now. */
4427 /* Working without memmove, for portability (sigh), so must be
4428 careful of overlapping subsections of the array... */
4430 if (end1
== start2
) /* adjacent regions */
4432 modify_region (current_buffer
, start1
, end2
, 0);
4433 record_change (start1
, len1
+ len2
);
4435 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4436 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4437 /* Don't use Fset_text_properties: that can cause GC, which can
4438 clobber objects stored in the tmp_intervals. */
4439 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4440 if (!NULL_INTERVAL_P (tmp_interval3
))
4441 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4443 /* First region smaller than second. */
4444 if (len1_byte
< len2_byte
)
4448 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4450 /* Don't precompute these addresses. We have to compute them
4451 at the last minute, because the relocating allocator might
4452 have moved the buffer around during the xmalloc. */
4453 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4454 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4456 bcopy (start2_addr
, temp
, len2_byte
);
4457 bcopy (start1_addr
, start1_addr
+ len2_byte
, len1_byte
);
4458 bcopy (temp
, start1_addr
, len2_byte
);
4462 /* First region not smaller than second. */
4466 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4467 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4468 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4469 bcopy (start1_addr
, temp
, len1_byte
);
4470 bcopy (start2_addr
, start1_addr
, len2_byte
);
4471 bcopy (temp
, start1_addr
+ len2_byte
, len1_byte
);
4474 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4475 len1
, current_buffer
, 0);
4476 graft_intervals_into_buffer (tmp_interval2
, start1
,
4477 len2
, current_buffer
, 0);
4478 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4479 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4481 /* Non-adjacent regions, because end1 != start2, bleagh... */
4484 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4486 if (len1_byte
== len2_byte
)
4487 /* Regions are same size, though, how nice. */
4491 modify_region (current_buffer
, start1
, end1
, 0);
4492 modify_region (current_buffer
, start2
, end2
, 0);
4493 record_change (start1
, len1
);
4494 record_change (start2
, len2
);
4495 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4496 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4498 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4499 if (!NULL_INTERVAL_P (tmp_interval3
))
4500 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4502 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4503 if (!NULL_INTERVAL_P (tmp_interval3
))
4504 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4506 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4507 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4508 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4509 bcopy (start1_addr
, temp
, len1_byte
);
4510 bcopy (start2_addr
, start1_addr
, len2_byte
);
4511 bcopy (temp
, start2_addr
, len1_byte
);
4514 graft_intervals_into_buffer (tmp_interval1
, start2
,
4515 len1
, current_buffer
, 0);
4516 graft_intervals_into_buffer (tmp_interval2
, start1
,
4517 len2
, current_buffer
, 0);
4520 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4521 /* Non-adjacent & unequal size, area between must also be shifted. */
4525 modify_region (current_buffer
, start1
, end2
, 0);
4526 record_change (start1
, (end2
- start1
));
4527 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4528 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4529 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4531 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4532 if (!NULL_INTERVAL_P (tmp_interval3
))
4533 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4535 /* holds region 2 */
4536 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4537 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4538 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4539 bcopy (start2_addr
, temp
, len2_byte
);
4540 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2_byte
, len1_byte
);
4541 safe_bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4542 bcopy (temp
, start1_addr
, len2_byte
);
4545 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4546 len1
, current_buffer
, 0);
4547 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4548 len_mid
, current_buffer
, 0);
4549 graft_intervals_into_buffer (tmp_interval2
, start1
,
4550 len2
, current_buffer
, 0);
4553 /* Second region smaller than first. */
4557 record_change (start1
, (end2
- start1
));
4558 modify_region (current_buffer
, start1
, end2
, 0);
4560 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4561 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4562 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4564 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4565 if (!NULL_INTERVAL_P (tmp_interval3
))
4566 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4568 /* holds region 1 */
4569 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4570 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4571 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4572 bcopy (start1_addr
, temp
, len1_byte
);
4573 bcopy (start2_addr
, start1_addr
, len2_byte
);
4574 bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4575 bcopy (temp
, start1_addr
+ len2_byte
+ len_mid
, len1_byte
);
4578 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4579 len1
, current_buffer
, 0);
4580 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4581 len_mid
, current_buffer
, 0);
4582 graft_intervals_into_buffer (tmp_interval2
, start1
,
4583 len2
, current_buffer
, 0);
4586 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4587 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4590 /* When doing multiple transpositions, it might be nice
4591 to optimize this. Perhaps the markers in any one buffer
4592 should be organized in some sorted data tree. */
4593 if (NILP (leave_markers
))
4595 transpose_markers (start1
, end1
, start2
, end2
,
4596 start1_byte
, start1_byte
+ len1_byte
,
4597 start2_byte
, start2_byte
+ len2_byte
);
4598 fix_start_end_in_overlays (start1
, end2
);
4601 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4612 Qbuffer_access_fontify_functions
4613 = intern ("buffer-access-fontify-functions");
4614 staticpro (&Qbuffer_access_fontify_functions
);
4616 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4617 doc
: /* Non-nil means text motion commands don't notice fields. */);
4618 Vinhibit_field_text_motion
= Qnil
;
4620 DEFVAR_LISP ("buffer-access-fontify-functions",
4621 &Vbuffer_access_fontify_functions
,
4622 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4623 Each function is called with two arguments which specify the range
4624 of the buffer being accessed. */);
4625 Vbuffer_access_fontify_functions
= Qnil
;
4629 extern Lisp_Object Vprin1_to_string_buffer
;
4630 obuf
= Fcurrent_buffer ();
4631 /* Do this here, because init_buffer_once is too early--it won't work. */
4632 Fset_buffer (Vprin1_to_string_buffer
);
4633 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4634 Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
4639 DEFVAR_LISP ("buffer-access-fontified-property",
4640 &Vbuffer_access_fontified_property
,
4641 doc
: /* Property which (if non-nil) indicates text has been fontified.
4642 `buffer-substring' need not call the `buffer-access-fontify-functions'
4643 functions if all the text being accessed has this property. */);
4644 Vbuffer_access_fontified_property
= Qnil
;
4646 DEFVAR_LISP ("system-name", &Vsystem_name
,
4647 doc
: /* The host name of the machine Emacs is running on. */);
4649 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4650 doc
: /* The full name of the user logged in. */);
4652 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4653 doc
: /* The user's name, taken from environment variables if possible. */);
4655 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4656 doc
: /* The user's name, based upon the real uid only. */);
4658 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4659 doc
: /* The release of the operating system Emacs is running on. */);
4661 defsubr (&Spropertize
);
4662 defsubr (&Schar_equal
);
4663 defsubr (&Sgoto_char
);
4664 defsubr (&Sstring_to_char
);
4665 defsubr (&Schar_to_string
);
4666 defsubr (&Sbuffer_substring
);
4667 defsubr (&Sbuffer_substring_no_properties
);
4668 defsubr (&Sbuffer_string
);
4670 defsubr (&Spoint_marker
);
4671 defsubr (&Smark_marker
);
4673 defsubr (&Sregion_beginning
);
4674 defsubr (&Sregion_end
);
4676 staticpro (&Qfield
);
4677 Qfield
= intern ("field");
4678 staticpro (&Qboundary
);
4679 Qboundary
= intern ("boundary");
4680 defsubr (&Sfield_beginning
);
4681 defsubr (&Sfield_end
);
4682 defsubr (&Sfield_string
);
4683 defsubr (&Sfield_string_no_properties
);
4684 defsubr (&Sdelete_field
);
4685 defsubr (&Sconstrain_to_field
);
4687 defsubr (&Sline_beginning_position
);
4688 defsubr (&Sline_end_position
);
4690 /* defsubr (&Smark); */
4691 /* defsubr (&Sset_mark); */
4692 defsubr (&Ssave_excursion
);
4693 defsubr (&Ssave_current_buffer
);
4695 defsubr (&Sbufsize
);
4696 defsubr (&Spoint_max
);
4697 defsubr (&Spoint_min
);
4698 defsubr (&Spoint_min_marker
);
4699 defsubr (&Spoint_max_marker
);
4700 defsubr (&Sgap_position
);
4701 defsubr (&Sgap_size
);
4702 defsubr (&Sposition_bytes
);
4703 defsubr (&Sbyte_to_position
);
4709 defsubr (&Sfollowing_char
);
4710 defsubr (&Sprevious_char
);
4711 defsubr (&Schar_after
);
4712 defsubr (&Schar_before
);
4714 defsubr (&Sinsert_before_markers
);
4715 defsubr (&Sinsert_and_inherit
);
4716 defsubr (&Sinsert_and_inherit_before_markers
);
4717 defsubr (&Sinsert_char
);
4718 defsubr (&Sinsert_byte
);
4720 defsubr (&Suser_login_name
);
4721 defsubr (&Suser_real_login_name
);
4722 defsubr (&Suser_uid
);
4723 defsubr (&Suser_real_uid
);
4724 defsubr (&Suser_full_name
);
4725 defsubr (&Semacs_pid
);
4726 defsubr (&Scurrent_time
);
4727 defsubr (&Sget_internal_run_time
);
4728 defsubr (&Sformat_time_string
);
4729 defsubr (&Sfloat_time
);
4730 defsubr (&Sdecode_time
);
4731 defsubr (&Sencode_time
);
4732 defsubr (&Scurrent_time_string
);
4733 defsubr (&Scurrent_time_zone
);
4734 defsubr (&Sset_time_zone_rule
);
4735 defsubr (&Ssystem_name
);
4736 defsubr (&Smessage
);
4737 defsubr (&Smessage_box
);
4738 defsubr (&Smessage_or_box
);
4739 defsubr (&Scurrent_message
);
4742 defsubr (&Sinsert_buffer_substring
);
4743 defsubr (&Scompare_buffer_substrings
);
4744 defsubr (&Ssubst_char_in_region
);
4745 defsubr (&Stranslate_region_internal
);
4746 defsubr (&Sdelete_region
);
4747 defsubr (&Sdelete_and_extract_region
);
4749 defsubr (&Snarrow_to_region
);
4750 defsubr (&Ssave_restriction
);
4751 defsubr (&Stranspose_regions
);
4754 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4755 (do not change this comment) */