1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
34 #ifdef HAVE_SYS_UTSNAME_H
35 #include <sys/utsname.h>
40 /* systime.h includes <sys/time.h> which, on some systems, is required
41 for <sys/resource.h>; thus systime.h must be included before
45 #if defined HAVE_SYS_RESOURCE_H
46 #include <sys/resource.h>
51 #include "intervals.h"
53 #include "character.h"
57 #include "blockinput.h"
61 #define MAX_10_EXP DBL_MAX_10_EXP
63 #define MAX_10_EXP 310
70 #ifndef USER_FULL_NAME
71 #define USER_FULL_NAME pw->pw_gecos
75 extern char **environ
;
78 #define TM_YEAR_BASE 1900
80 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
81 asctime to have well-defined behavior. */
82 #ifndef TM_YEAR_IN_ASCTIME_RANGE
83 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
84 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
87 extern size_t emacs_strftimeu
P_ ((char *, size_t, const char *,
88 const struct tm
*, int));
91 extern Lisp_Object
w32_get_internal_run_time ();
94 static int tm_diff
P_ ((struct tm
*, struct tm
*));
95 static void find_field
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *));
96 static void update_buffer_properties
P_ ((int, int));
97 static Lisp_Object region_limit
P_ ((int));
98 int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
99 static size_t emacs_memftimeu
P_ ((char *, size_t, const char *,
100 size_t, const struct tm
*, int));
101 static void general_insert_function
P_ ((void (*) (const unsigned char *, int),
102 void (*) (Lisp_Object
, int, int, int,
104 int, int, Lisp_Object
*));
105 static Lisp_Object subst_char_in_region_unwind
P_ ((Lisp_Object
));
106 static Lisp_Object subst_char_in_region_unwind_1
P_ ((Lisp_Object
));
107 static void transpose_markers
P_ ((int, int, int, int, int, int, int, int));
110 extern char *index
P_ ((const char *, int));
113 Lisp_Object Vbuffer_access_fontify_functions
;
114 Lisp_Object Qbuffer_access_fontify_functions
;
115 Lisp_Object Vbuffer_access_fontified_property
;
117 Lisp_Object Fuser_full_name
P_ ((Lisp_Object
));
119 /* Non-nil means don't stop at field boundary in text motion commands. */
121 Lisp_Object Vinhibit_field_text_motion
;
123 /* Some static data, and a function to initialize it for each run */
125 Lisp_Object Vsystem_name
;
126 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
127 Lisp_Object Vuser_full_name
; /* full name of current user */
128 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
129 Lisp_Object Voperating_system_release
; /* Operating System Release */
131 /* Symbol for the text property used to mark fields. */
135 /* A special value for Qfield properties. */
137 Lisp_Object Qboundary
;
144 register unsigned char *p
;
145 struct passwd
*pw
; /* password entry for the current user */
148 /* Set up system_name even when dumping. */
152 /* Don't bother with this on initial start when just dumping out */
155 #endif /* not CANNOT_DUMP */
157 pw
= (struct passwd
*) getpwuid (getuid ());
159 /* We let the real user name default to "root" because that's quite
160 accurate on MSDOG and because it lets Emacs find the init file.
161 (The DVX libraries override the Djgpp libraries here.) */
162 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
164 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
167 /* Get the effective user name, by consulting environment variables,
168 or the effective uid if those are unset. */
169 user_name
= (char *) getenv ("LOGNAME");
172 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
173 #else /* WINDOWSNT */
174 user_name
= (char *) getenv ("USER");
175 #endif /* WINDOWSNT */
178 pw
= (struct passwd
*) getpwuid (geteuid ());
179 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
181 Vuser_login_name
= build_string (user_name
);
183 /* If the user name claimed in the environment vars differs from
184 the real uid, use the claimed name to find the full name. */
185 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
186 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
189 p
= (unsigned char *) getenv ("NAME");
191 Vuser_full_name
= build_string (p
);
192 else if (NILP (Vuser_full_name
))
193 Vuser_full_name
= build_string ("unknown");
195 #ifdef HAVE_SYS_UTSNAME_H
199 Voperating_system_release
= build_string (uts
.release
);
202 Voperating_system_release
= Qnil
;
206 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
207 doc
: /* Convert arg CHAR to a string containing that character.
208 usage: (char-to-string CHAR) */)
210 Lisp_Object character
;
213 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
215 CHECK_CHARACTER (character
);
217 len
= CHAR_STRING (XFASTINT (character
), str
);
218 return make_string_from_bytes (str
, 1, len
);
221 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
222 doc
: /* Convert arg STRING to a character, the first character of that string.
223 A multibyte character is handled correctly. */)
225 register Lisp_Object string
;
227 register Lisp_Object val
;
228 CHECK_STRING (string
);
231 if (STRING_MULTIBYTE (string
))
232 XSETFASTINT (val
, STRING_CHAR (SDATA (string
), SBYTES (string
)));
234 XSETFASTINT (val
, SREF (string
, 0));
237 XSETFASTINT (val
, 0);
242 buildmark (charpos
, bytepos
)
243 int charpos
, bytepos
;
245 register Lisp_Object mark
;
246 mark
= Fmake_marker ();
247 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
251 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
252 doc
: /* Return value of point, as an integer.
253 Beginning of buffer is position (point-min). */)
257 XSETFASTINT (temp
, PT
);
261 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
262 doc
: /* Return value of point, as a marker object. */)
265 return buildmark (PT
, PT_BYTE
);
269 clip_to_bounds (lower
, num
, upper
)
270 int lower
, num
, upper
;
274 else if (num
> upper
)
280 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
281 doc
: /* Set point to POSITION, a number or marker.
282 Beginning of buffer is position (point-min), end is (point-max).
284 The return value is POSITION. */)
286 register Lisp_Object position
;
290 if (MARKERP (position
)
291 && current_buffer
== XMARKER (position
)->buffer
)
293 pos
= marker_position (position
);
295 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
297 SET_PT_BOTH (ZV
, ZV_BYTE
);
299 SET_PT_BOTH (pos
, marker_byte_position (position
));
304 CHECK_NUMBER_COERCE_MARKER (position
);
306 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
312 /* Return the start or end position of the region.
313 BEGINNINGP non-zero means return the start.
314 If there is no region active, signal an error. */
317 region_limit (beginningp
)
320 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
323 if (!NILP (Vtransient_mark_mode
)
324 && NILP (Vmark_even_if_inactive
)
325 && NILP (current_buffer
->mark_active
))
326 xsignal0 (Qmark_inactive
);
328 m
= Fmarker_position (current_buffer
->mark
);
330 error ("The mark is not set now, so there is no region");
332 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
333 m
= make_number (PT
);
337 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
338 doc
: /* Return position of beginning of region, as an integer. */)
341 return region_limit (1);
344 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
345 doc
: /* Return position of end of region, as an integer. */)
348 return region_limit (0);
351 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
352 doc
: /* Return this buffer's mark, as a marker object.
353 Watch out! Moving this marker changes the mark position.
354 If you set the marker not to point anywhere, the buffer will have no mark. */)
357 return current_buffer
->mark
;
361 /* Find all the overlays in the current buffer that touch position POS.
362 Return the number found, and store them in a vector in VEC
366 overlays_around (pos
, vec
, len
)
371 Lisp_Object overlay
, start
, end
;
372 struct Lisp_Overlay
*tail
;
373 int startpos
, endpos
;
376 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
378 XSETMISC (overlay
, tail
);
380 end
= OVERLAY_END (overlay
);
381 endpos
= OVERLAY_POSITION (end
);
384 start
= OVERLAY_START (overlay
);
385 startpos
= OVERLAY_POSITION (start
);
390 /* Keep counting overlays even if we can't return them all. */
395 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
397 XSETMISC (overlay
, tail
);
399 start
= OVERLAY_START (overlay
);
400 startpos
= OVERLAY_POSITION (start
);
403 end
= OVERLAY_END (overlay
);
404 endpos
= OVERLAY_POSITION (end
);
416 /* Return the value of property PROP, in OBJECT at POSITION.
417 It's the value of PROP that a char inserted at POSITION would get.
418 OBJECT is optional and defaults to the current buffer.
419 If OBJECT is a buffer, then overlay properties are considered as well as
421 If OBJECT is a window, then that window's buffer is used, but
422 window-specific overlays are considered only if they are associated
425 get_pos_property (position
, prop
, object
)
426 Lisp_Object position
, object
;
427 register Lisp_Object prop
;
429 CHECK_NUMBER_COERCE_MARKER (position
);
432 XSETBUFFER (object
, current_buffer
);
433 else if (WINDOWP (object
))
434 object
= XWINDOW (object
)->buffer
;
436 if (!BUFFERP (object
))
437 /* pos-property only makes sense in buffers right now, since strings
438 have no overlays and no notion of insertion for which stickiness
440 return Fget_text_property (position
, prop
, object
);
443 int posn
= XINT (position
);
445 Lisp_Object
*overlay_vec
, tem
;
446 struct buffer
*obuf
= current_buffer
;
448 set_buffer_temp (XBUFFER (object
));
450 /* First try with room for 40 overlays. */
452 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
453 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
455 /* If there are more than 40,
456 make enough space for all, and try again. */
459 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
460 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
462 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
464 set_buffer_temp (obuf
);
466 /* Now check the overlays in order of decreasing priority. */
467 while (--noverlays
>= 0)
469 Lisp_Object ol
= overlay_vec
[noverlays
];
470 tem
= Foverlay_get (ol
, prop
);
473 /* Check the overlay is indeed active at point. */
474 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
475 if ((OVERLAY_POSITION (start
) == posn
476 && XMARKER (start
)->insertion_type
== 1)
477 || (OVERLAY_POSITION (finish
) == posn
478 && XMARKER (finish
)->insertion_type
== 0))
479 ; /* The overlay will not cover a char inserted at point. */
487 { /* Now check the text properties. */
488 int stickiness
= text_property_stickiness (prop
, position
, object
);
490 return Fget_text_property (position
, prop
, object
);
491 else if (stickiness
< 0
492 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
493 return Fget_text_property (make_number (XINT (position
) - 1),
501 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
502 the value of point is used instead. If BEG or END is null,
503 means don't store the beginning or end of the field.
505 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
506 results; they do not effect boundary behavior.
508 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
509 position of a field, then the beginning of the previous field is
510 returned instead of the beginning of POS's field (since the end of a
511 field is actually also the beginning of the next input field, this
512 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
513 true case, if two fields are separated by a field with the special
514 value `boundary', and POS lies within it, then the two separated
515 fields are considered to be adjacent, and POS between them, when
516 finding the beginning and ending of the "merged" field.
518 Either BEG or END may be 0, in which case the corresponding value
522 find_field (pos
, merge_at_boundary
, beg_limit
, beg
, end_limit
, end
)
524 Lisp_Object merge_at_boundary
;
525 Lisp_Object beg_limit
, end_limit
;
528 /* Fields right before and after the point. */
529 Lisp_Object before_field
, after_field
;
530 /* 1 if POS counts as the start of a field. */
531 int at_field_start
= 0;
532 /* 1 if POS counts as the end of a field. */
533 int at_field_end
= 0;
536 XSETFASTINT (pos
, PT
);
538 CHECK_NUMBER_COERCE_MARKER (pos
);
541 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
543 = (XFASTINT (pos
) > BEGV
544 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
546 /* Using nil here would be a more obvious choice, but it would
547 fail when the buffer starts with a non-sticky field. */
550 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
551 and POS is at beginning of a field, which can also be interpreted
552 as the end of the previous field. Note that the case where if
553 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
554 more natural one; then we avoid treating the beginning of a field
556 if (NILP (merge_at_boundary
))
558 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
559 if (!EQ (field
, after_field
))
561 if (!EQ (field
, before_field
))
563 if (NILP (field
) && at_field_start
&& at_field_end
)
564 /* If an inserted char would have a nil field while the surrounding
565 text is non-nil, we're probably not looking at a
566 zero-length field, but instead at a non-nil field that's
567 not intended for editing (such as comint's prompts). */
568 at_field_end
= at_field_start
= 0;
571 /* Note about special `boundary' fields:
573 Consider the case where the point (`.') is between the fields `x' and `y':
577 In this situation, if merge_at_boundary is true, we consider the
578 `x' and `y' fields as forming one big merged field, and so the end
579 of the field is the end of `y'.
581 However, if `x' and `y' are separated by a special `boundary' field
582 (a field with a `field' char-property of 'boundary), then we ignore
583 this special field when merging adjacent fields. Here's the same
584 situation, but with a `boundary' field between the `x' and `y' fields:
588 Here, if point is at the end of `x', the beginning of `y', or
589 anywhere in-between (within the `boundary' field), we merge all
590 three fields and consider the beginning as being the beginning of
591 the `x' field, and the end as being the end of the `y' field. */
596 /* POS is at the edge of a field, and we should consider it as
597 the beginning of the following field. */
598 *beg
= XFASTINT (pos
);
600 /* Find the previous field boundary. */
603 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
604 /* Skip a `boundary' field. */
605 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
608 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
610 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
617 /* POS is at the edge of a field, and we should consider it as
618 the end of the previous field. */
619 *end
= XFASTINT (pos
);
621 /* Find the next field boundary. */
623 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
624 /* Skip a `boundary' field. */
625 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
628 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
630 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
636 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
637 doc
: /* Delete the field surrounding POS.
638 A field is a region of text with the same `field' property.
639 If POS is nil, the value of point is used for POS. */)
644 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
646 del_range (beg
, end
);
650 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
651 doc
: /* Return the contents of the field surrounding POS as a string.
652 A field is a region of text with the same `field' property.
653 If POS is nil, the value of point is used for POS. */)
658 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
659 return make_buffer_string (beg
, end
, 1);
662 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
663 doc
: /* Return the contents of the field around POS, without text properties.
664 A field is a region of text with the same `field' property.
665 If POS is nil, the value of point is used for POS. */)
670 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
671 return make_buffer_string (beg
, end
, 0);
674 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
675 doc
: /* Return the beginning of the field surrounding POS.
676 A field is a region of text with the same `field' property.
677 If POS is nil, the value of point is used for POS.
678 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
679 field, then the beginning of the *previous* field is returned.
680 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
681 is before LIMIT, then LIMIT will be returned instead. */)
682 (pos
, escape_from_edge
, limit
)
683 Lisp_Object pos
, escape_from_edge
, limit
;
686 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
687 return make_number (beg
);
690 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
691 doc
: /* Return the end of the field surrounding POS.
692 A field is a region of text with the same `field' property.
693 If POS is nil, the value of point is used for POS.
694 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
695 then the end of the *following* field is returned.
696 If LIMIT is non-nil, it is a buffer position; if the end of the field
697 is after LIMIT, then LIMIT will be returned instead. */)
698 (pos
, escape_from_edge
, limit
)
699 Lisp_Object pos
, escape_from_edge
, limit
;
702 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
703 return make_number (end
);
706 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
707 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
709 A field is a region of text with the same `field' property.
710 If NEW-POS is nil, then the current point is used instead, and set to the
711 constrained position if that is different.
713 If OLD-POS is at the boundary of two fields, then the allowable
714 positions for NEW-POS depends on the value of the optional argument
715 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
716 constrained to the field that has the same `field' char-property
717 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
718 is non-nil, NEW-POS is constrained to the union of the two adjacent
719 fields. Additionally, if two fields are separated by another field with
720 the special value `boundary', then any point within this special field is
721 also considered to be `on the boundary'.
723 If the optional argument ONLY-IN-LINE is non-nil and constraining
724 NEW-POS would move it to a different line, NEW-POS is returned
725 unconstrained. This useful for commands that move by line, like
726 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
727 only in the case where they can still move to the right line.
729 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
730 a non-nil property of that name, then any field boundaries are ignored.
732 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
733 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
734 Lisp_Object new_pos
, old_pos
;
735 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
737 /* If non-zero, then the original point, before re-positioning. */
740 Lisp_Object prev_old
, prev_new
;
743 /* Use the current point, and afterwards, set it. */
746 XSETFASTINT (new_pos
, PT
);
749 CHECK_NUMBER_COERCE_MARKER (new_pos
);
750 CHECK_NUMBER_COERCE_MARKER (old_pos
);
752 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
754 prev_old
= make_number (XFASTINT (old_pos
) - 1);
755 prev_new
= make_number (XFASTINT (new_pos
) - 1);
757 if (NILP (Vinhibit_field_text_motion
)
758 && !EQ (new_pos
, old_pos
)
759 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
760 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
761 /* To recognize field boundaries, we must also look at the
762 previous positions; we could use `get_pos_property'
763 instead, but in itself that would fail inside non-sticky
764 fields (like comint prompts). */
765 || (XFASTINT (new_pos
) > BEGV
766 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
767 || (XFASTINT (old_pos
) > BEGV
768 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
769 && (NILP (inhibit_capture_property
)
770 /* Field boundaries are again a problem; but now we must
771 decide the case exactly, so we need to call
772 `get_pos_property' as well. */
773 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
774 && (XFASTINT (old_pos
) <= BEGV
775 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
776 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
777 /* It is possible that NEW_POS is not within the same field as
778 OLD_POS; try to move NEW_POS so that it is. */
781 Lisp_Object field_bound
;
784 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
786 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
788 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
789 other side of NEW_POS, which would mean that NEW_POS is
790 already acceptable, and it's not necessary to constrain it
792 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
793 /* NEW_POS should be constrained, but only if either
794 ONLY_IN_LINE is nil (in which case any constraint is OK),
795 or NEW_POS and FIELD_BOUND are on the same line (in which
796 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
797 && (NILP (only_in_line
)
798 /* This is the ONLY_IN_LINE case, check that NEW_POS and
799 FIELD_BOUND are on the same line by seeing whether
800 there's an intervening newline or not. */
801 || (scan_buffer ('\n',
802 XFASTINT (new_pos
), XFASTINT (field_bound
),
803 fwd
? -1 : 1, &shortage
, 1),
805 /* Constrain NEW_POS to FIELD_BOUND. */
806 new_pos
= field_bound
;
808 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
809 /* The NEW_POS argument was originally nil, so automatically set PT. */
810 SET_PT (XFASTINT (new_pos
));
817 DEFUN ("line-beginning-position",
818 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
819 doc
: /* Return the character position of the first character on the current line.
820 With argument N not nil or 1, move forward N - 1 lines first.
821 If scan reaches end of buffer, return that position.
823 This function constrains the returned position to the current field
824 unless that would be on a different line than the original,
825 unconstrained result. If N is nil or 1, and a front-sticky field
826 starts at point, the scan stops as soon as it starts. To ignore field
827 boundaries bind `inhibit-field-text-motion' to t.
829 This function does not move point. */)
833 int orig
, orig_byte
, end
;
834 int count
= SPECPDL_INDEX ();
835 specbind (Qinhibit_point_motion_hooks
, Qt
);
844 Fforward_line (make_number (XINT (n
) - 1));
847 SET_PT_BOTH (orig
, orig_byte
);
849 unbind_to (count
, Qnil
);
851 /* Return END constrained to the current input field. */
852 return Fconstrain_to_field (make_number (end
), make_number (orig
),
853 XINT (n
) != 1 ? Qt
: Qnil
,
857 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
858 doc
: /* Return the character position of the last character on the current line.
859 With argument N not nil or 1, move forward N - 1 lines first.
860 If scan reaches end of buffer, return that position.
862 This function constrains the returned position to the current field
863 unless that would be on a different line than the original,
864 unconstrained result. If N is nil or 1, and a rear-sticky field ends
865 at point, the scan stops as soon as it starts. To ignore field
866 boundaries bind `inhibit-field-text-motion' to t.
868 This function does not move point. */)
880 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
882 /* Return END_POS constrained to the current input field. */
883 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
889 save_excursion_save ()
891 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
894 return Fcons (Fpoint_marker (),
895 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
896 Fcons (visible
? Qt
: Qnil
,
897 Fcons (current_buffer
->mark_active
,
902 save_excursion_restore (info
)
905 Lisp_Object tem
, tem1
, omark
, nmark
;
906 struct gcpro gcpro1
, gcpro2
, gcpro3
;
909 tem
= Fmarker_buffer (XCAR (info
));
910 /* If buffer being returned to is now deleted, avoid error */
911 /* Otherwise could get error here while unwinding to top level
913 /* In that case, Fmarker_buffer returns nil now. */
917 omark
= nmark
= Qnil
;
918 GCPRO3 (info
, omark
, nmark
);
925 unchain_marker (XMARKER (tem
));
930 omark
= Fmarker_position (current_buffer
->mark
);
931 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
932 nmark
= Fmarker_position (tem
);
933 unchain_marker (XMARKER (tem
));
937 visible_p
= !NILP (XCAR (info
));
939 #if 0 /* We used to make the current buffer visible in the selected window
940 if that was true previously. That avoids some anomalies.
941 But it creates others, and it wasn't documented, and it is simpler
942 and cleaner never to alter the window/buffer connections. */
945 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
946 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
952 tem1
= current_buffer
->mark_active
;
953 current_buffer
->mark_active
= tem
;
955 if (!NILP (Vrun_hooks
))
957 /* If mark is active now, and either was not active
958 or was at a different place, run the activate hook. */
959 if (! NILP (current_buffer
->mark_active
))
961 if (! EQ (omark
, nmark
))
962 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
964 /* If mark has ceased to be active, run deactivate hook. */
965 else if (! NILP (tem1
))
966 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
969 /* If buffer was visible in a window, and a different window was
970 selected, and the old selected window is still showing this
971 buffer, restore point in that window. */
974 && !EQ (tem
, selected_window
)
975 && (tem1
= XWINDOW (tem
)->buffer
,
976 (/* Window is live... */
978 /* ...and it shows the current buffer. */
979 && XBUFFER (tem1
) == current_buffer
)))
980 Fset_window_point (tem
, make_number (PT
));
986 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
987 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
988 Executes BODY just like `progn'.
989 The values of point, mark and the current buffer are restored
990 even in case of abnormal exit (throw or error).
991 The state of activation of the mark is also restored.
993 This construct does not save `deactivate-mark', and therefore
994 functions that change the buffer will still cause deactivation
995 of the mark at the end of the command. To prevent that, bind
996 `deactivate-mark' with `let'.
998 usage: (save-excursion &rest BODY) */)
1002 register Lisp_Object val
;
1003 int count
= SPECPDL_INDEX ();
1005 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1007 val
= Fprogn (args
);
1008 return unbind_to (count
, val
);
1011 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
1012 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
1013 Executes BODY just like `progn'.
1014 usage: (save-current-buffer &rest BODY) */)
1019 int count
= SPECPDL_INDEX ();
1021 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
1023 val
= Fprogn (args
);
1024 return unbind_to (count
, val
);
1027 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1028 doc
: /* Return the number of characters in the current buffer.
1029 If BUFFER, return the number of characters in that buffer instead. */)
1034 return make_number (Z
- BEG
);
1037 CHECK_BUFFER (buffer
);
1038 return make_number (BUF_Z (XBUFFER (buffer
))
1039 - BUF_BEG (XBUFFER (buffer
)));
1043 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1044 doc
: /* Return the minimum permissible value of point in the current buffer.
1045 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1049 XSETFASTINT (temp
, BEGV
);
1053 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1054 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1055 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1058 return buildmark (BEGV
, BEGV_BYTE
);
1061 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1062 doc
: /* Return the maximum permissible value of point in the current buffer.
1063 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1064 is in effect, in which case it is less. */)
1068 XSETFASTINT (temp
, ZV
);
1072 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1073 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1074 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1075 is in effect, in which case it is less. */)
1078 return buildmark (ZV
, ZV_BYTE
);
1081 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1082 doc
: /* Return the position of the gap, in the current buffer.
1083 See also `gap-size'. */)
1087 XSETFASTINT (temp
, GPT
);
1091 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1092 doc
: /* Return the size of the current buffer's gap.
1093 See also `gap-position'. */)
1097 XSETFASTINT (temp
, GAP_SIZE
);
1101 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1102 doc
: /* Return the byte position for character position POSITION.
1103 If POSITION is out of range, the value is nil. */)
1105 Lisp_Object position
;
1107 CHECK_NUMBER_COERCE_MARKER (position
);
1108 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1110 return make_number (CHAR_TO_BYTE (XINT (position
)));
1113 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1114 doc
: /* Return the character position for byte position BYTEPOS.
1115 If BYTEPOS is out of range, the value is nil. */)
1117 Lisp_Object bytepos
;
1119 CHECK_NUMBER (bytepos
);
1120 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1122 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1125 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1126 doc
: /* Return the character following point, as a number.
1127 At the end of the buffer or accessible region, return 0. */)
1132 XSETFASTINT (temp
, 0);
1134 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1138 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1139 doc
: /* Return the character preceding point, as a number.
1140 At the beginning of the buffer or accessible region, return 0. */)
1145 XSETFASTINT (temp
, 0);
1146 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1150 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1153 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1157 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1158 doc
: /* Return t if point is at the beginning of the buffer.
1159 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1167 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1168 doc
: /* Return t if point is at the end of the buffer.
1169 If the buffer is narrowed, this means the end of the narrowed part. */)
1177 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1178 doc
: /* Return t if point is at the beginning of a line. */)
1181 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1186 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1187 doc
: /* Return t if point is at the end of a line.
1188 `End of a line' includes point being at the end of the buffer. */)
1191 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1196 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1197 doc
: /* Return character in current buffer at position POS.
1198 POS is an integer or a marker and defaults to point.
1199 If POS is out of range, the value is nil. */)
1203 register int pos_byte
;
1208 XSETFASTINT (pos
, PT
);
1213 pos_byte
= marker_byte_position (pos
);
1214 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1219 CHECK_NUMBER_COERCE_MARKER (pos
);
1220 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1223 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1226 return make_number (FETCH_CHAR (pos_byte
));
1229 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1230 doc
: /* Return character in current buffer preceding position POS.
1231 POS is an integer or a marker and defaults to point.
1232 If POS is out of range, the value is nil. */)
1236 register Lisp_Object val
;
1237 register int pos_byte
;
1242 XSETFASTINT (pos
, PT
);
1247 pos_byte
= marker_byte_position (pos
);
1249 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1254 CHECK_NUMBER_COERCE_MARKER (pos
);
1256 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1259 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1262 if (!NILP (current_buffer
->enable_multibyte_characters
))
1265 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1270 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1275 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1276 doc
: /* Return the name under which the user logged in, as a string.
1277 This is based on the effective uid, not the real uid.
1278 Also, if the environment variables LOGNAME or USER are set,
1279 that determines the value of this function.
1281 If optional argument UID is an integer or a float, return the login name
1282 of the user with that uid, or nil if there is no such user. */)
1289 /* Set up the user name info if we didn't do it before.
1290 (That can happen if Emacs is dumpable
1291 but you decide to run `temacs -l loadup' and not dump. */
1292 if (INTEGERP (Vuser_login_name
))
1296 return Vuser_login_name
;
1298 id
= (uid_t
)XFLOATINT (uid
);
1300 pw
= (struct passwd
*) getpwuid (id
);
1302 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1305 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1307 doc
: /* Return the name of the user's real uid, as a string.
1308 This ignores the environment variables LOGNAME and USER, so it differs from
1309 `user-login-name' when running under `su'. */)
1312 /* Set up the user name info if we didn't do it before.
1313 (That can happen if Emacs is dumpable
1314 but you decide to run `temacs -l loadup' and not dump. */
1315 if (INTEGERP (Vuser_login_name
))
1317 return Vuser_real_login_name
;
1320 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1321 doc
: /* Return the effective uid of Emacs.
1322 Value is an integer or float, depending on the value. */)
1325 /* Assignment to EMACS_INT stops GCC whining about limited range of
1327 EMACS_INT euid
= geteuid ();
1328 return make_fixnum_or_float (euid
);
1331 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1332 doc
: /* Return the real uid of Emacs.
1333 Value is an integer or float, depending on the value. */)
1336 /* Assignment to EMACS_INT stops GCC whining about limited range of
1338 EMACS_INT uid
= getuid ();
1339 return make_fixnum_or_float (uid
);
1342 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1343 doc
: /* Return the full name of the user logged in, as a string.
1344 If the full name corresponding to Emacs's userid is not known,
1347 If optional argument UID is an integer or float, return the full name
1348 of the user with that uid, or nil if there is no such user.
1349 If UID is a string, return the full name of the user with that login
1350 name, or nil if there is no such user. */)
1355 register unsigned char *p
, *q
;
1359 return Vuser_full_name
;
1360 else if (NUMBERP (uid
))
1363 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1366 else if (STRINGP (uid
))
1369 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1373 error ("Invalid UID specification");
1378 p
= (unsigned char *) USER_FULL_NAME
;
1379 /* Chop off everything after the first comma. */
1380 q
= (unsigned char *) index (p
, ',');
1381 full
= make_string (p
, q
? q
- p
: strlen (p
));
1383 #ifdef AMPERSAND_FULL_NAME
1385 q
= (unsigned char *) index (p
, '&');
1386 /* Substitute the login name for the &, upcasing the first character. */
1389 register unsigned char *r
;
1392 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1393 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1394 bcopy (p
, r
, q
- p
);
1396 strcat (r
, SDATA (login
));
1397 r
[q
- p
] = UPCASE (r
[q
- p
]);
1399 full
= build_string (r
);
1401 #endif /* AMPERSAND_FULL_NAME */
1406 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1407 doc
: /* Return the host name of the machine you are running on, as a string. */)
1410 return Vsystem_name
;
1413 /* For the benefit of callers who don't want to include lisp.h */
1418 if (STRINGP (Vsystem_name
))
1419 return (char *) SDATA (Vsystem_name
);
1425 get_operating_system_release()
1427 if (STRINGP (Voperating_system_release
))
1428 return (char *) SDATA (Voperating_system_release
);
1433 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1434 doc
: /* Return the process ID of Emacs, as an integer. */)
1437 return make_number (getpid ());
1440 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1441 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1442 The time is returned as a list of three integers. The first has the
1443 most significant 16 bits of the seconds, while the second has the
1444 least significant 16 bits. The third integer gives the microsecond
1447 The microsecond count is zero on systems that do not provide
1448 resolution finer than a second. */)
1454 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1455 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1456 make_number (EMACS_USECS (t
)));
1459 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1461 doc
: /* Return the current run time used by Emacs.
1462 The time is returned as a list of three integers. The first has the
1463 most significant 16 bits of the seconds, while the second has the
1464 least significant 16 bits. The third integer gives the microsecond
1467 On systems that can't determine the run time, `get-internal-run-time'
1468 does the same thing as `current-time'. The microsecond count is zero
1469 on systems that do not provide resolution finer than a second. */)
1472 #ifdef HAVE_GETRUSAGE
1473 struct rusage usage
;
1476 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1477 /* This shouldn't happen. What action is appropriate? */
1480 /* Sum up user time and system time. */
1481 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1482 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1483 if (usecs
>= 1000000)
1489 return list3 (make_number ((secs
>> 16) & 0xffff),
1490 make_number ((secs
>> 0) & 0xffff),
1491 make_number (usecs
));
1492 #else /* ! HAVE_GETRUSAGE */
1494 return w32_get_internal_run_time ();
1495 #else /* ! WINDOWSNT */
1496 return Fcurrent_time ();
1497 #endif /* WINDOWSNT */
1498 #endif /* HAVE_GETRUSAGE */
1503 lisp_time_argument (specified_time
, result
, usec
)
1504 Lisp_Object specified_time
;
1508 if (NILP (specified_time
))
1515 *usec
= EMACS_USECS (t
);
1516 *result
= EMACS_SECS (t
);
1520 return time (result
) != -1;
1524 Lisp_Object high
, low
;
1525 high
= Fcar (specified_time
);
1526 CHECK_NUMBER (high
);
1527 low
= Fcdr (specified_time
);
1532 Lisp_Object usec_l
= Fcdr (low
);
1534 usec_l
= Fcar (usec_l
);
1539 CHECK_NUMBER (usec_l
);
1540 *usec
= XINT (usec_l
);
1548 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1549 return *result
>> 16 == XINT (high
);
1553 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1554 doc
: /* Return the current time, as a float number of seconds since the epoch.
1555 If SPECIFIED-TIME is given, it is the time to convert to float
1556 instead of the current time. The argument should have the form
1557 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1558 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1559 have the form (HIGH . LOW), but this is considered obsolete.
1561 WARNING: Since the result is floating point, it may not be exact.
1562 Do not use this function if precise time stamps are required. */)
1564 Lisp_Object specified_time
;
1569 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1570 error ("Invalid time specification");
1572 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1575 /* Write information into buffer S of size MAXSIZE, according to the
1576 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1577 Default to Universal Time if UT is nonzero, local time otherwise.
1578 Return the number of bytes written, not including the terminating
1579 '\0'. If S is NULL, nothing will be written anywhere; so to
1580 determine how many bytes would be written, use NULL for S and
1581 ((size_t) -1) for MAXSIZE.
1583 This function behaves like emacs_strftimeu, except it allows null
1586 emacs_memftimeu (s
, maxsize
, format
, format_len
, tp
, ut
)
1591 const struct tm
*tp
;
1596 /* Loop through all the null-terminated strings in the format
1597 argument. Normally there's just one null-terminated string, but
1598 there can be arbitrarily many, concatenated together, if the
1599 format contains '\0' bytes. emacs_strftimeu stops at the first
1600 '\0' byte so we must invoke it separately for each such string. */
1609 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1613 if (result
== 0 && s
[0] != '\0')
1618 maxsize
-= result
+ 1;
1620 len
= strlen (format
);
1621 if (len
== format_len
)
1625 format_len
-= len
+ 1;
1629 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1630 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1631 TIME is specified as (HIGH LOW . IGNORED), as returned by
1632 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1633 is also still accepted.
1634 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1635 as Universal Time; nil means describe TIME in the local time zone.
1636 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1637 by text that describes the specified date and time in TIME:
1639 %Y is the year, %y within the century, %C the century.
1640 %G is the year corresponding to the ISO week, %g within the century.
1641 %m is the numeric month.
1642 %b and %h are the locale's abbreviated month name, %B the full name.
1643 %d is the day of the month, zero-padded, %e is blank-padded.
1644 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1645 %a is the locale's abbreviated name of the day of week, %A the full name.
1646 %U is the week number starting on Sunday, %W starting on Monday,
1647 %V according to ISO 8601.
1648 %j is the day of the year.
1650 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1651 only blank-padded, %l is like %I blank-padded.
1652 %p is the locale's equivalent of either AM or PM.
1655 %Z is the time zone name, %z is the numeric form.
1656 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1658 %c is the locale's date and time format.
1659 %x is the locale's "preferred" date format.
1660 %D is like "%m/%d/%y".
1662 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1663 %X is the locale's "preferred" time format.
1665 Finally, %n is a newline, %t is a tab, %% is a literal %.
1667 Certain flags and modifiers are available with some format controls.
1668 The flags are `_', `-', `^' and `#'. For certain characters X,
1669 %_X is like %X, but padded with blanks; %-X is like %X,
1670 but without padding. %^X is like %X, but with all textual
1671 characters up-cased; %#X is like %X, but with letter-case of
1672 all textual characters reversed.
1673 %NX (where N stands for an integer) is like %X,
1674 but takes up at least N (a number) positions.
1675 The modifiers are `E' and `O'. For certain characters X,
1676 %EX is a locale's alternative version of %X;
1677 %OX is like %X, but uses the locale's number symbols.
1679 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1680 (format_string
, time
, universal
)
1681 Lisp_Object format_string
, time
, universal
;
1686 int ut
= ! NILP (universal
);
1688 CHECK_STRING (format_string
);
1690 if (! lisp_time_argument (time
, &value
, NULL
))
1691 error ("Invalid time specification");
1693 format_string
= code_convert_string_norecord (format_string
,
1694 Vlocale_coding_system
, 1);
1696 /* This is probably enough. */
1697 size
= SBYTES (format_string
) * 6 + 50;
1700 tm
= ut
? gmtime (&value
) : localtime (&value
);
1703 error ("Specified time is not representable");
1705 synchronize_system_time_locale ();
1709 char *buf
= (char *) alloca (size
+ 1);
1714 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1715 SBYTES (format_string
),
1718 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1719 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1720 Vlocale_coding_system
, 0);
1722 /* If buffer was too small, make it bigger and try again. */
1724 result
= emacs_memftimeu (NULL
, (size_t) -1,
1725 SDATA (format_string
),
1726 SBYTES (format_string
),
1733 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1734 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1735 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1736 as from `current-time' and `file-attributes', or nil to use the
1737 current time. The obsolete form (HIGH . LOW) is also still accepted.
1738 The list has the following nine members: SEC is an integer between 0
1739 and 60; SEC is 60 for a leap second, which only some operating systems
1740 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1741 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1742 integer between 1 and 12. YEAR is an integer indicating the
1743 four-digit year. DOW is the day of week, an integer between 0 and 6,
1744 where 0 is Sunday. DST is t if daylight saving time is in effect,
1745 otherwise nil. ZONE is an integer indicating the number of seconds
1746 east of Greenwich. (Note that Common Lisp has different meanings for
1749 Lisp_Object specified_time
;
1753 struct tm
*decoded_time
;
1754 Lisp_Object list_args
[9];
1756 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1757 error ("Invalid time specification");
1760 decoded_time
= localtime (&time_spec
);
1763 error ("Specified time is not representable");
1764 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1765 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1766 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1767 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1768 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1769 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1770 cast below avoids overflow in int arithmetics. */
1771 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1772 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1773 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1775 /* Make a copy, in case gmtime modifies the struct. */
1776 save_tm
= *decoded_time
;
1778 decoded_time
= gmtime (&time_spec
);
1780 if (decoded_time
== 0)
1781 list_args
[8] = Qnil
;
1783 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1784 return Flist (9, list_args
);
1787 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1788 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1789 This is the reverse operation of `decode-time', which see.
1790 ZONE defaults to the current time zone rule. This can
1791 be a string or t (as from `set-time-zone-rule'), or it can be a list
1792 \(as from `current-time-zone') or an integer (as from `decode-time')
1793 applied without consideration for daylight saving time.
1795 You can pass more than 7 arguments; then the first six arguments
1796 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1797 The intervening arguments are ignored.
1798 This feature lets (apply 'encode-time (decode-time ...)) work.
1800 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1801 for example, a DAY of 0 means the day preceding the given month.
1802 Year numbers less than 100 are treated just like other year numbers.
1803 If you want them to stand for years in this century, you must do that yourself.
1805 Years before 1970 are not guaranteed to work. On some systems,
1806 year values as low as 1901 do work.
1808 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1811 register Lisp_Object
*args
;
1815 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1817 CHECK_NUMBER (args
[0]); /* second */
1818 CHECK_NUMBER (args
[1]); /* minute */
1819 CHECK_NUMBER (args
[2]); /* hour */
1820 CHECK_NUMBER (args
[3]); /* day */
1821 CHECK_NUMBER (args
[4]); /* month */
1822 CHECK_NUMBER (args
[5]); /* year */
1824 tm
.tm_sec
= XINT (args
[0]);
1825 tm
.tm_min
= XINT (args
[1]);
1826 tm
.tm_hour
= XINT (args
[2]);
1827 tm
.tm_mday
= XINT (args
[3]);
1828 tm
.tm_mon
= XINT (args
[4]) - 1;
1829 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1837 time
= mktime (&tm
);
1844 char **oldenv
= environ
, **newenv
;
1848 else if (STRINGP (zone
))
1849 tzstring
= (char *) SDATA (zone
);
1850 else if (INTEGERP (zone
))
1852 int abszone
= eabs (XINT (zone
));
1853 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1854 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1858 error ("Invalid time zone specification");
1860 /* Set TZ before calling mktime; merely adjusting mktime's returned
1861 value doesn't suffice, since that would mishandle leap seconds. */
1862 set_time_zone_rule (tzstring
);
1865 time
= mktime (&tm
);
1868 /* Restore TZ to previous value. */
1872 #ifdef LOCALTIME_CACHE
1877 if (time
== (time_t) -1)
1878 error ("Specified time is not representable");
1880 return make_time (time
);
1883 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1884 doc
: /* Return the current time, as a human-readable string.
1885 Programs can use this function to decode a time,
1886 since the number of columns in each field is fixed
1887 if the year is in the range 1000-9999.
1888 The format is `Sun Sep 16 01:03:52 1973'.
1889 However, see also the functions `decode-time' and `format-time-string'
1890 which provide a much more powerful and general facility.
1892 If SPECIFIED-TIME is given, it is a time to format instead of the
1893 current time. The argument should have the form (HIGH LOW . IGNORED).
1894 Thus, you can use times obtained from `current-time' and from
1895 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1896 but this is considered obsolete. */)
1898 Lisp_Object specified_time
;
1904 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1905 error ("Invalid time specification");
1907 /* Convert to a string, checking for out-of-range time stamps.
1908 Don't use 'ctime', as that might dump core if VALUE is out of
1911 tm
= localtime (&value
);
1913 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1914 error ("Specified time is not representable");
1916 /* Remove the trailing newline. */
1917 tem
[strlen (tem
) - 1] = '\0';
1919 return build_string (tem
);
1922 /* Yield A - B, measured in seconds.
1923 This function is copied from the GNU C Library. */
1928 /* Compute intervening leap days correctly even if year is negative.
1929 Take care to avoid int overflow in leap day calculations,
1930 but it's OK to assume that A and B are close to each other. */
1931 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1932 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1933 int a100
= a4
/ 25 - (a4
% 25 < 0);
1934 int b100
= b4
/ 25 - (b4
% 25 < 0);
1935 int a400
= a100
>> 2;
1936 int b400
= b100
>> 2;
1937 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1938 int years
= a
->tm_year
- b
->tm_year
;
1939 int days
= (365 * years
+ intervening_leap_days
1940 + (a
->tm_yday
- b
->tm_yday
));
1941 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1942 + (a
->tm_min
- b
->tm_min
))
1943 + (a
->tm_sec
- b
->tm_sec
));
1946 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1947 doc
: /* Return the offset and name for the local time zone.
1948 This returns a list of the form (OFFSET NAME).
1949 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1950 A negative value means west of Greenwich.
1951 NAME is a string giving the name of the time zone.
1952 If SPECIFIED-TIME is given, the time zone offset is determined from it
1953 instead of using the current time. The argument should have the form
1954 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1955 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1956 have the form (HIGH . LOW), but this is considered obsolete.
1958 Some operating systems cannot provide all this information to Emacs;
1959 in this case, `current-time-zone' returns a list containing nil for
1960 the data it can't find. */)
1962 Lisp_Object specified_time
;
1968 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1973 t
= gmtime (&value
);
1977 t
= localtime (&value
);
1984 int offset
= tm_diff (t
, &gmt
);
1990 s
= (char *)t
->tm_zone
;
1991 #else /* not HAVE_TM_ZONE */
1993 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1994 s
= tzname
[t
->tm_isdst
];
1996 #endif /* not HAVE_TM_ZONE */
2000 /* No local time zone name is available; use "+-NNNN" instead. */
2001 int am
= (offset
< 0 ? -offset
: offset
) / 60;
2002 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
2006 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
2009 return Fmake_list (make_number (2), Qnil
);
2012 /* This holds the value of `environ' produced by the previous
2013 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
2014 has never been called. */
2015 static char **environbuf
;
2017 /* This holds the startup value of the TZ environment variable so it
2018 can be restored if the user calls set-time-zone-rule with a nil
2020 static char *initial_tz
;
2022 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
2023 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
2024 If TZ is nil, use implementation-defined default time zone information.
2025 If TZ is t, use Universal Time. */)
2031 /* When called for the first time, save the original TZ. */
2033 initial_tz
= (char *) getenv ("TZ");
2036 tzstring
= initial_tz
;
2037 else if (EQ (tz
, Qt
))
2042 tzstring
= (char *) SDATA (tz
);
2045 set_time_zone_rule (tzstring
);
2047 environbuf
= environ
;
2052 #ifdef LOCALTIME_CACHE
2054 /* These two values are known to load tz files in buggy implementations,
2055 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2056 Their values shouldn't matter in non-buggy implementations.
2057 We don't use string literals for these strings,
2058 since if a string in the environment is in readonly
2059 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2060 See Sun bugs 1113095 and 1114114, ``Timezone routines
2061 improperly modify environment''. */
2063 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2064 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2068 /* Set the local time zone rule to TZSTRING.
2069 This allocates memory into `environ', which it is the caller's
2070 responsibility to free. */
2073 set_time_zone_rule (tzstring
)
2077 char **from
, **to
, **newenv
;
2079 /* Make the ENVIRON vector longer with room for TZSTRING. */
2080 for (from
= environ
; *from
; from
++)
2082 envptrs
= from
- environ
+ 2;
2083 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2084 + (tzstring
? strlen (tzstring
) + 4 : 0));
2086 /* Add TZSTRING to the end of environ, as a value for TZ. */
2089 char *t
= (char *) (to
+ envptrs
);
2091 strcat (t
, tzstring
);
2095 /* Copy the old environ vector elements into NEWENV,
2096 but don't copy the TZ variable.
2097 So we have only one definition of TZ, which came from TZSTRING. */
2098 for (from
= environ
; *from
; from
++)
2099 if (strncmp (*from
, "TZ=", 3) != 0)
2105 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2106 the TZ variable is stored. If we do not have a TZSTRING,
2107 TO points to the vector slot which has the terminating null. */
2109 #ifdef LOCALTIME_CACHE
2111 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2112 "US/Pacific" that loads a tz file, then changes to a value like
2113 "XXX0" that does not load a tz file, and then changes back to
2114 its original value, the last change is (incorrectly) ignored.
2115 Also, if TZ changes twice in succession to values that do
2116 not load a tz file, tzset can dump core (see Sun bug#1225179).
2117 The following code works around these bugs. */
2121 /* Temporarily set TZ to a value that loads a tz file
2122 and that differs from tzstring. */
2124 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2125 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2131 /* The implied tzstring is unknown, so temporarily set TZ to
2132 two different values that each load a tz file. */
2133 *to
= set_time_zone_rule_tz1
;
2136 *to
= set_time_zone_rule_tz2
;
2141 /* Now TZ has the desired value, and tzset can be invoked safely. */
2148 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2149 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2150 type of object is Lisp_String). INHERIT is passed to
2151 INSERT_FROM_STRING_FUNC as the last argument. */
2154 general_insert_function (insert_func
, insert_from_string_func
,
2155 inherit
, nargs
, args
)
2156 void (*insert_func
) P_ ((const unsigned char *, int));
2157 void (*insert_from_string_func
) P_ ((Lisp_Object
, int, int, int, int, int));
2159 register Lisp_Object
*args
;
2161 register int argnum
;
2162 register Lisp_Object val
;
2164 for (argnum
= 0; argnum
< nargs
; argnum
++)
2167 if (CHARACTERP (val
))
2169 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2172 if (!NILP (current_buffer
->enable_multibyte_characters
))
2173 len
= CHAR_STRING (XFASTINT (val
), str
);
2176 str
[0] = (ASCII_CHAR_P (XINT (val
))
2178 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2181 (*insert_func
) (str
, len
);
2183 else if (STRINGP (val
))
2185 (*insert_from_string_func
) (val
, 0, 0,
2191 wrong_type_argument (Qchar_or_string_p
, val
);
2203 /* Callers passing one argument to Finsert need not gcpro the
2204 argument "array", since the only element of the array will
2205 not be used after calling insert or insert_from_string, so
2206 we don't care if it gets trashed. */
2208 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2209 doc
: /* Insert the arguments, either strings or characters, at point.
2210 Point and before-insertion markers move forward to end up
2211 after the inserted text.
2212 Any other markers at the point of insertion remain before the text.
2214 If the current buffer is multibyte, unibyte strings are converted
2215 to multibyte for insertion (see `string-make-multibyte').
2216 If the current buffer is unibyte, multibyte strings are converted
2217 to unibyte for insertion (see `string-make-unibyte').
2219 When operating on binary data, it may be necessary to preserve the
2220 original bytes of a unibyte string when inserting it into a multibyte
2221 buffer; to accomplish this, apply `string-as-multibyte' to the string
2222 and insert the result.
2224 usage: (insert &rest ARGS) */)
2227 register Lisp_Object
*args
;
2229 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2233 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2235 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2236 Point and before-insertion markers move forward to end up
2237 after the inserted text.
2238 Any other markers at the point of insertion remain before the text.
2240 If the current buffer is multibyte, unibyte strings are converted
2241 to multibyte for insertion (see `unibyte-char-to-multibyte').
2242 If the current buffer is unibyte, multibyte strings are converted
2243 to unibyte for insertion.
2245 usage: (insert-and-inherit &rest ARGS) */)
2248 register Lisp_Object
*args
;
2250 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2255 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2256 doc
: /* Insert strings or characters at point, relocating markers after the text.
2257 Point and markers move forward to end up after the inserted text.
2259 If the current buffer is multibyte, unibyte strings are converted
2260 to multibyte for insertion (see `unibyte-char-to-multibyte').
2261 If the current buffer is unibyte, multibyte strings are converted
2262 to unibyte for insertion.
2264 usage: (insert-before-markers &rest ARGS) */)
2267 register Lisp_Object
*args
;
2269 general_insert_function (insert_before_markers
,
2270 insert_from_string_before_markers
, 0,
2275 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2276 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2277 doc
: /* Insert text at point, relocating markers and inheriting properties.
2278 Point and markers move forward to end up after the inserted text.
2280 If the current buffer is multibyte, unibyte strings are converted
2281 to multibyte for insertion (see `unibyte-char-to-multibyte').
2282 If the current buffer is unibyte, multibyte strings are converted
2283 to unibyte for insertion.
2285 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2288 register Lisp_Object
*args
;
2290 general_insert_function (insert_before_markers_and_inherit
,
2291 insert_from_string_before_markers
, 1,
2296 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2297 doc
: /* Insert COUNT copies of CHARACTER.
2298 Point, and before-insertion markers, are relocated as in the function `insert'.
2299 The optional third arg INHERIT, if non-nil, says to inherit text properties
2300 from adjoining text, if those properties are sticky. */)
2301 (character
, count
, inherit
)
2302 Lisp_Object character
, count
, inherit
;
2304 register unsigned char *string
;
2305 register int strlen
;
2308 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2310 CHECK_NUMBER (character
);
2311 CHECK_NUMBER (count
);
2313 if (!NILP (current_buffer
->enable_multibyte_characters
))
2314 len
= CHAR_STRING (XFASTINT (character
), str
);
2316 str
[0] = XFASTINT (character
), len
= 1;
2317 n
= XINT (count
) * len
;
2320 strlen
= min (n
, 256 * len
);
2321 string
= (unsigned char *) alloca (strlen
);
2322 for (i
= 0; i
< strlen
; i
++)
2323 string
[i
] = str
[i
% len
];
2327 if (!NILP (inherit
))
2328 insert_and_inherit (string
, strlen
);
2330 insert (string
, strlen
);
2335 if (!NILP (inherit
))
2336 insert_and_inherit (string
, n
);
2343 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2344 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2345 Both arguments are required.
2346 BYTE is a number of the range 0..255.
2348 If BYTE is 128..255 and the current buffer is multibyte, the
2349 corresponding eight-bit character is inserted.
2351 Point, and before-insertion markers, are relocated as in the function `insert'.
2352 The optional third arg INHERIT, if non-nil, says to inherit text properties
2353 from adjoining text, if those properties are sticky. */)
2354 (byte
, count
, inherit
)
2355 Lisp_Object byte
, count
, inherit
;
2357 CHECK_NUMBER (byte
);
2358 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2359 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2360 if (XINT (byte
) >= 128
2361 && ! NILP (current_buffer
->enable_multibyte_characters
))
2362 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2363 return Finsert_char (byte
, count
, inherit
);
2367 /* Making strings from buffer contents. */
2369 /* Return a Lisp_String containing the text of the current buffer from
2370 START to END. If text properties are in use and the current buffer
2371 has properties in the range specified, the resulting string will also
2372 have them, if PROPS is nonzero.
2374 We don't want to use plain old make_string here, because it calls
2375 make_uninit_string, which can cause the buffer arena to be
2376 compacted. make_string has no way of knowing that the data has
2377 been moved, and thus copies the wrong data into the string. This
2378 doesn't effect most of the other users of make_string, so it should
2379 be left as is. But we should use this function when conjuring
2380 buffer substrings. */
2383 make_buffer_string (start
, end
, props
)
2387 int start_byte
= CHAR_TO_BYTE (start
);
2388 int end_byte
= CHAR_TO_BYTE (end
);
2390 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2393 /* Return a Lisp_String containing the text of the current buffer from
2394 START / START_BYTE to END / END_BYTE.
2396 If text properties are in use and the current buffer
2397 has properties in the range specified, the resulting string will also
2398 have them, if PROPS is nonzero.
2400 We don't want to use plain old make_string here, because it calls
2401 make_uninit_string, which can cause the buffer arena to be
2402 compacted. make_string has no way of knowing that the data has
2403 been moved, and thus copies the wrong data into the string. This
2404 doesn't effect most of the other users of make_string, so it should
2405 be left as is. But we should use this function when conjuring
2406 buffer substrings. */
2409 make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
)
2410 int start
, start_byte
, end
, end_byte
;
2413 Lisp_Object result
, tem
, tem1
;
2415 if (start
< GPT
&& GPT
< end
)
2418 if (! NILP (current_buffer
->enable_multibyte_characters
))
2419 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2421 result
= make_uninit_string (end
- start
);
2422 bcopy (BYTE_POS_ADDR (start_byte
), SDATA (result
),
2423 end_byte
- start_byte
);
2425 /* If desired, update and copy the text properties. */
2428 update_buffer_properties (start
, end
);
2430 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2431 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2433 if (XINT (tem
) != end
|| !NILP (tem1
))
2434 copy_intervals_to_string (result
, current_buffer
, start
,
2441 /* Call Vbuffer_access_fontify_functions for the range START ... END
2442 in the current buffer, if necessary. */
2445 update_buffer_properties (start
, end
)
2448 /* If this buffer has some access functions,
2449 call them, specifying the range of the buffer being accessed. */
2450 if (!NILP (Vbuffer_access_fontify_functions
))
2452 Lisp_Object args
[3];
2455 args
[0] = Qbuffer_access_fontify_functions
;
2456 XSETINT (args
[1], start
);
2457 XSETINT (args
[2], end
);
2459 /* But don't call them if we can tell that the work
2460 has already been done. */
2461 if (!NILP (Vbuffer_access_fontified_property
))
2463 tem
= Ftext_property_any (args
[1], args
[2],
2464 Vbuffer_access_fontified_property
,
2467 Frun_hook_with_args (3, args
);
2470 Frun_hook_with_args (3, args
);
2474 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2475 doc
: /* Return the contents of part of the current buffer as a string.
2476 The two arguments START and END are character positions;
2477 they can be in either order.
2478 The string returned is multibyte if the buffer is multibyte.
2480 This function copies the text properties of that part of the buffer
2481 into the result string; if you don't want the text properties,
2482 use `buffer-substring-no-properties' instead. */)
2484 Lisp_Object start
, end
;
2488 validate_region (&start
, &end
);
2492 return make_buffer_string (b
, e
, 1);
2495 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2496 Sbuffer_substring_no_properties
, 2, 2, 0,
2497 doc
: /* Return the characters of part of the buffer, without the text properties.
2498 The two arguments START and END are character positions;
2499 they can be in either order. */)
2501 Lisp_Object start
, end
;
2505 validate_region (&start
, &end
);
2509 return make_buffer_string (b
, e
, 0);
2512 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2513 doc
: /* Return the contents of the current buffer as a string.
2514 If narrowing is in effect, this function returns only the visible part
2518 return make_buffer_string (BEGV
, ZV
, 1);
2521 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2523 doc
: /* Insert before point a substring of the contents of BUFFER.
2524 BUFFER may be a buffer or a buffer name.
2525 Arguments START and END are character positions specifying the substring.
2526 They default to the values of (point-min) and (point-max) in BUFFER. */)
2527 (buffer
, start
, end
)
2528 Lisp_Object buffer
, start
, end
;
2530 register int b
, e
, temp
;
2531 register struct buffer
*bp
, *obuf
;
2534 buf
= Fget_buffer (buffer
);
2538 if (NILP (bp
->name
))
2539 error ("Selecting deleted buffer");
2545 CHECK_NUMBER_COERCE_MARKER (start
);
2552 CHECK_NUMBER_COERCE_MARKER (end
);
2557 temp
= b
, b
= e
, e
= temp
;
2559 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2560 args_out_of_range (start
, end
);
2562 obuf
= current_buffer
;
2563 set_buffer_internal_1 (bp
);
2564 update_buffer_properties (b
, e
);
2565 set_buffer_internal_1 (obuf
);
2567 insert_from_buffer (bp
, b
, e
- b
, 0);
2571 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2573 doc
: /* Compare two substrings of two buffers; return result as number.
2574 the value is -N if first string is less after N-1 chars,
2575 +N if first string is greater after N-1 chars, or 0 if strings match.
2576 Each substring is represented as three arguments: BUFFER, START and END.
2577 That makes six args in all, three for each substring.
2579 The value of `case-fold-search' in the current buffer
2580 determines whether case is significant or ignored. */)
2581 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2582 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2584 register int begp1
, endp1
, begp2
, endp2
, temp
;
2585 register struct buffer
*bp1
, *bp2
;
2586 register Lisp_Object trt
2587 = (!NILP (current_buffer
->case_fold_search
)
2588 ? current_buffer
->case_canon_table
: Qnil
);
2590 int i1
, i2
, i1_byte
, i2_byte
;
2592 /* Find the first buffer and its substring. */
2595 bp1
= current_buffer
;
2599 buf1
= Fget_buffer (buffer1
);
2602 bp1
= XBUFFER (buf1
);
2603 if (NILP (bp1
->name
))
2604 error ("Selecting deleted buffer");
2608 begp1
= BUF_BEGV (bp1
);
2611 CHECK_NUMBER_COERCE_MARKER (start1
);
2612 begp1
= XINT (start1
);
2615 endp1
= BUF_ZV (bp1
);
2618 CHECK_NUMBER_COERCE_MARKER (end1
);
2619 endp1
= XINT (end1
);
2623 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2625 if (!(BUF_BEGV (bp1
) <= begp1
2627 && endp1
<= BUF_ZV (bp1
)))
2628 args_out_of_range (start1
, end1
);
2630 /* Likewise for second substring. */
2633 bp2
= current_buffer
;
2637 buf2
= Fget_buffer (buffer2
);
2640 bp2
= XBUFFER (buf2
);
2641 if (NILP (bp2
->name
))
2642 error ("Selecting deleted buffer");
2646 begp2
= BUF_BEGV (bp2
);
2649 CHECK_NUMBER_COERCE_MARKER (start2
);
2650 begp2
= XINT (start2
);
2653 endp2
= BUF_ZV (bp2
);
2656 CHECK_NUMBER_COERCE_MARKER (end2
);
2657 endp2
= XINT (end2
);
2661 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2663 if (!(BUF_BEGV (bp2
) <= begp2
2665 && endp2
<= BUF_ZV (bp2
)))
2666 args_out_of_range (start2
, end2
);
2670 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2671 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2673 while (i1
< endp1
&& i2
< endp2
)
2675 /* When we find a mismatch, we must compare the
2676 characters, not just the bytes. */
2681 if (! NILP (bp1
->enable_multibyte_characters
))
2683 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2684 BUF_INC_POS (bp1
, i1_byte
);
2689 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2690 c1
= unibyte_char_to_multibyte (c1
);
2694 if (! NILP (bp2
->enable_multibyte_characters
))
2696 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2697 BUF_INC_POS (bp2
, i2_byte
);
2702 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2703 c2
= unibyte_char_to_multibyte (c2
);
2709 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2710 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2713 return make_number (- 1 - chars
);
2715 return make_number (chars
+ 1);
2720 /* The strings match as far as they go.
2721 If one is shorter, that one is less. */
2722 if (chars
< endp1
- begp1
)
2723 return make_number (chars
+ 1);
2724 else if (chars
< endp2
- begp2
)
2725 return make_number (- chars
- 1);
2727 /* Same length too => they are equal. */
2728 return make_number (0);
2732 subst_char_in_region_unwind (arg
)
2735 return current_buffer
->undo_list
= arg
;
2739 subst_char_in_region_unwind_1 (arg
)
2742 return current_buffer
->filename
= arg
;
2745 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2746 Ssubst_char_in_region
, 4, 5, 0,
2747 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2748 If optional arg NOUNDO is non-nil, don't record this change for undo
2749 and don't mark the buffer as really changed.
2750 Both characters must have the same length of multi-byte form. */)
2751 (start
, end
, fromchar
, tochar
, noundo
)
2752 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2754 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2755 /* Keep track of the first change in the buffer:
2756 if 0 we haven't found it yet.
2757 if < 0 we've found it and we've run the before-change-function.
2758 if > 0 we've actually performed it and the value is its position. */
2760 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2762 int count
= SPECPDL_INDEX ();
2763 #define COMBINING_NO 0
2764 #define COMBINING_BEFORE 1
2765 #define COMBINING_AFTER 2
2766 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2767 int maybe_byte_combining
= COMBINING_NO
;
2768 int last_changed
= 0;
2769 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2773 validate_region (&start
, &end
);
2774 CHECK_NUMBER (fromchar
);
2775 CHECK_NUMBER (tochar
);
2779 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2780 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2781 error ("Characters in `subst-char-in-region' have different byte-lengths");
2782 if (!ASCII_BYTE_P (*tostr
))
2784 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2785 complete multibyte character, it may be combined with the
2786 after bytes. If it is in the range 0xA0..0xFF, it may be
2787 combined with the before and after bytes. */
2788 if (!CHAR_HEAD_P (*tostr
))
2789 maybe_byte_combining
= COMBINING_BOTH
;
2790 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2791 maybe_byte_combining
= COMBINING_AFTER
;
2797 fromstr
[0] = XFASTINT (fromchar
);
2798 tostr
[0] = XFASTINT (tochar
);
2802 pos_byte
= CHAR_TO_BYTE (pos
);
2803 stop
= CHAR_TO_BYTE (XINT (end
));
2806 /* If we don't want undo, turn off putting stuff on the list.
2807 That's faster than getting rid of things,
2808 and it prevents even the entry for a first change.
2809 Also inhibit locking the file. */
2810 if (!changed
&& !NILP (noundo
))
2812 record_unwind_protect (subst_char_in_region_unwind
,
2813 current_buffer
->undo_list
);
2814 current_buffer
->undo_list
= Qt
;
2815 /* Don't do file-locking. */
2816 record_unwind_protect (subst_char_in_region_unwind_1
,
2817 current_buffer
->filename
);
2818 current_buffer
->filename
= Qnil
;
2821 if (pos_byte
< GPT_BYTE
)
2822 stop
= min (stop
, GPT_BYTE
);
2825 int pos_byte_next
= pos_byte
;
2827 if (pos_byte
>= stop
)
2829 if (pos_byte
>= end_byte
) break;
2832 p
= BYTE_POS_ADDR (pos_byte
);
2834 INC_POS (pos_byte_next
);
2837 if (pos_byte_next
- pos_byte
== len
2838 && p
[0] == fromstr
[0]
2840 || (p
[1] == fromstr
[1]
2841 && (len
== 2 || (p
[2] == fromstr
[2]
2842 && (len
== 3 || p
[3] == fromstr
[3]))))))
2845 /* We've already seen this and run the before-change-function;
2846 this time we only need to record the actual position. */
2851 modify_region (current_buffer
, pos
, XINT (end
), 0);
2853 if (! NILP (noundo
))
2855 if (MODIFF
- 1 == SAVE_MODIFF
)
2857 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
2858 current_buffer
->auto_save_modified
++;
2861 /* The before-change-function may have moved the gap
2862 or even modified the buffer so we should start over. */
2866 /* Take care of the case where the new character
2867 combines with neighboring bytes. */
2868 if (maybe_byte_combining
2869 && (maybe_byte_combining
== COMBINING_AFTER
2870 ? (pos_byte_next
< Z_BYTE
2871 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2872 : ((pos_byte_next
< Z_BYTE
2873 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2874 || (pos_byte
> BEG_BYTE
2875 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2877 Lisp_Object tem
, string
;
2879 struct gcpro gcpro1
;
2881 tem
= current_buffer
->undo_list
;
2884 /* Make a multibyte string containing this single character. */
2885 string
= make_multibyte_string (tostr
, 1, len
);
2886 /* replace_range is less efficient, because it moves the gap,
2887 but it handles combining correctly. */
2888 replace_range (pos
, pos
+ 1, string
,
2890 pos_byte_next
= CHAR_TO_BYTE (pos
);
2891 if (pos_byte_next
> pos_byte
)
2892 /* Before combining happened. We should not increment
2893 POS. So, to cancel the later increment of POS,
2897 INC_POS (pos_byte_next
);
2899 if (! NILP (noundo
))
2900 current_buffer
->undo_list
= tem
;
2907 record_change (pos
, 1);
2908 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2910 last_changed
= pos
+ 1;
2912 pos_byte
= pos_byte_next
;
2918 signal_after_change (changed
,
2919 last_changed
- changed
, last_changed
- changed
);
2920 update_compositions (changed
, last_changed
, CHECK_ALL
);
2923 unbind_to (count
, Qnil
);
2928 static Lisp_Object check_translation
P_ ((int, int, int, Lisp_Object
));
2930 /* Helper function for Ftranslate_region_internal.
2932 Check if a character sequence at POS (POS_BYTE) matches an element
2933 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2934 element is found, return it. Otherwise return Qnil. */
2937 check_translation (pos
, pos_byte
, end
, val
)
2938 int pos
, pos_byte
, end
;
2941 int buf_size
= 16, buf_used
= 0;
2942 int *buf
= alloca (sizeof (int) * buf_size
);
2944 for (; CONSP (val
); val
= XCDR (val
))
2953 if (! VECTORP (elt
))
2956 if (len
<= end
- pos
)
2958 for (i
= 0; i
< len
; i
++)
2962 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2965 if (buf_used
== buf_size
)
2970 newbuf
= alloca (sizeof (int) * buf_size
);
2971 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2974 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, 0, len
);
2977 if (XINT (AREF (elt
, i
)) != buf
[i
])
2988 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
2989 Stranslate_region_internal
, 3, 3, 0,
2990 doc
: /* Internal use only.
2991 From START to END, translate characters according to TABLE.
2992 TABLE is a string or a char-table; the Nth character in it is the
2993 mapping for the character with code N.
2994 It returns the number of characters changed. */)
2998 register Lisp_Object table
;
3000 register unsigned char *tt
; /* Trans table. */
3001 register int nc
; /* New character. */
3002 int cnt
; /* Number of changes made. */
3003 int size
; /* Size of translate table. */
3004 int pos
, pos_byte
, end_pos
;
3005 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
3006 int string_multibyte
;
3009 validate_region (&start
, &end
);
3010 if (CHAR_TABLE_P (table
))
3012 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
3013 error ("Not a translation table");
3019 CHECK_STRING (table
);
3021 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
3022 table
= string_make_unibyte (table
);
3023 string_multibyte
= SCHARS (table
) < SBYTES (table
);
3024 size
= SBYTES (table
);
3029 pos_byte
= CHAR_TO_BYTE (pos
);
3030 end_pos
= XINT (end
);
3031 modify_region (current_buffer
, pos
, end_pos
, 0);
3034 for (; pos
< end_pos
; )
3036 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3037 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
3043 oc
= STRING_CHAR_AND_LENGTH (p
, MAX_MULTIBYTE_LENGTH
, len
);
3050 /* Reload as signal_after_change in last iteration may GC. */
3052 if (string_multibyte
)
3054 str
= tt
+ string_char_to_byte (table
, oc
);
3055 nc
= STRING_CHAR_AND_LENGTH (str
, MAX_MULTIBYTE_LENGTH
,
3061 if (! ASCII_BYTE_P (nc
) && multibyte
)
3063 str_len
= BYTE8_STRING (nc
, buf
);
3078 val
= CHAR_TABLE_REF (table
, oc
);
3079 if (CHARACTERP (val
)
3080 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3083 str_len
= CHAR_STRING (nc
, buf
);
3086 else if (VECTORP (val
) || (CONSP (val
)))
3088 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3089 where TO is TO-CHAR or [TO-CHAR ...]. */
3094 if (nc
!= oc
&& nc
>= 0)
3096 /* Simple one char to one char translation. */
3101 /* This is less efficient, because it moves the gap,
3102 but it should handle multibyte characters correctly. */
3103 string
= make_multibyte_string (str
, 1, str_len
);
3104 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3109 record_change (pos
, 1);
3110 while (str_len
-- > 0)
3112 signal_after_change (pos
, 1, 1);
3113 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3123 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3130 /* VAL is ([FROM-CHAR ...] . TO). */
3131 len
= ASIZE (XCAR (val
));
3141 string
= Fmake_string (make_number (ASIZE (val
)),
3143 for (i
= 1; i
< ASIZE (val
); i
++)
3144 Faset (string
, make_number (i
), AREF (val
, i
));
3148 string
= Fmake_string (make_number (1), val
);
3150 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3151 pos_byte
+= SBYTES (string
);
3152 pos
+= SCHARS (string
);
3153 cnt
+= SCHARS (string
);
3154 end_pos
+= SCHARS (string
) - len
;
3162 return make_number (cnt
);
3165 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3166 doc
: /* Delete the text between point and mark.
3168 When called from a program, expects two arguments,
3169 positions (integers or markers) specifying the stretch to be deleted. */)
3171 Lisp_Object start
, end
;
3173 validate_region (&start
, &end
);
3174 del_range (XINT (start
), XINT (end
));
3178 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3179 Sdelete_and_extract_region
, 2, 2, 0,
3180 doc
: /* Delete the text between START and END and return it. */)
3182 Lisp_Object start
, end
;
3184 validate_region (&start
, &end
);
3185 if (XINT (start
) == XINT (end
))
3186 return empty_unibyte_string
;
3187 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3190 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3191 doc
: /* Remove restrictions (narrowing) from current buffer.
3192 This allows the buffer's full text to be seen and edited. */)
3195 if (BEG
!= BEGV
|| Z
!= ZV
)
3196 current_buffer
->clip_changed
= 1;
3198 BEGV_BYTE
= BEG_BYTE
;
3199 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3200 /* Changing the buffer bounds invalidates any recorded current column. */
3201 invalidate_current_column ();
3205 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3206 doc
: /* Restrict editing in this buffer to the current region.
3207 The rest of the text becomes temporarily invisible and untouchable
3208 but is not deleted; if you save the buffer in a file, the invisible
3209 text is included in the file. \\[widen] makes all visible again.
3210 See also `save-restriction'.
3212 When calling from a program, pass two arguments; positions (integers
3213 or markers) bounding the text that should remain visible. */)
3215 register Lisp_Object start
, end
;
3217 CHECK_NUMBER_COERCE_MARKER (start
);
3218 CHECK_NUMBER_COERCE_MARKER (end
);
3220 if (XINT (start
) > XINT (end
))
3223 tem
= start
; start
= end
; end
= tem
;
3226 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3227 args_out_of_range (start
, end
);
3229 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3230 current_buffer
->clip_changed
= 1;
3232 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3233 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3234 if (PT
< XFASTINT (start
))
3235 SET_PT (XFASTINT (start
));
3236 if (PT
> XFASTINT (end
))
3237 SET_PT (XFASTINT (end
));
3238 /* Changing the buffer bounds invalidates any recorded current column. */
3239 invalidate_current_column ();
3244 save_restriction_save ()
3246 if (BEGV
== BEG
&& ZV
== Z
)
3247 /* The common case that the buffer isn't narrowed.
3248 We return just the buffer object, which save_restriction_restore
3249 recognizes as meaning `no restriction'. */
3250 return Fcurrent_buffer ();
3252 /* We have to save a restriction, so return a pair of markers, one
3253 for the beginning and one for the end. */
3255 Lisp_Object beg
, end
;
3257 beg
= buildmark (BEGV
, BEGV_BYTE
);
3258 end
= buildmark (ZV
, ZV_BYTE
);
3260 /* END must move forward if text is inserted at its exact location. */
3261 XMARKER(end
)->insertion_type
= 1;
3263 return Fcons (beg
, end
);
3268 save_restriction_restore (data
)
3272 /* A pair of marks bounding a saved restriction. */
3274 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3275 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3276 struct buffer
*buf
= beg
->buffer
; /* END should have the same buffer. */
3278 if (buf
/* Verify marker still points to a buffer. */
3279 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3280 /* The restriction has changed from the saved one, so restore
3281 the saved restriction. */
3283 int pt
= BUF_PT (buf
);
3285 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3286 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3288 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3289 /* The point is outside the new visible range, move it inside. */
3290 SET_BUF_PT_BOTH (buf
,
3291 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3292 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3295 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3299 /* A buffer, which means that there was no old restriction. */
3301 struct buffer
*buf
= XBUFFER (data
);
3303 if (buf
/* Verify marker still points to a buffer. */
3304 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3305 /* The buffer has been narrowed, get rid of the narrowing. */
3307 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3308 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3310 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3317 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3318 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3319 The buffer's restrictions make parts of the beginning and end invisible.
3320 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3321 This special form, `save-restriction', saves the current buffer's restrictions
3322 when it is entered, and restores them when it is exited.
3323 So any `narrow-to-region' within BODY lasts only until the end of the form.
3324 The old restrictions settings are restored
3325 even in case of abnormal exit (throw or error).
3327 The value returned is the value of the last form in BODY.
3329 Note: if you are using both `save-excursion' and `save-restriction',
3330 use `save-excursion' outermost:
3331 (save-excursion (save-restriction ...))
3333 usage: (save-restriction &rest BODY) */)
3337 register Lisp_Object val
;
3338 int count
= SPECPDL_INDEX ();
3340 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3341 val
= Fprogn (body
);
3342 return unbind_to (count
, val
);
3345 /* Buffer for the most recent text displayed by Fmessage_box. */
3346 static char *message_text
;
3348 /* Allocated length of that buffer. */
3349 static int message_length
;
3351 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3352 doc
: /* Display a message at the bottom of the screen.
3353 The message also goes into the `*Messages*' buffer.
3354 \(In keyboard macros, that's all it does.)
3357 The first argument is a format control string, and the rest are data
3358 to be formatted under control of the string. See `format' for details.
3360 Note: Use (message "%s" VALUE) to print the value of expressions and
3361 variables to avoid accidentally interpreting `%' as format specifiers.
3363 If the first argument is nil or the empty string, the function clears
3364 any existing message; this lets the minibuffer contents show. See
3365 also `current-message'.
3367 usage: (message FORMAT-STRING &rest ARGS) */)
3373 || (STRINGP (args
[0])
3374 && SBYTES (args
[0]) == 0))
3381 register Lisp_Object val
;
3382 val
= Fformat (nargs
, args
);
3383 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3388 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3389 doc
: /* Display a message, in a dialog box if possible.
3390 If a dialog box is not available, use the echo area.
3391 The first argument is a format control string, and the rest are data
3392 to be formatted under control of the string. See `format' for details.
3394 If the first argument is nil or the empty string, clear any existing
3395 message; let the minibuffer contents show.
3397 usage: (message-box FORMAT-STRING &rest ARGS) */)
3409 register Lisp_Object val
;
3410 val
= Fformat (nargs
, args
);
3412 /* The MS-DOS frames support popup menus even though they are
3413 not FRAME_WINDOW_P. */
3414 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3415 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3417 Lisp_Object pane
, menu
, obj
;
3418 struct gcpro gcpro1
;
3419 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3421 menu
= Fcons (val
, pane
);
3422 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3426 #endif /* HAVE_MENUS */
3427 /* Copy the data so that it won't move when we GC. */
3430 message_text
= (char *)xmalloc (80);
3431 message_length
= 80;
3433 if (SBYTES (val
) > message_length
)
3435 message_length
= SBYTES (val
);
3436 message_text
= (char *)xrealloc (message_text
, message_length
);
3438 bcopy (SDATA (val
), message_text
, SBYTES (val
));
3439 message2 (message_text
, SBYTES (val
),
3440 STRING_MULTIBYTE (val
));
3445 extern Lisp_Object last_nonmenu_event
;
3448 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3449 doc
: /* Display a message in a dialog box or in the echo area.
3450 If this command was invoked with the mouse, use a dialog box if
3451 `use-dialog-box' is non-nil.
3452 Otherwise, use the echo area.
3453 The first argument is a format control string, and the rest are data
3454 to be formatted under control of the string. See `format' for details.
3456 If the first argument is nil or the empty string, clear any existing
3457 message; let the minibuffer contents show.
3459 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3465 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3467 return Fmessage_box (nargs
, args
);
3469 return Fmessage (nargs
, args
);
3472 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3473 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3476 return current_message ();
3480 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3481 doc
: /* Return a copy of STRING with text properties added.
3482 First argument is the string to copy.
3483 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3484 properties to add to the result.
3485 usage: (propertize STRING &rest PROPERTIES) */)
3490 Lisp_Object properties
, string
;
3491 struct gcpro gcpro1
, gcpro2
;
3494 /* Number of args must be odd. */
3495 if ((nargs
& 1) == 0 || nargs
< 1)
3496 error ("Wrong number of arguments");
3498 properties
= string
= Qnil
;
3499 GCPRO2 (properties
, string
);
3501 /* First argument must be a string. */
3502 CHECK_STRING (args
[0]);
3503 string
= Fcopy_sequence (args
[0]);
3505 for (i
= 1; i
< nargs
; i
+= 2)
3506 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3508 Fadd_text_properties (make_number (0),
3509 make_number (SCHARS (string
)),
3510 properties
, string
);
3511 RETURN_UNGCPRO (string
);
3515 /* Number of bytes that STRING will occupy when put into the result.
3516 MULTIBYTE is nonzero if the result should be multibyte. */
3518 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3519 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3520 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3523 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3524 doc
: /* Format a string out of a format-string and arguments.
3525 The first argument is a format control string.
3526 The other arguments are substituted into it to make the result, a string.
3528 The format control string may contain %-sequences meaning to substitute
3529 the next available argument:
3531 %s means print a string argument. Actually, prints any object, with `princ'.
3532 %d means print as number in decimal (%o octal, %x hex).
3533 %X is like %x, but uses upper case.
3534 %e means print a number in exponential notation.
3535 %f means print a number in decimal-point notation.
3536 %g means print a number in exponential notation
3537 or decimal-point notation, whichever uses fewer characters.
3538 %c means print a number as a single character.
3539 %S means print any object as an s-expression (using `prin1').
3541 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3542 Use %% to put a single % into the output.
3544 A %-sequence may contain optional flag, width, and precision
3545 specifiers, as follows:
3547 %<flags><width><precision>character
3549 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3551 The + flag character inserts a + before any positive number, while a
3552 space inserts a space before any positive number; these flags only
3553 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3554 The # flag means to use an alternate display form for %o, %x, %X, %e,
3555 %f, and %g sequences. The - and 0 flags affect the width specifier,
3558 The width specifier supplies a lower limit for the length of the
3559 printed representation. The padding, if any, normally goes on the
3560 left, but it goes on the right if the - flag is present. The padding
3561 character is normally a space, but it is 0 if the 0 flag is present.
3562 The - flag takes precedence over the 0 flag.
3564 For %e, %f, and %g sequences, the number after the "." in the
3565 precision specifier says how many decimal places to show; if zero, the
3566 decimal point itself is omitted. For %s and %S, the precision
3567 specifier truncates the string to the given width.
3569 usage: (format STRING &rest OBJECTS) */)
3572 register Lisp_Object
*args
;
3574 register int n
; /* The number of the next arg to substitute */
3575 register int total
; /* An estimate of the final length */
3577 register unsigned char *format
, *end
, *format_start
;
3579 /* Nonzero if the output should be a multibyte string,
3580 which is true if any of the inputs is one. */
3582 /* When we make a multibyte string, we must pay attention to the
3583 byte combining problem, i.e., a byte may be combined with a
3584 multibyte charcter of the previous string. This flag tells if we
3585 must consider such a situation or not. */
3586 int maybe_combine_byte
;
3587 unsigned char *this_format
;
3588 /* Precision for each spec, or -1, a flag value meaning no precision
3589 was given in that spec. Element 0, corresonding to the format
3590 string itself, will not be used. Element NARGS, corresponding to
3591 no argument, *will* be assigned to in the case that a `%' and `.'
3592 occur after the final format specifier. */
3593 int *precision
= (int *) (alloca((nargs
+ 1) * sizeof (int)));
3596 int arg_intervals
= 0;
3599 /* discarded[I] is 1 if byte I of the format
3600 string was not copied into the output.
3601 It is 2 if byte I was not the first byte of its character. */
3602 char *discarded
= 0;
3604 /* Each element records, for one argument,
3605 the start and end bytepos in the output string,
3606 and whether the argument is a string with intervals.
3607 info[0] is unused. Unused elements have -1 for start. */
3610 int start
, end
, intervals
;
3613 /* It should not be necessary to GCPRO ARGS, because
3614 the caller in the interpreter should take care of that. */
3616 /* Try to determine whether the result should be multibyte.
3617 This is not always right; sometimes the result needs to be multibyte
3618 because of an object that we will pass through prin1,
3619 and in that case, we won't know it here. */
3620 for (n
= 0; n
< nargs
; n
++)
3622 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3624 /* Piggyback on this loop to initialize precision[N]. */
3627 precision
[nargs
] = -1;
3629 CHECK_STRING (args
[0]);
3630 /* We may have to change "%S" to "%s". */
3631 args
[0] = Fcopy_sequence (args
[0]);
3633 /* GC should never happen here, so abort if it does. */
3636 /* If we start out planning a unibyte result,
3637 then discover it has to be multibyte, we jump back to retry.
3638 That can only happen from the first large while loop below. */
3641 format
= SDATA (args
[0]);
3642 format_start
= format
;
3643 end
= format
+ SBYTES (args
[0]);
3646 /* Make room in result for all the non-%-codes in the control string. */
3647 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3649 /* Allocate the info and discarded tables. */
3651 int nbytes
= (nargs
+1) * sizeof *info
;
3654 info
= (struct info
*) alloca (nbytes
);
3655 bzero (info
, nbytes
);
3656 for (i
= 0; i
<= nargs
; i
++)
3659 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3660 bzero (discarded
, SBYTES (args
[0]));
3663 /* Add to TOTAL enough space to hold the converted arguments. */
3666 while (format
!= end
)
3667 if (*format
++ == '%')
3670 int actual_width
= 0;
3671 unsigned char *this_format_start
= format
- 1;
3672 int field_width
= 0;
3674 /* General format specifications look like
3676 '%' [flags] [field-width] [precision] format
3681 field-width ::= [0-9]+
3682 precision ::= '.' [0-9]*
3684 If a field-width is specified, it specifies to which width
3685 the output should be padded with blanks, if the output
3686 string is shorter than field-width.
3688 If precision is specified, it specifies the number of
3689 digits to print after the '.' for floats, or the max.
3690 number of chars to print from a string. */
3692 while (format
!= end
3693 && (*format
== '-' || *format
== '0' || *format
== '#'
3694 || * format
== ' ' || *format
== '+'))
3697 if (*format
>= '0' && *format
<= '9')
3699 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3700 field_width
= 10 * field_width
+ *format
- '0';
3703 /* N is not incremented for another few lines below, so refer to
3704 element N+1 (which might be precision[NARGS]). */
3708 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3709 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3712 /* Extra +1 for 'l' that we may need to insert into the
3714 if (format
- this_format_start
+ 2 > longest_format
)
3715 longest_format
= format
- this_format_start
+ 2;
3718 error ("Format string ends in middle of format specifier");
3721 else if (++n
>= nargs
)
3722 error ("Not enough arguments for format string");
3723 else if (*format
== 'S')
3725 /* For `S', prin1 the argument and then treat like a string. */
3726 register Lisp_Object tem
;
3727 tem
= Fprin1_to_string (args
[n
], Qnil
);
3728 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3734 /* If we restart the loop, we should not come here again
3735 because args[n] is now a string and calling
3736 Fprin1_to_string on it produces superflous double
3737 quotes. So, change "%S" to "%s" now. */
3741 else if (SYMBOLP (args
[n
]))
3743 args
[n
] = SYMBOL_NAME (args
[n
]);
3744 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3751 else if (STRINGP (args
[n
]))
3754 if (*format
!= 's' && *format
!= 'S')
3755 error ("Format specifier doesn't match argument type");
3756 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3757 to be as large as is calculated here. Easy check for
3758 the case PRECISION = 0. */
3759 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3760 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3762 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3763 else if (INTEGERP (args
[n
]) && *format
!= 's')
3765 /* The following loop assumes the Lisp type indicates
3766 the proper way to pass the argument.
3767 So make sure we have a flonum if the argument should
3769 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3770 args
[n
] = Ffloat (args
[n
]);
3772 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3773 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3774 error ("Invalid format operation %%%c", *format
);
3776 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3779 if (! ASCII_CHAR_P (XINT (args
[n
]))
3780 /* Note: No one can remeber why we have to treat
3781 the character 0 as a multibyte character here.
3782 But, until it causes a real problem, let's
3784 || XINT (args
[n
]) == 0)
3791 args
[n
] = Fchar_to_string (args
[n
]);
3792 thissize
= SBYTES (args
[n
]);
3794 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3797 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3798 thissize
= SBYTES (args
[n
]);
3802 else if (FLOATP (args
[n
]) && *format
!= 's')
3804 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3806 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3807 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3808 error ("Invalid format operation %%%c", *format
);
3809 /* This fails unnecessarily if args[n] is bigger than
3810 most-positive-fixnum but smaller than MAXINT.
3811 These cases are important because we sometimes use floats
3812 to represent such integer values (typically such values
3813 come from UIDs or PIDs). */
3814 /* args[n] = Ftruncate (args[n], Qnil); */
3817 /* Note that we're using sprintf to print floats,
3818 so we have to take into account what that function
3820 /* Filter out flag value of -1. */
3821 thissize
= (MAX_10_EXP
+ 100
3822 + (precision
[n
] > 0 ? precision
[n
] : 0));
3826 /* Anything but a string, convert to a string using princ. */
3827 register Lisp_Object tem
;
3828 tem
= Fprin1_to_string (args
[n
], Qt
);
3829 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3838 thissize
+= max (0, field_width
- actual_width
);
3839 total
+= thissize
+ 4;
3844 /* Now we can no longer jump to retry.
3845 TOTAL and LONGEST_FORMAT are known for certain. */
3847 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3849 /* Allocate the space for the result.
3850 Note that TOTAL is an overestimate. */
3851 SAFE_ALLOCA (buf
, char *, total
);
3857 /* Scan the format and store result in BUF. */
3858 format
= SDATA (args
[0]);
3859 format_start
= format
;
3860 end
= format
+ SBYTES (args
[0]);
3861 maybe_combine_byte
= 0;
3862 while (format
!= end
)
3868 unsigned char *this_format_start
= format
;
3870 discarded
[format
- format_start
] = 1;
3873 while (index("-+0# ", *format
))
3879 discarded
[format
- format_start
] = 1;
3883 minlen
= atoi (format
);
3885 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3887 discarded
[format
- format_start
] = 1;
3891 if (*format
++ == '%')
3900 discarded
[format
- format_start
- 1] = 1;
3901 info
[n
].start
= nchars
;
3903 if (STRINGP (args
[n
]))
3905 /* handle case (precision[n] >= 0) */
3908 int nbytes
, start
, end
;
3911 /* lisp_string_width ignores a precision of 0, but GNU
3912 libc functions print 0 characters when the precision
3913 is 0. Imitate libc behavior here. Changing
3914 lisp_string_width is the right thing, and will be
3915 done, but meanwhile we work with it. */
3917 if (precision
[n
] == 0)
3918 width
= nchars_string
= nbytes
= 0;
3919 else if (precision
[n
] > 0)
3920 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3922 { /* no precision spec given for this argument */
3923 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3924 nbytes
= SBYTES (args
[n
]);
3925 nchars_string
= SCHARS (args
[n
]);
3928 /* If spec requires it, pad on right with spaces. */
3929 padding
= minlen
- width
;
3931 while (padding
-- > 0)
3937 info
[n
].start
= start
= nchars
;
3938 nchars
+= nchars_string
;
3943 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3944 && STRING_MULTIBYTE (args
[n
])
3945 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3946 maybe_combine_byte
= 1;
3948 p
+= copy_text (SDATA (args
[n
]), p
,
3950 STRING_MULTIBYTE (args
[n
]), multibyte
);
3952 info
[n
].end
= nchars
;
3955 while (padding
-- > 0)
3961 /* If this argument has text properties, record where
3962 in the result string it appears. */
3963 if (STRING_INTERVALS (args
[n
]))
3964 info
[n
].intervals
= arg_intervals
= 1;
3966 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3970 bcopy (this_format_start
, this_format
,
3971 format
- this_format_start
);
3972 this_format
[format
- this_format_start
] = 0;
3974 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
3975 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3978 if (sizeof (EMACS_INT
) > sizeof (int)
3979 && format
[-1] != 'c')
3981 /* Insert 'l' before format spec. */
3982 this_format
[format
- this_format_start
]
3983 = this_format
[format
- this_format_start
- 1];
3984 this_format
[format
- this_format_start
- 1] = 'l';
3985 this_format
[format
- this_format_start
+ 1] = 0;
3988 if (INTEGERP (args
[n
]))
3990 if (format
[-1] == 'c')
3991 sprintf (p
, this_format
, (int) XINT (args
[n
]));
3992 else if (format
[-1] == 'd')
3993 sprintf (p
, this_format
, XINT (args
[n
]));
3994 /* Don't sign-extend for octal or hex printing. */
3996 sprintf (p
, this_format
, XUINT (args
[n
]));
3998 else if (format
[-1] == 'c')
3999 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
4000 else if (format
[-1] == 'd')
4001 /* Maybe we should use "%1.0f" instead so it also works
4002 for values larger than MAXINT. */
4003 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
4005 /* Don't sign-extend for octal or hex printing. */
4006 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
4011 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4012 && !CHAR_HEAD_P (*((unsigned char *) p
)))
4013 maybe_combine_byte
= 1;
4014 this_nchars
= strlen (p
);
4016 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
4019 nchars
+= this_nchars
;
4020 info
[n
].end
= nchars
;
4024 else if (STRING_MULTIBYTE (args
[0]))
4026 /* Copy a whole multibyte character. */
4029 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4030 && !CHAR_HEAD_P (*format
))
4031 maybe_combine_byte
= 1;
4033 while (! CHAR_HEAD_P (*format
))
4035 discarded
[format
- format_start
] = 2;
4042 /* Convert a single-byte character to multibyte. */
4043 int len
= copy_text (format
, p
, 1, 0, 1);
4050 *p
++ = *format
++, nchars
++;
4053 if (p
> buf
+ total
)
4056 if (maybe_combine_byte
)
4057 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
4058 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4060 /* If we allocated BUF with malloc, free it too. */
4063 /* If the format string has text properties, or any of the string
4064 arguments has text properties, set up text properties of the
4067 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4069 Lisp_Object len
, new_len
, props
;
4070 struct gcpro gcpro1
;
4072 /* Add text properties from the format string. */
4073 len
= make_number (SCHARS (args
[0]));
4074 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4079 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4082 /* Adjust the bounds of each text property
4083 to the proper start and end in the output string. */
4085 /* Put the positions in PROPS in increasing order, so that
4086 we can do (effectively) one scan through the position
4087 space of the format string. */
4088 props
= Fnreverse (props
);
4090 /* BYTEPOS is the byte position in the format string,
4091 POSITION is the untranslated char position in it,
4092 TRANSLATED is the translated char position in BUF,
4093 and ARGN is the number of the next arg we will come to. */
4094 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4101 /* First adjust the property start position. */
4102 pos
= XINT (XCAR (item
));
4104 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4105 up to this position. */
4106 for (; position
< pos
; bytepos
++)
4108 if (! discarded
[bytepos
])
4109 position
++, translated
++;
4110 else if (discarded
[bytepos
] == 1)
4113 if (translated
== info
[argn
].start
)
4115 translated
+= info
[argn
].end
- info
[argn
].start
;
4121 XSETCAR (item
, make_number (translated
));
4123 /* Likewise adjust the property end position. */
4124 pos
= XINT (XCAR (XCDR (item
)));
4126 for (; position
< pos
; bytepos
++)
4128 if (! discarded
[bytepos
])
4129 position
++, translated
++;
4130 else if (discarded
[bytepos
] == 1)
4133 if (translated
== info
[argn
].start
)
4135 translated
+= info
[argn
].end
- info
[argn
].start
;
4141 XSETCAR (XCDR (item
), make_number (translated
));
4144 add_text_properties_from_list (val
, props
, make_number (0));
4147 /* Add text properties from arguments. */
4149 for (n
= 1; n
< nargs
; ++n
)
4150 if (info
[n
].intervals
)
4152 len
= make_number (SCHARS (args
[n
]));
4153 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4154 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4155 extend_property_ranges (props
, len
, new_len
);
4156 /* If successive arguments have properites, be sure that
4157 the value of `composition' property be the copy. */
4158 if (n
> 1 && info
[n
- 1].end
)
4159 make_composition_value_copy (props
);
4160 add_text_properties_from_list (val
, props
,
4161 make_number (info
[n
].start
));
4171 format2 (string1
, arg0
, arg1
)
4173 Lisp_Object arg0
, arg1
;
4175 Lisp_Object args
[3];
4176 args
[0] = build_string (string1
);
4179 return Fformat (3, args
);
4182 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4183 doc
: /* Return t if two characters match, optionally ignoring case.
4184 Both arguments must be characters (i.e. integers).
4185 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4187 register Lisp_Object c1
, c2
;
4190 /* Check they're chars, not just integers, otherwise we could get array
4191 bounds violations in DOWNCASE. */
4192 CHECK_CHARACTER (c1
);
4193 CHECK_CHARACTER (c2
);
4195 if (XINT (c1
) == XINT (c2
))
4197 if (NILP (current_buffer
->case_fold_search
))
4200 /* Do these in separate statements,
4201 then compare the variables.
4202 because of the way DOWNCASE uses temp variables. */
4204 if (NILP (current_buffer
->enable_multibyte_characters
)
4205 && ! ASCII_CHAR_P (i1
))
4207 MAKE_CHAR_MULTIBYTE (i1
);
4210 if (NILP (current_buffer
->enable_multibyte_characters
)
4211 && ! ASCII_CHAR_P (i2
))
4213 MAKE_CHAR_MULTIBYTE (i2
);
4217 return (i1
== i2
? Qt
: Qnil
);
4220 /* Transpose the markers in two regions of the current buffer, and
4221 adjust the ones between them if necessary (i.e.: if the regions
4224 START1, END1 are the character positions of the first region.
4225 START1_BYTE, END1_BYTE are the byte positions.
4226 START2, END2 are the character positions of the second region.
4227 START2_BYTE, END2_BYTE are the byte positions.
4229 Traverses the entire marker list of the buffer to do so, adding an
4230 appropriate amount to some, subtracting from some, and leaving the
4231 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4233 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4236 transpose_markers (start1
, end1
, start2
, end2
,
4237 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
4238 register int start1
, end1
, start2
, end2
;
4239 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
4241 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4242 register struct Lisp_Marker
*marker
;
4244 /* Update point as if it were a marker. */
4248 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4249 PT_BYTE
+ (end2_byte
- end1_byte
));
4250 else if (PT
< start2
)
4251 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4252 (PT_BYTE
+ (end2_byte
- start2_byte
)
4253 - (end1_byte
- start1_byte
)));
4255 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4256 PT_BYTE
- (start2_byte
- start1_byte
));
4258 /* We used to adjust the endpoints here to account for the gap, but that
4259 isn't good enough. Even if we assume the caller has tried to move the
4260 gap out of our way, it might still be at start1 exactly, for example;
4261 and that places it `inside' the interval, for our purposes. The amount
4262 of adjustment is nontrivial if there's a `denormalized' marker whose
4263 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4264 the dirty work to Fmarker_position, below. */
4266 /* The difference between the region's lengths */
4267 diff
= (end2
- start2
) - (end1
- start1
);
4268 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4270 /* For shifting each marker in a region by the length of the other
4271 region plus the distance between the regions. */
4272 amt1
= (end2
- start2
) + (start2
- end1
);
4273 amt2
= (end1
- start1
) + (start2
- end1
);
4274 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4275 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4277 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4279 mpos
= marker
->bytepos
;
4280 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4282 if (mpos
< end1_byte
)
4284 else if (mpos
< start2_byte
)
4288 marker
->bytepos
= mpos
;
4290 mpos
= marker
->charpos
;
4291 if (mpos
>= start1
&& mpos
< end2
)
4295 else if (mpos
< start2
)
4300 marker
->charpos
= mpos
;
4304 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4305 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4306 The regions may not be overlapping, because the size of the buffer is
4307 never changed in a transposition.
4309 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4310 any markers that happen to be located in the regions.
4312 Transposing beyond buffer boundaries is an error. */)
4313 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
4314 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
4316 register EMACS_INT start1
, end1
, start2
, end2
;
4317 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4318 EMACS_INT gap
, len1
, len_mid
, len2
;
4319 unsigned char *start1_addr
, *start2_addr
, *temp
;
4321 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4324 XSETBUFFER (buf
, current_buffer
);
4325 cur_intv
= BUF_INTERVALS (current_buffer
);
4327 validate_region (&startr1
, &endr1
);
4328 validate_region (&startr2
, &endr2
);
4330 start1
= XFASTINT (startr1
);
4331 end1
= XFASTINT (endr1
);
4332 start2
= XFASTINT (startr2
);
4333 end2
= XFASTINT (endr2
);
4336 /* Swap the regions if they're reversed. */
4339 register int glumph
= start1
;
4347 len1
= end1
- start1
;
4348 len2
= end2
- start2
;
4351 error ("Transposed regions overlap");
4352 else if (start1
== end1
|| start2
== end2
)
4353 error ("Transposed region has length 0");
4355 /* The possibilities are:
4356 1. Adjacent (contiguous) regions, or separate but equal regions
4357 (no, really equal, in this case!), or
4358 2. Separate regions of unequal size.
4360 The worst case is usually No. 2. It means that (aside from
4361 potential need for getting the gap out of the way), there also
4362 needs to be a shifting of the text between the two regions. So
4363 if they are spread far apart, we are that much slower... sigh. */
4365 /* It must be pointed out that the really studly thing to do would
4366 be not to move the gap at all, but to leave it in place and work
4367 around it if necessary. This would be extremely efficient,
4368 especially considering that people are likely to do
4369 transpositions near where they are working interactively, which
4370 is exactly where the gap would be found. However, such code
4371 would be much harder to write and to read. So, if you are
4372 reading this comment and are feeling squirrely, by all means have
4373 a go! I just didn't feel like doing it, so I will simply move
4374 the gap the minimum distance to get it out of the way, and then
4375 deal with an unbroken array. */
4377 /* Make sure the gap won't interfere, by moving it out of the text
4378 we will operate on. */
4379 if (start1
< gap
&& gap
< end2
)
4381 if (gap
- start1
< end2
- gap
)
4387 start1_byte
= CHAR_TO_BYTE (start1
);
4388 start2_byte
= CHAR_TO_BYTE (start2
);
4389 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4390 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4392 #ifdef BYTE_COMBINING_DEBUG
4395 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4396 len2_byte
, start1
, start1_byte
)
4397 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4398 len1_byte
, end2
, start2_byte
+ len2_byte
)
4399 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4400 len1_byte
, end2
, start2_byte
+ len2_byte
))
4405 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4406 len2_byte
, start1
, start1_byte
)
4407 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4408 len1_byte
, start2
, start2_byte
)
4409 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4410 len2_byte
, end1
, start1_byte
+ len1_byte
)
4411 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4412 len1_byte
, end2
, start2_byte
+ len2_byte
))
4417 /* Hmmm... how about checking to see if the gap is large
4418 enough to use as the temporary storage? That would avoid an
4419 allocation... interesting. Later, don't fool with it now. */
4421 /* Working without memmove, for portability (sigh), so must be
4422 careful of overlapping subsections of the array... */
4424 if (end1
== start2
) /* adjacent regions */
4426 modify_region (current_buffer
, start1
, end2
, 0);
4427 record_change (start1
, len1
+ len2
);
4429 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4430 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4431 /* Don't use Fset_text_properties: that can cause GC, which can
4432 clobber objects stored in the tmp_intervals. */
4433 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4434 if (!NULL_INTERVAL_P (tmp_interval3
))
4435 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4437 /* First region smaller than second. */
4438 if (len1_byte
< len2_byte
)
4442 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4444 /* Don't precompute these addresses. We have to compute them
4445 at the last minute, because the relocating allocator might
4446 have moved the buffer around during the xmalloc. */
4447 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4448 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4450 bcopy (start2_addr
, temp
, len2_byte
);
4451 bcopy (start1_addr
, start1_addr
+ len2_byte
, len1_byte
);
4452 bcopy (temp
, start1_addr
, len2_byte
);
4456 /* First region not smaller than second. */
4460 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4461 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4462 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4463 bcopy (start1_addr
, temp
, len1_byte
);
4464 bcopy (start2_addr
, start1_addr
, len2_byte
);
4465 bcopy (temp
, start1_addr
+ len2_byte
, len1_byte
);
4468 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4469 len1
, current_buffer
, 0);
4470 graft_intervals_into_buffer (tmp_interval2
, start1
,
4471 len2
, current_buffer
, 0);
4472 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4473 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4475 /* Non-adjacent regions, because end1 != start2, bleagh... */
4478 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4480 if (len1_byte
== len2_byte
)
4481 /* Regions are same size, though, how nice. */
4485 modify_region (current_buffer
, start1
, end1
, 0);
4486 modify_region (current_buffer
, start2
, end2
, 0);
4487 record_change (start1
, len1
);
4488 record_change (start2
, len2
);
4489 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4490 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4492 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4493 if (!NULL_INTERVAL_P (tmp_interval3
))
4494 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4496 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4497 if (!NULL_INTERVAL_P (tmp_interval3
))
4498 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4500 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4501 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4502 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4503 bcopy (start1_addr
, temp
, len1_byte
);
4504 bcopy (start2_addr
, start1_addr
, len2_byte
);
4505 bcopy (temp
, start2_addr
, len1_byte
);
4508 graft_intervals_into_buffer (tmp_interval1
, start2
,
4509 len1
, current_buffer
, 0);
4510 graft_intervals_into_buffer (tmp_interval2
, start1
,
4511 len2
, current_buffer
, 0);
4514 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4515 /* Non-adjacent & unequal size, area between must also be shifted. */
4519 modify_region (current_buffer
, start1
, end2
, 0);
4520 record_change (start1
, (end2
- start1
));
4521 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4522 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4523 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4525 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4526 if (!NULL_INTERVAL_P (tmp_interval3
))
4527 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4529 /* holds region 2 */
4530 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4531 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4532 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4533 bcopy (start2_addr
, temp
, len2_byte
);
4534 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2_byte
, len1_byte
);
4535 safe_bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4536 bcopy (temp
, start1_addr
, len2_byte
);
4539 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4540 len1
, current_buffer
, 0);
4541 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4542 len_mid
, current_buffer
, 0);
4543 graft_intervals_into_buffer (tmp_interval2
, start1
,
4544 len2
, current_buffer
, 0);
4547 /* Second region smaller than first. */
4551 record_change (start1
, (end2
- start1
));
4552 modify_region (current_buffer
, start1
, end2
, 0);
4554 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4555 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4556 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4558 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4559 if (!NULL_INTERVAL_P (tmp_interval3
))
4560 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4562 /* holds region 1 */
4563 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4564 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4565 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4566 bcopy (start1_addr
, temp
, len1_byte
);
4567 bcopy (start2_addr
, start1_addr
, len2_byte
);
4568 bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4569 bcopy (temp
, start1_addr
+ len2_byte
+ len_mid
, len1_byte
);
4572 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4573 len1
, current_buffer
, 0);
4574 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4575 len_mid
, current_buffer
, 0);
4576 graft_intervals_into_buffer (tmp_interval2
, start1
,
4577 len2
, current_buffer
, 0);
4580 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4581 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4584 /* When doing multiple transpositions, it might be nice
4585 to optimize this. Perhaps the markers in any one buffer
4586 should be organized in some sorted data tree. */
4587 if (NILP (leave_markers
))
4589 transpose_markers (start1
, end1
, start2
, end2
,
4590 start1_byte
, start1_byte
+ len1_byte
,
4591 start2_byte
, start2_byte
+ len2_byte
);
4592 fix_start_end_in_overlays (start1
, end2
);
4595 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4606 Qbuffer_access_fontify_functions
4607 = intern ("buffer-access-fontify-functions");
4608 staticpro (&Qbuffer_access_fontify_functions
);
4610 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4611 doc
: /* Non-nil means text motion commands don't notice fields. */);
4612 Vinhibit_field_text_motion
= Qnil
;
4614 DEFVAR_LISP ("buffer-access-fontify-functions",
4615 &Vbuffer_access_fontify_functions
,
4616 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4617 Each function is called with two arguments which specify the range
4618 of the buffer being accessed. */);
4619 Vbuffer_access_fontify_functions
= Qnil
;
4623 extern Lisp_Object Vprin1_to_string_buffer
;
4624 obuf
= Fcurrent_buffer ();
4625 /* Do this here, because init_buffer_once is too early--it won't work. */
4626 Fset_buffer (Vprin1_to_string_buffer
);
4627 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4628 Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
4633 DEFVAR_LISP ("buffer-access-fontified-property",
4634 &Vbuffer_access_fontified_property
,
4635 doc
: /* Property which (if non-nil) indicates text has been fontified.
4636 `buffer-substring' need not call the `buffer-access-fontify-functions'
4637 functions if all the text being accessed has this property. */);
4638 Vbuffer_access_fontified_property
= Qnil
;
4640 DEFVAR_LISP ("system-name", &Vsystem_name
,
4641 doc
: /* The host name of the machine Emacs is running on. */);
4643 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4644 doc
: /* The full name of the user logged in. */);
4646 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4647 doc
: /* The user's name, taken from environment variables if possible. */);
4649 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4650 doc
: /* The user's name, based upon the real uid only. */);
4652 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4653 doc
: /* The release of the operating system Emacs is running on. */);
4655 defsubr (&Spropertize
);
4656 defsubr (&Schar_equal
);
4657 defsubr (&Sgoto_char
);
4658 defsubr (&Sstring_to_char
);
4659 defsubr (&Schar_to_string
);
4660 defsubr (&Sbuffer_substring
);
4661 defsubr (&Sbuffer_substring_no_properties
);
4662 defsubr (&Sbuffer_string
);
4664 defsubr (&Spoint_marker
);
4665 defsubr (&Smark_marker
);
4667 defsubr (&Sregion_beginning
);
4668 defsubr (&Sregion_end
);
4670 staticpro (&Qfield
);
4671 Qfield
= intern ("field");
4672 staticpro (&Qboundary
);
4673 Qboundary
= intern ("boundary");
4674 defsubr (&Sfield_beginning
);
4675 defsubr (&Sfield_end
);
4676 defsubr (&Sfield_string
);
4677 defsubr (&Sfield_string_no_properties
);
4678 defsubr (&Sdelete_field
);
4679 defsubr (&Sconstrain_to_field
);
4681 defsubr (&Sline_beginning_position
);
4682 defsubr (&Sline_end_position
);
4684 /* defsubr (&Smark); */
4685 /* defsubr (&Sset_mark); */
4686 defsubr (&Ssave_excursion
);
4687 defsubr (&Ssave_current_buffer
);
4689 defsubr (&Sbufsize
);
4690 defsubr (&Spoint_max
);
4691 defsubr (&Spoint_min
);
4692 defsubr (&Spoint_min_marker
);
4693 defsubr (&Spoint_max_marker
);
4694 defsubr (&Sgap_position
);
4695 defsubr (&Sgap_size
);
4696 defsubr (&Sposition_bytes
);
4697 defsubr (&Sbyte_to_position
);
4703 defsubr (&Sfollowing_char
);
4704 defsubr (&Sprevious_char
);
4705 defsubr (&Schar_after
);
4706 defsubr (&Schar_before
);
4708 defsubr (&Sinsert_before_markers
);
4709 defsubr (&Sinsert_and_inherit
);
4710 defsubr (&Sinsert_and_inherit_before_markers
);
4711 defsubr (&Sinsert_char
);
4712 defsubr (&Sinsert_byte
);
4714 defsubr (&Suser_login_name
);
4715 defsubr (&Suser_real_login_name
);
4716 defsubr (&Suser_uid
);
4717 defsubr (&Suser_real_uid
);
4718 defsubr (&Suser_full_name
);
4719 defsubr (&Semacs_pid
);
4720 defsubr (&Scurrent_time
);
4721 defsubr (&Sget_internal_run_time
);
4722 defsubr (&Sformat_time_string
);
4723 defsubr (&Sfloat_time
);
4724 defsubr (&Sdecode_time
);
4725 defsubr (&Sencode_time
);
4726 defsubr (&Scurrent_time_string
);
4727 defsubr (&Scurrent_time_zone
);
4728 defsubr (&Sset_time_zone_rule
);
4729 defsubr (&Ssystem_name
);
4730 defsubr (&Smessage
);
4731 defsubr (&Smessage_box
);
4732 defsubr (&Smessage_or_box
);
4733 defsubr (&Scurrent_message
);
4736 defsubr (&Sinsert_buffer_substring
);
4737 defsubr (&Scompare_buffer_substrings
);
4738 defsubr (&Ssubst_char_in_region
);
4739 defsubr (&Stranslate_region_internal
);
4740 defsubr (&Sdelete_region
);
4741 defsubr (&Sdelete_and_extract_region
);
4743 defsubr (&Snarrow_to_region
);
4744 defsubr (&Ssave_restriction
);
4745 defsubr (&Stranspose_regions
);
4748 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4749 (do not change this comment) */