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 (void);
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
)
325 if (!NILP (Vtransient_mark_mode
)
326 && NILP (Vmark_even_if_inactive
)
327 && NILP (current_buffer
->mark_active
))
328 xsignal0 (Qmark_inactive
);
330 m
= Fmarker_position (current_buffer
->mark
);
332 error ("The mark is not set now, so there is no region");
334 if ((PT
< XFASTINT (m
)) == (beginningp
!= 0))
335 m
= make_number (PT
);
339 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
340 doc
: /* Return position of beginning of region, as an integer. */)
343 return region_limit (1);
346 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
347 doc
: /* Return position of end of region, as an integer. */)
350 return region_limit (0);
353 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
354 doc
: /* Return this buffer's mark, as a marker object.
355 Watch out! Moving this marker changes the mark position.
356 If you set the marker not to point anywhere, the buffer will have no mark. */)
359 return current_buffer
->mark
;
363 /* Find all the overlays in the current buffer that touch position POS.
364 Return the number found, and store them in a vector in VEC
368 overlays_around (int pos
, Lisp_Object
*vec
, int len
)
370 Lisp_Object overlay
, start
, end
;
371 struct Lisp_Overlay
*tail
;
372 int startpos
, endpos
;
375 for (tail
= current_buffer
->overlays_before
; tail
; tail
= tail
->next
)
377 XSETMISC (overlay
, tail
);
379 end
= OVERLAY_END (overlay
);
380 endpos
= OVERLAY_POSITION (end
);
383 start
= OVERLAY_START (overlay
);
384 startpos
= OVERLAY_POSITION (start
);
389 /* Keep counting overlays even if we can't return them all. */
394 for (tail
= current_buffer
->overlays_after
; tail
; tail
= tail
->next
)
396 XSETMISC (overlay
, tail
);
398 start
= OVERLAY_START (overlay
);
399 startpos
= OVERLAY_POSITION (start
);
402 end
= OVERLAY_END (overlay
);
403 endpos
= OVERLAY_POSITION (end
);
415 /* Return the value of property PROP, in OBJECT at POSITION.
416 It's the value of PROP that a char inserted at POSITION would get.
417 OBJECT is optional and defaults to the current buffer.
418 If OBJECT is a buffer, then overlay properties are considered as well as
420 If OBJECT is a window, then that window's buffer is used, but
421 window-specific overlays are considered only if they are associated
424 get_pos_property (Lisp_Object position
, register Lisp_Object prop
, Lisp_Object object
)
426 CHECK_NUMBER_COERCE_MARKER (position
);
429 XSETBUFFER (object
, current_buffer
);
430 else if (WINDOWP (object
))
431 object
= XWINDOW (object
)->buffer
;
433 if (!BUFFERP (object
))
434 /* pos-property only makes sense in buffers right now, since strings
435 have no overlays and no notion of insertion for which stickiness
437 return Fget_text_property (position
, prop
, object
);
440 int posn
= XINT (position
);
442 Lisp_Object
*overlay_vec
, tem
;
443 struct buffer
*obuf
= current_buffer
;
445 set_buffer_temp (XBUFFER (object
));
447 /* First try with room for 40 overlays. */
449 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
450 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
452 /* If there are more than 40,
453 make enough space for all, and try again. */
456 overlay_vec
= (Lisp_Object
*) alloca (noverlays
* sizeof (Lisp_Object
));
457 noverlays
= overlays_around (posn
, overlay_vec
, noverlays
);
459 noverlays
= sort_overlays (overlay_vec
, noverlays
, NULL
);
461 set_buffer_temp (obuf
);
463 /* Now check the overlays in order of decreasing priority. */
464 while (--noverlays
>= 0)
466 Lisp_Object ol
= overlay_vec
[noverlays
];
467 tem
= Foverlay_get (ol
, prop
);
470 /* Check the overlay is indeed active at point. */
471 Lisp_Object start
= OVERLAY_START (ol
), finish
= OVERLAY_END (ol
);
472 if ((OVERLAY_POSITION (start
) == posn
473 && XMARKER (start
)->insertion_type
== 1)
474 || (OVERLAY_POSITION (finish
) == posn
475 && XMARKER (finish
)->insertion_type
== 0))
476 ; /* The overlay will not cover a char inserted at point. */
484 { /* Now check the text properties. */
485 int stickiness
= text_property_stickiness (prop
, position
, object
);
487 return Fget_text_property (position
, prop
, object
);
488 else if (stickiness
< 0
489 && XINT (position
) > BUF_BEGV (XBUFFER (object
)))
490 return Fget_text_property (make_number (XINT (position
) - 1),
498 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
499 the value of point is used instead. If BEG or END is null,
500 means don't store the beginning or end of the field.
502 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
503 results; they do not effect boundary behavior.
505 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
506 position of a field, then the beginning of the previous field is
507 returned instead of the beginning of POS's field (since the end of a
508 field is actually also the beginning of the next input field, this
509 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
510 true case, if two fields are separated by a field with the special
511 value `boundary', and POS lies within it, then the two separated
512 fields are considered to be adjacent, and POS between them, when
513 finding the beginning and ending of the "merged" field.
515 Either BEG or END may be 0, in which case the corresponding value
519 find_field (Lisp_Object pos
, Lisp_Object merge_at_boundary
, Lisp_Object beg_limit
, int *beg
, Lisp_Object end_limit
, int *end
)
521 /* Fields right before and after the point. */
522 Lisp_Object before_field
, after_field
;
523 /* 1 if POS counts as the start of a field. */
524 int at_field_start
= 0;
525 /* 1 if POS counts as the end of a field. */
526 int at_field_end
= 0;
529 XSETFASTINT (pos
, PT
);
531 CHECK_NUMBER_COERCE_MARKER (pos
);
534 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, NULL
);
536 = (XFASTINT (pos
) > BEGV
537 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
539 /* Using nil here would be a more obvious choice, but it would
540 fail when the buffer starts with a non-sticky field. */
543 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
544 and POS is at beginning of a field, which can also be interpreted
545 as the end of the previous field. Note that the case where if
546 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
547 more natural one; then we avoid treating the beginning of a field
549 if (NILP (merge_at_boundary
))
551 Lisp_Object field
= get_pos_property (pos
, Qfield
, Qnil
);
552 if (!EQ (field
, after_field
))
554 if (!EQ (field
, before_field
))
556 if (NILP (field
) && at_field_start
&& at_field_end
)
557 /* If an inserted char would have a nil field while the surrounding
558 text is non-nil, we're probably not looking at a
559 zero-length field, but instead at a non-nil field that's
560 not intended for editing (such as comint's prompts). */
561 at_field_end
= at_field_start
= 0;
564 /* Note about special `boundary' fields:
566 Consider the case where the point (`.') is between the fields `x' and `y':
570 In this situation, if merge_at_boundary is true, we consider the
571 `x' and `y' fields as forming one big merged field, and so the end
572 of the field is the end of `y'.
574 However, if `x' and `y' are separated by a special `boundary' field
575 (a field with a `field' char-property of 'boundary), then we ignore
576 this special field when merging adjacent fields. Here's the same
577 situation, but with a `boundary' field between the `x' and `y' fields:
581 Here, if point is at the end of `x', the beginning of `y', or
582 anywhere in-between (within the `boundary' field), we merge all
583 three fields and consider the beginning as being the beginning of
584 the `x' field, and the end as being the end of the `y' field. */
589 /* POS is at the edge of a field, and we should consider it as
590 the beginning of the following field. */
591 *beg
= XFASTINT (pos
);
593 /* Find the previous field boundary. */
596 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
597 /* Skip a `boundary' field. */
598 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
601 p
= Fprevious_single_char_property_change (p
, Qfield
, Qnil
,
603 *beg
= NILP (p
) ? BEGV
: XFASTINT (p
);
610 /* POS is at the edge of a field, and we should consider it as
611 the end of the previous field. */
612 *end
= XFASTINT (pos
);
614 /* Find the next field boundary. */
616 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
617 /* Skip a `boundary' field. */
618 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
621 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
623 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
629 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
630 doc
: /* Delete the field surrounding POS.
631 A field is a region of text with the same `field' property.
632 If POS is nil, the value of point is used for POS. */)
636 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
638 del_range (beg
, end
);
642 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
643 doc
: /* Return the contents of the field surrounding POS as a string.
644 A field is a region of text with the same `field' property.
645 If POS is nil, the value of point is used for POS. */)
649 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
650 return make_buffer_string (beg
, end
, 1);
653 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
654 doc
: /* Return the contents of the field around POS, without text properties.
655 A field is a region of text with the same `field' property.
656 If POS is nil, the value of point is used for POS. */)
660 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
661 return make_buffer_string (beg
, end
, 0);
664 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
665 doc
: /* Return the beginning of the field surrounding POS.
666 A field is a region of text with the same `field' property.
667 If POS is nil, the value of point is used for POS.
668 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
669 field, then the beginning of the *previous* field is returned.
670 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
671 is before LIMIT, then LIMIT will be returned instead. */)
672 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
675 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
676 return make_number (beg
);
679 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
680 doc
: /* Return the end of the field surrounding POS.
681 A field is a region of text with the same `field' property.
682 If POS is nil, the value of point is used for POS.
683 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
684 then the end of the *following* field is returned.
685 If LIMIT is non-nil, it is a buffer position; if the end of the field
686 is after LIMIT, then LIMIT will be returned instead. */)
687 (Lisp_Object pos
, Lisp_Object escape_from_edge
, Lisp_Object limit
)
690 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
691 return make_number (end
);
694 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
695 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
697 A field is a region of text with the same `field' property.
698 If NEW-POS is nil, then the current point is used instead, and set to the
699 constrained position if that is different.
701 If OLD-POS is at the boundary of two fields, then the allowable
702 positions for NEW-POS depends on the value of the optional argument
703 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
704 constrained to the field that has the same `field' char-property
705 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
706 is non-nil, NEW-POS is constrained to the union of the two adjacent
707 fields. Additionally, if two fields are separated by another field with
708 the special value `boundary', then any point within this special field is
709 also considered to be `on the boundary'.
711 If the optional argument ONLY-IN-LINE is non-nil and constraining
712 NEW-POS would move it to a different line, NEW-POS is returned
713 unconstrained. This useful for commands that move by line, like
714 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
715 only in the case where they can still move to the right line.
717 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
718 a non-nil property of that name, then any field boundaries are ignored.
720 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
721 (Lisp_Object new_pos
, Lisp_Object old_pos
, Lisp_Object escape_from_edge
, Lisp_Object only_in_line
, Lisp_Object inhibit_capture_property
)
723 /* If non-zero, then the original point, before re-positioning. */
726 Lisp_Object prev_old
, prev_new
;
729 /* Use the current point, and afterwards, set it. */
732 XSETFASTINT (new_pos
, PT
);
735 CHECK_NUMBER_COERCE_MARKER (new_pos
);
736 CHECK_NUMBER_COERCE_MARKER (old_pos
);
738 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
740 prev_old
= make_number (XFASTINT (old_pos
) - 1);
741 prev_new
= make_number (XFASTINT (new_pos
) - 1);
743 if (NILP (Vinhibit_field_text_motion
)
744 && !EQ (new_pos
, old_pos
)
745 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
746 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
))
747 /* To recognize field boundaries, we must also look at the
748 previous positions; we could use `get_pos_property'
749 instead, but in itself that would fail inside non-sticky
750 fields (like comint prompts). */
751 || (XFASTINT (new_pos
) > BEGV
752 && !NILP (Fget_char_property (prev_new
, Qfield
, Qnil
)))
753 || (XFASTINT (old_pos
) > BEGV
754 && !NILP (Fget_char_property (prev_old
, Qfield
, Qnil
))))
755 && (NILP (inhibit_capture_property
)
756 /* Field boundaries are again a problem; but now we must
757 decide the case exactly, so we need to call
758 `get_pos_property' as well. */
759 || (NILP (get_pos_property (old_pos
, inhibit_capture_property
, Qnil
))
760 && (XFASTINT (old_pos
) <= BEGV
761 || NILP (Fget_char_property (old_pos
, inhibit_capture_property
, Qnil
))
762 || NILP (Fget_char_property (prev_old
, inhibit_capture_property
, Qnil
))))))
763 /* It is possible that NEW_POS is not within the same field as
764 OLD_POS; try to move NEW_POS so that it is. */
767 Lisp_Object field_bound
;
770 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
772 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
774 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
775 other side of NEW_POS, which would mean that NEW_POS is
776 already acceptable, and it's not necessary to constrain it
778 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
779 /* NEW_POS should be constrained, but only if either
780 ONLY_IN_LINE is nil (in which case any constraint is OK),
781 or NEW_POS and FIELD_BOUND are on the same line (in which
782 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
783 && (NILP (only_in_line
)
784 /* This is the ONLY_IN_LINE case, check that NEW_POS and
785 FIELD_BOUND are on the same line by seeing whether
786 there's an intervening newline or not. */
787 || (scan_buffer ('\n',
788 XFASTINT (new_pos
), XFASTINT (field_bound
),
789 fwd
? -1 : 1, &shortage
, 1),
791 /* Constrain NEW_POS to FIELD_BOUND. */
792 new_pos
= field_bound
;
794 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
795 /* The NEW_POS argument was originally nil, so automatically set PT. */
796 SET_PT (XFASTINT (new_pos
));
803 DEFUN ("line-beginning-position",
804 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
805 doc
: /* Return the character position of the first character on the current line.
806 With argument N not nil or 1, move forward N - 1 lines first.
807 If scan reaches end of buffer, return that position.
809 This function constrains the returned position to the current field
810 unless that would be on a different line than the original,
811 unconstrained result. If N is nil or 1, and a front-sticky field
812 starts at point, the scan stops as soon as it starts. To ignore field
813 boundaries bind `inhibit-field-text-motion' to t.
815 This function does not move point. */)
818 int orig
, orig_byte
, end
;
819 int count
= SPECPDL_INDEX ();
820 specbind (Qinhibit_point_motion_hooks
, Qt
);
829 Fforward_line (make_number (XINT (n
) - 1));
832 SET_PT_BOTH (orig
, orig_byte
);
834 unbind_to (count
, Qnil
);
836 /* Return END constrained to the current input field. */
837 return Fconstrain_to_field (make_number (end
), make_number (orig
),
838 XINT (n
) != 1 ? Qt
: Qnil
,
842 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
843 doc
: /* Return the character position of the last character on the current line.
844 With argument N not nil or 1, move forward N - 1 lines first.
845 If scan reaches end of buffer, return that position.
847 This function constrains the returned position to the current field
848 unless that would be on a different line than the original,
849 unconstrained result. If N is nil or 1, and a rear-sticky field ends
850 at point, the scan stops as soon as it starts. To ignore field
851 boundaries bind `inhibit-field-text-motion' to t.
853 This function does not move point. */)
864 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
866 /* Return END_POS constrained to the current input field. */
867 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
873 save_excursion_save (void)
875 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
878 return Fcons (Fpoint_marker (),
879 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
880 Fcons (visible
? Qt
: Qnil
,
881 Fcons (current_buffer
->mark_active
,
886 save_excursion_restore (Lisp_Object info
)
888 Lisp_Object tem
, tem1
, omark
, nmark
;
889 struct gcpro gcpro1
, gcpro2
, gcpro3
;
892 tem
= Fmarker_buffer (XCAR (info
));
893 /* If buffer being returned to is now deleted, avoid error */
894 /* Otherwise could get error here while unwinding to top level
896 /* In that case, Fmarker_buffer returns nil now. */
900 omark
= nmark
= Qnil
;
901 GCPRO3 (info
, omark
, nmark
);
908 unchain_marker (XMARKER (tem
));
913 omark
= Fmarker_position (current_buffer
->mark
);
914 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
915 nmark
= Fmarker_position (tem
);
916 unchain_marker (XMARKER (tem
));
920 visible_p
= !NILP (XCAR (info
));
922 #if 0 /* We used to make the current buffer visible in the selected window
923 if that was true previously. That avoids some anomalies.
924 But it creates others, and it wasn't documented, and it is simpler
925 and cleaner never to alter the window/buffer connections. */
928 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
929 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
935 tem1
= current_buffer
->mark_active
;
936 current_buffer
->mark_active
= tem
;
938 if (!NILP (Vrun_hooks
))
940 /* If mark is active now, and either was not active
941 or was at a different place, run the activate hook. */
942 if (! NILP (current_buffer
->mark_active
))
944 if (! EQ (omark
, nmark
))
945 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
947 /* If mark has ceased to be active, run deactivate hook. */
948 else if (! NILP (tem1
))
949 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
952 /* If buffer was visible in a window, and a different window was
953 selected, and the old selected window is still showing this
954 buffer, restore point in that window. */
957 && !EQ (tem
, selected_window
)
958 && (tem1
= XWINDOW (tem
)->buffer
,
959 (/* Window is live... */
961 /* ...and it shows the current buffer. */
962 && XBUFFER (tem1
) == current_buffer
)))
963 Fset_window_point (tem
, make_number (PT
));
969 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
970 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
971 Executes BODY just like `progn'.
972 The values of point, mark and the current buffer are restored
973 even in case of abnormal exit (throw or error).
974 The state of activation of the mark is also restored.
976 This construct does not save `deactivate-mark', and therefore
977 functions that change the buffer will still cause deactivation
978 of the mark at the end of the command. To prevent that, bind
979 `deactivate-mark' with `let'.
981 If you only want to save the current buffer but not point nor mark,
982 then just use `save-current-buffer', or even `with-current-buffer'.
984 usage: (save-excursion &rest BODY) */)
987 register Lisp_Object val
;
988 int count
= SPECPDL_INDEX ();
990 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
993 return unbind_to (count
, val
);
996 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
997 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
998 Executes BODY just like `progn'.
999 usage: (save-current-buffer &rest BODY) */)
1003 int count
= SPECPDL_INDEX ();
1005 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
1007 val
= Fprogn (args
);
1008 return unbind_to (count
, val
);
1011 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
1012 doc
: /* Return the number of characters in the current buffer.
1013 If BUFFER, return the number of characters in that buffer instead. */)
1014 (Lisp_Object buffer
)
1017 return make_number (Z
- BEG
);
1020 CHECK_BUFFER (buffer
);
1021 return make_number (BUF_Z (XBUFFER (buffer
))
1022 - BUF_BEG (XBUFFER (buffer
)));
1026 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
1027 doc
: /* Return the minimum permissible value of point in the current buffer.
1028 This is 1, unless narrowing (a buffer restriction) is in effect. */)
1032 XSETFASTINT (temp
, BEGV
);
1036 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
1037 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
1038 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
1041 return buildmark (BEGV
, BEGV_BYTE
);
1044 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
1045 doc
: /* Return the maximum permissible value of point in the current buffer.
1046 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1047 is in effect, in which case it is less. */)
1051 XSETFASTINT (temp
, ZV
);
1055 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
1056 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
1057 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
1058 is in effect, in which case it is less. */)
1061 return buildmark (ZV
, ZV_BYTE
);
1064 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
1065 doc
: /* Return the position of the gap, in the current buffer.
1066 See also `gap-size'. */)
1070 XSETFASTINT (temp
, GPT
);
1074 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
1075 doc
: /* Return the size of the current buffer's gap.
1076 See also `gap-position'. */)
1080 XSETFASTINT (temp
, GAP_SIZE
);
1084 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
1085 doc
: /* Return the byte position for character position POSITION.
1086 If POSITION is out of range, the value is nil. */)
1087 (Lisp_Object position
)
1089 CHECK_NUMBER_COERCE_MARKER (position
);
1090 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
1092 return make_number (CHAR_TO_BYTE (XINT (position
)));
1095 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
1096 doc
: /* Return the character position for byte position BYTEPOS.
1097 If BYTEPOS is out of range, the value is nil. */)
1098 (Lisp_Object bytepos
)
1100 CHECK_NUMBER (bytepos
);
1101 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
1103 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
1106 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
1107 doc
: /* Return the character following point, as a number.
1108 At the end of the buffer or accessible region, return 0. */)
1113 XSETFASTINT (temp
, 0);
1115 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
1119 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
1120 doc
: /* Return the character preceding point, as a number.
1121 At the beginning of the buffer or accessible region, return 0. */)
1126 XSETFASTINT (temp
, 0);
1127 else if (!NILP (current_buffer
->enable_multibyte_characters
))
1131 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1134 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1138 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1139 doc
: /* Return t if point is at the beginning of the buffer.
1140 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1148 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1149 doc
: /* Return t if point is at the end of the buffer.
1150 If the buffer is narrowed, this means the end of the narrowed part. */)
1158 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1159 doc
: /* Return t if point is at the beginning of a line. */)
1162 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1167 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1168 doc
: /* Return t if point is at the end of a line.
1169 `End of a line' includes point being at the end of the buffer. */)
1172 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1177 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1178 doc
: /* Return character in current buffer at position POS.
1179 POS is an integer or a marker and defaults to point.
1180 If POS is out of range, the value is nil. */)
1183 register int pos_byte
;
1188 XSETFASTINT (pos
, PT
);
1193 pos_byte
= marker_byte_position (pos
);
1194 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1199 CHECK_NUMBER_COERCE_MARKER (pos
);
1200 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1203 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1206 return make_number (FETCH_CHAR (pos_byte
));
1209 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1210 doc
: /* Return character in current buffer preceding position POS.
1211 POS is an integer or a marker and defaults to point.
1212 If POS is out of range, the value is nil. */)
1215 register Lisp_Object val
;
1216 register int pos_byte
;
1221 XSETFASTINT (pos
, PT
);
1226 pos_byte
= marker_byte_position (pos
);
1228 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1233 CHECK_NUMBER_COERCE_MARKER (pos
);
1235 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1238 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1241 if (!NILP (current_buffer
->enable_multibyte_characters
))
1244 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1249 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1254 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1255 doc
: /* Return the name under which the user logged in, as a string.
1256 This is based on the effective uid, not the real uid.
1257 Also, if the environment variables LOGNAME or USER are set,
1258 that determines the value of this function.
1260 If optional argument UID is an integer or a float, return the login name
1261 of the user with that uid, or nil if there is no such user. */)
1267 /* Set up the user name info if we didn't do it before.
1268 (That can happen if Emacs is dumpable
1269 but you decide to run `temacs -l loadup' and not dump. */
1270 if (INTEGERP (Vuser_login_name
))
1274 return Vuser_login_name
;
1276 id
= (uid_t
)XFLOATINT (uid
);
1278 pw
= (struct passwd
*) getpwuid (id
);
1280 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1283 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1285 doc
: /* Return the name of the user's real uid, as a string.
1286 This ignores the environment variables LOGNAME and USER, so it differs from
1287 `user-login-name' when running under `su'. */)
1290 /* Set up the user name info if we didn't do it before.
1291 (That can happen if Emacs is dumpable
1292 but you decide to run `temacs -l loadup' and not dump. */
1293 if (INTEGERP (Vuser_login_name
))
1295 return Vuser_real_login_name
;
1298 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1299 doc
: /* Return the effective uid of Emacs.
1300 Value is an integer or a float, depending on the value. */)
1303 /* Assignment to EMACS_INT stops GCC whining about limited range of
1305 EMACS_INT euid
= geteuid ();
1307 /* Make sure we don't produce a negative UID due to signed integer
1310 return make_float ((double)geteuid ());
1311 return make_fixnum_or_float (euid
);
1314 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1315 doc
: /* Return the real uid of Emacs.
1316 Value is an integer or a float, depending on the value. */)
1319 /* Assignment to EMACS_INT stops GCC whining about limited range of
1321 EMACS_INT uid
= getuid ();
1323 /* Make sure we don't produce a negative UID due to signed integer
1326 return make_float ((double)getuid ());
1327 return make_fixnum_or_float (uid
);
1330 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1331 doc
: /* Return the full name of the user logged in, as a string.
1332 If the full name corresponding to Emacs's userid is not known,
1335 If optional argument UID is an integer or float, return the full name
1336 of the user with that uid, or nil if there is no such user.
1337 If UID is a string, return the full name of the user with that login
1338 name, or nil if there is no such user. */)
1342 register unsigned char *p
, *q
;
1346 return Vuser_full_name
;
1347 else if (NUMBERP (uid
))
1350 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1353 else if (STRINGP (uid
))
1356 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1360 error ("Invalid UID specification");
1365 p
= (unsigned char *) USER_FULL_NAME
;
1366 /* Chop off everything after the first comma. */
1367 q
= (unsigned char *) strchr (p
, ',');
1368 full
= make_string (p
, q
? q
- p
: strlen (p
));
1370 #ifdef AMPERSAND_FULL_NAME
1372 q
= (unsigned char *) strchr (p
, '&');
1373 /* Substitute the login name for the &, upcasing the first character. */
1376 register unsigned char *r
;
1379 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1380 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1381 memcpy (r
, p
, q
- p
);
1383 strcat (r
, SDATA (login
));
1384 r
[q
- p
] = UPCASE (r
[q
- p
]);
1386 full
= build_string (r
);
1388 #endif /* AMPERSAND_FULL_NAME */
1393 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1394 doc
: /* Return the host name of the machine you are running on, as a string. */)
1397 return Vsystem_name
;
1400 /* For the benefit of callers who don't want to include lisp.h */
1403 get_system_name (void)
1405 if (STRINGP (Vsystem_name
))
1406 return (char *) SDATA (Vsystem_name
);
1412 get_operating_system_release (void)
1414 if (STRINGP (Voperating_system_release
))
1415 return (char *) SDATA (Voperating_system_release
);
1420 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1421 doc
: /* Return the process ID of Emacs, as an integer. */)
1424 return make_number (getpid ());
1427 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1428 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1429 The time is returned as a list of three integers. The first has the
1430 most significant 16 bits of the seconds, while the second has the
1431 least significant 16 bits. The third integer gives the microsecond
1434 The microsecond count is zero on systems that do not provide
1435 resolution finer than a second. */)
1441 return list3 (make_number ((EMACS_SECS (t
) >> 16) & 0xffff),
1442 make_number ((EMACS_SECS (t
) >> 0) & 0xffff),
1443 make_number (EMACS_USECS (t
)));
1446 DEFUN ("get-internal-run-time", Fget_internal_run_time
, Sget_internal_run_time
,
1448 doc
: /* Return the current run time used by Emacs.
1449 The time is returned as a list of three integers. The first has the
1450 most significant 16 bits of the seconds, while the second has the
1451 least significant 16 bits. The third integer gives the microsecond
1454 On systems that can't determine the run time, `get-internal-run-time'
1455 does the same thing as `current-time'. The microsecond count is zero
1456 on systems that do not provide resolution finer than a second. */)
1459 #ifdef HAVE_GETRUSAGE
1460 struct rusage usage
;
1463 if (getrusage (RUSAGE_SELF
, &usage
) < 0)
1464 /* This shouldn't happen. What action is appropriate? */
1467 /* Sum up user time and system time. */
1468 secs
= usage
.ru_utime
.tv_sec
+ usage
.ru_stime
.tv_sec
;
1469 usecs
= usage
.ru_utime
.tv_usec
+ usage
.ru_stime
.tv_usec
;
1470 if (usecs
>= 1000000)
1476 return list3 (make_number ((secs
>> 16) & 0xffff),
1477 make_number ((secs
>> 0) & 0xffff),
1478 make_number (usecs
));
1479 #else /* ! HAVE_GETRUSAGE */
1481 return w32_get_internal_run_time ();
1482 #else /* ! WINDOWSNT */
1483 return Fcurrent_time ();
1484 #endif /* WINDOWSNT */
1485 #endif /* HAVE_GETRUSAGE */
1490 lisp_time_argument (Lisp_Object specified_time
, time_t *result
, int *usec
)
1492 if (NILP (specified_time
))
1499 *usec
= EMACS_USECS (t
);
1500 *result
= EMACS_SECS (t
);
1504 return time (result
) != -1;
1508 Lisp_Object high
, low
;
1509 high
= Fcar (specified_time
);
1510 CHECK_NUMBER (high
);
1511 low
= Fcdr (specified_time
);
1516 Lisp_Object usec_l
= Fcdr (low
);
1518 usec_l
= Fcar (usec_l
);
1523 CHECK_NUMBER (usec_l
);
1524 *usec
= XINT (usec_l
);
1532 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1533 return *result
>> 16 == XINT (high
);
1537 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1538 doc
: /* Return the current time, as a float number of seconds since the epoch.
1539 If SPECIFIED-TIME is given, it is the time to convert to float
1540 instead of the current time. The argument should have the form
1541 (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
1542 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1543 have the form (HIGH . LOW), but this is considered obsolete.
1545 WARNING: Since the result is floating point, it may not be exact.
1546 If precise time stamps are required, use either `current-time',
1547 or (if you need time as a string) `format-time-string'. */)
1548 (Lisp_Object specified_time
)
1553 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1554 error ("Invalid time specification");
1556 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1559 /* Write information into buffer S of size MAXSIZE, according to the
1560 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1561 Default to Universal Time if UT is nonzero, local time otherwise.
1562 Return the number of bytes written, not including the terminating
1563 '\0'. If S is NULL, nothing will be written anywhere; so to
1564 determine how many bytes would be written, use NULL for S and
1565 ((size_t) -1) for MAXSIZE.
1567 This function behaves like emacs_strftimeu, except it allows null
1570 emacs_memftimeu (char *s
, size_t maxsize
, const char *format
, size_t format_len
, const struct tm
*tp
, int ut
)
1574 /* Loop through all the null-terminated strings in the format
1575 argument. Normally there's just one null-terminated string, but
1576 there can be arbitrarily many, concatenated together, if the
1577 format contains '\0' bytes. emacs_strftimeu stops at the first
1578 '\0' byte so we must invoke it separately for each such string. */
1587 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1591 if (result
== 0 && s
[0] != '\0')
1596 maxsize
-= result
+ 1;
1598 len
= strlen (format
);
1599 if (len
== format_len
)
1603 format_len
-= len
+ 1;
1607 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1608 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1609 TIME is specified as (HIGH LOW . IGNORED), as returned by
1610 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
1611 is also still accepted.
1612 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1613 as Universal Time; nil means describe TIME in the local time zone.
1614 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1615 by text that describes the specified date and time in TIME:
1617 %Y is the year, %y within the century, %C the century.
1618 %G is the year corresponding to the ISO week, %g within the century.
1619 %m is the numeric month.
1620 %b and %h are the locale's abbreviated month name, %B the full name.
1621 %d is the day of the month, zero-padded, %e is blank-padded.
1622 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1623 %a is the locale's abbreviated name of the day of week, %A the full name.
1624 %U is the week number starting on Sunday, %W starting on Monday,
1625 %V according to ISO 8601.
1626 %j is the day of the year.
1628 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1629 only blank-padded, %l is like %I blank-padded.
1630 %p is the locale's equivalent of either AM or PM.
1633 %Z is the time zone name, %z is the numeric form.
1634 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1636 %c is the locale's date and time format.
1637 %x is the locale's "preferred" date format.
1638 %D is like "%m/%d/%y".
1640 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1641 %X is the locale's "preferred" time format.
1643 Finally, %n is a newline, %t is a tab, %% is a literal %.
1645 Certain flags and modifiers are available with some format controls.
1646 The flags are `_', `-', `^' and `#'. For certain characters X,
1647 %_X is like %X, but padded with blanks; %-X is like %X,
1648 but without padding. %^X is like %X, but with all textual
1649 characters up-cased; %#X is like %X, but with letter-case of
1650 all textual characters reversed.
1651 %NX (where N stands for an integer) is like %X,
1652 but takes up at least N (a number) positions.
1653 The modifiers are `E' and `O'. For certain characters X,
1654 %EX is a locale's alternative version of %X;
1655 %OX is like %X, but uses the locale's number symbols.
1657 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1658 (Lisp_Object format_string
, Lisp_Object time
, Lisp_Object universal
)
1663 int ut
= ! NILP (universal
);
1665 CHECK_STRING (format_string
);
1667 if (! lisp_time_argument (time
, &value
, NULL
))
1668 error ("Invalid time specification");
1670 format_string
= code_convert_string_norecord (format_string
,
1671 Vlocale_coding_system
, 1);
1673 /* This is probably enough. */
1674 size
= SBYTES (format_string
) * 6 + 50;
1677 tm
= ut
? gmtime (&value
) : localtime (&value
);
1680 error ("Specified time is not representable");
1682 synchronize_system_time_locale ();
1686 char *buf
= (char *) alloca (size
+ 1);
1691 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1692 SBYTES (format_string
),
1695 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1696 return code_convert_string_norecord (make_unibyte_string (buf
, result
),
1697 Vlocale_coding_system
, 0);
1699 /* If buffer was too small, make it bigger and try again. */
1701 result
= emacs_memftimeu (NULL
, (size_t) -1,
1702 SDATA (format_string
),
1703 SBYTES (format_string
),
1710 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1711 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1712 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
1713 as from `current-time' and `file-attributes', or nil to use the
1714 current time. The obsolete form (HIGH . LOW) is also still accepted.
1715 The list has the following nine members: SEC is an integer between 0
1716 and 60; SEC is 60 for a leap second, which only some operating systems
1717 support. MINUTE is an integer between 0 and 59. HOUR is an integer
1718 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an
1719 integer between 1 and 12. YEAR is an integer indicating the
1720 four-digit year. DOW is the day of week, an integer between 0 and 6,
1721 where 0 is Sunday. DST is t if daylight saving time is in effect,
1722 otherwise nil. ZONE is an integer indicating the number of seconds
1723 east of Greenwich. (Note that Common Lisp has different meanings for
1725 (Lisp_Object specified_time
)
1729 struct tm
*decoded_time
;
1730 Lisp_Object list_args
[9];
1732 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1733 error ("Invalid time specification");
1736 decoded_time
= localtime (&time_spec
);
1739 error ("Specified time is not representable");
1740 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1741 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1742 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1743 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1744 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1745 /* On 64-bit machines an int is narrower than EMACS_INT, thus the
1746 cast below avoids overflow in int arithmetics. */
1747 XSETINT (list_args
[5], TM_YEAR_BASE
+ (EMACS_INT
) decoded_time
->tm_year
);
1748 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1749 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1751 /* Make a copy, in case gmtime modifies the struct. */
1752 save_tm
= *decoded_time
;
1754 decoded_time
= gmtime (&time_spec
);
1756 if (decoded_time
== 0)
1757 list_args
[8] = Qnil
;
1759 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1760 return Flist (9, list_args
);
1763 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1764 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1765 This is the reverse operation of `decode-time', which see.
1766 ZONE defaults to the current time zone rule. This can
1767 be a string or t (as from `set-time-zone-rule'), or it can be a list
1768 \(as from `current-time-zone') or an integer (as from `decode-time')
1769 applied without consideration for daylight saving time.
1771 You can pass more than 7 arguments; then the first six arguments
1772 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1773 The intervening arguments are ignored.
1774 This feature lets (apply 'encode-time (decode-time ...)) work.
1776 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed;
1777 for example, a DAY of 0 means the day preceding the given month.
1778 Year numbers less than 100 are treated just like other year numbers.
1779 If you want them to stand for years in this century, you must do that yourself.
1781 Years before 1970 are not guaranteed to work. On some systems,
1782 year values as low as 1901 do work.
1784 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1785 (int nargs
, register Lisp_Object
*args
)
1789 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1791 CHECK_NUMBER (args
[0]); /* second */
1792 CHECK_NUMBER (args
[1]); /* minute */
1793 CHECK_NUMBER (args
[2]); /* hour */
1794 CHECK_NUMBER (args
[3]); /* day */
1795 CHECK_NUMBER (args
[4]); /* month */
1796 CHECK_NUMBER (args
[5]); /* year */
1798 tm
.tm_sec
= XINT (args
[0]);
1799 tm
.tm_min
= XINT (args
[1]);
1800 tm
.tm_hour
= XINT (args
[2]);
1801 tm
.tm_mday
= XINT (args
[3]);
1802 tm
.tm_mon
= XINT (args
[4]) - 1;
1803 tm
.tm_year
= XINT (args
[5]) - TM_YEAR_BASE
;
1811 time
= mktime (&tm
);
1818 char **oldenv
= environ
, **newenv
;
1822 else if (STRINGP (zone
))
1823 tzstring
= (char *) SDATA (zone
);
1824 else if (INTEGERP (zone
))
1826 int abszone
= eabs (XINT (zone
));
1827 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1828 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1832 error ("Invalid time zone specification");
1834 /* Set TZ before calling mktime; merely adjusting mktime's returned
1835 value doesn't suffice, since that would mishandle leap seconds. */
1836 set_time_zone_rule (tzstring
);
1839 time
= mktime (&tm
);
1842 /* Restore TZ to previous value. */
1846 #ifdef LOCALTIME_CACHE
1851 if (time
== (time_t) -1)
1852 error ("Specified time is not representable");
1854 return make_time (time
);
1857 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1858 doc
: /* Return the current local time, as a human-readable string.
1859 Programs can use this function to decode a time,
1860 since the number of columns in each field is fixed
1861 if the year is in the range 1000-9999.
1862 The format is `Sun Sep 16 01:03:52 1973'.
1863 However, see also the functions `decode-time' and `format-time-string'
1864 which provide a much more powerful and general facility.
1866 If SPECIFIED-TIME is given, it is a time to format instead of the
1867 current time. The argument should have the form (HIGH LOW . IGNORED).
1868 Thus, you can use times obtained from `current-time' and from
1869 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW),
1870 but this is considered obsolete. */)
1871 (Lisp_Object specified_time
)
1877 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1878 error ("Invalid time specification");
1880 /* Convert to a string, checking for out-of-range time stamps.
1881 Don't use 'ctime', as that might dump core if VALUE is out of
1884 tm
= localtime (&value
);
1886 if (! (tm
&& TM_YEAR_IN_ASCTIME_RANGE (tm
->tm_year
) && (tem
= asctime (tm
))))
1887 error ("Specified time is not representable");
1889 /* Remove the trailing newline. */
1890 tem
[strlen (tem
) - 1] = '\0';
1892 return build_string (tem
);
1895 /* Yield A - B, measured in seconds.
1896 This function is copied from the GNU C Library. */
1898 tm_diff (struct tm
*a
, struct tm
*b
)
1900 /* Compute intervening leap days correctly even if year is negative.
1901 Take care to avoid int overflow in leap day calculations,
1902 but it's OK to assume that A and B are close to each other. */
1903 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1904 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1905 int a100
= a4
/ 25 - (a4
% 25 < 0);
1906 int b100
= b4
/ 25 - (b4
% 25 < 0);
1907 int a400
= a100
>> 2;
1908 int b400
= b100
>> 2;
1909 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1910 int years
= a
->tm_year
- b
->tm_year
;
1911 int days
= (365 * years
+ intervening_leap_days
1912 + (a
->tm_yday
- b
->tm_yday
));
1913 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1914 + (a
->tm_min
- b
->tm_min
))
1915 + (a
->tm_sec
- b
->tm_sec
));
1918 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1919 doc
: /* Return the offset and name for the local time zone.
1920 This returns a list of the form (OFFSET NAME).
1921 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1922 A negative value means west of Greenwich.
1923 NAME is a string giving the name of the time zone.
1924 If SPECIFIED-TIME is given, the time zone offset is determined from it
1925 instead of using the current time. The argument should have the form
1926 (HIGH LOW . IGNORED). Thus, you can use times obtained from
1927 `current-time' and from `file-attributes'. SPECIFIED-TIME can also
1928 have the form (HIGH . LOW), but this is considered obsolete.
1930 Some operating systems cannot provide all this information to Emacs;
1931 in this case, `current-time-zone' returns a list containing nil for
1932 the data it can't find. */)
1933 (Lisp_Object specified_time
)
1939 if (!lisp_time_argument (specified_time
, &value
, NULL
))
1944 t
= gmtime (&value
);
1948 t
= localtime (&value
);
1955 int offset
= tm_diff (t
, &gmt
);
1961 s
= (char *)t
->tm_zone
;
1962 #else /* not HAVE_TM_ZONE */
1964 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1965 s
= tzname
[t
->tm_isdst
];
1967 #endif /* not HAVE_TM_ZONE */
1971 /* No local time zone name is available; use "+-NNNN" instead. */
1972 int am
= (offset
< 0 ? -offset
: offset
) / 60;
1973 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
1977 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
1980 return Fmake_list (make_number (2), Qnil
);
1983 /* This holds the value of `environ' produced by the previous
1984 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
1985 has never been called. */
1986 static char **environbuf
;
1988 /* This holds the startup value of the TZ environment variable so it
1989 can be restored if the user calls set-time-zone-rule with a nil
1991 static char *initial_tz
;
1993 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
1994 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
1995 If TZ is nil, use implementation-defined default time zone information.
1996 If TZ is t, use Universal Time. */)
2001 /* When called for the first time, save the original TZ. */
2003 initial_tz
= (char *) getenv ("TZ");
2006 tzstring
= initial_tz
;
2007 else if (EQ (tz
, Qt
))
2012 tzstring
= (char *) SDATA (tz
);
2015 set_time_zone_rule (tzstring
);
2017 environbuf
= environ
;
2022 #ifdef LOCALTIME_CACHE
2024 /* These two values are known to load tz files in buggy implementations,
2025 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
2026 Their values shouldn't matter in non-buggy implementations.
2027 We don't use string literals for these strings,
2028 since if a string in the environment is in readonly
2029 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
2030 See Sun bugs 1113095 and 1114114, ``Timezone routines
2031 improperly modify environment''. */
2033 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
2034 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
2038 /* Set the local time zone rule to TZSTRING.
2039 This allocates memory into `environ', which it is the caller's
2040 responsibility to free. */
2043 set_time_zone_rule (const char *tzstring
)
2046 char **from
, **to
, **newenv
;
2048 /* Make the ENVIRON vector longer with room for TZSTRING. */
2049 for (from
= environ
; *from
; from
++)
2051 envptrs
= from
- environ
+ 2;
2052 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
2053 + (tzstring
? strlen (tzstring
) + 4 : 0));
2055 /* Add TZSTRING to the end of environ, as a value for TZ. */
2058 char *t
= (char *) (to
+ envptrs
);
2060 strcat (t
, tzstring
);
2064 /* Copy the old environ vector elements into NEWENV,
2065 but don't copy the TZ variable.
2066 So we have only one definition of TZ, which came from TZSTRING. */
2067 for (from
= environ
; *from
; from
++)
2068 if (strncmp (*from
, "TZ=", 3) != 0)
2074 /* If we do have a TZSTRING, NEWENV points to the vector slot where
2075 the TZ variable is stored. If we do not have a TZSTRING,
2076 TO points to the vector slot which has the terminating null. */
2078 #ifdef LOCALTIME_CACHE
2080 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
2081 "US/Pacific" that loads a tz file, then changes to a value like
2082 "XXX0" that does not load a tz file, and then changes back to
2083 its original value, the last change is (incorrectly) ignored.
2084 Also, if TZ changes twice in succession to values that do
2085 not load a tz file, tzset can dump core (see Sun bug#1225179).
2086 The following code works around these bugs. */
2090 /* Temporarily set TZ to a value that loads a tz file
2091 and that differs from tzstring. */
2093 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
2094 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
2100 /* The implied tzstring is unknown, so temporarily set TZ to
2101 two different values that each load a tz file. */
2102 *to
= set_time_zone_rule_tz1
;
2105 *to
= set_time_zone_rule_tz2
;
2110 /* Now TZ has the desired value, and tzset can be invoked safely. */
2117 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
2118 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
2119 type of object is Lisp_String). INHERIT is passed to
2120 INSERT_FROM_STRING_FUNC as the last argument. */
2123 general_insert_function (void (*insert_func
)
2124 (const unsigned char *, EMACS_INT
),
2125 void (*insert_from_string_func
)
2126 (Lisp_Object
, EMACS_INT
, EMACS_INT
,
2127 EMACS_INT
, EMACS_INT
, int),
2128 int inherit
, int nargs
, Lisp_Object
*args
)
2130 register int argnum
;
2131 register Lisp_Object val
;
2133 for (argnum
= 0; argnum
< nargs
; argnum
++)
2136 if (CHARACTERP (val
))
2138 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2141 if (!NILP (current_buffer
->enable_multibyte_characters
))
2142 len
= CHAR_STRING (XFASTINT (val
), str
);
2145 str
[0] = (ASCII_CHAR_P (XINT (val
))
2147 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
2150 (*insert_func
) (str
, len
);
2152 else if (STRINGP (val
))
2154 (*insert_from_string_func
) (val
, 0, 0,
2160 wrong_type_argument (Qchar_or_string_p
, val
);
2165 insert1 (Lisp_Object arg
)
2171 /* Callers passing one argument to Finsert need not gcpro the
2172 argument "array", since the only element of the array will
2173 not be used after calling insert or insert_from_string, so
2174 we don't care if it gets trashed. */
2176 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
2177 doc
: /* Insert the arguments, either strings or characters, at point.
2178 Point and before-insertion markers move forward to end up
2179 after the inserted text.
2180 Any other markers at the point of insertion remain before the text.
2182 If the current buffer is multibyte, unibyte strings are converted
2183 to multibyte for insertion (see `string-make-multibyte').
2184 If the current buffer is unibyte, multibyte strings are converted
2185 to unibyte for insertion (see `string-make-unibyte').
2187 When operating on binary data, it may be necessary to preserve the
2188 original bytes of a unibyte string when inserting it into a multibyte
2189 buffer; to accomplish this, apply `string-as-multibyte' to the string
2190 and insert the result.
2192 usage: (insert &rest ARGS) */)
2193 (int nargs
, register Lisp_Object
*args
)
2195 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
2199 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
2201 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
2202 Point and before-insertion markers move forward to end up
2203 after the inserted text.
2204 Any other markers at the point of insertion remain before the text.
2206 If the current buffer is multibyte, unibyte strings are converted
2207 to multibyte for insertion (see `unibyte-char-to-multibyte').
2208 If the current buffer is unibyte, multibyte strings are converted
2209 to unibyte for insertion.
2211 usage: (insert-and-inherit &rest ARGS) */)
2212 (int nargs
, register Lisp_Object
*args
)
2214 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2219 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2220 doc
: /* Insert strings or characters at point, relocating markers after the text.
2221 Point and markers move forward to end up after the inserted text.
2223 If the current buffer is multibyte, unibyte strings are converted
2224 to multibyte for insertion (see `unibyte-char-to-multibyte').
2225 If the current buffer is unibyte, multibyte strings are converted
2226 to unibyte for insertion.
2228 usage: (insert-before-markers &rest ARGS) */)
2229 (int nargs
, register Lisp_Object
*args
)
2231 general_insert_function (insert_before_markers
,
2232 insert_from_string_before_markers
, 0,
2237 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2238 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2239 doc
: /* Insert text at point, relocating markers and inheriting properties.
2240 Point and markers move forward to end up after the inserted text.
2242 If the current buffer is multibyte, unibyte strings are converted
2243 to multibyte for insertion (see `unibyte-char-to-multibyte').
2244 If the current buffer is unibyte, multibyte strings are converted
2245 to unibyte for insertion.
2247 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2248 (int nargs
, register Lisp_Object
*args
)
2250 general_insert_function (insert_before_markers_and_inherit
,
2251 insert_from_string_before_markers
, 1,
2256 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2257 doc
: /* Insert COUNT copies of CHARACTER.
2258 Point, and before-insertion markers, are relocated as in the function `insert'.
2259 The optional third arg INHERIT, if non-nil, says to inherit text properties
2260 from adjoining text, if those properties are sticky. */)
2261 (Lisp_Object character
, Lisp_Object count
, Lisp_Object inherit
)
2263 register unsigned char *string
;
2264 register int strlen
;
2267 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2269 CHECK_NUMBER (character
);
2270 CHECK_NUMBER (count
);
2272 if (!NILP (current_buffer
->enable_multibyte_characters
))
2273 len
= CHAR_STRING (XFASTINT (character
), str
);
2275 str
[0] = XFASTINT (character
), len
= 1;
2276 n
= XINT (count
) * len
;
2279 strlen
= min (n
, 256 * len
);
2280 string
= (unsigned char *) alloca (strlen
);
2281 for (i
= 0; i
< strlen
; i
++)
2282 string
[i
] = str
[i
% len
];
2286 if (!NILP (inherit
))
2287 insert_and_inherit (string
, strlen
);
2289 insert (string
, strlen
);
2294 if (!NILP (inherit
))
2295 insert_and_inherit (string
, n
);
2302 DEFUN ("insert-byte", Finsert_byte
, Sinsert_byte
, 2, 3, 0,
2303 doc
: /* Insert COUNT (second arg) copies of BYTE (first arg).
2304 Both arguments are required.
2305 BYTE is a number of the range 0..255.
2307 If BYTE is 128..255 and the current buffer is multibyte, the
2308 corresponding eight-bit character is inserted.
2310 Point, and before-insertion markers, are relocated as in the function `insert'.
2311 The optional third arg INHERIT, if non-nil, says to inherit text properties
2312 from adjoining text, if those properties are sticky. */)
2313 (Lisp_Object byte
, Lisp_Object count
, Lisp_Object inherit
)
2315 CHECK_NUMBER (byte
);
2316 if (XINT (byte
) < 0 || XINT (byte
) > 255)
2317 args_out_of_range_3 (byte
, make_number (0), make_number (255));
2318 if (XINT (byte
) >= 128
2319 && ! NILP (current_buffer
->enable_multibyte_characters
))
2320 XSETFASTINT (byte
, BYTE8_TO_CHAR (XINT (byte
)));
2321 return Finsert_char (byte
, count
, inherit
);
2325 /* Making strings from buffer contents. */
2327 /* Return a Lisp_String containing the text of the current buffer from
2328 START to END. If text properties are in use and the current buffer
2329 has properties in the range specified, the resulting string will also
2330 have them, if PROPS is nonzero.
2332 We don't want to use plain old make_string here, because it calls
2333 make_uninit_string, which can cause the buffer arena to be
2334 compacted. make_string has no way of knowing that the data has
2335 been moved, and thus copies the wrong data into the string. This
2336 doesn't effect most of the other users of make_string, so it should
2337 be left as is. But we should use this function when conjuring
2338 buffer substrings. */
2341 make_buffer_string (int start
, int end
, int props
)
2343 int start_byte
= CHAR_TO_BYTE (start
);
2344 int end_byte
= CHAR_TO_BYTE (end
);
2346 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2349 /* Return a Lisp_String containing the text of the current buffer from
2350 START / START_BYTE to END / END_BYTE.
2352 If text properties are in use and the current buffer
2353 has properties in the range specified, the resulting string will also
2354 have them, if PROPS is nonzero.
2356 We don't want to use plain old make_string here, because it calls
2357 make_uninit_string, which can cause the buffer arena to be
2358 compacted. make_string has no way of knowing that the data has
2359 been moved, and thus copies the wrong data into the string. This
2360 doesn't effect most of the other users of make_string, so it should
2361 be left as is. But we should use this function when conjuring
2362 buffer substrings. */
2365 make_buffer_string_both (int start
, int start_byte
, int end
, int end_byte
, int props
)
2367 Lisp_Object result
, tem
, tem1
;
2369 if (start
< GPT
&& GPT
< end
)
2372 if (! NILP (current_buffer
->enable_multibyte_characters
))
2373 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2375 result
= make_uninit_string (end
- start
);
2376 memcpy (SDATA (result
), BYTE_POS_ADDR (start_byte
), end_byte
- start_byte
);
2378 /* If desired, update and copy the text properties. */
2381 update_buffer_properties (start
, end
);
2383 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2384 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2386 if (XINT (tem
) != end
|| !NILP (tem1
))
2387 copy_intervals_to_string (result
, current_buffer
, start
,
2394 /* Call Vbuffer_access_fontify_functions for the range START ... END
2395 in the current buffer, if necessary. */
2398 update_buffer_properties (int start
, int end
)
2400 /* If this buffer has some access functions,
2401 call them, specifying the range of the buffer being accessed. */
2402 if (!NILP (Vbuffer_access_fontify_functions
))
2404 Lisp_Object args
[3];
2407 args
[0] = Qbuffer_access_fontify_functions
;
2408 XSETINT (args
[1], start
);
2409 XSETINT (args
[2], end
);
2411 /* But don't call them if we can tell that the work
2412 has already been done. */
2413 if (!NILP (Vbuffer_access_fontified_property
))
2415 tem
= Ftext_property_any (args
[1], args
[2],
2416 Vbuffer_access_fontified_property
,
2419 Frun_hook_with_args (3, args
);
2422 Frun_hook_with_args (3, args
);
2426 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2427 doc
: /* Return the contents of part of the current buffer as a string.
2428 The two arguments START and END are character positions;
2429 they can be in either order.
2430 The string returned is multibyte if the buffer is multibyte.
2432 This function copies the text properties of that part of the buffer
2433 into the result string; if you don't want the text properties,
2434 use `buffer-substring-no-properties' instead. */)
2435 (Lisp_Object start
, Lisp_Object end
)
2439 validate_region (&start
, &end
);
2443 return make_buffer_string (b
, e
, 1);
2446 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2447 Sbuffer_substring_no_properties
, 2, 2, 0,
2448 doc
: /* Return the characters of part of the buffer, without the text properties.
2449 The two arguments START and END are character positions;
2450 they can be in either order. */)
2451 (Lisp_Object start
, Lisp_Object end
)
2455 validate_region (&start
, &end
);
2459 return make_buffer_string (b
, e
, 0);
2462 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2463 doc
: /* Return the contents of the current buffer as a string.
2464 If narrowing is in effect, this function returns only the visible part
2468 return make_buffer_string (BEGV
, ZV
, 1);
2471 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2473 doc
: /* Insert before point a substring of the contents of BUFFER.
2474 BUFFER may be a buffer or a buffer name.
2475 Arguments START and END are character positions specifying the substring.
2476 They default to the values of (point-min) and (point-max) in BUFFER. */)
2477 (Lisp_Object buffer
, Lisp_Object start
, Lisp_Object end
)
2479 register int b
, e
, temp
;
2480 register struct buffer
*bp
, *obuf
;
2483 buf
= Fget_buffer (buffer
);
2487 if (NILP (bp
->name
))
2488 error ("Selecting deleted buffer");
2494 CHECK_NUMBER_COERCE_MARKER (start
);
2501 CHECK_NUMBER_COERCE_MARKER (end
);
2506 temp
= b
, b
= e
, e
= temp
;
2508 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2509 args_out_of_range (start
, end
);
2511 obuf
= current_buffer
;
2512 set_buffer_internal_1 (bp
);
2513 update_buffer_properties (b
, e
);
2514 set_buffer_internal_1 (obuf
);
2516 insert_from_buffer (bp
, b
, e
- b
, 0);
2520 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2522 doc
: /* Compare two substrings of two buffers; return result as number.
2523 the value is -N if first string is less after N-1 chars,
2524 +N if first string is greater after N-1 chars, or 0 if strings match.
2525 Each substring is represented as three arguments: BUFFER, START and END.
2526 That makes six args in all, three for each substring.
2528 The value of `case-fold-search' in the current buffer
2529 determines whether case is significant or ignored. */)
2530 (Lisp_Object buffer1
, Lisp_Object start1
, Lisp_Object end1
, Lisp_Object buffer2
, Lisp_Object start2
, Lisp_Object end2
)
2532 register int begp1
, endp1
, begp2
, endp2
, temp
;
2533 register struct buffer
*bp1
, *bp2
;
2534 register Lisp_Object trt
2535 = (!NILP (current_buffer
->case_fold_search
)
2536 ? current_buffer
->case_canon_table
: Qnil
);
2538 int i1
, i2
, i1_byte
, i2_byte
;
2540 /* Find the first buffer and its substring. */
2543 bp1
= current_buffer
;
2547 buf1
= Fget_buffer (buffer1
);
2550 bp1
= XBUFFER (buf1
);
2551 if (NILP (bp1
->name
))
2552 error ("Selecting deleted buffer");
2556 begp1
= BUF_BEGV (bp1
);
2559 CHECK_NUMBER_COERCE_MARKER (start1
);
2560 begp1
= XINT (start1
);
2563 endp1
= BUF_ZV (bp1
);
2566 CHECK_NUMBER_COERCE_MARKER (end1
);
2567 endp1
= XINT (end1
);
2571 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2573 if (!(BUF_BEGV (bp1
) <= begp1
2575 && endp1
<= BUF_ZV (bp1
)))
2576 args_out_of_range (start1
, end1
);
2578 /* Likewise for second substring. */
2581 bp2
= current_buffer
;
2585 buf2
= Fget_buffer (buffer2
);
2588 bp2
= XBUFFER (buf2
);
2589 if (NILP (bp2
->name
))
2590 error ("Selecting deleted buffer");
2594 begp2
= BUF_BEGV (bp2
);
2597 CHECK_NUMBER_COERCE_MARKER (start2
);
2598 begp2
= XINT (start2
);
2601 endp2
= BUF_ZV (bp2
);
2604 CHECK_NUMBER_COERCE_MARKER (end2
);
2605 endp2
= XINT (end2
);
2609 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2611 if (!(BUF_BEGV (bp2
) <= begp2
2613 && endp2
<= BUF_ZV (bp2
)))
2614 args_out_of_range (start2
, end2
);
2618 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2619 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2621 while (i1
< endp1
&& i2
< endp2
)
2623 /* When we find a mismatch, we must compare the
2624 characters, not just the bytes. */
2629 if (! NILP (bp1
->enable_multibyte_characters
))
2631 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2632 BUF_INC_POS (bp1
, i1_byte
);
2637 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2638 MAKE_CHAR_MULTIBYTE (c1
);
2642 if (! NILP (bp2
->enable_multibyte_characters
))
2644 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2645 BUF_INC_POS (bp2
, i2_byte
);
2650 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2651 MAKE_CHAR_MULTIBYTE (c2
);
2657 c1
= CHAR_TABLE_TRANSLATE (trt
, c1
);
2658 c2
= CHAR_TABLE_TRANSLATE (trt
, c2
);
2661 return make_number (- 1 - chars
);
2663 return make_number (chars
+ 1);
2668 /* The strings match as far as they go.
2669 If one is shorter, that one is less. */
2670 if (chars
< endp1
- begp1
)
2671 return make_number (chars
+ 1);
2672 else if (chars
< endp2
- begp2
)
2673 return make_number (- chars
- 1);
2675 /* Same length too => they are equal. */
2676 return make_number (0);
2680 subst_char_in_region_unwind (Lisp_Object arg
)
2682 return current_buffer
->undo_list
= arg
;
2686 subst_char_in_region_unwind_1 (Lisp_Object arg
)
2688 return current_buffer
->filename
= arg
;
2691 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2692 Ssubst_char_in_region
, 4, 5, 0,
2693 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2694 If optional arg NOUNDO is non-nil, don't record this change for undo
2695 and don't mark the buffer as really changed.
2696 Both characters must have the same length of multi-byte form. */)
2697 (Lisp_Object start
, Lisp_Object end
, Lisp_Object fromchar
, Lisp_Object tochar
, Lisp_Object noundo
)
2699 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2700 /* Keep track of the first change in the buffer:
2701 if 0 we haven't found it yet.
2702 if < 0 we've found it and we've run the before-change-function.
2703 if > 0 we've actually performed it and the value is its position. */
2705 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2707 int count
= SPECPDL_INDEX ();
2708 #define COMBINING_NO 0
2709 #define COMBINING_BEFORE 1
2710 #define COMBINING_AFTER 2
2711 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2712 int maybe_byte_combining
= COMBINING_NO
;
2713 int last_changed
= 0;
2714 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2718 validate_region (&start
, &end
);
2719 CHECK_NUMBER (fromchar
);
2720 CHECK_NUMBER (tochar
);
2724 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2725 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2726 error ("Characters in `subst-char-in-region' have different byte-lengths");
2727 if (!ASCII_BYTE_P (*tostr
))
2729 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2730 complete multibyte character, it may be combined with the
2731 after bytes. If it is in the range 0xA0..0xFF, it may be
2732 combined with the before and after bytes. */
2733 if (!CHAR_HEAD_P (*tostr
))
2734 maybe_byte_combining
= COMBINING_BOTH
;
2735 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2736 maybe_byte_combining
= COMBINING_AFTER
;
2742 fromstr
[0] = XFASTINT (fromchar
);
2743 tostr
[0] = XFASTINT (tochar
);
2747 pos_byte
= CHAR_TO_BYTE (pos
);
2748 stop
= CHAR_TO_BYTE (XINT (end
));
2751 /* If we don't want undo, turn off putting stuff on the list.
2752 That's faster than getting rid of things,
2753 and it prevents even the entry for a first change.
2754 Also inhibit locking the file. */
2755 if (!changed
&& !NILP (noundo
))
2757 record_unwind_protect (subst_char_in_region_unwind
,
2758 current_buffer
->undo_list
);
2759 current_buffer
->undo_list
= Qt
;
2760 /* Don't do file-locking. */
2761 record_unwind_protect (subst_char_in_region_unwind_1
,
2762 current_buffer
->filename
);
2763 current_buffer
->filename
= Qnil
;
2766 if (pos_byte
< GPT_BYTE
)
2767 stop
= min (stop
, GPT_BYTE
);
2770 int pos_byte_next
= pos_byte
;
2772 if (pos_byte
>= stop
)
2774 if (pos_byte
>= end_byte
) break;
2777 p
= BYTE_POS_ADDR (pos_byte
);
2779 INC_POS (pos_byte_next
);
2782 if (pos_byte_next
- pos_byte
== len
2783 && p
[0] == fromstr
[0]
2785 || (p
[1] == fromstr
[1]
2786 && (len
== 2 || (p
[2] == fromstr
[2]
2787 && (len
== 3 || p
[3] == fromstr
[3]))))))
2790 /* We've already seen this and run the before-change-function;
2791 this time we only need to record the actual position. */
2796 modify_region (current_buffer
, pos
, XINT (end
), 0);
2798 if (! NILP (noundo
))
2800 if (MODIFF
- 1 == SAVE_MODIFF
)
2802 if (MODIFF
- 1 == BUF_AUTOSAVE_MODIFF (current_buffer
))
2803 BUF_AUTOSAVE_MODIFF (current_buffer
)++;
2806 /* The before-change-function may have moved the gap
2807 or even modified the buffer so we should start over. */
2811 /* Take care of the case where the new character
2812 combines with neighboring bytes. */
2813 if (maybe_byte_combining
2814 && (maybe_byte_combining
== COMBINING_AFTER
2815 ? (pos_byte_next
< Z_BYTE
2816 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2817 : ((pos_byte_next
< Z_BYTE
2818 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2819 || (pos_byte
> BEG_BYTE
2820 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2822 Lisp_Object tem
, string
;
2824 struct gcpro gcpro1
;
2826 tem
= current_buffer
->undo_list
;
2829 /* Make a multibyte string containing this single character. */
2830 string
= make_multibyte_string (tostr
, 1, len
);
2831 /* replace_range is less efficient, because it moves the gap,
2832 but it handles combining correctly. */
2833 replace_range (pos
, pos
+ 1, string
,
2835 pos_byte_next
= CHAR_TO_BYTE (pos
);
2836 if (pos_byte_next
> pos_byte
)
2837 /* Before combining happened. We should not increment
2838 POS. So, to cancel the later increment of POS,
2842 INC_POS (pos_byte_next
);
2844 if (! NILP (noundo
))
2845 current_buffer
->undo_list
= tem
;
2852 record_change (pos
, 1);
2853 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2855 last_changed
= pos
+ 1;
2857 pos_byte
= pos_byte_next
;
2863 signal_after_change (changed
,
2864 last_changed
- changed
, last_changed
- changed
);
2865 update_compositions (changed
, last_changed
, CHECK_ALL
);
2868 unbind_to (count
, Qnil
);
2873 static Lisp_Object
check_translation (int, int, int, Lisp_Object
);
2875 /* Helper function for Ftranslate_region_internal.
2877 Check if a character sequence at POS (POS_BYTE) matches an element
2878 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
2879 element is found, return it. Otherwise return Qnil. */
2882 check_translation (int pos
, int pos_byte
, int end
, Lisp_Object val
)
2884 int buf_size
= 16, buf_used
= 0;
2885 int *buf
= alloca (sizeof (int) * buf_size
);
2887 for (; CONSP (val
); val
= XCDR (val
))
2896 if (! VECTORP (elt
))
2899 if (len
<= end
- pos
)
2901 for (i
= 0; i
< len
; i
++)
2905 unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2908 if (buf_used
== buf_size
)
2913 newbuf
= alloca (sizeof (int) * buf_size
);
2914 memcpy (newbuf
, buf
, sizeof (int) * buf_used
);
2917 buf
[buf_used
++] = STRING_CHAR_AND_LENGTH (p
, len
);
2920 if (XINT (AREF (elt
, i
)) != buf
[i
])
2931 DEFUN ("translate-region-internal", Ftranslate_region_internal
,
2932 Stranslate_region_internal
, 3, 3, 0,
2933 doc
: /* Internal use only.
2934 From START to END, translate characters according to TABLE.
2935 TABLE is a string or a char-table; the Nth character in it is the
2936 mapping for the character with code N.
2937 It returns the number of characters changed. */)
2938 (Lisp_Object start
, Lisp_Object end
, register Lisp_Object table
)
2940 register unsigned char *tt
; /* Trans table. */
2941 register int nc
; /* New character. */
2942 int cnt
; /* Number of changes made. */
2943 int size
; /* Size of translate table. */
2944 int pos
, pos_byte
, end_pos
;
2945 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2946 int string_multibyte
;
2949 validate_region (&start
, &end
);
2950 if (CHAR_TABLE_P (table
))
2952 if (! EQ (XCHAR_TABLE (table
)->purpose
, Qtranslation_table
))
2953 error ("Not a translation table");
2959 CHECK_STRING (table
);
2961 if (! multibyte
&& (SCHARS (table
) < SBYTES (table
)))
2962 table
= string_make_unibyte (table
);
2963 string_multibyte
= SCHARS (table
) < SBYTES (table
);
2964 size
= SBYTES (table
);
2969 pos_byte
= CHAR_TO_BYTE (pos
);
2970 end_pos
= XINT (end
);
2971 modify_region (current_buffer
, pos
, end_pos
, 0);
2974 for (; pos
< end_pos
; )
2976 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2977 unsigned char *str
, buf
[MAX_MULTIBYTE_LENGTH
];
2983 oc
= STRING_CHAR_AND_LENGTH (p
, len
);
2990 /* Reload as signal_after_change in last iteration may GC. */
2992 if (string_multibyte
)
2994 str
= tt
+ string_char_to_byte (table
, oc
);
2995 nc
= STRING_CHAR_AND_LENGTH (str
, str_len
);
3000 if (! ASCII_BYTE_P (nc
) && multibyte
)
3002 str_len
= BYTE8_STRING (nc
, buf
);
3017 val
= CHAR_TABLE_REF (table
, oc
);
3018 if (CHARACTERP (val
)
3019 && (c
= XINT (val
), CHAR_VALID_P (c
, 0)))
3022 str_len
= CHAR_STRING (nc
, buf
);
3025 else if (VECTORP (val
) || (CONSP (val
)))
3027 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
3028 where TO is TO-CHAR or [TO-CHAR ...]. */
3033 if (nc
!= oc
&& nc
>= 0)
3035 /* Simple one char to one char translation. */
3040 /* This is less efficient, because it moves the gap,
3041 but it should handle multibyte characters correctly. */
3042 string
= make_multibyte_string (str
, 1, str_len
);
3043 replace_range (pos
, pos
+ 1, string
, 1, 0, 1);
3048 record_change (pos
, 1);
3049 while (str_len
-- > 0)
3051 signal_after_change (pos
, 1, 1);
3052 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
3062 val
= check_translation (pos
, pos_byte
, end_pos
, val
);
3069 /* VAL is ([FROM-CHAR ...] . TO). */
3070 len
= ASIZE (XCAR (val
));
3078 string
= Fconcat (1, &val
);
3082 string
= Fmake_string (make_number (1), val
);
3084 replace_range (pos
, pos
+ len
, string
, 1, 0, 1);
3085 pos_byte
+= SBYTES (string
);
3086 pos
+= SCHARS (string
);
3087 cnt
+= SCHARS (string
);
3088 end_pos
+= SCHARS (string
) - len
;
3096 return make_number (cnt
);
3099 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
3100 doc
: /* Delete the text between point and mark.
3102 When called from a program, expects two arguments,
3103 positions (integers or markers) specifying the stretch to be deleted. */)
3104 (Lisp_Object start
, Lisp_Object end
)
3106 validate_region (&start
, &end
);
3107 del_range (XINT (start
), XINT (end
));
3111 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
3112 Sdelete_and_extract_region
, 2, 2, 0,
3113 doc
: /* Delete the text between START and END and return it. */)
3114 (Lisp_Object start
, Lisp_Object end
)
3116 validate_region (&start
, &end
);
3117 if (XINT (start
) == XINT (end
))
3118 return empty_unibyte_string
;
3119 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
3122 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
3123 doc
: /* Remove restrictions (narrowing) from current buffer.
3124 This allows the buffer's full text to be seen and edited. */)
3127 if (BEG
!= BEGV
|| Z
!= ZV
)
3128 current_buffer
->clip_changed
= 1;
3130 BEGV_BYTE
= BEG_BYTE
;
3131 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
3132 /* Changing the buffer bounds invalidates any recorded current column. */
3133 invalidate_current_column ();
3137 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
3138 doc
: /* Restrict editing in this buffer to the current region.
3139 The rest of the text becomes temporarily invisible and untouchable
3140 but is not deleted; if you save the buffer in a file, the invisible
3141 text is included in the file. \\[widen] makes all visible again.
3142 See also `save-restriction'.
3144 When calling from a program, pass two arguments; positions (integers
3145 or markers) bounding the text that should remain visible. */)
3146 (register Lisp_Object start
, Lisp_Object end
)
3148 CHECK_NUMBER_COERCE_MARKER (start
);
3149 CHECK_NUMBER_COERCE_MARKER (end
);
3151 if (XINT (start
) > XINT (end
))
3154 tem
= start
; start
= end
; end
= tem
;
3157 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
3158 args_out_of_range (start
, end
);
3160 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
3161 current_buffer
->clip_changed
= 1;
3163 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
3164 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
3165 if (PT
< XFASTINT (start
))
3166 SET_PT (XFASTINT (start
));
3167 if (PT
> XFASTINT (end
))
3168 SET_PT (XFASTINT (end
));
3169 /* Changing the buffer bounds invalidates any recorded current column. */
3170 invalidate_current_column ();
3175 save_restriction_save (void)
3177 if (BEGV
== BEG
&& ZV
== Z
)
3178 /* The common case that the buffer isn't narrowed.
3179 We return just the buffer object, which save_restriction_restore
3180 recognizes as meaning `no restriction'. */
3181 return Fcurrent_buffer ();
3183 /* We have to save a restriction, so return a pair of markers, one
3184 for the beginning and one for the end. */
3186 Lisp_Object beg
, end
;
3188 beg
= buildmark (BEGV
, BEGV_BYTE
);
3189 end
= buildmark (ZV
, ZV_BYTE
);
3191 /* END must move forward if text is inserted at its exact location. */
3192 XMARKER(end
)->insertion_type
= 1;
3194 return Fcons (beg
, end
);
3199 save_restriction_restore (Lisp_Object data
)
3201 struct buffer
*cur
= NULL
;
3202 struct buffer
*buf
= (CONSP (data
)
3203 ? XMARKER (XCAR (data
))->buffer
3206 if (buf
&& buf
!= current_buffer
&& !NILP (buf
->pt_marker
))
3207 { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
3208 is the case if it is or has an indirect buffer), then make
3209 sure it is current before we update BEGV, so
3210 set_buffer_internal takes care of managing those markers. */
3211 cur
= current_buffer
;
3212 set_buffer_internal (buf
);
3216 /* A pair of marks bounding a saved restriction. */
3218 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
3219 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
3220 eassert (buf
== end
->buffer
);
3222 if (buf
/* Verify marker still points to a buffer. */
3223 && (beg
->charpos
!= BUF_BEGV (buf
) || end
->charpos
!= BUF_ZV (buf
)))
3224 /* The restriction has changed from the saved one, so restore
3225 the saved restriction. */
3227 int pt
= BUF_PT (buf
);
3229 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
3230 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
3232 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
3233 /* The point is outside the new visible range, move it inside. */
3234 SET_BUF_PT_BOTH (buf
,
3235 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
3236 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE (buf
),
3239 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3243 /* A buffer, which means that there was no old restriction. */
3245 if (buf
/* Verify marker still points to a buffer. */
3246 && (BUF_BEGV (buf
) != BUF_BEG (buf
) || BUF_ZV (buf
) != BUF_Z (buf
)))
3247 /* The buffer has been narrowed, get rid of the narrowing. */
3249 SET_BUF_BEGV_BOTH (buf
, BUF_BEG (buf
), BUF_BEG_BYTE (buf
));
3250 SET_BUF_ZV_BOTH (buf
, BUF_Z (buf
), BUF_Z_BYTE (buf
));
3252 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
3257 set_buffer_internal (cur
);
3262 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
3263 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
3264 The buffer's restrictions make parts of the beginning and end invisible.
3265 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3266 This special form, `save-restriction', saves the current buffer's restrictions
3267 when it is entered, and restores them when it is exited.
3268 So any `narrow-to-region' within BODY lasts only until the end of the form.
3269 The old restrictions settings are restored
3270 even in case of abnormal exit (throw or error).
3272 The value returned is the value of the last form in BODY.
3274 Note: if you are using both `save-excursion' and `save-restriction',
3275 use `save-excursion' outermost:
3276 (save-excursion (save-restriction ...))
3278 usage: (save-restriction &rest BODY) */)
3281 register Lisp_Object val
;
3282 int count
= SPECPDL_INDEX ();
3284 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
3285 val
= Fprogn (body
);
3286 return unbind_to (count
, val
);
3289 /* Buffer for the most recent text displayed by Fmessage_box. */
3290 static char *message_text
;
3292 /* Allocated length of that buffer. */
3293 static int message_length
;
3295 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
3296 doc
: /* Display a message at the bottom of the screen.
3297 The message also goes into the `*Messages*' buffer.
3298 \(In keyboard macros, that's all it does.)
3301 The first argument is a format control string, and the rest are data
3302 to be formatted under control of the string. See `format' for details.
3304 Note: Use (message "%s" VALUE) to print the value of expressions and
3305 variables to avoid accidentally interpreting `%' as format specifiers.
3307 If the first argument is nil or the empty string, the function clears
3308 any existing message; this lets the minibuffer contents show. See
3309 also `current-message'.
3311 usage: (message FORMAT-STRING &rest ARGS) */)
3312 (int nargs
, Lisp_Object
*args
)
3315 || (STRINGP (args
[0])
3316 && SBYTES (args
[0]) == 0))
3323 register Lisp_Object val
;
3324 val
= Fformat (nargs
, args
);
3325 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
3330 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
3331 doc
: /* Display a message, in a dialog box if possible.
3332 If a dialog box is not available, use the echo area.
3333 The first argument is a format control string, and the rest are data
3334 to be formatted under control of the string. See `format' for details.
3336 If the first argument is nil or the empty string, clear any existing
3337 message; let the minibuffer contents show.
3339 usage: (message-box FORMAT-STRING &rest ARGS) */)
3340 (int nargs
, Lisp_Object
*args
)
3349 register Lisp_Object val
;
3350 val
= Fformat (nargs
, args
);
3352 /* The MS-DOS frames support popup menus even though they are
3353 not FRAME_WINDOW_P. */
3354 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
3355 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
3357 Lisp_Object pane
, menu
, obj
;
3358 struct gcpro gcpro1
;
3359 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
3361 menu
= Fcons (val
, pane
);
3362 obj
= Fx_popup_dialog (Qt
, menu
, Qt
);
3366 #endif /* HAVE_MENUS */
3367 /* Copy the data so that it won't move when we GC. */
3370 message_text
= (char *)xmalloc (80);
3371 message_length
= 80;
3373 if (SBYTES (val
) > message_length
)
3375 message_length
= SBYTES (val
);
3376 message_text
= (char *)xrealloc (message_text
, message_length
);
3378 memcpy (message_text
, SDATA (val
), SBYTES (val
));
3379 message2 (message_text
, SBYTES (val
),
3380 STRING_MULTIBYTE (val
));
3385 extern Lisp_Object last_nonmenu_event
;
3388 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
3389 doc
: /* Display a message in a dialog box or in the echo area.
3390 If this command was invoked with the mouse, use a dialog box if
3391 `use-dialog-box' is non-nil.
3392 Otherwise, use the echo area.
3393 The first argument is a format control string, and the rest are data
3394 to be formatted under control of the string. See `format' for details.
3396 If the first argument is nil or the empty string, clear any existing
3397 message; let the minibuffer contents show.
3399 usage: (message-or-box FORMAT-STRING &rest ARGS) */)
3400 (int nargs
, Lisp_Object
*args
)
3403 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3405 return Fmessage_box (nargs
, args
);
3407 return Fmessage (nargs
, args
);
3410 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3411 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3414 return current_message ();
3418 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3419 doc
: /* Return a copy of STRING with text properties added.
3420 First argument is the string to copy.
3421 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3422 properties to add to the result.
3423 usage: (propertize STRING &rest PROPERTIES) */)
3424 (int nargs
, Lisp_Object
*args
)
3426 Lisp_Object properties
, string
;
3427 struct gcpro gcpro1
, gcpro2
;
3430 /* Number of args must be odd. */
3431 if ((nargs
& 1) == 0 || nargs
< 1)
3432 error ("Wrong number of arguments");
3434 properties
= string
= Qnil
;
3435 GCPRO2 (properties
, string
);
3437 /* First argument must be a string. */
3438 CHECK_STRING (args
[0]);
3439 string
= Fcopy_sequence (args
[0]);
3441 for (i
= 1; i
< nargs
; i
+= 2)
3442 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3444 Fadd_text_properties (make_number (0),
3445 make_number (SCHARS (string
)),
3446 properties
, string
);
3447 RETURN_UNGCPRO (string
);
3451 /* Number of bytes that STRING will occupy when put into the result.
3452 MULTIBYTE is nonzero if the result should be multibyte. */
3454 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3455 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3456 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3459 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3460 doc
: /* Format a string out of a format-string and arguments.
3461 The first argument is a format control string.
3462 The other arguments are substituted into it to make the result, a string.
3464 The format control string may contain %-sequences meaning to substitute
3465 the next available argument:
3467 %s means print a string argument. Actually, prints any object, with `princ'.
3468 %d means print as number in decimal (%o octal, %x hex).
3469 %X is like %x, but uses upper case.
3470 %e means print a number in exponential notation.
3471 %f means print a number in decimal-point notation.
3472 %g means print a number in exponential notation
3473 or decimal-point notation, whichever uses fewer characters.
3474 %c means print a number as a single character.
3475 %S means print any object as an s-expression (using `prin1').
3477 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3478 Use %% to put a single % into the output.
3480 A %-sequence may contain optional flag, width, and precision
3481 specifiers, as follows:
3483 %<flags><width><precision>character
3485 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
3487 The + flag character inserts a + before any positive number, while a
3488 space inserts a space before any positive number; these flags only
3489 affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
3490 The # flag means to use an alternate display form for %o, %x, %X, %e,
3491 %f, and %g sequences. The - and 0 flags affect the width specifier,
3494 The width specifier supplies a lower limit for the length of the
3495 printed representation. The padding, if any, normally goes on the
3496 left, but it goes on the right if the - flag is present. The padding
3497 character is normally a space, but it is 0 if the 0 flag is present.
3498 The - flag takes precedence over the 0 flag.
3500 For %e, %f, and %g sequences, the number after the "." in the
3501 precision specifier says how many decimal places to show; if zero, the
3502 decimal point itself is omitted. For %s and %S, the precision
3503 specifier truncates the string to the given width.
3505 usage: (format STRING &rest OBJECTS) */)
3506 (int nargs
, register Lisp_Object
*args
)
3508 register int n
; /* The number of the next arg to substitute */
3509 register int total
; /* An estimate of the final length */
3511 register unsigned char *format
, *end
, *format_start
;
3513 /* Nonzero if the output should be a multibyte string,
3514 which is true if any of the inputs is one. */
3516 /* When we make a multibyte string, we must pay attention to the
3517 byte combining problem, i.e., a byte may be combined with a
3518 multibyte charcter of the previous string. This flag tells if we
3519 must consider such a situation or not. */
3520 int maybe_combine_byte
;
3521 unsigned char *this_format
;
3522 /* Precision for each spec, or -1, a flag value meaning no precision
3523 was given in that spec. Element 0, corresonding to the format
3524 string itself, will not be used. Element NARGS, corresponding to
3525 no argument, *will* be assigned to in the case that a `%' and `.'
3526 occur after the final format specifier. */
3527 int *precision
= (int *) (alloca ((nargs
+ 1) * sizeof (int)));
3530 int arg_intervals
= 0;
3533 /* discarded[I] is 1 if byte I of the format
3534 string was not copied into the output.
3535 It is 2 if byte I was not the first byte of its character. */
3536 char *discarded
= 0;
3538 /* Each element records, for one argument,
3539 the start and end bytepos in the output string,
3540 and whether the argument is a string with intervals.
3541 info[0] is unused. Unused elements have -1 for start. */
3544 int start
, end
, intervals
;
3547 /* It should not be necessary to GCPRO ARGS, because
3548 the caller in the interpreter should take care of that. */
3550 /* Try to determine whether the result should be multibyte.
3551 This is not always right; sometimes the result needs to be multibyte
3552 because of an object that we will pass through prin1,
3553 and in that case, we won't know it here. */
3554 for (n
= 0; n
< nargs
; n
++)
3556 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3558 /* Piggyback on this loop to initialize precision[N]. */
3561 precision
[nargs
] = -1;
3563 CHECK_STRING (args
[0]);
3564 /* We may have to change "%S" to "%s". */
3565 args
[0] = Fcopy_sequence (args
[0]);
3567 /* GC should never happen here, so abort if it does. */
3570 /* If we start out planning a unibyte result,
3571 then discover it has to be multibyte, we jump back to retry.
3572 That can only happen from the first large while loop below. */
3575 format
= SDATA (args
[0]);
3576 format_start
= format
;
3577 end
= format
+ SBYTES (args
[0]);
3580 /* Make room in result for all the non-%-codes in the control string. */
3581 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]) + 1;
3583 /* Allocate the info and discarded tables. */
3585 int nbytes
= (nargs
+1) * sizeof *info
;
3588 info
= (struct info
*) alloca (nbytes
);
3589 memset (info
, 0, nbytes
);
3590 for (i
= 0; i
<= nargs
; i
++)
3593 SAFE_ALLOCA (discarded
, char *, SBYTES (args
[0]));
3594 memset (discarded
, 0, SBYTES (args
[0]));
3597 /* Add to TOTAL enough space to hold the converted arguments. */
3600 while (format
!= end
)
3601 if (*format
++ == '%')
3604 int actual_width
= 0;
3605 unsigned char *this_format_start
= format
- 1;
3606 int field_width
= 0;
3608 /* General format specifications look like
3610 '%' [flags] [field-width] [precision] format
3615 field-width ::= [0-9]+
3616 precision ::= '.' [0-9]*
3618 If a field-width is specified, it specifies to which width
3619 the output should be padded with blanks, if the output
3620 string is shorter than field-width.
3622 If precision is specified, it specifies the number of
3623 digits to print after the '.' for floats, or the max.
3624 number of chars to print from a string. */
3626 while (format
!= end
3627 && (*format
== '-' || *format
== '0' || *format
== '#'
3628 || * format
== ' ' || *format
== '+'))
3631 if (*format
>= '0' && *format
<= '9')
3633 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3634 field_width
= 10 * field_width
+ *format
- '0';
3637 /* N is not incremented for another few lines below, so refer to
3638 element N+1 (which might be precision[NARGS]). */
3642 for (precision
[n
+1] = 0; *format
>= '0' && *format
<= '9'; ++format
)
3643 precision
[n
+1] = 10 * precision
[n
+1] + *format
- '0';
3646 /* Extra +1 for 'l' that we may need to insert into the
3648 if (format
- this_format_start
+ 2 > longest_format
)
3649 longest_format
= format
- this_format_start
+ 2;
3652 error ("Format string ends in middle of format specifier");
3655 else if (++n
>= nargs
)
3656 error ("Not enough arguments for format string");
3657 else if (*format
== 'S')
3659 /* For `S', prin1 the argument and then treat like a string. */
3660 register Lisp_Object tem
;
3661 tem
= Fprin1_to_string (args
[n
], Qnil
);
3662 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3668 /* If we restart the loop, we should not come here again
3669 because args[n] is now a string and calling
3670 Fprin1_to_string on it produces superflous double
3671 quotes. So, change "%S" to "%s" now. */
3675 else if (SYMBOLP (args
[n
]))
3677 args
[n
] = SYMBOL_NAME (args
[n
]);
3678 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3685 else if (STRINGP (args
[n
]))
3688 if (*format
!= 's' && *format
!= 'S')
3689 error ("Format specifier doesn't match argument type");
3690 /* In the case (PRECISION[N] > 0), THISSIZE may not need
3691 to be as large as is calculated here. Easy check for
3692 the case PRECISION = 0. */
3693 thissize
= precision
[n
] ? CONVERTED_BYTE_SIZE (multibyte
, args
[n
]) : 0;
3694 /* The precision also constrains how much of the argument
3695 string will finally appear (Bug#5710). */
3696 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3697 if (precision
[n
] != -1)
3698 actual_width
= min (actual_width
, precision
[n
]);
3700 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3701 else if (INTEGERP (args
[n
]) && *format
!= 's')
3703 /* The following loop assumes the Lisp type indicates
3704 the proper way to pass the argument.
3705 So make sure we have a flonum if the argument should
3707 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3708 args
[n
] = Ffloat (args
[n
]);
3710 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3711 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3712 error ("Invalid format operation %%%c", *format
);
3714 thissize
= 30 + (precision
[n
] > 0 ? precision
[n
] : 0);
3717 if (! ASCII_CHAR_P (XINT (args
[n
]))
3718 /* Note: No one can remeber why we have to treat
3719 the character 0 as a multibyte character here.
3720 But, until it causes a real problem, let's
3722 || XINT (args
[n
]) == 0)
3729 args
[n
] = Fchar_to_string (args
[n
]);
3730 thissize
= SBYTES (args
[n
]);
3732 else if (! ASCII_BYTE_P (XINT (args
[n
])) && multibyte
)
3735 = Fchar_to_string (Funibyte_char_to_multibyte (args
[n
]));
3736 thissize
= SBYTES (args
[n
]);
3740 else if (FLOATP (args
[n
]) && *format
!= 's')
3742 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3744 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3745 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3746 error ("Invalid format operation %%%c", *format
);
3747 /* This fails unnecessarily if args[n] is bigger than
3748 most-positive-fixnum but smaller than MAXINT.
3749 These cases are important because we sometimes use floats
3750 to represent such integer values (typically such values
3751 come from UIDs or PIDs). */
3752 /* args[n] = Ftruncate (args[n], Qnil); */
3755 /* Note that we're using sprintf to print floats,
3756 so we have to take into account what that function
3758 /* Filter out flag value of -1. */
3759 thissize
= (MAX_10_EXP
+ 100
3760 + (precision
[n
] > 0 ? precision
[n
] : 0));
3764 /* Anything but a string, convert to a string using princ. */
3765 register Lisp_Object tem
;
3766 tem
= Fprin1_to_string (args
[n
], Qt
);
3767 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3776 thissize
+= max (0, field_width
- actual_width
);
3777 total
+= thissize
+ 4;
3782 /* Now we can no longer jump to retry.
3783 TOTAL and LONGEST_FORMAT are known for certain. */
3785 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3787 /* Allocate the space for the result.
3788 Note that TOTAL is an overestimate. */
3789 SAFE_ALLOCA (buf
, char *, total
);
3795 /* Scan the format and store result in BUF. */
3796 format
= SDATA (args
[0]);
3797 format_start
= format
;
3798 end
= format
+ SBYTES (args
[0]);
3799 maybe_combine_byte
= 0;
3800 while (format
!= end
)
3806 unsigned char *this_format_start
= format
;
3808 discarded
[format
- format_start
] = 1;
3811 while (strchr ("-+0# ", *format
))
3817 discarded
[format
- format_start
] = 1;
3821 minlen
= atoi (format
);
3823 while ((*format
>= '0' && *format
<= '9') || *format
== '.')
3825 discarded
[format
- format_start
] = 1;
3829 if (*format
++ == '%')
3838 discarded
[format
- format_start
- 1] = 1;
3839 info
[n
].start
= nchars
;
3841 if (STRINGP (args
[n
]))
3843 /* handle case (precision[n] >= 0) */
3846 int nbytes
, start
, end
;
3849 /* lisp_string_width ignores a precision of 0, but GNU
3850 libc functions print 0 characters when the precision
3851 is 0. Imitate libc behavior here. Changing
3852 lisp_string_width is the right thing, and will be
3853 done, but meanwhile we work with it. */
3855 if (precision
[n
] == 0)
3856 width
= nchars_string
= nbytes
= 0;
3857 else if (precision
[n
] > 0)
3858 width
= lisp_string_width (args
[n
], precision
[n
], &nchars_string
, &nbytes
);
3860 { /* no precision spec given for this argument */
3861 width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3862 nbytes
= SBYTES (args
[n
]);
3863 nchars_string
= SCHARS (args
[n
]);
3866 /* If spec requires it, pad on right with spaces. */
3867 padding
= minlen
- width
;
3869 while (padding
-- > 0)
3875 info
[n
].start
= start
= nchars
;
3876 nchars
+= nchars_string
;
3881 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3882 && STRING_MULTIBYTE (args
[n
])
3883 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3884 maybe_combine_byte
= 1;
3886 p
+= copy_text (SDATA (args
[n
]), p
,
3888 STRING_MULTIBYTE (args
[n
]), multibyte
);
3890 info
[n
].end
= nchars
;
3893 while (padding
-- > 0)
3899 /* If this argument has text properties, record where
3900 in the result string it appears. */
3901 if (STRING_INTERVALS (args
[n
]))
3902 info
[n
].intervals
= arg_intervals
= 1;
3904 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3908 memcpy (this_format
, this_format_start
,
3909 format
- this_format_start
);
3910 this_format
[format
- this_format_start
] = 0;
3912 if (format
[-1] == 'e' || format
[-1] == 'f' || format
[-1] == 'g')
3913 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3916 if (sizeof (EMACS_INT
) > sizeof (int)
3917 && format
[-1] != 'c')
3919 /* Insert 'l' before format spec. */
3920 this_format
[format
- this_format_start
]
3921 = this_format
[format
- this_format_start
- 1];
3922 this_format
[format
- this_format_start
- 1] = 'l';
3923 this_format
[format
- this_format_start
+ 1] = 0;
3926 if (INTEGERP (args
[n
]))
3928 if (format
[-1] == 'c')
3929 sprintf (p
, this_format
, (int) XINT (args
[n
]));
3930 else if (format
[-1] == 'd')
3931 sprintf (p
, this_format
, XINT (args
[n
]));
3932 /* Don't sign-extend for octal or hex printing. */
3934 sprintf (p
, this_format
, XUINT (args
[n
]));
3936 else if (format
[-1] == 'c')
3937 sprintf (p
, this_format
, (int) XFLOAT_DATA (args
[n
]));
3938 else if (format
[-1] == 'd')
3939 /* Maybe we should use "%1.0f" instead so it also works
3940 for values larger than MAXINT. */
3941 sprintf (p
, this_format
, (EMACS_INT
) XFLOAT_DATA (args
[n
]));
3943 /* Don't sign-extend for octal or hex printing. */
3944 sprintf (p
, this_format
, (EMACS_UINT
) XFLOAT_DATA (args
[n
]));
3949 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3950 && !CHAR_HEAD_P (*((unsigned char *) p
)))
3951 maybe_combine_byte
= 1;
3952 this_nchars
= strlen (p
);
3954 p
+= str_to_multibyte (p
, buf
+ total
- 1 - p
, this_nchars
);
3957 nchars
+= this_nchars
;
3958 info
[n
].end
= nchars
;
3962 else if (STRING_MULTIBYTE (args
[0]))
3964 /* Copy a whole multibyte character. */
3967 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3968 && !CHAR_HEAD_P (*format
))
3969 maybe_combine_byte
= 1;
3971 while (! CHAR_HEAD_P (*format
))
3973 discarded
[format
- format_start
] = 2;
3980 /* Convert a single-byte character to multibyte. */
3981 int len
= copy_text (format
, p
, 1, 0, 1);
3988 *p
++ = *format
++, nchars
++;
3991 if (p
> buf
+ total
)
3994 if (maybe_combine_byte
)
3995 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
3996 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
3998 /* If we allocated BUF with malloc, free it too. */
4001 /* If the format string has text properties, or any of the string
4002 arguments has text properties, set up text properties of the
4005 if (STRING_INTERVALS (args
[0]) || arg_intervals
)
4007 Lisp_Object len
, new_len
, props
;
4008 struct gcpro gcpro1
;
4010 /* Add text properties from the format string. */
4011 len
= make_number (SCHARS (args
[0]));
4012 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
4017 int bytepos
= 0, position
= 0, translated
= 0, argn
= 1;
4020 /* Adjust the bounds of each text property
4021 to the proper start and end in the output string. */
4023 /* Put the positions in PROPS in increasing order, so that
4024 we can do (effectively) one scan through the position
4025 space of the format string. */
4026 props
= Fnreverse (props
);
4028 /* BYTEPOS is the byte position in the format string,
4029 POSITION is the untranslated char position in it,
4030 TRANSLATED is the translated char position in BUF,
4031 and ARGN is the number of the next arg we will come to. */
4032 for (list
= props
; CONSP (list
); list
= XCDR (list
))
4039 /* First adjust the property start position. */
4040 pos
= XINT (XCAR (item
));
4042 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
4043 up to this position. */
4044 for (; position
< pos
; bytepos
++)
4046 if (! discarded
[bytepos
])
4047 position
++, translated
++;
4048 else if (discarded
[bytepos
] == 1)
4051 if (translated
== info
[argn
].start
)
4053 translated
+= info
[argn
].end
- info
[argn
].start
;
4059 XSETCAR (item
, make_number (translated
));
4061 /* Likewise adjust the property end position. */
4062 pos
= XINT (XCAR (XCDR (item
)));
4064 for (; position
< pos
; bytepos
++)
4066 if (! discarded
[bytepos
])
4067 position
++, translated
++;
4068 else if (discarded
[bytepos
] == 1)
4071 if (translated
== info
[argn
].start
)
4073 translated
+= info
[argn
].end
- info
[argn
].start
;
4079 XSETCAR (XCDR (item
), make_number (translated
));
4082 add_text_properties_from_list (val
, props
, make_number (0));
4085 /* Add text properties from arguments. */
4087 for (n
= 1; n
< nargs
; ++n
)
4088 if (info
[n
].intervals
)
4090 len
= make_number (SCHARS (args
[n
]));
4091 new_len
= make_number (info
[n
].end
- info
[n
].start
);
4092 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
4093 props
= extend_property_ranges (props
, new_len
);
4094 /* If successive arguments have properties, be sure that
4095 the value of `composition' property be the copy. */
4096 if (n
> 1 && info
[n
- 1].end
)
4097 make_composition_value_copy (props
);
4098 add_text_properties_from_list (val
, props
,
4099 make_number (info
[n
].start
));
4109 format2 (const char *string1
, Lisp_Object arg0
, Lisp_Object arg1
)
4111 Lisp_Object args
[3];
4112 args
[0] = build_string (string1
);
4115 return Fformat (3, args
);
4118 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
4119 doc
: /* Return t if two characters match, optionally ignoring case.
4120 Both arguments must be characters (i.e. integers).
4121 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
4122 (register Lisp_Object c1
, Lisp_Object c2
)
4125 /* Check they're chars, not just integers, otherwise we could get array
4126 bounds violations in DOWNCASE. */
4127 CHECK_CHARACTER (c1
);
4128 CHECK_CHARACTER (c2
);
4130 if (XINT (c1
) == XINT (c2
))
4132 if (NILP (current_buffer
->case_fold_search
))
4135 /* Do these in separate statements,
4136 then compare the variables.
4137 because of the way DOWNCASE uses temp variables. */
4139 if (NILP (current_buffer
->enable_multibyte_characters
)
4140 && ! ASCII_CHAR_P (i1
))
4142 MAKE_CHAR_MULTIBYTE (i1
);
4145 if (NILP (current_buffer
->enable_multibyte_characters
)
4146 && ! ASCII_CHAR_P (i2
))
4148 MAKE_CHAR_MULTIBYTE (i2
);
4152 return (i1
== i2
? Qt
: Qnil
);
4155 /* Transpose the markers in two regions of the current buffer, and
4156 adjust the ones between them if necessary (i.e.: if the regions
4159 START1, END1 are the character positions of the first region.
4160 START1_BYTE, END1_BYTE are the byte positions.
4161 START2, END2 are the character positions of the second region.
4162 START2_BYTE, END2_BYTE are the byte positions.
4164 Traverses the entire marker list of the buffer to do so, adding an
4165 appropriate amount to some, subtracting from some, and leaving the
4166 rest untouched. Most of this is copied from adjust_markers in insdel.c.
4168 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
4171 transpose_markers (int start1
, int end1
, int start2
, int end2
,
4172 int start1_byte
, int end1_byte
,
4173 int start2_byte
, int end2_byte
)
4175 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
4176 register struct Lisp_Marker
*marker
;
4178 /* Update point as if it were a marker. */
4182 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
4183 PT_BYTE
+ (end2_byte
- end1_byte
));
4184 else if (PT
< start2
)
4185 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
4186 (PT_BYTE
+ (end2_byte
- start2_byte
)
4187 - (end1_byte
- start1_byte
)));
4189 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
4190 PT_BYTE
- (start2_byte
- start1_byte
));
4192 /* We used to adjust the endpoints here to account for the gap, but that
4193 isn't good enough. Even if we assume the caller has tried to move the
4194 gap out of our way, it might still be at start1 exactly, for example;
4195 and that places it `inside' the interval, for our purposes. The amount
4196 of adjustment is nontrivial if there's a `denormalized' marker whose
4197 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
4198 the dirty work to Fmarker_position, below. */
4200 /* The difference between the region's lengths */
4201 diff
= (end2
- start2
) - (end1
- start1
);
4202 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
4204 /* For shifting each marker in a region by the length of the other
4205 region plus the distance between the regions. */
4206 amt1
= (end2
- start2
) + (start2
- end1
);
4207 amt2
= (end1
- start1
) + (start2
- end1
);
4208 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
4209 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
4211 for (marker
= BUF_MARKERS (current_buffer
); marker
; marker
= marker
->next
)
4213 mpos
= marker
->bytepos
;
4214 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
4216 if (mpos
< end1_byte
)
4218 else if (mpos
< start2_byte
)
4222 marker
->bytepos
= mpos
;
4224 mpos
= marker
->charpos
;
4225 if (mpos
>= start1
&& mpos
< end2
)
4229 else if (mpos
< start2
)
4234 marker
->charpos
= mpos
;
4238 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
4239 doc
: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
4240 The regions should not be overlapping, because the size of the buffer is
4241 never changed in a transposition.
4243 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
4244 any markers that happen to be located in the regions.
4246 Transposing beyond buffer boundaries is an error. */)
4247 (Lisp_Object startr1
, Lisp_Object endr1
, Lisp_Object startr2
, Lisp_Object endr2
, Lisp_Object leave_markers
)
4249 register EMACS_INT start1
, end1
, start2
, end2
;
4250 EMACS_INT start1_byte
, start2_byte
, len1_byte
, len2_byte
;
4251 EMACS_INT gap
, len1
, len_mid
, len2
;
4252 unsigned char *start1_addr
, *start2_addr
, *temp
;
4254 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
, tmp_interval3
;
4257 XSETBUFFER (buf
, current_buffer
);
4258 cur_intv
= BUF_INTERVALS (current_buffer
);
4260 validate_region (&startr1
, &endr1
);
4261 validate_region (&startr2
, &endr2
);
4263 start1
= XFASTINT (startr1
);
4264 end1
= XFASTINT (endr1
);
4265 start2
= XFASTINT (startr2
);
4266 end2
= XFASTINT (endr2
);
4269 /* Swap the regions if they're reversed. */
4272 register int glumph
= start1
;
4280 len1
= end1
- start1
;
4281 len2
= end2
- start2
;
4284 error ("Transposed regions overlap");
4285 else if (start1
== end1
|| start2
== end2
)
4286 error ("Transposed region has length 0");
4288 /* The possibilities are:
4289 1. Adjacent (contiguous) regions, or separate but equal regions
4290 (no, really equal, in this case!), or
4291 2. Separate regions of unequal size.
4293 The worst case is usually No. 2. It means that (aside from
4294 potential need for getting the gap out of the way), there also
4295 needs to be a shifting of the text between the two regions. So
4296 if they are spread far apart, we are that much slower... sigh. */
4298 /* It must be pointed out that the really studly thing to do would
4299 be not to move the gap at all, but to leave it in place and work
4300 around it if necessary. This would be extremely efficient,
4301 especially considering that people are likely to do
4302 transpositions near where they are working interactively, which
4303 is exactly where the gap would be found. However, such code
4304 would be much harder to write and to read. So, if you are
4305 reading this comment and are feeling squirrely, by all means have
4306 a go! I just didn't feel like doing it, so I will simply move
4307 the gap the minimum distance to get it out of the way, and then
4308 deal with an unbroken array. */
4310 /* Make sure the gap won't interfere, by moving it out of the text
4311 we will operate on. */
4312 if (start1
< gap
&& gap
< end2
)
4314 if (gap
- start1
< end2
- gap
)
4320 start1_byte
= CHAR_TO_BYTE (start1
);
4321 start2_byte
= CHAR_TO_BYTE (start2
);
4322 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
4323 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
4325 #ifdef BYTE_COMBINING_DEBUG
4328 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4329 len2_byte
, start1
, start1_byte
)
4330 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4331 len1_byte
, end2
, start2_byte
+ len2_byte
)
4332 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4333 len1_byte
, end2
, start2_byte
+ len2_byte
))
4338 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
4339 len2_byte
, start1
, start1_byte
)
4340 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
4341 len1_byte
, start2
, start2_byte
)
4342 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
4343 len2_byte
, end1
, start1_byte
+ len1_byte
)
4344 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
4345 len1_byte
, end2
, start2_byte
+ len2_byte
))
4350 /* Hmmm... how about checking to see if the gap is large
4351 enough to use as the temporary storage? That would avoid an
4352 allocation... interesting. Later, don't fool with it now. */
4354 /* Working without memmove, for portability (sigh), so must be
4355 careful of overlapping subsections of the array... */
4357 if (end1
== start2
) /* adjacent regions */
4359 modify_region (current_buffer
, start1
, end2
, 0);
4360 record_change (start1
, len1
+ len2
);
4362 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4363 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4364 /* Don't use Fset_text_properties: that can cause GC, which can
4365 clobber objects stored in the tmp_intervals. */
4366 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4367 if (!NULL_INTERVAL_P (tmp_interval3
))
4368 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4370 /* First region smaller than second. */
4371 if (len1_byte
< len2_byte
)
4375 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4377 /* Don't precompute these addresses. We have to compute them
4378 at the last minute, because the relocating allocator might
4379 have moved the buffer around during the xmalloc. */
4380 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4381 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4383 memcpy (temp
, start2_addr
, len2_byte
);
4384 memcpy (start1_addr
+ len2_byte
, start1_addr
, len1_byte
);
4385 memcpy (start1_addr
, temp
, len2_byte
);
4389 /* First region not smaller than second. */
4393 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4394 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4395 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4396 memcpy (temp
, start1_addr
, len1_byte
);
4397 memcpy (start1_addr
, start2_addr
, len2_byte
);
4398 memcpy (start1_addr
+ len2_byte
, temp
, len1_byte
);
4401 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
4402 len1
, current_buffer
, 0);
4403 graft_intervals_into_buffer (tmp_interval2
, start1
,
4404 len2
, current_buffer
, 0);
4405 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4406 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
4408 /* Non-adjacent regions, because end1 != start2, bleagh... */
4411 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
4413 if (len1_byte
== len2_byte
)
4414 /* Regions are same size, though, how nice. */
4418 modify_region (current_buffer
, start1
, end1
, 0);
4419 modify_region (current_buffer
, start2
, end2
, 0);
4420 record_change (start1
, len1
);
4421 record_change (start2
, len2
);
4422 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4423 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4425 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr1
, 0);
4426 if (!NULL_INTERVAL_P (tmp_interval3
))
4427 set_text_properties_1 (startr1
, endr1
, Qnil
, buf
, tmp_interval3
);
4429 tmp_interval3
= validate_interval_range (buf
, &startr2
, &endr2
, 0);
4430 if (!NULL_INTERVAL_P (tmp_interval3
))
4431 set_text_properties_1 (startr2
, endr2
, Qnil
, buf
, tmp_interval3
);
4433 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4434 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4435 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4436 memcpy (temp
, start1_addr
, len1_byte
);
4437 memcpy (start1_addr
, start2_addr
, len2_byte
);
4438 memcpy (start2_addr
, temp
, len1_byte
);
4441 graft_intervals_into_buffer (tmp_interval1
, start2
,
4442 len1
, current_buffer
, 0);
4443 graft_intervals_into_buffer (tmp_interval2
, start1
,
4444 len2
, current_buffer
, 0);
4447 else if (len1_byte
< len2_byte
) /* Second region larger than first */
4448 /* Non-adjacent & unequal size, area between must also be shifted. */
4452 modify_region (current_buffer
, start1
, end2
, 0);
4453 record_change (start1
, (end2
- start1
));
4454 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4455 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4456 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4458 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4459 if (!NULL_INTERVAL_P (tmp_interval3
))
4460 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4462 /* holds region 2 */
4463 SAFE_ALLOCA (temp
, unsigned char *, len2_byte
);
4464 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4465 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4466 memcpy (temp
, start2_addr
, len2_byte
);
4467 memcpy (start1_addr
+ len_mid
+ len2_byte
, start1_addr
, len1_byte
);
4468 memmove (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4469 memcpy (start1_addr
, temp
, len2_byte
);
4472 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4473 len1
, current_buffer
, 0);
4474 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4475 len_mid
, current_buffer
, 0);
4476 graft_intervals_into_buffer (tmp_interval2
, start1
,
4477 len2
, current_buffer
, 0);
4480 /* Second region smaller than first. */
4484 record_change (start1
, (end2
- start1
));
4485 modify_region (current_buffer
, start1
, end2
, 0);
4487 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
4488 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
4489 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
4491 tmp_interval3
= validate_interval_range (buf
, &startr1
, &endr2
, 0);
4492 if (!NULL_INTERVAL_P (tmp_interval3
))
4493 set_text_properties_1 (startr1
, endr2
, Qnil
, buf
, tmp_interval3
);
4495 /* holds region 1 */
4496 SAFE_ALLOCA (temp
, unsigned char *, len1_byte
);
4497 start1_addr
= BYTE_POS_ADDR (start1_byte
);
4498 start2_addr
= BYTE_POS_ADDR (start2_byte
);
4499 memcpy (temp
, start1_addr
, len1_byte
);
4500 memcpy (start1_addr
, start2_addr
, len2_byte
);
4501 memcpy (start1_addr
+ len2_byte
, start1_addr
+ len1_byte
, len_mid
);
4502 memcpy (start1_addr
+ len2_byte
+ len_mid
, temp
, len1_byte
);
4505 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
4506 len1
, current_buffer
, 0);
4507 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
4508 len_mid
, current_buffer
, 0);
4509 graft_intervals_into_buffer (tmp_interval2
, start1
,
4510 len2
, current_buffer
, 0);
4513 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
4514 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
4517 /* When doing multiple transpositions, it might be nice
4518 to optimize this. Perhaps the markers in any one buffer
4519 should be organized in some sorted data tree. */
4520 if (NILP (leave_markers
))
4522 transpose_markers (start1
, end1
, start2
, end2
,
4523 start1_byte
, start1_byte
+ len1_byte
,
4524 start2_byte
, start2_byte
+ len2_byte
);
4525 fix_start_end_in_overlays (start1
, end2
);
4528 signal_after_change (start1
, end2
- start1
, end2
- start1
);
4534 syms_of_editfns (void)
4539 Qbuffer_access_fontify_functions
4540 = intern_c_string ("buffer-access-fontify-functions");
4541 staticpro (&Qbuffer_access_fontify_functions
);
4543 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
4544 doc
: /* Non-nil means text motion commands don't notice fields. */);
4545 Vinhibit_field_text_motion
= Qnil
;
4547 DEFVAR_LISP ("buffer-access-fontify-functions",
4548 &Vbuffer_access_fontify_functions
,
4549 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
4550 Each function is called with two arguments which specify the range
4551 of the buffer being accessed. */);
4552 Vbuffer_access_fontify_functions
= Qnil
;
4556 obuf
= Fcurrent_buffer ();
4557 /* Do this here, because init_buffer_once is too early--it won't work. */
4558 Fset_buffer (Vprin1_to_string_buffer
);
4559 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
4560 Fset (Fmake_local_variable (intern_c_string ("buffer-access-fontify-functions")),
4565 DEFVAR_LISP ("buffer-access-fontified-property",
4566 &Vbuffer_access_fontified_property
,
4567 doc
: /* Property which (if non-nil) indicates text has been fontified.
4568 `buffer-substring' need not call the `buffer-access-fontify-functions'
4569 functions if all the text being accessed has this property. */);
4570 Vbuffer_access_fontified_property
= Qnil
;
4572 DEFVAR_LISP ("system-name", &Vsystem_name
,
4573 doc
: /* The host name of the machine Emacs is running on. */);
4575 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
4576 doc
: /* The full name of the user logged in. */);
4578 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
4579 doc
: /* The user's name, taken from environment variables if possible. */);
4581 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
4582 doc
: /* The user's name, based upon the real uid only. */);
4584 DEFVAR_LISP ("operating-system-release", &Voperating_system_release
,
4585 doc
: /* The release of the operating system Emacs is running on. */);
4587 defsubr (&Spropertize
);
4588 defsubr (&Schar_equal
);
4589 defsubr (&Sgoto_char
);
4590 defsubr (&Sstring_to_char
);
4591 defsubr (&Schar_to_string
);
4592 defsubr (&Sbyte_to_string
);
4593 defsubr (&Sbuffer_substring
);
4594 defsubr (&Sbuffer_substring_no_properties
);
4595 defsubr (&Sbuffer_string
);
4597 defsubr (&Spoint_marker
);
4598 defsubr (&Smark_marker
);
4600 defsubr (&Sregion_beginning
);
4601 defsubr (&Sregion_end
);
4603 staticpro (&Qfield
);
4604 Qfield
= intern_c_string ("field");
4605 staticpro (&Qboundary
);
4606 Qboundary
= intern_c_string ("boundary");
4607 defsubr (&Sfield_beginning
);
4608 defsubr (&Sfield_end
);
4609 defsubr (&Sfield_string
);
4610 defsubr (&Sfield_string_no_properties
);
4611 defsubr (&Sdelete_field
);
4612 defsubr (&Sconstrain_to_field
);
4614 defsubr (&Sline_beginning_position
);
4615 defsubr (&Sline_end_position
);
4617 /* defsubr (&Smark); */
4618 /* defsubr (&Sset_mark); */
4619 defsubr (&Ssave_excursion
);
4620 defsubr (&Ssave_current_buffer
);
4622 defsubr (&Sbufsize
);
4623 defsubr (&Spoint_max
);
4624 defsubr (&Spoint_min
);
4625 defsubr (&Spoint_min_marker
);
4626 defsubr (&Spoint_max_marker
);
4627 defsubr (&Sgap_position
);
4628 defsubr (&Sgap_size
);
4629 defsubr (&Sposition_bytes
);
4630 defsubr (&Sbyte_to_position
);
4636 defsubr (&Sfollowing_char
);
4637 defsubr (&Sprevious_char
);
4638 defsubr (&Schar_after
);
4639 defsubr (&Schar_before
);
4641 defsubr (&Sinsert_before_markers
);
4642 defsubr (&Sinsert_and_inherit
);
4643 defsubr (&Sinsert_and_inherit_before_markers
);
4644 defsubr (&Sinsert_char
);
4645 defsubr (&Sinsert_byte
);
4647 defsubr (&Suser_login_name
);
4648 defsubr (&Suser_real_login_name
);
4649 defsubr (&Suser_uid
);
4650 defsubr (&Suser_real_uid
);
4651 defsubr (&Suser_full_name
);
4652 defsubr (&Semacs_pid
);
4653 defsubr (&Scurrent_time
);
4654 defsubr (&Sget_internal_run_time
);
4655 defsubr (&Sformat_time_string
);
4656 defsubr (&Sfloat_time
);
4657 defsubr (&Sdecode_time
);
4658 defsubr (&Sencode_time
);
4659 defsubr (&Scurrent_time_string
);
4660 defsubr (&Scurrent_time_zone
);
4661 defsubr (&Sset_time_zone_rule
);
4662 defsubr (&Ssystem_name
);
4663 defsubr (&Smessage
);
4664 defsubr (&Smessage_box
);
4665 defsubr (&Smessage_or_box
);
4666 defsubr (&Scurrent_message
);
4669 defsubr (&Sinsert_buffer_substring
);
4670 defsubr (&Scompare_buffer_substrings
);
4671 defsubr (&Ssubst_char_in_region
);
4672 defsubr (&Stranslate_region_internal
);
4673 defsubr (&Sdelete_region
);
4674 defsubr (&Sdelete_and_extract_region
);
4676 defsubr (&Snarrow_to_region
);
4677 defsubr (&Ssave_restriction
);
4678 defsubr (&Stranspose_regions
);
4681 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018
4682 (do not change this comment) */