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);
112 Lisp_Object Vbuffer_access_fontify_functions
;
113 Lisp_Object Qbuffer_access_fontify_functions
;
114 Lisp_Object Vbuffer_access_fontified_property
;
116 Lisp_Object
Fuser_full_name (Lisp_Object
);
118 /* Non-nil means don't stop at field boundary in text motion commands. */
120 Lisp_Object Vinhibit_field_text_motion
;
122 /* Some static data, and a function to initialize it for each run */
124 Lisp_Object Vsystem_name
;
125 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
126 Lisp_Object Vuser_full_name
; /* full name of current user */
127 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
128 Lisp_Object Voperating_system_release
; /* Operating System Release */
130 /* Symbol for the text property used to mark fields. */
134 /* A special value for Qfield properties. */
136 Lisp_Object Qboundary
;
143 register unsigned char *p
;
144 struct passwd
*pw
; /* password entry for the current user */
147 /* Set up system_name even when dumping. */
151 /* Don't bother with this on initial start when just dumping out */
154 #endif /* not CANNOT_DUMP */
156 pw
= (struct passwd
*) getpwuid (getuid ());
158 /* We let the real user name default to "root" because that's quite
159 accurate on MSDOG and because it lets Emacs find the init file.
160 (The DVX libraries override the Djgpp libraries here.) */
161 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
163 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
166 /* Get the effective user name, by consulting environment variables,
167 or the effective uid if those are unset. */
168 user_name
= (char *) getenv ("LOGNAME");
171 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
172 #else /* WINDOWSNT */
173 user_name
= (char *) getenv ("USER");
174 #endif /* WINDOWSNT */
177 pw
= (struct passwd
*) getpwuid (geteuid ());
178 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
180 Vuser_login_name
= build_string (user_name
);
182 /* If the user name claimed in the environment vars differs from
183 the real uid, use the claimed name to find the full name. */
184 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
185 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
188 p
= (unsigned char *) getenv ("NAME");
190 Vuser_full_name
= build_string (p
);
191 else if (NILP (Vuser_full_name
))
192 Vuser_full_name
= build_string ("unknown");
194 #ifdef HAVE_SYS_UTSNAME_H
198 Voperating_system_release
= build_string (uts
.release
);
201 Voperating_system_release
= Qnil
;
205 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
206 doc
: /* Convert arg CHAR to a string containing that character.
207 usage: (char-to-string CHAR) */)
208 (Lisp_Object character
)
211 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
213 CHECK_CHARACTER (character
);
215 len
= CHAR_STRING (XFASTINT (character
), str
);
216 return make_string_from_bytes (str
, 1, len
);
219 DEFUN ("byte-to-string", Fbyte_to_string
, Sbyte_to_string
, 1, 1, 0,
220 doc
: /* Convert arg BYTE to a string containing that byte. */)
226 return make_string_from_bytes (&b
, 1, 1);
229 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
230 doc
: /* Convert arg STRING to a character, the first character of that string.
231 A multibyte character is handled correctly. */)
232 (register Lisp_Object string
)
234 register Lisp_Object val
;
235 CHECK_STRING (string
);
238 if (STRING_MULTIBYTE (string
))
239 XSETFASTINT (val
, STRING_CHAR (SDATA (string
)));
241 XSETFASTINT (val
, SREF (string
, 0));
244 XSETFASTINT (val
, 0);
249 buildmark (int charpos
, int bytepos
)
251 register Lisp_Object mark
;
252 mark
= Fmake_marker ();
253 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
257 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
258 doc
: /* Return value of point, as an integer.
259 Beginning of buffer is position (point-min). */)
263 XSETFASTINT (temp
, PT
);
267 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
268 doc
: /* Return value of point, as a marker object. */)
271 return buildmark (PT
, PT_BYTE
);
275 clip_to_bounds (int lower
, int num
, int upper
)
279 else if (num
> upper
)
285 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
286 doc
: /* Set point to POSITION, a number or marker.
287 Beginning of buffer is position (point-min), end is (point-max).
289 The return value is POSITION. */)
290 (register Lisp_Object position
)
294 if (MARKERP (position
)
295 && current_buffer
== XMARKER (position
)->buffer
)
297 pos
= marker_position (position
);
299 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
301 SET_PT_BOTH (ZV
, ZV_BYTE
);
303 SET_PT_BOTH (pos
, marker_byte_position (position
));
308 CHECK_NUMBER_COERCE_MARKER (position
);
310 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
316 /* Return the start or end position of the region.
317 BEGINNINGP non-zero means return the start.
318 If there is no region active, signal an error. */
321 region_limit (int beginningp
)
323 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
326 if (!NILP (Vtransient_mark_mode
)
327 && NILP (Vmark_even_if_inactive
)
328 && NILP (current_buffer
->mark_active
))
329 xsignal0 (Qmark_inactive
);
331 m
= Fmarker_position (current_buffer
->mark
);
333 error ("The mark is not set now, so there is no region");
335 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
336 m
= make_number (PT
);
340 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
341 doc
: /* Return position of beginning of region, as an integer. */)
344 return region_limit (1);
347 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
348 doc
: /* Return position of end of region, as an integer. */)
351 return region_limit (0);
354 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
355 doc
: /* Return this buffer's mark, as a marker object.
356 Watch out! Moving this marker changes the mark position.
357 If you set the marker not to point anywhere, the buffer will have no mark. */)
360 return current_buffer
->mark
;
364 /* Find all the overlays in the current buffer that touch position POS.
365 Return the number found, and store them in a vector in VEC
369 overlays_around (int pos
, Lisp_Object
*vec
, int len
)
371 Lisp_Object overlay
, start
, end
;
372 struct Lisp_Overlay
*tail
;
373 int startpos
, endpos
;
376 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
378 XSETMISC (overlay
, tail
);
380 end
= OVERLAY_END (overlay
);
381 endpos
= OVERLAY_POSITION (end
);
384 start
= OVERLAY_START (overlay
);
385 startpos
= OVERLAY_POSITION (start
);
390 /* Keep counting overlays even if we can't return them all. */
395 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
397 XSETMISC (overlay
, tail
);
399 start
= OVERLAY_START (overlay
);
400 startpos
= OVERLAY_POSITION (start
);
403 end
= OVERLAY_END (overlay
);
404 endpos
= OVERLAY_POSITION (end
);
416 /* Return the value of property PROP, in OBJECT at POSITION.
417 It's the value of PROP that a char inserted at POSITION would get.
418 OBJECT is optional and defaults to the current buffer.
419 If OBJECT is a buffer, then overlay properties are considered as well as
421 If OBJECT is a window, then that window's buffer is used, but
422 window-specific overlays are considered only if they are associated
425 get_pos_property (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
)
427 CHECK_NUMBER_COERCE_MARKER (position
);
430 XSETBUFFER (object
, current_buffer
);
431 else if (WINDOWP (object
))
432 object
= XWINDOW (object
)->buffer
;
434 if (!BUFFERP (object
))
435 /* pos-property only makes sense in buffers right now, since strings
436 have no overlays and no notion of insertion for which stickiness
438 return Fget_text_property (position
, prop
, object
);
441 int posn
= XINT (position
);
443 Lisp_Object
*overlay_vec
, tem
;
444 struct buffer
*obuf
= current_buffer
;
446 set_buffer_temp (XBUFFER (object
));
448 /* First try with room for 40 overlays. */
450 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
451 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
453 /* If there are more than 40,
454 make enough space for all, and try again. */
457 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
458 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
460 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
462 set_buffer_temp (obuf
);
464 /* Now check the overlays in order of decreasing priority. */
465 while (--noverlays
>= 0)
467 Lisp_Object ol
= overlay_vec
[noverlays
];
468 tem
= Foverlay_get (ol
, prop
);
471 /* Check the overlay is indeed active at point. */
472 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
473 if ((OVERLAY_POSITION (start
) == posn
474 && XMARKER (start
)->insertion_type
== 1)
475 || (OVERLAY_POSITION (finish
) == posn
476 && XMARKER (finish
)->insertion_type
== 0))
477 ; /* The overlay will not cover a char inserted at point. */
485 { /* Now check the text properties. */
486 int stickiness
= text_property_stickiness (prop
, position
, object
);
488 return Fget_text_property (position
, prop
, object
);
489 else if (stickiness
< 0
490 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
491 return Fget_text_property (make_number (XINT (position
) - 1),
499 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
500 the value of point is used instead. If BEG or END is null,
501 means don't store the beginning or end of the field.
503 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
504 results; they do not effect boundary behavior.
506 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
507 position of a field, then the beginning of the previous field is
508 returned instead of the beginning of POS's field (since the end of a
509 field is actually also the beginning of the next input field, this
510 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
511 true case, if two fields are separated by a field with the special
512 value `boundary', and POS lies within it, then the two separated
513 fields are considered to be adjacent, and POS between them, when
514 finding the beginning and ending of the "merged" field.
516 Either BEG or END may be 0, in which case the corresponding value
520 find_field (Lisp_Object pos
, Lisp_Object merge_at_boundary
, Lisp_Object beg_limit
, int *beg
, Lisp_Object end_limit
, int *end
)
522 /* Fields right before and after the point. */
523 Lisp_Object before_field
, after_field
;
524 /* 1 if POS counts as the start of a field. */
525 int at_field_start
= 0;
526 /* 1 if POS counts as the end of a field. */
527 int at_field_end
= 0;
530 XSETFASTINT (pos
, PT
);
532 CHECK_NUMBER_COERCE_MARKER (pos
);
535 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
537 = (XFASTINT (pos
) > BEGV
538 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
540 /* Using nil here would be a more obvious choice, but it would
541 fail when the buffer starts with a non-sticky field. */
544 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
545 and POS is at beginning of a field, which can also be interpreted
546 as the end of the previous field. Note that the case where if
547 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
548 more natural one; then we avoid treating the beginning of a field
550 if (NILP (merge_at_boundary
))
552 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
553 if (!EQ (field
, after_field
))
555 if (!EQ (field
, before_field
))
557 if (NILP (field
) && at_field_start
&& at_field_end
)
558 /* If an inserted char would have a nil field while the surrounding
559 text is non-nil, we're probably not looking at a
560 zero-length field, but instead at a non-nil field that's
561 not intended for editing (such as comint's prompts). */
562 at_field_end
= at_field_start
= 0;
565 /* Note about special `boundary' fields:
567 Consider the case where the point (`.') is between the fields `x' and `y':
571 In this situation, if merge_at_boundary is true, we consider the
572 `x' and `y' fields as forming one big merged field, and so the end
573 of the field is the end of `y'.
575 However, if `x' and `y' are separated by a special `boundary' field
576 (a field with a `field' char-property of 'boundary), then we ignore
577 this special field when merging adjacent fields. Here's the same
578 situation, but with a `boundary' field between the `x' and `y' fields:
582 Here, if point is at the end of `x', the beginning of `y', or
583 anywhere in-between (within the `boundary' field), we merge all
584 three fields and consider the beginning as being the beginning of
585 the `x' field, and the end as being the end of the `y' field. */
590 /* POS is at the edge of a field, and we should consider it as
591 the beginning of the following field. */
592 *beg
= XFASTINT (pos
);
594 /* Find the previous field boundary. */
597 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
598 /* Skip a `boundary' field. */
599 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
602 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
604 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
611 /* POS is at the edge of a field, and we should consider it as
612 the end of the previous field. */
613 *end
= XFASTINT (pos
);
615 /* Find the next field boundary. */
617 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
618 /* Skip a `boundary' field. */
619 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
622 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
624 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
630 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
631 doc
: /* Delete the field surrounding POS.
632 A field is a region of text with the same `field' property.
633 If POS is nil, the value of point is used for POS. */)
637 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
639 del_range (beg
, end
);
643 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
644 doc
: /* Return the contents of the field surrounding POS as a string.
645 A field is a region of text with the same `field' property.
646 If POS is nil, the value of point is used for POS. */)
650 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
651 return make_buffer_string (beg
, end
, 1);
654 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
655 doc
: /* Return the contents of the field around POS, without text properties.
656 A field is a region of text with the same `field' property.
657 If POS is nil, the value of point is used for POS. */)
661 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
662 return make_buffer_string (beg
, end
, 0);
665 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
666 doc
: /* Return the beginning of the field surrounding POS.
667 A field is a region of text with the same `field' property.
668 If POS is nil, the value of point is used for POS.
669 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
670 field, then the beginning of the *previous* field is returned.
671 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
672 is before LIMIT, then LIMIT will be returned instead. */)
673 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
676 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
677 return make_number (beg
);
680 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
681 doc
: /* Return the end of the field surrounding POS.
682 A field is a region of text with the same `field' property.
683 If POS is nil, the value of point is used for POS.
684 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
685 then the end of the *following* field is returned.
686 If LIMIT is non-nil, it is a buffer position; if the end of the field
687 is after LIMIT, then LIMIT will be returned instead. */)
688 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
691 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
692 return make_number (end
);
695 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
696 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
698 A field is a region of text with the same `field' property.
699 If NEW-POS is nil, then the current point is used instead, and set to the
700 constrained position if that is different.
702 If OLD-POS is at the boundary of two fields, then the allowable
703 positions for NEW-POS depends on the value of the optional argument
704 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
705 constrained to the field that has the same `field' char-property
706 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
707 is non-nil, NEW-POS is constrained to the union of the two adjacent
708 fields. Additionally, if two fields are separated by another field with
709 the special value `boundary', then any point within this special field is
710 also considered to be `on the boundary'.
712 If the optional argument ONLY-IN-LINE is non-nil and constraining
713 NEW-POS would move it to a different line, NEW-POS is returned
714 unconstrained. This useful for commands that move by line, like
715 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
716 only in the case where they can still move to the right line.
718 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
719 a non-nil property of that name, then any field boundaries are ignored.
721 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
722 (Lisp_Object new_pos
, Lisp_Object old_pos
, Lisp_Object escape_from_edge
, Lisp_Object only_in_line
, Lisp_Object inhibit_capture_property
)
724 /* If non-zero, then the original point, before re-positioning. */
727 Lisp_Object prev_old
, prev_new
;
730 /* Use the current point, and afterwards, set it. */
733 XSETFASTINT (new_pos
, PT
);
736 CHECK_NUMBER_COERCE_MARKER (new_pos
);
737 CHECK_NUMBER_COERCE_MARKER (old_pos
);
739 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
741 prev_old
= make_number (XFASTINT (old_pos
) - 1);
742 prev_new
= make_number (XFASTINT (new_pos
) - 1);
744 if (NILP (Vinhibit_field_text_motion
)
745 && !EQ (new_pos
, old_pos
)
746 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
747 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
748 /* To recognize field boundaries, we must also look at the
749 previous positions; we could use `get_pos_property'
750 instead, but in itself that would fail inside non-sticky
751 fields (like comint prompts). */
752 || (XFASTINT (new_pos
) > BEGV
753 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
754 || (XFASTINT (old_pos
) > BEGV
755 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
756 && (NILP (inhibit_capture_property
)
757 /* Field boundaries are again a problem; but now we must
758 decide the case exactly, so we need to call
759 `get_pos_property' as well. */
760 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
761 && (XFASTINT (old_pos
) <= BEGV
762 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
763 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
764 /* It is possible that NEW_POS is not within the same field as
765 OLD_POS; try to move NEW_POS so that it is. */
768 Lisp_Object field_bound
;
771 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
773 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
775 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
776 other side of NEW_POS, which would mean that NEW_POS is
777 already acceptable, and it's not necessary to constrain it
779 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
780 /* NEW_POS should be constrained, but only if either
781 ONLY_IN_LINE is nil (in which case any constraint is OK),
782 or NEW_POS and FIELD_BOUND are on the same line (in which
783 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
784 && (NILP (only_in_line
)
785 /* This is the ONLY_IN_LINE case, check that NEW_POS and
786 FIELD_BOUND are on the same line by seeing whether
787 there's an intervening newline or not. */
788 || (scan_buffer ('\n',
789 XFASTINT (new_pos
), XFASTINT (field_bound
),
790 fwd
? -1 : 1, &shortage
, 1),
792 /* Constrain NEW_POS to FIELD_BOUND. */
793 new_pos
= field_bound
;
795 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
796 /* The NEW_POS argument was originally nil, so automatically set PT. */
797 SET_PT (XFASTINT (new_pos
));
804 DEFUN ("line-beginning-position",
805 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
806 doc
: /* Return the character position of the first character on the current line.
807 With argument N not nil or 1, move forward N - 1 lines first.
808 If scan reaches end of buffer, return that position.
810 This function constrains the returned position to the current field
811 unless that would be on a different line than the original,
812 unconstrained result. If N is nil or 1, and a front-sticky field
813 starts at point, the scan stops as soon as it starts. To ignore field
814 boundaries bind `inhibit-field-text-motion' to t.
816 This function does not move point. */)
819 int orig
, orig_byte
, end
;
820 int count
= SPECPDL_INDEX ();
821 specbind (Qinhibit_point_motion_hooks
, Qt
);
830 Fforward_line (make_number (XINT (n
) - 1));
833 SET_PT_BOTH (orig
, orig_byte
);
835 unbind_to (count
, Qnil
);
837 /* Return END constrained to the current input field. */
838 return Fconstrain_to_field (make_number (end
), make_number (orig
),
839 XINT (n
) != 1 ? Qt
: Qnil
,
843 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
844 doc
: /* Return the character position of the last character on the current line.
845 With argument N not nil or 1, move forward N - 1 lines first.
846 If scan reaches end of buffer, return that position.
848 This function constrains the returned position to the current field
849 unless that would be on a different line than the original,
850 unconstrained result. If N is nil or 1, and a rear-sticky field ends
851 at point, the scan stops as soon as it starts. To ignore field
852 boundaries bind `inhibit-field-text-motion' to t.
854 This function does not move point. */)
865 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
867 /* Return END_POS constrained to the current input field. */
868 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
874 save_excursion_save (void)
876 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
879 return Fcons (Fpoint_marker (),
880 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
881 Fcons (visible
? Qt
: Qnil
,
882 Fcons (current_buffer
->mark_active
,
887 save_excursion_restore (Lisp_Object info
)
889 Lisp_Object tem
, tem1
, omark
, nmark
;
890 struct gcpro gcpro1
, gcpro2
, gcpro3
;
893 tem
= Fmarker_buffer (XCAR (info
));
894 /* If buffer being returned to is now deleted, avoid error */
895 /* Otherwise could get error here while unwinding to top level
897 /* In that case, Fmarker_buffer returns nil now. */
901 omark
= nmark
= Qnil
;
902 GCPRO3 (info
, omark
, nmark
);
909 unchain_marker (XMARKER (tem
));
914 omark
= Fmarker_position (current_buffer
->mark
);
915 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
916 nmark
= Fmarker_position (tem
);
917 unchain_marker (XMARKER (tem
));
921 visible_p
= !NILP (XCAR (info
));
923 #if 0 /* We used to make the current buffer visible in the selected window
924 if that was true previously. That avoids some anomalies.
925 But it creates others, and it wasn't documented, and it is simpler
926 and cleaner never to alter the window/buffer connections. */
929 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
930 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
936 tem1
= current_buffer
->mark_active
;
937 current_buffer
->mark_active
= tem
;
939 if (!NILP (Vrun_hooks
))
941 /* If mark is active now, and either was not active
942 or was at a different place, run the activate hook. */
943 if (! NILP (current_buffer
->mark_active
))
945 if (! EQ (omark
, nmark
))
946 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
948 /* If mark has ceased to be active, run deactivate hook. */
949 else if (! NILP (tem1
))
950 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
953 /* If buffer was visible in a window, and a different window was
954 selected, and the old selected window is still showing this
955 buffer, restore point in that window. */
958 && !EQ (tem
, selected_window
)
959 && (tem1
= XWINDOW (tem
)->buffer
,
960 (/* Window is live... */
962 /* ...and it shows the current buffer. */
963 && XBUFFER (tem1
) == current_buffer
)))
964 Fset_window_point (tem
, make_number (PT
));
970 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
971 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
972 Executes BODY just like `progn'.
973 The values of point, mark and the current buffer are restored
974 even in case of abnormal exit (throw or error).
975 The state of activation of the mark is also restored.
977 This construct does not save `deactivate-mark', and therefore
978 functions that change the buffer will still cause deactivation
979 of the mark at the end of the command. To prevent that, bind
980 `deactivate-mark' with `let'.
982 If you only want to save the current buffer but not point nor mark,
983 then just use `save-current-buffer', or even `with-current-buffer'.
985 usage: (save-excursion &rest BODY) */)
988 register Lisp_Object val
;
989 int count
= SPECPDL_INDEX ();
991 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
994 return unbind_to (count
, val
);
997 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
998 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
999 Executes BODY just like `progn'.
1000 usage: (save-current-buffer &rest BODY) */)
1004 int count
= SPECPDL_INDEX ();
1006 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
1008 val
= Fprogn (args
);
1009 return unbind_to (count
, val
);
1012 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1013 doc
: /* Return the number of characters in the current buffer.
1014 If BUFFER, return the number of characters in that buffer instead. */)
1015 (Lisp_Object buffer
)
1018 return make_number (Z
- BEG
);
1021 CHECK_BUFFER (buffer
);
1022 return make_number (BUF_Z (XBUFFER (buffer
))
1023 - BUF_BEG (XBUFFER (buffer
)));
1027 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1028 doc
: /* Return the minimum permissible value of point in the current buffer.
1029 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1033 XSETFASTINT (temp
, BEGV
);
1037 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1038 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1039 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1042 return buildmark (BEGV
, BEGV_BYTE
);
1045 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1046 doc
: /* Return the maximum permissible value of point in the current buffer.
1047 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1048 is in effect, in which case it is less. */)
1052 XSETFASTINT (temp
, ZV
);
1056 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1057 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1058 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1059 is in effect, in which case it is less. */)
1062 return buildmark (ZV
, ZV_BYTE
);
1065 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1066 doc
: /* Return the position of the gap, in the current buffer.
1067 See also `gap-size'. */)
1071 XSETFASTINT (temp
, GPT
);
1075 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1076 doc
: /* Return the size of the current buffer's gap.
1077 See also `gap-position'. */)
1081 XSETFASTINT (temp
, GAP_SIZE
);
1085 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1086 doc
: /* Return the byte position for character position POSITION.
1087 If POSITION is out of range, the value is nil. */)
1088 (Lisp_Object position
)
1090 CHECK_NUMBER_COERCE_MARKER (position
);
1091 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1093 return make_number (CHAR_TO_BYTE (XINT (position
)));
1096 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1097 doc
: /* Return the character position for byte position BYTEPOS.
1098 If BYTEPOS is out of range, the value is nil. */)
1099 (Lisp_Object bytepos
)
1101 CHECK_NUMBER (bytepos
);
1102 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1104 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1107 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1108 doc
: /* Return the character following point, as a number.
1109 At the end of the buffer or accessible region, return 0. */)
1114 XSETFASTINT (temp
, 0);
1116 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1120 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1121 doc
: /* Return the character preceding point, as a number.
1122 At the beginning of the buffer or accessible region, return 0. */)
1127 XSETFASTINT (temp
, 0);
1128 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1132 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1135 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1139 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1140 doc
: /* Return t if point is at the beginning of the buffer.
1141 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1149 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1150 doc
: /* Return t if point is at the end of the buffer.
1151 If the buffer is narrowed, this means the end of the narrowed part. */)
1159 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1160 doc
: /* Return t if point is at the beginning of a line. */)
1163 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1168 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1169 doc
: /* Return t if point is at the end of a line.
1170 `End of a line' includes point being at the end of the buffer. */)
1173 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1178 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1179 doc
: /* Return character in current buffer at position POS.
1180 POS is an integer or a marker and defaults to point.
1181 If POS is out of range, the value is nil. */)
1184 register int pos_byte
;
1189 XSETFASTINT (pos
, PT
);
1194 pos_byte
= marker_byte_position (pos
);
1195 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1200 CHECK_NUMBER_COERCE_MARKER (pos
);
1201 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1204 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1207 return make_number (FETCH_CHAR (pos_byte
));
1210 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1211 doc
: /* Return character in current buffer preceding position POS.
1212 POS is an integer or a marker and defaults to point.
1213 If POS is out of range, the value is nil. */)
1216 register Lisp_Object val
;
1217 register int pos_byte
;
1222 XSETFASTINT (pos
, PT
);
1227 pos_byte
= marker_byte_position (pos
);
1229 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1234 CHECK_NUMBER_COERCE_MARKER (pos
);
1236 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1239 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1242 if (!NILP (current_buffer
->enable_multibyte_characters
))
1245 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1250 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1255 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1256 doc
: /* Return the name under which the user logged in, as a string.
1257 This is based on the effective uid, not the real uid.
1258 Also, if the environment variables LOGNAME or USER are set,
1259 that determines the value of this function.
1261 If optional argument UID is an integer or a float, return the login name
1262 of the user with that uid, or nil if there is no such user. */)
1268 /* Set up the user name info if we didn't do it before.
1269 (That can happen if Emacs is dumpable
1270 but you decide to run `temacs -l loadup' and not dump. */
1271 if (INTEGERP (Vuser_login_name
))
1275 return Vuser_login_name
;
1277 id
= (uid_t
)XFLOATINT (uid
);
1279 pw
= (struct passwd
*) getpwuid (id
);
1281 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1284 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1286 doc
: /* Return the name of the user's real uid, as a string.
1287 This ignores the environment variables LOGNAME and USER, so it differs from
1288 `user-login-name' when running under `su'. */)
1291 /* Set up the user name info if we didn't do it before.
1292 (That can happen if Emacs is dumpable
1293 but you decide to run `temacs -l loadup' and not dump. */
1294 if (INTEGERP (Vuser_login_name
))
1296 return Vuser_real_login_name
;
1299 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1300 doc
: /* Return the effective uid of Emacs.
1301 Value is an integer or a float, depending on the value. */)
1304 /* Assignment to EMACS_INT stops GCC whining about limited range of
1306 EMACS_INT euid
= geteuid ();
1308 /* Make sure we don't produce a negative UID due to signed integer
1311 return make_float ((double)geteuid ());
1312 return make_fixnum_or_float (euid
);
1315 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1316 doc
: /* Return the real uid of Emacs.
1317 Value is an integer or a float, depending on the value. */)
1320 /* Assignment to EMACS_INT stops GCC whining about limited range of
1322 EMACS_INT uid
= getuid ();
1324 /* Make sure we don't produce a negative UID due to signed integer
1327 return make_float ((double)getuid ());
1328 return make_fixnum_or_float (uid
);
1331 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1332 doc
: /* Return the full name of the user logged in, as a string.
1333 If the full name corresponding to Emacs's userid is not known,
1336 If optional argument UID is an integer or float, return the full name
1337 of the user with that uid, or nil if there is no such user.
1338 If UID is a string, return the full name of the user with that login
1339 name, or nil if there is no such user. */)
1343 register unsigned char *p
, *q
;
1347 return Vuser_full_name
;
1348 else if (NUMBERP (uid
))
1351 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1354 else if (STRINGP (uid
))
1357 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1361 error ("Invalid UID specification");
1366 p
= (unsigned char *) USER_FULL_NAME
;
1367 /* Chop off everything after the first comma. */
1368 q
= (unsigned char *) strchr (p
, ',');
1369 full
= make_string (p
, q
? q
- p
: strlen (p
));
1371 #ifdef AMPERSAND_FULL_NAME
1373 q
= (unsigned char *) strchr (p
, '&');
1374 /* Substitute the login name for the &, upcasing the first character. */
1377 register unsigned char *r
;
1380 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1381 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1382 memcpy (r
, p
, q
- p
);
1384 strcat (r
, SDATA (login
));
1385 r
[q
- p
] = UPCASE (r
[q
- p
]);
1387 full
= build_string (r
);
1389 #endif /* AMPERSAND_FULL_NAME */
1394 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1395 doc
: /* Return the host name of the machine you are running on, as a string. */)
1398 return Vsystem_name
;
1401 /* For the benefit of callers who don't want to include lisp.h */
1404 get_system_name (void)
1406 if (STRINGP (Vsystem_name
))
1407 return (char *) SDATA (Vsystem_name
);
1413 get_operating_system_release (void)
1415 if (STRINGP (Voperating_system_release
))
1416 return (char *) SDATA (Voperating_system_release
);
1421 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1422 doc
: /* Return the process ID of Emacs, as an integer. */)
1425 return make_number (getpid ());
1428 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1429 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1430 The time is returned as a list of three integers. The first has the
1431 most significant 16 bits of the seconds, while the second has the
1432 least significant 16 bits. The third integer gives the microsecond
1435 The microsecond count is zero on systems that do not provide
1436 resolution finer than a second. */)
1442 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1443 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1444 make_number (EMACS_USECS (t
)));
1447 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1449 doc
: /* Return the current run time used by Emacs.
1450 The time is returned as a list of three integers. The first has the
1451 most significant 16 bits of the seconds, while the second has the
1452 least significant 16 bits. The third integer gives the microsecond
1455 On systems that can't determine the run time, `get-internal-run-time'
1456 does the same thing as `current-time'. The microsecond count is zero
1457 on systems that do not provide resolution finer than a second. */)
1460 #ifdef HAVE_GETRUSAGE
1461 struct rusage usage
;
1464 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1465 /* This shouldn't happen. What action is appropriate? */
1468 /* Sum up user time and system time. */
1469 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1470 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1471 if (usecs
>= 1000000)
1477 return list3 (make_number ((secs
>> 16) & 0xffff),
1478 make_number ((secs
>> 0) & 0xffff),
1479 make_number (usecs
));
1480 #else /* ! HAVE_GETRUSAGE */
1482 return w32_get_internal_run_time ();
1483 #else /* ! WINDOWSNT */
1484 return Fcurrent_time ();
1485 #endif /* WINDOWSNT */
1486 #endif /* HAVE_GETRUSAGE */
1491 lisp_time_argument (Lisp_Object specified_time
, time_t *result
, int *usec
)
1493 if (NILP (specified_time
))
1500 *usec
= EMACS_USECS (t
);
1501 *result
= EMACS_SECS (t
);
1505 return time (result
) != -1;
1509 Lisp_Object high
, low
;
1510 high
= Fcar (specified_time
);
1511 CHECK_NUMBER (high
);
1512 low
= Fcdr (specified_time
);
1517 Lisp_Object usec_l
= Fcdr (low
);
1519 usec_l
= Fcar (usec_l
);
1524 CHECK_NUMBER (usec_l
);
1525 *usec
= XINT (usec_l
);
1533 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1534 return *result
>> 16 == XINT (high
);
1538 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1539 doc
: /* Return the current time, as a float number of seconds since the epoch.
1540 If SPECIFIED-TIME is given, it is the time to convert to float
1541 instead of the current time. The argument should have the form
1542 (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
1543 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1544 have the form (HIGH . LOW), but this is considered obsolete.
1546 WARNING: Since the result is floating point, it may not be exact.
1547 If precise time stamps are required, use either `current-time',
1548 or (if you need time as a string) `format-time-string'. */)
1549 (Lisp_Object specified_time
)
1554 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1555 error ("Invalid time specification");
1557 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1560 /* Write information into buffer S of size MAXSIZE, according to the
1561 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1562 Default to Universal Time if UT is nonzero, local time otherwise.
1563 Return the number of bytes written, not including the terminating
1564 '\0'. If S is NULL, nothing will be written anywhere; so to
1565 determine how many bytes would be written, use NULL for S and
1566 ((size_t) -1) for MAXSIZE.
1568 This function behaves like emacs_strftimeu, except it allows null
1571 emacs_memftimeu (char *s
, size_t maxsize
, const char *format
, size_t format_len
, const struct tm
*tp
, int ut
)
1575 /* Loop through all the null-terminated strings in the format
1576 argument. Normally there's just one null-terminated string, but
1577 there can be arbitrarily many, concatenated together, if the
1578 format contains '\0' bytes. emacs_strftimeu stops at the first
1579 '\0' byte so we must invoke it separately for each such string. */
1588 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1592 if (result
== 0 && s
[0] != '\0')
1597 maxsize
-= result
+ 1;
1599 len
= strlen (format
);
1600 if (len
== format_len
)
1604 format_len
-= len
+ 1;
1608 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1609 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1610 TIME is specified as (HIGH LOW . IGNORED), as returned by
1611 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1612 is also still accepted.
1613 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1614 as Universal Time; nil means describe TIME in the local time zone.
1615 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1616 by text that describes the specified date and time in TIME:
1618 %Y is the year, %y within the century, %C the century.
1619 %G is the year corresponding to the ISO week, %g within the century.
1620 %m is the numeric month.
1621 %b and %h are the locale's abbreviated month name, %B the full name.
1622 %d is the day of the month, zero-padded, %e is blank-padded.
1623 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1624 %a is the locale's abbreviated name of the day of week, %A the full name.
1625 %U is the week number starting on Sunday, %W starting on Monday,
1626 %V according to ISO 8601.
1627 %j is the day of the year.
1629 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1630 only blank-padded, %l is like %I blank-padded.
1631 %p is the locale's equivalent of either AM or PM.
1634 %Z is the time zone name, %z is the numeric form.
1635 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1637 %c is the locale's date and time format.
1638 %x is the locale's "preferred" date format.
1639 %D is like "%m/%d/%y".
1641 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1642 %X is the locale's "preferred" time format.
1644 Finally, %n is a newline, %t is a tab, %% is a literal %.
1646 Certain flags and modifiers are available with some format controls.
1647 The flags are `_', `-', `^' and `#'. For certain characters X,
1648 %_X is like %X, but padded with blanks; %-X is like %X,
1649 but without padding. %^X is like %X, but with all textual
1650 characters up-cased; %#X is like %X, but with letter-case of
1651 all textual characters reversed.
1652 %NX (where N stands for an integer) is like %X,
1653 but takes up at least N (a number) positions.
1654 The modifiers are `E' and `O'. For certain characters X,
1655 %EX is a locale's alternative version of %X;
1656 %OX is like %X, but uses the locale's number symbols.
1658 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1659 (Lisp_Object format_string
, Lisp_Object time
, Lisp_Object universal
)
1664 int ut
= ! NILP (universal
);
1666 CHECK_STRING (format_string
);
1668 if (! lisp_time_argument (time
, &value
, NULL
))
1669 error ("Invalid time specification");
1671 format_string
= code_convert_string_norecord (format_string
,
1672 Vlocale_coding_system
, 1);
1674 /* This is probably enough. */
1675 size
= SBYTES (format_string
) * 6 + 50;
1678 tm
= ut
? gmtime (&value
) : localtime (&value
);
1681 error ("Specified time is not representable");
1683 synchronize_system_time_locale ();
1687 char *buf
= (char *) alloca (size
+ 1);
1692 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1693 SBYTES (format_string
),
1696 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1697 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1698 Vlocale_coding_system
, 0);
1700 /* If buffer was too small, make it bigger and try again. */
1702 result
= emacs_memftimeu (NULL
, (size_t) -1,
1703 SDATA (format_string
),
1704 SBYTES (format_string
),
1711 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1712 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1713 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1714 as from `current-time' and `file-attributes', or nil to use the
1715 current time. The obsolete form (HIGH . LOW) is also still accepted.
1716 The list has the following nine members: SEC is an integer between 0
1717 and 60; SEC is 60 for a leap second, which only some operating systems
1718 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1719 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1720 integer between 1 and 12. YEAR is an integer indicating the
1721 four-digit year. DOW is the day of week, an integer between 0 and 6,
1722 where 0 is Sunday. DST is t if daylight saving time is in effect,
1723 otherwise nil. ZONE is an integer indicating the number of seconds
1724 east of Greenwich. (Note that Common Lisp has different meanings for
1726 (Lisp_Object specified_time
)
1730 struct tm
*decoded_time
;
1731 Lisp_Object list_args
[9];
1733 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1734 error ("Invalid time specification");
1737 decoded_time
= localtime (&time_spec
);
1740 error ("Specified time is not representable");
1741 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1742 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1743 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1744 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1745 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1746 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1747 cast below avoids overflow in int arithmetics. */
1748 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1749 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1750 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1752 /* Make a copy, in case gmtime modifies the struct. */
1753 save_tm
= *decoded_time
;
1755 decoded_time
= gmtime (&time_spec
);
1757 if (decoded_time
== 0)
1758 list_args
[8] = Qnil
;
1760 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1761 return Flist (9, list_args
);
1764 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1765 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1766 This is the reverse operation of `decode-time', which see.
1767 ZONE defaults to the current time zone rule. This can
1768 be a string or t (as from `set-time-zone-rule'), or it can be a list
1769 \(as from `current-time-zone') or an integer (as from `decode-time')
1770 applied without consideration for daylight saving time.
1772 You can pass more than 7 arguments; then the first six arguments
1773 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1774 The intervening arguments are ignored.
1775 This feature lets (apply 'encode-time (decode-time ...)) work.
1777 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1778 for example, a DAY of 0 means the day preceding the given month.
1779 Year numbers less than 100 are treated just like other year numbers.
1780 If you want them to stand for years in this century, you must do that yourself.
1782 Years before 1970 are not guaranteed to work. On some systems,
1783 year values as low as 1901 do work.
1785 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1786 (int nargs
, register Lisp_Object
*args
)
1790 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1792 CHECK_NUMBER (args
[0]); /* second */
1793 CHECK_NUMBER (args
[1]); /* minute */
1794 CHECK_NUMBER (args
[2]); /* hour */
1795 CHECK_NUMBER (args
[3]); /* day */
1796 CHECK_NUMBER (args
[4]); /* month */
1797 CHECK_NUMBER (args
[5]); /* year */
1799 tm
.tm_sec
= XINT (args
[0]);
1800 tm
.tm_min
= XINT (args
[1]);
1801 tm
.tm_hour
= XINT (args
[2]);
1802 tm
.tm_mday
= XINT (args
[3]);
1803 tm
.tm_mon
= XINT (args
[4]) - 1;
1804 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1812 time
= mktime (&tm
);
1819 char **oldenv
= environ
, **newenv
;
1823 else if (STRINGP (zone
))
1824 tzstring
= (char *) SDATA (zone
);
1825 else if (INTEGERP (zone
))
1827 int abszone
= eabs (XINT (zone
));
1828 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1829 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1833 error ("Invalid time zone specification");
1835 /* Set TZ before calling mktime; merely adjusting mktime's returned
1836 value doesn't suffice, since that would mishandle leap seconds. */
1837 set_time_zone_rule (tzstring
);
1840 time
= mktime (&tm
);
1843 /* Restore TZ to previous value. */
1847 #ifdef LOCALTIME_CACHE
1852 if (time
== (time_t) -1)
1853 error ("Specified time is not representable");
1855 return make_time (time
);
1858 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1859 doc
: /* Return the current local time, as a human-readable string.
1860 Programs can use this function to decode a time,
1861 since the number of columns in each field is fixed
1862 if the year is in the range 1000-9999.
1863 The format is `Sun Sep 16 01:03:52 1973'.
1864 However, see also the functions `decode-time' and `format-time-string'
1865 which provide a much more powerful and general facility.
1867 If SPECIFIED-TIME is given, it is a time to format instead of the
1868 current time. The argument should have the form (HIGH LOW . IGNORED).
1869 Thus, you can use times obtained from `current-time' and from
1870 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1871 but this is considered obsolete. */)
1872 (Lisp_Object specified_time
)
1878 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1879 error ("Invalid time specification");
1881 /* Convert to a string, checking for out-of-range time stamps.
1882 Don't use 'ctime', as that might dump core if VALUE is out of
1885 tm
= localtime (&value
);
1887 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1888 error ("Specified time is not representable");
1890 /* Remove the trailing newline. */
1891 tem
[strlen (tem
) - 1] = '\0';
1893 return build_string (tem
);
1896 /* Yield A - B, measured in seconds.
1897 This function is copied from the GNU C Library. */
1899 tm_diff (struct tm
*a
, struct tm
*b
)
1901 /* Compute intervening leap days correctly even if year is negative.
1902 Take care to avoid int overflow in leap day calculations,
1903 but it's OK to assume that A and B are close to each other. */
1904 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1905 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1906 int a100
= a4
/ 25 - (a4
% 25 < 0);
1907 int b100
= b4
/ 25 - (b4
% 25 < 0);
1908 int a400
= a100
>> 2;
1909 int b400
= b100
>> 2;
1910 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1911 int years
= a
->tm_year
- b
->tm_year
;
1912 int days
= (365 * years
+ intervening_leap_days
1913 + (a
->tm_yday
- b
->tm_yday
));
1914 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1915 + (a
->tm_min
- b
->tm_min
))
1916 + (a
->tm_sec
- b
->tm_sec
));
1919 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1920 doc
: /* Return the offset and name for the local time zone.
1921 This returns a list of the form (OFFSET NAME).
1922 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1923 A negative value means west of Greenwich.
1924 NAME is a string giving the name of the time zone.
1925 If SPECIFIED-TIME is given, the time zone offset is determined from it
1926 instead of using the current time. The argument should have the form
1927 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1928 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1929 have the form (HIGH . LOW), but this is considered obsolete.
1931 Some operating systems cannot provide all this information to Emacs;
1932 in this case, `current-time-zone' returns a list containing nil for
1933 the data it can't find. */)
1934 (Lisp_Object specified_time
)
1940 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1945 t
= gmtime (&value
);
1949 t
= localtime (&value
);
1956 int offset
= tm_diff (t
, &gmt
);
1962 s
= (char *)t
->tm_zone
;
1963 #else /* not HAVE_TM_ZONE */
1965 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1966 s
= tzname
[t
->tm_isdst
];
1968 #endif /* not HAVE_TM_ZONE */
1972 /* No local time zone name is available; use "+-NNNN" instead. */
1973 int am
= (offset
< 0 ? -offset
: offset
) / 60;
1974 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
1978 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
1981 return Fmake_list (make_number (2), Qnil
);
1984 /* This holds the value of `environ' produced by the previous
1985 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
1986 has never been called. */
1987 static char **environbuf
;
1989 /* This holds the startup value of the TZ environment variable so it
1990 can be restored if the user calls set-time-zone-rule with a nil
1992 static char *initial_tz
;
1994 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
1995 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
1996 If TZ is nil, use implementation-defined default time zone information.
1997 If TZ is t, use Universal Time. */)
2002 /* When called for the first time, save the original TZ. */
2004 initial_tz
= (char *) getenv ("TZ");
2007 tzstring
= initial_tz
;
2008 else if (EQ (tz
, Qt
))
2013 tzstring
= (char *) SDATA (tz
);
2016 set_time_zone_rule (tzstring
);
2018 environbuf
= environ
;
2023 #ifdef LOCALTIME_CACHE
2025 /* These two values are known to load tz files in buggy implementations,
2026 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2027 Their values shouldn't matter in non-buggy implementations.
2028 We don't use string literals for these strings,
2029 since if a string in the environment is in readonly
2030 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2031 See Sun bugs 1113095 and 1114114, ``Timezone routines
2032 improperly modify environment''. */
2034 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2035 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2039 /* Set the local time zone rule to TZSTRING.
2040 This allocates memory into `environ', which it is the caller's
2041 responsibility to free. */
2044 set_time_zone_rule (const char *tzstring
)
2047 char **from
, **to
, **newenv
;
2049 /* Make the ENVIRON vector longer with room for TZSTRING. */
2050 for (from
= environ
; *from
; from
++)
2052 envptrs
= from
- environ
+ 2;
2053 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2054 + (tzstring
? strlen (tzstring
) + 4 : 0));
2056 /* Add TZSTRING to the end of environ, as a value for TZ. */
2059 char *t
= (char *) (to
+ envptrs
);
2061 strcat (t
, tzstring
);
2065 /* Copy the old environ vector elements into NEWENV,
2066 but don't copy the TZ variable.
2067 So we have only one definition of TZ, which came from TZSTRING. */
2068 for (from
= environ
; *from
; from
++)
2069 if (strncmp (*from
, "TZ=", 3) != 0)
2075 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2076 the TZ variable is stored. If we do not have a TZSTRING,
2077 TO points to the vector slot which has the terminating null. */
2079 #ifdef LOCALTIME_CACHE
2081 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2082 "US/Pacific" that loads a tz file, then changes to a value like
2083 "XXX0" that does not load a tz file, and then changes back to
2084 its original value, the last change is (incorrectly) ignored.
2085 Also, if TZ changes twice in succession to values that do
2086 not load a tz file, tzset can dump core (see Sun bug#1225179).
2087 The following code works around these bugs. */
2091 /* Temporarily set TZ to a value that loads a tz file
2092 and that differs from tzstring. */
2094 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2095 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2101 /* The implied tzstring is unknown, so temporarily set TZ to
2102 two different values that each load a tz file. */
2103 *to
= set_time_zone_rule_tz1
;
2106 *to
= set_time_zone_rule_tz2
;
2111 /* Now TZ has the desired value, and tzset can be invoked safely. */
2118 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2119 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2120 type of object is Lisp_String). INHERIT is passed to
2121 INSERT_FROM_STRING_FUNC as the last argument. */
2124 general_insert_function (void (*insert_func
)
2125 (const unsigned char *, EMACS_INT
),
2126 void (*insert_from_string_func
)
2127 (Lisp_Object
, EMACS_INT
, EMACS_INT
,
2128 EMACS_INT
, EMACS_INT
, int),
2129 int inherit
, int nargs
, Lisp_Object
*args
)
2131 register int argnum
;
2132 register Lisp_Object val
;
2134 for (argnum
= 0; argnum
< nargs
; argnum
++)
2137 if (CHARACTERP (val
))
2139 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2142 if (!NILP (current_buffer
->enable_multibyte_characters
))
2143 len
= CHAR_STRING (XFASTINT (val
), str
);
2146 str
[0] = (ASCII_CHAR_P (XINT (val
))
2148 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2151 (*insert_func
) (str
, len
);
2153 else if (STRINGP (val
))
2155 (*insert_from_string_func
) (val
, 0, 0,
2161 wrong_type_argument (Qchar_or_string_p
, val
);
2166 insert1 (Lisp_Object arg
)
2172 /* Callers passing one argument to Finsert need not gcpro the
2173 argument "array", since the only element of the array will
2174 not be used after calling insert or insert_from_string, so
2175 we don't care if it gets trashed. */
2177 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2178 doc
: /* Insert the arguments, either strings or characters, at point.
2179 Point and before-insertion markers move forward to end up
2180 after the inserted text.
2181 Any other markers at the point of insertion remain before the text.
2183 If the current buffer is multibyte, unibyte strings are converted
2184 to multibyte for insertion (see `string-make-multibyte').
2185 If the current buffer is unibyte, multibyte strings are converted
2186 to unibyte for insertion (see `string-make-unibyte').
2188 When operating on binary data, it may be necessary to preserve the
2189 original bytes of a unibyte string when inserting it into a multibyte
2190 buffer; to accomplish this, apply `string-as-multibyte' to the string
2191 and insert the result.
2193 usage: (insert &rest ARGS) */)
2194 (int nargs
, register Lisp_Object
*args
)
2196 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2200 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2202 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2203 Point and before-insertion markers move forward to end up
2204 after the inserted text.
2205 Any other markers at the point of insertion remain before the text.
2207 If the current buffer is multibyte, unibyte strings are converted
2208 to multibyte for insertion (see `unibyte-char-to-multibyte').
2209 If the current buffer is unibyte, multibyte strings are converted
2210 to unibyte for insertion.
2212 usage: (insert-and-inherit &rest ARGS) */)
2213 (int nargs
, register Lisp_Object
*args
)
2215 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2220 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2221 doc
: /* Insert strings or characters at point, relocating markers after the text.
2222 Point and markers move forward to end up after the inserted text.
2224 If the current buffer is multibyte, unibyte strings are converted
2225 to multibyte for insertion (see `unibyte-char-to-multibyte').
2226 If the current buffer is unibyte, multibyte strings are converted
2227 to unibyte for insertion.
2229 usage: (insert-before-markers &rest ARGS) */)
2230 (int nargs
, register Lisp_Object
*args
)
2232 general_insert_function (insert_before_markers
,
2233 insert_from_string_before_markers
, 0,
2238 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2239 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2240 doc
: /* Insert text at point, relocating markers and inheriting properties.
2241 Point and markers move forward to end up after the inserted text.
2243 If the current buffer is multibyte, unibyte strings are converted
2244 to multibyte for insertion (see `unibyte-char-to-multibyte').
2245 If the current buffer is unibyte, multibyte strings are converted
2246 to unibyte for insertion.
2248 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2249 (int nargs
, register Lisp_Object
*args
)
2251 general_insert_function (insert_before_markers_and_inherit
,
2252 insert_from_string_before_markers
, 1,
2257 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2258 doc
: /* Insert COUNT copies of CHARACTER.
2259 Point, and before-insertion markers, are relocated as in the function `insert'.
2260 The optional third arg INHERIT, if non-nil, says to inherit text properties
2261 from adjoining text, if those properties are sticky. */)
2262 (Lisp_Object character
, Lisp_Object count
, Lisp_Object inherit
)
2264 register unsigned char *string
;
2265 register int strlen
;
2268 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2270 CHECK_NUMBER (character
);
2271 CHECK_NUMBER (count
);
2273 if (!NILP (current_buffer
->enable_multibyte_characters
))
2274 len
= CHAR_STRING (XFASTINT (character
), str
);
2276 str
[0] = XFASTINT (character
), len
= 1;
2277 n
= XINT (count
) * len
;
2280 strlen
= min (n
, 256 * len
);
2281 string
= (unsigned char *) alloca (strlen
);
2282 for (i
= 0; i
< strlen
; i
++)
2283 string
[i
] = str
[i
% len
];
2287 if (!NILP (inherit
))
2288 insert_and_inherit (string
, strlen
);
2290 insert (string
, strlen
);
2295 if (!NILP (inherit
))
2296 insert_and_inherit (string
, n
);
2303 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2304 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2305 Both arguments are required.
2306 BYTE is a number of the range 0..255.
2308 If BYTE is 128..255 and the current buffer is multibyte, the
2309 corresponding eight-bit character is inserted.
2311 Point, and before-insertion markers, are relocated as in the function `insert'.
2312 The optional third arg INHERIT, if non-nil, says to inherit text properties
2313 from adjoining text, if those properties are sticky. */)
2314 (Lisp_Object byte
, Lisp_Object count
, Lisp_Object inherit
)
2316 CHECK_NUMBER (byte
);
2317 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2318 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2319 if (XINT (byte
) >= 128
2320 && ! NILP (current_buffer
->enable_multibyte_characters
))
2321 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2322 return Finsert_char (byte
, count
, inherit
);
2326 /* Making strings from buffer contents. */
2328 /* Return a Lisp_String containing the text of the current buffer from
2329 START to END. If text properties are in use and the current buffer
2330 has properties in the range specified, the resulting string will also
2331 have them, if PROPS is nonzero.
2333 We don't want to use plain old make_string here, because it calls
2334 make_uninit_string, which can cause the buffer arena to be
2335 compacted. make_string has no way of knowing that the data has
2336 been moved, and thus copies the wrong data into the string. This
2337 doesn't effect most of the other users of make_string, so it should
2338 be left as is. But we should use this function when conjuring
2339 buffer substrings. */
2342 make_buffer_string (int start
, int end
, int props
)
2344 int start_byte
= CHAR_TO_BYTE (start
);
2345 int end_byte
= CHAR_TO_BYTE (end
);
2347 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2350 /* Return a Lisp_String containing the text of the current buffer from
2351 START / START_BYTE to END / END_BYTE.
2353 If text properties are in use and the current buffer
2354 has properties in the range specified, the resulting string will also
2355 have them, if PROPS is nonzero.
2357 We don't want to use plain old make_string here, because it calls
2358 make_uninit_string, which can cause the buffer arena to be
2359 compacted. make_string has no way of knowing that the data has
2360 been moved, and thus copies the wrong data into the string. This
2361 doesn't effect most of the other users of make_string, so it should
2362 be left as is. But we should use this function when conjuring
2363 buffer substrings. */
2366 make_buffer_string_both (int start
, int start_byte
, int end
, int end_byte
, int props
)
2368 Lisp_Object result
, tem
, tem1
;
2370 if (start
< GPT
&& GPT
< end
)
2373 if (! NILP (current_buffer
->enable_multibyte_characters
))
2374 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2376 result
= make_uninit_string (end
- start
);
2377 memcpy (SDATA (result
), BYTE_POS_ADDR (start_byte
), end_byte
- start_byte
);
2379 /* If desired, update and copy the text properties. */
2382 update_buffer_properties (start
, end
);
2384 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2385 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2387 if (XINT (tem
) != end
|| !NILP (tem1
))
2388 copy_intervals_to_string (result
, current_buffer
, start
,
2395 /* Call Vbuffer_access_fontify_functions for the range START ... END
2396 in the current buffer, if necessary. */
2399 update_buffer_properties (int start
, int end
)
2401 /* If this buffer has some access functions,
2402 call them, specifying the range of the buffer being accessed. */
2403 if (!NILP (Vbuffer_access_fontify_functions
))
2405 Lisp_Object args
[3];
2408 args
[0] = Qbuffer_access_fontify_functions
;
2409 XSETINT (args
[1], start
);
2410 XSETINT (args
[2], end
);
2412 /* But don't call them if we can tell that the work
2413 has already been done. */
2414 if (!NILP (Vbuffer_access_fontified_property
))
2416 tem
= Ftext_property_any (args
[1], args
[2],
2417 Vbuffer_access_fontified_property
,
2420 Frun_hook_with_args (3, args
);
2423 Frun_hook_with_args (3, args
);
2427 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2428 doc
: /* Return the contents of part of the current buffer as a string.
2429 The two arguments START and END are character positions;
2430 they can be in either order.
2431 The string returned is multibyte if the buffer is multibyte.
2433 This function copies the text properties of that part of the buffer
2434 into the result string; if you don't want the text properties,
2435 use `buffer-substring-no-properties' instead. */)
2436 (Lisp_Object start
, Lisp_Object end
)
2440 validate_region (&start
, &end
);
2444 return make_buffer_string (b
, e
, 1);
2447 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2448 Sbuffer_substring_no_properties
, 2, 2, 0,
2449 doc
: /* Return the characters of part of the buffer, without the text properties.
2450 The two arguments START and END are character positions;
2451 they can be in either order. */)
2452 (Lisp_Object start
, Lisp_Object end
)
2456 validate_region (&start
, &end
);
2460 return make_buffer_string (b
, e
, 0);
2463 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2464 doc
: /* Return the contents of the current buffer as a string.
2465 If narrowing is in effect, this function returns only the visible part
2469 return make_buffer_string (BEGV
, ZV
, 1);
2472 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2474 doc
: /* Insert before point a substring of the contents of BUFFER.
2475 BUFFER may be a buffer or a buffer name.
2476 Arguments START and END are character positions specifying the substring.
2477 They default to the values of (point-min) and (point-max) in BUFFER. */)
2478 (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
2480 register int b
, e
, temp
;
2481 register struct buffer
*bp
, *obuf
;
2484 buf
= Fget_buffer (buffer
);
2488 if (NILP (bp
->name
))
2489 error ("Selecting deleted buffer");
2495 CHECK_NUMBER_COERCE_MARKER (start
);
2502 CHECK_NUMBER_COERCE_MARKER (end
);
2507 temp
= b
, b
= e
, e
= temp
;
2509 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2510 args_out_of_range (start
, end
);
2512 obuf
= current_buffer
;
2513 set_buffer_internal_1 (bp
);
2514 update_buffer_properties (b
, e
);
2515 set_buffer_internal_1 (obuf
);
2517 insert_from_buffer (bp
, b
, e
- b
, 0);
2521 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2523 doc
: /* Compare two substrings of two buffers; return result as number.
2524 the value is -N if first string is less after N-1 chars,
2525 +N if first string is greater after N-1 chars, or 0 if strings match.
2526 Each substring is represented as three arguments: BUFFER, START and END.
2527 That makes six args in all, three for each substring.
2529 The value of `case-fold-search' in the current buffer
2530 determines whether case is significant or ignored. */)
2531 (Lisp_Object buffer1
, Lisp_Object start1
, Lisp_Object end1
, Lisp_Object buffer2
, Lisp_Object start2
, Lisp_Object end2
)
2533 register int begp1
, endp1
, begp2
, endp2
, temp
;
2534 register struct buffer
*bp1
, *bp2
;
2535 register Lisp_Object trt
2536 = (!NILP (current_buffer
->case_fold_search
)
2537 ? current_buffer
->case_canon_table
: Qnil
);
2539 int i1
, i2
, i1_byte
, i2_byte
;
2541 /* Find the first buffer and its substring. */
2544 bp1
= current_buffer
;
2548 buf1
= Fget_buffer (buffer1
);
2551 bp1
= XBUFFER (buf1
);
2552 if (NILP (bp1
->name
))
2553 error ("Selecting deleted buffer");
2557 begp1
= BUF_BEGV (bp1
);
2560 CHECK_NUMBER_COERCE_MARKER (start1
);
2561 begp1
= XINT (start1
);
2564 endp1
= BUF_ZV (bp1
);
2567 CHECK_NUMBER_COERCE_MARKER (end1
);
2568 endp1
= XINT (end1
);
2572 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2574 if (!(BUF_BEGV (bp1
) <= begp1
2576 && endp1
<= BUF_ZV (bp1
)))
2577 args_out_of_range (start1
, end1
);
2579 /* Likewise for second substring. */
2582 bp2
= current_buffer
;
2586 buf2
= Fget_buffer (buffer2
);
2589 bp2
= XBUFFER (buf2
);
2590 if (NILP (bp2
->name
))
2591 error ("Selecting deleted buffer");
2595 begp2
= BUF_BEGV (bp2
);
2598 CHECK_NUMBER_COERCE_MARKER (start2
);
2599 begp2
= XINT (start2
);
2602 endp2
= BUF_ZV (bp2
);
2605 CHECK_NUMBER_COERCE_MARKER (end2
);
2606 endp2
= XINT (end2
);
2610 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2612 if (!(BUF_BEGV (bp2
) <= begp2
2614 && endp2
<= BUF_ZV (bp2
)))
2615 args_out_of_range (start2
, end2
);
2619 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2620 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2622 while (i1
< endp1
&& i2
< endp2
)
2624 /* When we find a mismatch, we must compare the
2625 characters, not just the bytes. */
2630 if (! NILP (bp1
->enable_multibyte_characters
))
2632 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2633 BUF_INC_POS (bp1
, i1_byte
);
2638 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2639 MAKE_CHAR_MULTIBYTE (c1
);
2643 if (! NILP (bp2
->enable_multibyte_characters
))
2645 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2646 BUF_INC_POS (bp2
, i2_byte
);
2651 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2652 MAKE_CHAR_MULTIBYTE (c2
);
2658 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2659 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2662 return make_number (- 1 - chars
);
2664 return make_number (chars
+ 1);
2669 /* The strings match as far as they go.
2670 If one is shorter, that one is less. */
2671 if (chars
< endp1
- begp1
)
2672 return make_number (chars
+ 1);
2673 else if (chars
< endp2
- begp2
)
2674 return make_number (- chars
- 1);
2676 /* Same length too => they are equal. */
2677 return make_number (0);
2681 subst_char_in_region_unwind (Lisp_Object arg
)
2683 return current_buffer
->undo_list
= arg
;
2687 subst_char_in_region_unwind_1 (Lisp_Object arg
)
2689 return current_buffer
->filename
= arg
;
2692 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2693 Ssubst_char_in_region
, 4, 5, 0,
2694 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2695 If optional arg NOUNDO is non-nil, don't record this change for undo
2696 and don't mark the buffer as really changed.
2697 Both characters must have the same length of multi-byte form. */)
2698 (Lisp_Object start
, Lisp_Object end
, Lisp_Object fromchar
, Lisp_Object tochar
, Lisp_Object noundo
)
2700 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2701 /* Keep track of the first change in the buffer:
2702 if 0 we haven't found it yet.
2703 if < 0 we've found it and we've run the before-change-function.
2704 if > 0 we've actually performed it and the value is its position. */
2706 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2708 int count
= SPECPDL_INDEX ();
2709 #define COMBINING_NO 0
2710 #define COMBINING_BEFORE 1
2711 #define COMBINING_AFTER 2
2712 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2713 int maybe_byte_combining
= COMBINING_NO
;
2714 int last_changed
= 0;
2715 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2719 validate_region (&start
, &end
);
2720 CHECK_NUMBER (fromchar
);
2721 CHECK_NUMBER (tochar
);
2725 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2726 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2727 error ("Characters in `subst-char-in-region' have different byte-lengths");
2728 if (!ASCII_BYTE_P (*tostr
))
2730 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2731 complete multibyte character, it may be combined with the
2732 after bytes. If it is in the range 0xA0..0xFF, it may be
2733 combined with the before and after bytes. */
2734 if (!CHAR_HEAD_P (*tostr
))
2735 maybe_byte_combining
= COMBINING_BOTH
;
2736 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2737 maybe_byte_combining
= COMBINING_AFTER
;
2743 fromstr
[0] = XFASTINT (fromchar
);
2744 tostr
[0] = XFASTINT (tochar
);
2748 pos_byte
= CHAR_TO_BYTE (pos
);
2749 stop
= CHAR_TO_BYTE (XINT (end
));
2752 /* If we don't want undo, turn off putting stuff on the list.
2753 That's faster than getting rid of things,
2754 and it prevents even the entry for a first change.
2755 Also inhibit locking the file. */
2756 if (!changed
&& !NILP (noundo
))
2758 record_unwind_protect (subst_char_in_region_unwind
,
2759 current_buffer
->undo_list
);
2760 current_buffer
->undo_list
= Qt
;
2761 /* Don't do file-locking. */
2762 record_unwind_protect (subst_char_in_region_unwind_1
,
2763 current_buffer
->filename
);
2764 current_buffer
->filename
= Qnil
;
2767 if (pos_byte
< GPT_BYTE
)
2768 stop
= min (stop
, GPT_BYTE
);
2771 int pos_byte_next
= pos_byte
;
2773 if (pos_byte
>= stop
)
2775 if (pos_byte
>= end_byte
) break;
2778 p
= BYTE_POS_ADDR (pos_byte
);
2780 INC_POS (pos_byte_next
);
2783 if (pos_byte_next
- pos_byte
== len
2784 && p
[0] == fromstr
[0]
2786 || (p
[1] == fromstr
[1]
2787 && (len
== 2 || (p
[2] == fromstr
[2]
2788 && (len
== 3 || p
[3] == fromstr
[3]))))))
2791 /* We've already seen this and run the before-change-function;
2792 this time we only need to record the actual position. */
2797 modify_region (current_buffer
, pos
, XINT (end
), 0);
2799 if (! NILP (noundo
))
2801 if (MODIFF
- 1 == SAVE_MODIFF
)
2803 if (MODIFF
- 1 == BUF_AUTOSAVE_MODIFF (current_buffer
))
2804 BUF_AUTOSAVE_MODIFF (current_buffer
)++;
2807 /* The before-change-function may have moved the gap
2808 or even modified the buffer so we should start over. */
2812 /* Take care of the case where the new character
2813 combines with neighboring bytes. */
2814 if (maybe_byte_combining
2815 && (maybe_byte_combining
== COMBINING_AFTER
2816 ? (pos_byte_next
< Z_BYTE
2817 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2818 : ((pos_byte_next
< Z_BYTE
2819 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2820 || (pos_byte
> BEG_BYTE
2821 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2823 Lisp_Object tem
, string
;
2825 struct gcpro gcpro1
;
2827 tem
= current_buffer
->undo_list
;
2830 /* Make a multibyte string containing this single character. */
2831 string
= make_multibyte_string (tostr
, 1, len
);
2832 /* replace_range is less efficient, because it moves the gap,
2833 but it handles combining correctly. */
2834 replace_range (pos
, pos
+ 1, string
,
2836 pos_byte_next
= CHAR_TO_BYTE (pos
);
2837 if (pos_byte_next
> pos_byte
)
2838 /* Before combining happened. We should not increment
2839 POS. So, to cancel the later increment of POS,
2843 INC_POS (pos_byte_next
);
2845 if (! NILP (noundo
))
2846 current_buffer
->undo_list
= tem
;
2853 record_change (pos
, 1);
2854 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2856 last_changed
= pos
+ 1;
2858 pos_byte
= pos_byte_next
;
2864 signal_after_change (changed
,
2865 last_changed
- changed
, last_changed
- changed
);
2866 update_compositions (changed
, last_changed
, CHECK_ALL
);
2869 unbind_to (count
, Qnil
);
2874 static Lisp_Object
check_translation (int, int, int, Lisp_Object
);
2876 /* Helper function for Ftranslate_region_internal.
2878 Check if a character sequence at POS (POS_BYTE) matches an element
2879 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2880 element is found, return it. Otherwise return Qnil. */
2883 check_translation (int pos
, int pos_byte
, int end
, Lisp_Object val
)
2885 int buf_size
= 16, buf_used
= 0;
2886 int *buf
= alloca (sizeof (int) * buf_size
);
2888 for (; CONSP (val
); val
= XCDR (val
))
2897 if (! VECTORP (elt
))
2900 if (len
<= end
- pos
)
2902 for (i
= 0; i
< len
; i
++)
2906 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2909 if (buf_used
== buf_size
)
2914 newbuf
= alloca (sizeof (int) * buf_size
);
2915 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2918 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, len
);
2921 if (XINT (AREF (elt
, i
)) != buf
[i
])
2932 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
2933 Stranslate_region_internal
, 3, 3, 0,
2934 doc
: /* Internal use only.
2935 From START to END, translate characters according to TABLE.
2936 TABLE is a string or a char-table; the Nth character in it is the
2937 mapping for the character with code N.
2938 It returns the number of characters changed. */)
2939 (Lisp_Object start
, Lisp_Object end
, register Lisp_Object table
)
2941 register unsigned char *tt
; /* Trans table. */
2942 register int nc
; /* New character. */
2943 int cnt
; /* Number of changes made. */
2944 int size
; /* Size of translate table. */
2945 int pos
, pos_byte
, end_pos
;
2946 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2947 int string_multibyte
;
2950 validate_region (&start
, &end
);
2951 if (CHAR_TABLE_P (table
))
2953 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
2954 error ("Not a translation table");
2960 CHECK_STRING (table
);
2962 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
2963 table
= string_make_unibyte (table
);
2964 string_multibyte
= SCHARS (table
) < SBYTES (table
);
2965 size
= SBYTES (table
);
2970 pos_byte
= CHAR_TO_BYTE (pos
);
2971 end_pos
= XINT (end
);
2972 modify_region (current_buffer
, pos
, end_pos
, 0);
2975 for (; pos
< end_pos
; )
2977 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2978 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
2984 oc
= STRING_CHAR_AND_LENGTH (p
, len
);
2991 /* Reload as signal_after_change in last iteration may GC. */
2993 if (string_multibyte
)
2995 str
= tt
+ string_char_to_byte (table
, oc
);
2996 nc
= STRING_CHAR_AND_LENGTH (str
, str_len
);
3001 if (! ASCII_BYTE_P (nc
) && multibyte
)
3003 str_len
= BYTE8_STRING (nc
, buf
);
3018 val
= CHAR_TABLE_REF (table
, oc
);
3019 if (CHARACTERP (val
)
3020 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3023 str_len
= CHAR_STRING (nc
, buf
);
3026 else if (VECTORP (val
) || (CONSP (val
)))
3028 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3029 where TO is TO-CHAR or [TO-CHAR ...]. */
3034 if (nc
!= oc
&& nc
>= 0)
3036 /* Simple one char to one char translation. */
3041 /* This is less efficient, because it moves the gap,
3042 but it should handle multibyte characters correctly. */
3043 string
= make_multibyte_string (str
, 1, str_len
);
3044 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3049 record_change (pos
, 1);
3050 while (str_len
-- > 0)
3052 signal_after_change (pos
, 1, 1);
3053 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3063 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3070 /* VAL is ([FROM-CHAR ...] . TO). */
3071 len
= ASIZE (XCAR (val
));
3079 string
= Fconcat (1, &val
);
3083 string
= Fmake_string (make_number (1), val
);
3085 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3086 pos_byte
+= SBYTES (string
);
3087 pos
+= SCHARS (string
);
3088 cnt
+= SCHARS (string
);
3089 end_pos
+= SCHARS (string
) - len
;
3097 return make_number (cnt
);
3100 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3101 doc
: /* Delete the text between point and mark.
3103 When called from a program, expects two arguments,
3104 positions (integers or markers) specifying the stretch to be deleted. */)
3105 (Lisp_Object start
, Lisp_Object end
)
3107 validate_region (&start
, &end
);
3108 del_range (XINT (start
), XINT (end
));
3112 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3113 Sdelete_and_extract_region
, 2, 2, 0,
3114 doc
: /* Delete the text between START and END and return it. */)
3115 (Lisp_Object start
, Lisp_Object end
)
3117 validate_region (&start
, &end
);
3118 if (XINT (start
) == XINT (end
))
3119 return empty_unibyte_string
;
3120 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3123 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3124 doc
: /* Remove restrictions (narrowing) from current buffer.
3125 This allows the buffer's full text to be seen and edited. */)
3128 if (BEG
!= BEGV
|| Z
!= ZV
)
3129 current_buffer
->clip_changed
= 1;
3131 BEGV_BYTE
= BEG_BYTE
;
3132 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3133 /* Changing the buffer bounds invalidates any recorded current column. */
3134 invalidate_current_column ();
3138 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3139 doc
: /* Restrict editing in this buffer to the current region.
3140 The rest of the text becomes temporarily invisible and untouchable
3141 but is not deleted; if you save the buffer in a file, the invisible
3142 text is included in the file. \\[widen] makes all visible again.
3143 See also `save-restriction'.
3145 When calling from a program, pass two arguments; positions (integers
3146 or markers) bounding the text that should remain visible. */)
3147 (register Lisp_Object start
, Lisp_Object end
)
3149 CHECK_NUMBER_COERCE_MARKER (start
);
3150 CHECK_NUMBER_COERCE_MARKER (end
);
3152 if (XINT (start
) > XINT (end
))
3155 tem
= start
; start
= end
; end
= tem
;
3158 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3159 args_out_of_range (start
, end
);
3161 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3162 current_buffer
->clip_changed
= 1;
3164 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3165 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3166 if (PT
< XFASTINT (start
))
3167 SET_PT (XFASTINT (start
));
3168 if (PT
> XFASTINT (end
))
3169 SET_PT (XFASTINT (end
));
3170 /* Changing the buffer bounds invalidates any recorded current column. */
3171 invalidate_current_column ();
3176 save_restriction_save (void)
3178 if (BEGV
== BEG
&& ZV
== Z
)
3179 /* The common case that the buffer isn't narrowed.
3180 We return just the buffer object, which save_restriction_restore
3181 recognizes as meaning `no restriction'. */
3182 return Fcurrent_buffer ();
3184 /* We have to save a restriction, so return a pair of markers, one
3185 for the beginning and one for the end. */
3187 Lisp_Object beg
, end
;
3189 beg
= buildmark (BEGV
, BEGV_BYTE
);
3190 end
= buildmark (ZV
, ZV_BYTE
);
3192 /* END must move forward if text is inserted at its exact location. */
3193 XMARKER(end
)->insertion_type
= 1;
3195 return Fcons (beg
, end
);
3200 save_restriction_restore (Lisp_Object data
)
3202 struct buffer
*cur
= NULL
;
3203 struct buffer
*buf
= (CONSP (data
)
3204 ? XMARKER (XCAR (data
))->buffer
3207 if (buf
&& buf
!= current_buffer
&& !NILP (buf
->pt_marker
))
3208 { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
3209 is the case if it is or has an indirect buffer), then make
3210 sure it is current before we update BEGV, so
3211 set_buffer_internal takes care of managing those markers. */
3212 cur
= current_buffer
;
3213 set_buffer_internal (buf
);
3217 /* A pair of marks bounding a saved restriction. */
3219 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3220 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3221 eassert (buf
== end
->buffer
);
3223 if (buf
/* Verify marker still points to a buffer. */
3224 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3225 /* The restriction has changed from the saved one, so restore
3226 the saved restriction. */
3228 int pt
= BUF_PT (buf
);
3230 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3231 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3233 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3234 /* The point is outside the new visible range, move it inside. */
3235 SET_BUF_PT_BOTH (buf
,
3236 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3237 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3240 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3244 /* A buffer, which means that there was no old restriction. */
3246 if (buf
/* Verify marker still points to a buffer. */
3247 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3248 /* The buffer has been narrowed, get rid of the narrowing. */
3250 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3251 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3253 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3258 set_buffer_internal (cur
);
3263 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3264 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3265 The buffer's restrictions make parts of the beginning and end invisible.
3266 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3267 This special form, `save-restriction', saves the current buffer's restrictions
3268 when it is entered, and restores them when it is exited.
3269 So any `narrow-to-region' within BODY lasts only until the end of the form.
3270 The old restrictions settings are restored
3271 even in case of abnormal exit (throw or error).
3273 The value returned is the value of the last form in BODY.
3275 Note: if you are using both `save-excursion' and `save-restriction',
3276 use `save-excursion' outermost:
3277 (save-excursion (save-restriction ...))
3279 usage: (save-restriction &rest BODY) */)
3282 register Lisp_Object val
;
3283 int count
= SPECPDL_INDEX ();
3285 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3286 val
= Fprogn (body
);
3287 return unbind_to (count
, val
);
3290 /* Buffer for the most recent text displayed by Fmessage_box. */
3291 static char *message_text
;
3293 /* Allocated length of that buffer. */
3294 static int message_length
;
3296 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3297 doc
: /* Display a message at the bottom of the screen.
3298 The message also goes into the `*Messages*' buffer.
3299 \(In keyboard macros, that's all it does.)
3302 The first argument is a format control string, and the rest are data
3303 to be formatted under control of the string. See `format' for details.
3305 Note: Use (message "%s" VALUE) to print the value of expressions and
3306 variables to avoid accidentally interpreting `%' as format specifiers.
3308 If the first argument is nil or the empty string, the function clears
3309 any existing message; this lets the minibuffer contents show. See
3310 also `current-message'.
3312 usage: (message FORMAT-STRING &rest ARGS) */)
3313 (int nargs
, Lisp_Object
*args
)
3316 || (STRINGP (args
[0])
3317 && SBYTES (args
[0]) == 0))
3324 register Lisp_Object val
;
3325 val
= Fformat (nargs
, args
);
3326 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3331 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3332 doc
: /* Display a message, in a dialog box if possible.
3333 If a dialog box is not available, use the echo area.
3334 The first argument is a format control string, and the rest are data
3335 to be formatted under control of the string. See `format' for details.
3337 If the first argument is nil or the empty string, clear any existing
3338 message; let the minibuffer contents show.
3340 usage: (message-box FORMAT-STRING &rest ARGS) */)
3341 (int nargs
, Lisp_Object
*args
)
3350 register Lisp_Object val
;
3351 val
= Fformat (nargs
, args
);
3353 /* The MS-DOS frames support popup menus even though they are
3354 not FRAME_WINDOW_P. */
3355 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3356 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3358 Lisp_Object pane
, menu
, obj
;
3359 struct gcpro gcpro1
;
3360 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3362 menu
= Fcons (val
, pane
);
3363 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3367 #endif /* HAVE_MENUS */
3368 /* Copy the data so that it won't move when we GC. */
3371 message_text
= (char *)xmalloc (80);
3372 message_length
= 80;
3374 if (SBYTES (val
) > message_length
)
3376 message_length
= SBYTES (val
);
3377 message_text
= (char *)xrealloc (message_text
, message_length
);
3379 memcpy (message_text
, SDATA (val
), SBYTES (val
));
3380 message2 (message_text
, SBYTES (val
),
3381 STRING_MULTIBYTE (val
));
3386 extern Lisp_Object last_nonmenu_event
;
3389 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3390 doc
: /* Display a message in a dialog box or in the echo area.
3391 If this command was invoked with the mouse, use a dialog box if
3392 `use-dialog-box' is non-nil.
3393 Otherwise, use the echo area.
3394 The first argument is a format control string, and the rest are data
3395 to be formatted under control of the string. See `format' for details.
3397 If the first argument is nil or the empty string, clear any existing
3398 message; let the minibuffer contents show.
3400 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3401 (int nargs
, Lisp_Object
*args
)
3404 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3406 return Fmessage_box (nargs
, args
);
3408 return Fmessage (nargs
, args
);
3411 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3412 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3415 return current_message ();
3419 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3420 doc
: /* Return a copy of STRING with text properties added.
3421 First argument is the string to copy.
3422 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3423 properties to add to the result.
3424 usage: (propertize STRING &rest PROPERTIES) */)
3425 (int nargs
, Lisp_Object
*args
)
3427 Lisp_Object properties
, string
;
3428 struct gcpro gcpro1
, gcpro2
;
3431 /* Number of args must be odd. */
3432 if ((nargs
& 1) == 0 || nargs
< 1)
3433 error ("Wrong number of arguments");
3435 properties
= string
= Qnil
;
3436 GCPRO2 (properties
, string
);
3438 /* First argument must be a string. */
3439 CHECK_STRING (args
[0]);
3440 string
= Fcopy_sequence (args
[0]);
3442 for (i
= 1; i
< nargs
; i
+= 2)
3443 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3445 Fadd_text_properties (make_number (0),
3446 make_number (SCHARS (string
)),
3447 properties
, string
);
3448 RETURN_UNGCPRO (string
);
3452 /* Number of bytes that STRING will occupy when put into the result.
3453 MULTIBYTE is nonzero if the result should be multibyte. */
3455 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3456 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3457 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3460 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3461 doc
: /* Format a string out of a format-string and arguments.
3462 The first argument is a format control string.
3463 The other arguments are substituted into it to make the result, a string.
3465 The format control string may contain %-sequences meaning to substitute
3466 the next available argument:
3468 %s means print a string argument. Actually, prints any object, with `princ'.
3469 %d means print as number in decimal (%o octal, %x hex).
3470 %X is like %x, but uses upper case.
3471 %e means print a number in exponential notation.
3472 %f means print a number in decimal-point notation.
3473 %g means print a number in exponential notation
3474 or decimal-point notation, whichever uses fewer characters.
3475 %c means print a number as a single character.
3476 %S means print any object as an s-expression (using `prin1').
3478 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3479 Use %% to put a single % into the output.
3481 A %-sequence may contain optional flag, width, and precision
3482 specifiers, as follows:
3484 %<flags><width><precision>character
3486 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3488 The + flag character inserts a + before any positive number, while a
3489 space inserts a space before any positive number; these flags only
3490 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3491 The # flag means to use an alternate display form for %o, %x, %X, %e,
3492 %f, and %g sequences. The - and 0 flags affect the width specifier,
3495 The width specifier supplies a lower limit for the length of the
3496 printed representation. The padding, if any, normally goes on the
3497 left, but it goes on the right if the - flag is present. The padding
3498 character is normally a space, but it is 0 if the 0 flag is present.
3499 The - flag takes precedence over the 0 flag.
3501 For %e, %f, and %g sequences, the number after the "." in the
3502 precision specifier says how many decimal places to show; if zero, the
3503 decimal point itself is omitted. For %s and %S, the precision
3504 specifier truncates the string to the given width.
3506 usage: (format STRING &rest OBJECTS) */)
3507 (int nargs
, register Lisp_Object
*args
)
3509 register int n
; /* The number of the next arg to substitute */
3510 register int total
; /* An estimate of the final length */
3512 register unsigned char *format
, *end
, *format_start
;
3514 /* Nonzero if the output should be a multibyte string,
3515 which is true if any of the inputs is one. */
3517 /* When we make a multibyte string, we must pay attention to the
3518 byte combining problem, i.e., a byte may be combined with a
3519 multibyte charcter of the previous string. This flag tells if we
3520 must consider such a situation or not. */
3521 int maybe_combine_byte
;
3522 unsigned char *this_format
;
3523 /* Precision for each spec, or -1, a flag value meaning no precision
3524 was given in that spec. Element 0, corresonding to the format
3525 string itself, will not be used. Element NARGS, corresponding to
3526 no argument, *will* be assigned to in the case that a `%' and `.'
3527 occur after the final format specifier. */
3528 int *precision
= (int *) (alloca ((nargs
+ 1) * sizeof (int)));
3531 int arg_intervals
= 0;
3534 /* discarded[I] is 1 if byte I of the format
3535 string was not copied into the output.
3536 It is 2 if byte I was not the first byte of its character. */
3537 char *discarded
= 0;
3539 /* Each element records, for one argument,
3540 the start and end bytepos in the output string,
3541 and whether the argument is a string with intervals.
3542 info[0] is unused. Unused elements have -1 for start. */
3545 int start
, end
, intervals
;
3548 /* It should not be necessary to GCPRO ARGS, because
3549 the caller in the interpreter should take care of that. */
3551 /* Try to determine whether the result should be multibyte.
3552 This is not always right; sometimes the result needs to be multibyte
3553 because of an object that we will pass through prin1,
3554 and in that case, we won't know it here. */
3555 for (n
= 0; n
< nargs
; n
++)
3557 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3559 /* Piggyback on this loop to initialize precision[N]. */
3562 precision
[nargs
] = -1;
3564 CHECK_STRING (args
[0]);
3565 /* We may have to change "%S" to "%s". */
3566 args
[0] = Fcopy_sequence (args
[0]);
3568 /* GC should never happen here, so abort if it does. */
3571 /* If we start out planning a unibyte result,
3572 then discover it has to be multibyte, we jump back to retry.
3573 That can only happen from the first large while loop below. */
3576 format
= SDATA (args
[0]);
3577 format_start
= format
;
3578 end
= format
+ SBYTES (args
[0]);
3581 /* Make room in result for all the non-%-codes in the control string. */
3582 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3584 /* Allocate the info and discarded tables. */
3586 int nbytes
= (nargs
+1) * sizeof *info
;
3589 info
= (struct info
*) alloca (nbytes
);
3590 memset (info
, 0, nbytes
);
3591 for (i
= 0; i
<= nargs
; i
++)
3594 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3595 memset (discarded
, 0, SBYTES (args
[0]));
3598 /* Add to TOTAL enough space to hold the converted arguments. */
3601 while (format
!= end
)
3602 if (*format
++ == '%')
3605 int actual_width
= 0;
3606 unsigned char *this_format_start
= format
- 1;
3607 int field_width
= 0;
3609 /* General format specifications look like
3611 '%' [flags] [field-width] [precision] format
3616 field-width ::= [0-9]+
3617 precision ::= '.' [0-9]*
3619 If a field-width is specified, it specifies to which width
3620 the output should be padded with blanks, if the output
3621 string is shorter than field-width.
3623 If precision is specified, it specifies the number of
3624 digits to print after the '.' for floats, or the max.
3625 number of chars to print from a string. */
3627 while (format
!= end
3628 && (*format
== '-' || *format
== '0' || *format
== '#'
3629 || * format
== ' ' || *format
== '+'))
3632 if (*format
>= '0' && *format
<= '9')
3634 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3635 field_width
= 10 * field_width
+ *format
- '0';
3638 /* N is not incremented for another few lines below, so refer to
3639 element N+1 (which might be precision[NARGS]). */
3643 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3644 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3647 /* Extra +1 for 'l' that we may need to insert into the
3649 if (format
- this_format_start
+ 2 > longest_format
)
3650 longest_format
= format
- this_format_start
+ 2;
3653 error ("Format string ends in middle of format specifier");
3656 else if (++n
>= nargs
)
3657 error ("Not enough arguments for format string");
3658 else if (*format
== 'S')
3660 /* For `S', prin1 the argument and then treat like a string. */
3661 register Lisp_Object tem
;
3662 tem
= Fprin1_to_string (args
[n
], Qnil
);
3663 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3669 /* If we restart the loop, we should not come here again
3670 because args[n] is now a string and calling
3671 Fprin1_to_string on it produces superflous double
3672 quotes. So, change "%S" to "%s" now. */
3676 else if (SYMBOLP (args
[n
]))
3678 args
[n
] = SYMBOL_NAME (args
[n
]);
3679 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3686 else if (STRINGP (args
[n
]))
3689 if (*format
!= 's' && *format
!= 'S')
3690 error ("Format specifier doesn't match argument type");
3691 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3692 to be as large as is calculated here. Easy check for
3693 the case PRECISION = 0. */
3694 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3695 /* The precision also constrains how much of the argument
3696 string will finally appear (Bug#5710). */
3697 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3698 if (precision
[n
] != -1)
3699 actual_width
= min (actual_width
, precision
[n
]);
3701 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3702 else if (INTEGERP (args
[n
]) && *format
!= 's')
3704 /* The following loop assumes the Lisp type indicates
3705 the proper way to pass the argument.
3706 So make sure we have a flonum if the argument should
3708 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3709 args
[n
] = Ffloat (args
[n
]);
3711 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3712 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3713 error ("Invalid format operation %%%c", *format
);
3715 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3718 if (! ASCII_CHAR_P (XINT (args
[n
]))
3719 /* Note: No one can remeber why we have to treat
3720 the character 0 as a multibyte character here.
3721 But, until it causes a real problem, let's
3723 || XINT (args
[n
]) == 0)
3730 args
[n
] = Fchar_to_string (args
[n
]);
3731 thissize
= SBYTES (args
[n
]);
3733 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3736 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3737 thissize
= SBYTES (args
[n
]);
3741 else if (FLOATP (args
[n
]) && *format
!= 's')
3743 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3745 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3746 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3747 error ("Invalid format operation %%%c", *format
);
3748 /* This fails unnecessarily if args[n] is bigger than
3749 most-positive-fixnum but smaller than MAXINT.
3750 These cases are important because we sometimes use floats
3751 to represent such integer values (typically such values
3752 come from UIDs or PIDs). */
3753 /* args[n] = Ftruncate (args[n], Qnil); */
3756 /* Note that we're using sprintf to print floats,
3757 so we have to take into account what that function
3759 /* Filter out flag value of -1. */
3760 thissize
= (MAX_10_EXP
+ 100
3761 + (precision
[n
] > 0 ? precision
[n
] : 0));
3765 /* Anything but a string, convert to a string using princ. */
3766 register Lisp_Object tem
;
3767 tem
= Fprin1_to_string (args
[n
], Qt
);
3768 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3777 thissize
+= max (0, field_width
- actual_width
);
3778 total
+= thissize
+ 4;
3783 /* Now we can no longer jump to retry.
3784 TOTAL and LONGEST_FORMAT are known for certain. */
3786 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3788 /* Allocate the space for the result.
3789 Note that TOTAL is an overestimate. */
3790 SAFE_ALLOCA (buf
, char *, total
);
3796 /* Scan the format and store result in BUF. */
3797 format
= SDATA (args
[0]);
3798 format_start
= format
;
3799 end
= format
+ SBYTES (args
[0]);
3800 maybe_combine_byte
= 0;
3801 while (format
!= end
)
3807 unsigned char *this_format_start
= format
;
3809 discarded
[format
- format_start
] = 1;
3812 while (strchr ("-+0# ", *format
))
3818 discarded
[format
- format_start
] = 1;
3822 minlen
= atoi (format
);
3824 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3826 discarded
[format
- format_start
] = 1;
3830 if (*format
++ == '%')
3839 discarded
[format
- format_start
- 1] = 1;
3840 info
[n
].start
= nchars
;
3842 if (STRINGP (args
[n
]))
3844 /* handle case (precision[n] >= 0) */
3847 int nbytes
, start
, end
;
3850 /* lisp_string_width ignores a precision of 0, but GNU
3851 libc functions print 0 characters when the precision
3852 is 0. Imitate libc behavior here. Changing
3853 lisp_string_width is the right thing, and will be
3854 done, but meanwhile we work with it. */
3856 if (precision
[n
] == 0)
3857 width
= nchars_string
= nbytes
= 0;
3858 else if (precision
[n
] > 0)
3859 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3861 { /* no precision spec given for this argument */
3862 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3863 nbytes
= SBYTES (args
[n
]);
3864 nchars_string
= SCHARS (args
[n
]);
3867 /* If spec requires it, pad on right with spaces. */
3868 padding
= minlen
- width
;
3870 while (padding
-- > 0)
3876 info
[n
].start
= start
= nchars
;
3877 nchars
+= nchars_string
;
3882 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3883 && STRING_MULTIBYTE (args
[n
])
3884 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3885 maybe_combine_byte
= 1;
3887 p
+= copy_text (SDATA (args
[n
]), p
,
3889 STRING_MULTIBYTE (args
[n
]), multibyte
);
3891 info
[n
].end
= nchars
;
3894 while (padding
-- > 0)
3900 /* If this argument has text properties, record where
3901 in the result string it appears. */
3902 if (STRING_INTERVALS (args
[n
]))
3903 info
[n
].intervals
= arg_intervals
= 1;
3905 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3909 memcpy (this_format
, this_format_start
,
3910 format
- this_format_start
);
3911 this_format
[format
- this_format_start
] = 0;
3913 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
3914 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3917 if (sizeof (EMACS_INT
) > sizeof (int)
3918 && format
[-1] != 'c')
3920 /* Insert 'l' before format spec. */
3921 this_format
[format
- this_format_start
]
3922 = this_format
[format
- this_format_start
- 1];
3923 this_format
[format
- this_format_start
- 1] = 'l';
3924 this_format
[format
- this_format_start
+ 1] = 0;
3927 if (INTEGERP (args
[n
]))
3929 if (format
[-1] == 'c')
3930 sprintf (p
, this_format
, (int) XINT (args
[n
]));
3931 else if (format
[-1] == 'd')
3932 sprintf (p
, this_format
, XINT (args
[n
]));
3933 /* Don't sign-extend for octal or hex printing. */
3935 sprintf (p
, this_format
, XUINT (args
[n
]));
3937 else if (format
[-1] == 'c')
3938 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
3939 else if (format
[-1] == 'd')
3940 /* Maybe we should use "%1.0f" instead so it also works
3941 for values larger than MAXINT. */
3942 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
3944 /* Don't sign-extend for octal or hex printing. */
3945 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
3950 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3951 && !CHAR_HEAD_P (*((unsigned char *) p
)))
3952 maybe_combine_byte
= 1;
3953 this_nchars
= strlen (p
);
3955 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
3958 nchars
+= this_nchars
;
3959 info
[n
].end
= nchars
;
3963 else if (STRING_MULTIBYTE (args
[0]))
3965 /* Copy a whole multibyte character. */
3968 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3969 && !CHAR_HEAD_P (*format
))
3970 maybe_combine_byte
= 1;
3972 while (! CHAR_HEAD_P (*format
))
3974 discarded
[format
- format_start
] = 2;
3981 /* Convert a single-byte character to multibyte. */
3982 int len
= copy_text (format
, p
, 1, 0, 1);
3989 *p
++ = *format
++, nchars
++;
3992 if (p
> buf
+ total
)
3995 if (maybe_combine_byte
)
3996 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
3997 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
3999 /* If we allocated BUF with malloc, free it too. */
4002 /* If the format string has text properties, or any of the string
4003 arguments has text properties, set up text properties of the
4006 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4008 Lisp_Object len
, new_len
, props
;
4009 struct gcpro gcpro1
;
4011 /* Add text properties from the format string. */
4012 len
= make_number (SCHARS (args
[0]));
4013 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4018 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4021 /* Adjust the bounds of each text property
4022 to the proper start and end in the output string. */
4024 /* Put the positions in PROPS in increasing order, so that
4025 we can do (effectively) one scan through the position
4026 space of the format string. */
4027 props
= Fnreverse (props
);
4029 /* BYTEPOS is the byte position in the format string,
4030 POSITION is the untranslated char position in it,
4031 TRANSLATED is the translated char position in BUF,
4032 and ARGN is the number of the next arg we will come to. */
4033 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4040 /* First adjust the property start position. */
4041 pos
= XINT (XCAR (item
));
4043 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4044 up to this position. */
4045 for (; position
< pos
; bytepos
++)
4047 if (! discarded
[bytepos
])
4048 position
++, translated
++;
4049 else if (discarded
[bytepos
] == 1)
4052 if (translated
== info
[argn
].start
)
4054 translated
+= info
[argn
].end
- info
[argn
].start
;
4060 XSETCAR (item
, make_number (translated
));
4062 /* Likewise adjust the property end position. */
4063 pos
= XINT (XCAR (XCDR (item
)));
4065 for (; position
< pos
; bytepos
++)
4067 if (! discarded
[bytepos
])
4068 position
++, translated
++;
4069 else if (discarded
[bytepos
] == 1)
4072 if (translated
== info
[argn
].start
)
4074 translated
+= info
[argn
].end
- info
[argn
].start
;
4080 XSETCAR (XCDR (item
), make_number (translated
));
4083 add_text_properties_from_list (val
, props
, make_number (0));
4086 /* Add text properties from arguments. */
4088 for (n
= 1; n
< nargs
; ++n
)
4089 if (info
[n
].intervals
)
4091 len
= make_number (SCHARS (args
[n
]));
4092 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4093 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4094 props
= extend_property_ranges (props
, new_len
);
4095 /* If successive arguments have properties, be sure that
4096 the value of `composition' property be the copy. */
4097 if (n
> 1 && info
[n
- 1].end
)
4098 make_composition_value_copy (props
);
4099 add_text_properties_from_list (val
, props
,
4100 make_number (info
[n
].start
));
4110 format2 (const char *string1
, Lisp_Object arg0
, Lisp_Object arg1
)
4112 Lisp_Object args
[3];
4113 args
[0] = build_string (string1
);
4116 return Fformat (3, args
);
4119 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4120 doc
: /* Return t if two characters match, optionally ignoring case.
4121 Both arguments must be characters (i.e. integers).
4122 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4123 (register Lisp_Object c1
, Lisp_Object c2
)
4126 /* Check they're chars, not just integers, otherwise we could get array
4127 bounds violations in DOWNCASE. */
4128 CHECK_CHARACTER (c1
);
4129 CHECK_CHARACTER (c2
);
4131 if (XINT (c1
) == XINT (c2
))
4133 if (NILP (current_buffer
->case_fold_search
))
4136 /* Do these in separate statements,
4137 then compare the variables.
4138 because of the way DOWNCASE uses temp variables. */
4140 if (NILP (current_buffer
->enable_multibyte_characters
)
4141 && ! ASCII_CHAR_P (i1
))
4143 MAKE_CHAR_MULTIBYTE (i1
);
4146 if (NILP (current_buffer
->enable_multibyte_characters
)
4147 && ! ASCII_CHAR_P (i2
))
4149 MAKE_CHAR_MULTIBYTE (i2
);
4153 return (i1
== i2
? Qt
: Qnil
);
4156 /* Transpose the markers in two regions of the current buffer, and
4157 adjust the ones between them if necessary (i.e.: if the regions
4160 START1, END1 are the character positions of the first region.
4161 START1_BYTE, END1_BYTE are the byte positions.
4162 START2, END2 are the character positions of the second region.
4163 START2_BYTE, END2_BYTE are the byte positions.
4165 Traverses the entire marker list of the buffer to do so, adding an
4166 appropriate amount to some, subtracting from some, and leaving the
4167 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4169 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4172 transpose_markers (int start1
, int end1
, int start2
, int end2
,
4173 int start1_byte
, int end1_byte
,
4174 int start2_byte
, int end2_byte
)
4176 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4177 register struct Lisp_Marker
*marker
;
4179 /* Update point as if it were a marker. */
4183 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4184 PT_BYTE
+ (end2_byte
- end1_byte
));
4185 else if (PT
< start2
)
4186 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4187 (PT_BYTE
+ (end2_byte
- start2_byte
)
4188 - (end1_byte
- start1_byte
)));
4190 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4191 PT_BYTE
- (start2_byte
- start1_byte
));
4193 /* We used to adjust the endpoints here to account for the gap, but that
4194 isn't good enough. Even if we assume the caller has tried to move the
4195 gap out of our way, it might still be at start1 exactly, for example;
4196 and that places it `inside' the interval, for our purposes. The amount
4197 of adjustment is nontrivial if there's a `denormalized' marker whose
4198 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4199 the dirty work to Fmarker_position, below. */
4201 /* The difference between the region's lengths */
4202 diff
= (end2
- start2
) - (end1
- start1
);
4203 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4205 /* For shifting each marker in a region by the length of the other
4206 region plus the distance between the regions. */
4207 amt1
= (end2
- start2
) + (start2
- end1
);
4208 amt2
= (end1
- start1
) + (start2
- end1
);
4209 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4210 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4212 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4214 mpos
= marker
->bytepos
;
4215 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4217 if (mpos
< end1_byte
)
4219 else if (mpos
< start2_byte
)
4223 marker
->bytepos
= mpos
;
4225 mpos
= marker
->charpos
;
4226 if (mpos
>= start1
&& mpos
< end2
)
4230 else if (mpos
< start2
)
4235 marker
->charpos
= mpos
;
4239 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4240 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4241 The regions should not be overlapping, because the size of the buffer is
4242 never changed in a transposition.
4244 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4245 any markers that happen to be located in the regions.
4247 Transposing beyond buffer boundaries is an error. */)
4248 (Lisp_Object startr1
, Lisp_Object endr1
, Lisp_Object startr2
, Lisp_Object endr2
, Lisp_Object leave_markers
)
4250 register EMACS_INT start1
, end1
, start2
, end2
;
4251 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4252 EMACS_INT gap
, len1
, len_mid
, len2
;
4253 unsigned char *start1_addr
, *start2_addr
, *temp
;
4255 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4258 XSETBUFFER (buf
, current_buffer
);
4259 cur_intv
= BUF_INTERVALS (current_buffer
);
4261 validate_region (&startr1
, &endr1
);
4262 validate_region (&startr2
, &endr2
);
4264 start1
= XFASTINT (startr1
);
4265 end1
= XFASTINT (endr1
);
4266 start2
= XFASTINT (startr2
);
4267 end2
= XFASTINT (endr2
);
4270 /* Swap the regions if they're reversed. */
4273 register int glumph
= start1
;
4281 len1
= end1
- start1
;
4282 len2
= end2
- start2
;
4285 error ("Transposed regions overlap");
4286 else if (start1
== end1
|| start2
== end2
)
4287 error ("Transposed region has length 0");
4289 /* The possibilities are:
4290 1. Adjacent (contiguous) regions, or separate but equal regions
4291 (no, really equal, in this case!), or
4292 2. Separate regions of unequal size.
4294 The worst case is usually No. 2. It means that (aside from
4295 potential need for getting the gap out of the way), there also
4296 needs to be a shifting of the text between the two regions. So
4297 if they are spread far apart, we are that much slower... sigh. */
4299 /* It must be pointed out that the really studly thing to do would
4300 be not to move the gap at all, but to leave it in place and work
4301 around it if necessary. This would be extremely efficient,
4302 especially considering that people are likely to do
4303 transpositions near where they are working interactively, which
4304 is exactly where the gap would be found. However, such code
4305 would be much harder to write and to read. So, if you are
4306 reading this comment and are feeling squirrely, by all means have
4307 a go! I just didn't feel like doing it, so I will simply move
4308 the gap the minimum distance to get it out of the way, and then
4309 deal with an unbroken array. */
4311 /* Make sure the gap won't interfere, by moving it out of the text
4312 we will operate on. */
4313 if (start1
< gap
&& gap
< end2
)
4315 if (gap
- start1
< end2
- gap
)
4321 start1_byte
= CHAR_TO_BYTE (start1
);
4322 start2_byte
= CHAR_TO_BYTE (start2
);
4323 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4324 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4326 #ifdef BYTE_COMBINING_DEBUG
4329 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4330 len2_byte
, start1
, start1_byte
)
4331 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4332 len1_byte
, end2
, start2_byte
+ len2_byte
)
4333 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4334 len1_byte
, end2
, start2_byte
+ len2_byte
))
4339 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4340 len2_byte
, start1
, start1_byte
)
4341 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4342 len1_byte
, start2
, start2_byte
)
4343 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4344 len2_byte
, end1
, start1_byte
+ len1_byte
)
4345 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4346 len1_byte
, end2
, start2_byte
+ len2_byte
))
4351 /* Hmmm... how about checking to see if the gap is large
4352 enough to use as the temporary storage? That would avoid an
4353 allocation... interesting. Later, don't fool with it now. */
4355 /* Working without memmove, for portability (sigh), so must be
4356 careful of overlapping subsections of the array... */
4358 if (end1
== start2
) /* adjacent regions */
4360 modify_region (current_buffer
, start1
, end2
, 0);
4361 record_change (start1
, len1
+ len2
);
4363 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4364 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4365 /* Don't use Fset_text_properties: that can cause GC, which can
4366 clobber objects stored in the tmp_intervals. */
4367 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4368 if (!NULL_INTERVAL_P (tmp_interval3
))
4369 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4371 /* First region smaller than second. */
4372 if (len1_byte
< len2_byte
)
4376 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4378 /* Don't precompute these addresses. We have to compute them
4379 at the last minute, because the relocating allocator might
4380 have moved the buffer around during the xmalloc. */
4381 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4382 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4384 memcpy (temp
, start2_addr
, len2_byte
);
4385 memcpy (start1_addr
+ len2_byte
, start1_addr
, len1_byte
);
4386 memcpy (start1_addr
, temp
, len2_byte
);
4390 /* First region not smaller than second. */
4394 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4395 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4396 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4397 memcpy (temp
, start1_addr
, len1_byte
);
4398 memcpy (start1_addr
, start2_addr
, len2_byte
);
4399 memcpy (start1_addr
+ len2_byte
, temp
, len1_byte
);
4402 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4403 len1
, current_buffer
, 0);
4404 graft_intervals_into_buffer (tmp_interval2
, start1
,
4405 len2
, current_buffer
, 0);
4406 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4407 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4409 /* Non-adjacent regions, because end1 != start2, bleagh... */
4412 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4414 if (len1_byte
== len2_byte
)
4415 /* Regions are same size, though, how nice. */
4419 modify_region (current_buffer
, start1
, end1
, 0);
4420 modify_region (current_buffer
, start2
, end2
, 0);
4421 record_change (start1
, len1
);
4422 record_change (start2
, len2
);
4423 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4424 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4426 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4427 if (!NULL_INTERVAL_P (tmp_interval3
))
4428 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4430 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4431 if (!NULL_INTERVAL_P (tmp_interval3
))
4432 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4434 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4435 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4436 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4437 memcpy (temp
, start1_addr
, len1_byte
);
4438 memcpy (start1_addr
, start2_addr
, len2_byte
);
4439 memcpy (start2_addr
, temp
, len1_byte
);
4442 graft_intervals_into_buffer (tmp_interval1
, start2
,
4443 len1
, current_buffer
, 0);
4444 graft_intervals_into_buffer (tmp_interval2
, start1
,
4445 len2
, current_buffer
, 0);
4448 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4449 /* Non-adjacent & unequal size, area between must also be shifted. */
4453 modify_region (current_buffer
, start1
, end2
, 0);
4454 record_change (start1
, (end2
- start1
));
4455 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4456 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4457 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4459 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4460 if (!NULL_INTERVAL_P (tmp_interval3
))
4461 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4463 /* holds region 2 */
4464 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4465 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4466 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4467 memcpy (temp
, start2_addr
, len2_byte
);
4468 memcpy (start1_addr
+ len_mid
+ len2_byte
, start1_addr
, len1_byte
);
4469 memmove (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4470 memcpy (start1_addr
, temp
, len2_byte
);
4473 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4474 len1
, current_buffer
, 0);
4475 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4476 len_mid
, current_buffer
, 0);
4477 graft_intervals_into_buffer (tmp_interval2
, start1
,
4478 len2
, current_buffer
, 0);
4481 /* Second region smaller than first. */
4485 record_change (start1
, (end2
- start1
));
4486 modify_region (current_buffer
, start1
, end2
, 0);
4488 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4489 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4490 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4492 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4493 if (!NULL_INTERVAL_P (tmp_interval3
))
4494 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4496 /* holds region 1 */
4497 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4498 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4499 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4500 memcpy (temp
, start1_addr
, len1_byte
);
4501 memcpy (start1_addr
, start2_addr
, len2_byte
);
4502 memcpy (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4503 memcpy (start1_addr
+ len2_byte
+ len_mid
, temp
, len1_byte
);
4506 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4507 len1
, current_buffer
, 0);
4508 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4509 len_mid
, current_buffer
, 0);
4510 graft_intervals_into_buffer (tmp_interval2
, start1
,
4511 len2
, current_buffer
, 0);
4514 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4515 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4518 /* When doing multiple transpositions, it might be nice
4519 to optimize this. Perhaps the markers in any one buffer
4520 should be organized in some sorted data tree. */
4521 if (NILP (leave_markers
))
4523 transpose_markers (start1
, end1
, start2
, end2
,
4524 start1_byte
, start1_byte
+ len1_byte
,
4525 start2_byte
, start2_byte
+ len2_byte
);
4526 fix_start_end_in_overlays (start1
, end2
);
4529 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4535 syms_of_editfns (void)
4540 Qbuffer_access_fontify_functions
4541 = intern_c_string ("buffer-access-fontify-functions");
4542 staticpro (&Qbuffer_access_fontify_functions
);
4544 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4545 doc
: /* Non-nil means text motion commands don't notice fields. */);
4546 Vinhibit_field_text_motion
= Qnil
;
4548 DEFVAR_LISP ("buffer-access-fontify-functions",
4549 &Vbuffer_access_fontify_functions
,
4550 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4551 Each function is called with two arguments which specify the range
4552 of the buffer being accessed. */);
4553 Vbuffer_access_fontify_functions
= Qnil
;
4557 extern Lisp_Object Vprin1_to_string_buffer
;
4558 obuf
= Fcurrent_buffer ();
4559 /* Do this here, because init_buffer_once is too early--it won't work. */
4560 Fset_buffer (Vprin1_to_string_buffer
);
4561 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4562 Fset (Fmake_local_variable (intern_c_string ("buffer-access-fontify-functions")),
4567 DEFVAR_LISP ("buffer-access-fontified-property",
4568 &Vbuffer_access_fontified_property
,
4569 doc
: /* Property which (if non-nil) indicates text has been fontified.
4570 `buffer-substring' need not call the `buffer-access-fontify-functions'
4571 functions if all the text being accessed has this property. */);
4572 Vbuffer_access_fontified_property
= Qnil
;
4574 DEFVAR_LISP ("system-name", &Vsystem_name
,
4575 doc
: /* The host name of the machine Emacs is running on. */);
4577 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4578 doc
: /* The full name of the user logged in. */);
4580 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4581 doc
: /* The user's name, taken from environment variables if possible. */);
4583 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4584 doc
: /* The user's name, based upon the real uid only. */);
4586 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4587 doc
: /* The release of the operating system Emacs is running on. */);
4589 defsubr (&Spropertize
);
4590 defsubr (&Schar_equal
);
4591 defsubr (&Sgoto_char
);
4592 defsubr (&Sstring_to_char
);
4593 defsubr (&Schar_to_string
);
4594 defsubr (&Sbyte_to_string
);
4595 defsubr (&Sbuffer_substring
);
4596 defsubr (&Sbuffer_substring_no_properties
);
4597 defsubr (&Sbuffer_string
);
4599 defsubr (&Spoint_marker
);
4600 defsubr (&Smark_marker
);
4602 defsubr (&Sregion_beginning
);
4603 defsubr (&Sregion_end
);
4605 staticpro (&Qfield
);
4606 Qfield
= intern_c_string ("field");
4607 staticpro (&Qboundary
);
4608 Qboundary
= intern_c_string ("boundary");
4609 defsubr (&Sfield_beginning
);
4610 defsubr (&Sfield_end
);
4611 defsubr (&Sfield_string
);
4612 defsubr (&Sfield_string_no_properties
);
4613 defsubr (&Sdelete_field
);
4614 defsubr (&Sconstrain_to_field
);
4616 defsubr (&Sline_beginning_position
);
4617 defsubr (&Sline_end_position
);
4619 /* defsubr (&Smark); */
4620 /* defsubr (&Sset_mark); */
4621 defsubr (&Ssave_excursion
);
4622 defsubr (&Ssave_current_buffer
);
4624 defsubr (&Sbufsize
);
4625 defsubr (&Spoint_max
);
4626 defsubr (&Spoint_min
);
4627 defsubr (&Spoint_min_marker
);
4628 defsubr (&Spoint_max_marker
);
4629 defsubr (&Sgap_position
);
4630 defsubr (&Sgap_size
);
4631 defsubr (&Sposition_bytes
);
4632 defsubr (&Sbyte_to_position
);
4638 defsubr (&Sfollowing_char
);
4639 defsubr (&Sprevious_char
);
4640 defsubr (&Schar_after
);
4641 defsubr (&Schar_before
);
4643 defsubr (&Sinsert_before_markers
);
4644 defsubr (&Sinsert_and_inherit
);
4645 defsubr (&Sinsert_and_inherit_before_markers
);
4646 defsubr (&Sinsert_char
);
4647 defsubr (&Sinsert_byte
);
4649 defsubr (&Suser_login_name
);
4650 defsubr (&Suser_real_login_name
);
4651 defsubr (&Suser_uid
);
4652 defsubr (&Suser_real_uid
);
4653 defsubr (&Suser_full_name
);
4654 defsubr (&Semacs_pid
);
4655 defsubr (&Scurrent_time
);
4656 defsubr (&Sget_internal_run_time
);
4657 defsubr (&Sformat_time_string
);
4658 defsubr (&Sfloat_time
);
4659 defsubr (&Sdecode_time
);
4660 defsubr (&Sencode_time
);
4661 defsubr (&Scurrent_time_string
);
4662 defsubr (&Scurrent_time_zone
);
4663 defsubr (&Sset_time_zone_rule
);
4664 defsubr (&Ssystem_name
);
4665 defsubr (&Smessage
);
4666 defsubr (&Smessage_box
);
4667 defsubr (&Smessage_or_box
);
4668 defsubr (&Scurrent_message
);
4671 defsubr (&Sinsert_buffer_substring
);
4672 defsubr (&Scompare_buffer_substrings
);
4673 defsubr (&Ssubst_char_in_region
);
4674 defsubr (&Stranslate_region_internal
);
4675 defsubr (&Sdelete_region
);
4676 defsubr (&Sdelete_and_extract_region
);
4678 defsubr (&Snarrow_to_region
);
4679 defsubr (&Ssave_restriction
);
4680 defsubr (&Stranspose_regions
);
4683 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4684 (do not change this comment) */