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, 2010 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
35 #ifdef HAVE_SYS_UTSNAME_H
36 #include <sys/utsname.h>
41 /* systime.h includes <sys/time.h> which, on some systems, is required
42 for <sys/resource.h>; thus systime.h must be included before
46 #if defined HAVE_SYS_RESOURCE_H
47 #include <sys/resource.h>
52 #include "intervals.h"
54 #include "character.h"
58 #include "blockinput.h"
62 #define MAX_10_EXP DBL_MAX_10_EXP
64 #define MAX_10_EXP 310
71 #ifndef USER_FULL_NAME
72 #define USER_FULL_NAME pw->pw_gecos
76 extern char **environ
;
79 #define TM_YEAR_BASE 1900
81 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
82 asctime to have well-defined behavior. */
83 #ifndef TM_YEAR_IN_ASCTIME_RANGE
84 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
85 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
88 extern size_t emacs_strftimeu
P_ ((char *, size_t, const char *,
89 const struct tm
*, int));
92 extern Lisp_Object
w32_get_internal_run_time ();
95 static int tm_diff
P_ ((struct tm
*, struct tm
*));
96 static void find_field
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *));
97 static void update_buffer_properties
P_ ((int, int));
98 static Lisp_Object region_limit
P_ ((int));
99 int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
100 static size_t emacs_memftimeu
P_ ((char *, size_t, const char *,
101 size_t, const struct tm
*, int));
102 static void general_insert_function (void (*) (const unsigned char *, EMACS_INT
),
103 void (*) (Lisp_Object
, EMACS_INT
,
104 EMACS_INT
, EMACS_INT
,
106 int, int, Lisp_Object
*);
107 static Lisp_Object subst_char_in_region_unwind
P_ ((Lisp_Object
));
108 static Lisp_Object subst_char_in_region_unwind_1
P_ ((Lisp_Object
));
109 static void transpose_markers
P_ ((int, int, int, int, int, int, int, int));
112 extern char *index
P_ ((const char *, int));
115 Lisp_Object Vbuffer_access_fontify_functions
;
116 Lisp_Object Qbuffer_access_fontify_functions
;
117 Lisp_Object Vbuffer_access_fontified_property
;
119 Lisp_Object Fuser_full_name
P_ ((Lisp_Object
));
121 /* Non-nil means don't stop at field boundary in text motion commands. */
123 Lisp_Object Vinhibit_field_text_motion
;
125 /* Some static data, and a function to initialize it for each run */
127 Lisp_Object Vsystem_name
;
128 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
129 Lisp_Object Vuser_full_name
; /* full name of current user */
130 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
131 Lisp_Object Voperating_system_release
; /* Operating System Release */
133 /* Symbol for the text property used to mark fields. */
137 /* A special value for Qfield properties. */
139 Lisp_Object Qboundary
;
146 register unsigned char *p
;
147 struct passwd
*pw
; /* password entry for the current user */
150 /* Set up system_name even when dumping. */
154 /* Don't bother with this on initial start when just dumping out */
157 #endif /* not CANNOT_DUMP */
159 pw
= (struct passwd
*) getpwuid (getuid ());
161 /* We let the real user name default to "root" because that's quite
162 accurate on MSDOG and because it lets Emacs find the init file.
163 (The DVX libraries override the Djgpp libraries here.) */
164 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
166 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
169 /* Get the effective user name, by consulting environment variables,
170 or the effective uid if those are unset. */
171 user_name
= (char *) getenv ("LOGNAME");
174 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
175 #else /* WINDOWSNT */
176 user_name
= (char *) getenv ("USER");
177 #endif /* WINDOWSNT */
180 pw
= (struct passwd
*) getpwuid (geteuid ());
181 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
183 Vuser_login_name
= build_string (user_name
);
185 /* If the user name claimed in the environment vars differs from
186 the real uid, use the claimed name to find the full name. */
187 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
188 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
191 p
= (unsigned char *) getenv ("NAME");
193 Vuser_full_name
= build_string (p
);
194 else if (NILP (Vuser_full_name
))
195 Vuser_full_name
= build_string ("unknown");
197 #ifdef HAVE_SYS_UTSNAME_H
201 Voperating_system_release
= build_string (uts
.release
);
204 Voperating_system_release
= Qnil
;
208 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
209 doc
: /* Convert arg CHAR to a string containing that character.
210 usage: (char-to-string CHAR) */)
212 Lisp_Object character
;
215 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
217 CHECK_CHARACTER (character
);
219 len
= CHAR_STRING (XFASTINT (character
), str
);
220 return make_string_from_bytes (str
, 1, len
);
223 DEFUN ("byte-to-string", Fbyte_to_string
, Sbyte_to_string
, 1, 1, 0,
224 doc
: /* Convert arg BYTE to a string containing that byte. */)
229 unsigned char b
= XINT (byte
);
230 return make_string_from_bytes (&b
, 1, 1);
233 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
234 doc
: /* Convert arg STRING to a character, the first character of that string.
235 A multibyte character is handled correctly. */)
237 register Lisp_Object string
;
239 register Lisp_Object val
;
240 CHECK_STRING (string
);
243 if (STRING_MULTIBYTE (string
))
244 XSETFASTINT (val
, STRING_CHAR (SDATA (string
)));
246 XSETFASTINT (val
, SREF (string
, 0));
249 XSETFASTINT (val
, 0);
254 buildmark (charpos
, bytepos
)
255 int charpos
, bytepos
;
257 register Lisp_Object mark
;
258 mark
= Fmake_marker ();
259 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
263 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
264 doc
: /* Return value of point, as an integer.
265 Beginning of buffer is position (point-min). */)
269 XSETFASTINT (temp
, PT
);
273 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
274 doc
: /* Return value of point, as a marker object. */)
277 return buildmark (PT
, PT_BYTE
);
281 clip_to_bounds (lower
, num
, upper
)
282 int lower
, num
, upper
;
286 else if (num
> upper
)
292 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
293 doc
: /* Set point to POSITION, a number or marker.
294 Beginning of buffer is position (point-min), end is (point-max).
296 The return value is POSITION. */)
298 register Lisp_Object position
;
302 if (MARKERP (position
)
303 && current_buffer
== XMARKER (position
)->buffer
)
305 pos
= marker_position (position
);
307 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
309 SET_PT_BOTH (ZV
, ZV_BYTE
);
311 SET_PT_BOTH (pos
, marker_byte_position (position
));
316 CHECK_NUMBER_COERCE_MARKER (position
);
318 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
324 /* Return the start or end position of the region.
325 BEGINNINGP non-zero means return the start.
326 If there is no region active, signal an error. */
329 region_limit (beginningp
)
332 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
335 if (!NILP (Vtransient_mark_mode
)
336 && NILP (Vmark_even_if_inactive
)
337 && NILP (current_buffer
->mark_active
))
338 xsignal0 (Qmark_inactive
);
340 m
= Fmarker_position (current_buffer
->mark
);
342 error ("The mark is not set now, so there is no region");
344 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
345 m
= make_number (PT
);
349 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
350 doc
: /* Return position of beginning of region, as an integer. */)
353 return region_limit (1);
356 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
357 doc
: /* Return position of end of region, as an integer. */)
360 return region_limit (0);
363 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
364 doc
: /* Return this buffer's mark, as a marker object.
365 Watch out! Moving this marker changes the mark position.
366 If you set the marker not to point anywhere, the buffer will have no mark. */)
369 return current_buffer
->mark
;
373 /* Find all the overlays in the current buffer that touch position POS.
374 Return the number found, and store them in a vector in VEC
378 overlays_around (pos
, vec
, len
)
383 Lisp_Object overlay
, start
, end
;
384 struct Lisp_Overlay
*tail
;
385 int startpos
, endpos
;
388 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
390 XSETMISC (overlay
, tail
);
392 end
= OVERLAY_END (overlay
);
393 endpos
= OVERLAY_POSITION (end
);
396 start
= OVERLAY_START (overlay
);
397 startpos
= OVERLAY_POSITION (start
);
402 /* Keep counting overlays even if we can't return them all. */
407 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
409 XSETMISC (overlay
, tail
);
411 start
= OVERLAY_START (overlay
);
412 startpos
= OVERLAY_POSITION (start
);
415 end
= OVERLAY_END (overlay
);
416 endpos
= OVERLAY_POSITION (end
);
428 /* Return the value of property PROP, in OBJECT at POSITION.
429 It's the value of PROP that a char inserted at POSITION would get.
430 OBJECT is optional and defaults to the current buffer.
431 If OBJECT is a buffer, then overlay properties are considered as well as
433 If OBJECT is a window, then that window's buffer is used, but
434 window-specific overlays are considered only if they are associated
437 get_pos_property (position
, prop
, object
)
438 Lisp_Object position
, object
;
439 register Lisp_Object prop
;
441 CHECK_NUMBER_COERCE_MARKER (position
);
444 XSETBUFFER (object
, current_buffer
);
445 else if (WINDOWP (object
))
446 object
= XWINDOW (object
)->buffer
;
448 if (!BUFFERP (object
))
449 /* pos-property only makes sense in buffers right now, since strings
450 have no overlays and no notion of insertion for which stickiness
452 return Fget_text_property (position
, prop
, object
);
455 int posn
= XINT (position
);
457 Lisp_Object
*overlay_vec
, tem
;
458 struct buffer
*obuf
= current_buffer
;
460 set_buffer_temp (XBUFFER (object
));
462 /* First try with room for 40 overlays. */
464 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
465 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
467 /* If there are more than 40,
468 make enough space for all, and try again. */
471 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
472 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
474 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
476 set_buffer_temp (obuf
);
478 /* Now check the overlays in order of decreasing priority. */
479 while (--noverlays
>= 0)
481 Lisp_Object ol
= overlay_vec
[noverlays
];
482 tem
= Foverlay_get (ol
, prop
);
485 /* Check the overlay is indeed active at point. */
486 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
487 if ((OVERLAY_POSITION (start
) == posn
488 && XMARKER (start
)->insertion_type
== 1)
489 || (OVERLAY_POSITION (finish
) == posn
490 && XMARKER (finish
)->insertion_type
== 0))
491 ; /* The overlay will not cover a char inserted at point. */
499 { /* Now check the text properties. */
500 int stickiness
= text_property_stickiness (prop
, position
, object
);
502 return Fget_text_property (position
, prop
, object
);
503 else if (stickiness
< 0
504 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
505 return Fget_text_property (make_number (XINT (position
) - 1),
513 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
514 the value of point is used instead. If BEG or END is null,
515 means don't store the beginning or end of the field.
517 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
518 results; they do not effect boundary behavior.
520 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
521 position of a field, then the beginning of the previous field is
522 returned instead of the beginning of POS's field (since the end of a
523 field is actually also the beginning of the next input field, this
524 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
525 true case, if two fields are separated by a field with the special
526 value `boundary', and POS lies within it, then the two separated
527 fields are considered to be adjacent, and POS between them, when
528 finding the beginning and ending of the "merged" field.
530 Either BEG or END may be 0, in which case the corresponding value
534 find_field (pos
, merge_at_boundary
, beg_limit
, beg
, end_limit
, end
)
536 Lisp_Object merge_at_boundary
;
537 Lisp_Object beg_limit
, end_limit
;
540 /* Fields right before and after the point. */
541 Lisp_Object before_field
, after_field
;
542 /* 1 if POS counts as the start of a field. */
543 int at_field_start
= 0;
544 /* 1 if POS counts as the end of a field. */
545 int at_field_end
= 0;
548 XSETFASTINT (pos
, PT
);
550 CHECK_NUMBER_COERCE_MARKER (pos
);
553 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
555 = (XFASTINT (pos
) > BEGV
556 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
558 /* Using nil here would be a more obvious choice, but it would
559 fail when the buffer starts with a non-sticky field. */
562 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
563 and POS is at beginning of a field, which can also be interpreted
564 as the end of the previous field. Note that the case where if
565 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
566 more natural one; then we avoid treating the beginning of a field
568 if (NILP (merge_at_boundary
))
570 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
571 if (!EQ (field
, after_field
))
573 if (!EQ (field
, before_field
))
575 if (NILP (field
) && at_field_start
&& at_field_end
)
576 /* If an inserted char would have a nil field while the surrounding
577 text is non-nil, we're probably not looking at a
578 zero-length field, but instead at a non-nil field that's
579 not intended for editing (such as comint's prompts). */
580 at_field_end
= at_field_start
= 0;
583 /* Note about special `boundary' fields:
585 Consider the case where the point (`.') is between the fields `x' and `y':
589 In this situation, if merge_at_boundary is true, we consider the
590 `x' and `y' fields as forming one big merged field, and so the end
591 of the field is the end of `y'.
593 However, if `x' and `y' are separated by a special `boundary' field
594 (a field with a `field' char-property of 'boundary), then we ignore
595 this special field when merging adjacent fields. Here's the same
596 situation, but with a `boundary' field between the `x' and `y' fields:
600 Here, if point is at the end of `x', the beginning of `y', or
601 anywhere in-between (within the `boundary' field), we merge all
602 three fields and consider the beginning as being the beginning of
603 the `x' field, and the end as being the end of the `y' field. */
608 /* POS is at the edge of a field, and we should consider it as
609 the beginning of the following field. */
610 *beg
= XFASTINT (pos
);
612 /* Find the previous field boundary. */
615 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
616 /* Skip a `boundary' field. */
617 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
620 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
622 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
629 /* POS is at the edge of a field, and we should consider it as
630 the end of the previous field. */
631 *end
= XFASTINT (pos
);
633 /* Find the next field boundary. */
635 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
636 /* Skip a `boundary' field. */
637 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
640 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
642 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
648 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
649 doc
: /* Delete the field surrounding POS.
650 A field is a region of text with the same `field' property.
651 If POS is nil, the value of point is used for POS. */)
656 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
658 del_range (beg
, end
);
662 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
663 doc
: /* Return the contents of the field surrounding POS as a string.
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
, 1);
674 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
675 doc
: /* Return the contents of the field around POS, without text properties.
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. */)
682 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
683 return make_buffer_string (beg
, end
, 0);
686 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
687 doc
: /* Return the beginning of the field surrounding POS.
688 A field is a region of text with the same `field' property.
689 If POS is nil, the value of point is used for POS.
690 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
691 field, then the beginning of the *previous* field is returned.
692 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
693 is before LIMIT, then LIMIT will be returned instead. */)
694 (pos
, escape_from_edge
, limit
)
695 Lisp_Object pos
, escape_from_edge
, limit
;
698 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
699 return make_number (beg
);
702 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
703 doc
: /* Return the end of the field surrounding POS.
704 A field is a region of text with the same `field' property.
705 If POS is nil, the value of point is used for POS.
706 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
707 then the end of the *following* field is returned.
708 If LIMIT is non-nil, it is a buffer position; if the end of the field
709 is after LIMIT, then LIMIT will be returned instead. */)
710 (pos
, escape_from_edge
, limit
)
711 Lisp_Object pos
, escape_from_edge
, limit
;
714 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
715 return make_number (end
);
718 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
719 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
721 A field is a region of text with the same `field' property.
722 If NEW-POS is nil, then the current point is used instead, and set to the
723 constrained position if that is different.
725 If OLD-POS is at the boundary of two fields, then the allowable
726 positions for NEW-POS depends on the value of the optional argument
727 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
728 constrained to the field that has the same `field' char-property
729 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
730 is non-nil, NEW-POS is constrained to the union of the two adjacent
731 fields. Additionally, if two fields are separated by another field with
732 the special value `boundary', then any point within this special field is
733 also considered to be `on the boundary'.
735 If the optional argument ONLY-IN-LINE is non-nil and constraining
736 NEW-POS would move it to a different line, NEW-POS is returned
737 unconstrained. This useful for commands that move by line, like
738 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
739 only in the case where they can still move to the right line.
741 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
742 a non-nil property of that name, then any field boundaries are ignored.
744 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
745 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
746 Lisp_Object new_pos
, old_pos
;
747 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
749 /* If non-zero, then the original point, before re-positioning. */
752 Lisp_Object prev_old
, prev_new
;
755 /* Use the current point, and afterwards, set it. */
758 XSETFASTINT (new_pos
, PT
);
761 CHECK_NUMBER_COERCE_MARKER (new_pos
);
762 CHECK_NUMBER_COERCE_MARKER (old_pos
);
764 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
766 prev_old
= make_number (XFASTINT (old_pos
) - 1);
767 prev_new
= make_number (XFASTINT (new_pos
) - 1);
769 if (NILP (Vinhibit_field_text_motion
)
770 && !EQ (new_pos
, old_pos
)
771 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
772 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
773 /* To recognize field boundaries, we must also look at the
774 previous positions; we could use `get_pos_property'
775 instead, but in itself that would fail inside non-sticky
776 fields (like comint prompts). */
777 || (XFASTINT (new_pos
) > BEGV
778 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
779 || (XFASTINT (old_pos
) > BEGV
780 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
781 && (NILP (inhibit_capture_property
)
782 /* Field boundaries are again a problem; but now we must
783 decide the case exactly, so we need to call
784 `get_pos_property' as well. */
785 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
786 && (XFASTINT (old_pos
) <= BEGV
787 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
788 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
789 /* It is possible that NEW_POS is not within the same field as
790 OLD_POS; try to move NEW_POS so that it is. */
793 Lisp_Object field_bound
;
796 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
798 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
800 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
801 other side of NEW_POS, which would mean that NEW_POS is
802 already acceptable, and it's not necessary to constrain it
804 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
805 /* NEW_POS should be constrained, but only if either
806 ONLY_IN_LINE is nil (in which case any constraint is OK),
807 or NEW_POS and FIELD_BOUND are on the same line (in which
808 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
809 && (NILP (only_in_line
)
810 /* This is the ONLY_IN_LINE case, check that NEW_POS and
811 FIELD_BOUND are on the same line by seeing whether
812 there's an intervening newline or not. */
813 || (scan_buffer ('\n',
814 XFASTINT (new_pos
), XFASTINT (field_bound
),
815 fwd
? -1 : 1, &shortage
, 1),
817 /* Constrain NEW_POS to FIELD_BOUND. */
818 new_pos
= field_bound
;
820 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
821 /* The NEW_POS argument was originally nil, so automatically set PT. */
822 SET_PT (XFASTINT (new_pos
));
829 DEFUN ("line-beginning-position",
830 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
831 doc
: /* Return the character position of the first character on the current line.
832 With argument N not nil or 1, move forward N - 1 lines first.
833 If scan reaches end of buffer, return that position.
835 This function constrains the returned position to the current field
836 unless that would be on a different line than the original,
837 unconstrained result. If N is nil or 1, and a front-sticky field
838 starts at point, the scan stops as soon as it starts. To ignore field
839 boundaries bind `inhibit-field-text-motion' to t.
841 This function does not move point. */)
845 int orig
, orig_byte
, end
;
846 int count
= SPECPDL_INDEX ();
847 specbind (Qinhibit_point_motion_hooks
, Qt
);
856 Fforward_line (make_number (XINT (n
) - 1));
859 SET_PT_BOTH (orig
, orig_byte
);
861 unbind_to (count
, Qnil
);
863 /* Return END constrained to the current input field. */
864 return Fconstrain_to_field (make_number (end
), make_number (orig
),
865 XINT (n
) != 1 ? Qt
: Qnil
,
869 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
870 doc
: /* Return the character position of the last character on the current line.
871 With argument N not nil or 1, move forward N - 1 lines first.
872 If scan reaches end of buffer, return that position.
874 This function constrains the returned position to the current field
875 unless that would be on a different line than the original,
876 unconstrained result. If N is nil or 1, and a rear-sticky field ends
877 at point, the scan stops as soon as it starts. To ignore field
878 boundaries bind `inhibit-field-text-motion' to t.
880 This function does not move point. */)
892 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
894 /* Return END_POS constrained to the current input field. */
895 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
901 save_excursion_save ()
903 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
906 return Fcons (Fpoint_marker (),
907 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
908 Fcons (visible
? Qt
: Qnil
,
909 Fcons (current_buffer
->mark_active
,
914 save_excursion_restore (info
)
917 Lisp_Object tem
, tem1
, omark
, nmark
;
918 struct gcpro gcpro1
, gcpro2
, gcpro3
;
921 tem
= Fmarker_buffer (XCAR (info
));
922 /* If buffer being returned to is now deleted, avoid error */
923 /* Otherwise could get error here while unwinding to top level
925 /* In that case, Fmarker_buffer returns nil now. */
929 omark
= nmark
= Qnil
;
930 GCPRO3 (info
, omark
, nmark
);
937 unchain_marker (XMARKER (tem
));
942 omark
= Fmarker_position (current_buffer
->mark
);
943 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
944 nmark
= Fmarker_position (tem
);
945 unchain_marker (XMARKER (tem
));
949 visible_p
= !NILP (XCAR (info
));
951 #if 0 /* We used to make the current buffer visible in the selected window
952 if that was true previously. That avoids some anomalies.
953 But it creates others, and it wasn't documented, and it is simpler
954 and cleaner never to alter the window/buffer connections. */
957 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
958 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
964 tem1
= current_buffer
->mark_active
;
965 current_buffer
->mark_active
= tem
;
967 if (!NILP (Vrun_hooks
))
969 /* If mark is active now, and either was not active
970 or was at a different place, run the activate hook. */
971 if (! NILP (current_buffer
->mark_active
))
973 if (! EQ (omark
, nmark
))
974 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
976 /* If mark has ceased to be active, run deactivate hook. */
977 else if (! NILP (tem1
))
978 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
981 /* If buffer was visible in a window, and a different window was
982 selected, and the old selected window is still showing this
983 buffer, restore point in that window. */
986 && !EQ (tem
, selected_window
)
987 && (tem1
= XWINDOW (tem
)->buffer
,
988 (/* Window is live... */
990 /* ...and it shows the current buffer. */
991 && XBUFFER (tem1
) == current_buffer
)))
992 Fset_window_point (tem
, make_number (PT
));
998 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
999 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
1000 Executes BODY just like `progn'.
1001 The values of point, mark and the current buffer are restored
1002 even in case of abnormal exit (throw or error).
1003 The state of activation of the mark is also restored.
1005 This construct does not save `deactivate-mark', and therefore
1006 functions that change the buffer will still cause deactivation
1007 of the mark at the end of the command. To prevent that, bind
1008 `deactivate-mark' with `let'.
1010 If you only want to save the current buffer but not point nor mark,
1011 then just use `save-current-buffer', or even `with-current-buffer'.
1013 usage: (save-excursion &rest BODY) */)
1017 register Lisp_Object val
;
1018 int count
= SPECPDL_INDEX ();
1020 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1022 val
= Fprogn (args
);
1023 return unbind_to (count
, val
);
1026 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
1027 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
1028 Executes BODY just like `progn'.
1029 usage: (save-current-buffer &rest BODY) */)
1034 int count
= SPECPDL_INDEX ();
1036 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
1038 val
= Fprogn (args
);
1039 return unbind_to (count
, val
);
1042 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1043 doc
: /* Return the number of characters in the current buffer.
1044 If BUFFER, return the number of characters in that buffer instead. */)
1049 return make_number (Z
- BEG
);
1052 CHECK_BUFFER (buffer
);
1053 return make_number (BUF_Z (XBUFFER (buffer
))
1054 - BUF_BEG (XBUFFER (buffer
)));
1058 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1059 doc
: /* Return the minimum permissible value of point in the current buffer.
1060 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1064 XSETFASTINT (temp
, BEGV
);
1068 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1069 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1070 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1073 return buildmark (BEGV
, BEGV_BYTE
);
1076 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1077 doc
: /* Return the maximum permissible value of point in the current buffer.
1078 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1079 is in effect, in which case it is less. */)
1083 XSETFASTINT (temp
, ZV
);
1087 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1088 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1089 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1090 is in effect, in which case it is less. */)
1093 return buildmark (ZV
, ZV_BYTE
);
1096 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1097 doc
: /* Return the position of the gap, in the current buffer.
1098 See also `gap-size'. */)
1102 XSETFASTINT (temp
, GPT
);
1106 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1107 doc
: /* Return the size of the current buffer's gap.
1108 See also `gap-position'. */)
1112 XSETFASTINT (temp
, GAP_SIZE
);
1116 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1117 doc
: /* Return the byte position for character position POSITION.
1118 If POSITION is out of range, the value is nil. */)
1120 Lisp_Object position
;
1122 CHECK_NUMBER_COERCE_MARKER (position
);
1123 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1125 return make_number (CHAR_TO_BYTE (XINT (position
)));
1128 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1129 doc
: /* Return the character position for byte position BYTEPOS.
1130 If BYTEPOS is out of range, the value is nil. */)
1132 Lisp_Object bytepos
;
1134 CHECK_NUMBER (bytepos
);
1135 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1137 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1140 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1141 doc
: /* Return the character following point, as a number.
1142 At the end of the buffer or accessible region, return 0. */)
1147 XSETFASTINT (temp
, 0);
1149 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1153 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1154 doc
: /* Return the character preceding point, as a number.
1155 At the beginning of the buffer or accessible region, return 0. */)
1160 XSETFASTINT (temp
, 0);
1161 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1165 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1168 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1172 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1173 doc
: /* Return t if point is at the beginning of the buffer.
1174 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1182 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1183 doc
: /* Return t if point is at the end of the buffer.
1184 If the buffer is narrowed, this means the end of the narrowed part. */)
1192 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1193 doc
: /* Return t if point is at the beginning of a line. */)
1196 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1201 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1202 doc
: /* Return t if point is at the end of a line.
1203 `End of a line' includes point being at the end of the buffer. */)
1206 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1211 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1212 doc
: /* Return character in current buffer at position POS.
1213 POS is an integer or a marker and defaults to point.
1214 If POS is out of range, the value is nil. */)
1218 register int pos_byte
;
1223 XSETFASTINT (pos
, PT
);
1228 pos_byte
= marker_byte_position (pos
);
1229 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1234 CHECK_NUMBER_COERCE_MARKER (pos
);
1235 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1238 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1241 return make_number (FETCH_CHAR (pos_byte
));
1244 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1245 doc
: /* Return character in current buffer preceding position POS.
1246 POS is an integer or a marker and defaults to point.
1247 If POS is out of range, the value is nil. */)
1251 register Lisp_Object val
;
1252 register int pos_byte
;
1257 XSETFASTINT (pos
, PT
);
1262 pos_byte
= marker_byte_position (pos
);
1264 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1269 CHECK_NUMBER_COERCE_MARKER (pos
);
1271 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1274 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1277 if (!NILP (current_buffer
->enable_multibyte_characters
))
1280 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1285 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1290 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1291 doc
: /* Return the name under which the user logged in, as a string.
1292 This is based on the effective uid, not the real uid.
1293 Also, if the environment variables LOGNAME or USER are set,
1294 that determines the value of this function.
1296 If optional argument UID is an integer or a float, return the login name
1297 of the user with that uid, or nil if there is no such user. */)
1304 /* Set up the user name info if we didn't do it before.
1305 (That can happen if Emacs is dumpable
1306 but you decide to run `temacs -l loadup' and not dump. */
1307 if (INTEGERP (Vuser_login_name
))
1311 return Vuser_login_name
;
1313 id
= (uid_t
)XFLOATINT (uid
);
1315 pw
= (struct passwd
*) getpwuid (id
);
1317 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1320 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1322 doc
: /* Return the name of the user's real uid, as a string.
1323 This ignores the environment variables LOGNAME and USER, so it differs from
1324 `user-login-name' when running under `su'. */)
1327 /* Set up the user name info if we didn't do it before.
1328 (That can happen if Emacs is dumpable
1329 but you decide to run `temacs -l loadup' and not dump. */
1330 if (INTEGERP (Vuser_login_name
))
1332 return Vuser_real_login_name
;
1335 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1336 doc
: /* Return the effective uid of Emacs.
1337 Value is an integer or a float, depending on the value. */)
1340 /* Assignment to EMACS_INT stops GCC whining about limited range of
1342 EMACS_INT euid
= geteuid ();
1344 /* Make sure we don't produce a negative UID due to signed integer
1347 return make_float ((double)geteuid ());
1348 return make_fixnum_or_float (euid
);
1351 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1352 doc
: /* Return the real uid of Emacs.
1353 Value is an integer or a float, depending on the value. */)
1356 /* Assignment to EMACS_INT stops GCC whining about limited range of
1358 EMACS_INT uid
= getuid ();
1360 /* Make sure we don't produce a negative UID due to signed integer
1363 return make_float ((double)getuid ());
1364 return make_fixnum_or_float (uid
);
1367 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1368 doc
: /* Return the full name of the user logged in, as a string.
1369 If the full name corresponding to Emacs's userid is not known,
1372 If optional argument UID is an integer or float, return the full name
1373 of the user with that uid, or nil if there is no such user.
1374 If UID is a string, return the full name of the user with that login
1375 name, or nil if there is no such user. */)
1380 register unsigned char *p
, *q
;
1384 return Vuser_full_name
;
1385 else if (NUMBERP (uid
))
1388 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1391 else if (STRINGP (uid
))
1394 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1398 error ("Invalid UID specification");
1403 p
= (unsigned char *) USER_FULL_NAME
;
1404 /* Chop off everything after the first comma. */
1405 q
= (unsigned char *) index (p
, ',');
1406 full
= make_string (p
, q
? q
- p
: strlen (p
));
1408 #ifdef AMPERSAND_FULL_NAME
1410 q
= (unsigned char *) index (p
, '&');
1411 /* Substitute the login name for the &, upcasing the first character. */
1414 register unsigned char *r
;
1417 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1418 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1419 bcopy (p
, r
, q
- p
);
1421 strcat (r
, SDATA (login
));
1422 r
[q
- p
] = UPCASE (r
[q
- p
]);
1424 full
= build_string (r
);
1426 #endif /* AMPERSAND_FULL_NAME */
1431 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1432 doc
: /* Return the host name of the machine you are running on, as a string. */)
1435 return Vsystem_name
;
1438 /* For the benefit of callers who don't want to include lisp.h */
1443 if (STRINGP (Vsystem_name
))
1444 return (char *) SDATA (Vsystem_name
);
1450 get_operating_system_release()
1452 if (STRINGP (Voperating_system_release
))
1453 return (char *) SDATA (Voperating_system_release
);
1458 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1459 doc
: /* Return the process ID of Emacs, as an integer. */)
1462 return make_number (getpid ());
1465 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1466 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1467 The time is returned as a list of three integers. The first has the
1468 most significant 16 bits of the seconds, while the second has the
1469 least significant 16 bits. The third integer gives the microsecond
1472 The microsecond count is zero on systems that do not provide
1473 resolution finer than a second. */)
1479 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1480 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1481 make_number (EMACS_USECS (t
)));
1484 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1486 doc
: /* Return the current run time used by Emacs.
1487 The time is returned as a list of three integers. The first has the
1488 most significant 16 bits of the seconds, while the second has the
1489 least significant 16 bits. The third integer gives the microsecond
1492 On systems that can't determine the run time, `get-internal-run-time'
1493 does the same thing as `current-time'. The microsecond count is zero
1494 on systems that do not provide resolution finer than a second. */)
1497 #ifdef HAVE_GETRUSAGE
1498 struct rusage usage
;
1501 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1502 /* This shouldn't happen. What action is appropriate? */
1505 /* Sum up user time and system time. */
1506 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1507 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1508 if (usecs
>= 1000000)
1514 return list3 (make_number ((secs
>> 16) & 0xffff),
1515 make_number ((secs
>> 0) & 0xffff),
1516 make_number (usecs
));
1517 #else /* ! HAVE_GETRUSAGE */
1519 return w32_get_internal_run_time ();
1520 #else /* ! WINDOWSNT */
1521 return Fcurrent_time ();
1522 #endif /* WINDOWSNT */
1523 #endif /* HAVE_GETRUSAGE */
1528 lisp_time_argument (specified_time
, result
, usec
)
1529 Lisp_Object specified_time
;
1533 if (NILP (specified_time
))
1540 *usec
= EMACS_USECS (t
);
1541 *result
= EMACS_SECS (t
);
1545 return time (result
) != -1;
1549 Lisp_Object high
, low
;
1550 high
= Fcar (specified_time
);
1551 CHECK_NUMBER (high
);
1552 low
= Fcdr (specified_time
);
1557 Lisp_Object usec_l
= Fcdr (low
);
1559 usec_l
= Fcar (usec_l
);
1564 CHECK_NUMBER (usec_l
);
1565 *usec
= XINT (usec_l
);
1573 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1574 return *result
>> 16 == XINT (high
);
1578 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1579 doc
: /* Return the current time, as a float number of seconds since the epoch.
1580 If SPECIFIED-TIME is given, it is the time to convert to float
1581 instead of the current time. The argument should have the form
1582 (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
1583 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1584 have the form (HIGH . LOW), but this is considered obsolete.
1586 WARNING: Since the result is floating point, it may not be exact.
1587 If precise time stamps are required, use either `current-time',
1588 or (if you need time as a string) `format-time-string'. */)
1590 Lisp_Object specified_time
;
1595 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1596 error ("Invalid time specification");
1598 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1601 /* Write information into buffer S of size MAXSIZE, according to the
1602 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1603 Default to Universal Time if UT is nonzero, local time otherwise.
1604 Return the number of bytes written, not including the terminating
1605 '\0'. If S is NULL, nothing will be written anywhere; so to
1606 determine how many bytes would be written, use NULL for S and
1607 ((size_t) -1) for MAXSIZE.
1609 This function behaves like emacs_strftimeu, except it allows null
1612 emacs_memftimeu (s
, maxsize
, format
, format_len
, tp
, ut
)
1617 const struct tm
*tp
;
1622 /* Loop through all the null-terminated strings in the format
1623 argument. Normally there's just one null-terminated string, but
1624 there can be arbitrarily many, concatenated together, if the
1625 format contains '\0' bytes. emacs_strftimeu stops at the first
1626 '\0' byte so we must invoke it separately for each such string. */
1635 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1639 if (result
== 0 && s
[0] != '\0')
1644 maxsize
-= result
+ 1;
1646 len
= strlen (format
);
1647 if (len
== format_len
)
1651 format_len
-= len
+ 1;
1655 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1656 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1657 TIME is specified as (HIGH LOW . IGNORED), as returned by
1658 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1659 is also still accepted.
1660 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1661 as Universal Time; nil means describe TIME in the local time zone.
1662 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1663 by text that describes the specified date and time in TIME:
1665 %Y is the year, %y within the century, %C the century.
1666 %G is the year corresponding to the ISO week, %g within the century.
1667 %m is the numeric month.
1668 %b and %h are the locale's abbreviated month name, %B the full name.
1669 %d is the day of the month, zero-padded, %e is blank-padded.
1670 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1671 %a is the locale's abbreviated name of the day of week, %A the full name.
1672 %U is the week number starting on Sunday, %W starting on Monday,
1673 %V according to ISO 8601.
1674 %j is the day of the year.
1676 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1677 only blank-padded, %l is like %I blank-padded.
1678 %p is the locale's equivalent of either AM or PM.
1681 %Z is the time zone name, %z is the numeric form.
1682 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1684 %c is the locale's date and time format.
1685 %x is the locale's "preferred" date format.
1686 %D is like "%m/%d/%y".
1688 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1689 %X is the locale's "preferred" time format.
1691 Finally, %n is a newline, %t is a tab, %% is a literal %.
1693 Certain flags and modifiers are available with some format controls.
1694 The flags are `_', `-', `^' and `#'. For certain characters X,
1695 %_X is like %X, but padded with blanks; %-X is like %X,
1696 but without padding. %^X is like %X, but with all textual
1697 characters up-cased; %#X is like %X, but with letter-case of
1698 all textual characters reversed.
1699 %NX (where N stands for an integer) is like %X,
1700 but takes up at least N (a number) positions.
1701 The modifiers are `E' and `O'. For certain characters X,
1702 %EX is a locale's alternative version of %X;
1703 %OX is like %X, but uses the locale's number symbols.
1705 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1706 (format_string
, time
, universal
)
1707 Lisp_Object format_string
, time
, universal
;
1712 int ut
= ! NILP (universal
);
1714 CHECK_STRING (format_string
);
1716 if (! lisp_time_argument (time
, &value
, NULL
))
1717 error ("Invalid time specification");
1719 format_string
= code_convert_string_norecord (format_string
,
1720 Vlocale_coding_system
, 1);
1722 /* This is probably enough. */
1723 size
= SBYTES (format_string
) * 6 + 50;
1726 tm
= ut
? gmtime (&value
) : localtime (&value
);
1729 error ("Specified time is not representable");
1731 synchronize_system_time_locale ();
1735 char *buf
= (char *) alloca (size
+ 1);
1740 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1741 SBYTES (format_string
),
1744 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1745 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1746 Vlocale_coding_system
, 0);
1748 /* If buffer was too small, make it bigger and try again. */
1750 result
= emacs_memftimeu (NULL
, (size_t) -1,
1751 SDATA (format_string
),
1752 SBYTES (format_string
),
1759 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1760 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1761 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1762 as from `current-time' and `file-attributes', or nil to use the
1763 current time. The obsolete form (HIGH . LOW) is also still accepted.
1764 The list has the following nine members: SEC is an integer between 0
1765 and 60; SEC is 60 for a leap second, which only some operating systems
1766 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1767 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1768 integer between 1 and 12. YEAR is an integer indicating the
1769 four-digit year. DOW is the day of week, an integer between 0 and 6,
1770 where 0 is Sunday. DST is t if daylight saving time is in effect,
1771 otherwise nil. ZONE is an integer indicating the number of seconds
1772 east of Greenwich. (Note that Common Lisp has different meanings for
1775 Lisp_Object specified_time
;
1779 struct tm
*decoded_time
;
1780 Lisp_Object list_args
[9];
1782 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1783 error ("Invalid time specification");
1786 decoded_time
= localtime (&time_spec
);
1789 error ("Specified time is not representable");
1790 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1791 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1792 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1793 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1794 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1795 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1796 cast below avoids overflow in int arithmetics. */
1797 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1798 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1799 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1801 /* Make a copy, in case gmtime modifies the struct. */
1802 save_tm
= *decoded_time
;
1804 decoded_time
= gmtime (&time_spec
);
1806 if (decoded_time
== 0)
1807 list_args
[8] = Qnil
;
1809 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1810 return Flist (9, list_args
);
1813 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1814 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1815 This is the reverse operation of `decode-time', which see.
1816 ZONE defaults to the current time zone rule. This can
1817 be a string or t (as from `set-time-zone-rule'), or it can be a list
1818 \(as from `current-time-zone') or an integer (as from `decode-time')
1819 applied without consideration for daylight saving time.
1821 You can pass more than 7 arguments; then the first six arguments
1822 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1823 The intervening arguments are ignored.
1824 This feature lets (apply 'encode-time (decode-time ...)) work.
1826 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1827 for example, a DAY of 0 means the day preceding the given month.
1828 Year numbers less than 100 are treated just like other year numbers.
1829 If you want them to stand for years in this century, you must do that yourself.
1831 Years before 1970 are not guaranteed to work. On some systems,
1832 year values as low as 1901 do work.
1834 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1837 register Lisp_Object
*args
;
1841 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1843 CHECK_NUMBER (args
[0]); /* second */
1844 CHECK_NUMBER (args
[1]); /* minute */
1845 CHECK_NUMBER (args
[2]); /* hour */
1846 CHECK_NUMBER (args
[3]); /* day */
1847 CHECK_NUMBER (args
[4]); /* month */
1848 CHECK_NUMBER (args
[5]); /* year */
1850 tm
.tm_sec
= XINT (args
[0]);
1851 tm
.tm_min
= XINT (args
[1]);
1852 tm
.tm_hour
= XINT (args
[2]);
1853 tm
.tm_mday
= XINT (args
[3]);
1854 tm
.tm_mon
= XINT (args
[4]) - 1;
1855 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1863 time
= mktime (&tm
);
1870 char **oldenv
= environ
, **newenv
;
1874 else if (STRINGP (zone
))
1875 tzstring
= (char *) SDATA (zone
);
1876 else if (INTEGERP (zone
))
1878 int abszone
= eabs (XINT (zone
));
1879 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1880 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1884 error ("Invalid time zone specification");
1886 /* Set TZ before calling mktime; merely adjusting mktime's returned
1887 value doesn't suffice, since that would mishandle leap seconds. */
1888 set_time_zone_rule (tzstring
);
1891 time
= mktime (&tm
);
1894 /* Restore TZ to previous value. */
1898 #ifdef LOCALTIME_CACHE
1903 if (time
== (time_t) -1)
1904 error ("Specified time is not representable");
1906 return make_time (time
);
1909 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1910 doc
: /* Return the current local time, as a human-readable string.
1911 Programs can use this function to decode a time,
1912 since the number of columns in each field is fixed
1913 if the year is in the range 1000-9999.
1914 The format is `Sun Sep 16 01:03:52 1973'.
1915 However, see also the functions `decode-time' and `format-time-string'
1916 which provide a much more powerful and general facility.
1918 If SPECIFIED-TIME is given, it is a time to format instead of the
1919 current time. The argument should have the form (HIGH LOW . IGNORED).
1920 Thus, you can use times obtained from `current-time' and from
1921 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1922 but this is considered obsolete. */)
1924 Lisp_Object specified_time
;
1930 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1931 error ("Invalid time specification");
1933 /* Convert to a string, checking for out-of-range time stamps.
1934 Don't use 'ctime', as that might dump core if VALUE is out of
1937 tm
= localtime (&value
);
1939 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1940 error ("Specified time is not representable");
1942 /* Remove the trailing newline. */
1943 tem
[strlen (tem
) - 1] = '\0';
1945 return build_string (tem
);
1948 /* Yield A - B, measured in seconds.
1949 This function is copied from the GNU C Library. */
1954 /* Compute intervening leap days correctly even if year is negative.
1955 Take care to avoid int overflow in leap day calculations,
1956 but it's OK to assume that A and B are close to each other. */
1957 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1958 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1959 int a100
= a4
/ 25 - (a4
% 25 < 0);
1960 int b100
= b4
/ 25 - (b4
% 25 < 0);
1961 int a400
= a100
>> 2;
1962 int b400
= b100
>> 2;
1963 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1964 int years
= a
->tm_year
- b
->tm_year
;
1965 int days
= (365 * years
+ intervening_leap_days
1966 + (a
->tm_yday
- b
->tm_yday
));
1967 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1968 + (a
->tm_min
- b
->tm_min
))
1969 + (a
->tm_sec
- b
->tm_sec
));
1972 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1973 doc
: /* Return the offset and name for the local time zone.
1974 This returns a list of the form (OFFSET NAME).
1975 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1976 A negative value means west of Greenwich.
1977 NAME is a string giving the name of the time zone.
1978 If SPECIFIED-TIME is given, the time zone offset is determined from it
1979 instead of using the current time. The argument should have the form
1980 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1981 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1982 have the form (HIGH . LOW), but this is considered obsolete.
1984 Some operating systems cannot provide all this information to Emacs;
1985 in this case, `current-time-zone' returns a list containing nil for
1986 the data it can't find. */)
1988 Lisp_Object specified_time
;
1994 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1999 t
= gmtime (&value
);
2003 t
= localtime (&value
);
2010 int offset
= tm_diff (t
, &gmt
);
2016 s
= (char *)t
->tm_zone
;
2017 #else /* not HAVE_TM_ZONE */
2019 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
2020 s
= tzname
[t
->tm_isdst
];
2022 #endif /* not HAVE_TM_ZONE */
2026 /* No local time zone name is available; use "+-NNNN" instead. */
2027 int am
= (offset
< 0 ? -offset
: offset
) / 60;
2028 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
2032 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
2035 return Fmake_list (make_number (2), Qnil
);
2038 /* This holds the value of `environ' produced by the previous
2039 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
2040 has never been called. */
2041 static char **environbuf
;
2043 /* This holds the startup value of the TZ environment variable so it
2044 can be restored if the user calls set-time-zone-rule with a nil
2046 static char *initial_tz
;
2048 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
2049 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
2050 If TZ is nil, use implementation-defined default time zone information.
2051 If TZ is t, use Universal Time. */)
2057 /* When called for the first time, save the original TZ. */
2059 initial_tz
= (char *) getenv ("TZ");
2062 tzstring
= initial_tz
;
2063 else if (EQ (tz
, Qt
))
2068 tzstring
= (char *) SDATA (tz
);
2071 set_time_zone_rule (tzstring
);
2073 environbuf
= environ
;
2078 #ifdef LOCALTIME_CACHE
2080 /* These two values are known to load tz files in buggy implementations,
2081 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2082 Their values shouldn't matter in non-buggy implementations.
2083 We don't use string literals for these strings,
2084 since if a string in the environment is in readonly
2085 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2086 See Sun bugs 1113095 and 1114114, ``Timezone routines
2087 improperly modify environment''. */
2089 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2090 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2094 /* Set the local time zone rule to TZSTRING.
2095 This allocates memory into `environ', which it is the caller's
2096 responsibility to free. */
2099 set_time_zone_rule (tzstring
)
2103 char **from
, **to
, **newenv
;
2105 /* Make the ENVIRON vector longer with room for TZSTRING. */
2106 for (from
= environ
; *from
; from
++)
2108 envptrs
= from
- environ
+ 2;
2109 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2110 + (tzstring
? strlen (tzstring
) + 4 : 0));
2112 /* Add TZSTRING to the end of environ, as a value for TZ. */
2115 char *t
= (char *) (to
+ envptrs
);
2117 strcat (t
, tzstring
);
2121 /* Copy the old environ vector elements into NEWENV,
2122 but don't copy the TZ variable.
2123 So we have only one definition of TZ, which came from TZSTRING. */
2124 for (from
= environ
; *from
; from
++)
2125 if (strncmp (*from
, "TZ=", 3) != 0)
2131 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2132 the TZ variable is stored. If we do not have a TZSTRING,
2133 TO points to the vector slot which has the terminating null. */
2135 #ifdef LOCALTIME_CACHE
2137 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2138 "US/Pacific" that loads a tz file, then changes to a value like
2139 "XXX0" that does not load a tz file, and then changes back to
2140 its original value, the last change is (incorrectly) ignored.
2141 Also, if TZ changes twice in succession to values that do
2142 not load a tz file, tzset can dump core (see Sun bug#1225179).
2143 The following code works around these bugs. */
2147 /* Temporarily set TZ to a value that loads a tz file
2148 and that differs from tzstring. */
2150 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2151 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2157 /* The implied tzstring is unknown, so temporarily set TZ to
2158 two different values that each load a tz file. */
2159 *to
= set_time_zone_rule_tz1
;
2162 *to
= set_time_zone_rule_tz2
;
2167 /* Now TZ has the desired value, and tzset can be invoked safely. */
2174 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2175 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2176 type of object is Lisp_String). INHERIT is passed to
2177 INSERT_FROM_STRING_FUNC as the last argument. */
2180 general_insert_function (void (*insert_func
)
2181 (const unsigned char *, EMACS_INT
),
2182 void (*insert_from_string_func
)
2183 (Lisp_Object
, EMACS_INT
, EMACS_INT
,
2184 EMACS_INT
, EMACS_INT
, int),
2185 int inherit
, int nargs
, Lisp_Object
*args
)
2187 register int argnum
;
2188 register Lisp_Object val
;
2190 for (argnum
= 0; argnum
< nargs
; argnum
++)
2193 if (CHARACTERP (val
))
2195 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2198 if (!NILP (current_buffer
->enable_multibyte_characters
))
2199 len
= CHAR_STRING (XFASTINT (val
), str
);
2202 str
[0] = (ASCII_CHAR_P (XINT (val
))
2204 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2207 (*insert_func
) (str
, len
);
2209 else if (STRINGP (val
))
2211 (*insert_from_string_func
) (val
, 0, 0,
2217 wrong_type_argument (Qchar_or_string_p
, val
);
2229 /* Callers passing one argument to Finsert need not gcpro the
2230 argument "array", since the only element of the array will
2231 not be used after calling insert or insert_from_string, so
2232 we don't care if it gets trashed. */
2234 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2235 doc
: /* Insert the arguments, either strings or characters, at point.
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 `string-make-multibyte').
2242 If the current buffer is unibyte, multibyte strings are converted
2243 to unibyte for insertion (see `string-make-unibyte').
2245 When operating on binary data, it may be necessary to preserve the
2246 original bytes of a unibyte string when inserting it into a multibyte
2247 buffer; to accomplish this, apply `string-as-multibyte' to the string
2248 and insert the result.
2250 usage: (insert &rest ARGS) */)
2253 register Lisp_Object
*args
;
2255 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2259 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2261 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2262 Point and before-insertion markers move forward to end up
2263 after the inserted text.
2264 Any other markers at the point of insertion remain before the text.
2266 If the current buffer is multibyte, unibyte strings are converted
2267 to multibyte for insertion (see `unibyte-char-to-multibyte').
2268 If the current buffer is unibyte, multibyte strings are converted
2269 to unibyte for insertion.
2271 usage: (insert-and-inherit &rest ARGS) */)
2274 register Lisp_Object
*args
;
2276 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2281 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2282 doc
: /* Insert strings or characters at point, relocating markers after the text.
2283 Point and markers move forward to end up after the inserted text.
2285 If the current buffer is multibyte, unibyte strings are converted
2286 to multibyte for insertion (see `unibyte-char-to-multibyte').
2287 If the current buffer is unibyte, multibyte strings are converted
2288 to unibyte for insertion.
2290 usage: (insert-before-markers &rest ARGS) */)
2293 register Lisp_Object
*args
;
2295 general_insert_function (insert_before_markers
,
2296 insert_from_string_before_markers
, 0,
2301 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2302 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2303 doc
: /* Insert text at point, relocating markers and inheriting properties.
2304 Point and markers move forward to end up after the inserted text.
2306 If the current buffer is multibyte, unibyte strings are converted
2307 to multibyte for insertion (see `unibyte-char-to-multibyte').
2308 If the current buffer is unibyte, multibyte strings are converted
2309 to unibyte for insertion.
2311 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2314 register Lisp_Object
*args
;
2316 general_insert_function (insert_before_markers_and_inherit
,
2317 insert_from_string_before_markers
, 1,
2322 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2323 doc
: /* Insert COUNT copies of CHARACTER.
2324 Point, and before-insertion markers, are relocated as in the function `insert'.
2325 The optional third arg INHERIT, if non-nil, says to inherit text properties
2326 from adjoining text, if those properties are sticky. */)
2327 (character
, count
, inherit
)
2328 Lisp_Object character
, count
, inherit
;
2330 register unsigned char *string
;
2331 register int strlen
;
2334 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2336 CHECK_NUMBER (character
);
2337 CHECK_NUMBER (count
);
2339 if (!NILP (current_buffer
->enable_multibyte_characters
))
2340 len
= CHAR_STRING (XFASTINT (character
), str
);
2342 str
[0] = XFASTINT (character
), len
= 1;
2343 n
= XINT (count
) * len
;
2346 strlen
= min (n
, 256 * len
);
2347 string
= (unsigned char *) alloca (strlen
);
2348 for (i
= 0; i
< strlen
; i
++)
2349 string
[i
] = str
[i
% len
];
2353 if (!NILP (inherit
))
2354 insert_and_inherit (string
, strlen
);
2356 insert (string
, strlen
);
2361 if (!NILP (inherit
))
2362 insert_and_inherit (string
, n
);
2369 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2370 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2371 Both arguments are required.
2372 BYTE is a number of the range 0..255.
2374 If BYTE is 128..255 and the current buffer is multibyte, the
2375 corresponding eight-bit character is inserted.
2377 Point, and before-insertion markers, are relocated as in the function `insert'.
2378 The optional third arg INHERIT, if non-nil, says to inherit text properties
2379 from adjoining text, if those properties are sticky. */)
2380 (byte
, count
, inherit
)
2381 Lisp_Object byte
, count
, inherit
;
2383 CHECK_NUMBER (byte
);
2384 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2385 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2386 if (XINT (byte
) >= 128
2387 && ! NILP (current_buffer
->enable_multibyte_characters
))
2388 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2389 return Finsert_char (byte
, count
, inherit
);
2393 /* Making strings from buffer contents. */
2395 /* Return a Lisp_String containing the text of the current buffer from
2396 START to END. 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 (start
, end
, props
)
2413 int start_byte
= CHAR_TO_BYTE (start
);
2414 int end_byte
= CHAR_TO_BYTE (end
);
2416 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2419 /* Return a Lisp_String containing the text of the current buffer from
2420 START / START_BYTE to END / END_BYTE.
2422 If text properties are in use and the current buffer
2423 has properties in the range specified, the resulting string will also
2424 have them, if PROPS is nonzero.
2426 We don't want to use plain old make_string here, because it calls
2427 make_uninit_string, which can cause the buffer arena to be
2428 compacted. make_string has no way of knowing that the data has
2429 been moved, and thus copies the wrong data into the string. This
2430 doesn't effect most of the other users of make_string, so it should
2431 be left as is. But we should use this function when conjuring
2432 buffer substrings. */
2435 make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
)
2436 int start
, start_byte
, end
, end_byte
;
2439 Lisp_Object result
, tem
, tem1
;
2441 if (start
< GPT
&& GPT
< end
)
2444 if (! NILP (current_buffer
->enable_multibyte_characters
))
2445 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2447 result
= make_uninit_string (end
- start
);
2448 bcopy (BYTE_POS_ADDR (start_byte
), SDATA (result
),
2449 end_byte
- start_byte
);
2451 /* If desired, update and copy the text properties. */
2454 update_buffer_properties (start
, end
);
2456 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2457 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2459 if (XINT (tem
) != end
|| !NILP (tem1
))
2460 copy_intervals_to_string (result
, current_buffer
, start
,
2467 /* Call Vbuffer_access_fontify_functions for the range START ... END
2468 in the current buffer, if necessary. */
2471 update_buffer_properties (start
, end
)
2474 /* If this buffer has some access functions,
2475 call them, specifying the range of the buffer being accessed. */
2476 if (!NILP (Vbuffer_access_fontify_functions
))
2478 Lisp_Object args
[3];
2481 args
[0] = Qbuffer_access_fontify_functions
;
2482 XSETINT (args
[1], start
);
2483 XSETINT (args
[2], end
);
2485 /* But don't call them if we can tell that the work
2486 has already been done. */
2487 if (!NILP (Vbuffer_access_fontified_property
))
2489 tem
= Ftext_property_any (args
[1], args
[2],
2490 Vbuffer_access_fontified_property
,
2493 Frun_hook_with_args (3, args
);
2496 Frun_hook_with_args (3, args
);
2500 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2501 doc
: /* Return the contents of part of the current buffer as a string.
2502 The two arguments START and END are character positions;
2503 they can be in either order.
2504 The string returned is multibyte if the buffer is multibyte.
2506 This function copies the text properties of that part of the buffer
2507 into the result string; if you don't want the text properties,
2508 use `buffer-substring-no-properties' instead. */)
2510 Lisp_Object start
, end
;
2514 validate_region (&start
, &end
);
2518 return make_buffer_string (b
, e
, 1);
2521 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2522 Sbuffer_substring_no_properties
, 2, 2, 0,
2523 doc
: /* Return the characters of part of the buffer, without the text properties.
2524 The two arguments START and END are character positions;
2525 they can be in either order. */)
2527 Lisp_Object start
, end
;
2531 validate_region (&start
, &end
);
2535 return make_buffer_string (b
, e
, 0);
2538 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2539 doc
: /* Return the contents of the current buffer as a string.
2540 If narrowing is in effect, this function returns only the visible part
2544 return make_buffer_string (BEGV
, ZV
, 1);
2547 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2549 doc
: /* Insert before point a substring of the contents of BUFFER.
2550 BUFFER may be a buffer or a buffer name.
2551 Arguments START and END are character positions specifying the substring.
2552 They default to the values of (point-min) and (point-max) in BUFFER. */)
2553 (buffer
, start
, end
)
2554 Lisp_Object buffer
, start
, end
;
2556 register int b
, e
, temp
;
2557 register struct buffer
*bp
, *obuf
;
2560 buf
= Fget_buffer (buffer
);
2564 if (NILP (bp
->name
))
2565 error ("Selecting deleted buffer");
2571 CHECK_NUMBER_COERCE_MARKER (start
);
2578 CHECK_NUMBER_COERCE_MARKER (end
);
2583 temp
= b
, b
= e
, e
= temp
;
2585 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2586 args_out_of_range (start
, end
);
2588 obuf
= current_buffer
;
2589 set_buffer_internal_1 (bp
);
2590 update_buffer_properties (b
, e
);
2591 set_buffer_internal_1 (obuf
);
2593 insert_from_buffer (bp
, b
, e
- b
, 0);
2597 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2599 doc
: /* Compare two substrings of two buffers; return result as number.
2600 the value is -N if first string is less after N-1 chars,
2601 +N if first string is greater after N-1 chars, or 0 if strings match.
2602 Each substring is represented as three arguments: BUFFER, START and END.
2603 That makes six args in all, three for each substring.
2605 The value of `case-fold-search' in the current buffer
2606 determines whether case is significant or ignored. */)
2607 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2608 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2610 register int begp1
, endp1
, begp2
, endp2
, temp
;
2611 register struct buffer
*bp1
, *bp2
;
2612 register Lisp_Object trt
2613 = (!NILP (current_buffer
->case_fold_search
)
2614 ? current_buffer
->case_canon_table
: Qnil
);
2616 int i1
, i2
, i1_byte
, i2_byte
;
2618 /* Find the first buffer and its substring. */
2621 bp1
= current_buffer
;
2625 buf1
= Fget_buffer (buffer1
);
2628 bp1
= XBUFFER (buf1
);
2629 if (NILP (bp1
->name
))
2630 error ("Selecting deleted buffer");
2634 begp1
= BUF_BEGV (bp1
);
2637 CHECK_NUMBER_COERCE_MARKER (start1
);
2638 begp1
= XINT (start1
);
2641 endp1
= BUF_ZV (bp1
);
2644 CHECK_NUMBER_COERCE_MARKER (end1
);
2645 endp1
= XINT (end1
);
2649 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2651 if (!(BUF_BEGV (bp1
) <= begp1
2653 && endp1
<= BUF_ZV (bp1
)))
2654 args_out_of_range (start1
, end1
);
2656 /* Likewise for second substring. */
2659 bp2
= current_buffer
;
2663 buf2
= Fget_buffer (buffer2
);
2666 bp2
= XBUFFER (buf2
);
2667 if (NILP (bp2
->name
))
2668 error ("Selecting deleted buffer");
2672 begp2
= BUF_BEGV (bp2
);
2675 CHECK_NUMBER_COERCE_MARKER (start2
);
2676 begp2
= XINT (start2
);
2679 endp2
= BUF_ZV (bp2
);
2682 CHECK_NUMBER_COERCE_MARKER (end2
);
2683 endp2
= XINT (end2
);
2687 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2689 if (!(BUF_BEGV (bp2
) <= begp2
2691 && endp2
<= BUF_ZV (bp2
)))
2692 args_out_of_range (start2
, end2
);
2696 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2697 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2699 while (i1
< endp1
&& i2
< endp2
)
2701 /* When we find a mismatch, we must compare the
2702 characters, not just the bytes. */
2707 if (! NILP (bp1
->enable_multibyte_characters
))
2709 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2710 BUF_INC_POS (bp1
, i1_byte
);
2715 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2716 MAKE_CHAR_MULTIBYTE (c1
);
2720 if (! NILP (bp2
->enable_multibyte_characters
))
2722 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2723 BUF_INC_POS (bp2
, i2_byte
);
2728 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2729 MAKE_CHAR_MULTIBYTE (c2
);
2735 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2736 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2739 return make_number (- 1 - chars
);
2741 return make_number (chars
+ 1);
2746 /* The strings match as far as they go.
2747 If one is shorter, that one is less. */
2748 if (chars
< endp1
- begp1
)
2749 return make_number (chars
+ 1);
2750 else if (chars
< endp2
- begp2
)
2751 return make_number (- chars
- 1);
2753 /* Same length too => they are equal. */
2754 return make_number (0);
2758 subst_char_in_region_unwind (arg
)
2761 return current_buffer
->undo_list
= arg
;
2765 subst_char_in_region_unwind_1 (arg
)
2768 return current_buffer
->filename
= arg
;
2771 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2772 Ssubst_char_in_region
, 4, 5, 0,
2773 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2774 If optional arg NOUNDO is non-nil, don't record this change for undo
2775 and don't mark the buffer as really changed.
2776 Both characters must have the same length of multi-byte form. */)
2777 (start
, end
, fromchar
, tochar
, noundo
)
2778 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2780 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2781 /* Keep track of the first change in the buffer:
2782 if 0 we haven't found it yet.
2783 if < 0 we've found it and we've run the before-change-function.
2784 if > 0 we've actually performed it and the value is its position. */
2786 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2788 int count
= SPECPDL_INDEX ();
2789 #define COMBINING_NO 0
2790 #define COMBINING_BEFORE 1
2791 #define COMBINING_AFTER 2
2792 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2793 int maybe_byte_combining
= COMBINING_NO
;
2794 int last_changed
= 0;
2795 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2799 validate_region (&start
, &end
);
2800 CHECK_NUMBER (fromchar
);
2801 CHECK_NUMBER (tochar
);
2805 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2806 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2807 error ("Characters in `subst-char-in-region' have different byte-lengths");
2808 if (!ASCII_BYTE_P (*tostr
))
2810 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2811 complete multibyte character, it may be combined with the
2812 after bytes. If it is in the range 0xA0..0xFF, it may be
2813 combined with the before and after bytes. */
2814 if (!CHAR_HEAD_P (*tostr
))
2815 maybe_byte_combining
= COMBINING_BOTH
;
2816 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2817 maybe_byte_combining
= COMBINING_AFTER
;
2823 fromstr
[0] = XFASTINT (fromchar
);
2824 tostr
[0] = XFASTINT (tochar
);
2828 pos_byte
= CHAR_TO_BYTE (pos
);
2829 stop
= CHAR_TO_BYTE (XINT (end
));
2832 /* If we don't want undo, turn off putting stuff on the list.
2833 That's faster than getting rid of things,
2834 and it prevents even the entry for a first change.
2835 Also inhibit locking the file. */
2836 if (!changed
&& !NILP (noundo
))
2838 record_unwind_protect (subst_char_in_region_unwind
,
2839 current_buffer
->undo_list
);
2840 current_buffer
->undo_list
= Qt
;
2841 /* Don't do file-locking. */
2842 record_unwind_protect (subst_char_in_region_unwind_1
,
2843 current_buffer
->filename
);
2844 current_buffer
->filename
= Qnil
;
2847 if (pos_byte
< GPT_BYTE
)
2848 stop
= min (stop
, GPT_BYTE
);
2851 int pos_byte_next
= pos_byte
;
2853 if (pos_byte
>= stop
)
2855 if (pos_byte
>= end_byte
) break;
2858 p
= BYTE_POS_ADDR (pos_byte
);
2860 INC_POS (pos_byte_next
);
2863 if (pos_byte_next
- pos_byte
== len
2864 && p
[0] == fromstr
[0]
2866 || (p
[1] == fromstr
[1]
2867 && (len
== 2 || (p
[2] == fromstr
[2]
2868 && (len
== 3 || p
[3] == fromstr
[3]))))))
2871 /* We've already seen this and run the before-change-function;
2872 this time we only need to record the actual position. */
2877 modify_region (current_buffer
, pos
, XINT (end
), 0);
2879 if (! NILP (noundo
))
2881 if (MODIFF
- 1 == SAVE_MODIFF
)
2883 if (MODIFF
- 1 == BUF_AUTOSAVE_MODIFF (current_buffer
))
2884 BUF_AUTOSAVE_MODIFF (current_buffer
)++;
2887 /* The before-change-function may have moved the gap
2888 or even modified the buffer so we should start over. */
2892 /* Take care of the case where the new character
2893 combines with neighboring bytes. */
2894 if (maybe_byte_combining
2895 && (maybe_byte_combining
== COMBINING_AFTER
2896 ? (pos_byte_next
< Z_BYTE
2897 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2898 : ((pos_byte_next
< Z_BYTE
2899 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2900 || (pos_byte
> BEG_BYTE
2901 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2903 Lisp_Object tem
, string
;
2905 struct gcpro gcpro1
;
2907 tem
= current_buffer
->undo_list
;
2910 /* Make a multibyte string containing this single character. */
2911 string
= make_multibyte_string (tostr
, 1, len
);
2912 /* replace_range is less efficient, because it moves the gap,
2913 but it handles combining correctly. */
2914 replace_range (pos
, pos
+ 1, string
,
2916 pos_byte_next
= CHAR_TO_BYTE (pos
);
2917 if (pos_byte_next
> pos_byte
)
2918 /* Before combining happened. We should not increment
2919 POS. So, to cancel the later increment of POS,
2923 INC_POS (pos_byte_next
);
2925 if (! NILP (noundo
))
2926 current_buffer
->undo_list
= tem
;
2933 record_change (pos
, 1);
2934 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2936 last_changed
= pos
+ 1;
2938 pos_byte
= pos_byte_next
;
2944 signal_after_change (changed
,
2945 last_changed
- changed
, last_changed
- changed
);
2946 update_compositions (changed
, last_changed
, CHECK_ALL
);
2949 unbind_to (count
, Qnil
);
2954 static Lisp_Object check_translation
P_ ((int, int, int, Lisp_Object
));
2956 /* Helper function for Ftranslate_region_internal.
2958 Check if a character sequence at POS (POS_BYTE) matches an element
2959 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2960 element is found, return it. Otherwise return Qnil. */
2963 check_translation (pos
, pos_byte
, end
, val
)
2964 int pos
, pos_byte
, end
;
2967 int buf_size
= 16, buf_used
= 0;
2968 int *buf
= alloca (sizeof (int) * buf_size
);
2970 for (; CONSP (val
); val
= XCDR (val
))
2979 if (! VECTORP (elt
))
2982 if (len
<= end
- pos
)
2984 for (i
= 0; i
< len
; i
++)
2988 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2991 if (buf_used
== buf_size
)
2996 newbuf
= alloca (sizeof (int) * buf_size
);
2997 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
3000 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, len
);
3003 if (XINT (AREF (elt
, i
)) != buf
[i
])
3014 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
3015 Stranslate_region_internal
, 3, 3, 0,
3016 doc
: /* Internal use only.
3017 From START to END, translate characters according to TABLE.
3018 TABLE is a string or a char-table; the Nth character in it is the
3019 mapping for the character with code N.
3020 It returns the number of characters changed. */)
3024 register Lisp_Object table
;
3026 register unsigned char *tt
; /* Trans table. */
3027 register int nc
; /* New character. */
3028 int cnt
; /* Number of changes made. */
3029 int size
; /* Size of translate table. */
3030 int pos
, pos_byte
, end_pos
;
3031 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
3032 int string_multibyte
;
3035 validate_region (&start
, &end
);
3036 if (CHAR_TABLE_P (table
))
3038 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
3039 error ("Not a translation table");
3045 CHECK_STRING (table
);
3047 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
3048 table
= string_make_unibyte (table
);
3049 string_multibyte
= SCHARS (table
) < SBYTES (table
);
3050 size
= SBYTES (table
);
3055 pos_byte
= CHAR_TO_BYTE (pos
);
3056 end_pos
= XINT (end
);
3057 modify_region (current_buffer
, pos
, end_pos
, 0);
3060 for (; pos
< end_pos
; )
3062 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
3063 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
3069 oc
= STRING_CHAR_AND_LENGTH (p
, len
);
3076 /* Reload as signal_after_change in last iteration may GC. */
3078 if (string_multibyte
)
3080 str
= tt
+ string_char_to_byte (table
, oc
);
3081 nc
= STRING_CHAR_AND_LENGTH (str
, str_len
);
3086 if (! ASCII_BYTE_P (nc
) && multibyte
)
3088 str_len
= BYTE8_STRING (nc
, buf
);
3103 val
= CHAR_TABLE_REF (table
, oc
);
3104 if (CHARACTERP (val
)
3105 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3108 str_len
= CHAR_STRING (nc
, buf
);
3111 else if (VECTORP (val
) || (CONSP (val
)))
3113 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3114 where TO is TO-CHAR or [TO-CHAR ...]. */
3119 if (nc
!= oc
&& nc
>= 0)
3121 /* Simple one char to one char translation. */
3126 /* This is less efficient, because it moves the gap,
3127 but it should handle multibyte characters correctly. */
3128 string
= make_multibyte_string (str
, 1, str_len
);
3129 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3134 record_change (pos
, 1);
3135 while (str_len
-- > 0)
3137 signal_after_change (pos
, 1, 1);
3138 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3148 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3155 /* VAL is ([FROM-CHAR ...] . TO). */
3156 len
= ASIZE (XCAR (val
));
3164 string
= Fconcat (1, &val
);
3168 string
= Fmake_string (make_number (1), val
);
3170 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3171 pos_byte
+= SBYTES (string
);
3172 pos
+= SCHARS (string
);
3173 cnt
+= SCHARS (string
);
3174 end_pos
+= SCHARS (string
) - len
;
3182 return make_number (cnt
);
3185 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3186 doc
: /* Delete the text between point and mark.
3188 When called from a program, expects two arguments,
3189 positions (integers or markers) specifying the stretch to be deleted. */)
3191 Lisp_Object start
, end
;
3193 validate_region (&start
, &end
);
3194 del_range (XINT (start
), XINT (end
));
3198 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3199 Sdelete_and_extract_region
, 2, 2, 0,
3200 doc
: /* Delete the text between START and END and return it. */)
3202 Lisp_Object start
, end
;
3204 validate_region (&start
, &end
);
3205 if (XINT (start
) == XINT (end
))
3206 return empty_unibyte_string
;
3207 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3210 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3211 doc
: /* Remove restrictions (narrowing) from current buffer.
3212 This allows the buffer's full text to be seen and edited. */)
3215 if (BEG
!= BEGV
|| Z
!= ZV
)
3216 current_buffer
->clip_changed
= 1;
3218 BEGV_BYTE
= BEG_BYTE
;
3219 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3220 /* Changing the buffer bounds invalidates any recorded current column. */
3221 invalidate_current_column ();
3225 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3226 doc
: /* Restrict editing in this buffer to the current region.
3227 The rest of the text becomes temporarily invisible and untouchable
3228 but is not deleted; if you save the buffer in a file, the invisible
3229 text is included in the file. \\[widen] makes all visible again.
3230 See also `save-restriction'.
3232 When calling from a program, pass two arguments; positions (integers
3233 or markers) bounding the text that should remain visible. */)
3235 register Lisp_Object start
, end
;
3237 CHECK_NUMBER_COERCE_MARKER (start
);
3238 CHECK_NUMBER_COERCE_MARKER (end
);
3240 if (XINT (start
) > XINT (end
))
3243 tem
= start
; start
= end
; end
= tem
;
3246 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3247 args_out_of_range (start
, end
);
3249 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3250 current_buffer
->clip_changed
= 1;
3252 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3253 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3254 if (PT
< XFASTINT (start
))
3255 SET_PT (XFASTINT (start
));
3256 if (PT
> XFASTINT (end
))
3257 SET_PT (XFASTINT (end
));
3258 /* Changing the buffer bounds invalidates any recorded current column. */
3259 invalidate_current_column ();
3264 save_restriction_save ()
3266 if (BEGV
== BEG
&& ZV
== Z
)
3267 /* The common case that the buffer isn't narrowed.
3268 We return just the buffer object, which save_restriction_restore
3269 recognizes as meaning `no restriction'. */
3270 return Fcurrent_buffer ();
3272 /* We have to save a restriction, so return a pair of markers, one
3273 for the beginning and one for the end. */
3275 Lisp_Object beg
, end
;
3277 beg
= buildmark (BEGV
, BEGV_BYTE
);
3278 end
= buildmark (ZV
, ZV_BYTE
);
3280 /* END must move forward if text is inserted at its exact location. */
3281 XMARKER(end
)->insertion_type
= 1;
3283 return Fcons (beg
, end
);
3288 save_restriction_restore (data
)
3291 struct buffer
*cur
= NULL
;
3292 struct buffer
*buf
= (CONSP (data
)
3293 ? XMARKER (XCAR (data
))->buffer
3296 if (buf
&& buf
!= current_buffer
&& !NILP (buf
->pt_marker
))
3297 { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
3298 is the case if it is or has an indirect buffer), then make
3299 sure it is current before we update BEGV, so
3300 set_buffer_internal takes care of managing those markers. */
3301 cur
= current_buffer
;
3302 set_buffer_internal (buf
);
3306 /* A pair of marks bounding a saved restriction. */
3308 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3309 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3310 eassert (buf
== end
->buffer
);
3312 if (buf
/* Verify marker still points to a buffer. */
3313 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3314 /* The restriction has changed from the saved one, so restore
3315 the saved restriction. */
3317 int pt
= BUF_PT (buf
);
3319 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3320 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3322 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3323 /* The point is outside the new visible range, move it inside. */
3324 SET_BUF_PT_BOTH (buf
,
3325 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3326 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3329 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3333 /* A buffer, which means that there was no old restriction. */
3335 if (buf
/* Verify marker still points to a buffer. */
3336 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3337 /* The buffer has been narrowed, get rid of the narrowing. */
3339 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3340 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3342 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3347 set_buffer_internal (cur
);
3352 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3353 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3354 The buffer's restrictions make parts of the beginning and end invisible.
3355 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3356 This special form, `save-restriction', saves the current buffer's restrictions
3357 when it is entered, and restores them when it is exited.
3358 So any `narrow-to-region' within BODY lasts only until the end of the form.
3359 The old restrictions settings are restored
3360 even in case of abnormal exit (throw or error).
3362 The value returned is the value of the last form in BODY.
3364 Note: if you are using both `save-excursion' and `save-restriction',
3365 use `save-excursion' outermost:
3366 (save-excursion (save-restriction ...))
3368 usage: (save-restriction &rest BODY) */)
3372 register Lisp_Object val
;
3373 int count
= SPECPDL_INDEX ();
3375 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3376 val
= Fprogn (body
);
3377 return unbind_to (count
, val
);
3380 /* Buffer for the most recent text displayed by Fmessage_box. */
3381 static char *message_text
;
3383 /* Allocated length of that buffer. */
3384 static int message_length
;
3386 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3387 doc
: /* Display a message at the bottom of the screen.
3388 The message also goes into the `*Messages*' buffer.
3389 \(In keyboard macros, that's all it does.)
3392 The first argument is a format control string, and the rest are data
3393 to be formatted under control of the string. See `format' for details.
3395 Note: Use (message "%s" VALUE) to print the value of expressions and
3396 variables to avoid accidentally interpreting `%' as format specifiers.
3398 If the first argument is nil or the empty string, the function clears
3399 any existing message; this lets the minibuffer contents show. See
3400 also `current-message'.
3402 usage: (message FORMAT-STRING &rest ARGS) */)
3408 || (STRINGP (args
[0])
3409 && SBYTES (args
[0]) == 0))
3416 register Lisp_Object val
;
3417 val
= Fformat (nargs
, args
);
3418 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3423 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3424 doc
: /* Display a message, in a dialog box if possible.
3425 If a dialog box is not available, use the echo area.
3426 The first argument is a format control string, and the rest are data
3427 to be formatted under control of the string. See `format' for details.
3429 If the first argument is nil or the empty string, clear any existing
3430 message; let the minibuffer contents show.
3432 usage: (message-box FORMAT-STRING &rest ARGS) */)
3444 register Lisp_Object val
;
3445 val
= Fformat (nargs
, args
);
3447 /* The MS-DOS frames support popup menus even though they are
3448 not FRAME_WINDOW_P. */
3449 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3450 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3452 Lisp_Object pane
, menu
, obj
;
3453 struct gcpro gcpro1
;
3454 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3456 menu
= Fcons (val
, pane
);
3457 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3461 #endif /* HAVE_MENUS */
3462 /* Copy the data so that it won't move when we GC. */
3465 message_text
= (char *)xmalloc (80);
3466 message_length
= 80;
3468 if (SBYTES (val
) > message_length
)
3470 message_length
= SBYTES (val
);
3471 message_text
= (char *)xrealloc (message_text
, message_length
);
3473 bcopy (SDATA (val
), message_text
, SBYTES (val
));
3474 message2 (message_text
, SBYTES (val
),
3475 STRING_MULTIBYTE (val
));
3480 extern Lisp_Object last_nonmenu_event
;
3483 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3484 doc
: /* Display a message in a dialog box or in the echo area.
3485 If this command was invoked with the mouse, use a dialog box if
3486 `use-dialog-box' is non-nil.
3487 Otherwise, use the echo area.
3488 The first argument is a format control string, and the rest are data
3489 to be formatted under control of the string. See `format' for details.
3491 If the first argument is nil or the empty string, clear any existing
3492 message; let the minibuffer contents show.
3494 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3500 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3502 return Fmessage_box (nargs
, args
);
3504 return Fmessage (nargs
, args
);
3507 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3508 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3511 return current_message ();
3515 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3516 doc
: /* Return a copy of STRING with text properties added.
3517 First argument is the string to copy.
3518 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3519 properties to add to the result.
3520 usage: (propertize STRING &rest PROPERTIES) */)
3525 Lisp_Object properties
, string
;
3526 struct gcpro gcpro1
, gcpro2
;
3529 /* Number of args must be odd. */
3530 if ((nargs
& 1) == 0 || nargs
< 1)
3531 error ("Wrong number of arguments");
3533 properties
= string
= Qnil
;
3534 GCPRO2 (properties
, string
);
3536 /* First argument must be a string. */
3537 CHECK_STRING (args
[0]);
3538 string
= Fcopy_sequence (args
[0]);
3540 for (i
= 1; i
< nargs
; i
+= 2)
3541 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3543 Fadd_text_properties (make_number (0),
3544 make_number (SCHARS (string
)),
3545 properties
, string
);
3546 RETURN_UNGCPRO (string
);
3550 /* Number of bytes that STRING will occupy when put into the result.
3551 MULTIBYTE is nonzero if the result should be multibyte. */
3553 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3554 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3555 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3558 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3559 doc
: /* Format a string out of a format-string and arguments.
3560 The first argument is a format control string.
3561 The other arguments are substituted into it to make the result, a string.
3563 The format control string may contain %-sequences meaning to substitute
3564 the next available argument:
3566 %s means print a string argument. Actually, prints any object, with `princ'.
3567 %d means print as number in decimal (%o octal, %x hex).
3568 %X is like %x, but uses upper case.
3569 %e means print a number in exponential notation.
3570 %f means print a number in decimal-point notation.
3571 %g means print a number in exponential notation
3572 or decimal-point notation, whichever uses fewer characters.
3573 %c means print a number as a single character.
3574 %S means print any object as an s-expression (using `prin1').
3576 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3577 Use %% to put a single % into the output.
3579 A %-sequence may contain optional flag, width, and precision
3580 specifiers, as follows:
3582 %<flags><width><precision>character
3584 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3586 The + flag character inserts a + before any positive number, while a
3587 space inserts a space before any positive number; these flags only
3588 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3589 The # flag means to use an alternate display form for %o, %x, %X, %e,
3590 %f, and %g sequences. The - and 0 flags affect the width specifier,
3593 The width specifier supplies a lower limit for the length of the
3594 printed representation. The padding, if any, normally goes on the
3595 left, but it goes on the right if the - flag is present. The padding
3596 character is normally a space, but it is 0 if the 0 flag is present.
3597 The - flag takes precedence over the 0 flag.
3599 For %e, %f, and %g sequences, the number after the "." in the
3600 precision specifier says how many decimal places to show; if zero, the
3601 decimal point itself is omitted. For %s and %S, the precision
3602 specifier truncates the string to the given width.
3604 usage: (format STRING &rest OBJECTS) */)
3607 register Lisp_Object
*args
;
3609 register int n
; /* The number of the next arg to substitute */
3610 register int total
; /* An estimate of the final length */
3612 register unsigned char *format
, *end
, *format_start
;
3614 /* Nonzero if the output should be a multibyte string,
3615 which is true if any of the inputs is one. */
3617 /* When we make a multibyte string, we must pay attention to the
3618 byte combining problem, i.e., a byte may be combined with a
3619 multibyte charcter of the previous string. This flag tells if we
3620 must consider such a situation or not. */
3621 int maybe_combine_byte
;
3622 unsigned char *this_format
;
3623 /* Precision for each spec, or -1, a flag value meaning no precision
3624 was given in that spec. Element 0, corresonding to the format
3625 string itself, will not be used. Element NARGS, corresponding to
3626 no argument, *will* be assigned to in the case that a `%' and `.'
3627 occur after the final format specifier. */
3628 int *precision
= (int *) (alloca((nargs
+ 1) * sizeof (int)));
3631 int arg_intervals
= 0;
3634 /* discarded[I] is 1 if byte I of the format
3635 string was not copied into the output.
3636 It is 2 if byte I was not the first byte of its character. */
3637 char *discarded
= 0;
3639 /* Each element records, for one argument,
3640 the start and end bytepos in the output string,
3641 and whether the argument is a string with intervals.
3642 info[0] is unused. Unused elements have -1 for start. */
3645 int start
, end
, intervals
;
3648 /* It should not be necessary to GCPRO ARGS, because
3649 the caller in the interpreter should take care of that. */
3651 /* Try to determine whether the result should be multibyte.
3652 This is not always right; sometimes the result needs to be multibyte
3653 because of an object that we will pass through prin1,
3654 and in that case, we won't know it here. */
3655 for (n
= 0; n
< nargs
; n
++)
3657 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3659 /* Piggyback on this loop to initialize precision[N]. */
3662 precision
[nargs
] = -1;
3664 CHECK_STRING (args
[0]);
3665 /* We may have to change "%S" to "%s". */
3666 args
[0] = Fcopy_sequence (args
[0]);
3668 /* GC should never happen here, so abort if it does. */
3671 /* If we start out planning a unibyte result,
3672 then discover it has to be multibyte, we jump back to retry.
3673 That can only happen from the first large while loop below. */
3676 format
= SDATA (args
[0]);
3677 format_start
= format
;
3678 end
= format
+ SBYTES (args
[0]);
3681 /* Make room in result for all the non-%-codes in the control string. */
3682 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3684 /* Allocate the info and discarded tables. */
3686 int nbytes
= (nargs
+1) * sizeof *info
;
3689 info
= (struct info
*) alloca (nbytes
);
3690 bzero (info
, nbytes
);
3691 for (i
= 0; i
<= nargs
; i
++)
3694 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3695 bzero (discarded
, SBYTES (args
[0]));
3698 /* Add to TOTAL enough space to hold the converted arguments. */
3701 while (format
!= end
)
3702 if (*format
++ == '%')
3705 int actual_width
= 0;
3706 unsigned char *this_format_start
= format
- 1;
3707 int field_width
= 0;
3709 /* General format specifications look like
3711 '%' [flags] [field-width] [precision] format
3716 field-width ::= [0-9]+
3717 precision ::= '.' [0-9]*
3719 If a field-width is specified, it specifies to which width
3720 the output should be padded with blanks, if the output
3721 string is shorter than field-width.
3723 If precision is specified, it specifies the number of
3724 digits to print after the '.' for floats, or the max.
3725 number of chars to print from a string. */
3727 while (format
!= end
3728 && (*format
== '-' || *format
== '0' || *format
== '#'
3729 || * format
== ' ' || *format
== '+'))
3732 if (*format
>= '0' && *format
<= '9')
3734 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3735 field_width
= 10 * field_width
+ *format
- '0';
3738 /* N is not incremented for another few lines below, so refer to
3739 element N+1 (which might be precision[NARGS]). */
3743 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3744 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3747 /* Extra +1 for 'l' that we may need to insert into the
3749 if (format
- this_format_start
+ 2 > longest_format
)
3750 longest_format
= format
- this_format_start
+ 2;
3753 error ("Format string ends in middle of format specifier");
3756 else if (++n
>= nargs
)
3757 error ("Not enough arguments for format string");
3758 else if (*format
== 'S')
3760 /* For `S', prin1 the argument and then treat like a string. */
3761 register Lisp_Object tem
;
3762 tem
= Fprin1_to_string (args
[n
], Qnil
);
3763 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3769 /* If we restart the loop, we should not come here again
3770 because args[n] is now a string and calling
3771 Fprin1_to_string on it produces superflous double
3772 quotes. So, change "%S" to "%s" now. */
3776 else if (SYMBOLP (args
[n
]))
3778 args
[n
] = SYMBOL_NAME (args
[n
]);
3779 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3786 else if (STRINGP (args
[n
]))
3789 if (*format
!= 's' && *format
!= 'S')
3790 error ("Format specifier doesn't match argument type");
3791 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3792 to be as large as is calculated here. Easy check for
3793 the case PRECISION = 0. */
3794 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3795 /* The precision also constrains how much of the argument
3796 string will finally appear (Bug#5710). */
3797 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3798 if (precision
[n
] != -1)
3799 actual_width
= min(actual_width
,precision
[n
]);
3801 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3802 else if (INTEGERP (args
[n
]) && *format
!= 's')
3804 /* The following loop assumes the Lisp type indicates
3805 the proper way to pass the argument.
3806 So make sure we have a flonum if the argument should
3808 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3809 args
[n
] = Ffloat (args
[n
]);
3811 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3812 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3813 error ("Invalid format operation %%%c", *format
);
3815 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3818 if (! ASCII_CHAR_P (XINT (args
[n
]))
3819 /* Note: No one can remeber why we have to treat
3820 the character 0 as a multibyte character here.
3821 But, until it causes a real problem, let's
3823 || XINT (args
[n
]) == 0)
3830 args
[n
] = Fchar_to_string (args
[n
]);
3831 thissize
= SBYTES (args
[n
]);
3833 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3836 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3837 thissize
= SBYTES (args
[n
]);
3841 else if (FLOATP (args
[n
]) && *format
!= 's')
3843 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3845 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3846 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3847 error ("Invalid format operation %%%c", *format
);
3848 /* This fails unnecessarily if args[n] is bigger than
3849 most-positive-fixnum but smaller than MAXINT.
3850 These cases are important because we sometimes use floats
3851 to represent such integer values (typically such values
3852 come from UIDs or PIDs). */
3853 /* args[n] = Ftruncate (args[n], Qnil); */
3856 /* Note that we're using sprintf to print floats,
3857 so we have to take into account what that function
3859 /* Filter out flag value of -1. */
3860 thissize
= (MAX_10_EXP
+ 100
3861 + (precision
[n
] > 0 ? precision
[n
] : 0));
3865 /* Anything but a string, convert to a string using princ. */
3866 register Lisp_Object tem
;
3867 tem
= Fprin1_to_string (args
[n
], Qt
);
3868 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3877 thissize
+= max (0, field_width
- actual_width
);
3878 total
+= thissize
+ 4;
3883 /* Now we can no longer jump to retry.
3884 TOTAL and LONGEST_FORMAT are known for certain. */
3886 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3888 /* Allocate the space for the result.
3889 Note that TOTAL is an overestimate. */
3890 SAFE_ALLOCA (buf
, char *, total
);
3896 /* Scan the format and store result in BUF. */
3897 format
= SDATA (args
[0]);
3898 format_start
= format
;
3899 end
= format
+ SBYTES (args
[0]);
3900 maybe_combine_byte
= 0;
3901 while (format
!= end
)
3907 unsigned char *this_format_start
= format
;
3909 discarded
[format
- format_start
] = 1;
3912 while (index("-+0# ", *format
))
3918 discarded
[format
- format_start
] = 1;
3922 minlen
= atoi (format
);
3924 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3926 discarded
[format
- format_start
] = 1;
3930 if (*format
++ == '%')
3939 discarded
[format
- format_start
- 1] = 1;
3940 info
[n
].start
= nchars
;
3942 if (STRINGP (args
[n
]))
3944 /* handle case (precision[n] >= 0) */
3947 int nbytes
, start
, end
;
3950 /* lisp_string_width ignores a precision of 0, but GNU
3951 libc functions print 0 characters when the precision
3952 is 0. Imitate libc behavior here. Changing
3953 lisp_string_width is the right thing, and will be
3954 done, but meanwhile we work with it. */
3956 if (precision
[n
] == 0)
3957 width
= nchars_string
= nbytes
= 0;
3958 else if (precision
[n
] > 0)
3959 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3961 { /* no precision spec given for this argument */
3962 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3963 nbytes
= SBYTES (args
[n
]);
3964 nchars_string
= SCHARS (args
[n
]);
3967 /* If spec requires it, pad on right with spaces. */
3968 padding
= minlen
- width
;
3970 while (padding
-- > 0)
3976 info
[n
].start
= start
= nchars
;
3977 nchars
+= nchars_string
;
3982 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3983 && STRING_MULTIBYTE (args
[n
])
3984 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3985 maybe_combine_byte
= 1;
3987 p
+= copy_text (SDATA (args
[n
]), p
,
3989 STRING_MULTIBYTE (args
[n
]), multibyte
);
3991 info
[n
].end
= nchars
;
3994 while (padding
-- > 0)
4000 /* If this argument has text properties, record where
4001 in the result string it appears. */
4002 if (STRING_INTERVALS (args
[n
]))
4003 info
[n
].intervals
= arg_intervals
= 1;
4005 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
4009 bcopy (this_format_start
, this_format
,
4010 format
- this_format_start
);
4011 this_format
[format
- this_format_start
] = 0;
4013 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
4014 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
4017 if (sizeof (EMACS_INT
) > sizeof (int)
4018 && format
[-1] != 'c')
4020 /* Insert 'l' before format spec. */
4021 this_format
[format
- this_format_start
]
4022 = this_format
[format
- this_format_start
- 1];
4023 this_format
[format
- this_format_start
- 1] = 'l';
4024 this_format
[format
- this_format_start
+ 1] = 0;
4027 if (INTEGERP (args
[n
]))
4029 if (format
[-1] == 'c')
4030 sprintf (p
, this_format
, (int) XINT (args
[n
]));
4031 else if (format
[-1] == 'd')
4032 sprintf (p
, this_format
, XINT (args
[n
]));
4033 /* Don't sign-extend for octal or hex printing. */
4035 sprintf (p
, this_format
, XUINT (args
[n
]));
4037 else if (format
[-1] == 'c')
4038 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
4039 else if (format
[-1] == 'd')
4040 /* Maybe we should use "%1.0f" instead so it also works
4041 for values larger than MAXINT. */
4042 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
4044 /* Don't sign-extend for octal or hex printing. */
4045 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
4050 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4051 && !CHAR_HEAD_P (*((unsigned char *) p
)))
4052 maybe_combine_byte
= 1;
4053 this_nchars
= strlen (p
);
4055 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
4058 nchars
+= this_nchars
;
4059 info
[n
].end
= nchars
;
4063 else if (STRING_MULTIBYTE (args
[0]))
4065 /* Copy a whole multibyte character. */
4068 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
4069 && !CHAR_HEAD_P (*format
))
4070 maybe_combine_byte
= 1;
4072 while (! CHAR_HEAD_P (*format
))
4074 discarded
[format
- format_start
] = 2;
4081 /* Convert a single-byte character to multibyte. */
4082 int len
= copy_text (format
, p
, 1, 0, 1);
4089 *p
++ = *format
++, nchars
++;
4092 if (p
> buf
+ total
)
4095 if (maybe_combine_byte
)
4096 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
4097 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4099 /* If we allocated BUF with malloc, free it too. */
4102 /* If the format string has text properties, or any of the string
4103 arguments has text properties, set up text properties of the
4106 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4108 Lisp_Object len
, new_len
, props
;
4109 struct gcpro gcpro1
;
4111 /* Add text properties from the format string. */
4112 len
= make_number (SCHARS (args
[0]));
4113 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4118 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4121 /* Adjust the bounds of each text property
4122 to the proper start and end in the output string. */
4124 /* Put the positions in PROPS in increasing order, so that
4125 we can do (effectively) one scan through the position
4126 space of the format string. */
4127 props
= Fnreverse (props
);
4129 /* BYTEPOS is the byte position in the format string,
4130 POSITION is the untranslated char position in it,
4131 TRANSLATED is the translated char position in BUF,
4132 and ARGN is the number of the next arg we will come to. */
4133 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4140 /* First adjust the property start position. */
4141 pos
= XINT (XCAR (item
));
4143 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4144 up to this position. */
4145 for (; position
< pos
; bytepos
++)
4147 if (! discarded
[bytepos
])
4148 position
++, translated
++;
4149 else if (discarded
[bytepos
] == 1)
4152 if (translated
== info
[argn
].start
)
4154 translated
+= info
[argn
].end
- info
[argn
].start
;
4160 XSETCAR (item
, make_number (translated
));
4162 /* Likewise adjust the property end position. */
4163 pos
= XINT (XCAR (XCDR (item
)));
4165 for (; position
< pos
; bytepos
++)
4167 if (! discarded
[bytepos
])
4168 position
++, translated
++;
4169 else if (discarded
[bytepos
] == 1)
4172 if (translated
== info
[argn
].start
)
4174 translated
+= info
[argn
].end
- info
[argn
].start
;
4180 XSETCAR (XCDR (item
), make_number (translated
));
4183 add_text_properties_from_list (val
, props
, make_number (0));
4186 /* Add text properties from arguments. */
4188 for (n
= 1; n
< nargs
; ++n
)
4189 if (info
[n
].intervals
)
4191 len
= make_number (SCHARS (args
[n
]));
4192 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4193 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4194 props
= extend_property_ranges (props
, new_len
);
4195 /* If successive arguments have properties, be sure that
4196 the value of `composition' property be the copy. */
4197 if (n
> 1 && info
[n
- 1].end
)
4198 make_composition_value_copy (props
);
4199 add_text_properties_from_list (val
, props
,
4200 make_number (info
[n
].start
));
4210 format2 (string1
, arg0
, arg1
)
4212 Lisp_Object arg0
, arg1
;
4214 Lisp_Object args
[3];
4215 args
[0] = build_string (string1
);
4218 return Fformat (3, args
);
4221 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4222 doc
: /* Return t if two characters match, optionally ignoring case.
4223 Both arguments must be characters (i.e. integers).
4224 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4226 register Lisp_Object c1
, c2
;
4229 /* Check they're chars, not just integers, otherwise we could get array
4230 bounds violations in DOWNCASE. */
4231 CHECK_CHARACTER (c1
);
4232 CHECK_CHARACTER (c2
);
4234 if (XINT (c1
) == XINT (c2
))
4236 if (NILP (current_buffer
->case_fold_search
))
4239 /* Do these in separate statements,
4240 then compare the variables.
4241 because of the way DOWNCASE uses temp variables. */
4243 if (NILP (current_buffer
->enable_multibyte_characters
)
4244 && ! ASCII_CHAR_P (i1
))
4246 MAKE_CHAR_MULTIBYTE (i1
);
4249 if (NILP (current_buffer
->enable_multibyte_characters
)
4250 && ! ASCII_CHAR_P (i2
))
4252 MAKE_CHAR_MULTIBYTE (i2
);
4256 return (i1
== i2
? Qt
: Qnil
);
4259 /* Transpose the markers in two regions of the current buffer, and
4260 adjust the ones between them if necessary (i.e.: if the regions
4263 START1, END1 are the character positions of the first region.
4264 START1_BYTE, END1_BYTE are the byte positions.
4265 START2, END2 are the character positions of the second region.
4266 START2_BYTE, END2_BYTE are the byte positions.
4268 Traverses the entire marker list of the buffer to do so, adding an
4269 appropriate amount to some, subtracting from some, and leaving the
4270 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4272 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4275 transpose_markers (start1
, end1
, start2
, end2
,
4276 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
4277 register int start1
, end1
, start2
, end2
;
4278 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
4280 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4281 register struct Lisp_Marker
*marker
;
4283 /* Update point as if it were a marker. */
4287 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4288 PT_BYTE
+ (end2_byte
- end1_byte
));
4289 else if (PT
< start2
)
4290 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4291 (PT_BYTE
+ (end2_byte
- start2_byte
)
4292 - (end1_byte
- start1_byte
)));
4294 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4295 PT_BYTE
- (start2_byte
- start1_byte
));
4297 /* We used to adjust the endpoints here to account for the gap, but that
4298 isn't good enough. Even if we assume the caller has tried to move the
4299 gap out of our way, it might still be at start1 exactly, for example;
4300 and that places it `inside' the interval, for our purposes. The amount
4301 of adjustment is nontrivial if there's a `denormalized' marker whose
4302 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4303 the dirty work to Fmarker_position, below. */
4305 /* The difference between the region's lengths */
4306 diff
= (end2
- start2
) - (end1
- start1
);
4307 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4309 /* For shifting each marker in a region by the length of the other
4310 region plus the distance between the regions. */
4311 amt1
= (end2
- start2
) + (start2
- end1
);
4312 amt2
= (end1
- start1
) + (start2
- end1
);
4313 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4314 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4316 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4318 mpos
= marker
->bytepos
;
4319 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4321 if (mpos
< end1_byte
)
4323 else if (mpos
< start2_byte
)
4327 marker
->bytepos
= mpos
;
4329 mpos
= marker
->charpos
;
4330 if (mpos
>= start1
&& mpos
< end2
)
4334 else if (mpos
< start2
)
4339 marker
->charpos
= mpos
;
4343 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4344 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4345 The regions should not be overlapping, because the size of the buffer is
4346 never changed in a transposition.
4348 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4349 any markers that happen to be located in the regions.
4351 Transposing beyond buffer boundaries is an error. */)
4352 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
4353 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
4355 register EMACS_INT start1
, end1
, start2
, end2
;
4356 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4357 EMACS_INT gap
, len1
, len_mid
, len2
;
4358 unsigned char *start1_addr
, *start2_addr
, *temp
;
4360 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4363 XSETBUFFER (buf
, current_buffer
);
4364 cur_intv
= BUF_INTERVALS (current_buffer
);
4366 validate_region (&startr1
, &endr1
);
4367 validate_region (&startr2
, &endr2
);
4369 start1
= XFASTINT (startr1
);
4370 end1
= XFASTINT (endr1
);
4371 start2
= XFASTINT (startr2
);
4372 end2
= XFASTINT (endr2
);
4375 /* Swap the regions if they're reversed. */
4378 register int glumph
= start1
;
4386 len1
= end1
- start1
;
4387 len2
= end2
- start2
;
4390 error ("Transposed regions overlap");
4391 else if (start1
== end1
|| start2
== end2
)
4392 error ("Transposed region has length 0");
4394 /* The possibilities are:
4395 1. Adjacent (contiguous) regions, or separate but equal regions
4396 (no, really equal, in this case!), or
4397 2. Separate regions of unequal size.
4399 The worst case is usually No. 2. It means that (aside from
4400 potential need for getting the gap out of the way), there also
4401 needs to be a shifting of the text between the two regions. So
4402 if they are spread far apart, we are that much slower... sigh. */
4404 /* It must be pointed out that the really studly thing to do would
4405 be not to move the gap at all, but to leave it in place and work
4406 around it if necessary. This would be extremely efficient,
4407 especially considering that people are likely to do
4408 transpositions near where they are working interactively, which
4409 is exactly where the gap would be found. However, such code
4410 would be much harder to write and to read. So, if you are
4411 reading this comment and are feeling squirrely, by all means have
4412 a go! I just didn't feel like doing it, so I will simply move
4413 the gap the minimum distance to get it out of the way, and then
4414 deal with an unbroken array. */
4416 /* Make sure the gap won't interfere, by moving it out of the text
4417 we will operate on. */
4418 if (start1
< gap
&& gap
< end2
)
4420 if (gap
- start1
< end2
- gap
)
4426 start1_byte
= CHAR_TO_BYTE (start1
);
4427 start2_byte
= CHAR_TO_BYTE (start2
);
4428 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4429 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4431 #ifdef BYTE_COMBINING_DEBUG
4434 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4435 len2_byte
, start1
, start1_byte
)
4436 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4437 len1_byte
, end2
, start2_byte
+ len2_byte
)
4438 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4439 len1_byte
, end2
, start2_byte
+ len2_byte
))
4444 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4445 len2_byte
, start1
, start1_byte
)
4446 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4447 len1_byte
, start2
, start2_byte
)
4448 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4449 len2_byte
, end1
, start1_byte
+ len1_byte
)
4450 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4451 len1_byte
, end2
, start2_byte
+ len2_byte
))
4456 /* Hmmm... how about checking to see if the gap is large
4457 enough to use as the temporary storage? That would avoid an
4458 allocation... interesting. Later, don't fool with it now. */
4460 /* Working without memmove, for portability (sigh), so must be
4461 careful of overlapping subsections of the array... */
4463 if (end1
== start2
) /* adjacent regions */
4465 modify_region (current_buffer
, start1
, end2
, 0);
4466 record_change (start1
, len1
+ len2
);
4468 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4469 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4470 /* Don't use Fset_text_properties: that can cause GC, which can
4471 clobber objects stored in the tmp_intervals. */
4472 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4473 if (!NULL_INTERVAL_P (tmp_interval3
))
4474 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4476 /* First region smaller than second. */
4477 if (len1_byte
< len2_byte
)
4481 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4483 /* Don't precompute these addresses. We have to compute them
4484 at the last minute, because the relocating allocator might
4485 have moved the buffer around during the xmalloc. */
4486 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4487 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4489 bcopy (start2_addr
, temp
, len2_byte
);
4490 bcopy (start1_addr
, start1_addr
+ len2_byte
, len1_byte
);
4491 bcopy (temp
, start1_addr
, len2_byte
);
4495 /* First region not smaller than second. */
4499 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4500 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4501 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4502 bcopy (start1_addr
, temp
, len1_byte
);
4503 bcopy (start2_addr
, start1_addr
, len2_byte
);
4504 bcopy (temp
, start1_addr
+ len2_byte
, len1_byte
);
4507 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4508 len1
, current_buffer
, 0);
4509 graft_intervals_into_buffer (tmp_interval2
, start1
,
4510 len2
, current_buffer
, 0);
4511 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4512 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4514 /* Non-adjacent regions, because end1 != start2, bleagh... */
4517 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4519 if (len1_byte
== len2_byte
)
4520 /* Regions are same size, though, how nice. */
4524 modify_region (current_buffer
, start1
, end1
, 0);
4525 modify_region (current_buffer
, start2
, end2
, 0);
4526 record_change (start1
, len1
);
4527 record_change (start2
, len2
);
4528 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4529 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4531 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4532 if (!NULL_INTERVAL_P (tmp_interval3
))
4533 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4535 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4536 if (!NULL_INTERVAL_P (tmp_interval3
))
4537 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4539 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4540 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4541 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4542 bcopy (start1_addr
, temp
, len1_byte
);
4543 bcopy (start2_addr
, start1_addr
, len2_byte
);
4544 bcopy (temp
, start2_addr
, len1_byte
);
4547 graft_intervals_into_buffer (tmp_interval1
, start2
,
4548 len1
, current_buffer
, 0);
4549 graft_intervals_into_buffer (tmp_interval2
, start1
,
4550 len2
, current_buffer
, 0);
4553 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4554 /* Non-adjacent & unequal size, area between must also be shifted. */
4558 modify_region (current_buffer
, start1
, end2
, 0);
4559 record_change (start1
, (end2
- start1
));
4560 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4561 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4562 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4564 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4565 if (!NULL_INTERVAL_P (tmp_interval3
))
4566 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4568 /* holds region 2 */
4569 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4570 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4571 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4572 bcopy (start2_addr
, temp
, len2_byte
);
4573 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2_byte
, len1_byte
);
4574 safe_bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4575 bcopy (temp
, start1_addr
, len2_byte
);
4578 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4579 len1
, current_buffer
, 0);
4580 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4581 len_mid
, current_buffer
, 0);
4582 graft_intervals_into_buffer (tmp_interval2
, start1
,
4583 len2
, current_buffer
, 0);
4586 /* Second region smaller than first. */
4590 record_change (start1
, (end2
- start1
));
4591 modify_region (current_buffer
, start1
, end2
, 0);
4593 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4594 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4595 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4597 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4598 if (!NULL_INTERVAL_P (tmp_interval3
))
4599 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4601 /* holds region 1 */
4602 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4603 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4604 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4605 bcopy (start1_addr
, temp
, len1_byte
);
4606 bcopy (start2_addr
, start1_addr
, len2_byte
);
4607 bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
4608 bcopy (temp
, start1_addr
+ len2_byte
+ len_mid
, len1_byte
);
4611 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4612 len1
, current_buffer
, 0);
4613 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4614 len_mid
, current_buffer
, 0);
4615 graft_intervals_into_buffer (tmp_interval2
, start1
,
4616 len2
, current_buffer
, 0);
4619 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4620 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4623 /* When doing multiple transpositions, it might be nice
4624 to optimize this. Perhaps the markers in any one buffer
4625 should be organized in some sorted data tree. */
4626 if (NILP (leave_markers
))
4628 transpose_markers (start1
, end1
, start2
, end2
,
4629 start1_byte
, start1_byte
+ len1_byte
,
4630 start2_byte
, start2_byte
+ len2_byte
);
4631 fix_start_end_in_overlays (start1
, end2
);
4634 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4645 Qbuffer_access_fontify_functions
4646 = intern_c_string ("buffer-access-fontify-functions");
4647 staticpro (&Qbuffer_access_fontify_functions
);
4649 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4650 doc
: /* Non-nil means text motion commands don't notice fields. */);
4651 Vinhibit_field_text_motion
= Qnil
;
4653 DEFVAR_LISP ("buffer-access-fontify-functions",
4654 &Vbuffer_access_fontify_functions
,
4655 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4656 Each function is called with two arguments which specify the range
4657 of the buffer being accessed. */);
4658 Vbuffer_access_fontify_functions
= Qnil
;
4662 extern Lisp_Object Vprin1_to_string_buffer
;
4663 obuf
= Fcurrent_buffer ();
4664 /* Do this here, because init_buffer_once is too early--it won't work. */
4665 Fset_buffer (Vprin1_to_string_buffer
);
4666 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4667 Fset (Fmake_local_variable (intern_c_string ("buffer-access-fontify-functions")),
4672 DEFVAR_LISP ("buffer-access-fontified-property",
4673 &Vbuffer_access_fontified_property
,
4674 doc
: /* Property which (if non-nil) indicates text has been fontified.
4675 `buffer-substring' need not call the `buffer-access-fontify-functions'
4676 functions if all the text being accessed has this property. */);
4677 Vbuffer_access_fontified_property
= Qnil
;
4679 DEFVAR_LISP ("system-name", &Vsystem_name
,
4680 doc
: /* The host name of the machine Emacs is running on. */);
4682 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4683 doc
: /* The full name of the user logged in. */);
4685 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4686 doc
: /* The user's name, taken from environment variables if possible. */);
4688 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4689 doc
: /* The user's name, based upon the real uid only. */);
4691 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4692 doc
: /* The release of the operating system Emacs is running on. */);
4694 defsubr (&Spropertize
);
4695 defsubr (&Schar_equal
);
4696 defsubr (&Sgoto_char
);
4697 defsubr (&Sstring_to_char
);
4698 defsubr (&Schar_to_string
);
4699 defsubr (&Sbyte_to_string
);
4700 defsubr (&Sbuffer_substring
);
4701 defsubr (&Sbuffer_substring_no_properties
);
4702 defsubr (&Sbuffer_string
);
4704 defsubr (&Spoint_marker
);
4705 defsubr (&Smark_marker
);
4707 defsubr (&Sregion_beginning
);
4708 defsubr (&Sregion_end
);
4710 staticpro (&Qfield
);
4711 Qfield
= intern_c_string ("field");
4712 staticpro (&Qboundary
);
4713 Qboundary
= intern_c_string ("boundary");
4714 defsubr (&Sfield_beginning
);
4715 defsubr (&Sfield_end
);
4716 defsubr (&Sfield_string
);
4717 defsubr (&Sfield_string_no_properties
);
4718 defsubr (&Sdelete_field
);
4719 defsubr (&Sconstrain_to_field
);
4721 defsubr (&Sline_beginning_position
);
4722 defsubr (&Sline_end_position
);
4724 /* defsubr (&Smark); */
4725 /* defsubr (&Sset_mark); */
4726 defsubr (&Ssave_excursion
);
4727 defsubr (&Ssave_current_buffer
);
4729 defsubr (&Sbufsize
);
4730 defsubr (&Spoint_max
);
4731 defsubr (&Spoint_min
);
4732 defsubr (&Spoint_min_marker
);
4733 defsubr (&Spoint_max_marker
);
4734 defsubr (&Sgap_position
);
4735 defsubr (&Sgap_size
);
4736 defsubr (&Sposition_bytes
);
4737 defsubr (&Sbyte_to_position
);
4743 defsubr (&Sfollowing_char
);
4744 defsubr (&Sprevious_char
);
4745 defsubr (&Schar_after
);
4746 defsubr (&Schar_before
);
4748 defsubr (&Sinsert_before_markers
);
4749 defsubr (&Sinsert_and_inherit
);
4750 defsubr (&Sinsert_and_inherit_before_markers
);
4751 defsubr (&Sinsert_char
);
4752 defsubr (&Sinsert_byte
);
4754 defsubr (&Suser_login_name
);
4755 defsubr (&Suser_real_login_name
);
4756 defsubr (&Suser_uid
);
4757 defsubr (&Suser_real_uid
);
4758 defsubr (&Suser_full_name
);
4759 defsubr (&Semacs_pid
);
4760 defsubr (&Scurrent_time
);
4761 defsubr (&Sget_internal_run_time
);
4762 defsubr (&Sformat_time_string
);
4763 defsubr (&Sfloat_time
);
4764 defsubr (&Sdecode_time
);
4765 defsubr (&Sencode_time
);
4766 defsubr (&Scurrent_time_string
);
4767 defsubr (&Scurrent_time_zone
);
4768 defsubr (&Sset_time_zone_rule
);
4769 defsubr (&Ssystem_name
);
4770 defsubr (&Smessage
);
4771 defsubr (&Smessage_box
);
4772 defsubr (&Smessage_or_box
);
4773 defsubr (&Scurrent_message
);
4776 defsubr (&Sinsert_buffer_substring
);
4777 defsubr (&Scompare_buffer_substrings
);
4778 defsubr (&Ssubst_char_in_region
);
4779 defsubr (&Stranslate_region_internal
);
4780 defsubr (&Sdelete_region
);
4781 defsubr (&Sdelete_and_extract_region
);
4783 defsubr (&Snarrow_to_region
);
4784 defsubr (&Ssave_restriction
);
4785 defsubr (&Stranspose_regions
);
4788 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4789 (do not change this comment) */