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>
35 #ifdef HAVE_SYS_UTSNAME_H
36 #include <sys/utsname.h>
41 /* systime.h includes <sys/time.h> which, on some systems, is required
42 for <sys/resource.h>; thus systime.h must be included before
46 #if defined HAVE_SYS_RESOURCE_H
47 #include <sys/resource.h>
52 #include "intervals.h"
54 #include "character.h"
58 #include "blockinput.h"
62 #define MAX_10_EXP DBL_MAX_10_EXP
64 #define MAX_10_EXP 310
71 #ifndef USER_FULL_NAME
72 #define USER_FULL_NAME pw->pw_gecos
76 extern char **environ
;
79 #define TM_YEAR_BASE 1900
81 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
82 asctime to have well-defined behavior. */
83 #ifndef TM_YEAR_IN_ASCTIME_RANGE
84 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
85 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
88 extern size_t emacs_strftimeu
P_ ((char *, size_t, const char *,
89 const struct tm
*, int));
92 extern Lisp_Object
w32_get_internal_run_time ();
95 static int tm_diff
P_ ((struct tm
*, struct tm
*));
96 static void find_field
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *));
97 static void update_buffer_properties
P_ ((int, int));
98 static Lisp_Object region_limit
P_ ((int));
99 int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
100 static size_t emacs_memftimeu
P_ ((char *, size_t, const char *,
101 size_t, const struct tm
*, int));
102 static void general_insert_function (void (*) (const unsigned char *, EMACS_INT
),
103 void (*) (Lisp_Object
, EMACS_INT
,
104 EMACS_INT
, EMACS_INT
,
106 int, int, Lisp_Object
*);
107 static Lisp_Object subst_char_in_region_unwind
P_ ((Lisp_Object
));
108 static Lisp_Object subst_char_in_region_unwind_1
P_ ((Lisp_Object
));
109 static void transpose_markers
P_ ((int, int, int, int, int, int, int, int));
112 extern char *index
P_ ((const char *, int));
115 Lisp_Object Vbuffer_access_fontify_functions
;
116 Lisp_Object Qbuffer_access_fontify_functions
;
117 Lisp_Object Vbuffer_access_fontified_property
;
119 Lisp_Object Fuser_full_name
P_ ((Lisp_Object
));
121 /* Non-nil means don't stop at field boundary in text motion commands. */
123 Lisp_Object Vinhibit_field_text_motion
;
125 /* Some static data, and a function to initialize it for each run */
127 Lisp_Object Vsystem_name
;
128 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
129 Lisp_Object Vuser_full_name
; /* full name of current user */
130 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
131 Lisp_Object Voperating_system_release
; /* Operating System Release */
133 /* Symbol for the text property used to mark fields. */
137 /* A special value for Qfield properties. */
139 Lisp_Object Qboundary
;
146 register unsigned char *p
;
147 struct passwd
*pw
; /* password entry for the current user */
150 /* Set up system_name even when dumping. */
154 /* Don't bother with this on initial start when just dumping out */
157 #endif /* not CANNOT_DUMP */
159 pw
= (struct passwd
*) getpwuid (getuid ());
161 /* We let the real user name default to "root" because that's quite
162 accurate on MSDOG and because it lets Emacs find the init file.
163 (The DVX libraries override the Djgpp libraries here.) */
164 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
166 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
169 /* Get the effective user name, by consulting environment variables,
170 or the effective uid if those are unset. */
171 user_name
= (char *) getenv ("LOGNAME");
174 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
175 #else /* WINDOWSNT */
176 user_name
= (char *) getenv ("USER");
177 #endif /* WINDOWSNT */
180 pw
= (struct passwd
*) getpwuid (geteuid ());
181 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
183 Vuser_login_name
= build_string (user_name
);
185 /* If the user name claimed in the environment vars differs from
186 the real uid, use the claimed name to find the full name. */
187 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
188 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
191 p
= (unsigned char *) getenv ("NAME");
193 Vuser_full_name
= build_string (p
);
194 else if (NILP (Vuser_full_name
))
195 Vuser_full_name
= build_string ("unknown");
197 #ifdef HAVE_SYS_UTSNAME_H
201 Voperating_system_release
= build_string (uts
.release
);
204 Voperating_system_release
= Qnil
;
208 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
209 doc
: /* Convert arg CHAR to a string containing that character.
210 usage: (char-to-string CHAR) */)
212 Lisp_Object character
;
215 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
217 CHECK_CHARACTER (character
);
219 len
= CHAR_STRING (XFASTINT (character
), str
);
220 return make_string_from_bytes (str
, 1, len
);
223 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
224 doc
: /* Convert arg STRING to a character, the first character of that string.
225 A multibyte character is handled correctly. */)
227 register Lisp_Object string
;
229 register Lisp_Object val
;
230 CHECK_STRING (string
);
233 if (STRING_MULTIBYTE (string
))
234 XSETFASTINT (val
, STRING_CHAR (SDATA (string
), SBYTES (string
)));
236 XSETFASTINT (val
, SREF (string
, 0));
239 XSETFASTINT (val
, 0);
244 buildmark (charpos
, bytepos
)
245 int charpos
, bytepos
;
247 register Lisp_Object mark
;
248 mark
= Fmake_marker ();
249 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
253 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
254 doc
: /* Return value of point, as an integer.
255 Beginning of buffer is position (point-min). */)
259 XSETFASTINT (temp
, PT
);
263 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
264 doc
: /* Return value of point, as a marker object. */)
267 return buildmark (PT
, PT_BYTE
);
271 clip_to_bounds (lower
, num
, upper
)
272 int lower
, num
, upper
;
276 else if (num
> upper
)
282 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
283 doc
: /* Set point to POSITION, a number or marker.
284 Beginning of buffer is position (point-min), end is (point-max).
286 The return value is POSITION. */)
288 register Lisp_Object position
;
292 if (MARKERP (position
)
293 && current_buffer
== XMARKER (position
)->buffer
)
295 pos
= marker_position (position
);
297 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
299 SET_PT_BOTH (ZV
, ZV_BYTE
);
301 SET_PT_BOTH (pos
, marker_byte_position (position
));
306 CHECK_NUMBER_COERCE_MARKER (position
);
308 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
314 /* Return the start or end position of the region.
315 BEGINNINGP non-zero means return the start.
316 If there is no region active, signal an error. */
319 region_limit (beginningp
)
322 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
325 if (!NILP (Vtransient_mark_mode
)
326 && NILP (Vmark_even_if_inactive
)
327 && NILP (current_buffer
->mark_active
))
328 xsignal0 (Qmark_inactive
);
330 m
= Fmarker_position (current_buffer
->mark
);
332 error ("The mark is not set now, so there is no region");
334 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
335 m
= make_number (PT
);
339 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
340 doc
: /* Return position of beginning of region, as an integer. */)
343 return region_limit (1);
346 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
347 doc
: /* Return position of end of region, as an integer. */)
350 return region_limit (0);
353 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
354 doc
: /* Return this buffer's mark, as a marker object.
355 Watch out! Moving this marker changes the mark position.
356 If you set the marker not to point anywhere, the buffer will have no mark. */)
359 return current_buffer
->mark
;
363 /* Find all the overlays in the current buffer that touch position POS.
364 Return the number found, and store them in a vector in VEC
368 overlays_around (pos
, vec
, len
)
373 Lisp_Object overlay
, start
, end
;
374 struct Lisp_Overlay
*tail
;
375 int startpos
, endpos
;
378 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
380 XSETMISC (overlay
, tail
);
382 end
= OVERLAY_END (overlay
);
383 endpos
= OVERLAY_POSITION (end
);
386 start
= OVERLAY_START (overlay
);
387 startpos
= OVERLAY_POSITION (start
);
392 /* Keep counting overlays even if we can't return them all. */
397 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
399 XSETMISC (overlay
, tail
);
401 start
= OVERLAY_START (overlay
);
402 startpos
= OVERLAY_POSITION (start
);
405 end
= OVERLAY_END (overlay
);
406 endpos
= OVERLAY_POSITION (end
);
418 /* Return the value of property PROP, in OBJECT at POSITION.
419 It's the value of PROP that a char inserted at POSITION would get.
420 OBJECT is optional and defaults to the current buffer.
421 If OBJECT is a buffer, then overlay properties are considered as well as
423 If OBJECT is a window, then that window's buffer is used, but
424 window-specific overlays are considered only if they are associated
427 get_pos_property (position
, prop
, object
)
428 Lisp_Object position
, object
;
429 register Lisp_Object prop
;
431 CHECK_NUMBER_COERCE_MARKER (position
);
434 XSETBUFFER (object
, current_buffer
);
435 else if (WINDOWP (object
))
436 object
= XWINDOW (object
)->buffer
;
438 if (!BUFFERP (object
))
439 /* pos-property only makes sense in buffers right now, since strings
440 have no overlays and no notion of insertion for which stickiness
442 return Fget_text_property (position
, prop
, object
);
445 int posn
= XINT (position
);
447 Lisp_Object
*overlay_vec
, tem
;
448 struct buffer
*obuf
= current_buffer
;
450 set_buffer_temp (XBUFFER (object
));
452 /* First try with room for 40 overlays. */
454 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
455 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
457 /* If there are more than 40,
458 make enough space for all, and try again. */
461 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
462 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
464 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
466 set_buffer_temp (obuf
);
468 /* Now check the overlays in order of decreasing priority. */
469 while (--noverlays
>= 0)
471 Lisp_Object ol
= overlay_vec
[noverlays
];
472 tem
= Foverlay_get (ol
, prop
);
475 /* Check the overlay is indeed active at point. */
476 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
477 if ((OVERLAY_POSITION (start
) == posn
478 && XMARKER (start
)->insertion_type
== 1)
479 || (OVERLAY_POSITION (finish
) == posn
480 && XMARKER (finish
)->insertion_type
== 0))
481 ; /* The overlay will not cover a char inserted at point. */
489 { /* Now check the text properties. */
490 int stickiness
= text_property_stickiness (prop
, position
, object
);
492 return Fget_text_property (position
, prop
, object
);
493 else if (stickiness
< 0
494 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
495 return Fget_text_property (make_number (XINT (position
) - 1),
503 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
504 the value of point is used instead. If BEG or END is null,
505 means don't store the beginning or end of the field.
507 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
508 results; they do not effect boundary behavior.
510 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
511 position of a field, then the beginning of the previous field is
512 returned instead of the beginning of POS's field (since the end of a
513 field is actually also the beginning of the next input field, this
514 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
515 true case, if two fields are separated by a field with the special
516 value `boundary', and POS lies within it, then the two separated
517 fields are considered to be adjacent, and POS between them, when
518 finding the beginning and ending of the "merged" field.
520 Either BEG or END may be 0, in which case the corresponding value
524 find_field (pos
, merge_at_boundary
, beg_limit
, beg
, end_limit
, end
)
526 Lisp_Object merge_at_boundary
;
527 Lisp_Object beg_limit
, end_limit
;
530 /* Fields right before and after the point. */
531 Lisp_Object before_field
, after_field
;
532 /* 1 if POS counts as the start of a field. */
533 int at_field_start
= 0;
534 /* 1 if POS counts as the end of a field. */
535 int at_field_end
= 0;
538 XSETFASTINT (pos
, PT
);
540 CHECK_NUMBER_COERCE_MARKER (pos
);
543 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
545 = (XFASTINT (pos
) > BEGV
546 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
548 /* Using nil here would be a more obvious choice, but it would
549 fail when the buffer starts with a non-sticky field. */
552 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
553 and POS is at beginning of a field, which can also be interpreted
554 as the end of the previous field. Note that the case where if
555 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
556 more natural one; then we avoid treating the beginning of a field
558 if (NILP (merge_at_boundary
))
560 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
561 if (!EQ (field
, after_field
))
563 if (!EQ (field
, before_field
))
565 if (NILP (field
) && at_field_start
&& at_field_end
)
566 /* If an inserted char would have a nil field while the surrounding
567 text is non-nil, we're probably not looking at a
568 zero-length field, but instead at a non-nil field that's
569 not intended for editing (such as comint's prompts). */
570 at_field_end
= at_field_start
= 0;
573 /* Note about special `boundary' fields:
575 Consider the case where the point (`.') is between the fields `x' and `y':
579 In this situation, if merge_at_boundary is true, we consider the
580 `x' and `y' fields as forming one big merged field, and so the end
581 of the field is the end of `y'.
583 However, if `x' and `y' are separated by a special `boundary' field
584 (a field with a `field' char-property of 'boundary), then we ignore
585 this special field when merging adjacent fields. Here's the same
586 situation, but with a `boundary' field between the `x' and `y' fields:
590 Here, if point is at the end of `x', the beginning of `y', or
591 anywhere in-between (within the `boundary' field), we merge all
592 three fields and consider the beginning as being the beginning of
593 the `x' field, and the end as being the end of the `y' field. */
598 /* POS is at the edge of a field, and we should consider it as
599 the beginning of the following field. */
600 *beg
= XFASTINT (pos
);
602 /* Find the previous field boundary. */
605 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
606 /* Skip a `boundary' field. */
607 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
610 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
612 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
619 /* POS is at the edge of a field, and we should consider it as
620 the end of the previous field. */
621 *end
= XFASTINT (pos
);
623 /* Find the next field boundary. */
625 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
626 /* Skip a `boundary' field. */
627 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
630 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
632 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
638 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
639 doc
: /* Delete the field surrounding POS.
640 A field is a region of text with the same `field' property.
641 If POS is nil, the value of point is used for POS. */)
646 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
648 del_range (beg
, end
);
652 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
653 doc
: /* Return the contents of the field surrounding POS as a string.
654 A field is a region of text with the same `field' property.
655 If POS is nil, the value of point is used for POS. */)
660 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
661 return make_buffer_string (beg
, end
, 1);
664 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
665 doc
: /* Return the contents of the field around POS, without text properties.
666 A field is a region of text with the same `field' property.
667 If POS is nil, the value of point is used for POS. */)
672 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
673 return make_buffer_string (beg
, end
, 0);
676 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
677 doc
: /* Return the beginning of the field surrounding POS.
678 A field is a region of text with the same `field' property.
679 If POS is nil, the value of point is used for POS.
680 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
681 field, then the beginning of the *previous* field is returned.
682 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
683 is before LIMIT, then LIMIT will be returned instead. */)
684 (pos
, escape_from_edge
, limit
)
685 Lisp_Object pos
, escape_from_edge
, limit
;
688 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
689 return make_number (beg
);
692 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
693 doc
: /* Return the end of the field surrounding POS.
694 A field is a region of text with the same `field' property.
695 If POS is nil, the value of point is used for POS.
696 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
697 then the end of the *following* field is returned.
698 If LIMIT is non-nil, it is a buffer position; if the end of the field
699 is after LIMIT, then LIMIT will be returned instead. */)
700 (pos
, escape_from_edge
, limit
)
701 Lisp_Object pos
, escape_from_edge
, limit
;
704 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
705 return make_number (end
);
708 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
709 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
711 A field is a region of text with the same `field' property.
712 If NEW-POS is nil, then the current point is used instead, and set to the
713 constrained position if that is different.
715 If OLD-POS is at the boundary of two fields, then the allowable
716 positions for NEW-POS depends on the value of the optional argument
717 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
718 constrained to the field that has the same `field' char-property
719 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
720 is non-nil, NEW-POS is constrained to the union of the two adjacent
721 fields. Additionally, if two fields are separated by another field with
722 the special value `boundary', then any point within this special field is
723 also considered to be `on the boundary'.
725 If the optional argument ONLY-IN-LINE is non-nil and constraining
726 NEW-POS would move it to a different line, NEW-POS is returned
727 unconstrained. This useful for commands that move by line, like
728 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
729 only in the case where they can still move to the right line.
731 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
732 a non-nil property of that name, then any field boundaries are ignored.
734 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
735 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
736 Lisp_Object new_pos
, old_pos
;
737 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
739 /* If non-zero, then the original point, before re-positioning. */
742 Lisp_Object prev_old
, prev_new
;
745 /* Use the current point, and afterwards, set it. */
748 XSETFASTINT (new_pos
, PT
);
751 CHECK_NUMBER_COERCE_MARKER (new_pos
);
752 CHECK_NUMBER_COERCE_MARKER (old_pos
);
754 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
756 prev_old
= make_number (XFASTINT (old_pos
) - 1);
757 prev_new
= make_number (XFASTINT (new_pos
) - 1);
759 if (NILP (Vinhibit_field_text_motion
)
760 && !EQ (new_pos
, old_pos
)
761 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
762 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
763 /* To recognize field boundaries, we must also look at the
764 previous positions; we could use `get_pos_property'
765 instead, but in itself that would fail inside non-sticky
766 fields (like comint prompts). */
767 || (XFASTINT (new_pos
) > BEGV
768 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
769 || (XFASTINT (old_pos
) > BEGV
770 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
771 && (NILP (inhibit_capture_property
)
772 /* Field boundaries are again a problem; but now we must
773 decide the case exactly, so we need to call
774 `get_pos_property' as well. */
775 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
776 && (XFASTINT (old_pos
) <= BEGV
777 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
778 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
779 /* It is possible that NEW_POS is not within the same field as
780 OLD_POS; try to move NEW_POS so that it is. */
783 Lisp_Object field_bound
;
786 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
788 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
790 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
791 other side of NEW_POS, which would mean that NEW_POS is
792 already acceptable, and it's not necessary to constrain it
794 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
795 /* NEW_POS should be constrained, but only if either
796 ONLY_IN_LINE is nil (in which case any constraint is OK),
797 or NEW_POS and FIELD_BOUND are on the same line (in which
798 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
799 && (NILP (only_in_line
)
800 /* This is the ONLY_IN_LINE case, check that NEW_POS and
801 FIELD_BOUND are on the same line by seeing whether
802 there's an intervening newline or not. */
803 || (scan_buffer ('\n',
804 XFASTINT (new_pos
), XFASTINT (field_bound
),
805 fwd
? -1 : 1, &shortage
, 1),
807 /* Constrain NEW_POS to FIELD_BOUND. */
808 new_pos
= field_bound
;
810 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
811 /* The NEW_POS argument was originally nil, so automatically set PT. */
812 SET_PT (XFASTINT (new_pos
));
819 DEFUN ("line-beginning-position",
820 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
821 doc
: /* Return the character position of the first character on the current line.
822 With argument N not nil or 1, move forward N - 1 lines first.
823 If scan reaches end of buffer, return that position.
825 This function constrains the returned position to the current field
826 unless that would be on a different line than the original,
827 unconstrained result. If N is nil or 1, and a front-sticky field
828 starts at point, the scan stops as soon as it starts. To ignore field
829 boundaries bind `inhibit-field-text-motion' to t.
831 This function does not move point. */)
835 int orig
, orig_byte
, end
;
836 int count
= SPECPDL_INDEX ();
837 specbind (Qinhibit_point_motion_hooks
, Qt
);
846 Fforward_line (make_number (XINT (n
) - 1));
849 SET_PT_BOTH (orig
, orig_byte
);
851 unbind_to (count
, Qnil
);
853 /* Return END constrained to the current input field. */
854 return Fconstrain_to_field (make_number (end
), make_number (orig
),
855 XINT (n
) != 1 ? Qt
: Qnil
,
859 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
860 doc
: /* Return the character position of the last character on the current line.
861 With argument N not nil or 1, move forward N - 1 lines first.
862 If scan reaches end of buffer, return that position.
864 This function constrains the returned position to the current field
865 unless that would be on a different line than the original,
866 unconstrained result. If N is nil or 1, and a rear-sticky field ends
867 at point, the scan stops as soon as it starts. To ignore field
868 boundaries bind `inhibit-field-text-motion' to t.
870 This function does not move point. */)
882 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
884 /* Return END_POS constrained to the current input field. */
885 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
891 save_excursion_save ()
893 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
896 return Fcons (Fpoint_marker (),
897 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
898 Fcons (visible
? Qt
: Qnil
,
899 Fcons (current_buffer
->mark_active
,
904 save_excursion_restore (info
)
907 Lisp_Object tem
, tem1
, omark
, nmark
;
908 struct gcpro gcpro1
, gcpro2
, gcpro3
;
911 tem
= Fmarker_buffer (XCAR (info
));
912 /* If buffer being returned to is now deleted, avoid error */
913 /* Otherwise could get error here while unwinding to top level
915 /* In that case, Fmarker_buffer returns nil now. */
919 omark
= nmark
= Qnil
;
920 GCPRO3 (info
, omark
, nmark
);
927 unchain_marker (XMARKER (tem
));
932 omark
= Fmarker_position (current_buffer
->mark
);
933 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
934 nmark
= Fmarker_position (tem
);
935 unchain_marker (XMARKER (tem
));
939 visible_p
= !NILP (XCAR (info
));
941 #if 0 /* We used to make the current buffer visible in the selected window
942 if that was true previously. That avoids some anomalies.
943 But it creates others, and it wasn't documented, and it is simpler
944 and cleaner never to alter the window/buffer connections. */
947 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
948 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
954 tem1
= current_buffer
->mark_active
;
955 current_buffer
->mark_active
= tem
;
957 if (!NILP (Vrun_hooks
))
959 /* If mark is active now, and either was not active
960 or was at a different place, run the activate hook. */
961 if (! NILP (current_buffer
->mark_active
))
963 if (! EQ (omark
, nmark
))
964 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
966 /* If mark has ceased to be active, run deactivate hook. */
967 else if (! NILP (tem1
))
968 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
971 /* If buffer was visible in a window, and a different window was
972 selected, and the old selected window is still showing this
973 buffer, restore point in that window. */
976 && !EQ (tem
, selected_window
)
977 && (tem1
= XWINDOW (tem
)->buffer
,
978 (/* Window is live... */
980 /* ...and it shows the current buffer. */
981 && XBUFFER (tem1
) == current_buffer
)))
982 Fset_window_point (tem
, make_number (PT
));
988 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
989 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
990 Executes BODY just like `progn'.
991 The values of point, mark and the current buffer are restored
992 even in case of abnormal exit (throw or error).
993 The state of activation of the mark is also restored.
995 This construct does not save `deactivate-mark', and therefore
996 functions that change the buffer will still cause deactivation
997 of the mark at the end of the command. To prevent that, bind
998 `deactivate-mark' with `let'.
1000 usage: (save-excursion &rest BODY) */)
1004 register Lisp_Object val
;
1005 int count
= SPECPDL_INDEX ();
1007 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1009 val
= Fprogn (args
);
1010 return unbind_to (count
, val
);
1013 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
1014 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
1015 Executes BODY just like `progn'.
1016 usage: (save-current-buffer &rest BODY) */)
1021 int count
= SPECPDL_INDEX ();
1023 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
1025 val
= Fprogn (args
);
1026 return unbind_to (count
, val
);
1029 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1030 doc
: /* Return the number of characters in the current buffer.
1031 If BUFFER, return the number of characters in that buffer instead. */)
1036 return make_number (Z
- BEG
);
1039 CHECK_BUFFER (buffer
);
1040 return make_number (BUF_Z (XBUFFER (buffer
))
1041 - BUF_BEG (XBUFFER (buffer
)));
1045 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1046 doc
: /* Return the minimum permissible value of point in the current buffer.
1047 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1051 XSETFASTINT (temp
, BEGV
);
1055 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1056 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1057 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1060 return buildmark (BEGV
, BEGV_BYTE
);
1063 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1064 doc
: /* Return the maximum permissible value of point in the current buffer.
1065 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1066 is in effect, in which case it is less. */)
1070 XSETFASTINT (temp
, ZV
);
1074 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1075 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1076 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1077 is in effect, in which case it is less. */)
1080 return buildmark (ZV
, ZV_BYTE
);
1083 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1084 doc
: /* Return the position of the gap, in the current buffer.
1085 See also `gap-size'. */)
1089 XSETFASTINT (temp
, GPT
);
1093 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1094 doc
: /* Return the size of the current buffer's gap.
1095 See also `gap-position'. */)
1099 XSETFASTINT (temp
, GAP_SIZE
);
1103 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1104 doc
: /* Return the byte position for character position POSITION.
1105 If POSITION is out of range, the value is nil. */)
1107 Lisp_Object position
;
1109 CHECK_NUMBER_COERCE_MARKER (position
);
1110 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1112 return make_number (CHAR_TO_BYTE (XINT (position
)));
1115 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1116 doc
: /* Return the character position for byte position BYTEPOS.
1117 If BYTEPOS is out of range, the value is nil. */)
1119 Lisp_Object bytepos
;
1121 CHECK_NUMBER (bytepos
);
1122 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1124 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1127 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1128 doc
: /* Return the character following point, as a number.
1129 At the end of the buffer or accessible region, return 0. */)
1134 XSETFASTINT (temp
, 0);
1136 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1140 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1141 doc
: /* Return the character preceding point, as a number.
1142 At the beginning of the buffer or accessible region, return 0. */)
1147 XSETFASTINT (temp
, 0);
1148 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1152 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1155 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1159 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1160 doc
: /* Return t if point is at the beginning of the buffer.
1161 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1169 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1170 doc
: /* Return t if point is at the end of the buffer.
1171 If the buffer is narrowed, this means the end of the narrowed part. */)
1179 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1180 doc
: /* Return t if point is at the beginning of a line. */)
1183 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1188 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1189 doc
: /* Return t if point is at the end of a line.
1190 `End of a line' includes point being at the end of the buffer. */)
1193 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1198 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1199 doc
: /* Return character in current buffer at position POS.
1200 POS is an integer or a marker and defaults to point.
1201 If POS is out of range, the value is nil. */)
1205 register int pos_byte
;
1210 XSETFASTINT (pos
, PT
);
1215 pos_byte
= marker_byte_position (pos
);
1216 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1221 CHECK_NUMBER_COERCE_MARKER (pos
);
1222 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1225 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1228 return make_number (FETCH_CHAR (pos_byte
));
1231 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1232 doc
: /* Return character in current buffer preceding position POS.
1233 POS is an integer or a marker and defaults to point.
1234 If POS is out of range, the value is nil. */)
1238 register Lisp_Object val
;
1239 register int pos_byte
;
1244 XSETFASTINT (pos
, PT
);
1249 pos_byte
= marker_byte_position (pos
);
1251 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1256 CHECK_NUMBER_COERCE_MARKER (pos
);
1258 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1261 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1264 if (!NILP (current_buffer
->enable_multibyte_characters
))
1267 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1272 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1277 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1278 doc
: /* Return the name under which the user logged in, as a string.
1279 This is based on the effective uid, not the real uid.
1280 Also, if the environment variables LOGNAME or USER are set,
1281 that determines the value of this function.
1283 If optional argument UID is an integer or a float, return the login name
1284 of the user with that uid, or nil if there is no such user. */)
1291 /* Set up the user name info if we didn't do it before.
1292 (That can happen if Emacs is dumpable
1293 but you decide to run `temacs -l loadup' and not dump. */
1294 if (INTEGERP (Vuser_login_name
))
1298 return Vuser_login_name
;
1300 id
= (uid_t
)XFLOATINT (uid
);
1302 pw
= (struct passwd
*) getpwuid (id
);
1304 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1307 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1309 doc
: /* Return the name of the user's real uid, as a string.
1310 This ignores the environment variables LOGNAME and USER, so it differs from
1311 `user-login-name' when running under `su'. */)
1314 /* Set up the user name info if we didn't do it before.
1315 (That can happen if Emacs is dumpable
1316 but you decide to run `temacs -l loadup' and not dump. */
1317 if (INTEGERP (Vuser_login_name
))
1319 return Vuser_real_login_name
;
1322 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1323 doc
: /* Return the effective uid of Emacs.
1324 Value is an integer or a float, depending on the value. */)
1327 /* Assignment to EMACS_INT stops GCC whining about limited range of
1329 EMACS_INT euid
= geteuid ();
1331 /* Make sure we don't produce a negative UID due to signed integer
1334 return make_float ((double)geteuid ());
1335 return make_fixnum_or_float (euid
);
1338 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1339 doc
: /* Return the real uid of Emacs.
1340 Value is an integer or a float, depending on the value. */)
1343 /* Assignment to EMACS_INT stops GCC whining about limited range of
1345 EMACS_INT uid
= getuid ();
1347 /* Make sure we don't produce a negative UID due to signed integer
1350 return make_float ((double)getuid ());
1351 return make_fixnum_or_float (uid
);
1354 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1355 doc
: /* Return the full name of the user logged in, as a string.
1356 If the full name corresponding to Emacs's userid is not known,
1359 If optional argument UID is an integer or float, return the full name
1360 of the user with that uid, or nil if there is no such user.
1361 If UID is a string, return the full name of the user with that login
1362 name, or nil if there is no such user. */)
1367 register unsigned char *p
, *q
;
1371 return Vuser_full_name
;
1372 else if (NUMBERP (uid
))
1375 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1378 else if (STRINGP (uid
))
1381 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1385 error ("Invalid UID specification");
1390 p
= (unsigned char *) USER_FULL_NAME
;
1391 /* Chop off everything after the first comma. */
1392 q
= (unsigned char *) index (p
, ',');
1393 full
= make_string (p
, q
? q
- p
: strlen (p
));
1395 #ifdef AMPERSAND_FULL_NAME
1397 q
= (unsigned char *) index (p
, '&');
1398 /* Substitute the login name for the &, upcasing the first character. */
1401 register unsigned char *r
;
1404 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1405 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1406 bcopy (p
, r
, q
- p
);
1408 strcat (r
, SDATA (login
));
1409 r
[q
- p
] = UPCASE (r
[q
- p
]);
1411 full
= build_string (r
);
1413 #endif /* AMPERSAND_FULL_NAME */
1418 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1419 doc
: /* Return the host name of the machine you are running on, as a string. */)
1422 return Vsystem_name
;
1425 /* For the benefit of callers who don't want to include lisp.h */
1430 if (STRINGP (Vsystem_name
))
1431 return (char *) SDATA (Vsystem_name
);
1437 get_operating_system_release()
1439 if (STRINGP (Voperating_system_release
))
1440 return (char *) SDATA (Voperating_system_release
);
1445 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1446 doc
: /* Return the process ID of Emacs, as an integer. */)
1449 return make_number (getpid ());
1452 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1453 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1454 The time is returned as a list of three integers. The first has the
1455 most significant 16 bits of the seconds, while the second has the
1456 least significant 16 bits. The third integer gives the microsecond
1459 The microsecond count is zero on systems that do not provide
1460 resolution finer than a second. */)
1466 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1467 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1468 make_number (EMACS_USECS (t
)));
1471 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1473 doc
: /* Return the current run time used by Emacs.
1474 The time is returned as a list of three integers. The first has the
1475 most significant 16 bits of the seconds, while the second has the
1476 least significant 16 bits. The third integer gives the microsecond
1479 On systems that can't determine the run time, `get-internal-run-time'
1480 does the same thing as `current-time'. The microsecond count is zero
1481 on systems that do not provide resolution finer than a second. */)
1484 #ifdef HAVE_GETRUSAGE
1485 struct rusage usage
;
1488 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1489 /* This shouldn't happen. What action is appropriate? */
1492 /* Sum up user time and system time. */
1493 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1494 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1495 if (usecs
>= 1000000)
1501 return list3 (make_number ((secs
>> 16) & 0xffff),
1502 make_number ((secs
>> 0) & 0xffff),
1503 make_number (usecs
));
1504 #else /* ! HAVE_GETRUSAGE */
1506 return w32_get_internal_run_time ();
1507 #else /* ! WINDOWSNT */
1508 return Fcurrent_time ();
1509 #endif /* WINDOWSNT */
1510 #endif /* HAVE_GETRUSAGE */
1515 lisp_time_argument (specified_time
, result
, usec
)
1516 Lisp_Object specified_time
;
1520 if (NILP (specified_time
))
1527 *usec
= EMACS_USECS (t
);
1528 *result
= EMACS_SECS (t
);
1532 return time (result
) != -1;
1536 Lisp_Object high
, low
;
1537 high
= Fcar (specified_time
);
1538 CHECK_NUMBER (high
);
1539 low
= Fcdr (specified_time
);
1544 Lisp_Object usec_l
= Fcdr (low
);
1546 usec_l
= Fcar (usec_l
);
1551 CHECK_NUMBER (usec_l
);
1552 *usec
= XINT (usec_l
);
1560 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1561 return *result
>> 16 == XINT (high
);
1565 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1566 doc
: /* Return the current time, as a float number of seconds since the epoch.
1567 If SPECIFIED-TIME is given, it is the time to convert to float
1568 instead of the current time. The argument should have the form
1569 (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
1570 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1571 have the form (HIGH . LOW), but this is considered obsolete.
1573 WARNING: Since the result is floating point, it may not be exact.
1574 Do not use this function if precise time stamps are required. */)
1576 Lisp_Object specified_time
;
1581 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1582 error ("Invalid time specification");
1584 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1587 /* Write information into buffer S of size MAXSIZE, according to the
1588 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1589 Default to Universal Time if UT is nonzero, local time otherwise.
1590 Return the number of bytes written, not including the terminating
1591 '\0'. If S is NULL, nothing will be written anywhere; so to
1592 determine how many bytes would be written, use NULL for S and
1593 ((size_t) -1) for MAXSIZE.
1595 This function behaves like emacs_strftimeu, except it allows null
1598 emacs_memftimeu (s
, maxsize
, format
, format_len
, tp
, ut
)
1603 const struct tm
*tp
;
1608 /* Loop through all the null-terminated strings in the format
1609 argument. Normally there's just one null-terminated string, but
1610 there can be arbitrarily many, concatenated together, if the
1611 format contains '\0' bytes. emacs_strftimeu stops at the first
1612 '\0' byte so we must invoke it separately for each such string. */
1621 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1625 if (result
== 0 && s
[0] != '\0')
1630 maxsize
-= result
+ 1;
1632 len
= strlen (format
);
1633 if (len
== format_len
)
1637 format_len
-= len
+ 1;
1641 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1642 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1643 TIME is specified as (HIGH LOW . IGNORED), as returned by
1644 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1645 is also still accepted.
1646 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1647 as Universal Time; nil means describe TIME in the local time zone.
1648 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1649 by text that describes the specified date and time in TIME:
1651 %Y is the year, %y within the century, %C the century.
1652 %G is the year corresponding to the ISO week, %g within the century.
1653 %m is the numeric month.
1654 %b and %h are the locale's abbreviated month name, %B the full name.
1655 %d is the day of the month, zero-padded, %e is blank-padded.
1656 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1657 %a is the locale's abbreviated name of the day of week, %A the full name.
1658 %U is the week number starting on Sunday, %W starting on Monday,
1659 %V according to ISO 8601.
1660 %j is the day of the year.
1662 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1663 only blank-padded, %l is like %I blank-padded.
1664 %p is the locale's equivalent of either AM or PM.
1667 %Z is the time zone name, %z is the numeric form.
1668 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1670 %c is the locale's date and time format.
1671 %x is the locale's "preferred" date format.
1672 %D is like "%m/%d/%y".
1674 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1675 %X is the locale's "preferred" time format.
1677 Finally, %n is a newline, %t is a tab, %% is a literal %.
1679 Certain flags and modifiers are available with some format controls.
1680 The flags are `_', `-', `^' and `#'. For certain characters X,
1681 %_X is like %X, but padded with blanks; %-X is like %X,
1682 but without padding. %^X is like %X, but with all textual
1683 characters up-cased; %#X is like %X, but with letter-case of
1684 all textual characters reversed.
1685 %NX (where N stands for an integer) is like %X,
1686 but takes up at least N (a number) positions.
1687 The modifiers are `E' and `O'. For certain characters X,
1688 %EX is a locale's alternative version of %X;
1689 %OX is like %X, but uses the locale's number symbols.
1691 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1692 (format_string
, time
, universal
)
1693 Lisp_Object format_string
, time
, universal
;
1698 int ut
= ! NILP (universal
);
1700 CHECK_STRING (format_string
);
1702 if (! lisp_time_argument (time
, &value
, NULL
))
1703 error ("Invalid time specification");
1705 format_string
= code_convert_string_norecord (format_string
,
1706 Vlocale_coding_system
, 1);
1708 /* This is probably enough. */
1709 size
= SBYTES (format_string
) * 6 + 50;
1712 tm
= ut
? gmtime (&value
) : localtime (&value
);
1715 error ("Specified time is not representable");
1717 synchronize_system_time_locale ();
1721 char *buf
= (char *) alloca (size
+ 1);
1726 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1727 SBYTES (format_string
),
1730 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1731 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1732 Vlocale_coding_system
, 0);
1734 /* If buffer was too small, make it bigger and try again. */
1736 result
= emacs_memftimeu (NULL
, (size_t) -1,
1737 SDATA (format_string
),
1738 SBYTES (format_string
),
1745 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1746 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1747 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1748 as from `current-time' and `file-attributes', or nil to use the
1749 current time. The obsolete form (HIGH . LOW) is also still accepted.
1750 The list has the following nine members: SEC is an integer between 0
1751 and 60; SEC is 60 for a leap second, which only some operating systems
1752 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1753 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1754 integer between 1 and 12. YEAR is an integer indicating the
1755 four-digit year. DOW is the day of week, an integer between 0 and 6,
1756 where 0 is Sunday. DST is t if daylight saving time is in effect,
1757 otherwise nil. ZONE is an integer indicating the number of seconds
1758 east of Greenwich. (Note that Common Lisp has different meanings for
1761 Lisp_Object specified_time
;
1765 struct tm
*decoded_time
;
1766 Lisp_Object list_args
[9];
1768 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1769 error ("Invalid time specification");
1772 decoded_time
= localtime (&time_spec
);
1775 error ("Specified time is not representable");
1776 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1777 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1778 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1779 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1780 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1781 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1782 cast below avoids overflow in int arithmetics. */
1783 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1784 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1785 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1787 /* Make a copy, in case gmtime modifies the struct. */
1788 save_tm
= *decoded_time
;
1790 decoded_time
= gmtime (&time_spec
);
1792 if (decoded_time
== 0)
1793 list_args
[8] = Qnil
;
1795 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1796 return Flist (9, list_args
);
1799 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1800 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1801 This is the reverse operation of `decode-time', which see.
1802 ZONE defaults to the current time zone rule. This can
1803 be a string or t (as from `set-time-zone-rule'), or it can be a list
1804 \(as from `current-time-zone') or an integer (as from `decode-time')
1805 applied without consideration for daylight saving time.
1807 You can pass more than 7 arguments; then the first six arguments
1808 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1809 The intervening arguments are ignored.
1810 This feature lets (apply 'encode-time (decode-time ...)) work.
1812 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1813 for example, a DAY of 0 means the day preceding the given month.
1814 Year numbers less than 100 are treated just like other year numbers.
1815 If you want them to stand for years in this century, you must do that yourself.
1817 Years before 1970 are not guaranteed to work. On some systems,
1818 year values as low as 1901 do work.
1820 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1823 register Lisp_Object
*args
;
1827 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1829 CHECK_NUMBER (args
[0]); /* second */
1830 CHECK_NUMBER (args
[1]); /* minute */
1831 CHECK_NUMBER (args
[2]); /* hour */
1832 CHECK_NUMBER (args
[3]); /* day */
1833 CHECK_NUMBER (args
[4]); /* month */
1834 CHECK_NUMBER (args
[5]); /* year */
1836 tm
.tm_sec
= XINT (args
[0]);
1837 tm
.tm_min
= XINT (args
[1]);
1838 tm
.tm_hour
= XINT (args
[2]);
1839 tm
.tm_mday
= XINT (args
[3]);
1840 tm
.tm_mon
= XINT (args
[4]) - 1;
1841 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1849 time
= mktime (&tm
);
1856 char **oldenv
= environ
, **newenv
;
1860 else if (STRINGP (zone
))
1861 tzstring
= (char *) SDATA (zone
);
1862 else if (INTEGERP (zone
))
1864 int abszone
= eabs (XINT (zone
));
1865 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1866 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1870 error ("Invalid time zone specification");
1872 /* Set TZ before calling mktime; merely adjusting mktime's returned
1873 value doesn't suffice, since that would mishandle leap seconds. */
1874 set_time_zone_rule (tzstring
);
1877 time
= mktime (&tm
);
1880 /* Restore TZ to previous value. */
1884 #ifdef LOCALTIME_CACHE
1889 if (time
== (time_t) -1)
1890 error ("Specified time is not representable");
1892 return make_time (time
);
1895 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1896 doc
: /* Return the current time, as a human-readable string.
1897 Programs can use this function to decode a time,
1898 since the number of columns in each field is fixed
1899 if the year is in the range 1000-9999.
1900 The format is `Sun Sep 16 01:03:52 1973'.
1901 However, see also the functions `decode-time' and `format-time-string'
1902 which provide a much more powerful and general facility.
1904 If SPECIFIED-TIME is given, it is a time to format instead of the
1905 current time. The argument should have the form (HIGH LOW . IGNORED).
1906 Thus, you can use times obtained from `current-time' and from
1907 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1908 but this is considered obsolete. */)
1910 Lisp_Object specified_time
;
1916 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1917 error ("Invalid time specification");
1919 /* Convert to a string, checking for out-of-range time stamps.
1920 Don't use 'ctime', as that might dump core if VALUE is out of
1923 tm
= localtime (&value
);
1925 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1926 error ("Specified time is not representable");
1928 /* Remove the trailing newline. */
1929 tem
[strlen (tem
) - 1] = '\0';
1931 return build_string (tem
);
1934 /* Yield A - B, measured in seconds.
1935 This function is copied from the GNU C Library. */
1940 /* Compute intervening leap days correctly even if year is negative.
1941 Take care to avoid int overflow in leap day calculations,
1942 but it's OK to assume that A and B are close to each other. */
1943 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1944 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1945 int a100
= a4
/ 25 - (a4
% 25 < 0);
1946 int b100
= b4
/ 25 - (b4
% 25 < 0);
1947 int a400
= a100
>> 2;
1948 int b400
= b100
>> 2;
1949 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1950 int years
= a
->tm_year
- b
->tm_year
;
1951 int days
= (365 * years
+ intervening_leap_days
1952 + (a
->tm_yday
- b
->tm_yday
));
1953 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1954 + (a
->tm_min
- b
->tm_min
))
1955 + (a
->tm_sec
- b
->tm_sec
));
1958 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1959 doc
: /* Return the offset and name for the local time zone.
1960 This returns a list of the form (OFFSET NAME).
1961 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1962 A negative value means west of Greenwich.
1963 NAME is a string giving the name of the time zone.
1964 If SPECIFIED-TIME is given, the time zone offset is determined from it
1965 instead of using the current time. The argument should have the form
1966 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1967 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1968 have the form (HIGH . LOW), but this is considered obsolete.
1970 Some operating systems cannot provide all this information to Emacs;
1971 in this case, `current-time-zone' returns a list containing nil for
1972 the data it can't find. */)
1974 Lisp_Object specified_time
;
1980 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1985 t
= gmtime (&value
);
1989 t
= localtime (&value
);
1996 int offset
= tm_diff (t
, &gmt
);
2002 s
= (char *)t
->tm_zone
;
2003 #else /* not HAVE_TM_ZONE */
2005 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
2006 s
= tzname
[t
->tm_isdst
];
2008 #endif /* not HAVE_TM_ZONE */
2012 /* No local time zone name is available; use "+-NNNN" instead. */
2013 int am
= (offset
< 0 ? -offset
: offset
) / 60;
2014 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
2018 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
2021 return Fmake_list (make_number (2), Qnil
);
2024 /* This holds the value of `environ' produced by the previous
2025 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
2026 has never been called. */
2027 static char **environbuf
;
2029 /* This holds the startup value of the TZ environment variable so it
2030 can be restored if the user calls set-time-zone-rule with a nil
2032 static char *initial_tz
;
2034 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
2035 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
2036 If TZ is nil, use implementation-defined default time zone information.
2037 If TZ is t, use Universal Time. */)
2043 /* When called for the first time, save the original TZ. */
2045 initial_tz
= (char *) getenv ("TZ");
2048 tzstring
= initial_tz
;
2049 else if (EQ (tz
, Qt
))
2054 tzstring
= (char *) SDATA (tz
);
2057 set_time_zone_rule (tzstring
);
2059 environbuf
= environ
;
2064 #ifdef LOCALTIME_CACHE
2066 /* These two values are known to load tz files in buggy implementations,
2067 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2068 Their values shouldn't matter in non-buggy implementations.
2069 We don't use string literals for these strings,
2070 since if a string in the environment is in readonly
2071 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2072 See Sun bugs 1113095 and 1114114, ``Timezone routines
2073 improperly modify environment''. */
2075 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2076 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2080 /* Set the local time zone rule to TZSTRING.
2081 This allocates memory into `environ', which it is the caller's
2082 responsibility to free. */
2085 set_time_zone_rule (tzstring
)
2089 char **from
, **to
, **newenv
;
2091 /* Make the ENVIRON vector longer with room for TZSTRING. */
2092 for (from
= environ
; *from
; from
++)
2094 envptrs
= from
- environ
+ 2;
2095 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2096 + (tzstring
? strlen (tzstring
) + 4 : 0));
2098 /* Add TZSTRING to the end of environ, as a value for TZ. */
2101 char *t
= (char *) (to
+ envptrs
);
2103 strcat (t
, tzstring
);
2107 /* Copy the old environ vector elements into NEWENV,
2108 but don't copy the TZ variable.
2109 So we have only one definition of TZ, which came from TZSTRING. */
2110 for (from
= environ
; *from
; from
++)
2111 if (strncmp (*from
, "TZ=", 3) != 0)
2117 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2118 the TZ variable is stored. If we do not have a TZSTRING,
2119 TO points to the vector slot which has the terminating null. */
2121 #ifdef LOCALTIME_CACHE
2123 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2124 "US/Pacific" that loads a tz file, then changes to a value like
2125 "XXX0" that does not load a tz file, and then changes back to
2126 its original value, the last change is (incorrectly) ignored.
2127 Also, if TZ changes twice in succession to values that do
2128 not load a tz file, tzset can dump core (see Sun bug#1225179).
2129 The following code works around these bugs. */
2133 /* Temporarily set TZ to a value that loads a tz file
2134 and that differs from tzstring. */
2136 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2137 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2143 /* The implied tzstring is unknown, so temporarily set TZ to
2144 two different values that each load a tz file. */
2145 *to
= set_time_zone_rule_tz1
;
2148 *to
= set_time_zone_rule_tz2
;
2153 /* Now TZ has the desired value, and tzset can be invoked safely. */
2160 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2161 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2162 type of object is Lisp_String). INHERIT is passed to
2163 INSERT_FROM_STRING_FUNC as the last argument. */
2166 general_insert_function (void (*insert_func
)
2167 (const unsigned char *, EMACS_INT
),
2168 void (*insert_from_string_func
)
2169 (Lisp_Object
, EMACS_INT
, EMACS_INT
,
2170 EMACS_INT
, EMACS_INT
, int),
2171 int inherit
, int nargs
, Lisp_Object
*args
)
2173 register int argnum
;
2174 register Lisp_Object val
;
2176 for (argnum
= 0; argnum
< nargs
; argnum
++)
2179 if (CHARACTERP (val
))
2181 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2184 if (!NILP (current_buffer
->enable_multibyte_characters
))
2185 len
= CHAR_STRING (XFASTINT (val
), str
);
2188 str
[0] = (ASCII_CHAR_P (XINT (val
))
2190 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2193 (*insert_func
) (str
, len
);
2195 else if (STRINGP (val
))
2197 (*insert_from_string_func
) (val
, 0, 0,
2203 wrong_type_argument (Qchar_or_string_p
, val
);
2215 /* Callers passing one argument to Finsert need not gcpro the
2216 argument "array", since the only element of the array will
2217 not be used after calling insert or insert_from_string, so
2218 we don't care if it gets trashed. */
2220 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2221 doc
: /* Insert the arguments, either strings or characters, at point.
2222 Point and before-insertion markers move forward to end up
2223 after the inserted text.
2224 Any other markers at the point of insertion remain before the text.
2226 If the current buffer is multibyte, unibyte strings are converted
2227 to multibyte for insertion (see `string-make-multibyte').
2228 If the current buffer is unibyte, multibyte strings are converted
2229 to unibyte for insertion (see `string-make-unibyte').
2231 When operating on binary data, it may be necessary to preserve the
2232 original bytes of a unibyte string when inserting it into a multibyte
2233 buffer; to accomplish this, apply `string-as-multibyte' to the string
2234 and insert the result.
2236 usage: (insert &rest ARGS) */)
2239 register Lisp_Object
*args
;
2241 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2245 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2247 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2248 Point and before-insertion markers move forward to end up
2249 after the inserted text.
2250 Any other markers at the point of insertion remain before the text.
2252 If the current buffer is multibyte, unibyte strings are converted
2253 to multibyte for insertion (see `unibyte-char-to-multibyte').
2254 If the current buffer is unibyte, multibyte strings are converted
2255 to unibyte for insertion.
2257 usage: (insert-and-inherit &rest ARGS) */)
2260 register Lisp_Object
*args
;
2262 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2267 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2268 doc
: /* Insert strings or characters at point, relocating markers after the text.
2269 Point and markers move forward to end up after the inserted text.
2271 If the current buffer is multibyte, unibyte strings are converted
2272 to multibyte for insertion (see `unibyte-char-to-multibyte').
2273 If the current buffer is unibyte, multibyte strings are converted
2274 to unibyte for insertion.
2276 usage: (insert-before-markers &rest ARGS) */)
2279 register Lisp_Object
*args
;
2281 general_insert_function (insert_before_markers
,
2282 insert_from_string_before_markers
, 0,
2287 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2288 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2289 doc
: /* Insert text at point, relocating markers and inheriting properties.
2290 Point and markers move forward to end up after the inserted text.
2292 If the current buffer is multibyte, unibyte strings are converted
2293 to multibyte for insertion (see `unibyte-char-to-multibyte').
2294 If the current buffer is unibyte, multibyte strings are converted
2295 to unibyte for insertion.
2297 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2300 register Lisp_Object
*args
;
2302 general_insert_function (insert_before_markers_and_inherit
,
2303 insert_from_string_before_markers
, 1,
2308 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2309 doc
: /* Insert COUNT copies of CHARACTER.
2310 Point, and before-insertion markers, are relocated as in the function `insert'.
2311 The optional third arg INHERIT, if non-nil, says to inherit text properties
2312 from adjoining text, if those properties are sticky. */)
2313 (character
, count
, inherit
)
2314 Lisp_Object character
, count
, inherit
;
2316 register unsigned char *string
;
2317 register int strlen
;
2320 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2322 CHECK_NUMBER (character
);
2323 CHECK_NUMBER (count
);
2325 if (!NILP (current_buffer
->enable_multibyte_characters
))
2326 len
= CHAR_STRING (XFASTINT (character
), str
);
2328 str
[0] = XFASTINT (character
), len
= 1;
2329 n
= XINT (count
) * len
;
2332 strlen
= min (n
, 256 * len
);
2333 string
= (unsigned char *) alloca (strlen
);
2334 for (i
= 0; i
< strlen
; i
++)
2335 string
[i
] = str
[i
% len
];
2339 if (!NILP (inherit
))
2340 insert_and_inherit (string
, strlen
);
2342 insert (string
, strlen
);
2347 if (!NILP (inherit
))
2348 insert_and_inherit (string
, n
);
2355 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2356 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2357 Both arguments are required.
2358 BYTE is a number of the range 0..255.
2360 If BYTE is 128..255 and the current buffer is multibyte, the
2361 corresponding eight-bit character is inserted.
2363 Point, and before-insertion markers, are relocated as in the function `insert'.
2364 The optional third arg INHERIT, if non-nil, says to inherit text properties
2365 from adjoining text, if those properties are sticky. */)
2366 (byte
, count
, inherit
)
2367 Lisp_Object byte
, count
, inherit
;
2369 CHECK_NUMBER (byte
);
2370 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2371 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2372 if (XINT (byte
) >= 128
2373 && ! NILP (current_buffer
->enable_multibyte_characters
))
2374 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2375 return Finsert_char (byte
, count
, inherit
);
2379 /* Making strings from buffer contents. */
2381 /* Return a Lisp_String containing the text of the current buffer from
2382 START to END. If text properties are in use and the current buffer
2383 has properties in the range specified, the resulting string will also
2384 have them, if PROPS is nonzero.
2386 We don't want to use plain old make_string here, because it calls
2387 make_uninit_string, which can cause the buffer arena to be
2388 compacted. make_string has no way of knowing that the data has
2389 been moved, and thus copies the wrong data into the string. This
2390 doesn't effect most of the other users of make_string, so it should
2391 be left as is. But we should use this function when conjuring
2392 buffer substrings. */
2395 make_buffer_string (start
, end
, props
)
2399 int start_byte
= CHAR_TO_BYTE (start
);
2400 int end_byte
= CHAR_TO_BYTE (end
);
2402 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2405 /* Return a Lisp_String containing the text of the current buffer from
2406 START / START_BYTE to END / END_BYTE.
2408 If text properties are in use and the current buffer
2409 has properties in the range specified, the resulting string will also
2410 have them, if PROPS is nonzero.
2412 We don't want to use plain old make_string here, because it calls
2413 make_uninit_string, which can cause the buffer arena to be
2414 compacted. make_string has no way of knowing that the data has
2415 been moved, and thus copies the wrong data into the string. This
2416 doesn't effect most of the other users of make_string, so it should
2417 be left as is. But we should use this function when conjuring
2418 buffer substrings. */
2421 make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
)
2422 int start
, start_byte
, end
, end_byte
;
2425 Lisp_Object result
, tem
, tem1
;
2427 if (start
< GPT
&& GPT
< end
)
2430 if (! NILP (current_buffer
->enable_multibyte_characters
))
2431 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2433 result
= make_uninit_string (end
- start
);
2434 bcopy (BYTE_POS_ADDR (start_byte
), SDATA (result
),
2435 end_byte
- start_byte
);
2437 /* If desired, update and copy the text properties. */
2440 update_buffer_properties (start
, end
);
2442 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2443 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2445 if (XINT (tem
) != end
|| !NILP (tem1
))
2446 copy_intervals_to_string (result
, current_buffer
, start
,
2453 /* Call Vbuffer_access_fontify_functions for the range START ... END
2454 in the current buffer, if necessary. */
2457 update_buffer_properties (start
, end
)
2460 /* If this buffer has some access functions,
2461 call them, specifying the range of the buffer being accessed. */
2462 if (!NILP (Vbuffer_access_fontify_functions
))
2464 Lisp_Object args
[3];
2467 args
[0] = Qbuffer_access_fontify_functions
;
2468 XSETINT (args
[1], start
);
2469 XSETINT (args
[2], end
);
2471 /* But don't call them if we can tell that the work
2472 has already been done. */
2473 if (!NILP (Vbuffer_access_fontified_property
))
2475 tem
= Ftext_property_any (args
[1], args
[2],
2476 Vbuffer_access_fontified_property
,
2479 Frun_hook_with_args (3, args
);
2482 Frun_hook_with_args (3, args
);
2486 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2487 doc
: /* Return the contents of part of the current buffer as a string.
2488 The two arguments START and END are character positions;
2489 they can be in either order.
2490 The string returned is multibyte if the buffer is multibyte.
2492 This function copies the text properties of that part of the buffer
2493 into the result string; if you don't want the text properties,
2494 use `buffer-substring-no-properties' instead. */)
2496 Lisp_Object start
, end
;
2500 validate_region (&start
, &end
);
2504 return make_buffer_string (b
, e
, 1);
2507 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2508 Sbuffer_substring_no_properties
, 2, 2, 0,
2509 doc
: /* Return the characters of part of the buffer, without the text properties.
2510 The two arguments START and END are character positions;
2511 they can be in either order. */)
2513 Lisp_Object start
, end
;
2517 validate_region (&start
, &end
);
2521 return make_buffer_string (b
, e
, 0);
2524 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2525 doc
: /* Return the contents of the current buffer as a string.
2526 If narrowing is in effect, this function returns only the visible part
2530 return make_buffer_string (BEGV
, ZV
, 1);
2533 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2535 doc
: /* Insert before point a substring of the contents of BUFFER.
2536 BUFFER may be a buffer or a buffer name.
2537 Arguments START and END are character positions specifying the substring.
2538 They default to the values of (point-min) and (point-max) in BUFFER. */)
2539 (buffer
, start
, end
)
2540 Lisp_Object buffer
, start
, end
;
2542 register int b
, e
, temp
;
2543 register struct buffer
*bp
, *obuf
;
2546 buf
= Fget_buffer (buffer
);
2550 if (NILP (bp
->name
))
2551 error ("Selecting deleted buffer");
2557 CHECK_NUMBER_COERCE_MARKER (start
);
2564 CHECK_NUMBER_COERCE_MARKER (end
);
2569 temp
= b
, b
= e
, e
= temp
;
2571 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2572 args_out_of_range (start
, end
);
2574 obuf
= current_buffer
;
2575 set_buffer_internal_1 (bp
);
2576 update_buffer_properties (b
, e
);
2577 set_buffer_internal_1 (obuf
);
2579 insert_from_buffer (bp
, b
, e
- b
, 0);
2583 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2585 doc
: /* Compare two substrings of two buffers; return result as number.
2586 the value is -N if first string is less after N-1 chars,
2587 +N if first string is greater after N-1 chars, or 0 if strings match.
2588 Each substring is represented as three arguments: BUFFER, START and END.
2589 That makes six args in all, three for each substring.
2591 The value of `case-fold-search' in the current buffer
2592 determines whether case is significant or ignored. */)
2593 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2594 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2596 register int begp1
, endp1
, begp2
, endp2
, temp
;
2597 register struct buffer
*bp1
, *bp2
;
2598 register Lisp_Object trt
2599 = (!NILP (current_buffer
->case_fold_search
)
2600 ? current_buffer
->case_canon_table
: Qnil
);
2602 int i1
, i2
, i1_byte
, i2_byte
;
2604 /* Find the first buffer and its substring. */
2607 bp1
= current_buffer
;
2611 buf1
= Fget_buffer (buffer1
);
2614 bp1
= XBUFFER (buf1
);
2615 if (NILP (bp1
->name
))
2616 error ("Selecting deleted buffer");
2620 begp1
= BUF_BEGV (bp1
);
2623 CHECK_NUMBER_COERCE_MARKER (start1
);
2624 begp1
= XINT (start1
);
2627 endp1
= BUF_ZV (bp1
);
2630 CHECK_NUMBER_COERCE_MARKER (end1
);
2631 endp1
= XINT (end1
);
2635 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2637 if (!(BUF_BEGV (bp1
) <= begp1
2639 && endp1
<= BUF_ZV (bp1
)))
2640 args_out_of_range (start1
, end1
);
2642 /* Likewise for second substring. */
2645 bp2
= current_buffer
;
2649 buf2
= Fget_buffer (buffer2
);
2652 bp2
= XBUFFER (buf2
);
2653 if (NILP (bp2
->name
))
2654 error ("Selecting deleted buffer");
2658 begp2
= BUF_BEGV (bp2
);
2661 CHECK_NUMBER_COERCE_MARKER (start2
);
2662 begp2
= XINT (start2
);
2665 endp2
= BUF_ZV (bp2
);
2668 CHECK_NUMBER_COERCE_MARKER (end2
);
2669 endp2
= XINT (end2
);
2673 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2675 if (!(BUF_BEGV (bp2
) <= begp2
2677 && endp2
<= BUF_ZV (bp2
)))
2678 args_out_of_range (start2
, end2
);
2682 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2683 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2685 while (i1
< endp1
&& i2
< endp2
)
2687 /* When we find a mismatch, we must compare the
2688 characters, not just the bytes. */
2693 if (! NILP (bp1
->enable_multibyte_characters
))
2695 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2696 BUF_INC_POS (bp1
, i1_byte
);
2701 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2702 MAKE_CHAR_MULTIBYTE (c1
);
2706 if (! NILP (bp2
->enable_multibyte_characters
))
2708 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2709 BUF_INC_POS (bp2
, i2_byte
);
2714 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2715 MAKE_CHAR_MULTIBYTE (c2
);
2721 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2722 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2725 return make_number (- 1 - chars
);
2727 return make_number (chars
+ 1);
2732 /* The strings match as far as they go.
2733 If one is shorter, that one is less. */
2734 if (chars
< endp1
- begp1
)
2735 return make_number (chars
+ 1);
2736 else if (chars
< endp2
- begp2
)
2737 return make_number (- chars
- 1);
2739 /* Same length too => they are equal. */
2740 return make_number (0);
2744 subst_char_in_region_unwind (arg
)
2747 return current_buffer
->undo_list
= arg
;
2751 subst_char_in_region_unwind_1 (arg
)
2754 return current_buffer
->filename
= arg
;
2757 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2758 Ssubst_char_in_region
, 4, 5, 0,
2759 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2760 If optional arg NOUNDO is non-nil, don't record this change for undo
2761 and don't mark the buffer as really changed.
2762 Both characters must have the same length of multi-byte form. */)
2763 (start
, end
, fromchar
, tochar
, noundo
)
2764 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2766 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2767 /* Keep track of the first change in the buffer:
2768 if 0 we haven't found it yet.
2769 if < 0 we've found it and we've run the before-change-function.
2770 if > 0 we've actually performed it and the value is its position. */
2772 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2774 int count
= SPECPDL_INDEX ();
2775 #define COMBINING_NO 0
2776 #define COMBINING_BEFORE 1
2777 #define COMBINING_AFTER 2
2778 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2779 int maybe_byte_combining
= COMBINING_NO
;
2780 int last_changed
= 0;
2781 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2785 validate_region (&start
, &end
);
2786 CHECK_NUMBER (fromchar
);
2787 CHECK_NUMBER (tochar
);
2791 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2792 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2793 error ("Characters in `subst-char-in-region' have different byte-lengths");
2794 if (!ASCII_BYTE_P (*tostr
))
2796 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2797 complete multibyte character, it may be combined with the
2798 after bytes. If it is in the range 0xA0..0xFF, it may be
2799 combined with the before and after bytes. */
2800 if (!CHAR_HEAD_P (*tostr
))
2801 maybe_byte_combining
= COMBINING_BOTH
;
2802 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2803 maybe_byte_combining
= COMBINING_AFTER
;
2809 fromstr
[0] = XFASTINT (fromchar
);
2810 tostr
[0] = XFASTINT (tochar
);
2814 pos_byte
= CHAR_TO_BYTE (pos
);
2815 stop
= CHAR_TO_BYTE (XINT (end
));
2818 /* If we don't want undo, turn off putting stuff on the list.
2819 That's faster than getting rid of things,
2820 and it prevents even the entry for a first change.
2821 Also inhibit locking the file. */
2822 if (!changed
&& !NILP (noundo
))
2824 record_unwind_protect (subst_char_in_region_unwind
,
2825 current_buffer
->undo_list
);
2826 current_buffer
->undo_list
= Qt
;
2827 /* Don't do file-locking. */
2828 record_unwind_protect (subst_char_in_region_unwind_1
,
2829 current_buffer
->filename
);
2830 current_buffer
->filename
= Qnil
;
2833 if (pos_byte
< GPT_BYTE
)
2834 stop
= min (stop
, GPT_BYTE
);
2837 int pos_byte_next
= pos_byte
;
2839 if (pos_byte
>= stop
)
2841 if (pos_byte
>= end_byte
) break;
2844 p
= BYTE_POS_ADDR (pos_byte
);
2846 INC_POS (pos_byte_next
);
2849 if (pos_byte_next
- pos_byte
== len
2850 && p
[0] == fromstr
[0]
2852 || (p
[1] == fromstr
[1]
2853 && (len
== 2 || (p
[2] == fromstr
[2]
2854 && (len
== 3 || p
[3] == fromstr
[3]))))))
2857 /* We've already seen this and run the before-change-function;
2858 this time we only need to record the actual position. */
2863 modify_region (current_buffer
, pos
, XINT (end
), 0);
2865 if (! NILP (noundo
))
2867 if (MODIFF
- 1 == SAVE_MODIFF
)
2869 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
2870 current_buffer
->auto_save_modified
++;
2873 /* The before-change-function may have moved the gap
2874 or even modified the buffer so we should start over. */
2878 /* Take care of the case where the new character
2879 combines with neighboring bytes. */
2880 if (maybe_byte_combining
2881 && (maybe_byte_combining
== COMBINING_AFTER
2882 ? (pos_byte_next
< Z_BYTE
2883 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2884 : ((pos_byte_next
< Z_BYTE
2885 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2886 || (pos_byte
> BEG_BYTE
2887 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2889 Lisp_Object tem
, string
;
2891 struct gcpro gcpro1
;
2893 tem
= current_buffer
->undo_list
;
2896 /* Make a multibyte string containing this single character. */
2897 string
= make_multibyte_string (tostr
, 1, len
);
2898 /* replace_range is less efficient, because it moves the gap,
2899 but it handles combining correctly. */
2900 replace_range (pos
, pos
+ 1, string
,
2902 pos_byte_next
= CHAR_TO_BYTE (pos
);
2903 if (pos_byte_next
> pos_byte
)
2904 /* Before combining happened. We should not increment
2905 POS. So, to cancel the later increment of POS,
2909 INC_POS (pos_byte_next
);
2911 if (! NILP (noundo
))
2912 current_buffer
->undo_list
= tem
;
2919 record_change (pos
, 1);
2920 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2922 last_changed
= pos
+ 1;
2924 pos_byte
= pos_byte_next
;
2930 signal_after_change (changed
,
2931 last_changed
- changed
, last_changed
- changed
);
2932 update_compositions (changed
, last_changed
, CHECK_ALL
);
2935 unbind_to (count
, Qnil
);
2940 static Lisp_Object check_translation
P_ ((int, int, int, Lisp_Object
));
2942 /* Helper function for Ftranslate_region_internal.
2944 Check if a character sequence at POS (POS_BYTE) matches an element
2945 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2946 element is found, return it. Otherwise return Qnil. */
2949 check_translation (pos
, pos_byte
, end
, val
)
2950 int pos
, pos_byte
, end
;
2953 int buf_size
= 16, buf_used
= 0;
2954 int *buf
= alloca (sizeof (int) * buf_size
);
2956 for (; CONSP (val
); val
= XCDR (val
))
2965 if (! VECTORP (elt
))
2968 if (len
<= end
- pos
)
2970 for (i
= 0; i
< len
; i
++)
2974 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2977 if (buf_used
== buf_size
)
2982 newbuf
= alloca (sizeof (int) * buf_size
);
2983 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2986 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, 0, len
);
2989 if (XINT (AREF (elt
, i
)) != buf
[i
])
3000 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
3001 Stranslate_region_internal
, 3, 3, 0,
3002 doc
: /* Internal use only.
3003 From START to END, translate characters according to TABLE.
3004 TABLE is a string or a char-table; the Nth character in it is the
3005 mapping for the character with code N.
3006 It returns the number of characters changed. */)
3010 register Lisp_Object table
;
3012 register unsigned char *tt
; /* Trans table. */
3013 register int nc
; /* New character. */
3014 int cnt
; /* Number of changes made. */
3015 int size
; /* Size of translate table. */
3016 int pos
, pos_byte
, end_pos
;
3017 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
3018 int string_multibyte
;
3021 validate_region (&start
, &end
);
3022 if (CHAR_TABLE_P (table
))
3024 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
3025 error ("Not a translation table");
3031 CHECK_STRING (table
);
3033 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
3034 table
= string_make_unibyte (table
);
3035 string_multibyte
= SCHARS (table
) < SBYTES (table
);
3036 size
= SBYTES (table
);
3041 pos_byte
= CHAR_TO_BYTE (pos
);
3042 end_pos
= XINT (end
);
3043 modify_region (current_buffer
, pos
, end_pos
, 0);
3046 for (; pos
< end_pos
; )
3048 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3049 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
3055 oc
= STRING_CHAR_AND_LENGTH (p
, MAX_MULTIBYTE_LENGTH
, len
);
3062 /* Reload as signal_after_change in last iteration may GC. */
3064 if (string_multibyte
)
3066 str
= tt
+ string_char_to_byte (table
, oc
);
3067 nc
= STRING_CHAR_AND_LENGTH (str
, MAX_MULTIBYTE_LENGTH
,
3073 if (! ASCII_BYTE_P (nc
) && multibyte
)
3075 str_len
= BYTE8_STRING (nc
, buf
);
3090 val
= CHAR_TABLE_REF (table
, oc
);
3091 if (CHARACTERP (val
)
3092 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3095 str_len
= CHAR_STRING (nc
, buf
);
3098 else if (VECTORP (val
) || (CONSP (val
)))
3100 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3101 where TO is TO-CHAR or [TO-CHAR ...]. */
3106 if (nc
!= oc
&& nc
>= 0)
3108 /* Simple one char to one char translation. */
3113 /* This is less efficient, because it moves the gap,
3114 but it should handle multibyte characters correctly. */
3115 string
= make_multibyte_string (str
, 1, str_len
);
3116 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3121 record_change (pos
, 1);
3122 while (str_len
-- > 0)
3124 signal_after_change (pos
, 1, 1);
3125 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3135 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3142 /* VAL is ([FROM-CHAR ...] . TO). */
3143 len
= ASIZE (XCAR (val
));
3151 string
= Fconcat (1, &val
);
3155 string
= Fmake_string (make_number (1), val
);
3157 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3158 pos_byte
+= SBYTES (string
);
3159 pos
+= SCHARS (string
);
3160 cnt
+= SCHARS (string
);
3161 end_pos
+= SCHARS (string
) - len
;
3169 return make_number (cnt
);
3172 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3173 doc
: /* Delete the text between point and mark.
3175 When called from a program, expects two arguments,
3176 positions (integers or markers) specifying the stretch to be deleted. */)
3178 Lisp_Object start
, end
;
3180 validate_region (&start
, &end
);
3181 del_range (XINT (start
), XINT (end
));
3185 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3186 Sdelete_and_extract_region
, 2, 2, 0,
3187 doc
: /* Delete the text between START and END and return it. */)
3189 Lisp_Object start
, end
;
3191 validate_region (&start
, &end
);
3192 if (XINT (start
) == XINT (end
))
3193 return empty_unibyte_string
;
3194 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3197 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3198 doc
: /* Remove restrictions (narrowing) from current buffer.
3199 This allows the buffer's full text to be seen and edited. */)
3202 if (BEG
!= BEGV
|| Z
!= ZV
)
3203 current_buffer
->clip_changed
= 1;
3205 BEGV_BYTE
= BEG_BYTE
;
3206 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3207 /* Changing the buffer bounds invalidates any recorded current column. */
3208 invalidate_current_column ();
3212 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3213 doc
: /* Restrict editing in this buffer to the current region.
3214 The rest of the text becomes temporarily invisible and untouchable
3215 but is not deleted; if you save the buffer in a file, the invisible
3216 text is included in the file. \\[widen] makes all visible again.
3217 See also `save-restriction'.
3219 When calling from a program, pass two arguments; positions (integers
3220 or markers) bounding the text that should remain visible. */)
3222 register Lisp_Object start
, end
;
3224 CHECK_NUMBER_COERCE_MARKER (start
);
3225 CHECK_NUMBER_COERCE_MARKER (end
);
3227 if (XINT (start
) > XINT (end
))
3230 tem
= start
; start
= end
; end
= tem
;
3233 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3234 args_out_of_range (start
, end
);
3236 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3237 current_buffer
->clip_changed
= 1;
3239 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3240 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3241 if (PT
< XFASTINT (start
))
3242 SET_PT (XFASTINT (start
));
3243 if (PT
> XFASTINT (end
))
3244 SET_PT (XFASTINT (end
));
3245 /* Changing the buffer bounds invalidates any recorded current column. */
3246 invalidate_current_column ();
3251 save_restriction_save ()
3253 if (BEGV
== BEG
&& ZV
== Z
)
3254 /* The common case that the buffer isn't narrowed.
3255 We return just the buffer object, which save_restriction_restore
3256 recognizes as meaning `no restriction'. */
3257 return Fcurrent_buffer ();
3259 /* We have to save a restriction, so return a pair of markers, one
3260 for the beginning and one for the end. */
3262 Lisp_Object beg
, end
;
3264 beg
= buildmark (BEGV
, BEGV_BYTE
);
3265 end
= buildmark (ZV
, ZV_BYTE
);
3267 /* END must move forward if text is inserted at its exact location. */
3268 XMARKER(end
)->insertion_type
= 1;
3270 return Fcons (beg
, end
);
3275 save_restriction_restore (data
)
3279 /* A pair of marks bounding a saved restriction. */
3281 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3282 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3283 struct buffer
*buf
= beg
->buffer
; /* END should have the same buffer. */
3285 if (buf
/* Verify marker still points to a buffer. */
3286 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3287 /* The restriction has changed from the saved one, so restore
3288 the saved restriction. */
3290 int pt
= BUF_PT (buf
);
3292 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3293 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3295 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3296 /* The point is outside the new visible range, move it inside. */
3297 SET_BUF_PT_BOTH (buf
,
3298 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3299 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3302 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3306 /* A buffer, which means that there was no old restriction. */
3308 struct buffer
*buf
= XBUFFER (data
);
3310 if (buf
/* Verify marker still points to a buffer. */
3311 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3312 /* The buffer has been narrowed, get rid of the narrowing. */
3314 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3315 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3317 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3324 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3325 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3326 The buffer's restrictions make parts of the beginning and end invisible.
3327 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3328 This special form, `save-restriction', saves the current buffer's restrictions
3329 when it is entered, and restores them when it is exited.
3330 So any `narrow-to-region' within BODY lasts only until the end of the form.
3331 The old restrictions settings are restored
3332 even in case of abnormal exit (throw or error).
3334 The value returned is the value of the last form in BODY.
3336 Note: if you are using both `save-excursion' and `save-restriction',
3337 use `save-excursion' outermost:
3338 (save-excursion (save-restriction ...))
3340 usage: (save-restriction &rest BODY) */)
3344 register Lisp_Object val
;
3345 int count
= SPECPDL_INDEX ();
3347 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3348 val
= Fprogn (body
);
3349 return unbind_to (count
, val
);
3352 /* Buffer for the most recent text displayed by Fmessage_box. */
3353 static char *message_text
;
3355 /* Allocated length of that buffer. */
3356 static int message_length
;
3358 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3359 doc
: /* Display a message at the bottom of the screen.
3360 The message also goes into the `*Messages*' buffer.
3361 \(In keyboard macros, that's all it does.)
3364 The first argument is a format control string, and the rest are data
3365 to be formatted under control of the string. See `format' for details.
3367 Note: Use (message "%s" VALUE) to print the value of expressions and
3368 variables to avoid accidentally interpreting `%' as format specifiers.
3370 If the first argument is nil or the empty string, the function clears
3371 any existing message; this lets the minibuffer contents show. See
3372 also `current-message'.
3374 usage: (message FORMAT-STRING &rest ARGS) */)
3380 || (STRINGP (args
[0])
3381 && SBYTES (args
[0]) == 0))
3388 register Lisp_Object val
;
3389 val
= Fformat (nargs
, args
);
3390 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3395 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3396 doc
: /* Display a message, in a dialog box if possible.
3397 If a dialog box is not available, use the echo area.
3398 The first argument is a format control string, and the rest are data
3399 to be formatted under control of the string. See `format' for details.
3401 If the first argument is nil or the empty string, clear any existing
3402 message; let the minibuffer contents show.
3404 usage: (message-box FORMAT-STRING &rest ARGS) */)
3416 register Lisp_Object val
;
3417 val
= Fformat (nargs
, args
);
3419 /* The MS-DOS frames support popup menus even though they are
3420 not FRAME_WINDOW_P. */
3421 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3422 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3424 Lisp_Object pane
, menu
, obj
;
3425 struct gcpro gcpro1
;
3426 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3428 menu
= Fcons (val
, pane
);
3429 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3433 #endif /* HAVE_MENUS */
3434 /* Copy the data so that it won't move when we GC. */
3437 message_text
= (char *)xmalloc (80);
3438 message_length
= 80;
3440 if (SBYTES (val
) > message_length
)
3442 message_length
= SBYTES (val
);
3443 message_text
= (char *)xrealloc (message_text
, message_length
);
3445 bcopy (SDATA (val
), message_text
, SBYTES (val
));
3446 message2 (message_text
, SBYTES (val
),
3447 STRING_MULTIBYTE (val
));
3452 extern Lisp_Object last_nonmenu_event
;
3455 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3456 doc
: /* Display a message in a dialog box or in the echo area.
3457 If this command was invoked with the mouse, use a dialog box if
3458 `use-dialog-box' is non-nil.
3459 Otherwise, use the echo area.
3460 The first argument is a format control string, and the rest are data
3461 to be formatted under control of the string. See `format' for details.
3463 If the first argument is nil or the empty string, clear any existing
3464 message; let the minibuffer contents show.
3466 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3472 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3474 return Fmessage_box (nargs
, args
);
3476 return Fmessage (nargs
, args
);
3479 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3480 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3483 return current_message ();
3487 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3488 doc
: /* Return a copy of STRING with text properties added.
3489 First argument is the string to copy.
3490 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3491 properties to add to the result.
3492 usage: (propertize STRING &rest PROPERTIES) */)
3497 Lisp_Object properties
, string
;
3498 struct gcpro gcpro1
, gcpro2
;
3501 /* Number of args must be odd. */
3502 if ((nargs
& 1) == 0 || nargs
< 1)
3503 error ("Wrong number of arguments");
3505 properties
= string
= Qnil
;
3506 GCPRO2 (properties
, string
);
3508 /* First argument must be a string. */
3509 CHECK_STRING (args
[0]);
3510 string
= Fcopy_sequence (args
[0]);
3512 for (i
= 1; i
< nargs
; i
+= 2)
3513 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3515 Fadd_text_properties (make_number (0),
3516 make_number (SCHARS (string
)),
3517 properties
, string
);
3518 RETURN_UNGCPRO (string
);
3522 /* Number of bytes that STRING will occupy when put into the result.
3523 MULTIBYTE is nonzero if the result should be multibyte. */
3525 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3526 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3527 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3530 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3531 doc
: /* Format a string out of a format-string and arguments.
3532 The first argument is a format control string.
3533 The other arguments are substituted into it to make the result, a string.
3535 The format control string may contain %-sequences meaning to substitute
3536 the next available argument:
3538 %s means print a string argument. Actually, prints any object, with `princ'.
3539 %d means print as number in decimal (%o octal, %x hex).
3540 %X is like %x, but uses upper case.
3541 %e means print a number in exponential notation.
3542 %f means print a number in decimal-point notation.
3543 %g means print a number in exponential notation
3544 or decimal-point notation, whichever uses fewer characters.
3545 %c means print a number as a single character.
3546 %S means print any object as an s-expression (using `prin1').
3548 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3549 Use %% to put a single % into the output.
3551 A %-sequence may contain optional flag, width, and precision
3552 specifiers, as follows:
3554 %<flags><width><precision>character
3556 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3558 The + flag character inserts a + before any positive number, while a
3559 space inserts a space before any positive number; these flags only
3560 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3561 The # flag means to use an alternate display form for %o, %x, %X, %e,
3562 %f, and %g sequences. The - and 0 flags affect the width specifier,
3565 The width specifier supplies a lower limit for the length of the
3566 printed representation. The padding, if any, normally goes on the
3567 left, but it goes on the right if the - flag is present. The padding
3568 character is normally a space, but it is 0 if the 0 flag is present.
3569 The - flag takes precedence over the 0 flag.
3571 For %e, %f, and %g sequences, the number after the "." in the
3572 precision specifier says how many decimal places to show; if zero, the
3573 decimal point itself is omitted. For %s and %S, the precision
3574 specifier truncates the string to the given width.
3576 usage: (format STRING &rest OBJECTS) */)
3579 register Lisp_Object
*args
;
3581 register int n
; /* The number of the next arg to substitute */
3582 register int total
; /* An estimate of the final length */
3584 register unsigned char *format
, *end
, *format_start
;
3586 /* Nonzero if the output should be a multibyte string,
3587 which is true if any of the inputs is one. */
3589 /* When we make a multibyte string, we must pay attention to the
3590 byte combining problem, i.e., a byte may be combined with a
3591 multibyte charcter of the previous string. This flag tells if we
3592 must consider such a situation or not. */
3593 int maybe_combine_byte
;
3594 unsigned char *this_format
;
3595 /* Precision for each spec, or -1, a flag value meaning no precision
3596 was given in that spec. Element 0, corresonding to the format
3597 string itself, will not be used. Element NARGS, corresponding to
3598 no argument, *will* be assigned to in the case that a `%' and `.'
3599 occur after the final format specifier. */
3600 int *precision
= (int *) (alloca((nargs
+ 1) * sizeof (int)));
3603 int arg_intervals
= 0;
3606 /* discarded[I] is 1 if byte I of the format
3607 string was not copied into the output.
3608 It is 2 if byte I was not the first byte of its character. */
3609 char *discarded
= 0;
3611 /* Each element records, for one argument,
3612 the start and end bytepos in the output string,
3613 and whether the argument is a string with intervals.
3614 info[0] is unused. Unused elements have -1 for start. */
3617 int start
, end
, intervals
;
3620 /* It should not be necessary to GCPRO ARGS, because
3621 the caller in the interpreter should take care of that. */
3623 /* Try to determine whether the result should be multibyte.
3624 This is not always right; sometimes the result needs to be multibyte
3625 because of an object that we will pass through prin1,
3626 and in that case, we won't know it here. */
3627 for (n
= 0; n
< nargs
; n
++)
3629 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3631 /* Piggyback on this loop to initialize precision[N]. */
3634 precision
[nargs
] = -1;
3636 CHECK_STRING (args
[0]);
3637 /* We may have to change "%S" to "%s". */
3638 args
[0] = Fcopy_sequence (args
[0]);
3640 /* GC should never happen here, so abort if it does. */
3643 /* If we start out planning a unibyte result,
3644 then discover it has to be multibyte, we jump back to retry.
3645 That can only happen from the first large while loop below. */
3648 format
= SDATA (args
[0]);
3649 format_start
= format
;
3650 end
= format
+ SBYTES (args
[0]);
3653 /* Make room in result for all the non-%-codes in the control string. */
3654 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3656 /* Allocate the info and discarded tables. */
3658 int nbytes
= (nargs
+1) * sizeof *info
;
3661 info
= (struct info
*) alloca (nbytes
);
3662 bzero (info
, nbytes
);
3663 for (i
= 0; i
<= nargs
; i
++)
3666 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3667 bzero (discarded
, SBYTES (args
[0]));
3670 /* Add to TOTAL enough space to hold the converted arguments. */
3673 while (format
!= end
)
3674 if (*format
++ == '%')
3677 int actual_width
= 0;
3678 unsigned char *this_format_start
= format
- 1;
3679 int field_width
= 0;
3681 /* General format specifications look like
3683 '%' [flags] [field-width] [precision] format
3688 field-width ::= [0-9]+
3689 precision ::= '.' [0-9]*
3691 If a field-width is specified, it specifies to which width
3692 the output should be padded with blanks, if the output
3693 string is shorter than field-width.
3695 If precision is specified, it specifies the number of
3696 digits to print after the '.' for floats, or the max.
3697 number of chars to print from a string. */
3699 while (format
!= end
3700 && (*format
== '-' || *format
== '0' || *format
== '#'
3701 || * format
== ' ' || *format
== '+'))
3704 if (*format
>= '0' && *format
<= '9')
3706 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3707 field_width
= 10 * field_width
+ *format
- '0';
3710 /* N is not incremented for another few lines below, so refer to
3711 element N+1 (which might be precision[NARGS]). */
3715 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3716 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3719 /* Extra +1 for 'l' that we may need to insert into the
3721 if (format
- this_format_start
+ 2 > longest_format
)
3722 longest_format
= format
- this_format_start
+ 2;
3725 error ("Format string ends in middle of format specifier");
3728 else if (++n
>= nargs
)
3729 error ("Not enough arguments for format string");
3730 else if (*format
== 'S')
3732 /* For `S', prin1 the argument and then treat like a string. */
3733 register Lisp_Object tem
;
3734 tem
= Fprin1_to_string (args
[n
], Qnil
);
3735 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3741 /* If we restart the loop, we should not come here again
3742 because args[n] is now a string and calling
3743 Fprin1_to_string on it produces superflous double
3744 quotes. So, change "%S" to "%s" now. */
3748 else if (SYMBOLP (args
[n
]))
3750 args
[n
] = SYMBOL_NAME (args
[n
]);
3751 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3758 else if (STRINGP (args
[n
]))
3761 if (*format
!= 's' && *format
!= 'S')
3762 error ("Format specifier doesn't match argument type");
3763 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3764 to be as large as is calculated here. Easy check for
3765 the case PRECISION = 0. */
3766 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3767 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3769 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3770 else if (INTEGERP (args
[n
]) && *format
!= 's')
3772 /* The following loop assumes the Lisp type indicates
3773 the proper way to pass the argument.
3774 So make sure we have a flonum if the argument should
3776 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3777 args
[n
] = Ffloat (args
[n
]);
3779 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3780 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3781 error ("Invalid format operation %%%c", *format
);
3783 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3786 if (! ASCII_CHAR_P (XINT (args
[n
]))
3787 /* Note: No one can remeber why we have to treat
3788 the character 0 as a multibyte character here.
3789 But, until it causes a real problem, let's
3791 || XINT (args
[n
]) == 0)
3798 args
[n
] = Fchar_to_string (args
[n
]);
3799 thissize
= SBYTES (args
[n
]);
3801 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3804 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3805 thissize
= SBYTES (args
[n
]);
3809 else if (FLOATP (args
[n
]) && *format
!= 's')
3811 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3813 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3814 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3815 error ("Invalid format operation %%%c", *format
);
3816 /* This fails unnecessarily if args[n] is bigger than
3817 most-positive-fixnum but smaller than MAXINT.
3818 These cases are important because we sometimes use floats
3819 to represent such integer values (typically such values
3820 come from UIDs or PIDs). */
3821 /* args[n] = Ftruncate (args[n], Qnil); */
3824 /* Note that we're using sprintf to print floats,
3825 so we have to take into account what that function
3827 /* Filter out flag value of -1. */
3828 thissize
= (MAX_10_EXP
+ 100
3829 + (precision
[n
] > 0 ? precision
[n
] : 0));
3833 /* Anything but a string, convert to a string using princ. */
3834 register Lisp_Object tem
;
3835 tem
= Fprin1_to_string (args
[n
], Qt
);
3836 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3845 thissize
+= max (0, field_width
- actual_width
);
3846 total
+= thissize
+ 4;
3851 /* Now we can no longer jump to retry.
3852 TOTAL and LONGEST_FORMAT are known for certain. */
3854 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3856 /* Allocate the space for the result.
3857 Note that TOTAL is an overestimate. */
3858 SAFE_ALLOCA (buf
, char *, total
);
3864 /* Scan the format and store result in BUF. */
3865 format
= SDATA (args
[0]);
3866 format_start
= format
;
3867 end
= format
+ SBYTES (args
[0]);
3868 maybe_combine_byte
= 0;
3869 while (format
!= end
)
3875 unsigned char *this_format_start
= format
;
3877 discarded
[format
- format_start
] = 1;
3880 while (index("-+0# ", *format
))
3886 discarded
[format
- format_start
] = 1;
3890 minlen
= atoi (format
);
3892 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3894 discarded
[format
- format_start
] = 1;
3898 if (*format
++ == '%')
3907 discarded
[format
- format_start
- 1] = 1;
3908 info
[n
].start
= nchars
;
3910 if (STRINGP (args
[n
]))
3912 /* handle case (precision[n] >= 0) */
3915 int nbytes
, start
, end
;
3918 /* lisp_string_width ignores a precision of 0, but GNU
3919 libc functions print 0 characters when the precision
3920 is 0. Imitate libc behavior here. Changing
3921 lisp_string_width is the right thing, and will be
3922 done, but meanwhile we work with it. */
3924 if (precision
[n
] == 0)
3925 width
= nchars_string
= nbytes
= 0;
3926 else if (precision
[n
] > 0)
3927 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3929 { /* no precision spec given for this argument */
3930 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3931 nbytes
= SBYTES (args
[n
]);
3932 nchars_string
= SCHARS (args
[n
]);
3935 /* If spec requires it, pad on right with spaces. */
3936 padding
= minlen
- width
;
3938 while (padding
-- > 0)
3944 info
[n
].start
= start
= nchars
;
3945 nchars
+= nchars_string
;
3950 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3951 && STRING_MULTIBYTE (args
[n
])
3952 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3953 maybe_combine_byte
= 1;
3955 p
+= copy_text (SDATA (args
[n
]), p
,
3957 STRING_MULTIBYTE (args
[n
]), multibyte
);
3959 info
[n
].end
= nchars
;
3962 while (padding
-- > 0)
3968 /* If this argument has text properties, record where
3969 in the result string it appears. */
3970 if (STRING_INTERVALS (args
[n
]))
3971 info
[n
].intervals
= arg_intervals
= 1;
3973 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3977 bcopy (this_format_start
, this_format
,
3978 format
- this_format_start
);
3979 this_format
[format
- this_format_start
] = 0;
3981 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
3982 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3985 if (sizeof (EMACS_INT
) > sizeof (int)
3986 && format
[-1] != 'c')
3988 /* Insert 'l' before format spec. */
3989 this_format
[format
- this_format_start
]
3990 = this_format
[format
- this_format_start
- 1];
3991 this_format
[format
- this_format_start
- 1] = 'l';
3992 this_format
[format
- this_format_start
+ 1] = 0;
3995 if (INTEGERP (args
[n
]))
3997 if (format
[-1] == 'c')
3998 sprintf (p
, this_format
, (int) XINT (args
[n
]));
3999 else if (format
[-1] == 'd')
4000 sprintf (p
, this_format
, XINT (args
[n
]));
4001 /* Don't sign-extend for octal or hex printing. */
4003 sprintf (p
, this_format
, XUINT (args
[n
]));
4005 else if (format
[-1] == 'c')
4006 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
4007 else if (format
[-1] == 'd')
4008 /* Maybe we should use "%1.0f" instead so it also works
4009 for values larger than MAXINT. */
4010 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
4012 /* Don't sign-extend for octal or hex printing. */
4013 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
4018 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4019 && !CHAR_HEAD_P (*((unsigned char *) p
)))
4020 maybe_combine_byte
= 1;
4021 this_nchars
= strlen (p
);
4023 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
4026 nchars
+= this_nchars
;
4027 info
[n
].end
= nchars
;
4031 else if (STRING_MULTIBYTE (args
[0]))
4033 /* Copy a whole multibyte character. */
4036 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4037 && !CHAR_HEAD_P (*format
))
4038 maybe_combine_byte
= 1;
4040 while (! CHAR_HEAD_P (*format
))
4042 discarded
[format
- format_start
] = 2;
4049 /* Convert a single-byte character to multibyte. */
4050 int len
= copy_text (format
, p
, 1, 0, 1);
4057 *p
++ = *format
++, nchars
++;
4060 if (p
> buf
+ total
)
4063 if (maybe_combine_byte
)
4064 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
4065 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4067 /* If we allocated BUF with malloc, free it too. */
4070 /* If the format string has text properties, or any of the string
4071 arguments has text properties, set up text properties of the
4074 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4076 Lisp_Object len
, new_len
, props
;
4077 struct gcpro gcpro1
;
4079 /* Add text properties from the format string. */
4080 len
= make_number (SCHARS (args
[0]));
4081 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4086 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4089 /* Adjust the bounds of each text property
4090 to the proper start and end in the output string. */
4092 /* Put the positions in PROPS in increasing order, so that
4093 we can do (effectively) one scan through the position
4094 space of the format string. */
4095 props
= Fnreverse (props
);
4097 /* BYTEPOS is the byte position in the format string,
4098 POSITION is the untranslated char position in it,
4099 TRANSLATED is the translated char position in BUF,
4100 and ARGN is the number of the next arg we will come to. */
4101 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4108 /* First adjust the property start position. */
4109 pos
= XINT (XCAR (item
));
4111 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4112 up to this position. */
4113 for (; position
< pos
; bytepos
++)
4115 if (! discarded
[bytepos
])
4116 position
++, translated
++;
4117 else if (discarded
[bytepos
] == 1)
4120 if (translated
== info
[argn
].start
)
4122 translated
+= info
[argn
].end
- info
[argn
].start
;
4128 XSETCAR (item
, make_number (translated
));
4130 /* Likewise adjust the property end position. */
4131 pos
= XINT (XCAR (XCDR (item
)));
4133 for (; position
< pos
; bytepos
++)
4135 if (! discarded
[bytepos
])
4136 position
++, translated
++;
4137 else if (discarded
[bytepos
] == 1)
4140 if (translated
== info
[argn
].start
)
4142 translated
+= info
[argn
].end
- info
[argn
].start
;
4148 XSETCAR (XCDR (item
), make_number (translated
));
4151 add_text_properties_from_list (val
, props
, make_number (0));
4154 /* Add text properties from arguments. */
4156 for (n
= 1; n
< nargs
; ++n
)
4157 if (info
[n
].intervals
)
4159 len
= make_number (SCHARS (args
[n
]));
4160 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4161 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4162 extend_property_ranges (props
, len
, new_len
);
4163 /* If successive arguments have properites, be sure that
4164 the value of `composition' property be the copy. */
4165 if (n
> 1 && info
[n
- 1].end
)
4166 make_composition_value_copy (props
);
4167 add_text_properties_from_list (val
, props
,
4168 make_number (info
[n
].start
));
4178 format2 (string1
, arg0
, arg1
)
4180 Lisp_Object arg0
, arg1
;
4182 Lisp_Object args
[3];
4183 args
[0] = build_string (string1
);
4186 return Fformat (3, args
);
4189 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4190 doc
: /* Return t if two characters match, optionally ignoring case.
4191 Both arguments must be characters (i.e. integers).
4192 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4194 register Lisp_Object c1
, c2
;
4197 /* Check they're chars, not just integers, otherwise we could get array
4198 bounds violations in DOWNCASE. */
4199 CHECK_CHARACTER (c1
);
4200 CHECK_CHARACTER (c2
);
4202 if (XINT (c1
) == XINT (c2
))
4204 if (NILP (current_buffer
->case_fold_search
))
4207 /* Do these in separate statements,
4208 then compare the variables.
4209 because of the way DOWNCASE uses temp variables. */
4211 if (NILP (current_buffer
->enable_multibyte_characters
)
4212 && ! ASCII_CHAR_P (i1
))
4214 MAKE_CHAR_MULTIBYTE (i1
);
4217 if (NILP (current_buffer
->enable_multibyte_characters
)
4218 && ! ASCII_CHAR_P (i2
))
4220 MAKE_CHAR_MULTIBYTE (i2
);
4224 return (i1
== i2
? Qt
: Qnil
);
4227 /* Transpose the markers in two regions of the current buffer, and
4228 adjust the ones between them if necessary (i.e.: if the regions
4231 START1, END1 are the character positions of the first region.
4232 START1_BYTE, END1_BYTE are the byte positions.
4233 START2, END2 are the character positions of the second region.
4234 START2_BYTE, END2_BYTE are the byte positions.
4236 Traverses the entire marker list of the buffer to do so, adding an
4237 appropriate amount to some, subtracting from some, and leaving the
4238 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4240 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4243 transpose_markers (start1
, end1
, start2
, end2
,
4244 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
4245 register int start1
, end1
, start2
, end2
;
4246 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
4248 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4249 register struct Lisp_Marker
*marker
;
4251 /* Update point as if it were a marker. */
4255 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4256 PT_BYTE
+ (end2_byte
- end1_byte
));
4257 else if (PT
< start2
)
4258 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4259 (PT_BYTE
+ (end2_byte
- start2_byte
)
4260 - (end1_byte
- start1_byte
)));
4262 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4263 PT_BYTE
- (start2_byte
- start1_byte
));
4265 /* We used to adjust the endpoints here to account for the gap, but that
4266 isn't good enough. Even if we assume the caller has tried to move the
4267 gap out of our way, it might still be at start1 exactly, for example;
4268 and that places it `inside' the interval, for our purposes. The amount
4269 of adjustment is nontrivial if there's a `denormalized' marker whose
4270 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4271 the dirty work to Fmarker_position, below. */
4273 /* The difference between the region's lengths */
4274 diff
= (end2
- start2
) - (end1
- start1
);
4275 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4277 /* For shifting each marker in a region by the length of the other
4278 region plus the distance between the regions. */
4279 amt1
= (end2
- start2
) + (start2
- end1
);
4280 amt2
= (end1
- start1
) + (start2
- end1
);
4281 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4282 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4284 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4286 mpos
= marker
->bytepos
;
4287 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4289 if (mpos
< end1_byte
)
4291 else if (mpos
< start2_byte
)
4295 marker
->bytepos
= mpos
;
4297 mpos
= marker
->charpos
;
4298 if (mpos
>= start1
&& mpos
< end2
)
4302 else if (mpos
< start2
)
4307 marker
->charpos
= mpos
;
4311 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4312 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4313 The regions should not be overlapping, because the size of the buffer is
4314 never changed in a transposition.
4316 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4317 any markers that happen to be located in the regions.
4319 Transposing beyond buffer boundaries is an error. */)
4320 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
4321 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
4323 register EMACS_INT start1
, end1
, start2
, end2
;
4324 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4325 EMACS_INT gap
, len1
, len_mid
, len2
;
4326 unsigned char *start1_addr
, *start2_addr
, *temp
;
4328 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4331 XSETBUFFER (buf
, current_buffer
);
4332 cur_intv
= BUF_INTERVALS (current_buffer
);
4334 validate_region (&startr1
, &endr1
);
4335 validate_region (&startr2
, &endr2
);
4337 start1
= XFASTINT (startr1
);
4338 end1
= XFASTINT (endr1
);
4339 start2
= XFASTINT (startr2
);
4340 end2
= XFASTINT (endr2
);
4343 /* Swap the regions if they're reversed. */
4346 register int glumph
= start1
;
4354 len1
= end1
- start1
;
4355 len2
= end2
- start2
;
4358 error ("Transposed regions overlap");
4359 else if (start1
== end1
|| start2
== end2
)
4360 error ("Transposed region has length 0");
4362 /* The possibilities are:
4363 1. Adjacent (contiguous) regions, or separate but equal regions
4364 (no, really equal, in this case!), or
4365 2. Separate regions of unequal size.
4367 The worst case is usually No. 2. It means that (aside from
4368 potential need for getting the gap out of the way), there also
4369 needs to be a shifting of the text between the two regions. So
4370 if they are spread far apart, we are that much slower... sigh. */
4372 /* It must be pointed out that the really studly thing to do would
4373 be not to move the gap at all, but to leave it in place and work
4374 around it if necessary. This would be extremely efficient,
4375 especially considering that people are likely to do
4376 transpositions near where they are working interactively, which
4377 is exactly where the gap would be found. However, such code
4378 would be much harder to write and to read. So, if you are
4379 reading this comment and are feeling squirrely, by all means have
4380 a go! I just didn't feel like doing it, so I will simply move
4381 the gap the minimum distance to get it out of the way, and then
4382 deal with an unbroken array. */
4384 /* Make sure the gap won't interfere, by moving it out of the text
4385 we will operate on. */
4386 if (start1
< gap
&& gap
< end2
)
4388 if (gap
- start1
< end2
- gap
)
4394 start1_byte
= CHAR_TO_BYTE (start1
);
4395 start2_byte
= CHAR_TO_BYTE (start2
);
4396 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4397 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4399 #ifdef BYTE_COMBINING_DEBUG
4402 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4403 len2_byte
, start1
, start1_byte
)
4404 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4405 len1_byte
, end2
, start2_byte
+ len2_byte
)
4406 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4407 len1_byte
, end2
, start2_byte
+ len2_byte
))
4412 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4413 len2_byte
, start1
, start1_byte
)
4414 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4415 len1_byte
, start2
, start2_byte
)
4416 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4417 len2_byte
, end1
, start1_byte
+ len1_byte
)
4418 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4419 len1_byte
, end2
, start2_byte
+ len2_byte
))
4424 /* Hmmm... how about checking to see if the gap is large
4425 enough to use as the temporary storage? That would avoid an
4426 allocation... interesting. Later, don't fool with it now. */
4428 /* Working without memmove, for portability (sigh), so must be
4429 careful of overlapping subsections of the array... */
4431 if (end1
== start2
) /* adjacent regions */
4433 modify_region (current_buffer
, start1
, end2
, 0);
4434 record_change (start1
, len1
+ len2
);
4436 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4437 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4438 /* Don't use Fset_text_properties: that can cause GC, which can
4439 clobber objects stored in the tmp_intervals. */
4440 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4441 if (!NULL_INTERVAL_P (tmp_interval3
))
4442 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4444 /* First region smaller than second. */
4445 if (len1_byte
< len2_byte
)
4449 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4451 /* Don't precompute these addresses. We have to compute them
4452 at the last minute, because the relocating allocator might
4453 have moved the buffer around during the xmalloc. */
4454 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4455 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4457 bcopy (start2_addr
, temp
, len2_byte
);
4458 bcopy (start1_addr
, start1_addr
+ len2_byte
, len1_byte
);
4459 bcopy (temp
, start1_addr
, len2_byte
);
4463 /* First region not smaller than second. */
4467 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4468 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4469 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4470 bcopy (start1_addr
, temp
, len1_byte
);
4471 bcopy (start2_addr
, start1_addr
, len2_byte
);
4472 bcopy (temp
, start1_addr
+ len2_byte
, len1_byte
);
4475 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4476 len1
, current_buffer
, 0);
4477 graft_intervals_into_buffer (tmp_interval2
, start1
,
4478 len2
, current_buffer
, 0);
4479 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4480 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4482 /* Non-adjacent regions, because end1 != start2, bleagh... */
4485 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4487 if (len1_byte
== len2_byte
)
4488 /* Regions are same size, though, how nice. */
4492 modify_region (current_buffer
, start1
, end1
, 0);
4493 modify_region (current_buffer
, start2
, end2
, 0);
4494 record_change (start1
, len1
);
4495 record_change (start2
, len2
);
4496 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4497 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4499 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4500 if (!NULL_INTERVAL_P (tmp_interval3
))
4501 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4503 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4504 if (!NULL_INTERVAL_P (tmp_interval3
))
4505 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4507 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4508 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4509 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4510 bcopy (start1_addr
, temp
, len1_byte
);
4511 bcopy (start2_addr
, start1_addr
, len2_byte
);
4512 bcopy (temp
, start2_addr
, len1_byte
);
4515 graft_intervals_into_buffer (tmp_interval1
, start2
,
4516 len1
, current_buffer
, 0);
4517 graft_intervals_into_buffer (tmp_interval2
, start1
,
4518 len2
, current_buffer
, 0);
4521 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4522 /* Non-adjacent & unequal size, area between must also be shifted. */
4526 modify_region (current_buffer
, start1
, end2
, 0);
4527 record_change (start1
, (end2
- start1
));
4528 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4529 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4530 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4532 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4533 if (!NULL_INTERVAL_P (tmp_interval3
))
4534 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4536 /* holds region 2 */
4537 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4538 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4539 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4540 bcopy (start2_addr
, temp
, len2_byte
);
4541 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2_byte
, len1_byte
);
4542 safe_bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4543 bcopy (temp
, start1_addr
, len2_byte
);
4546 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4547 len1
, current_buffer
, 0);
4548 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4549 len_mid
, current_buffer
, 0);
4550 graft_intervals_into_buffer (tmp_interval2
, start1
,
4551 len2
, current_buffer
, 0);
4554 /* Second region smaller than first. */
4558 record_change (start1
, (end2
- start1
));
4559 modify_region (current_buffer
, start1
, end2
, 0);
4561 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4562 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4563 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4565 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4566 if (!NULL_INTERVAL_P (tmp_interval3
))
4567 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4569 /* holds region 1 */
4570 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4571 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4572 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4573 bcopy (start1_addr
, temp
, len1_byte
);
4574 bcopy (start2_addr
, start1_addr
, len2_byte
);
4575 bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4576 bcopy (temp
, start1_addr
+ len2_byte
+ len_mid
, len1_byte
);
4579 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4580 len1
, current_buffer
, 0);
4581 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4582 len_mid
, current_buffer
, 0);
4583 graft_intervals_into_buffer (tmp_interval2
, start1
,
4584 len2
, current_buffer
, 0);
4587 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4588 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4591 /* When doing multiple transpositions, it might be nice
4592 to optimize this. Perhaps the markers in any one buffer
4593 should be organized in some sorted data tree. */
4594 if (NILP (leave_markers
))
4596 transpose_markers (start1
, end1
, start2
, end2
,
4597 start1_byte
, start1_byte
+ len1_byte
,
4598 start2_byte
, start2_byte
+ len2_byte
);
4599 fix_start_end_in_overlays (start1
, end2
);
4602 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4613 Qbuffer_access_fontify_functions
4614 = intern ("buffer-access-fontify-functions");
4615 staticpro (&Qbuffer_access_fontify_functions
);
4617 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4618 doc
: /* Non-nil means text motion commands don't notice fields. */);
4619 Vinhibit_field_text_motion
= Qnil
;
4621 DEFVAR_LISP ("buffer-access-fontify-functions",
4622 &Vbuffer_access_fontify_functions
,
4623 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4624 Each function is called with two arguments which specify the range
4625 of the buffer being accessed. */);
4626 Vbuffer_access_fontify_functions
= Qnil
;
4630 extern Lisp_Object Vprin1_to_string_buffer
;
4631 obuf
= Fcurrent_buffer ();
4632 /* Do this here, because init_buffer_once is too early--it won't work. */
4633 Fset_buffer (Vprin1_to_string_buffer
);
4634 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4635 Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
4640 DEFVAR_LISP ("buffer-access-fontified-property",
4641 &Vbuffer_access_fontified_property
,
4642 doc
: /* Property which (if non-nil) indicates text has been fontified.
4643 `buffer-substring' need not call the `buffer-access-fontify-functions'
4644 functions if all the text being accessed has this property. */);
4645 Vbuffer_access_fontified_property
= Qnil
;
4647 DEFVAR_LISP ("system-name", &Vsystem_name
,
4648 doc
: /* The host name of the machine Emacs is running on. */);
4650 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4651 doc
: /* The full name of the user logged in. */);
4653 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4654 doc
: /* The user's name, taken from environment variables if possible. */);
4656 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4657 doc
: /* The user's name, based upon the real uid only. */);
4659 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4660 doc
: /* The release of the operating system Emacs is running on. */);
4662 defsubr (&Spropertize
);
4663 defsubr (&Schar_equal
);
4664 defsubr (&Sgoto_char
);
4665 defsubr (&Sstring_to_char
);
4666 defsubr (&Schar_to_string
);
4667 defsubr (&Sbuffer_substring
);
4668 defsubr (&Sbuffer_substring_no_properties
);
4669 defsubr (&Sbuffer_string
);
4671 defsubr (&Spoint_marker
);
4672 defsubr (&Smark_marker
);
4674 defsubr (&Sregion_beginning
);
4675 defsubr (&Sregion_end
);
4677 staticpro (&Qfield
);
4678 Qfield
= intern ("field");
4679 staticpro (&Qboundary
);
4680 Qboundary
= intern ("boundary");
4681 defsubr (&Sfield_beginning
);
4682 defsubr (&Sfield_end
);
4683 defsubr (&Sfield_string
);
4684 defsubr (&Sfield_string_no_properties
);
4685 defsubr (&Sdelete_field
);
4686 defsubr (&Sconstrain_to_field
);
4688 defsubr (&Sline_beginning_position
);
4689 defsubr (&Sline_end_position
);
4691 /* defsubr (&Smark); */
4692 /* defsubr (&Sset_mark); */
4693 defsubr (&Ssave_excursion
);
4694 defsubr (&Ssave_current_buffer
);
4696 defsubr (&Sbufsize
);
4697 defsubr (&Spoint_max
);
4698 defsubr (&Spoint_min
);
4699 defsubr (&Spoint_min_marker
);
4700 defsubr (&Spoint_max_marker
);
4701 defsubr (&Sgap_position
);
4702 defsubr (&Sgap_size
);
4703 defsubr (&Sposition_bytes
);
4704 defsubr (&Sbyte_to_position
);
4710 defsubr (&Sfollowing_char
);
4711 defsubr (&Sprevious_char
);
4712 defsubr (&Schar_after
);
4713 defsubr (&Schar_before
);
4715 defsubr (&Sinsert_before_markers
);
4716 defsubr (&Sinsert_and_inherit
);
4717 defsubr (&Sinsert_and_inherit_before_markers
);
4718 defsubr (&Sinsert_char
);
4719 defsubr (&Sinsert_byte
);
4721 defsubr (&Suser_login_name
);
4722 defsubr (&Suser_real_login_name
);
4723 defsubr (&Suser_uid
);
4724 defsubr (&Suser_real_uid
);
4725 defsubr (&Suser_full_name
);
4726 defsubr (&Semacs_pid
);
4727 defsubr (&Scurrent_time
);
4728 defsubr (&Sget_internal_run_time
);
4729 defsubr (&Sformat_time_string
);
4730 defsubr (&Sfloat_time
);
4731 defsubr (&Sdecode_time
);
4732 defsubr (&Sencode_time
);
4733 defsubr (&Scurrent_time_string
);
4734 defsubr (&Scurrent_time_zone
);
4735 defsubr (&Sset_time_zone_rule
);
4736 defsubr (&Ssystem_name
);
4737 defsubr (&Smessage
);
4738 defsubr (&Smessage_box
);
4739 defsubr (&Smessage_or_box
);
4740 defsubr (&Scurrent_message
);
4743 defsubr (&Sinsert_buffer_substring
);
4744 defsubr (&Scompare_buffer_substrings
);
4745 defsubr (&Ssubst_char_in_region
);
4746 defsubr (&Stranslate_region_internal
);
4747 defsubr (&Sdelete_region
);
4748 defsubr (&Sdelete_and_extract_region
);
4750 defsubr (&Snarrow_to_region
);
4751 defsubr (&Ssave_restriction
);
4752 defsubr (&Stranspose_regions
);
4755 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4756 (do not change this comment) */