1 /* Lisp functions pertaining to editing.
3 Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996, 1997,
4 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 2009, 2010 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
36 #ifdef HAVE_SYS_UTSNAME_H
37 #include <sys/utsname.h>
42 /* systime.h includes <sys/time.h> which, on some systems, is required
43 for <sys/resource.h>; thus systime.h must be included before
47 #if defined HAVE_SYS_RESOURCE_H
48 #include <sys/resource.h>
53 #include "intervals.h"
55 #include "character.h"
59 #include "blockinput.h"
63 #define MAX_10_EXP DBL_MAX_10_EXP
65 #define MAX_10_EXP 310
72 #ifndef USER_FULL_NAME
73 #define USER_FULL_NAME pw->pw_gecos
77 extern char **environ
;
80 #define TM_YEAR_BASE 1900
82 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
83 asctime to have well-defined behavior. */
84 #ifndef TM_YEAR_IN_ASCTIME_RANGE
85 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
86 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
89 extern size_t emacs_strftimeu (char *, size_t, const char *,
90 const struct tm
*, int);
93 extern Lisp_Object
w32_get_internal_run_time ();
96 static int tm_diff (struct tm
*, struct tm
*);
97 static void find_field (Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *);
98 static void update_buffer_properties (int, int);
99 static Lisp_Object
region_limit (int);
100 int lisp_time_argument (Lisp_Object
, time_t *, int *);
101 static size_t emacs_memftimeu (char *, size_t, const char *,
102 size_t, const struct tm
*, int);
103 static void general_insert_function (void (*) (const unsigned char *, EMACS_INT
),
104 void (*) (Lisp_Object
, EMACS_INT
,
105 EMACS_INT
, EMACS_INT
,
107 int, int, Lisp_Object
*);
108 static Lisp_Object
subst_char_in_region_unwind (Lisp_Object
);
109 static Lisp_Object
subst_char_in_region_unwind_1 (Lisp_Object
);
110 static void transpose_markers (int, int, int, int, int, int, int, int);
113 extern char *index (const char *, int);
116 Lisp_Object Vbuffer_access_fontify_functions
;
117 Lisp_Object Qbuffer_access_fontify_functions
;
118 Lisp_Object Vbuffer_access_fontified_property
;
120 Lisp_Object
Fuser_full_name (Lisp_Object
);
122 /* Non-nil means don't stop at field boundary in text motion commands. */
124 Lisp_Object Vinhibit_field_text_motion
;
126 /* Some static data, and a function to initialize it for each run */
128 Lisp_Object Vsystem_name
;
129 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
130 Lisp_Object Vuser_full_name
; /* full name of current user */
131 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
132 Lisp_Object Voperating_system_release
; /* Operating System Release */
134 /* Symbol for the text property used to mark fields. */
138 /* A special value for Qfield properties. */
140 Lisp_Object Qboundary
;
147 register unsigned char *p
;
148 struct passwd
*pw
; /* password entry for the current user */
151 /* Set up system_name even when dumping. */
155 /* Don't bother with this on initial start when just dumping out */
158 #endif /* not CANNOT_DUMP */
160 pw
= (struct passwd
*) getpwuid (getuid ());
162 /* We let the real user name default to "root" because that's quite
163 accurate on MSDOG and because it lets Emacs find the init file.
164 (The DVX libraries override the Djgpp libraries here.) */
165 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
167 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
170 /* Get the effective user name, by consulting environment variables,
171 or the effective uid if those are unset. */
172 user_name
= (char *) getenv ("LOGNAME");
175 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
176 #else /* WINDOWSNT */
177 user_name
= (char *) getenv ("USER");
178 #endif /* WINDOWSNT */
181 pw
= (struct passwd
*) getpwuid (geteuid ());
182 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
184 Vuser_login_name
= build_string (user_name
);
186 /* If the user name claimed in the environment vars differs from
187 the real uid, use the claimed name to find the full name. */
188 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
189 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
192 p
= (unsigned char *) getenv ("NAME");
194 Vuser_full_name
= build_string (p
);
195 else if (NILP (Vuser_full_name
))
196 Vuser_full_name
= build_string ("unknown");
198 #ifdef HAVE_SYS_UTSNAME_H
202 Voperating_system_release
= build_string (uts
.release
);
205 Voperating_system_release
= Qnil
;
209 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
210 doc
: /* Convert arg CHAR to a string containing that character.
211 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. */)
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. */)
236 (register Lisp_Object string
)
238 register Lisp_Object val
;
239 CHECK_STRING (string
);
242 if (STRING_MULTIBYTE (string
))
243 XSETFASTINT (val
, STRING_CHAR (SDATA (string
)));
245 XSETFASTINT (val
, SREF (string
, 0));
248 XSETFASTINT (val
, 0);
253 buildmark (int charpos
, int bytepos
)
255 register Lisp_Object mark
;
256 mark
= Fmake_marker ();
257 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
261 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
262 doc
: /* Return value of point, as an integer.
263 Beginning of buffer is position (point-min). */)
267 XSETFASTINT (temp
, PT
);
271 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
272 doc
: /* Return value of point, as a marker object. */)
275 return buildmark (PT
, PT_BYTE
);
279 clip_to_bounds (int lower
, int num
, int upper
)
283 else if (num
> upper
)
289 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
290 doc
: /* Set point to POSITION, a number or marker.
291 Beginning of buffer is position (point-min), end is (point-max).
293 The return value is POSITION. */)
294 (register Lisp_Object position
)
298 if (MARKERP (position
)
299 && current_buffer
== XMARKER (position
)->buffer
)
301 pos
= marker_position (position
);
303 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
305 SET_PT_BOTH (ZV
, ZV_BYTE
);
307 SET_PT_BOTH (pos
, marker_byte_position (position
));
312 CHECK_NUMBER_COERCE_MARKER (position
);
314 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
320 /* Return the start or end position of the region.
321 BEGINNINGP non-zero means return the start.
322 If there is no region active, signal an error. */
325 region_limit (int beginningp
)
327 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
330 if (!NILP (Vtransient_mark_mode
)
331 && NILP (Vmark_even_if_inactive
)
332 && NILP (current_buffer
->mark_active
))
333 xsignal0 (Qmark_inactive
);
335 m
= Fmarker_position (current_buffer
->mark
);
337 error ("The mark is not set now, so there is no region");
339 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
340 m
= make_number (PT
);
344 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
345 doc
: /* Return position of beginning of region, as an integer. */)
348 return region_limit (1);
351 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
352 doc
: /* Return position of end of region, as an integer. */)
355 return region_limit (0);
358 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
359 doc
: /* Return this buffer's mark, as a marker object.
360 Watch out! Moving this marker changes the mark position.
361 If you set the marker not to point anywhere, the buffer will have no mark. */)
364 return current_buffer
->mark
;
368 /* Find all the overlays in the current buffer that touch position POS.
369 Return the number found, and store them in a vector in VEC
373 overlays_around (int pos
, Lisp_Object
*vec
, int len
)
375 Lisp_Object overlay
, start
, end
;
376 struct Lisp_Overlay
*tail
;
377 int startpos
, endpos
;
380 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
382 XSETMISC (overlay
, tail
);
384 end
= OVERLAY_END (overlay
);
385 endpos
= OVERLAY_POSITION (end
);
388 start
= OVERLAY_START (overlay
);
389 startpos
= OVERLAY_POSITION (start
);
394 /* Keep counting overlays even if we can't return them all. */
399 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
401 XSETMISC (overlay
, tail
);
403 start
= OVERLAY_START (overlay
);
404 startpos
= OVERLAY_POSITION (start
);
407 end
= OVERLAY_END (overlay
);
408 endpos
= OVERLAY_POSITION (end
);
420 /* Return the value of property PROP, in OBJECT at POSITION.
421 It's the value of PROP that a char inserted at POSITION would get.
422 OBJECT is optional and defaults to the current buffer.
423 If OBJECT is a buffer, then overlay properties are considered as well as
425 If OBJECT is a window, then that window's buffer is used, but
426 window-specific overlays are considered only if they are associated
429 get_pos_property (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
)
431 CHECK_NUMBER_COERCE_MARKER (position
);
434 XSETBUFFER (object
, current_buffer
);
435 else if (WINDOWP (object
))
436 object
= XWINDOW (object
)->buffer
;
438 if (!BUFFERP (object
))
439 /* pos-property only makes sense in buffers right now, since strings
440 have no overlays and no notion of insertion for which stickiness
442 return Fget_text_property (position
, prop
, object
);
445 int posn
= XINT (position
);
447 Lisp_Object
*overlay_vec
, tem
;
448 struct buffer
*obuf
= current_buffer
;
450 set_buffer_temp (XBUFFER (object
));
452 /* First try with room for 40 overlays. */
454 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
455 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
457 /* If there are more than 40,
458 make enough space for all, and try again. */
461 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
462 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
464 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
466 set_buffer_temp (obuf
);
468 /* Now check the overlays in order of decreasing priority. */
469 while (--noverlays
>= 0)
471 Lisp_Object ol
= overlay_vec
[noverlays
];
472 tem
= Foverlay_get (ol
, prop
);
475 /* Check the overlay is indeed active at point. */
476 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
477 if ((OVERLAY_POSITION (start
) == posn
478 && XMARKER (start
)->insertion_type
== 1)
479 || (OVERLAY_POSITION (finish
) == posn
480 && XMARKER (finish
)->insertion_type
== 0))
481 ; /* The overlay will not cover a char inserted at point. */
489 { /* Now check the text properties. */
490 int stickiness
= text_property_stickiness (prop
, position
, object
);
492 return Fget_text_property (position
, prop
, object
);
493 else if (stickiness
< 0
494 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
495 return Fget_text_property (make_number (XINT (position
) - 1),
503 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
504 the value of point is used instead. If BEG or END is null,
505 means don't store the beginning or end of the field.
507 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
508 results; they do not effect boundary behavior.
510 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
511 position of a field, then the beginning of the previous field is
512 returned instead of the beginning of POS's field (since the end of a
513 field is actually also the beginning of the next input field, this
514 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
515 true case, if two fields are separated by a field with the special
516 value `boundary', and POS lies within it, then the two separated
517 fields are considered to be adjacent, and POS between them, when
518 finding the beginning and ending of the "merged" field.
520 Either BEG or END may be 0, in which case the corresponding value
524 find_field (Lisp_Object pos
, Lisp_Object merge_at_boundary
, Lisp_Object beg_limit
, int *beg
, Lisp_Object end_limit
, int *end
)
526 /* Fields right before and after the point. */
527 Lisp_Object before_field
, after_field
;
528 /* 1 if POS counts as the start of a field. */
529 int at_field_start
= 0;
530 /* 1 if POS counts as the end of a field. */
531 int at_field_end
= 0;
534 XSETFASTINT (pos
, PT
);
536 CHECK_NUMBER_COERCE_MARKER (pos
);
539 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
541 = (XFASTINT (pos
) > BEGV
542 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
544 /* Using nil here would be a more obvious choice, but it would
545 fail when the buffer starts with a non-sticky field. */
548 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
549 and POS is at beginning of a field, which can also be interpreted
550 as the end of the previous field. Note that the case where if
551 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
552 more natural one; then we avoid treating the beginning of a field
554 if (NILP (merge_at_boundary
))
556 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
557 if (!EQ (field
, after_field
))
559 if (!EQ (field
, before_field
))
561 if (NILP (field
) && at_field_start
&& at_field_end
)
562 /* If an inserted char would have a nil field while the surrounding
563 text is non-nil, we're probably not looking at a
564 zero-length field, but instead at a non-nil field that's
565 not intended for editing (such as comint's prompts). */
566 at_field_end
= at_field_start
= 0;
569 /* Note about special `boundary' fields:
571 Consider the case where the point (`.') is between the fields `x' and `y':
575 In this situation, if merge_at_boundary is true, we consider the
576 `x' and `y' fields as forming one big merged field, and so the end
577 of the field is the end of `y'.
579 However, if `x' and `y' are separated by a special `boundary' field
580 (a field with a `field' char-property of 'boundary), then we ignore
581 this special field when merging adjacent fields. Here's the same
582 situation, but with a `boundary' field between the `x' and `y' fields:
586 Here, if point is at the end of `x', the beginning of `y', or
587 anywhere in-between (within the `boundary' field), we merge all
588 three fields and consider the beginning as being the beginning of
589 the `x' field, and the end as being the end of the `y' field. */
594 /* POS is at the edge of a field, and we should consider it as
595 the beginning of the following field. */
596 *beg
= XFASTINT (pos
);
598 /* Find the previous field boundary. */
601 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
602 /* Skip a `boundary' field. */
603 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
606 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
608 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
615 /* POS is at the edge of a field, and we should consider it as
616 the end of the previous field. */
617 *end
= XFASTINT (pos
);
619 /* Find the next field boundary. */
621 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
622 /* Skip a `boundary' field. */
623 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
626 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
628 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
634 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
635 doc
: /* Delete the field surrounding POS.
636 A field is a region of text with the same `field' property.
637 If POS is nil, the value of point is used for POS. */)
641 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
643 del_range (beg
, end
);
647 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
648 doc
: /* Return the contents of the field surrounding POS as a string.
649 A field is a region of text with the same `field' property.
650 If POS is nil, the value of point is used for POS. */)
654 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
655 return make_buffer_string (beg
, end
, 1);
658 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
659 doc
: /* Return the contents of the field around POS, without text properties.
660 A field is a region of text with the same `field' property.
661 If POS is nil, the value of point is used for POS. */)
665 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
666 return make_buffer_string (beg
, end
, 0);
669 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
670 doc
: /* Return the beginning of the field surrounding POS.
671 A field is a region of text with the same `field' property.
672 If POS is nil, the value of point is used for POS.
673 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
674 field, then the beginning of the *previous* field is returned.
675 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
676 is before LIMIT, then LIMIT will be returned instead. */)
677 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
680 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
681 return make_number (beg
);
684 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
685 doc
: /* Return the end of the field surrounding POS.
686 A field is a region of text with the same `field' property.
687 If POS is nil, the value of point is used for POS.
688 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
689 then the end of the *following* field is returned.
690 If LIMIT is non-nil, it is a buffer position; if the end of the field
691 is after LIMIT, then LIMIT will be returned instead. */)
692 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
695 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
696 return make_number (end
);
699 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
700 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
702 A field is a region of text with the same `field' property.
703 If NEW-POS is nil, then the current point is used instead, and set to the
704 constrained position if that is different.
706 If OLD-POS is at the boundary of two fields, then the allowable
707 positions for NEW-POS depends on the value of the optional argument
708 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
709 constrained to the field that has the same `field' char-property
710 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
711 is non-nil, NEW-POS is constrained to the union of the two adjacent
712 fields. Additionally, if two fields are separated by another field with
713 the special value `boundary', then any point within this special field is
714 also considered to be `on the boundary'.
716 If the optional argument ONLY-IN-LINE is non-nil and constraining
717 NEW-POS would move it to a different line, NEW-POS is returned
718 unconstrained. This useful for commands that move by line, like
719 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
720 only in the case where they can still move to the right line.
722 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
723 a non-nil property of that name, then any field boundaries are ignored.
725 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
726 (Lisp_Object new_pos
, Lisp_Object old_pos
, Lisp_Object escape_from_edge
, Lisp_Object only_in_line
, Lisp_Object inhibit_capture_property
)
728 /* If non-zero, then the original point, before re-positioning. */
731 Lisp_Object prev_old
, prev_new
;
734 /* Use the current point, and afterwards, set it. */
737 XSETFASTINT (new_pos
, PT
);
740 CHECK_NUMBER_COERCE_MARKER (new_pos
);
741 CHECK_NUMBER_COERCE_MARKER (old_pos
);
743 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
745 prev_old
= make_number (XFASTINT (old_pos
) - 1);
746 prev_new
= make_number (XFASTINT (new_pos
) - 1);
748 if (NILP (Vinhibit_field_text_motion
)
749 && !EQ (new_pos
, old_pos
)
750 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
751 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
752 /* To recognize field boundaries, we must also look at the
753 previous positions; we could use `get_pos_property'
754 instead, but in itself that would fail inside non-sticky
755 fields (like comint prompts). */
756 || (XFASTINT (new_pos
) > BEGV
757 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
758 || (XFASTINT (old_pos
) > BEGV
759 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
760 && (NILP (inhibit_capture_property
)
761 /* Field boundaries are again a problem; but now we must
762 decide the case exactly, so we need to call
763 `get_pos_property' as well. */
764 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
765 && (XFASTINT (old_pos
) <= BEGV
766 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
767 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
768 /* It is possible that NEW_POS is not within the same field as
769 OLD_POS; try to move NEW_POS so that it is. */
772 Lisp_Object field_bound
;
775 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
777 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
779 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
780 other side of NEW_POS, which would mean that NEW_POS is
781 already acceptable, and it's not necessary to constrain it
783 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
784 /* NEW_POS should be constrained, but only if either
785 ONLY_IN_LINE is nil (in which case any constraint is OK),
786 or NEW_POS and FIELD_BOUND are on the same line (in which
787 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
788 && (NILP (only_in_line
)
789 /* This is the ONLY_IN_LINE case, check that NEW_POS and
790 FIELD_BOUND are on the same line by seeing whether
791 there's an intervening newline or not. */
792 || (scan_buffer ('\n',
793 XFASTINT (new_pos
), XFASTINT (field_bound
),
794 fwd
? -1 : 1, &shortage
, 1),
796 /* Constrain NEW_POS to FIELD_BOUND. */
797 new_pos
= field_bound
;
799 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
800 /* The NEW_POS argument was originally nil, so automatically set PT. */
801 SET_PT (XFASTINT (new_pos
));
808 DEFUN ("line-beginning-position",
809 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
810 doc
: /* Return the character position of the first character on the current line.
811 With argument N not nil or 1, move forward N - 1 lines first.
812 If scan reaches end of buffer, return that position.
814 This function constrains the returned position to the current field
815 unless that would be on a different line than the original,
816 unconstrained result. If N is nil or 1, and a front-sticky field
817 starts at point, the scan stops as soon as it starts. To ignore field
818 boundaries bind `inhibit-field-text-motion' to t.
820 This function does not move point. */)
823 int orig
, orig_byte
, end
;
824 int count
= SPECPDL_INDEX ();
825 specbind (Qinhibit_point_motion_hooks
, Qt
);
834 Fforward_line (make_number (XINT (n
) - 1));
837 SET_PT_BOTH (orig
, orig_byte
);
839 unbind_to (count
, Qnil
);
841 /* Return END constrained to the current input field. */
842 return Fconstrain_to_field (make_number (end
), make_number (orig
),
843 XINT (n
) != 1 ? Qt
: Qnil
,
847 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
848 doc
: /* Return the character position of the last character on the current line.
849 With argument N not nil or 1, move forward N - 1 lines first.
850 If scan reaches end of buffer, return that position.
852 This function constrains the returned position to the current field
853 unless that would be on a different line than the original,
854 unconstrained result. If N is nil or 1, and a rear-sticky field ends
855 at point, the scan stops as soon as it starts. To ignore field
856 boundaries bind `inhibit-field-text-motion' to t.
858 This function does not move point. */)
869 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
871 /* Return END_POS constrained to the current input field. */
872 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
878 save_excursion_save (void)
880 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
883 return Fcons (Fpoint_marker (),
884 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
885 Fcons (visible
? Qt
: Qnil
,
886 Fcons (current_buffer
->mark_active
,
891 save_excursion_restore (Lisp_Object info
)
893 Lisp_Object tem
, tem1
, omark
, nmark
;
894 struct gcpro gcpro1
, gcpro2
, gcpro3
;
897 tem
= Fmarker_buffer (XCAR (info
));
898 /* If buffer being returned to is now deleted, avoid error */
899 /* Otherwise could get error here while unwinding to top level
901 /* In that case, Fmarker_buffer returns nil now. */
905 omark
= nmark
= Qnil
;
906 GCPRO3 (info
, omark
, nmark
);
913 unchain_marker (XMARKER (tem
));
918 omark
= Fmarker_position (current_buffer
->mark
);
919 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
920 nmark
= Fmarker_position (tem
);
921 unchain_marker (XMARKER (tem
));
925 visible_p
= !NILP (XCAR (info
));
927 #if 0 /* We used to make the current buffer visible in the selected window
928 if that was true previously. That avoids some anomalies.
929 But it creates others, and it wasn't documented, and it is simpler
930 and cleaner never to alter the window/buffer connections. */
933 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
934 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
940 tem1
= current_buffer
->mark_active
;
941 current_buffer
->mark_active
= tem
;
943 if (!NILP (Vrun_hooks
))
945 /* If mark is active now, and either was not active
946 or was at a different place, run the activate hook. */
947 if (! NILP (current_buffer
->mark_active
))
949 if (! EQ (omark
, nmark
))
950 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
952 /* If mark has ceased to be active, run deactivate hook. */
953 else if (! NILP (tem1
))
954 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
957 /* If buffer was visible in a window, and a different window was
958 selected, and the old selected window is still showing this
959 buffer, restore point in that window. */
962 && !EQ (tem
, selected_window
)
963 && (tem1
= XWINDOW (tem
)->buffer
,
964 (/* Window is live... */
966 /* ...and it shows the current buffer. */
967 && XBUFFER (tem1
) == current_buffer
)))
968 Fset_window_point (tem
, make_number (PT
));
974 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
975 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
976 Executes BODY just like `progn'.
977 The values of point, mark and the current buffer are restored
978 even in case of abnormal exit (throw or error).
979 The state of activation of the mark is also restored.
981 This construct does not save `deactivate-mark', and therefore
982 functions that change the buffer will still cause deactivation
983 of the mark at the end of the command. To prevent that, bind
984 `deactivate-mark' with `let'.
986 If you only want to save the current buffer but not point nor mark,
987 then just use `save-current-buffer', or even `with-current-buffer'.
989 usage: (save-excursion &rest BODY) */)
992 register Lisp_Object val
;
993 int count
= SPECPDL_INDEX ();
995 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
998 return unbind_to (count
, val
);
1001 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
1002 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
1003 Executes BODY just like `progn'.
1004 usage: (save-current-buffer &rest BODY) */)
1008 int count
= SPECPDL_INDEX ();
1010 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
1012 val
= Fprogn (args
);
1013 return unbind_to (count
, val
);
1016 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1017 doc
: /* Return the number of characters in the current buffer.
1018 If BUFFER, return the number of characters in that buffer instead. */)
1019 (Lisp_Object buffer
)
1022 return make_number (Z
- BEG
);
1025 CHECK_BUFFER (buffer
);
1026 return make_number (BUF_Z (XBUFFER (buffer
))
1027 - BUF_BEG (XBUFFER (buffer
)));
1031 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1032 doc
: /* Return the minimum permissible value of point in the current buffer.
1033 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1037 XSETFASTINT (temp
, BEGV
);
1041 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1042 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1043 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1046 return buildmark (BEGV
, BEGV_BYTE
);
1049 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1050 doc
: /* Return the maximum permissible value of point in the current buffer.
1051 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1052 is in effect, in which case it is less. */)
1056 XSETFASTINT (temp
, ZV
);
1060 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1061 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1062 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1063 is in effect, in which case it is less. */)
1066 return buildmark (ZV
, ZV_BYTE
);
1069 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1070 doc
: /* Return the position of the gap, in the current buffer.
1071 See also `gap-size'. */)
1075 XSETFASTINT (temp
, GPT
);
1079 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1080 doc
: /* Return the size of the current buffer's gap.
1081 See also `gap-position'. */)
1085 XSETFASTINT (temp
, GAP_SIZE
);
1089 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1090 doc
: /* Return the byte position for character position POSITION.
1091 If POSITION is out of range, the value is nil. */)
1092 (Lisp_Object position
)
1094 CHECK_NUMBER_COERCE_MARKER (position
);
1095 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1097 return make_number (CHAR_TO_BYTE (XINT (position
)));
1100 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1101 doc
: /* Return the character position for byte position BYTEPOS.
1102 If BYTEPOS is out of range, the value is nil. */)
1103 (Lisp_Object bytepos
)
1105 CHECK_NUMBER (bytepos
);
1106 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1108 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1111 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1112 doc
: /* Return the character following point, as a number.
1113 At the end of the buffer or accessible region, return 0. */)
1118 XSETFASTINT (temp
, 0);
1120 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1124 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1125 doc
: /* Return the character preceding point, as a number.
1126 At the beginning of the buffer or accessible region, return 0. */)
1131 XSETFASTINT (temp
, 0);
1132 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1136 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1139 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1143 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1144 doc
: /* Return t if point is at the beginning of the buffer.
1145 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1153 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1154 doc
: /* Return t if point is at the end of the buffer.
1155 If the buffer is narrowed, this means the end of the narrowed part. */)
1163 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1164 doc
: /* Return t if point is at the beginning of a line. */)
1167 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1172 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1173 doc
: /* Return t if point is at the end of a line.
1174 `End of a line' includes point being at the end of the buffer. */)
1177 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1182 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1183 doc
: /* Return character in current buffer at position POS.
1184 POS is an integer or a marker and defaults to point.
1185 If POS is out of range, the value is nil. */)
1188 register int pos_byte
;
1193 XSETFASTINT (pos
, PT
);
1198 pos_byte
= marker_byte_position (pos
);
1199 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1204 CHECK_NUMBER_COERCE_MARKER (pos
);
1205 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1208 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1211 return make_number (FETCH_CHAR (pos_byte
));
1214 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1215 doc
: /* Return character in current buffer preceding position POS.
1216 POS is an integer or a marker and defaults to point.
1217 If POS is out of range, the value is nil. */)
1220 register Lisp_Object val
;
1221 register int pos_byte
;
1226 XSETFASTINT (pos
, PT
);
1231 pos_byte
= marker_byte_position (pos
);
1233 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1238 CHECK_NUMBER_COERCE_MARKER (pos
);
1240 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1243 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1246 if (!NILP (current_buffer
->enable_multibyte_characters
))
1249 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1254 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1259 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1260 doc
: /* Return the name under which the user logged in, as a string.
1261 This is based on the effective uid, not the real uid.
1262 Also, if the environment variables LOGNAME or USER are set,
1263 that determines the value of this function.
1265 If optional argument UID is an integer or a float, return the login name
1266 of the user with that uid, or nil if there is no such user. */)
1272 /* Set up the user name info if we didn't do it before.
1273 (That can happen if Emacs is dumpable
1274 but you decide to run `temacs -l loadup' and not dump. */
1275 if (INTEGERP (Vuser_login_name
))
1279 return Vuser_login_name
;
1281 id
= (uid_t
)XFLOATINT (uid
);
1283 pw
= (struct passwd
*) getpwuid (id
);
1285 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1288 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1290 doc
: /* Return the name of the user's real uid, as a string.
1291 This ignores the environment variables LOGNAME and USER, so it differs from
1292 `user-login-name' when running under `su'. */)
1295 /* Set up the user name info if we didn't do it before.
1296 (That can happen if Emacs is dumpable
1297 but you decide to run `temacs -l loadup' and not dump. */
1298 if (INTEGERP (Vuser_login_name
))
1300 return Vuser_real_login_name
;
1303 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1304 doc
: /* Return the effective uid of Emacs.
1305 Value is an integer or a float, depending on the value. */)
1308 /* Assignment to EMACS_INT stops GCC whining about limited range of
1310 EMACS_INT euid
= geteuid ();
1312 /* Make sure we don't produce a negative UID due to signed integer
1315 return make_float ((double)geteuid ());
1316 return make_fixnum_or_float (euid
);
1319 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1320 doc
: /* Return the real uid of Emacs.
1321 Value is an integer or a float, depending on the value. */)
1324 /* Assignment to EMACS_INT stops GCC whining about limited range of
1326 EMACS_INT uid
= getuid ();
1328 /* Make sure we don't produce a negative UID due to signed integer
1331 return make_float ((double)getuid ());
1332 return make_fixnum_or_float (uid
);
1335 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1336 doc
: /* Return the full name of the user logged in, as a string.
1337 If the full name corresponding to Emacs's userid is not known,
1340 If optional argument UID is an integer or float, return the full name
1341 of the user with that uid, or nil if there is no such user.
1342 If UID is a string, return the full name of the user with that login
1343 name, or nil if there is no such user. */)
1347 register unsigned char *p
, *q
;
1351 return Vuser_full_name
;
1352 else if (NUMBERP (uid
))
1355 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1358 else if (STRINGP (uid
))
1361 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1365 error ("Invalid UID specification");
1370 p
= (unsigned char *) USER_FULL_NAME
;
1371 /* Chop off everything after the first comma. */
1372 q
= (unsigned char *) index (p
, ',');
1373 full
= make_string (p
, q
? q
- p
: strlen (p
));
1375 #ifdef AMPERSAND_FULL_NAME
1377 q
= (unsigned char *) index (p
, '&');
1378 /* Substitute the login name for the &, upcasing the first character. */
1381 register unsigned char *r
;
1384 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1385 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1386 memcpy (r
, p
, q
- p
);
1388 strcat (r
, SDATA (login
));
1389 r
[q
- p
] = UPCASE (r
[q
- p
]);
1391 full
= build_string (r
);
1393 #endif /* AMPERSAND_FULL_NAME */
1398 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1399 doc
: /* Return the host name of the machine you are running on, as a string. */)
1402 return Vsystem_name
;
1405 /* For the benefit of callers who don't want to include lisp.h */
1408 get_system_name (void)
1410 if (STRINGP (Vsystem_name
))
1411 return (char *) SDATA (Vsystem_name
);
1417 get_operating_system_release (void)
1419 if (STRINGP (Voperating_system_release
))
1420 return (char *) SDATA (Voperating_system_release
);
1425 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1426 doc
: /* Return the process ID of Emacs, as an integer. */)
1429 return make_number (getpid ());
1432 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1433 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1434 The time is returned as a list of three integers. The first has the
1435 most significant 16 bits of the seconds, while the second has the
1436 least significant 16 bits. The third integer gives the microsecond
1439 The microsecond count is zero on systems that do not provide
1440 resolution finer than a second. */)
1446 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1447 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1448 make_number (EMACS_USECS (t
)));
1451 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1453 doc
: /* Return the current run time used by Emacs.
1454 The time is returned as a list of three integers. The first has the
1455 most significant 16 bits of the seconds, while the second has the
1456 least significant 16 bits. The third integer gives the microsecond
1459 On systems that can't determine the run time, `get-internal-run-time'
1460 does the same thing as `current-time'. The microsecond count is zero
1461 on systems that do not provide resolution finer than a second. */)
1464 #ifdef HAVE_GETRUSAGE
1465 struct rusage usage
;
1468 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1469 /* This shouldn't happen. What action is appropriate? */
1472 /* Sum up user time and system time. */
1473 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1474 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1475 if (usecs
>= 1000000)
1481 return list3 (make_number ((secs
>> 16) & 0xffff),
1482 make_number ((secs
>> 0) & 0xffff),
1483 make_number (usecs
));
1484 #else /* ! HAVE_GETRUSAGE */
1486 return w32_get_internal_run_time ();
1487 #else /* ! WINDOWSNT */
1488 return Fcurrent_time ();
1489 #endif /* WINDOWSNT */
1490 #endif /* HAVE_GETRUSAGE */
1495 lisp_time_argument (Lisp_Object specified_time
, time_t *result
, int *usec
)
1497 if (NILP (specified_time
))
1504 *usec
= EMACS_USECS (t
);
1505 *result
= EMACS_SECS (t
);
1509 return time (result
) != -1;
1513 Lisp_Object high
, low
;
1514 high
= Fcar (specified_time
);
1515 CHECK_NUMBER (high
);
1516 low
= Fcdr (specified_time
);
1521 Lisp_Object usec_l
= Fcdr (low
);
1523 usec_l
= Fcar (usec_l
);
1528 CHECK_NUMBER (usec_l
);
1529 *usec
= XINT (usec_l
);
1537 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1538 return *result
>> 16 == XINT (high
);
1542 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1543 doc
: /* Return the current time, as a float number of seconds since the epoch.
1544 If SPECIFIED-TIME is given, it is the time to convert to float
1545 instead of the current time. The argument should have the form
1546 (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
1547 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1548 have the form (HIGH . LOW), but this is considered obsolete.
1550 WARNING: Since the result is floating point, it may not be exact.
1551 If precise time stamps are required, use either `current-time',
1552 or (if you need time as a string) `format-time-string'. */)
1553 (Lisp_Object specified_time
)
1558 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1559 error ("Invalid time specification");
1561 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1564 /* Write information into buffer S of size MAXSIZE, according to the
1565 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1566 Default to Universal Time if UT is nonzero, local time otherwise.
1567 Return the number of bytes written, not including the terminating
1568 '\0'. If S is NULL, nothing will be written anywhere; so to
1569 determine how many bytes would be written, use NULL for S and
1570 ((size_t) -1) for MAXSIZE.
1572 This function behaves like emacs_strftimeu, except it allows null
1575 emacs_memftimeu (char *s
, size_t maxsize
, const char *format
, size_t format_len
, const struct tm
*tp
, int ut
)
1579 /* Loop through all the null-terminated strings in the format
1580 argument. Normally there's just one null-terminated string, but
1581 there can be arbitrarily many, concatenated together, if the
1582 format contains '\0' bytes. emacs_strftimeu stops at the first
1583 '\0' byte so we must invoke it separately for each such string. */
1592 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1596 if (result
== 0 && s
[0] != '\0')
1601 maxsize
-= result
+ 1;
1603 len
= strlen (format
);
1604 if (len
== format_len
)
1608 format_len
-= len
+ 1;
1612 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1613 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1614 TIME is specified as (HIGH LOW . IGNORED), as returned by
1615 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1616 is also still accepted.
1617 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1618 as Universal Time; nil means describe TIME in the local time zone.
1619 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1620 by text that describes the specified date and time in TIME:
1622 %Y is the year, %y within the century, %C the century.
1623 %G is the year corresponding to the ISO week, %g within the century.
1624 %m is the numeric month.
1625 %b and %h are the locale's abbreviated month name, %B the full name.
1626 %d is the day of the month, zero-padded, %e is blank-padded.
1627 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1628 %a is the locale's abbreviated name of the day of week, %A the full name.
1629 %U is the week number starting on Sunday, %W starting on Monday,
1630 %V according to ISO 8601.
1631 %j is the day of the year.
1633 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1634 only blank-padded, %l is like %I blank-padded.
1635 %p is the locale's equivalent of either AM or PM.
1638 %Z is the time zone name, %z is the numeric form.
1639 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1641 %c is the locale's date and time format.
1642 %x is the locale's "preferred" date format.
1643 %D is like "%m/%d/%y".
1645 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1646 %X is the locale's "preferred" time format.
1648 Finally, %n is a newline, %t is a tab, %% is a literal %.
1650 Certain flags and modifiers are available with some format controls.
1651 The flags are `_', `-', `^' and `#'. For certain characters X,
1652 %_X is like %X, but padded with blanks; %-X is like %X,
1653 but without padding. %^X is like %X, but with all textual
1654 characters up-cased; %#X is like %X, but with letter-case of
1655 all textual characters reversed.
1656 %NX (where N stands for an integer) is like %X,
1657 but takes up at least N (a number) positions.
1658 The modifiers are `E' and `O'. For certain characters X,
1659 %EX is a locale's alternative version of %X;
1660 %OX is like %X, but uses the locale's number symbols.
1662 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1663 (Lisp_Object format_string
, Lisp_Object time
, Lisp_Object universal
)
1668 int ut
= ! NILP (universal
);
1670 CHECK_STRING (format_string
);
1672 if (! lisp_time_argument (time
, &value
, NULL
))
1673 error ("Invalid time specification");
1675 format_string
= code_convert_string_norecord (format_string
,
1676 Vlocale_coding_system
, 1);
1678 /* This is probably enough. */
1679 size
= SBYTES (format_string
) * 6 + 50;
1682 tm
= ut
? gmtime (&value
) : localtime (&value
);
1685 error ("Specified time is not representable");
1687 synchronize_system_time_locale ();
1691 char *buf
= (char *) alloca (size
+ 1);
1696 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1697 SBYTES (format_string
),
1700 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1701 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1702 Vlocale_coding_system
, 0);
1704 /* If buffer was too small, make it bigger and try again. */
1706 result
= emacs_memftimeu (NULL
, (size_t) -1,
1707 SDATA (format_string
),
1708 SBYTES (format_string
),
1715 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1716 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1717 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1718 as from `current-time' and `file-attributes', or nil to use the
1719 current time. The obsolete form (HIGH . LOW) is also still accepted.
1720 The list has the following nine members: SEC is an integer between 0
1721 and 60; SEC is 60 for a leap second, which only some operating systems
1722 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1723 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1724 integer between 1 and 12. YEAR is an integer indicating the
1725 four-digit year. DOW is the day of week, an integer between 0 and 6,
1726 where 0 is Sunday. DST is t if daylight saving time is in effect,
1727 otherwise nil. ZONE is an integer indicating the number of seconds
1728 east of Greenwich. (Note that Common Lisp has different meanings for
1730 (Lisp_Object specified_time
)
1734 struct tm
*decoded_time
;
1735 Lisp_Object list_args
[9];
1737 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1738 error ("Invalid time specification");
1741 decoded_time
= localtime (&time_spec
);
1744 error ("Specified time is not representable");
1745 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1746 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1747 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1748 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1749 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1750 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1751 cast below avoids overflow in int arithmetics. */
1752 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1753 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1754 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1756 /* Make a copy, in case gmtime modifies the struct. */
1757 save_tm
= *decoded_time
;
1759 decoded_time
= gmtime (&time_spec
);
1761 if (decoded_time
== 0)
1762 list_args
[8] = Qnil
;
1764 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1765 return Flist (9, list_args
);
1768 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1769 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1770 This is the reverse operation of `decode-time', which see.
1771 ZONE defaults to the current time zone rule. This can
1772 be a string or t (as from `set-time-zone-rule'), or it can be a list
1773 \(as from `current-time-zone') or an integer (as from `decode-time')
1774 applied without consideration for daylight saving time.
1776 You can pass more than 7 arguments; then the first six arguments
1777 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1778 The intervening arguments are ignored.
1779 This feature lets (apply 'encode-time (decode-time ...)) work.
1781 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1782 for example, a DAY of 0 means the day preceding the given month.
1783 Year numbers less than 100 are treated just like other year numbers.
1784 If you want them to stand for years in this century, you must do that yourself.
1786 Years before 1970 are not guaranteed to work. On some systems,
1787 year values as low as 1901 do work.
1789 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1790 (int nargs
, register Lisp_Object
*args
)
1794 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1796 CHECK_NUMBER (args
[0]); /* second */
1797 CHECK_NUMBER (args
[1]); /* minute */
1798 CHECK_NUMBER (args
[2]); /* hour */
1799 CHECK_NUMBER (args
[3]); /* day */
1800 CHECK_NUMBER (args
[4]); /* month */
1801 CHECK_NUMBER (args
[5]); /* year */
1803 tm
.tm_sec
= XINT (args
[0]);
1804 tm
.tm_min
= XINT (args
[1]);
1805 tm
.tm_hour
= XINT (args
[2]);
1806 tm
.tm_mday
= XINT (args
[3]);
1807 tm
.tm_mon
= XINT (args
[4]) - 1;
1808 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1816 time
= mktime (&tm
);
1823 char **oldenv
= environ
, **newenv
;
1827 else if (STRINGP (zone
))
1828 tzstring
= (char *) SDATA (zone
);
1829 else if (INTEGERP (zone
))
1831 int abszone
= eabs (XINT (zone
));
1832 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1833 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1837 error ("Invalid time zone specification");
1839 /* Set TZ before calling mktime; merely adjusting mktime's returned
1840 value doesn't suffice, since that would mishandle leap seconds. */
1841 set_time_zone_rule (tzstring
);
1844 time
= mktime (&tm
);
1847 /* Restore TZ to previous value. */
1851 #ifdef LOCALTIME_CACHE
1856 if (time
== (time_t) -1)
1857 error ("Specified time is not representable");
1859 return make_time (time
);
1862 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1863 doc
: /* Return the current local time, as a human-readable string.
1864 Programs can use this function to decode a time,
1865 since the number of columns in each field is fixed
1866 if the year is in the range 1000-9999.
1867 The format is `Sun Sep 16 01:03:52 1973'.
1868 However, see also the functions `decode-time' and `format-time-string'
1869 which provide a much more powerful and general facility.
1871 If SPECIFIED-TIME is given, it is a time to format instead of the
1872 current time. The argument should have the form (HIGH LOW . IGNORED).
1873 Thus, you can use times obtained from `current-time' and from
1874 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1875 but this is considered obsolete. */)
1876 (Lisp_Object specified_time
)
1882 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1883 error ("Invalid time specification");
1885 /* Convert to a string, checking for out-of-range time stamps.
1886 Don't use 'ctime', as that might dump core if VALUE is out of
1889 tm
= localtime (&value
);
1891 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1892 error ("Specified time is not representable");
1894 /* Remove the trailing newline. */
1895 tem
[strlen (tem
) - 1] = '\0';
1897 return build_string (tem
);
1900 /* Yield A - B, measured in seconds.
1901 This function is copied from the GNU C Library. */
1903 tm_diff (struct tm
*a
, struct tm
*b
)
1905 /* Compute intervening leap days correctly even if year is negative.
1906 Take care to avoid int overflow in leap day calculations,
1907 but it's OK to assume that A and B are close to each other. */
1908 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1909 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1910 int a100
= a4
/ 25 - (a4
% 25 < 0);
1911 int b100
= b4
/ 25 - (b4
% 25 < 0);
1912 int a400
= a100
>> 2;
1913 int b400
= b100
>> 2;
1914 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1915 int years
= a
->tm_year
- b
->tm_year
;
1916 int days
= (365 * years
+ intervening_leap_days
1917 + (a
->tm_yday
- b
->tm_yday
));
1918 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1919 + (a
->tm_min
- b
->tm_min
))
1920 + (a
->tm_sec
- b
->tm_sec
));
1923 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1924 doc
: /* Return the offset and name for the local time zone.
1925 This returns a list of the form (OFFSET NAME).
1926 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1927 A negative value means west of Greenwich.
1928 NAME is a string giving the name of the time zone.
1929 If SPECIFIED-TIME is given, the time zone offset is determined from it
1930 instead of using the current time. The argument should have the form
1931 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1932 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1933 have the form (HIGH . LOW), but this is considered obsolete.
1935 Some operating systems cannot provide all this information to Emacs;
1936 in this case, `current-time-zone' returns a list containing nil for
1937 the data it can't find. */)
1938 (Lisp_Object specified_time
)
1944 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1949 t
= gmtime (&value
);
1953 t
= localtime (&value
);
1960 int offset
= tm_diff (t
, &gmt
);
1966 s
= (char *)t
->tm_zone
;
1967 #else /* not HAVE_TM_ZONE */
1969 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1970 s
= tzname
[t
->tm_isdst
];
1972 #endif /* not HAVE_TM_ZONE */
1976 /* No local time zone name is available; use "+-NNNN" instead. */
1977 int am
= (offset
< 0 ? -offset
: offset
) / 60;
1978 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
1982 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
1985 return Fmake_list (make_number (2), Qnil
);
1988 /* This holds the value of `environ' produced by the previous
1989 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
1990 has never been called. */
1991 static char **environbuf
;
1993 /* This holds the startup value of the TZ environment variable so it
1994 can be restored if the user calls set-time-zone-rule with a nil
1996 static char *initial_tz
;
1998 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
1999 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
2000 If TZ is nil, use implementation-defined default time zone information.
2001 If TZ is t, use Universal Time. */)
2006 /* When called for the first time, save the original TZ. */
2008 initial_tz
= (char *) getenv ("TZ");
2011 tzstring
= initial_tz
;
2012 else if (EQ (tz
, Qt
))
2017 tzstring
= (char *) SDATA (tz
);
2020 set_time_zone_rule (tzstring
);
2022 environbuf
= environ
;
2027 #ifdef LOCALTIME_CACHE
2029 /* These two values are known to load tz files in buggy implementations,
2030 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2031 Their values shouldn't matter in non-buggy implementations.
2032 We don't use string literals for these strings,
2033 since if a string in the environment is in readonly
2034 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2035 See Sun bugs 1113095 and 1114114, ``Timezone routines
2036 improperly modify environment''. */
2038 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2039 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2043 /* Set the local time zone rule to TZSTRING.
2044 This allocates memory into `environ', which it is the caller's
2045 responsibility to free. */
2048 set_time_zone_rule (const char *tzstring
)
2051 char **from
, **to
, **newenv
;
2053 /* Make the ENVIRON vector longer with room for TZSTRING. */
2054 for (from
= environ
; *from
; from
++)
2056 envptrs
= from
- environ
+ 2;
2057 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2058 + (tzstring
? strlen (tzstring
) + 4 : 0));
2060 /* Add TZSTRING to the end of environ, as a value for TZ. */
2063 char *t
= (char *) (to
+ envptrs
);
2065 strcat (t
, tzstring
);
2069 /* Copy the old environ vector elements into NEWENV,
2070 but don't copy the TZ variable.
2071 So we have only one definition of TZ, which came from TZSTRING. */
2072 for (from
= environ
; *from
; from
++)
2073 if (strncmp (*from
, "TZ=", 3) != 0)
2079 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2080 the TZ variable is stored. If we do not have a TZSTRING,
2081 TO points to the vector slot which has the terminating null. */
2083 #ifdef LOCALTIME_CACHE
2085 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2086 "US/Pacific" that loads a tz file, then changes to a value like
2087 "XXX0" that does not load a tz file, and then changes back to
2088 its original value, the last change is (incorrectly) ignored.
2089 Also, if TZ changes twice in succession to values that do
2090 not load a tz file, tzset can dump core (see Sun bug#1225179).
2091 The following code works around these bugs. */
2095 /* Temporarily set TZ to a value that loads a tz file
2096 and that differs from tzstring. */
2098 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2099 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2105 /* The implied tzstring is unknown, so temporarily set TZ to
2106 two different values that each load a tz file. */
2107 *to
= set_time_zone_rule_tz1
;
2110 *to
= set_time_zone_rule_tz2
;
2115 /* Now TZ has the desired value, and tzset can be invoked safely. */
2122 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2123 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2124 type of object is Lisp_String). INHERIT is passed to
2125 INSERT_FROM_STRING_FUNC as the last argument. */
2128 general_insert_function (void (*insert_func
)
2129 (const unsigned char *, EMACS_INT
),
2130 void (*insert_from_string_func
)
2131 (Lisp_Object
, EMACS_INT
, EMACS_INT
,
2132 EMACS_INT
, EMACS_INT
, int),
2133 int inherit
, int nargs
, Lisp_Object
*args
)
2135 register int argnum
;
2136 register Lisp_Object val
;
2138 for (argnum
= 0; argnum
< nargs
; argnum
++)
2141 if (CHARACTERP (val
))
2143 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2146 if (!NILP (current_buffer
->enable_multibyte_characters
))
2147 len
= CHAR_STRING (XFASTINT (val
), str
);
2150 str
[0] = (ASCII_CHAR_P (XINT (val
))
2152 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2155 (*insert_func
) (str
, len
);
2157 else if (STRINGP (val
))
2159 (*insert_from_string_func
) (val
, 0, 0,
2165 wrong_type_argument (Qchar_or_string_p
, val
);
2170 insert1 (Lisp_Object arg
)
2176 /* Callers passing one argument to Finsert need not gcpro the
2177 argument "array", since the only element of the array will
2178 not be used after calling insert or insert_from_string, so
2179 we don't care if it gets trashed. */
2181 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2182 doc
: /* Insert the arguments, either strings or characters, at point.
2183 Point and before-insertion markers move forward to end up
2184 after the inserted text.
2185 Any other markers at the point of insertion remain before the text.
2187 If the current buffer is multibyte, unibyte strings are converted
2188 to multibyte for insertion (see `string-make-multibyte').
2189 If the current buffer is unibyte, multibyte strings are converted
2190 to unibyte for insertion (see `string-make-unibyte').
2192 When operating on binary data, it may be necessary to preserve the
2193 original bytes of a unibyte string when inserting it into a multibyte
2194 buffer; to accomplish this, apply `string-as-multibyte' to the string
2195 and insert the result.
2197 usage: (insert &rest ARGS) */)
2198 (int nargs
, register Lisp_Object
*args
)
2200 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2204 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2206 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2207 Point and before-insertion markers move forward to end up
2208 after the inserted text.
2209 Any other markers at the point of insertion remain before the text.
2211 If the current buffer is multibyte, unibyte strings are converted
2212 to multibyte for insertion (see `unibyte-char-to-multibyte').
2213 If the current buffer is unibyte, multibyte strings are converted
2214 to unibyte for insertion.
2216 usage: (insert-and-inherit &rest ARGS) */)
2217 (int nargs
, register Lisp_Object
*args
)
2219 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2224 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2225 doc
: /* Insert strings or characters at point, relocating markers after the text.
2226 Point and markers move forward to end up after the inserted text.
2228 If the current buffer is multibyte, unibyte strings are converted
2229 to multibyte for insertion (see `unibyte-char-to-multibyte').
2230 If the current buffer is unibyte, multibyte strings are converted
2231 to unibyte for insertion.
2233 usage: (insert-before-markers &rest ARGS) */)
2234 (int nargs
, register Lisp_Object
*args
)
2236 general_insert_function (insert_before_markers
,
2237 insert_from_string_before_markers
, 0,
2242 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2243 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2244 doc
: /* Insert text at point, relocating markers and inheriting properties.
2245 Point and markers move forward to end up after the inserted text.
2247 If the current buffer is multibyte, unibyte strings are converted
2248 to multibyte for insertion (see `unibyte-char-to-multibyte').
2249 If the current buffer is unibyte, multibyte strings are converted
2250 to unibyte for insertion.
2252 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2253 (int nargs
, register Lisp_Object
*args
)
2255 general_insert_function (insert_before_markers_and_inherit
,
2256 insert_from_string_before_markers
, 1,
2261 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2262 doc
: /* Insert COUNT copies of CHARACTER.
2263 Point, and before-insertion markers, are relocated as in the function `insert'.
2264 The optional third arg INHERIT, if non-nil, says to inherit text properties
2265 from adjoining text, if those properties are sticky. */)
2266 (Lisp_Object character
, Lisp_Object count
, Lisp_Object inherit
)
2268 register unsigned char *string
;
2269 register int strlen
;
2272 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2274 CHECK_NUMBER (character
);
2275 CHECK_NUMBER (count
);
2277 if (!NILP (current_buffer
->enable_multibyte_characters
))
2278 len
= CHAR_STRING (XFASTINT (character
), str
);
2280 str
[0] = XFASTINT (character
), len
= 1;
2281 n
= XINT (count
) * len
;
2284 strlen
= min (n
, 256 * len
);
2285 string
= (unsigned char *) alloca (strlen
);
2286 for (i
= 0; i
< strlen
; i
++)
2287 string
[i
] = str
[i
% len
];
2291 if (!NILP (inherit
))
2292 insert_and_inherit (string
, strlen
);
2294 insert (string
, strlen
);
2299 if (!NILP (inherit
))
2300 insert_and_inherit (string
, n
);
2307 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2308 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2309 Both arguments are required.
2310 BYTE is a number of the range 0..255.
2312 If BYTE is 128..255 and the current buffer is multibyte, the
2313 corresponding eight-bit character is inserted.
2315 Point, and before-insertion markers, are relocated as in the function `insert'.
2316 The optional third arg INHERIT, if non-nil, says to inherit text properties
2317 from adjoining text, if those properties are sticky. */)
2318 (Lisp_Object byte
, Lisp_Object count
, Lisp_Object inherit
)
2320 CHECK_NUMBER (byte
);
2321 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2322 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2323 if (XINT (byte
) >= 128
2324 && ! NILP (current_buffer
->enable_multibyte_characters
))
2325 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2326 return Finsert_char (byte
, count
, inherit
);
2330 /* Making strings from buffer contents. */
2332 /* Return a Lisp_String containing the text of the current buffer from
2333 START to END. If text properties are in use and the current buffer
2334 has properties in the range specified, the resulting string will also
2335 have them, if PROPS is nonzero.
2337 We don't want to use plain old make_string here, because it calls
2338 make_uninit_string, which can cause the buffer arena to be
2339 compacted. make_string has no way of knowing that the data has
2340 been moved, and thus copies the wrong data into the string. This
2341 doesn't effect most of the other users of make_string, so it should
2342 be left as is. But we should use this function when conjuring
2343 buffer substrings. */
2346 make_buffer_string (int start
, int end
, int props
)
2348 int start_byte
= CHAR_TO_BYTE (start
);
2349 int end_byte
= CHAR_TO_BYTE (end
);
2351 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2354 /* Return a Lisp_String containing the text of the current buffer from
2355 START / START_BYTE to END / END_BYTE.
2357 If text properties are in use and the current buffer
2358 has properties in the range specified, the resulting string will also
2359 have them, if PROPS is nonzero.
2361 We don't want to use plain old make_string here, because it calls
2362 make_uninit_string, which can cause the buffer arena to be
2363 compacted. make_string has no way of knowing that the data has
2364 been moved, and thus copies the wrong data into the string. This
2365 doesn't effect most of the other users of make_string, so it should
2366 be left as is. But we should use this function when conjuring
2367 buffer substrings. */
2370 make_buffer_string_both (int start
, int start_byte
, int end
, int end_byte
, int props
)
2372 Lisp_Object result
, tem
, tem1
;
2374 if (start
< GPT
&& GPT
< end
)
2377 if (! NILP (current_buffer
->enable_multibyte_characters
))
2378 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2380 result
= make_uninit_string (end
- start
);
2381 memcpy (SDATA (result
), BYTE_POS_ADDR (start_byte
), end_byte
- start_byte
);
2383 /* If desired, update and copy the text properties. */
2386 update_buffer_properties (start
, end
);
2388 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2389 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2391 if (XINT (tem
) != end
|| !NILP (tem1
))
2392 copy_intervals_to_string (result
, current_buffer
, start
,
2399 /* Call Vbuffer_access_fontify_functions for the range START ... END
2400 in the current buffer, if necessary. */
2403 update_buffer_properties (int start
, int end
)
2405 /* If this buffer has some access functions,
2406 call them, specifying the range of the buffer being accessed. */
2407 if (!NILP (Vbuffer_access_fontify_functions
))
2409 Lisp_Object args
[3];
2412 args
[0] = Qbuffer_access_fontify_functions
;
2413 XSETINT (args
[1], start
);
2414 XSETINT (args
[2], end
);
2416 /* But don't call them if we can tell that the work
2417 has already been done. */
2418 if (!NILP (Vbuffer_access_fontified_property
))
2420 tem
= Ftext_property_any (args
[1], args
[2],
2421 Vbuffer_access_fontified_property
,
2424 Frun_hook_with_args (3, args
);
2427 Frun_hook_with_args (3, args
);
2431 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2432 doc
: /* Return the contents of part of the current buffer as a string.
2433 The two arguments START and END are character positions;
2434 they can be in either order.
2435 The string returned is multibyte if the buffer is multibyte.
2437 This function copies the text properties of that part of the buffer
2438 into the result string; if you don't want the text properties,
2439 use `buffer-substring-no-properties' instead. */)
2440 (Lisp_Object start
, Lisp_Object end
)
2444 validate_region (&start
, &end
);
2448 return make_buffer_string (b
, e
, 1);
2451 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2452 Sbuffer_substring_no_properties
, 2, 2, 0,
2453 doc
: /* Return the characters of part of the buffer, without the text properties.
2454 The two arguments START and END are character positions;
2455 they can be in either order. */)
2456 (Lisp_Object start
, Lisp_Object end
)
2460 validate_region (&start
, &end
);
2464 return make_buffer_string (b
, e
, 0);
2467 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2468 doc
: /* Return the contents of the current buffer as a string.
2469 If narrowing is in effect, this function returns only the visible part
2473 return make_buffer_string (BEGV
, ZV
, 1);
2476 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2478 doc
: /* Insert before point a substring of the contents of BUFFER.
2479 BUFFER may be a buffer or a buffer name.
2480 Arguments START and END are character positions specifying the substring.
2481 They default to the values of (point-min) and (point-max) in BUFFER. */)
2482 (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
2484 register int b
, e
, temp
;
2485 register struct buffer
*bp
, *obuf
;
2488 buf
= Fget_buffer (buffer
);
2492 if (NILP (bp
->name
))
2493 error ("Selecting deleted buffer");
2499 CHECK_NUMBER_COERCE_MARKER (start
);
2506 CHECK_NUMBER_COERCE_MARKER (end
);
2511 temp
= b
, b
= e
, e
= temp
;
2513 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2514 args_out_of_range (start
, end
);
2516 obuf
= current_buffer
;
2517 set_buffer_internal_1 (bp
);
2518 update_buffer_properties (b
, e
);
2519 set_buffer_internal_1 (obuf
);
2521 insert_from_buffer (bp
, b
, e
- b
, 0);
2525 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2527 doc
: /* Compare two substrings of two buffers; return result as number.
2528 the value is -N if first string is less after N-1 chars,
2529 +N if first string is greater after N-1 chars, or 0 if strings match.
2530 Each substring is represented as three arguments: BUFFER, START and END.
2531 That makes six args in all, three for each substring.
2533 The value of `case-fold-search' in the current buffer
2534 determines whether case is significant or ignored. */)
2535 (Lisp_Object buffer1
, Lisp_Object start1
, Lisp_Object end1
, Lisp_Object buffer2
, Lisp_Object start2
, Lisp_Object end2
)
2537 register int begp1
, endp1
, begp2
, endp2
, temp
;
2538 register struct buffer
*bp1
, *bp2
;
2539 register Lisp_Object trt
2540 = (!NILP (current_buffer
->case_fold_search
)
2541 ? current_buffer
->case_canon_table
: Qnil
);
2543 int i1
, i2
, i1_byte
, i2_byte
;
2545 /* Find the first buffer and its substring. */
2548 bp1
= current_buffer
;
2552 buf1
= Fget_buffer (buffer1
);
2555 bp1
= XBUFFER (buf1
);
2556 if (NILP (bp1
->name
))
2557 error ("Selecting deleted buffer");
2561 begp1
= BUF_BEGV (bp1
);
2564 CHECK_NUMBER_COERCE_MARKER (start1
);
2565 begp1
= XINT (start1
);
2568 endp1
= BUF_ZV (bp1
);
2571 CHECK_NUMBER_COERCE_MARKER (end1
);
2572 endp1
= XINT (end1
);
2576 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2578 if (!(BUF_BEGV (bp1
) <= begp1
2580 && endp1
<= BUF_ZV (bp1
)))
2581 args_out_of_range (start1
, end1
);
2583 /* Likewise for second substring. */
2586 bp2
= current_buffer
;
2590 buf2
= Fget_buffer (buffer2
);
2593 bp2
= XBUFFER (buf2
);
2594 if (NILP (bp2
->name
))
2595 error ("Selecting deleted buffer");
2599 begp2
= BUF_BEGV (bp2
);
2602 CHECK_NUMBER_COERCE_MARKER (start2
);
2603 begp2
= XINT (start2
);
2606 endp2
= BUF_ZV (bp2
);
2609 CHECK_NUMBER_COERCE_MARKER (end2
);
2610 endp2
= XINT (end2
);
2614 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2616 if (!(BUF_BEGV (bp2
) <= begp2
2618 && endp2
<= BUF_ZV (bp2
)))
2619 args_out_of_range (start2
, end2
);
2623 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2624 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2626 while (i1
< endp1
&& i2
< endp2
)
2628 /* When we find a mismatch, we must compare the
2629 characters, not just the bytes. */
2634 if (! NILP (bp1
->enable_multibyte_characters
))
2636 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2637 BUF_INC_POS (bp1
, i1_byte
);
2642 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2643 MAKE_CHAR_MULTIBYTE (c1
);
2647 if (! NILP (bp2
->enable_multibyte_characters
))
2649 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2650 BUF_INC_POS (bp2
, i2_byte
);
2655 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2656 MAKE_CHAR_MULTIBYTE (c2
);
2662 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2663 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2666 return make_number (- 1 - chars
);
2668 return make_number (chars
+ 1);
2673 /* The strings match as far as they go.
2674 If one is shorter, that one is less. */
2675 if (chars
< endp1
- begp1
)
2676 return make_number (chars
+ 1);
2677 else if (chars
< endp2
- begp2
)
2678 return make_number (- chars
- 1);
2680 /* Same length too => they are equal. */
2681 return make_number (0);
2685 subst_char_in_region_unwind (Lisp_Object arg
)
2687 return current_buffer
->undo_list
= arg
;
2691 subst_char_in_region_unwind_1 (Lisp_Object arg
)
2693 return current_buffer
->filename
= arg
;
2696 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2697 Ssubst_char_in_region
, 4, 5, 0,
2698 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2699 If optional arg NOUNDO is non-nil, don't record this change for undo
2700 and don't mark the buffer as really changed.
2701 Both characters must have the same length of multi-byte form. */)
2702 (Lisp_Object start
, Lisp_Object end
, Lisp_Object fromchar
, Lisp_Object tochar
, Lisp_Object noundo
)
2704 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2705 /* Keep track of the first change in the buffer:
2706 if 0 we haven't found it yet.
2707 if < 0 we've found it and we've run the before-change-function.
2708 if > 0 we've actually performed it and the value is its position. */
2710 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2712 int count
= SPECPDL_INDEX ();
2713 #define COMBINING_NO 0
2714 #define COMBINING_BEFORE 1
2715 #define COMBINING_AFTER 2
2716 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2717 int maybe_byte_combining
= COMBINING_NO
;
2718 int last_changed
= 0;
2719 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2723 validate_region (&start
, &end
);
2724 CHECK_NUMBER (fromchar
);
2725 CHECK_NUMBER (tochar
);
2729 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2730 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2731 error ("Characters in `subst-char-in-region' have different byte-lengths");
2732 if (!ASCII_BYTE_P (*tostr
))
2734 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2735 complete multibyte character, it may be combined with the
2736 after bytes. If it is in the range 0xA0..0xFF, it may be
2737 combined with the before and after bytes. */
2738 if (!CHAR_HEAD_P (*tostr
))
2739 maybe_byte_combining
= COMBINING_BOTH
;
2740 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2741 maybe_byte_combining
= COMBINING_AFTER
;
2747 fromstr
[0] = XFASTINT (fromchar
);
2748 tostr
[0] = XFASTINT (tochar
);
2752 pos_byte
= CHAR_TO_BYTE (pos
);
2753 stop
= CHAR_TO_BYTE (XINT (end
));
2756 /* If we don't want undo, turn off putting stuff on the list.
2757 That's faster than getting rid of things,
2758 and it prevents even the entry for a first change.
2759 Also inhibit locking the file. */
2760 if (!changed
&& !NILP (noundo
))
2762 record_unwind_protect (subst_char_in_region_unwind
,
2763 current_buffer
->undo_list
);
2764 current_buffer
->undo_list
= Qt
;
2765 /* Don't do file-locking. */
2766 record_unwind_protect (subst_char_in_region_unwind_1
,
2767 current_buffer
->filename
);
2768 current_buffer
->filename
= Qnil
;
2771 if (pos_byte
< GPT_BYTE
)
2772 stop
= min (stop
, GPT_BYTE
);
2775 int pos_byte_next
= pos_byte
;
2777 if (pos_byte
>= stop
)
2779 if (pos_byte
>= end_byte
) break;
2782 p
= BYTE_POS_ADDR (pos_byte
);
2784 INC_POS (pos_byte_next
);
2787 if (pos_byte_next
- pos_byte
== len
2788 && p
[0] == fromstr
[0]
2790 || (p
[1] == fromstr
[1]
2791 && (len
== 2 || (p
[2] == fromstr
[2]
2792 && (len
== 3 || p
[3] == fromstr
[3]))))))
2795 /* We've already seen this and run the before-change-function;
2796 this time we only need to record the actual position. */
2801 modify_region (current_buffer
, pos
, XINT (end
), 0);
2803 if (! NILP (noundo
))
2805 if (MODIFF
- 1 == SAVE_MODIFF
)
2807 if (MODIFF
- 1 == BUF_AUTOSAVE_MODIFF (current_buffer
))
2808 BUF_AUTOSAVE_MODIFF (current_buffer
)++;
2811 /* The before-change-function may have moved the gap
2812 or even modified the buffer so we should start over. */
2816 /* Take care of the case where the new character
2817 combines with neighboring bytes. */
2818 if (maybe_byte_combining
2819 && (maybe_byte_combining
== COMBINING_AFTER
2820 ? (pos_byte_next
< Z_BYTE
2821 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2822 : ((pos_byte_next
< Z_BYTE
2823 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2824 || (pos_byte
> BEG_BYTE
2825 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2827 Lisp_Object tem
, string
;
2829 struct gcpro gcpro1
;
2831 tem
= current_buffer
->undo_list
;
2834 /* Make a multibyte string containing this single character. */
2835 string
= make_multibyte_string (tostr
, 1, len
);
2836 /* replace_range is less efficient, because it moves the gap,
2837 but it handles combining correctly. */
2838 replace_range (pos
, pos
+ 1, string
,
2840 pos_byte_next
= CHAR_TO_BYTE (pos
);
2841 if (pos_byte_next
> pos_byte
)
2842 /* Before combining happened. We should not increment
2843 POS. So, to cancel the later increment of POS,
2847 INC_POS (pos_byte_next
);
2849 if (! NILP (noundo
))
2850 current_buffer
->undo_list
= tem
;
2857 record_change (pos
, 1);
2858 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2860 last_changed
= pos
+ 1;
2862 pos_byte
= pos_byte_next
;
2868 signal_after_change (changed
,
2869 last_changed
- changed
, last_changed
- changed
);
2870 update_compositions (changed
, last_changed
, CHECK_ALL
);
2873 unbind_to (count
, Qnil
);
2878 static Lisp_Object
check_translation (int, int, int, Lisp_Object
);
2880 /* Helper function for Ftranslate_region_internal.
2882 Check if a character sequence at POS (POS_BYTE) matches an element
2883 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2884 element is found, return it. Otherwise return Qnil. */
2887 check_translation (int pos
, int pos_byte
, int end
, Lisp_Object val
)
2889 int buf_size
= 16, buf_used
= 0;
2890 int *buf
= alloca (sizeof (int) * buf_size
);
2892 for (; CONSP (val
); val
= XCDR (val
))
2901 if (! VECTORP (elt
))
2904 if (len
<= end
- pos
)
2906 for (i
= 0; i
< len
; i
++)
2910 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2913 if (buf_used
== buf_size
)
2918 newbuf
= alloca (sizeof (int) * buf_size
);
2919 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2922 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, len
);
2925 if (XINT (AREF (elt
, i
)) != buf
[i
])
2936 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
2937 Stranslate_region_internal
, 3, 3, 0,
2938 doc
: /* Internal use only.
2939 From START to END, translate characters according to TABLE.
2940 TABLE is a string or a char-table; the Nth character in it is the
2941 mapping for the character with code N.
2942 It returns the number of characters changed. */)
2943 (Lisp_Object start
, Lisp_Object end
, register Lisp_Object table
)
2945 register unsigned char *tt
; /* Trans table. */
2946 register int nc
; /* New character. */
2947 int cnt
; /* Number of changes made. */
2948 int size
; /* Size of translate table. */
2949 int pos
, pos_byte
, end_pos
;
2950 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2951 int string_multibyte
;
2954 validate_region (&start
, &end
);
2955 if (CHAR_TABLE_P (table
))
2957 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
2958 error ("Not a translation table");
2964 CHECK_STRING (table
);
2966 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
2967 table
= string_make_unibyte (table
);
2968 string_multibyte
= SCHARS (table
) < SBYTES (table
);
2969 size
= SBYTES (table
);
2974 pos_byte
= CHAR_TO_BYTE (pos
);
2975 end_pos
= XINT (end
);
2976 modify_region (current_buffer
, pos
, end_pos
, 0);
2979 for (; pos
< end_pos
; )
2981 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2982 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
2988 oc
= STRING_CHAR_AND_LENGTH (p
, len
);
2995 /* Reload as signal_after_change in last iteration may GC. */
2997 if (string_multibyte
)
2999 str
= tt
+ string_char_to_byte (table
, oc
);
3000 nc
= STRING_CHAR_AND_LENGTH (str
, str_len
);
3005 if (! ASCII_BYTE_P (nc
) && multibyte
)
3007 str_len
= BYTE8_STRING (nc
, buf
);
3022 val
= CHAR_TABLE_REF (table
, oc
);
3023 if (CHARACTERP (val
)
3024 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3027 str_len
= CHAR_STRING (nc
, buf
);
3030 else if (VECTORP (val
) || (CONSP (val
)))
3032 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3033 where TO is TO-CHAR or [TO-CHAR ...]. */
3038 if (nc
!= oc
&& nc
>= 0)
3040 /* Simple one char to one char translation. */
3045 /* This is less efficient, because it moves the gap,
3046 but it should handle multibyte characters correctly. */
3047 string
= make_multibyte_string (str
, 1, str_len
);
3048 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3053 record_change (pos
, 1);
3054 while (str_len
-- > 0)
3056 signal_after_change (pos
, 1, 1);
3057 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3067 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3074 /* VAL is ([FROM-CHAR ...] . TO). */
3075 len
= ASIZE (XCAR (val
));
3083 string
= Fconcat (1, &val
);
3087 string
= Fmake_string (make_number (1), val
);
3089 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3090 pos_byte
+= SBYTES (string
);
3091 pos
+= SCHARS (string
);
3092 cnt
+= SCHARS (string
);
3093 end_pos
+= SCHARS (string
) - len
;
3101 return make_number (cnt
);
3104 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3105 doc
: /* Delete the text between point and mark.
3107 When called from a program, expects two arguments,
3108 positions (integers or markers) specifying the stretch to be deleted. */)
3109 (Lisp_Object start
, Lisp_Object end
)
3111 validate_region (&start
, &end
);
3112 del_range (XINT (start
), XINT (end
));
3116 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3117 Sdelete_and_extract_region
, 2, 2, 0,
3118 doc
: /* Delete the text between START and END and return it. */)
3119 (Lisp_Object start
, Lisp_Object end
)
3121 validate_region (&start
, &end
);
3122 if (XINT (start
) == XINT (end
))
3123 return empty_unibyte_string
;
3124 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3127 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3128 doc
: /* Remove restrictions (narrowing) from current buffer.
3129 This allows the buffer's full text to be seen and edited. */)
3132 if (BEG
!= BEGV
|| Z
!= ZV
)
3133 current_buffer
->clip_changed
= 1;
3135 BEGV_BYTE
= BEG_BYTE
;
3136 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3137 /* Changing the buffer bounds invalidates any recorded current column. */
3138 invalidate_current_column ();
3142 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3143 doc
: /* Restrict editing in this buffer to the current region.
3144 The rest of the text becomes temporarily invisible and untouchable
3145 but is not deleted; if you save the buffer in a file, the invisible
3146 text is included in the file. \\[widen] makes all visible again.
3147 See also `save-restriction'.
3149 When calling from a program, pass two arguments; positions (integers
3150 or markers) bounding the text that should remain visible. */)
3151 (register Lisp_Object start
, Lisp_Object end
)
3153 CHECK_NUMBER_COERCE_MARKER (start
);
3154 CHECK_NUMBER_COERCE_MARKER (end
);
3156 if (XINT (start
) > XINT (end
))
3159 tem
= start
; start
= end
; end
= tem
;
3162 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3163 args_out_of_range (start
, end
);
3165 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3166 current_buffer
->clip_changed
= 1;
3168 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3169 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3170 if (PT
< XFASTINT (start
))
3171 SET_PT (XFASTINT (start
));
3172 if (PT
> XFASTINT (end
))
3173 SET_PT (XFASTINT (end
));
3174 /* Changing the buffer bounds invalidates any recorded current column. */
3175 invalidate_current_column ();
3180 save_restriction_save (void)
3182 if (BEGV
== BEG
&& ZV
== Z
)
3183 /* The common case that the buffer isn't narrowed.
3184 We return just the buffer object, which save_restriction_restore
3185 recognizes as meaning `no restriction'. */
3186 return Fcurrent_buffer ();
3188 /* We have to save a restriction, so return a pair of markers, one
3189 for the beginning and one for the end. */
3191 Lisp_Object beg
, end
;
3193 beg
= buildmark (BEGV
, BEGV_BYTE
);
3194 end
= buildmark (ZV
, ZV_BYTE
);
3196 /* END must move forward if text is inserted at its exact location. */
3197 XMARKER(end
)->insertion_type
= 1;
3199 return Fcons (beg
, end
);
3204 save_restriction_restore (Lisp_Object data
)
3206 struct buffer
*cur
= NULL
;
3207 struct buffer
*buf
= (CONSP (data
)
3208 ? XMARKER (XCAR (data
))->buffer
3211 if (buf
&& buf
!= current_buffer
&& !NILP (buf
->pt_marker
))
3212 { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
3213 is the case if it is or has an indirect buffer), then make
3214 sure it is current before we update BEGV, so
3215 set_buffer_internal takes care of managing those markers. */
3216 cur
= current_buffer
;
3217 set_buffer_internal (buf
);
3221 /* A pair of marks bounding a saved restriction. */
3223 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3224 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3225 eassert (buf
== end
->buffer
);
3227 if (buf
/* Verify marker still points to a buffer. */
3228 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3229 /* The restriction has changed from the saved one, so restore
3230 the saved restriction. */
3232 int pt
= BUF_PT (buf
);
3234 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3235 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3237 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3238 /* The point is outside the new visible range, move it inside. */
3239 SET_BUF_PT_BOTH (buf
,
3240 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3241 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3244 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3248 /* A buffer, which means that there was no old restriction. */
3250 if (buf
/* Verify marker still points to a buffer. */
3251 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3252 /* The buffer has been narrowed, get rid of the narrowing. */
3254 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3255 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3257 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3262 set_buffer_internal (cur
);
3267 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3268 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3269 The buffer's restrictions make parts of the beginning and end invisible.
3270 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3271 This special form, `save-restriction', saves the current buffer's restrictions
3272 when it is entered, and restores them when it is exited.
3273 So any `narrow-to-region' within BODY lasts only until the end of the form.
3274 The old restrictions settings are restored
3275 even in case of abnormal exit (throw or error).
3277 The value returned is the value of the last form in BODY.
3279 Note: if you are using both `save-excursion' and `save-restriction',
3280 use `save-excursion' outermost:
3281 (save-excursion (save-restriction ...))
3283 usage: (save-restriction &rest BODY) */)
3286 register Lisp_Object val
;
3287 int count
= SPECPDL_INDEX ();
3289 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3290 val
= Fprogn (body
);
3291 return unbind_to (count
, val
);
3294 /* Buffer for the most recent text displayed by Fmessage_box. */
3295 static char *message_text
;
3297 /* Allocated length of that buffer. */
3298 static int message_length
;
3300 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3301 doc
: /* Display a message at the bottom of the screen.
3302 The message also goes into the `*Messages*' buffer.
3303 \(In keyboard macros, that's all it does.)
3306 The first argument is a format control string, and the rest are data
3307 to be formatted under control of the string. See `format' for details.
3309 Note: Use (message "%s" VALUE) to print the value of expressions and
3310 variables to avoid accidentally interpreting `%' as format specifiers.
3312 If the first argument is nil or the empty string, the function clears
3313 any existing message; this lets the minibuffer contents show. See
3314 also `current-message'.
3316 usage: (message FORMAT-STRING &rest ARGS) */)
3317 (int nargs
, Lisp_Object
*args
)
3320 || (STRINGP (args
[0])
3321 && SBYTES (args
[0]) == 0))
3328 register Lisp_Object val
;
3329 val
= Fformat (nargs
, args
);
3330 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3335 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3336 doc
: /* Display a message, in a dialog box if possible.
3337 If a dialog box is not available, use the echo area.
3338 The first argument is a format control string, and the rest are data
3339 to be formatted under control of the string. See `format' for details.
3341 If the first argument is nil or the empty string, clear any existing
3342 message; let the minibuffer contents show.
3344 usage: (message-box FORMAT-STRING &rest ARGS) */)
3345 (int nargs
, Lisp_Object
*args
)
3354 register Lisp_Object val
;
3355 val
= Fformat (nargs
, args
);
3357 /* The MS-DOS frames support popup menus even though they are
3358 not FRAME_WINDOW_P. */
3359 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3360 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3362 Lisp_Object pane
, menu
, obj
;
3363 struct gcpro gcpro1
;
3364 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3366 menu
= Fcons (val
, pane
);
3367 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3371 #endif /* HAVE_MENUS */
3372 /* Copy the data so that it won't move when we GC. */
3375 message_text
= (char *)xmalloc (80);
3376 message_length
= 80;
3378 if (SBYTES (val
) > message_length
)
3380 message_length
= SBYTES (val
);
3381 message_text
= (char *)xrealloc (message_text
, message_length
);
3383 memcpy (message_text
, SDATA (val
), SBYTES (val
));
3384 message2 (message_text
, SBYTES (val
),
3385 STRING_MULTIBYTE (val
));
3390 extern Lisp_Object last_nonmenu_event
;
3393 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3394 doc
: /* Display a message in a dialog box or in the echo area.
3395 If this command was invoked with the mouse, use a dialog box if
3396 `use-dialog-box' is non-nil.
3397 Otherwise, use the echo area.
3398 The first argument is a format control string, and the rest are data
3399 to be formatted under control of the string. See `format' for details.
3401 If the first argument is nil or the empty string, clear any existing
3402 message; let the minibuffer contents show.
3404 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3405 (int nargs
, Lisp_Object
*args
)
3408 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3410 return Fmessage_box (nargs
, args
);
3412 return Fmessage (nargs
, args
);
3415 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3416 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3419 return current_message ();
3423 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3424 doc
: /* Return a copy of STRING with text properties added.
3425 First argument is the string to copy.
3426 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3427 properties to add to the result.
3428 usage: (propertize STRING &rest PROPERTIES) */)
3429 (int nargs
, Lisp_Object
*args
)
3431 Lisp_Object properties
, string
;
3432 struct gcpro gcpro1
, gcpro2
;
3435 /* Number of args must be odd. */
3436 if ((nargs
& 1) == 0 || nargs
< 1)
3437 error ("Wrong number of arguments");
3439 properties
= string
= Qnil
;
3440 GCPRO2 (properties
, string
);
3442 /* First argument must be a string. */
3443 CHECK_STRING (args
[0]);
3444 string
= Fcopy_sequence (args
[0]);
3446 for (i
= 1; i
< nargs
; i
+= 2)
3447 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3449 Fadd_text_properties (make_number (0),
3450 make_number (SCHARS (string
)),
3451 properties
, string
);
3452 RETURN_UNGCPRO (string
);
3456 /* Number of bytes that STRING will occupy when put into the result.
3457 MULTIBYTE is nonzero if the result should be multibyte. */
3459 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3460 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3461 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3464 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3465 doc
: /* Format a string out of a format-string and arguments.
3466 The first argument is a format control string.
3467 The other arguments are substituted into it to make the result, a string.
3469 The format control string may contain %-sequences meaning to substitute
3470 the next available argument:
3472 %s means print a string argument. Actually, prints any object, with `princ'.
3473 %d means print as number in decimal (%o octal, %x hex).
3474 %X is like %x, but uses upper case.
3475 %e means print a number in exponential notation.
3476 %f means print a number in decimal-point notation.
3477 %g means print a number in exponential notation
3478 or decimal-point notation, whichever uses fewer characters.
3479 %c means print a number as a single character.
3480 %S means print any object as an s-expression (using `prin1').
3482 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3483 Use %% to put a single % into the output.
3485 A %-sequence may contain optional flag, width, and precision
3486 specifiers, as follows:
3488 %<flags><width><precision>character
3490 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3492 The + flag character inserts a + before any positive number, while a
3493 space inserts a space before any positive number; these flags only
3494 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3495 The # flag means to use an alternate display form for %o, %x, %X, %e,
3496 %f, and %g sequences. The - and 0 flags affect the width specifier,
3499 The width specifier supplies a lower limit for the length of the
3500 printed representation. The padding, if any, normally goes on the
3501 left, but it goes on the right if the - flag is present. The padding
3502 character is normally a space, but it is 0 if the 0 flag is present.
3503 The - flag takes precedence over the 0 flag.
3505 For %e, %f, and %g sequences, the number after the "." in the
3506 precision specifier says how many decimal places to show; if zero, the
3507 decimal point itself is omitted. For %s and %S, the precision
3508 specifier truncates the string to the given width.
3510 usage: (format STRING &rest OBJECTS) */)
3511 (int nargs
, register Lisp_Object
*args
)
3513 register int n
; /* The number of the next arg to substitute */
3514 register int total
; /* An estimate of the final length */
3516 register unsigned char *format
, *end
, *format_start
;
3518 /* Nonzero if the output should be a multibyte string,
3519 which is true if any of the inputs is one. */
3521 /* When we make a multibyte string, we must pay attention to the
3522 byte combining problem, i.e., a byte may be combined with a
3523 multibyte charcter of the previous string. This flag tells if we
3524 must consider such a situation or not. */
3525 int maybe_combine_byte
;
3526 unsigned char *this_format
;
3527 /* Precision for each spec, or -1, a flag value meaning no precision
3528 was given in that spec. Element 0, corresonding to the format
3529 string itself, will not be used. Element NARGS, corresponding to
3530 no argument, *will* be assigned to in the case that a `%' and `.'
3531 occur after the final format specifier. */
3532 int *precision
= (int *) (alloca ((nargs
+ 1) * sizeof (int)));
3535 int arg_intervals
= 0;
3538 /* discarded[I] is 1 if byte I of the format
3539 string was not copied into the output.
3540 It is 2 if byte I was not the first byte of its character. */
3541 char *discarded
= 0;
3543 /* Each element records, for one argument,
3544 the start and end bytepos in the output string,
3545 and whether the argument is a string with intervals.
3546 info[0] is unused. Unused elements have -1 for start. */
3549 int start
, end
, intervals
;
3552 /* It should not be necessary to GCPRO ARGS, because
3553 the caller in the interpreter should take care of that. */
3555 /* Try to determine whether the result should be multibyte.
3556 This is not always right; sometimes the result needs to be multibyte
3557 because of an object that we will pass through prin1,
3558 and in that case, we won't know it here. */
3559 for (n
= 0; n
< nargs
; n
++)
3561 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3563 /* Piggyback on this loop to initialize precision[N]. */
3566 precision
[nargs
] = -1;
3568 CHECK_STRING (args
[0]);
3569 /* We may have to change "%S" to "%s". */
3570 args
[0] = Fcopy_sequence (args
[0]);
3572 /* GC should never happen here, so abort if it does. */
3575 /* If we start out planning a unibyte result,
3576 then discover it has to be multibyte, we jump back to retry.
3577 That can only happen from the first large while loop below. */
3580 format
= SDATA (args
[0]);
3581 format_start
= format
;
3582 end
= format
+ SBYTES (args
[0]);
3585 /* Make room in result for all the non-%-codes in the control string. */
3586 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3588 /* Allocate the info and discarded tables. */
3590 int nbytes
= (nargs
+1) * sizeof *info
;
3593 info
= (struct info
*) alloca (nbytes
);
3594 memset (info
, 0, nbytes
);
3595 for (i
= 0; i
<= nargs
; i
++)
3598 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3599 memset (discarded
, 0, SBYTES (args
[0]));
3602 /* Add to TOTAL enough space to hold the converted arguments. */
3605 while (format
!= end
)
3606 if (*format
++ == '%')
3609 int actual_width
= 0;
3610 unsigned char *this_format_start
= format
- 1;
3611 int field_width
= 0;
3613 /* General format specifications look like
3615 '%' [flags] [field-width] [precision] format
3620 field-width ::= [0-9]+
3621 precision ::= '.' [0-9]*
3623 If a field-width is specified, it specifies to which width
3624 the output should be padded with blanks, if the output
3625 string is shorter than field-width.
3627 If precision is specified, it specifies the number of
3628 digits to print after the '.' for floats, or the max.
3629 number of chars to print from a string. */
3631 while (format
!= end
3632 && (*format
== '-' || *format
== '0' || *format
== '#'
3633 || * format
== ' ' || *format
== '+'))
3636 if (*format
>= '0' && *format
<= '9')
3638 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3639 field_width
= 10 * field_width
+ *format
- '0';
3642 /* N is not incremented for another few lines below, so refer to
3643 element N+1 (which might be precision[NARGS]). */
3647 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3648 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3651 /* Extra +1 for 'l' that we may need to insert into the
3653 if (format
- this_format_start
+ 2 > longest_format
)
3654 longest_format
= format
- this_format_start
+ 2;
3657 error ("Format string ends in middle of format specifier");
3660 else if (++n
>= nargs
)
3661 error ("Not enough arguments for format string");
3662 else if (*format
== 'S')
3664 /* For `S', prin1 the argument and then treat like a string. */
3665 register Lisp_Object tem
;
3666 tem
= Fprin1_to_string (args
[n
], Qnil
);
3667 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3673 /* If we restart the loop, we should not come here again
3674 because args[n] is now a string and calling
3675 Fprin1_to_string on it produces superflous double
3676 quotes. So, change "%S" to "%s" now. */
3680 else if (SYMBOLP (args
[n
]))
3682 args
[n
] = SYMBOL_NAME (args
[n
]);
3683 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3690 else if (STRINGP (args
[n
]))
3693 if (*format
!= 's' && *format
!= 'S')
3694 error ("Format specifier doesn't match argument type");
3695 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3696 to be as large as is calculated here. Easy check for
3697 the case PRECISION = 0. */
3698 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3699 /* The precision also constrains how much of the argument
3700 string will finally appear (Bug#5710). */
3701 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3702 if (precision
[n
] != -1)
3703 actual_width
= min (actual_width
, precision
[n
]);
3705 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3706 else if (INTEGERP (args
[n
]) && *format
!= 's')
3708 /* The following loop assumes the Lisp type indicates
3709 the proper way to pass the argument.
3710 So make sure we have a flonum if the argument should
3712 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3713 args
[n
] = Ffloat (args
[n
]);
3715 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3716 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3717 error ("Invalid format operation %%%c", *format
);
3719 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3722 if (! ASCII_CHAR_P (XINT (args
[n
]))
3723 /* Note: No one can remeber why we have to treat
3724 the character 0 as a multibyte character here.
3725 But, until it causes a real problem, let's
3727 || XINT (args
[n
]) == 0)
3734 args
[n
] = Fchar_to_string (args
[n
]);
3735 thissize
= SBYTES (args
[n
]);
3737 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3740 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3741 thissize
= SBYTES (args
[n
]);
3745 else if (FLOATP (args
[n
]) && *format
!= 's')
3747 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3749 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3750 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3751 error ("Invalid format operation %%%c", *format
);
3752 /* This fails unnecessarily if args[n] is bigger than
3753 most-positive-fixnum but smaller than MAXINT.
3754 These cases are important because we sometimes use floats
3755 to represent such integer values (typically such values
3756 come from UIDs or PIDs). */
3757 /* args[n] = Ftruncate (args[n], Qnil); */
3760 /* Note that we're using sprintf to print floats,
3761 so we have to take into account what that function
3763 /* Filter out flag value of -1. */
3764 thissize
= (MAX_10_EXP
+ 100
3765 + (precision
[n
] > 0 ? precision
[n
] : 0));
3769 /* Anything but a string, convert to a string using princ. */
3770 register Lisp_Object tem
;
3771 tem
= Fprin1_to_string (args
[n
], Qt
);
3772 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3781 thissize
+= max (0, field_width
- actual_width
);
3782 total
+= thissize
+ 4;
3787 /* Now we can no longer jump to retry.
3788 TOTAL and LONGEST_FORMAT are known for certain. */
3790 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3792 /* Allocate the space for the result.
3793 Note that TOTAL is an overestimate. */
3794 SAFE_ALLOCA (buf
, char *, total
);
3800 /* Scan the format and store result in BUF. */
3801 format
= SDATA (args
[0]);
3802 format_start
= format
;
3803 end
= format
+ SBYTES (args
[0]);
3804 maybe_combine_byte
= 0;
3805 while (format
!= end
)
3811 unsigned char *this_format_start
= format
;
3813 discarded
[format
- format_start
] = 1;
3816 while (index ("-+0# ", *format
))
3822 discarded
[format
- format_start
] = 1;
3826 minlen
= atoi (format
);
3828 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3830 discarded
[format
- format_start
] = 1;
3834 if (*format
++ == '%')
3843 discarded
[format
- format_start
- 1] = 1;
3844 info
[n
].start
= nchars
;
3846 if (STRINGP (args
[n
]))
3848 /* handle case (precision[n] >= 0) */
3851 int nbytes
, start
, end
;
3854 /* lisp_string_width ignores a precision of 0, but GNU
3855 libc functions print 0 characters when the precision
3856 is 0. Imitate libc behavior here. Changing
3857 lisp_string_width is the right thing, and will be
3858 done, but meanwhile we work with it. */
3860 if (precision
[n
] == 0)
3861 width
= nchars_string
= nbytes
= 0;
3862 else if (precision
[n
] > 0)
3863 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3865 { /* no precision spec given for this argument */
3866 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3867 nbytes
= SBYTES (args
[n
]);
3868 nchars_string
= SCHARS (args
[n
]);
3871 /* If spec requires it, pad on right with spaces. */
3872 padding
= minlen
- width
;
3874 while (padding
-- > 0)
3880 info
[n
].start
= start
= nchars
;
3881 nchars
+= nchars_string
;
3886 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3887 && STRING_MULTIBYTE (args
[n
])
3888 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3889 maybe_combine_byte
= 1;
3891 p
+= copy_text (SDATA (args
[n
]), p
,
3893 STRING_MULTIBYTE (args
[n
]), multibyte
);
3895 info
[n
].end
= nchars
;
3898 while (padding
-- > 0)
3904 /* If this argument has text properties, record where
3905 in the result string it appears. */
3906 if (STRING_INTERVALS (args
[n
]))
3907 info
[n
].intervals
= arg_intervals
= 1;
3909 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3913 memcpy (this_format
, this_format_start
,
3914 format
- this_format_start
);
3915 this_format
[format
- this_format_start
] = 0;
3917 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
3918 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3921 if (sizeof (EMACS_INT
) > sizeof (int)
3922 && format
[-1] != 'c')
3924 /* Insert 'l' before format spec. */
3925 this_format
[format
- this_format_start
]
3926 = this_format
[format
- this_format_start
- 1];
3927 this_format
[format
- this_format_start
- 1] = 'l';
3928 this_format
[format
- this_format_start
+ 1] = 0;
3931 if (INTEGERP (args
[n
]))
3933 if (format
[-1] == 'c')
3934 sprintf (p
, this_format
, (int) XINT (args
[n
]));
3935 else if (format
[-1] == 'd')
3936 sprintf (p
, this_format
, XINT (args
[n
]));
3937 /* Don't sign-extend for octal or hex printing. */
3939 sprintf (p
, this_format
, XUINT (args
[n
]));
3941 else if (format
[-1] == 'c')
3942 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
3943 else if (format
[-1] == 'd')
3944 /* Maybe we should use "%1.0f" instead so it also works
3945 for values larger than MAXINT. */
3946 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
3948 /* Don't sign-extend for octal or hex printing. */
3949 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
3954 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3955 && !CHAR_HEAD_P (*((unsigned char *) p
)))
3956 maybe_combine_byte
= 1;
3957 this_nchars
= strlen (p
);
3959 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
3962 nchars
+= this_nchars
;
3963 info
[n
].end
= nchars
;
3967 else if (STRING_MULTIBYTE (args
[0]))
3969 /* Copy a whole multibyte character. */
3972 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3973 && !CHAR_HEAD_P (*format
))
3974 maybe_combine_byte
= 1;
3976 while (! CHAR_HEAD_P (*format
))
3978 discarded
[format
- format_start
] = 2;
3985 /* Convert a single-byte character to multibyte. */
3986 int len
= copy_text (format
, p
, 1, 0, 1);
3993 *p
++ = *format
++, nchars
++;
3996 if (p
> buf
+ total
)
3999 if (maybe_combine_byte
)
4000 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
4001 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
4003 /* If we allocated BUF with malloc, free it too. */
4006 /* If the format string has text properties, or any of the string
4007 arguments has text properties, set up text properties of the
4010 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4012 Lisp_Object len
, new_len
, props
;
4013 struct gcpro gcpro1
;
4015 /* Add text properties from the format string. */
4016 len
= make_number (SCHARS (args
[0]));
4017 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4022 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4025 /* Adjust the bounds of each text property
4026 to the proper start and end in the output string. */
4028 /* Put the positions in PROPS in increasing order, so that
4029 we can do (effectively) one scan through the position
4030 space of the format string. */
4031 props
= Fnreverse (props
);
4033 /* BYTEPOS is the byte position in the format string,
4034 POSITION is the untranslated char position in it,
4035 TRANSLATED is the translated char position in BUF,
4036 and ARGN is the number of the next arg we will come to. */
4037 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4044 /* First adjust the property start position. */
4045 pos
= XINT (XCAR (item
));
4047 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4048 up to this position. */
4049 for (; position
< pos
; bytepos
++)
4051 if (! discarded
[bytepos
])
4052 position
++, translated
++;
4053 else if (discarded
[bytepos
] == 1)
4056 if (translated
== info
[argn
].start
)
4058 translated
+= info
[argn
].end
- info
[argn
].start
;
4064 XSETCAR (item
, make_number (translated
));
4066 /* Likewise adjust the property end position. */
4067 pos
= XINT (XCAR (XCDR (item
)));
4069 for (; position
< pos
; bytepos
++)
4071 if (! discarded
[bytepos
])
4072 position
++, translated
++;
4073 else if (discarded
[bytepos
] == 1)
4076 if (translated
== info
[argn
].start
)
4078 translated
+= info
[argn
].end
- info
[argn
].start
;
4084 XSETCAR (XCDR (item
), make_number (translated
));
4087 add_text_properties_from_list (val
, props
, make_number (0));
4090 /* Add text properties from arguments. */
4092 for (n
= 1; n
< nargs
; ++n
)
4093 if (info
[n
].intervals
)
4095 len
= make_number (SCHARS (args
[n
]));
4096 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4097 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4098 props
= extend_property_ranges (props
, new_len
);
4099 /* If successive arguments have properties, be sure that
4100 the value of `composition' property be the copy. */
4101 if (n
> 1 && info
[n
- 1].end
)
4102 make_composition_value_copy (props
);
4103 add_text_properties_from_list (val
, props
,
4104 make_number (info
[n
].start
));
4114 format2 (const char *string1
, Lisp_Object arg0
, Lisp_Object arg1
)
4116 Lisp_Object args
[3];
4117 args
[0] = build_string (string1
);
4120 return Fformat (3, args
);
4123 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4124 doc
: /* Return t if two characters match, optionally ignoring case.
4125 Both arguments must be characters (i.e. integers).
4126 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4127 (register Lisp_Object c1
, Lisp_Object c2
)
4130 /* Check they're chars, not just integers, otherwise we could get array
4131 bounds violations in DOWNCASE. */
4132 CHECK_CHARACTER (c1
);
4133 CHECK_CHARACTER (c2
);
4135 if (XINT (c1
) == XINT (c2
))
4137 if (NILP (current_buffer
->case_fold_search
))
4140 /* Do these in separate statements,
4141 then compare the variables.
4142 because of the way DOWNCASE uses temp variables. */
4144 if (NILP (current_buffer
->enable_multibyte_characters
)
4145 && ! ASCII_CHAR_P (i1
))
4147 MAKE_CHAR_MULTIBYTE (i1
);
4150 if (NILP (current_buffer
->enable_multibyte_characters
)
4151 && ! ASCII_CHAR_P (i2
))
4153 MAKE_CHAR_MULTIBYTE (i2
);
4157 return (i1
== i2
? Qt
: Qnil
);
4160 /* Transpose the markers in two regions of the current buffer, and
4161 adjust the ones between them if necessary (i.e.: if the regions
4164 START1, END1 are the character positions of the first region.
4165 START1_BYTE, END1_BYTE are the byte positions.
4166 START2, END2 are the character positions of the second region.
4167 START2_BYTE, END2_BYTE are the byte positions.
4169 Traverses the entire marker list of the buffer to do so, adding an
4170 appropriate amount to some, subtracting from some, and leaving the
4171 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4173 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4176 transpose_markers (start1
, end1
, start2
, end2
,
4177 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
4178 register int start1
, end1
, start2
, end2
;
4179 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
4181 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4182 register struct Lisp_Marker
*marker
;
4184 /* Update point as if it were a marker. */
4188 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4189 PT_BYTE
+ (end2_byte
- end1_byte
));
4190 else if (PT
< start2
)
4191 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4192 (PT_BYTE
+ (end2_byte
- start2_byte
)
4193 - (end1_byte
- start1_byte
)));
4195 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4196 PT_BYTE
- (start2_byte
- start1_byte
));
4198 /* We used to adjust the endpoints here to account for the gap, but that
4199 isn't good enough. Even if we assume the caller has tried to move the
4200 gap out of our way, it might still be at start1 exactly, for example;
4201 and that places it `inside' the interval, for our purposes. The amount
4202 of adjustment is nontrivial if there's a `denormalized' marker whose
4203 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4204 the dirty work to Fmarker_position, below. */
4206 /* The difference between the region's lengths */
4207 diff
= (end2
- start2
) - (end1
- start1
);
4208 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4210 /* For shifting each marker in a region by the length of the other
4211 region plus the distance between the regions. */
4212 amt1
= (end2
- start2
) + (start2
- end1
);
4213 amt2
= (end1
- start1
) + (start2
- end1
);
4214 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4215 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4217 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4219 mpos
= marker
->bytepos
;
4220 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4222 if (mpos
< end1_byte
)
4224 else if (mpos
< start2_byte
)
4228 marker
->bytepos
= mpos
;
4230 mpos
= marker
->charpos
;
4231 if (mpos
>= start1
&& mpos
< end2
)
4235 else if (mpos
< start2
)
4240 marker
->charpos
= mpos
;
4244 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4245 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4246 The regions should not be overlapping, because the size of the buffer is
4247 never changed in a transposition.
4249 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4250 any markers that happen to be located in the regions.
4252 Transposing beyond buffer boundaries is an error. */)
4253 (Lisp_Object startr1
, Lisp_Object endr1
, Lisp_Object startr2
, Lisp_Object endr2
, Lisp_Object leave_markers
)
4255 register EMACS_INT start1
, end1
, start2
, end2
;
4256 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4257 EMACS_INT gap
, len1
, len_mid
, len2
;
4258 unsigned char *start1_addr
, *start2_addr
, *temp
;
4260 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4263 XSETBUFFER (buf
, current_buffer
);
4264 cur_intv
= BUF_INTERVALS (current_buffer
);
4266 validate_region (&startr1
, &endr1
);
4267 validate_region (&startr2
, &endr2
);
4269 start1
= XFASTINT (startr1
);
4270 end1
= XFASTINT (endr1
);
4271 start2
= XFASTINT (startr2
);
4272 end2
= XFASTINT (endr2
);
4275 /* Swap the regions if they're reversed. */
4278 register int glumph
= start1
;
4286 len1
= end1
- start1
;
4287 len2
= end2
- start2
;
4290 error ("Transposed regions overlap");
4291 else if (start1
== end1
|| start2
== end2
)
4292 error ("Transposed region has length 0");
4294 /* The possibilities are:
4295 1. Adjacent (contiguous) regions, or separate but equal regions
4296 (no, really equal, in this case!), or
4297 2. Separate regions of unequal size.
4299 The worst case is usually No. 2. It means that (aside from
4300 potential need for getting the gap out of the way), there also
4301 needs to be a shifting of the text between the two regions. So
4302 if they are spread far apart, we are that much slower... sigh. */
4304 /* It must be pointed out that the really studly thing to do would
4305 be not to move the gap at all, but to leave it in place and work
4306 around it if necessary. This would be extremely efficient,
4307 especially considering that people are likely to do
4308 transpositions near where they are working interactively, which
4309 is exactly where the gap would be found. However, such code
4310 would be much harder to write and to read. So, if you are
4311 reading this comment and are feeling squirrely, by all means have
4312 a go! I just didn't feel like doing it, so I will simply move
4313 the gap the minimum distance to get it out of the way, and then
4314 deal with an unbroken array. */
4316 /* Make sure the gap won't interfere, by moving it out of the text
4317 we will operate on. */
4318 if (start1
< gap
&& gap
< end2
)
4320 if (gap
- start1
< end2
- gap
)
4326 start1_byte
= CHAR_TO_BYTE (start1
);
4327 start2_byte
= CHAR_TO_BYTE (start2
);
4328 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4329 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4331 #ifdef BYTE_COMBINING_DEBUG
4334 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4335 len2_byte
, start1
, start1_byte
)
4336 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4337 len1_byte
, end2
, start2_byte
+ len2_byte
)
4338 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4339 len1_byte
, end2
, start2_byte
+ len2_byte
))
4344 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4345 len2_byte
, start1
, start1_byte
)
4346 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4347 len1_byte
, start2
, start2_byte
)
4348 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4349 len2_byte
, end1
, start1_byte
+ len1_byte
)
4350 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4351 len1_byte
, end2
, start2_byte
+ len2_byte
))
4356 /* Hmmm... how about checking to see if the gap is large
4357 enough to use as the temporary storage? That would avoid an
4358 allocation... interesting. Later, don't fool with it now. */
4360 /* Working without memmove, for portability (sigh), so must be
4361 careful of overlapping subsections of the array... */
4363 if (end1
== start2
) /* adjacent regions */
4365 modify_region (current_buffer
, start1
, end2
, 0);
4366 record_change (start1
, len1
+ len2
);
4368 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4369 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4370 /* Don't use Fset_text_properties: that can cause GC, which can
4371 clobber objects stored in the tmp_intervals. */
4372 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4373 if (!NULL_INTERVAL_P (tmp_interval3
))
4374 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4376 /* First region smaller than second. */
4377 if (len1_byte
< len2_byte
)
4381 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4383 /* Don't precompute these addresses. We have to compute them
4384 at the last minute, because the relocating allocator might
4385 have moved the buffer around during the xmalloc. */
4386 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4387 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4389 memcpy (temp
, start2_addr
, len2_byte
);
4390 memcpy (start1_addr
+ len2_byte
, start1_addr
, len1_byte
);
4391 memcpy (start1_addr
, temp
, len2_byte
);
4395 /* First region not smaller than second. */
4399 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4400 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4401 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4402 memcpy (temp
, start1_addr
, len1_byte
);
4403 memcpy (start1_addr
, start2_addr
, len2_byte
);
4404 memcpy (start1_addr
+ len2_byte
, temp
, len1_byte
);
4407 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4408 len1
, current_buffer
, 0);
4409 graft_intervals_into_buffer (tmp_interval2
, start1
,
4410 len2
, current_buffer
, 0);
4411 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4412 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4414 /* Non-adjacent regions, because end1 != start2, bleagh... */
4417 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4419 if (len1_byte
== len2_byte
)
4420 /* Regions are same size, though, how nice. */
4424 modify_region (current_buffer
, start1
, end1
, 0);
4425 modify_region (current_buffer
, start2
, end2
, 0);
4426 record_change (start1
, len1
);
4427 record_change (start2
, len2
);
4428 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4429 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4431 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4432 if (!NULL_INTERVAL_P (tmp_interval3
))
4433 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4435 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4436 if (!NULL_INTERVAL_P (tmp_interval3
))
4437 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4439 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4440 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4441 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4442 memcpy (temp
, start1_addr
, len1_byte
);
4443 memcpy (start1_addr
, start2_addr
, len2_byte
);
4444 memcpy (start2_addr
, temp
, len1_byte
);
4447 graft_intervals_into_buffer (tmp_interval1
, start2
,
4448 len1
, current_buffer
, 0);
4449 graft_intervals_into_buffer (tmp_interval2
, start1
,
4450 len2
, current_buffer
, 0);
4453 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4454 /* Non-adjacent & unequal size, area between must also be shifted. */
4458 modify_region (current_buffer
, start1
, end2
, 0);
4459 record_change (start1
, (end2
- start1
));
4460 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4461 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4462 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4464 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4465 if (!NULL_INTERVAL_P (tmp_interval3
))
4466 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4468 /* holds region 2 */
4469 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4470 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4471 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4472 memcpy (temp
, start2_addr
, len2_byte
);
4473 memcpy (start1_addr
+ len_mid
+ len2_byte
, start1_addr
, len1_byte
);
4474 memmove (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4475 memcpy (start1_addr
, temp
, len2_byte
);
4478 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4479 len1
, current_buffer
, 0);
4480 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4481 len_mid
, current_buffer
, 0);
4482 graft_intervals_into_buffer (tmp_interval2
, start1
,
4483 len2
, current_buffer
, 0);
4486 /* Second region smaller than first. */
4490 record_change (start1
, (end2
- start1
));
4491 modify_region (current_buffer
, start1
, end2
, 0);
4493 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4494 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4495 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4497 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4498 if (!NULL_INTERVAL_P (tmp_interval3
))
4499 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4501 /* holds region 1 */
4502 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4503 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4504 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4505 memcpy (temp
, start1_addr
, len1_byte
);
4506 memcpy (start1_addr
, start2_addr
, len2_byte
);
4507 memcpy (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4508 memcpy (start1_addr
+ len2_byte
+ len_mid
, temp
, len1_byte
);
4511 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4512 len1
, current_buffer
, 0);
4513 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4514 len_mid
, current_buffer
, 0);
4515 graft_intervals_into_buffer (tmp_interval2
, start1
,
4516 len2
, current_buffer
, 0);
4519 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4520 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4523 /* When doing multiple transpositions, it might be nice
4524 to optimize this. Perhaps the markers in any one buffer
4525 should be organized in some sorted data tree. */
4526 if (NILP (leave_markers
))
4528 transpose_markers (start1
, end1
, start2
, end2
,
4529 start1_byte
, start1_byte
+ len1_byte
,
4530 start2_byte
, start2_byte
+ len2_byte
);
4531 fix_start_end_in_overlays (start1
, end2
);
4534 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4540 syms_of_editfns (void)
4545 Qbuffer_access_fontify_functions
4546 = intern_c_string ("buffer-access-fontify-functions");
4547 staticpro (&Qbuffer_access_fontify_functions
);
4549 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4550 doc
: /* Non-nil means text motion commands don't notice fields. */);
4551 Vinhibit_field_text_motion
= Qnil
;
4553 DEFVAR_LISP ("buffer-access-fontify-functions",
4554 &Vbuffer_access_fontify_functions
,
4555 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4556 Each function is called with two arguments which specify the range
4557 of the buffer being accessed. */);
4558 Vbuffer_access_fontify_functions
= Qnil
;
4562 extern Lisp_Object Vprin1_to_string_buffer
;
4563 obuf
= Fcurrent_buffer ();
4564 /* Do this here, because init_buffer_once is too early--it won't work. */
4565 Fset_buffer (Vprin1_to_string_buffer
);
4566 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4567 Fset (Fmake_local_variable (intern_c_string ("buffer-access-fontify-functions")),
4572 DEFVAR_LISP ("buffer-access-fontified-property",
4573 &Vbuffer_access_fontified_property
,
4574 doc
: /* Property which (if non-nil) indicates text has been fontified.
4575 `buffer-substring' need not call the `buffer-access-fontify-functions'
4576 functions if all the text being accessed has this property. */);
4577 Vbuffer_access_fontified_property
= Qnil
;
4579 DEFVAR_LISP ("system-name", &Vsystem_name
,
4580 doc
: /* The host name of the machine Emacs is running on. */);
4582 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4583 doc
: /* The full name of the user logged in. */);
4585 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4586 doc
: /* The user's name, taken from environment variables if possible. */);
4588 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4589 doc
: /* The user's name, based upon the real uid only. */);
4591 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4592 doc
: /* The release of the operating system Emacs is running on. */);
4594 defsubr (&Spropertize
);
4595 defsubr (&Schar_equal
);
4596 defsubr (&Sgoto_char
);
4597 defsubr (&Sstring_to_char
);
4598 defsubr (&Schar_to_string
);
4599 defsubr (&Sbyte_to_string
);
4600 defsubr (&Sbuffer_substring
);
4601 defsubr (&Sbuffer_substring_no_properties
);
4602 defsubr (&Sbuffer_string
);
4604 defsubr (&Spoint_marker
);
4605 defsubr (&Smark_marker
);
4607 defsubr (&Sregion_beginning
);
4608 defsubr (&Sregion_end
);
4610 staticpro (&Qfield
);
4611 Qfield
= intern_c_string ("field");
4612 staticpro (&Qboundary
);
4613 Qboundary
= intern_c_string ("boundary");
4614 defsubr (&Sfield_beginning
);
4615 defsubr (&Sfield_end
);
4616 defsubr (&Sfield_string
);
4617 defsubr (&Sfield_string_no_properties
);
4618 defsubr (&Sdelete_field
);
4619 defsubr (&Sconstrain_to_field
);
4621 defsubr (&Sline_beginning_position
);
4622 defsubr (&Sline_end_position
);
4624 /* defsubr (&Smark); */
4625 /* defsubr (&Sset_mark); */
4626 defsubr (&Ssave_excursion
);
4627 defsubr (&Ssave_current_buffer
);
4629 defsubr (&Sbufsize
);
4630 defsubr (&Spoint_max
);
4631 defsubr (&Spoint_min
);
4632 defsubr (&Spoint_min_marker
);
4633 defsubr (&Spoint_max_marker
);
4634 defsubr (&Sgap_position
);
4635 defsubr (&Sgap_size
);
4636 defsubr (&Sposition_bytes
);
4637 defsubr (&Sbyte_to_position
);
4643 defsubr (&Sfollowing_char
);
4644 defsubr (&Sprevious_char
);
4645 defsubr (&Schar_after
);
4646 defsubr (&Schar_before
);
4648 defsubr (&Sinsert_before_markers
);
4649 defsubr (&Sinsert_and_inherit
);
4650 defsubr (&Sinsert_and_inherit_before_markers
);
4651 defsubr (&Sinsert_char
);
4652 defsubr (&Sinsert_byte
);
4654 defsubr (&Suser_login_name
);
4655 defsubr (&Suser_real_login_name
);
4656 defsubr (&Suser_uid
);
4657 defsubr (&Suser_real_uid
);
4658 defsubr (&Suser_full_name
);
4659 defsubr (&Semacs_pid
);
4660 defsubr (&Scurrent_time
);
4661 defsubr (&Sget_internal_run_time
);
4662 defsubr (&Sformat_time_string
);
4663 defsubr (&Sfloat_time
);
4664 defsubr (&Sdecode_time
);
4665 defsubr (&Sencode_time
);
4666 defsubr (&Scurrent_time_string
);
4667 defsubr (&Scurrent_time_zone
);
4668 defsubr (&Sset_time_zone_rule
);
4669 defsubr (&Ssystem_name
);
4670 defsubr (&Smessage
);
4671 defsubr (&Smessage_box
);
4672 defsubr (&Smessage_or_box
);
4673 defsubr (&Scurrent_message
);
4676 defsubr (&Sinsert_buffer_substring
);
4677 defsubr (&Scompare_buffer_substrings
);
4678 defsubr (&Ssubst_char_in_region
);
4679 defsubr (&Stranslate_region_internal
);
4680 defsubr (&Sdelete_region
);
4681 defsubr (&Sdelete_and_extract_region
);
4683 defsubr (&Snarrow_to_region
);
4684 defsubr (&Ssave_restriction
);
4685 defsubr (&Stranspose_regions
);
4688 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4689 (do not change this comment) */