1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999, 2000, 2001, 2002
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
24 #include <sys/types.h>
36 /* Without this, sprintf on Mac OS Classic will produce wrong
45 #include "intervals.h"
56 #define MAX_10_EXP DBL_MAX_10_EXP
58 #define MAX_10_EXP 310
66 extern char **environ
;
69 extern Lisp_Object make_time
P_ ((time_t));
70 extern size_t emacs_strftimeu
P_ ((char *, size_t, const char *,
71 const struct tm
*, int));
72 static int tm_diff
P_ ((struct tm
*, struct tm
*));
73 static void find_field
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, int *, Lisp_Object
, int *));
74 static void update_buffer_properties
P_ ((int, int));
75 static Lisp_Object region_limit
P_ ((int));
76 static int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
77 static size_t emacs_memftimeu
P_ ((char *, size_t, const char *,
78 size_t, const struct tm
*, int));
79 static void general_insert_function
P_ ((void (*) (const unsigned char *, int),
80 void (*) (Lisp_Object
, int, int, int,
82 int, int, Lisp_Object
*));
83 static Lisp_Object subst_char_in_region_unwind
P_ ((Lisp_Object
));
84 static Lisp_Object subst_char_in_region_unwind_1
P_ ((Lisp_Object
));
85 static void transpose_markers
P_ ((int, int, int, int, int, int, int, int));
88 extern char *index
P_ ((const char *, int));
91 Lisp_Object Vbuffer_access_fontify_functions
;
92 Lisp_Object Qbuffer_access_fontify_functions
;
93 Lisp_Object Vbuffer_access_fontified_property
;
95 Lisp_Object Fuser_full_name
P_ ((Lisp_Object
));
97 /* Non-nil means don't stop at field boundary in text motion commands. */
99 Lisp_Object Vinhibit_field_text_motion
;
101 /* Some static data, and a function to initialize it for each run */
103 Lisp_Object Vsystem_name
;
104 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
105 Lisp_Object Vuser_full_name
; /* full name of current user */
106 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
108 /* Symbol for the text property used to mark fields. */
112 /* A special value for Qfield properties. */
114 Lisp_Object Qboundary
;
121 register unsigned char *p
;
122 struct passwd
*pw
; /* password entry for the current user */
125 /* Set up system_name even when dumping. */
129 /* Don't bother with this on initial start when just dumping out */
132 #endif /* not CANNOT_DUMP */
134 pw
= (struct passwd
*) getpwuid (getuid ());
136 /* We let the real user name default to "root" because that's quite
137 accurate on MSDOG and because it lets Emacs find the init file.
138 (The DVX libraries override the Djgpp libraries here.) */
139 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
141 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
144 /* Get the effective user name, by consulting environment variables,
145 or the effective uid if those are unset. */
146 user_name
= (char *) getenv ("LOGNAME");
149 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
150 #else /* WINDOWSNT */
151 user_name
= (char *) getenv ("USER");
152 #endif /* WINDOWSNT */
155 pw
= (struct passwd
*) getpwuid (geteuid ());
156 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
158 Vuser_login_name
= build_string (user_name
);
160 /* If the user name claimed in the environment vars differs from
161 the real uid, use the claimed name to find the full name. */
162 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
163 Vuser_full_name
= Fuser_full_name (NILP (tem
)? make_number (geteuid())
166 p
= (unsigned char *) getenv ("NAME");
168 Vuser_full_name
= build_string (p
);
169 else if (NILP (Vuser_full_name
))
170 Vuser_full_name
= build_string ("unknown");
173 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
174 doc
: /* Convert arg CHAR to a string containing that character.
175 usage: (char-to-string CHAR) */)
177 Lisp_Object character
;
180 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
182 CHECK_NUMBER (character
);
184 len
= (SINGLE_BYTE_CHAR_P (XFASTINT (character
))
185 ? (*str
= (unsigned char)(XFASTINT (character
)), 1)
186 : char_to_string (XFASTINT (character
), str
));
187 return make_string_from_bytes (str
, 1, len
);
190 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
191 doc
: /* Convert arg STRING to a character, the first character of that string.
192 A multibyte character is handled correctly. */)
194 register Lisp_Object string
;
196 register Lisp_Object val
;
197 CHECK_STRING (string
);
200 if (STRING_MULTIBYTE (string
))
201 XSETFASTINT (val
, STRING_CHAR (SDATA (string
), SBYTES (string
)));
203 XSETFASTINT (val
, SREF (string
, 0));
206 XSETFASTINT (val
, 0);
211 buildmark (charpos
, bytepos
)
212 int charpos
, bytepos
;
214 register Lisp_Object mark
;
215 mark
= Fmake_marker ();
216 set_marker_both (mark
, Qnil
, charpos
, bytepos
);
220 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
221 doc
: /* Return value of point, as an integer.
222 Beginning of buffer is position (point-min). */)
226 XSETFASTINT (temp
, PT
);
230 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
231 doc
: /* Return value of point, as a marker object. */)
234 return buildmark (PT
, PT_BYTE
);
238 clip_to_bounds (lower
, num
, upper
)
239 int lower
, num
, upper
;
243 else if (num
> upper
)
249 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
250 doc
: /* Set point to POSITION, a number or marker.
251 Beginning of buffer is position (point-min), end is (point-max).
252 If the position is in the middle of a multibyte form,
253 the actual point is set at the head of the multibyte form
254 except in the case that `enable-multibyte-characters' is nil. */)
256 register Lisp_Object position
;
260 if (MARKERP (position
)
261 && current_buffer
== XMARKER (position
)->buffer
)
263 pos
= marker_position (position
);
265 SET_PT_BOTH (BEGV
, BEGV_BYTE
);
267 SET_PT_BOTH (ZV
, ZV_BYTE
);
269 SET_PT_BOTH (pos
, marker_byte_position (position
));
274 CHECK_NUMBER_COERCE_MARKER (position
);
276 pos
= clip_to_bounds (BEGV
, XINT (position
), ZV
);
282 /* Return the start or end position of the region.
283 BEGINNINGP non-zero means return the start.
284 If there is no region active, signal an error. */
287 region_limit (beginningp
)
290 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
293 if (!NILP (Vtransient_mark_mode
)
294 && NILP (Vmark_even_if_inactive
)
295 && NILP (current_buffer
->mark_active
))
296 Fsignal (Qmark_inactive
, Qnil
);
298 m
= Fmarker_position (current_buffer
->mark
);
300 error ("The mark is not set now, so there is no region");
302 if ((PT
< XFASTINT (m
)) == beginningp
)
303 m
= make_number (PT
);
307 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
308 doc
: /* Return position of beginning of region, as an integer. */)
311 return region_limit (1);
314 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
315 doc
: /* Return position of end of region, as an integer. */)
318 return region_limit (0);
321 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
322 doc
: /* Return this buffer's mark, as a marker object.
323 Watch out! Moving this marker changes the mark position.
324 If you set the marker not to point anywhere, the buffer will have no mark. */)
327 return current_buffer
->mark
;
331 /* Find the field surrounding POS in *BEG and *END. If POS is nil,
332 the value of point is used instead. If BEG or END null,
333 means don't store the beginning or end of the field.
335 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
336 results; they do not effect boundary behavior.
338 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
339 position of a field, then the beginning of the previous field is
340 returned instead of the beginning of POS's field (since the end of a
341 field is actually also the beginning of the next input field, this
342 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
343 true case, if two fields are separated by a field with the special
344 value `boundary', and POS lies within it, then the two separated
345 fields are considered to be adjacent, and POS between them, when
346 finding the beginning and ending of the "merged" field.
348 Either BEG or END may be 0, in which case the corresponding value
352 find_field (pos
, merge_at_boundary
, beg_limit
, beg
, end_limit
, end
)
354 Lisp_Object merge_at_boundary
;
355 Lisp_Object beg_limit
, end_limit
;
358 /* Fields right before and after the point. */
359 Lisp_Object before_field
, after_field
;
360 /* If the fields came from overlays, the associated overlays.
361 Qnil means they came from text-properties. */
362 Lisp_Object before_overlay
= Qnil
, after_overlay
= Qnil
;
363 /* 1 if POS counts as the start of a field. */
364 int at_field_start
= 0;
365 /* 1 if POS counts as the end of a field. */
366 int at_field_end
= 0;
369 XSETFASTINT (pos
, PT
);
371 CHECK_NUMBER_COERCE_MARKER (pos
);
374 = get_char_property_and_overlay (pos
, Qfield
, Qnil
, &after_overlay
);
376 = (XFASTINT (pos
) > BEGV
377 ? get_char_property_and_overlay (make_number (XINT (pos
) - 1),
382 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
383 and POS is at beginning of a field, which can also be interpreted
384 as the end of the previous field. Note that the case where if
385 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
386 more natural one; then we avoid treating the beginning of a field
388 if (NILP (merge_at_boundary
) && !EQ (after_field
, before_field
))
389 /* We are at a boundary, see which direction is inclusive. We
390 decide by seeing which field the `field' property sticks to. */
392 /* -1 means insertions go into before_field, 1 means they go
393 into after_field, 0 means neither. */
395 /* Whether the before/after_field come from overlays. */
396 int bop
= !NILP (before_overlay
);
397 int aop
= !NILP (after_overlay
);
399 if (bop
&& XMARKER (OVERLAY_END (before_overlay
))->insertion_type
== 1)
400 /* before_field is from an overlay, which expands upon
401 end-insertions. Note that it's possible for after_overlay to
402 also eat insertions here, but then they will overlap, and
403 there's not much we can do. */
406 && XMARKER (OVERLAY_START (after_overlay
))->insertion_type
== 0)
407 /* after_field is from an overlay, which expand to contain
411 /* Both fields come from overlays, but neither will contain any
415 /* before_field is an overlay that won't eat any insertion, but
416 after_field is from a text-property. Assume that the
417 text-property continues underneath the overlay, and so will
418 be inherited by any insertion, regardless of any stickiness
422 /* Similarly, when after_field is the overlay. */
425 /* Both fields come from text-properties. Look for explicit
426 stickiness properties. */
427 stickiness
= text_property_stickiness (Qfield
, pos
);
431 else if (stickiness
< 0)
434 /* STICKINESS == 0 means that any inserted text will get a
435 `field' char-property of nil, so check to see if that
436 matches either of the adjacent characters (this being a
437 kind of "stickiness by default"). */
439 if (NILP (before_field
))
440 at_field_end
= 1; /* Sticks to the left. */
441 else if (NILP (after_field
))
442 at_field_start
= 1; /* Sticks to the right. */
446 /* Note about special `boundary' fields:
448 Consider the case where the point (`.') is between the fields `x' and `y':
452 In this situation, if merge_at_boundary is true, we consider the
453 `x' and `y' fields as forming one big merged field, and so the end
454 of the field is the end of `y'.
456 However, if `x' and `y' are separated by a special `boundary' field
457 (a field with a `field' char-property of 'boundary), then we ignore
458 this special field when merging adjacent fields. Here's the same
459 situation, but with a `boundary' field between the `x' and `y' fields:
463 Here, if point is at the end of `x', the beginning of `y', or
464 anywhere in-between (within the `boundary' field), we merge all
465 three fields and consider the beginning as being the beginning of
466 the `x' field, and the end as being the end of the `y' field. */
471 /* POS is at the edge of a field, and we should consider it as
472 the beginning of the following field. */
473 *beg
= XFASTINT (pos
);
475 /* Find the previous field boundary. */
477 if (!NILP (merge_at_boundary
) && EQ (before_field
, Qboundary
))
478 /* Skip a `boundary' field. */
479 pos
= Fprevious_single_char_property_change (pos
, Qfield
, Qnil
,
482 pos
= Fprevious_single_char_property_change (pos
, Qfield
, Qnil
,
484 *beg
= NILP (pos
) ? BEGV
: XFASTINT (pos
);
491 /* POS is at the edge of a field, and we should consider it as
492 the end of the previous field. */
493 *end
= XFASTINT (pos
);
495 /* Find the next field boundary. */
497 if (!NILP (merge_at_boundary
) && EQ (after_field
, Qboundary
))
498 /* Skip a `boundary' field. */
499 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
502 pos
= Fnext_single_char_property_change (pos
, Qfield
, Qnil
,
504 *end
= NILP (pos
) ? ZV
: XFASTINT (pos
);
510 DEFUN ("delete-field", Fdelete_field
, Sdelete_field
, 0, 1, 0,
511 doc
: /* Delete the field surrounding POS.
512 A field is a region of text with the same `field' property.
513 If POS is nil, the value of point is used for POS. */)
518 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
520 del_range (beg
, end
);
524 DEFUN ("field-string", Ffield_string
, Sfield_string
, 0, 1, 0,
525 doc
: /* Return the contents of the field surrounding POS as a string.
526 A field is a region of text with the same `field' property.
527 If POS is nil, the value of point is used for POS. */)
532 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
533 return make_buffer_string (beg
, end
, 1);
536 DEFUN ("field-string-no-properties", Ffield_string_no_properties
, Sfield_string_no_properties
, 0, 1, 0,
537 doc
: /* Return the contents of the field around POS, without text-properties.
538 A field is a region of text with the same `field' property.
539 If POS is nil, the value of point is used for POS. */)
544 find_field (pos
, Qnil
, Qnil
, &beg
, Qnil
, &end
);
545 return make_buffer_string (beg
, end
, 0);
548 DEFUN ("field-beginning", Ffield_beginning
, Sfield_beginning
, 0, 3, 0,
549 doc
: /* Return the beginning of the field surrounding POS.
550 A field is a region of text with the same `field' property.
551 If POS is nil, the value of point is used for POS.
552 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
553 field, then the beginning of the *previous* field is returned.
554 If LIMIT is non-nil, it is a buffer position; if the beginning of the field
555 is before LIMIT, then LIMIT will be returned instead. */)
556 (pos
, escape_from_edge
, limit
)
557 Lisp_Object pos
, escape_from_edge
, limit
;
560 find_field (pos
, escape_from_edge
, limit
, &beg
, Qnil
, 0);
561 return make_number (beg
);
564 DEFUN ("field-end", Ffield_end
, Sfield_end
, 0, 3, 0,
565 doc
: /* Return the end of the field surrounding POS.
566 A field is a region of text with the same `field' property.
567 If POS is nil, the value of point is used for POS.
568 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
569 then the end of the *following* field is returned.
570 If LIMIT is non-nil, it is a buffer position; if the end of the field
571 is after LIMIT, then LIMIT will be returned instead. */)
572 (pos
, escape_from_edge
, limit
)
573 Lisp_Object pos
, escape_from_edge
, limit
;
576 find_field (pos
, escape_from_edge
, Qnil
, 0, limit
, &end
);
577 return make_number (end
);
580 DEFUN ("constrain-to-field", Fconstrain_to_field
, Sconstrain_to_field
, 2, 5, 0,
581 doc
: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
583 A field is a region of text with the same `field' property.
584 If NEW-POS is nil, then the current point is used instead, and set to the
585 constrained position if that is different.
587 If OLD-POS is at the boundary of two fields, then the allowable
588 positions for NEW-POS depends on the value of the optional argument
589 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
590 constrained to the field that has the same `field' char-property
591 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
592 is non-nil, NEW-POS is constrained to the union of the two adjacent
593 fields. Additionally, if two fields are separated by another field with
594 the special value `boundary', then any point within this special field is
595 also considered to be `on the boundary'.
597 If the optional argument ONLY-IN-LINE is non-nil and constraining
598 NEW-POS would move it to a different line, NEW-POS is returned
599 unconstrained. This useful for commands that move by line, like
600 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
601 only in the case where they can still move to the right line.
603 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
604 a non-nil property of that name, then any field boundaries are ignored.
606 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
607 (new_pos
, old_pos
, escape_from_edge
, only_in_line
, inhibit_capture_property
)
608 Lisp_Object new_pos
, old_pos
;
609 Lisp_Object escape_from_edge
, only_in_line
, inhibit_capture_property
;
611 /* If non-zero, then the original point, before re-positioning. */
615 /* Use the current point, and afterwards, set it. */
618 XSETFASTINT (new_pos
, PT
);
621 if (NILP (Vinhibit_field_text_motion
)
622 && !EQ (new_pos
, old_pos
)
623 && (!NILP (Fget_char_property (new_pos
, Qfield
, Qnil
))
624 || !NILP (Fget_char_property (old_pos
, Qfield
, Qnil
)))
625 && (NILP (inhibit_capture_property
)
626 || NILP (Fget_char_property(old_pos
, inhibit_capture_property
, Qnil
))))
627 /* NEW_POS is not within the same field as OLD_POS; try to
628 move NEW_POS so that it is. */
631 Lisp_Object field_bound
;
633 CHECK_NUMBER_COERCE_MARKER (new_pos
);
634 CHECK_NUMBER_COERCE_MARKER (old_pos
);
636 fwd
= (XFASTINT (new_pos
) > XFASTINT (old_pos
));
639 field_bound
= Ffield_end (old_pos
, escape_from_edge
, new_pos
);
641 field_bound
= Ffield_beginning (old_pos
, escape_from_edge
, new_pos
);
643 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the
644 other side of NEW_POS, which would mean that NEW_POS is
645 already acceptable, and it's not necessary to constrain it
647 ((XFASTINT (field_bound
) < XFASTINT (new_pos
)) ? fwd
: !fwd
)
648 /* NEW_POS should be constrained, but only if either
649 ONLY_IN_LINE is nil (in which case any constraint is OK),
650 or NEW_POS and FIELD_BOUND are on the same line (in which
651 case the constraint is OK even if ONLY_IN_LINE is non-nil). */
652 && (NILP (only_in_line
)
653 /* This is the ONLY_IN_LINE case, check that NEW_POS and
654 FIELD_BOUND are on the same line by seeing whether
655 there's an intervening newline or not. */
656 || (scan_buffer ('\n',
657 XFASTINT (new_pos
), XFASTINT (field_bound
),
658 fwd
? -1 : 1, &shortage
, 1),
660 /* Constrain NEW_POS to FIELD_BOUND. */
661 new_pos
= field_bound
;
663 if (orig_point
&& XFASTINT (new_pos
) != orig_point
)
664 /* The NEW_POS argument was originally nil, so automatically set PT. */
665 SET_PT (XFASTINT (new_pos
));
672 DEFUN ("line-beginning-position",
673 Fline_beginning_position
, Sline_beginning_position
, 0, 1, 0,
674 doc
: /* Return the character position of the first character on the current line.
675 With argument N not nil or 1, move forward N - 1 lines first.
676 If scan reaches end of buffer, return that position.
678 The scan does not cross a field boundary unless doing so would move
679 beyond there to a different line; if N is nil or 1, and scan starts at a
680 field boundary, the scan stops as soon as it starts. To ignore field
681 boundaries bind `inhibit-field-text-motion' to t.
683 This function does not move point. */)
687 int orig
, orig_byte
, end
;
696 Fforward_line (make_number (XINT (n
) - 1));
699 SET_PT_BOTH (orig
, orig_byte
);
701 /* Return END constrained to the current input field. */
702 return Fconstrain_to_field (make_number (end
), make_number (orig
),
703 XINT (n
) != 1 ? Qt
: Qnil
,
707 DEFUN ("line-end-position", Fline_end_position
, Sline_end_position
, 0, 1, 0,
708 doc
: /* Return the character position of the last character on the current line.
709 With argument N not nil or 1, move forward N - 1 lines first.
710 If scan reaches end of buffer, return that position.
712 The scan does not cross a field boundary unless doing so would move
713 beyond there to a different line; if N is nil or 1, and scan starts at a
714 field boundary, the scan stops as soon as it starts. To ignore field
715 boundaries bind `inhibit-field-text-motion' to t.
717 This function does not move point. */)
729 end_pos
= find_before_next_newline (orig
, 0, XINT (n
) - (XINT (n
) <= 0));
731 /* Return END_POS constrained to the current input field. */
732 return Fconstrain_to_field (make_number (end_pos
), make_number (orig
),
738 save_excursion_save ()
740 int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
743 return Fcons (Fpoint_marker (),
744 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
745 Fcons (visible
? Qt
: Qnil
,
746 Fcons (current_buffer
->mark_active
,
751 save_excursion_restore (info
)
754 Lisp_Object tem
, tem1
, omark
, nmark
;
755 struct gcpro gcpro1
, gcpro2
, gcpro3
;
758 tem
= Fmarker_buffer (XCAR (info
));
759 /* If buffer being returned to is now deleted, avoid error */
760 /* Otherwise could get error here while unwinding to top level
762 /* In that case, Fmarker_buffer returns nil now. */
766 omark
= nmark
= Qnil
;
767 GCPRO3 (info
, omark
, nmark
);
774 unchain_marker (tem
);
779 omark
= Fmarker_position (current_buffer
->mark
);
780 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
781 nmark
= Fmarker_position (tem
);
782 unchain_marker (tem
);
786 visible_p
= !NILP (XCAR (info
));
788 #if 0 /* We used to make the current buffer visible in the selected window
789 if that was true previously. That avoids some anomalies.
790 But it creates others, and it wasn't documented, and it is simpler
791 and cleaner never to alter the window/buffer connections. */
794 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
795 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
801 tem1
= current_buffer
->mark_active
;
802 current_buffer
->mark_active
= tem
;
804 if (!NILP (Vrun_hooks
))
806 /* If mark is active now, and either was not active
807 or was at a different place, run the activate hook. */
808 if (! NILP (current_buffer
->mark_active
))
810 if (! EQ (omark
, nmark
))
811 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
813 /* If mark has ceased to be active, run deactivate hook. */
814 else if (! NILP (tem1
))
815 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
818 /* If buffer was visible in a window, and a different window was
819 selected, and the old selected window is still showing this
820 buffer, restore point in that window. */
823 && !EQ (tem
, selected_window
)
824 && (tem1
= XWINDOW (tem
)->buffer
,
825 (/* Window is live... */
827 /* ...and it shows the current buffer. */
828 && XBUFFER (tem1
) == current_buffer
)))
829 Fset_window_point (tem
, make_number (PT
));
835 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
836 doc
: /* Save point, mark, and current buffer; execute BODY; restore those things.
837 Executes BODY just like `progn'.
838 The values of point, mark and the current buffer are restored
839 even in case of abnormal exit (throw or error).
840 The state of activation of the mark is also restored.
842 This construct does not save `deactivate-mark', and therefore
843 functions that change the buffer will still cause deactivation
844 of the mark at the end of the command. To prevent that, bind
845 `deactivate-mark' with `let'.
847 usage: (save-excursion &rest BODY) */)
851 register Lisp_Object val
;
852 int count
= SPECPDL_INDEX ();
854 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
857 return unbind_to (count
, val
);
860 DEFUN ("save-current-buffer", Fsave_current_buffer
, Ssave_current_buffer
, 0, UNEVALLED
, 0,
861 doc
: /* Save the current buffer; execute BODY; restore the current buffer.
862 Executes BODY just like `progn'.
863 usage: (save-current-buffer &rest BODY) */)
868 int count
= SPECPDL_INDEX ();
870 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
873 return unbind_to (count
, val
);
876 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 1, 0,
877 doc
: /* Return the number of characters in the current buffer.
878 If BUFFER, return the number of characters in that buffer instead. */)
883 return make_number (Z
- BEG
);
886 CHECK_BUFFER (buffer
);
887 return make_number (BUF_Z (XBUFFER (buffer
))
888 - BUF_BEG (XBUFFER (buffer
)));
892 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
893 doc
: /* Return the minimum permissible value of point in the current buffer.
894 This is 1, unless narrowing (a buffer restriction) is in effect. */)
898 XSETFASTINT (temp
, BEGV
);
902 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
903 doc
: /* Return a marker to the minimum permissible value of point in this buffer.
904 This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
907 return buildmark (BEGV
, BEGV_BYTE
);
910 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
911 doc
: /* Return the maximum permissible value of point in the current buffer.
912 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
913 is in effect, in which case it is less. */)
917 XSETFASTINT (temp
, ZV
);
921 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
922 doc
: /* Return a marker to the maximum permissible value of point in this buffer.
923 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
924 is in effect, in which case it is less. */)
927 return buildmark (ZV
, ZV_BYTE
);
930 DEFUN ("gap-position", Fgap_position
, Sgap_position
, 0, 0, 0,
931 doc
: /* Return the position of the gap, in the current buffer.
932 See also `gap-size'. */)
936 XSETFASTINT (temp
, GPT
);
940 DEFUN ("gap-size", Fgap_size
, Sgap_size
, 0, 0, 0,
941 doc
: /* Return the size of the current buffer's gap.
942 See also `gap-position'. */)
946 XSETFASTINT (temp
, GAP_SIZE
);
950 DEFUN ("position-bytes", Fposition_bytes
, Sposition_bytes
, 1, 1, 0,
951 doc
: /* Return the byte position for character position POSITION.
952 If POSITION is out of range, the value is nil. */)
954 Lisp_Object position
;
956 CHECK_NUMBER_COERCE_MARKER (position
);
957 if (XINT (position
) < BEG
|| XINT (position
) > Z
)
959 return make_number (CHAR_TO_BYTE (XINT (position
)));
962 DEFUN ("byte-to-position", Fbyte_to_position
, Sbyte_to_position
, 1, 1, 0,
963 doc
: /* Return the character position for byte position BYTEPOS.
964 If BYTEPOS is out of range, the value is nil. */)
968 CHECK_NUMBER (bytepos
);
969 if (XINT (bytepos
) < BEG_BYTE
|| XINT (bytepos
) > Z_BYTE
)
971 return make_number (BYTE_TO_CHAR (XINT (bytepos
)));
974 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
975 doc
: /* Return the character following point, as a number.
976 At the end of the buffer or accessible region, return 0. */)
981 XSETFASTINT (temp
, 0);
983 XSETFASTINT (temp
, FETCH_CHAR (PT_BYTE
));
987 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
988 doc
: /* Return the character preceding point, as a number.
989 At the beginning of the buffer or accessible region, return 0. */)
994 XSETFASTINT (temp
, 0);
995 else if (!NILP (current_buffer
->enable_multibyte_characters
))
999 XSETFASTINT (temp
, FETCH_CHAR (pos
));
1002 XSETFASTINT (temp
, FETCH_BYTE (PT_BYTE
- 1));
1006 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
1007 doc
: /* Return t if point is at the beginning of the buffer.
1008 If the buffer is narrowed, this means the beginning of the narrowed part. */)
1016 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
1017 doc
: /* Return t if point is at the end of the buffer.
1018 If the buffer is narrowed, this means the end of the narrowed part. */)
1026 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
1027 doc
: /* Return t if point is at the beginning of a line. */)
1030 if (PT
== BEGV
|| FETCH_BYTE (PT_BYTE
- 1) == '\n')
1035 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
1036 doc
: /* Return t if point is at the end of a line.
1037 `End of a line' includes point being at the end of the buffer. */)
1040 if (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n')
1045 DEFUN ("char-after", Fchar_after
, Schar_after
, 0, 1, 0,
1046 doc
: /* Return character in current buffer at position POS.
1047 POS is an integer or a marker.
1048 If POS is out of range, the value is nil. */)
1052 register int pos_byte
;
1057 XSETFASTINT (pos
, PT
);
1062 pos_byte
= marker_byte_position (pos
);
1063 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1068 CHECK_NUMBER_COERCE_MARKER (pos
);
1069 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1072 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1075 return make_number (FETCH_CHAR (pos_byte
));
1078 DEFUN ("char-before", Fchar_before
, Schar_before
, 0, 1, 0,
1079 doc
: /* Return character in current buffer preceding position POS.
1080 POS is an integer or a marker.
1081 If POS is out of range, the value is nil. */)
1085 register Lisp_Object val
;
1086 register int pos_byte
;
1091 XSETFASTINT (pos
, PT
);
1096 pos_byte
= marker_byte_position (pos
);
1098 if (pos_byte
<= BEGV_BYTE
|| pos_byte
> ZV_BYTE
)
1103 CHECK_NUMBER_COERCE_MARKER (pos
);
1105 if (XINT (pos
) <= BEGV
|| XINT (pos
) > ZV
)
1108 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1111 if (!NILP (current_buffer
->enable_multibyte_characters
))
1114 XSETFASTINT (val
, FETCH_CHAR (pos_byte
));
1119 XSETFASTINT (val
, FETCH_BYTE (pos_byte
));
1124 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
1125 doc
: /* Return the name under which the user logged in, as a string.
1126 This is based on the effective uid, not the real uid.
1127 Also, if the environment variable LOGNAME or USER is set,
1128 that determines the value of this function.
1130 If optional argument UID is an integer, return the login name of the user
1131 with that uid, or nil if there is no such user. */)
1137 /* Set up the user name info if we didn't do it before.
1138 (That can happen if Emacs is dumpable
1139 but you decide to run `temacs -l loadup' and not dump. */
1140 if (INTEGERP (Vuser_login_name
))
1144 return Vuser_login_name
;
1147 pw
= (struct passwd
*) getpwuid (XINT (uid
));
1148 return (pw
? build_string (pw
->pw_name
) : Qnil
);
1151 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
1153 doc
: /* Return the name of the user's real uid, as a string.
1154 This ignores the environment variables LOGNAME and USER, so it differs from
1155 `user-login-name' when running under `su'. */)
1158 /* Set up the user name info if we didn't do it before.
1159 (That can happen if Emacs is dumpable
1160 but you decide to run `temacs -l loadup' and not dump. */
1161 if (INTEGERP (Vuser_login_name
))
1163 return Vuser_real_login_name
;
1166 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
1167 doc
: /* Return the effective uid of Emacs.
1168 Value is an integer or float, depending on the value. */)
1171 return make_fixnum_or_float (geteuid ());
1174 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
1175 doc
: /* Return the real uid of Emacs.
1176 Value is an integer or float, depending on the value. */)
1179 return make_fixnum_or_float (getuid ());
1182 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 1, 0,
1183 doc
: /* Return the full name of the user logged in, as a string.
1184 If the full name corresponding to Emacs's userid is not known,
1187 If optional argument UID is an integer or float, return the full name
1188 of the user with that uid, or nil if there is no such user.
1189 If UID is a string, return the full name of the user with that login
1190 name, or nil if there is no such user. */)
1195 register unsigned char *p
, *q
;
1199 return Vuser_full_name
;
1200 else if (NUMBERP (uid
))
1201 pw
= (struct passwd
*) getpwuid ((uid_t
) XFLOATINT (uid
));
1202 else if (STRINGP (uid
))
1203 pw
= (struct passwd
*) getpwnam (SDATA (uid
));
1205 error ("Invalid UID specification");
1210 p
= (unsigned char *) USER_FULL_NAME
;
1211 /* Chop off everything after the first comma. */
1212 q
= (unsigned char *) index (p
, ',');
1213 full
= make_string (p
, q
? q
- p
: strlen (p
));
1215 #ifdef AMPERSAND_FULL_NAME
1217 q
= (unsigned char *) index (p
, '&');
1218 /* Substitute the login name for the &, upcasing the first character. */
1221 register unsigned char *r
;
1224 login
= Fuser_login_name (make_number (pw
->pw_uid
));
1225 r
= (unsigned char *) alloca (strlen (p
) + SCHARS (login
) + 1);
1226 bcopy (p
, r
, q
- p
);
1228 strcat (r
, SDATA (login
));
1229 r
[q
- p
] = UPCASE (r
[q
- p
]);
1231 full
= build_string (r
);
1233 #endif /* AMPERSAND_FULL_NAME */
1238 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
1239 doc
: /* Return the name of the machine you are running on, as a string. */)
1242 return Vsystem_name
;
1245 /* For the benefit of callers who don't want to include lisp.h */
1250 if (STRINGP (Vsystem_name
))
1251 return (char *) SDATA (Vsystem_name
);
1256 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
1257 doc
: /* Return the process ID of Emacs, as an integer. */)
1260 return make_number (getpid ());
1263 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
1264 doc
: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
1265 The time is returned as a list of three integers. The first has the
1266 most significant 16 bits of the seconds, while the second has the
1267 least significant 16 bits. The third integer gives the microsecond
1270 The microsecond count is zero on systems that do not provide
1271 resolution finer than a second. */)
1275 Lisp_Object result
[3];
1278 XSETINT (result
[0], (EMACS_SECS (t
) >> 16) & 0xffff);
1279 XSETINT (result
[1], (EMACS_SECS (t
) >> 0) & 0xffff);
1280 XSETINT (result
[2], EMACS_USECS (t
));
1282 return Flist (3, result
);
1287 lisp_time_argument (specified_time
, result
, usec
)
1288 Lisp_Object specified_time
;
1292 if (NILP (specified_time
))
1299 *usec
= EMACS_USECS (t
);
1300 *result
= EMACS_SECS (t
);
1304 return time (result
) != -1;
1308 Lisp_Object high
, low
;
1309 high
= Fcar (specified_time
);
1310 CHECK_NUMBER (high
);
1311 low
= Fcdr (specified_time
);
1316 Lisp_Object usec_l
= Fcdr (low
);
1318 usec_l
= Fcar (usec_l
);
1323 CHECK_NUMBER (usec_l
);
1324 *usec
= XINT (usec_l
);
1332 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
1333 return *result
>> 16 == XINT (high
);
1337 DEFUN ("float-time", Ffloat_time
, Sfloat_time
, 0, 1, 0,
1338 doc
: /* Return the current time, as a float number of seconds since the epoch.
1339 If an argument is given, it specifies a time to convert to float
1340 instead of the current time. The argument should have the forms:
1341 (HIGH . LOW) or (HIGH LOW USEC) or (HIGH LOW . USEC).
1342 Thus, you can use times obtained from `current-time'
1343 and from `file-attributes'.
1345 WARNING: Since the result is floating point, it may not be exact.
1346 Do not use this function if precise time stamps are required. */)
1348 Lisp_Object specified_time
;
1353 if (! lisp_time_argument (specified_time
, &sec
, &usec
))
1354 error ("Invalid time specification");
1356 return make_float ((sec
* 1e6
+ usec
) / 1e6
);
1359 /* Write information into buffer S of size MAXSIZE, according to the
1360 FORMAT of length FORMAT_LEN, using time information taken from *TP.
1361 Default to Universal Time if UT is nonzero, local time otherwise.
1362 Return the number of bytes written, not including the terminating
1363 '\0'. If S is NULL, nothing will be written anywhere; so to
1364 determine how many bytes would be written, use NULL for S and
1365 ((size_t) -1) for MAXSIZE.
1367 This function behaves like emacs_strftimeu, except it allows null
1370 emacs_memftimeu (s
, maxsize
, format
, format_len
, tp
, ut
)
1375 const struct tm
*tp
;
1380 /* Loop through all the null-terminated strings in the format
1381 argument. Normally there's just one null-terminated string, but
1382 there can be arbitrarily many, concatenated together, if the
1383 format contains '\0' bytes. emacs_strftimeu stops at the first
1384 '\0' byte so we must invoke it separately for each such string. */
1393 result
= emacs_strftimeu (s
, maxsize
, format
, tp
, ut
);
1397 if (result
== 0 && s
[0] != '\0')
1402 maxsize
-= result
+ 1;
1404 len
= strlen (format
);
1405 if (len
== format_len
)
1409 format_len
-= len
+ 1;
1413 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 3, 0,
1414 doc
: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
1415 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by
1416 `current-time' or `file-attributes'.
1417 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
1418 as Universal Time; nil means describe TIME in the local time zone.
1419 The value is a copy of FORMAT-STRING, but with certain constructs replaced
1420 by text that describes the specified date and time in TIME:
1422 %Y is the year, %y within the century, %C the century.
1423 %G is the year corresponding to the ISO week, %g within the century.
1424 %m is the numeric month.
1425 %b and %h are the locale's abbreviated month name, %B the full name.
1426 %d is the day of the month, zero-padded, %e is blank-padded.
1427 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
1428 %a is the locale's abbreviated name of the day of week, %A the full name.
1429 %U is the week number starting on Sunday, %W starting on Monday,
1430 %V according to ISO 8601.
1431 %j is the day of the year.
1433 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
1434 only blank-padded, %l is like %I blank-padded.
1435 %p is the locale's equivalent of either AM or PM.
1438 %Z is the time zone name, %z is the numeric form.
1439 %s is the number of seconds since 1970-01-01 00:00:00 +0000.
1441 %c is the locale's date and time format.
1442 %x is the locale's "preferred" date format.
1443 %D is like "%m/%d/%y".
1445 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
1446 %X is the locale's "preferred" time format.
1448 Finally, %n is a newline, %t is a tab, %% is a literal %.
1450 Certain flags and modifiers are available with some format controls.
1451 The flags are `_', `-', `^' and `#'. For certain characters X,
1452 %_X is like %X, but padded with blanks; %-X is like %X,
1453 ut without padding. %^X is like %X but with all textual
1454 characters up-cased; %#X is like %X but with letter-case of
1455 all textual characters reversed.
1456 %NX (where N stands for an integer) is like %X,
1457 but takes up at least N (a number) positions.
1458 The modifiers are `E' and `O'. For certain characters X,
1459 %EX is a locale's alternative version of %X;
1460 %OX is like %X, but uses the locale's number symbols.
1462 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */)
1463 (format_string
, time
, universal
)
1464 Lisp_Object format_string
, time
, universal
;
1469 int ut
= ! NILP (universal
);
1471 CHECK_STRING (format_string
);
1473 if (! lisp_time_argument (time
, &value
, NULL
))
1474 error ("Invalid time specification");
1476 format_string
= code_convert_string_norecord (format_string
,
1477 Vlocale_coding_system
, 1);
1479 /* This is probably enough. */
1480 size
= SBYTES (format_string
) * 6 + 50;
1482 tm
= ut
? gmtime (&value
) : localtime (&value
);
1484 error ("Specified time is not representable");
1486 synchronize_system_time_locale ();
1490 char *buf
= (char *) alloca (size
+ 1);
1494 result
= emacs_memftimeu (buf
, size
, SDATA (format_string
),
1495 SBYTES (format_string
),
1497 if ((result
> 0 && result
< size
) || (result
== 0 && buf
[0] == '\0'))
1498 return code_convert_string_norecord (make_string (buf
, result
),
1499 Vlocale_coding_system
, 0);
1501 /* If buffer was too small, make it bigger and try again. */
1502 result
= emacs_memftimeu (NULL
, (size_t) -1,
1503 SDATA (format_string
),
1504 SBYTES (format_string
),
1510 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
1511 doc
: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1512 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1513 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1514 to use the current time. The list has the following nine members:
1515 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1516 only some operating systems support. MINUTE is an integer between 0 and 59.
1517 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
1518 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
1519 four-digit year. DOW is the day of week, an integer between 0 and 6, where
1520 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
1521 ZONE is an integer indicating the number of seconds east of Greenwich.
1522 (Note that Common Lisp has different meanings for DOW and ZONE.) */)
1524 Lisp_Object specified_time
;
1528 struct tm
*decoded_time
;
1529 Lisp_Object list_args
[9];
1531 if (! lisp_time_argument (specified_time
, &time_spec
, NULL
))
1532 error ("Invalid time specification");
1534 decoded_time
= localtime (&time_spec
);
1536 error ("Specified time is not representable");
1537 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
1538 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
1539 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
1540 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
1541 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
1542 XSETINT (list_args
[5], decoded_time
->tm_year
+ 1900);
1543 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
1544 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
1546 /* Make a copy, in case gmtime modifies the struct. */
1547 save_tm
= *decoded_time
;
1548 decoded_time
= gmtime (&time_spec
);
1549 if (decoded_time
== 0)
1550 list_args
[8] = Qnil
;
1552 XSETINT (list_args
[8], tm_diff (&save_tm
, decoded_time
));
1553 return Flist (9, list_args
);
1556 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, MANY
, 0,
1557 doc
: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1558 This is the reverse operation of `decode-time', which see.
1559 ZONE defaults to the current time zone rule. This can
1560 be a string or t (as from `set-time-zone-rule'), or it can be a list
1561 \(as from `current-time-zone') or an integer (as from `decode-time')
1562 applied without consideration for daylight savings time.
1564 You can pass more than 7 arguments; then the first six arguments
1565 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1566 The intervening arguments are ignored.
1567 This feature lets (apply 'encode-time (decode-time ...)) work.
1569 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1570 for example, a DAY of 0 means the day preceding the given month.
1571 Year numbers less than 100 are treated just like other year numbers.
1572 If you want them to stand for years in this century, you must do that yourself.
1574 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
1577 register Lisp_Object
*args
;
1581 Lisp_Object zone
= (nargs
> 6 ? args
[nargs
- 1] : Qnil
);
1583 CHECK_NUMBER (args
[0]); /* second */
1584 CHECK_NUMBER (args
[1]); /* minute */
1585 CHECK_NUMBER (args
[2]); /* hour */
1586 CHECK_NUMBER (args
[3]); /* day */
1587 CHECK_NUMBER (args
[4]); /* month */
1588 CHECK_NUMBER (args
[5]); /* year */
1590 tm
.tm_sec
= XINT (args
[0]);
1591 tm
.tm_min
= XINT (args
[1]);
1592 tm
.tm_hour
= XINT (args
[2]);
1593 tm
.tm_mday
= XINT (args
[3]);
1594 tm
.tm_mon
= XINT (args
[4]) - 1;
1595 tm
.tm_year
= XINT (args
[5]) - 1900;
1601 time
= mktime (&tm
);
1606 char **oldenv
= environ
, **newenv
;
1610 else if (STRINGP (zone
))
1611 tzstring
= (char *) SDATA (zone
);
1612 else if (INTEGERP (zone
))
1614 int abszone
= abs (XINT (zone
));
1615 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
1616 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
1620 error ("Invalid time zone specification");
1622 /* Set TZ before calling mktime; merely adjusting mktime's returned
1623 value doesn't suffice, since that would mishandle leap seconds. */
1624 set_time_zone_rule (tzstring
);
1626 time
= mktime (&tm
);
1628 /* Restore TZ to previous value. */
1632 #ifdef LOCALTIME_CACHE
1637 if (time
== (time_t) -1)
1638 error ("Specified time is not representable");
1640 return make_time (time
);
1643 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
1644 doc
: /* Return the current time, as a human-readable string.
1645 Programs can use this function to decode a time,
1646 since the number of columns in each field is fixed.
1647 The format is `Sun Sep 16 01:03:52 1973'.
1648 However, see also the functions `decode-time' and `format-time-string'
1649 which provide a much more powerful and general facility.
1651 If an argument is given, it specifies a time to format
1652 instead of the current time. The argument should have the form:
1655 (HIGH LOW . IGNORED).
1656 Thus, you can use times obtained from `current-time'
1657 and from `file-attributes'. */)
1659 Lisp_Object specified_time
;
1665 if (! lisp_time_argument (specified_time
, &value
, NULL
))
1667 tem
= (char *) ctime (&value
);
1669 strncpy (buf
, tem
, 24);
1672 return build_string (buf
);
1675 #define TM_YEAR_BASE 1900
1677 /* Yield A - B, measured in seconds.
1678 This function is copied from the GNU C Library. */
1683 /* Compute intervening leap days correctly even if year is negative.
1684 Take care to avoid int overflow in leap day calculations,
1685 but it's OK to assume that A and B are close to each other. */
1686 int a4
= (a
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (a
->tm_year
& 3);
1687 int b4
= (b
->tm_year
>> 2) + (TM_YEAR_BASE
>> 2) - ! (b
->tm_year
& 3);
1688 int a100
= a4
/ 25 - (a4
% 25 < 0);
1689 int b100
= b4
/ 25 - (b4
% 25 < 0);
1690 int a400
= a100
>> 2;
1691 int b400
= b100
>> 2;
1692 int intervening_leap_days
= (a4
- b4
) - (a100
- b100
) + (a400
- b400
);
1693 int years
= a
->tm_year
- b
->tm_year
;
1694 int days
= (365 * years
+ intervening_leap_days
1695 + (a
->tm_yday
- b
->tm_yday
));
1696 return (60 * (60 * (24 * days
+ (a
->tm_hour
- b
->tm_hour
))
1697 + (a
->tm_min
- b
->tm_min
))
1698 + (a
->tm_sec
- b
->tm_sec
));
1701 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
1702 doc
: /* Return the offset and name for the local time zone.
1703 This returns a list of the form (OFFSET NAME).
1704 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1705 A negative value means west of Greenwich.
1706 NAME is a string giving the name of the time zone.
1707 If an argument is given, it specifies when the time zone offset is determined
1708 instead of using the current time. The argument should have the form:
1711 (HIGH LOW . IGNORED).
1712 Thus, you can use times obtained from `current-time'
1713 and from `file-attributes'.
1715 Some operating systems cannot provide all this information to Emacs;
1716 in this case, `current-time-zone' returns a list containing nil for
1717 the data it can't find. */)
1719 Lisp_Object specified_time
;
1725 if (lisp_time_argument (specified_time
, &value
, NULL
)
1726 && (t
= gmtime (&value
)) != 0
1727 && (gmt
= *t
, t
= localtime (&value
)) != 0)
1729 int offset
= tm_diff (t
, &gmt
);
1734 s
= (char *)t
->tm_zone
;
1735 #else /* not HAVE_TM_ZONE */
1737 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
1738 s
= tzname
[t
->tm_isdst
];
1740 #endif /* not HAVE_TM_ZONE */
1742 #if defined HAVE_TM_ZONE || defined HAVE_TZNAME
1745 /* On Japanese w32, we can get a Japanese string as time
1746 zone name. Don't accept that. */
1748 for (p
= s
; *p
&& (isalnum ((unsigned char)*p
) || *p
== ' '); ++p
)
1757 /* No local time zone name is available; use "+-NNNN" instead. */
1758 int am
= (offset
< 0 ? -offset
: offset
) / 60;
1759 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
1762 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
1765 return Fmake_list (make_number (2), Qnil
);
1768 /* This holds the value of `environ' produced by the previous
1769 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
1770 has never been called. */
1771 static char **environbuf
;
1773 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
1774 doc
: /* Set the local time zone using TZ, a string specifying a time zone rule.
1775 If TZ is nil, use implementation-defined default time zone information.
1776 If TZ is t, use Universal Time. */)
1784 else if (EQ (tz
, Qt
))
1789 tzstring
= (char *) SDATA (tz
);
1792 set_time_zone_rule (tzstring
);
1795 environbuf
= environ
;
1800 #ifdef LOCALTIME_CACHE
1802 /* These two values are known to load tz files in buggy implementations,
1803 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1804 Their values shouldn't matter in non-buggy implementations.
1805 We don't use string literals for these strings,
1806 since if a string in the environment is in readonly
1807 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1808 See Sun bugs 1113095 and 1114114, ``Timezone routines
1809 improperly modify environment''. */
1811 static char set_time_zone_rule_tz1
[] = "TZ=GMT+0";
1812 static char set_time_zone_rule_tz2
[] = "TZ=GMT+1";
1816 /* Set the local time zone rule to TZSTRING.
1817 This allocates memory into `environ', which it is the caller's
1818 responsibility to free. */
1821 set_time_zone_rule (tzstring
)
1825 char **from
, **to
, **newenv
;
1827 /* Make the ENVIRON vector longer with room for TZSTRING. */
1828 for (from
= environ
; *from
; from
++)
1830 envptrs
= from
- environ
+ 2;
1831 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
1832 + (tzstring
? strlen (tzstring
) + 4 : 0));
1834 /* Add TZSTRING to the end of environ, as a value for TZ. */
1837 char *t
= (char *) (to
+ envptrs
);
1839 strcat (t
, tzstring
);
1843 /* Copy the old environ vector elements into NEWENV,
1844 but don't copy the TZ variable.
1845 So we have only one definition of TZ, which came from TZSTRING. */
1846 for (from
= environ
; *from
; from
++)
1847 if (strncmp (*from
, "TZ=", 3) != 0)
1853 /* If we do have a TZSTRING, NEWENV points to the vector slot where
1854 the TZ variable is stored. If we do not have a TZSTRING,
1855 TO points to the vector slot which has the terminating null. */
1857 #ifdef LOCALTIME_CACHE
1859 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1860 "US/Pacific" that loads a tz file, then changes to a value like
1861 "XXX0" that does not load a tz file, and then changes back to
1862 its original value, the last change is (incorrectly) ignored.
1863 Also, if TZ changes twice in succession to values that do
1864 not load a tz file, tzset can dump core (see Sun bug#1225179).
1865 The following code works around these bugs. */
1869 /* Temporarily set TZ to a value that loads a tz file
1870 and that differs from tzstring. */
1872 *newenv
= (strcmp (tzstring
, set_time_zone_rule_tz1
+ 3) == 0
1873 ? set_time_zone_rule_tz2
: set_time_zone_rule_tz1
);
1879 /* The implied tzstring is unknown, so temporarily set TZ to
1880 two different values that each load a tz file. */
1881 *to
= set_time_zone_rule_tz1
;
1884 *to
= set_time_zone_rule_tz2
;
1889 /* Now TZ has the desired value, and tzset can be invoked safely. */
1896 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
1897 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
1898 type of object is Lisp_String). INHERIT is passed to
1899 INSERT_FROM_STRING_FUNC as the last argument. */
1902 general_insert_function (insert_func
, insert_from_string_func
,
1903 inherit
, nargs
, args
)
1904 void (*insert_func
) P_ ((const unsigned char *, int));
1905 void (*insert_from_string_func
) P_ ((Lisp_Object
, int, int, int, int, int));
1907 register Lisp_Object
*args
;
1909 register int argnum
;
1910 register Lisp_Object val
;
1912 for (argnum
= 0; argnum
< nargs
; argnum
++)
1918 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1921 if (!NILP (current_buffer
->enable_multibyte_characters
))
1922 len
= CHAR_STRING (XFASTINT (val
), str
);
1925 str
[0] = (SINGLE_BYTE_CHAR_P (XINT (val
))
1927 : multibyte_char_to_unibyte (XINT (val
), Qnil
));
1930 (*insert_func
) (str
, len
);
1932 else if (STRINGP (val
))
1934 (*insert_from_string_func
) (val
, 0, 0,
1941 val
= wrong_type_argument (Qchar_or_string_p
, val
);
1955 /* Callers passing one argument to Finsert need not gcpro the
1956 argument "array", since the only element of the array will
1957 not be used after calling insert or insert_from_string, so
1958 we don't care if it gets trashed. */
1960 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
1961 doc
: /* Insert the arguments, either strings or characters, at point.
1962 Point and before-insertion markers move forward to end up
1963 after the inserted text.
1964 Any other markers at the point of insertion remain before the text.
1966 If the current buffer is multibyte, unibyte strings are converted
1967 to multibyte for insertion (see `unibyte-char-to-multibyte').
1968 If the current buffer is unibyte, multibyte strings are converted
1969 to unibyte for insertion.
1971 usage: (insert &rest ARGS) */)
1974 register Lisp_Object
*args
;
1976 general_insert_function (insert
, insert_from_string
, 0, nargs
, args
);
1980 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
1982 doc
: /* Insert the arguments at point, inheriting properties from adjoining text.
1983 Point and before-insertion markers move forward to end up
1984 after the inserted text.
1985 Any other markers at the point of insertion remain before the text.
1987 If the current buffer is multibyte, unibyte strings are converted
1988 to multibyte for insertion (see `unibyte-char-to-multibyte').
1989 If the current buffer is unibyte, multibyte strings are converted
1990 to unibyte for insertion.
1992 usage: (insert-and-inherit &rest ARGS) */)
1995 register Lisp_Object
*args
;
1997 general_insert_function (insert_and_inherit
, insert_from_string
, 1,
2002 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
2003 doc
: /* Insert strings or characters at point, relocating markers after the text.
2004 Point and markers move forward to end up after the inserted text.
2006 If the current buffer is multibyte, unibyte strings are converted
2007 to multibyte for insertion (see `unibyte-char-to-multibyte').
2008 If the current buffer is unibyte, multibyte strings are converted
2009 to unibyte for insertion.
2011 usage: (insert-before-markers &rest ARGS) */)
2014 register Lisp_Object
*args
;
2016 general_insert_function (insert_before_markers
,
2017 insert_from_string_before_markers
, 0,
2022 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers
,
2023 Sinsert_and_inherit_before_markers
, 0, MANY
, 0,
2024 doc
: /* Insert text at point, relocating markers and inheriting properties.
2025 Point and markers move forward to end up after the inserted text.
2027 If the current buffer is multibyte, unibyte strings are converted
2028 to multibyte for insertion (see `unibyte-char-to-multibyte').
2029 If the current buffer is unibyte, multibyte strings are converted
2030 to unibyte for insertion.
2032 usage: (insert-before-markers-and-inherit &rest ARGS) */)
2035 register Lisp_Object
*args
;
2037 general_insert_function (insert_before_markers_and_inherit
,
2038 insert_from_string_before_markers
, 1,
2043 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
2044 doc
: /* Insert COUNT (second arg) copies of CHARACTER (first arg).
2045 Both arguments are required.
2046 Point, and before-insertion markers, are relocated as in the function `insert'.
2047 The optional third arg INHERIT, if non-nil, says to inherit text properties
2048 from adjoining text, if those properties are sticky. */)
2049 (character
, count
, inherit
)
2050 Lisp_Object character
, count
, inherit
;
2052 register unsigned char *string
;
2053 register int strlen
;
2056 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
2058 CHECK_NUMBER (character
);
2059 CHECK_NUMBER (count
);
2061 if (!NILP (current_buffer
->enable_multibyte_characters
))
2062 len
= CHAR_STRING (XFASTINT (character
), str
);
2064 str
[0] = XFASTINT (character
), len
= 1;
2065 n
= XINT (count
) * len
;
2068 strlen
= min (n
, 256 * len
);
2069 string
= (unsigned char *) alloca (strlen
);
2070 for (i
= 0; i
< strlen
; i
++)
2071 string
[i
] = str
[i
% len
];
2075 if (!NILP (inherit
))
2076 insert_and_inherit (string
, strlen
);
2078 insert (string
, strlen
);
2083 if (!NILP (inherit
))
2084 insert_and_inherit (string
, n
);
2092 /* Making strings from buffer contents. */
2094 /* Return a Lisp_String containing the text of the current buffer from
2095 START to END. If text properties are in use and the current buffer
2096 has properties in the range specified, the resulting string will also
2097 have them, if PROPS is nonzero.
2099 We don't want to use plain old make_string here, because it calls
2100 make_uninit_string, which can cause the buffer arena to be
2101 compacted. make_string has no way of knowing that the data has
2102 been moved, and thus copies the wrong data into the string. This
2103 doesn't effect most of the other users of make_string, so it should
2104 be left as is. But we should use this function when conjuring
2105 buffer substrings. */
2108 make_buffer_string (start
, end
, props
)
2112 int start_byte
= CHAR_TO_BYTE (start
);
2113 int end_byte
= CHAR_TO_BYTE (end
);
2115 return make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
);
2118 /* Return a Lisp_String containing the text of the current buffer from
2119 START / START_BYTE to END / END_BYTE.
2121 If text properties are in use and the current buffer
2122 has properties in the range specified, the resulting string will also
2123 have them, if PROPS is nonzero.
2125 We don't want to use plain old make_string here, because it calls
2126 make_uninit_string, which can cause the buffer arena to be
2127 compacted. make_string has no way of knowing that the data has
2128 been moved, and thus copies the wrong data into the string. This
2129 doesn't effect most of the other users of make_string, so it should
2130 be left as is. But we should use this function when conjuring
2131 buffer substrings. */
2134 make_buffer_string_both (start
, start_byte
, end
, end_byte
, props
)
2135 int start
, start_byte
, end
, end_byte
;
2138 Lisp_Object result
, tem
, tem1
;
2140 if (start
< GPT
&& GPT
< end
)
2143 if (! NILP (current_buffer
->enable_multibyte_characters
))
2144 result
= make_uninit_multibyte_string (end
- start
, end_byte
- start_byte
);
2146 result
= make_uninit_string (end
- start
);
2147 bcopy (BYTE_POS_ADDR (start_byte
), SDATA (result
),
2148 end_byte
- start_byte
);
2150 /* If desired, update and copy the text properties. */
2153 update_buffer_properties (start
, end
);
2155 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
2156 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
2158 if (XINT (tem
) != end
|| !NILP (tem1
))
2159 copy_intervals_to_string (result
, current_buffer
, start
,
2166 /* Call Vbuffer_access_fontify_functions for the range START ... END
2167 in the current buffer, if necessary. */
2170 update_buffer_properties (start
, end
)
2173 /* If this buffer has some access functions,
2174 call them, specifying the range of the buffer being accessed. */
2175 if (!NILP (Vbuffer_access_fontify_functions
))
2177 Lisp_Object args
[3];
2180 args
[0] = Qbuffer_access_fontify_functions
;
2181 XSETINT (args
[1], start
);
2182 XSETINT (args
[2], end
);
2184 /* But don't call them if we can tell that the work
2185 has already been done. */
2186 if (!NILP (Vbuffer_access_fontified_property
))
2188 tem
= Ftext_property_any (args
[1], args
[2],
2189 Vbuffer_access_fontified_property
,
2192 Frun_hook_with_args (3, args
);
2195 Frun_hook_with_args (3, args
);
2199 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
2200 doc
: /* Return the contents of part of the current buffer as a string.
2201 The two arguments START and END are character positions;
2202 they can be in either order.
2203 The string returned is multibyte if the buffer is multibyte.
2205 This function copies the text properties of that part of the buffer
2206 into the result string; if you don't want the text properties,
2207 use `buffer-substring-no-properties' instead. */)
2209 Lisp_Object start
, end
;
2213 validate_region (&start
, &end
);
2217 return make_buffer_string (b
, e
, 1);
2220 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
2221 Sbuffer_substring_no_properties
, 2, 2, 0,
2222 doc
: /* Return the characters of part of the buffer, without the text properties.
2223 The two arguments START and END are character positions;
2224 they can be in either order. */)
2226 Lisp_Object start
, end
;
2230 validate_region (&start
, &end
);
2234 return make_buffer_string (b
, e
, 0);
2237 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
2238 doc
: /* Return the contents of the current buffer as a string.
2239 If narrowing is in effect, this function returns only the visible part
2243 return make_buffer_string (BEGV
, ZV
, 1);
2246 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
2248 doc
: /* Insert before point a substring of the contents of buffer BUFFER.
2249 BUFFER may be a buffer or a buffer name.
2250 Arguments START and END are character numbers specifying the substring.
2251 They default to the beginning and the end of BUFFER. */)
2253 Lisp_Object buf
, start
, end
;
2255 register int b
, e
, temp
;
2256 register struct buffer
*bp
, *obuf
;
2259 buffer
= Fget_buffer (buf
);
2262 bp
= XBUFFER (buffer
);
2263 if (NILP (bp
->name
))
2264 error ("Selecting deleted buffer");
2270 CHECK_NUMBER_COERCE_MARKER (start
);
2277 CHECK_NUMBER_COERCE_MARKER (end
);
2282 temp
= b
, b
= e
, e
= temp
;
2284 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
2285 args_out_of_range (start
, end
);
2287 obuf
= current_buffer
;
2288 set_buffer_internal_1 (bp
);
2289 update_buffer_properties (b
, e
);
2290 set_buffer_internal_1 (obuf
);
2292 insert_from_buffer (bp
, b
, e
- b
, 0);
2296 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
2298 doc
: /* Compare two substrings of two buffers; return result as number.
2299 the value is -N if first string is less after N-1 chars,
2300 +N if first string is greater after N-1 chars, or 0 if strings match.
2301 Each substring is represented as three arguments: BUFFER, START and END.
2302 That makes six args in all, three for each substring.
2304 The value of `case-fold-search' in the current buffer
2305 determines whether case is significant or ignored. */)
2306 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
2307 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
2309 register int begp1
, endp1
, begp2
, endp2
, temp
;
2310 register struct buffer
*bp1
, *bp2
;
2311 register Lisp_Object
*trt
2312 = (!NILP (current_buffer
->case_fold_search
)
2313 ? XCHAR_TABLE (current_buffer
->case_canon_table
)->contents
: 0);
2315 int i1
, i2
, i1_byte
, i2_byte
;
2317 /* Find the first buffer and its substring. */
2320 bp1
= current_buffer
;
2324 buf1
= Fget_buffer (buffer1
);
2327 bp1
= XBUFFER (buf1
);
2328 if (NILP (bp1
->name
))
2329 error ("Selecting deleted buffer");
2333 begp1
= BUF_BEGV (bp1
);
2336 CHECK_NUMBER_COERCE_MARKER (start1
);
2337 begp1
= XINT (start1
);
2340 endp1
= BUF_ZV (bp1
);
2343 CHECK_NUMBER_COERCE_MARKER (end1
);
2344 endp1
= XINT (end1
);
2348 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
2350 if (!(BUF_BEGV (bp1
) <= begp1
2352 && endp1
<= BUF_ZV (bp1
)))
2353 args_out_of_range (start1
, end1
);
2355 /* Likewise for second substring. */
2358 bp2
= current_buffer
;
2362 buf2
= Fget_buffer (buffer2
);
2365 bp2
= XBUFFER (buf2
);
2366 if (NILP (bp2
->name
))
2367 error ("Selecting deleted buffer");
2371 begp2
= BUF_BEGV (bp2
);
2374 CHECK_NUMBER_COERCE_MARKER (start2
);
2375 begp2
= XINT (start2
);
2378 endp2
= BUF_ZV (bp2
);
2381 CHECK_NUMBER_COERCE_MARKER (end2
);
2382 endp2
= XINT (end2
);
2386 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
2388 if (!(BUF_BEGV (bp2
) <= begp2
2390 && endp2
<= BUF_ZV (bp2
)))
2391 args_out_of_range (start2
, end2
);
2395 i1_byte
= buf_charpos_to_bytepos (bp1
, i1
);
2396 i2_byte
= buf_charpos_to_bytepos (bp2
, i2
);
2398 while (i1
< endp1
&& i2
< endp2
)
2400 /* When we find a mismatch, we must compare the
2401 characters, not just the bytes. */
2406 if (! NILP (bp1
->enable_multibyte_characters
))
2408 c1
= BUF_FETCH_MULTIBYTE_CHAR (bp1
, i1_byte
);
2409 BUF_INC_POS (bp1
, i1_byte
);
2414 c1
= BUF_FETCH_BYTE (bp1
, i1
);
2415 c1
= unibyte_char_to_multibyte (c1
);
2419 if (! NILP (bp2
->enable_multibyte_characters
))
2421 c2
= BUF_FETCH_MULTIBYTE_CHAR (bp2
, i2_byte
);
2422 BUF_INC_POS (bp2
, i2_byte
);
2427 c2
= BUF_FETCH_BYTE (bp2
, i2
);
2428 c2
= unibyte_char_to_multibyte (c2
);
2434 c1
= XINT (trt
[c1
]);
2435 c2
= XINT (trt
[c2
]);
2438 return make_number (- 1 - chars
);
2440 return make_number (chars
+ 1);
2445 /* The strings match as far as they go.
2446 If one is shorter, that one is less. */
2447 if (chars
< endp1
- begp1
)
2448 return make_number (chars
+ 1);
2449 else if (chars
< endp2
- begp2
)
2450 return make_number (- chars
- 1);
2452 /* Same length too => they are equal. */
2453 return make_number (0);
2457 subst_char_in_region_unwind (arg
)
2460 return current_buffer
->undo_list
= arg
;
2464 subst_char_in_region_unwind_1 (arg
)
2467 return current_buffer
->filename
= arg
;
2470 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
2471 Ssubst_char_in_region
, 4, 5, 0,
2472 doc
: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2473 If optional arg NOUNDO is non-nil, don't record this change for undo
2474 and don't mark the buffer as really changed.
2475 Both characters must have the same length of multi-byte form. */)
2476 (start
, end
, fromchar
, tochar
, noundo
)
2477 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
2479 register int pos
, pos_byte
, stop
, i
, len
, end_byte
;
2481 unsigned char fromstr
[MAX_MULTIBYTE_LENGTH
], tostr
[MAX_MULTIBYTE_LENGTH
];
2483 int count
= SPECPDL_INDEX ();
2484 #define COMBINING_NO 0
2485 #define COMBINING_BEFORE 1
2486 #define COMBINING_AFTER 2
2487 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
2488 int maybe_byte_combining
= COMBINING_NO
;
2489 int last_changed
= 0;
2490 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
2492 validate_region (&start
, &end
);
2493 CHECK_NUMBER (fromchar
);
2494 CHECK_NUMBER (tochar
);
2498 len
= CHAR_STRING (XFASTINT (fromchar
), fromstr
);
2499 if (CHAR_STRING (XFASTINT (tochar
), tostr
) != len
)
2500 error ("Characters in subst-char-in-region have different byte-lengths");
2501 if (!ASCII_BYTE_P (*tostr
))
2503 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
2504 complete multibyte character, it may be combined with the
2505 after bytes. If it is in the range 0xA0..0xFF, it may be
2506 combined with the before and after bytes. */
2507 if (!CHAR_HEAD_P (*tostr
))
2508 maybe_byte_combining
= COMBINING_BOTH
;
2509 else if (BYTES_BY_CHAR_HEAD (*tostr
) > len
)
2510 maybe_byte_combining
= COMBINING_AFTER
;
2516 fromstr
[0] = XFASTINT (fromchar
);
2517 tostr
[0] = XFASTINT (tochar
);
2521 pos_byte
= CHAR_TO_BYTE (pos
);
2522 stop
= CHAR_TO_BYTE (XINT (end
));
2525 /* If we don't want undo, turn off putting stuff on the list.
2526 That's faster than getting rid of things,
2527 and it prevents even the entry for a first change.
2528 Also inhibit locking the file. */
2531 record_unwind_protect (subst_char_in_region_unwind
,
2532 current_buffer
->undo_list
);
2533 current_buffer
->undo_list
= Qt
;
2534 /* Don't do file-locking. */
2535 record_unwind_protect (subst_char_in_region_unwind_1
,
2536 current_buffer
->filename
);
2537 current_buffer
->filename
= Qnil
;
2540 if (pos_byte
< GPT_BYTE
)
2541 stop
= min (stop
, GPT_BYTE
);
2544 int pos_byte_next
= pos_byte
;
2546 if (pos_byte
>= stop
)
2548 if (pos_byte
>= end_byte
) break;
2551 p
= BYTE_POS_ADDR (pos_byte
);
2553 INC_POS (pos_byte_next
);
2556 if (pos_byte_next
- pos_byte
== len
2557 && p
[0] == fromstr
[0]
2559 || (p
[1] == fromstr
[1]
2560 && (len
== 2 || (p
[2] == fromstr
[2]
2561 && (len
== 3 || p
[3] == fromstr
[3]))))))
2566 modify_region (current_buffer
, changed
, XINT (end
));
2568 if (! NILP (noundo
))
2570 if (MODIFF
- 1 == SAVE_MODIFF
)
2572 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
2573 current_buffer
->auto_save_modified
++;
2577 /* Take care of the case where the new character
2578 combines with neighboring bytes. */
2579 if (maybe_byte_combining
2580 && (maybe_byte_combining
== COMBINING_AFTER
2581 ? (pos_byte_next
< Z_BYTE
2582 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2583 : ((pos_byte_next
< Z_BYTE
2584 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next
)))
2585 || (pos_byte
> BEG_BYTE
2586 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1))))))
2588 Lisp_Object tem
, string
;
2590 struct gcpro gcpro1
;
2592 tem
= current_buffer
->undo_list
;
2595 /* Make a multibyte string containing this single character. */
2596 string
= make_multibyte_string (tostr
, 1, len
);
2597 /* replace_range is less efficient, because it moves the gap,
2598 but it handles combining correctly. */
2599 replace_range (pos
, pos
+ 1, string
,
2601 pos_byte_next
= CHAR_TO_BYTE (pos
);
2602 if (pos_byte_next
> pos_byte
)
2603 /* Before combining happened. We should not increment
2604 POS. So, to cancel the later increment of POS,
2608 INC_POS (pos_byte_next
);
2610 if (! NILP (noundo
))
2611 current_buffer
->undo_list
= tem
;
2618 record_change (pos
, 1);
2619 for (i
= 0; i
< len
; i
++) *p
++ = tostr
[i
];
2621 last_changed
= pos
+ 1;
2623 pos_byte
= pos_byte_next
;
2629 signal_after_change (changed
,
2630 last_changed
- changed
, last_changed
- changed
);
2631 update_compositions (changed
, last_changed
, CHECK_ALL
);
2634 unbind_to (count
, Qnil
);
2638 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
2639 doc
: /* From START to END, translate characters according to TABLE.
2640 TABLE is a string; the Nth character in it is the mapping
2641 for the character with code N.
2642 This function does not alter multibyte characters.
2643 It returns the number of characters changed. */)
2647 register Lisp_Object table
;
2649 register int pos_byte
, stop
; /* Limits of the region. */
2650 register unsigned char *tt
; /* Trans table. */
2651 register int nc
; /* New character. */
2652 int cnt
; /* Number of changes made. */
2653 int size
; /* Size of translate table. */
2655 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2657 validate_region (&start
, &end
);
2658 CHECK_STRING (table
);
2660 size
= SBYTES (table
);
2663 pos_byte
= CHAR_TO_BYTE (XINT (start
));
2664 stop
= CHAR_TO_BYTE (XINT (end
));
2665 modify_region (current_buffer
, XINT (start
), XINT (end
));
2669 for (; pos_byte
< stop
; )
2671 register unsigned char *p
= BYTE_POS_ADDR (pos_byte
);
2677 oc
= STRING_CHAR_AND_LENGTH (p
, stop
- pos_byte
, len
);
2680 pos_byte_next
= pos_byte
+ len
;
2681 if (oc
< size
&& len
== 1)
2686 /* Take care of the case where the new character
2687 combines with neighboring bytes. */
2688 if (!ASCII_BYTE_P (nc
)
2689 && (CHAR_HEAD_P (nc
)
2690 ? ! CHAR_HEAD_P (FETCH_BYTE (pos_byte
+ 1))
2691 : (pos_byte
> BEG_BYTE
2692 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte
- 1)))))
2696 string
= make_multibyte_string (tt
+ oc
, 1, 1);
2697 /* This is less efficient, because it moves the gap,
2698 but it handles combining correctly. */
2699 replace_range (pos
, pos
+ 1, string
,
2701 pos_byte_next
= CHAR_TO_BYTE (pos
);
2702 if (pos_byte_next
> pos_byte
)
2703 /* Before combining happened. We should not
2704 increment POS. So, to cancel the later
2705 increment of POS, we decrease it now. */
2708 INC_POS (pos_byte_next
);
2712 record_change (pos
, 1);
2714 signal_after_change (pos
, 1, 1);
2715 update_compositions (pos
, pos
+ 1, CHECK_BORDER
);
2720 pos_byte
= pos_byte_next
;
2724 return make_number (cnt
);
2727 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
2728 doc
: /* Delete the text between point and mark.
2729 When called from a program, expects two arguments,
2730 positions (integers or markers) specifying the stretch to be deleted. */)
2732 Lisp_Object start
, end
;
2734 validate_region (&start
, &end
);
2735 del_range (XINT (start
), XINT (end
));
2739 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region
,
2740 Sdelete_and_extract_region
, 2, 2, 0,
2741 doc
: /* Delete the text between START and END and return it. */)
2743 Lisp_Object start
, end
;
2745 validate_region (&start
, &end
);
2746 return del_range_1 (XINT (start
), XINT (end
), 1, 1);
2749 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
2750 doc
: /* Remove restrictions (narrowing) from current buffer.
2751 This allows the buffer's full text to be seen and edited. */)
2754 if (BEG
!= BEGV
|| Z
!= ZV
)
2755 current_buffer
->clip_changed
= 1;
2757 BEGV_BYTE
= BEG_BYTE
;
2758 SET_BUF_ZV_BOTH (current_buffer
, Z
, Z_BYTE
);
2759 /* Changing the buffer bounds invalidates any recorded current column. */
2760 invalidate_current_column ();
2764 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
2765 doc
: /* Restrict editing in this buffer to the current region.
2766 The rest of the text becomes temporarily invisible and untouchable
2767 but is not deleted; if you save the buffer in a file, the invisible
2768 text is included in the file. \\[widen] makes all visible again.
2769 See also `save-restriction'.
2771 When calling from a program, pass two arguments; positions (integers
2772 or markers) bounding the text that should remain visible. */)
2774 register Lisp_Object start
, end
;
2776 CHECK_NUMBER_COERCE_MARKER (start
);
2777 CHECK_NUMBER_COERCE_MARKER (end
);
2779 if (XINT (start
) > XINT (end
))
2782 tem
= start
; start
= end
; end
= tem
;
2785 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
2786 args_out_of_range (start
, end
);
2788 if (BEGV
!= XFASTINT (start
) || ZV
!= XFASTINT (end
))
2789 current_buffer
->clip_changed
= 1;
2791 SET_BUF_BEGV (current_buffer
, XFASTINT (start
));
2792 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
2793 if (PT
< XFASTINT (start
))
2794 SET_PT (XFASTINT (start
));
2795 if (PT
> XFASTINT (end
))
2796 SET_PT (XFASTINT (end
));
2797 /* Changing the buffer bounds invalidates any recorded current column. */
2798 invalidate_current_column ();
2803 save_restriction_save ()
2805 if (BEGV
== BEG
&& ZV
== Z
)
2806 /* The common case that the buffer isn't narrowed.
2807 We return just the buffer object, which save_restriction_restore
2808 recognizes as meaning `no restriction'. */
2809 return Fcurrent_buffer ();
2811 /* We have to save a restriction, so return a pair of markers, one
2812 for the beginning and one for the end. */
2814 Lisp_Object beg
, end
;
2816 beg
= buildmark (BEGV
, BEGV_BYTE
);
2817 end
= buildmark (ZV
, ZV_BYTE
);
2819 /* END must move forward if text is inserted at its exact location. */
2820 XMARKER(end
)->insertion_type
= 1;
2822 return Fcons (beg
, end
);
2827 save_restriction_restore (data
)
2831 /* A pair of marks bounding a saved restriction. */
2833 struct Lisp_Marker
*beg
= XMARKER (XCAR (data
));
2834 struct Lisp_Marker
*end
= XMARKER (XCDR (data
));
2835 struct buffer
*buf
= beg
->buffer
; /* END should have the same buffer. */
2837 if (beg
->charpos
!= BUF_BEGV(buf
) || end
->charpos
!= BUF_ZV(buf
))
2838 /* The restriction has changed from the saved one, so restore
2839 the saved restriction. */
2841 int pt
= BUF_PT (buf
);
2843 SET_BUF_BEGV_BOTH (buf
, beg
->charpos
, beg
->bytepos
);
2844 SET_BUF_ZV_BOTH (buf
, end
->charpos
, end
->bytepos
);
2846 if (pt
< beg
->charpos
|| pt
> end
->charpos
)
2847 /* The point is outside the new visible range, move it inside. */
2848 SET_BUF_PT_BOTH (buf
,
2849 clip_to_bounds (beg
->charpos
, pt
, end
->charpos
),
2850 clip_to_bounds (beg
->bytepos
, BUF_PT_BYTE(buf
),
2853 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
2857 /* A buffer, which means that there was no old restriction. */
2859 struct buffer
*buf
= XBUFFER (data
);
2861 if (BUF_BEGV(buf
) != BUF_BEG(buf
) || BUF_ZV(buf
) != BUF_Z(buf
))
2862 /* The buffer has been narrowed, get rid of the narrowing. */
2864 SET_BUF_BEGV_BOTH (buf
, BUF_BEG(buf
), BUF_BEG_BYTE(buf
));
2865 SET_BUF_ZV_BOTH (buf
, BUF_Z(buf
), BUF_Z_BYTE(buf
));
2867 buf
->clip_changed
= 1; /* Remember that the narrowing changed. */
2874 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
2875 doc
: /* Execute BODY, saving and restoring current buffer's restrictions.
2876 The buffer's restrictions make parts of the beginning and end invisible.
2877 (They are set up with `narrow-to-region' and eliminated with `widen'.)
2878 This special form, `save-restriction', saves the current buffer's restrictions
2879 when it is entered, and restores them when it is exited.
2880 So any `narrow-to-region' within BODY lasts only until the end of the form.
2881 The old restrictions settings are restored
2882 even in case of abnormal exit (throw or error).
2884 The value returned is the value of the last form in BODY.
2886 Note: if you are using both `save-excursion' and `save-restriction',
2887 use `save-excursion' outermost:
2888 (save-excursion (save-restriction ...))
2890 usage: (save-restriction &rest BODY) */)
2894 register Lisp_Object val
;
2895 int count
= SPECPDL_INDEX ();
2897 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
2898 val
= Fprogn (body
);
2899 return unbind_to (count
, val
);
2902 /* Buffer for the most recent text displayed by Fmessage_box. */
2903 static char *message_text
;
2905 /* Allocated length of that buffer. */
2906 static int message_length
;
2908 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
2909 doc
: /* Print a one-line message at the bottom of the screen.
2910 The first argument is a format control string, and the rest are data
2911 to be formatted under control of the string. See `format' for details.
2913 If the first argument is nil, clear any existing message; let the
2914 minibuffer contents show.
2916 usage: (message STRING &rest ARGS) */)
2922 || (STRINGP (args
[0])
2923 && SBYTES (args
[0]) == 0))
2930 register Lisp_Object val
;
2931 val
= Fformat (nargs
, args
);
2932 message3 (val
, SBYTES (val
), STRING_MULTIBYTE (val
));
2937 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
2938 doc
: /* Display a message, in a dialog box if possible.
2939 If a dialog box is not available, use the echo area.
2940 The first argument is a format control string, and the rest are data
2941 to be formatted under control of the string. See `format' for details.
2943 If the first argument is nil, clear any existing message; let the
2944 minibuffer contents show.
2946 usage: (message-box STRING &rest ARGS) */)
2958 register Lisp_Object val
;
2959 val
= Fformat (nargs
, args
);
2961 /* The MS-DOS frames support popup menus even though they are
2962 not FRAME_WINDOW_P. */
2963 if (FRAME_WINDOW_P (XFRAME (selected_frame
))
2964 || FRAME_MSDOS_P (XFRAME (selected_frame
)))
2966 Lisp_Object pane
, menu
, obj
;
2967 struct gcpro gcpro1
;
2968 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
2970 menu
= Fcons (val
, pane
);
2971 obj
= Fx_popup_dialog (Qt
, menu
);
2975 #endif /* HAVE_MENUS */
2976 /* Copy the data so that it won't move when we GC. */
2979 message_text
= (char *)xmalloc (80);
2980 message_length
= 80;
2982 if (SBYTES (val
) > message_length
)
2984 message_length
= SBYTES (val
);
2985 message_text
= (char *)xrealloc (message_text
, message_length
);
2987 bcopy (SDATA (val
), message_text
, SBYTES (val
));
2988 message2 (message_text
, SBYTES (val
),
2989 STRING_MULTIBYTE (val
));
2994 extern Lisp_Object last_nonmenu_event
;
2997 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
2998 doc
: /* Display a message in a dialog box or in the echo area.
2999 If this command was invoked with the mouse, use a dialog box if
3000 `use-dialog-box' is non-nil.
3001 Otherwise, use the echo area.
3002 The first argument is a format control string, and the rest are data
3003 to be formatted under control of the string. See `format' for details.
3005 If the first argument is nil, clear any existing message; let the
3006 minibuffer contents show.
3008 usage: (message-or-box STRING &rest ARGS) */)
3014 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
3016 return Fmessage_box (nargs
, args
);
3018 return Fmessage (nargs
, args
);
3021 DEFUN ("current-message", Fcurrent_message
, Scurrent_message
, 0, 0, 0,
3022 doc
: /* Return the string currently displayed in the echo area, or nil if none. */)
3025 return current_message ();
3029 DEFUN ("propertize", Fpropertize
, Spropertize
, 1, MANY
, 0,
3030 doc
: /* Return a copy of STRING with text properties added.
3031 First argument is the string to copy.
3032 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
3033 properties to add to the result.
3034 usage: (propertize STRING &rest PROPERTIES) */)
3039 Lisp_Object properties
, string
;
3040 struct gcpro gcpro1
, gcpro2
;
3043 /* Number of args must be odd. */
3044 if ((nargs
& 1) == 0 || nargs
< 1)
3045 error ("Wrong number of arguments");
3047 properties
= string
= Qnil
;
3048 GCPRO2 (properties
, string
);
3050 /* First argument must be a string. */
3051 CHECK_STRING (args
[0]);
3052 string
= Fcopy_sequence (args
[0]);
3054 for (i
= 1; i
< nargs
; i
+= 2)
3056 CHECK_SYMBOL (args
[i
]);
3057 properties
= Fcons (args
[i
], Fcons (args
[i
+ 1], properties
));
3060 Fadd_text_properties (make_number (0),
3061 make_number (SCHARS (string
)),
3062 properties
, string
);
3063 RETURN_UNGCPRO (string
);
3067 /* Number of bytes that STRING will occupy when put into the result.
3068 MULTIBYTE is nonzero if the result should be multibyte. */
3070 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
3071 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
3072 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
3075 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
3076 doc
: /* Format a string out of a control-string and arguments.
3077 The first argument is a control string.
3078 The other arguments are substituted into it to make the result, a string.
3079 It may contain %-sequences meaning to substitute the next argument.
3080 %s means print a string argument. Actually, prints any object, with `princ'.
3081 %d means print as number in decimal (%o octal, %x hex).
3082 %X is like %x, but uses upper case.
3083 %e means print a number in exponential notation.
3084 %f means print a number in decimal-point notation.
3085 %g means print a number in exponential notation
3086 or decimal-point notation, whichever uses fewer characters.
3087 %c means print a number as a single character.
3088 %S means print any object as an s-expression (using `prin1').
3089 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
3090 Use %% to put a single % into the output.
3092 usage: (format STRING &rest OBJECTS) */)
3095 register Lisp_Object
*args
;
3097 register int n
; /* The number of the next arg to substitute */
3098 register int total
; /* An estimate of the final length */
3100 register unsigned char *format
, *end
;
3102 /* Nonzero if the output should be a multibyte string,
3103 which is true if any of the inputs is one. */
3105 /* When we make a multibyte string, we must pay attention to the
3106 byte combining problem, i.e., a byte may be combined with a
3107 multibyte charcter of the previous string. This flag tells if we
3108 must consider such a situation or not. */
3109 int maybe_combine_byte
;
3110 unsigned char *this_format
;
3118 /* It should not be necessary to GCPRO ARGS, because
3119 the caller in the interpreter should take care of that. */
3121 /* Try to determine whether the result should be multibyte.
3122 This is not always right; sometimes the result needs to be multibyte
3123 because of an object that we will pass through prin1,
3124 and in that case, we won't know it here. */
3125 for (n
= 0; n
< nargs
; n
++)
3126 if (STRINGP (args
[n
]) && STRING_MULTIBYTE (args
[n
]))
3129 CHECK_STRING (args
[0]);
3131 /* If we start out planning a unibyte result,
3132 and later find it has to be multibyte, we jump back to retry. */
3135 format
= SDATA (args
[0]);
3136 end
= format
+ SBYTES (args
[0]);
3139 /* Make room in result for all the non-%-codes in the control string. */
3140 total
= 5 + CONVERTED_BYTE_SIZE (multibyte
, args
[0]);
3142 /* Add to TOTAL enough space to hold the converted arguments. */
3145 while (format
!= end
)
3146 if (*format
++ == '%')
3149 int actual_width
= 0;
3150 unsigned char *this_format_start
= format
- 1;
3151 int field_width
, precision
;
3153 /* General format specifications look like
3155 '%' [flags] [field-width] [precision] format
3160 field-width ::= [0-9]+
3161 precision ::= '.' [0-9]*
3163 If a field-width is specified, it specifies to which width
3164 the output should be padded with blanks, iff the output
3165 string is shorter than field-width.
3167 if precision is specified, it specifies the number of
3168 digits to print after the '.' for floats, or the max.
3169 number of chars to print from a string. */
3171 precision
= field_width
= 0;
3173 while (index ("-*# 0", *format
))
3176 if (*format
>= '0' && *format
<= '9')
3178 for (field_width
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3179 field_width
= 10 * field_width
+ *format
- '0';
3185 for (precision
= 0; *format
>= '0' && *format
<= '9'; ++format
)
3186 precision
= 10 * precision
+ *format
- '0';
3189 if (format
- this_format_start
+ 1 > longest_format
)
3190 longest_format
= format
- this_format_start
+ 1;
3193 error ("Format string ends in middle of format specifier");
3196 else if (++n
>= nargs
)
3197 error ("Not enough arguments for format string");
3198 else if (*format
== 'S')
3200 /* For `S', prin1 the argument and then treat like a string. */
3201 register Lisp_Object tem
;
3202 tem
= Fprin1_to_string (args
[n
], Qnil
);
3203 if (STRING_MULTIBYTE (tem
) && ! multibyte
)
3211 else if (SYMBOLP (args
[n
]))
3213 args
[n
] = SYMBOL_NAME (args
[n
]);
3214 if (STRING_MULTIBYTE (args
[n
]) && ! multibyte
)
3221 else if (STRINGP (args
[n
]))
3224 if (*format
!= 's' && *format
!= 'S')
3225 error ("Format specifier doesn't match argument type");
3226 thissize
= CONVERTED_BYTE_SIZE (multibyte
, args
[n
]);
3227 actual_width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3229 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
3230 else if (INTEGERP (args
[n
]) && *format
!= 's')
3232 /* The following loop assumes the Lisp type indicates
3233 the proper way to pass the argument.
3234 So make sure we have a flonum if the argument should
3236 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
3237 args
[n
] = Ffloat (args
[n
]);
3239 if (*format
!= 'd' && *format
!= 'o' && *format
!= 'x'
3240 && *format
!= 'i' && *format
!= 'X' && *format
!= 'c')
3241 error ("Invalid format operation %%%c", *format
);
3245 && (! SINGLE_BYTE_CHAR_P (XINT (args
[n
]))
3246 || XINT (args
[n
]) == 0))
3253 args
[n
] = Fchar_to_string (args
[n
]);
3254 thissize
= SBYTES (args
[n
]);
3257 else if (FLOATP (args
[n
]) && *format
!= 's')
3259 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
3260 args
[n
] = Ftruncate (args
[n
], Qnil
);
3262 /* Note that we're using sprintf to print floats,
3263 so we have to take into account what that function
3265 thissize
= MAX_10_EXP
+ 100 + precision
;
3269 /* Anything but a string, convert to a string using princ. */
3270 register Lisp_Object tem
;
3271 tem
= Fprin1_to_string (args
[n
], Qt
);
3272 if (STRING_MULTIBYTE (tem
) & ! multibyte
)
3281 thissize
+= max (0, field_width
- actual_width
);
3282 total
+= thissize
+ 4;
3285 /* Now we can no longer jump to retry.
3286 TOTAL and LONGEST_FORMAT are known for certain. */
3288 this_format
= (unsigned char *) alloca (longest_format
+ 1);
3290 /* Allocate the space for the result.
3291 Note that TOTAL is an overestimate. */
3293 buf
= (char *) alloca (total
+ 1);
3295 buf
= (char *) xmalloc (total
+ 1);
3301 /* Scan the format and store result in BUF. */
3302 format
= SDATA (args
[0]);
3303 maybe_combine_byte
= 0;
3304 while (format
!= end
)
3310 unsigned char *this_format_start
= format
;
3314 /* Process a numeric arg and skip it. */
3315 minlen
= atoi (format
);
3317 minlen
= - minlen
, negative
= 1;
3319 while ((*format
>= '0' && *format
<= '9')
3320 || *format
== '-' || *format
== ' ' || *format
== '.')
3323 if (*format
++ == '%')
3332 if (STRINGP (args
[n
]))
3334 int padding
, nbytes
, start
, end
;
3335 int width
= lisp_string_width (args
[n
], -1, NULL
, NULL
);
3337 /* If spec requires it, pad on right with spaces. */
3338 padding
= minlen
- width
;
3340 while (padding
-- > 0)
3350 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3351 && STRING_MULTIBYTE (args
[n
])
3352 && !CHAR_HEAD_P (SREF (args
[n
], 0)))
3353 maybe_combine_byte
= 1;
3354 nbytes
= copy_text (SDATA (args
[n
]), p
,
3356 STRING_MULTIBYTE (args
[n
]), multibyte
);
3358 nchars
+= SCHARS (args
[n
]);
3362 while (padding
-- > 0)
3368 /* If this argument has text properties, record where
3369 in the result string it appears. */
3370 if (STRING_INTERVALS (args
[n
]))
3374 int nbytes
= nargs
* sizeof *info
;
3375 info
= (struct info
*) alloca (nbytes
);
3376 bzero (info
, nbytes
);
3379 info
[n
].start
= start
;
3383 else if (INTEGERP (args
[n
]) || FLOATP (args
[n
]))
3387 bcopy (this_format_start
, this_format
,
3388 format
- this_format_start
);
3389 this_format
[format
- this_format_start
] = 0;
3391 if (INTEGERP (args
[n
]))
3392 sprintf (p
, this_format
, XINT (args
[n
]));
3394 sprintf (p
, this_format
, XFLOAT_DATA (args
[n
]));
3398 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3399 && !CHAR_HEAD_P (*((unsigned char *) p
)))
3400 maybe_combine_byte
= 1;
3401 this_nchars
= strlen (p
);
3403 p
+= str_to_multibyte (p
, buf
+ total
- p
, this_nchars
);
3406 nchars
+= this_nchars
;
3409 else if (STRING_MULTIBYTE (args
[0]))
3411 /* Copy a whole multibyte character. */
3414 && !ASCII_BYTE_P (*((unsigned char *) p
- 1))
3415 && !CHAR_HEAD_P (*format
))
3416 maybe_combine_byte
= 1;
3418 while (! CHAR_HEAD_P (*format
)) *p
++ = *format
++;
3423 /* Convert a single-byte character to multibyte. */
3424 int len
= copy_text (format
, p
, 1, 0, 1);
3431 *p
++ = *format
++, nchars
++;
3434 if (p
> buf
+ total
+ 1)
3437 if (maybe_combine_byte
)
3438 nchars
= multibyte_chars_in_text (buf
, p
- buf
);
3439 val
= make_specified_string (buf
, nchars
, p
- buf
, multibyte
);
3441 /* If we allocated BUF with malloc, free it too. */
3445 /* If the format string has text properties, or any of the string
3446 arguments has text properties, set up text properties of the
3449 if (STRING_INTERVALS (args
[0]) || info
)
3451 Lisp_Object len
, new_len
, props
;
3452 struct gcpro gcpro1
;
3454 /* Add text properties from the format string. */
3455 len
= make_number (SCHARS (args
[0]));
3456 props
= text_property_list (args
[0], make_number (0), len
, Qnil
);
3461 new_len
= make_number (SCHARS (val
));
3462 extend_property_ranges (props
, len
, new_len
);
3463 add_text_properties_from_list (val
, props
, make_number (0));
3466 /* Add text properties from arguments. */
3468 for (n
= 1; n
< nargs
; ++n
)
3471 len
= make_number (SCHARS (args
[n
]));
3472 new_len
= make_number (info
[n
].end
- info
[n
].start
);
3473 props
= text_property_list (args
[n
], make_number (0), len
, Qnil
);
3474 extend_property_ranges (props
, len
, new_len
);
3475 /* If successive arguments have properites, be sure that
3476 the value of `composition' property be the copy. */
3477 if (n
> 1 && info
[n
- 1].end
)
3478 make_composition_value_copy (props
);
3479 add_text_properties_from_list (val
, props
,
3480 make_number (info
[n
].start
));
3493 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
3494 EMACS_INT arg0
, arg1
, arg2
, arg3
, arg4
;
3508 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, (char **) args
);
3510 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, &string1
+ 1);
3512 return build_string (buf
);
3515 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
3516 doc
: /* Return t if two characters match, optionally ignoring case.
3517 Both arguments must be characters (i.e. integers).
3518 Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
3520 register Lisp_Object c1
, c2
;
3526 if (XINT (c1
) == XINT (c2
))
3528 if (NILP (current_buffer
->case_fold_search
))
3531 /* Do these in separate statements,
3532 then compare the variables.
3533 because of the way DOWNCASE uses temp variables. */
3534 i1
= DOWNCASE (XFASTINT (c1
));
3535 i2
= DOWNCASE (XFASTINT (c2
));
3536 return (i1
== i2
? Qt
: Qnil
);
3539 /* Transpose the markers in two regions of the current buffer, and
3540 adjust the ones between them if necessary (i.e.: if the regions
3543 START1, END1 are the character positions of the first region.
3544 START1_BYTE, END1_BYTE are the byte positions.
3545 START2, END2 are the character positions of the second region.
3546 START2_BYTE, END2_BYTE are the byte positions.
3548 Traverses the entire marker list of the buffer to do so, adding an
3549 appropriate amount to some, subtracting from some, and leaving the
3550 rest untouched. Most of this is copied from adjust_markers in insdel.c.
3552 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
3555 transpose_markers (start1
, end1
, start2
, end2
,
3556 start1_byte
, end1_byte
, start2_byte
, end2_byte
)
3557 register int start1
, end1
, start2
, end2
;
3558 register int start1_byte
, end1_byte
, start2_byte
, end2_byte
;
3560 register int amt1
, amt1_byte
, amt2
, amt2_byte
, diff
, diff_byte
, mpos
;
3561 register Lisp_Object marker
;
3563 /* Update point as if it were a marker. */
3567 TEMP_SET_PT_BOTH (PT
+ (end2
- end1
),
3568 PT_BYTE
+ (end2_byte
- end1_byte
));
3569 else if (PT
< start2
)
3570 TEMP_SET_PT_BOTH (PT
+ (end2
- start2
) - (end1
- start1
),
3571 (PT_BYTE
+ (end2_byte
- start2_byte
)
3572 - (end1_byte
- start1_byte
)));
3574 TEMP_SET_PT_BOTH (PT
- (start2
- start1
),
3575 PT_BYTE
- (start2_byte
- start1_byte
));
3577 /* We used to adjust the endpoints here to account for the gap, but that
3578 isn't good enough. Even if we assume the caller has tried to move the
3579 gap out of our way, it might still be at start1 exactly, for example;
3580 and that places it `inside' the interval, for our purposes. The amount
3581 of adjustment is nontrivial if there's a `denormalized' marker whose
3582 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
3583 the dirty work to Fmarker_position, below. */
3585 /* The difference between the region's lengths */
3586 diff
= (end2
- start2
) - (end1
- start1
);
3587 diff_byte
= (end2_byte
- start2_byte
) - (end1_byte
- start1_byte
);
3589 /* For shifting each marker in a region by the length of the other
3590 region plus the distance between the regions. */
3591 amt1
= (end2
- start2
) + (start2
- end1
);
3592 amt2
= (end1
- start1
) + (start2
- end1
);
3593 amt1_byte
= (end2_byte
- start2_byte
) + (start2_byte
- end1_byte
);
3594 amt2_byte
= (end1_byte
- start1_byte
) + (start2_byte
- end1_byte
);
3596 for (marker
= BUF_MARKERS (current_buffer
); !NILP (marker
);
3597 marker
= XMARKER (marker
)->chain
)
3599 mpos
= marker_byte_position (marker
);
3600 if (mpos
>= start1_byte
&& mpos
< end2_byte
)
3602 if (mpos
< end1_byte
)
3604 else if (mpos
< start2_byte
)
3608 XMARKER (marker
)->bytepos
= mpos
;
3610 mpos
= XMARKER (marker
)->charpos
;
3611 if (mpos
>= start1
&& mpos
< end2
)
3615 else if (mpos
< start2
)
3620 XMARKER (marker
)->charpos
= mpos
;
3624 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
3625 doc
: /* Transpose region START1 to END1 with START2 to END2.
3626 The regions may not be overlapping, because the size of the buffer is
3627 never changed in a transposition.
3629 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't update
3630 any markers that happen to be located in the regions.
3632 Transposing beyond buffer boundaries is an error. */)
3633 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
3634 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
3636 register int start1
, end1
, start2
, end2
;
3637 int start1_byte
, start2_byte
, len1_byte
, len2_byte
;
3638 int gap
, len1
, len_mid
, len2
;
3639 unsigned char *start1_addr
, *start2_addr
, *temp
;
3641 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
;
3642 cur_intv
= BUF_INTERVALS (current_buffer
);
3644 validate_region (&startr1
, &endr1
);
3645 validate_region (&startr2
, &endr2
);
3647 start1
= XFASTINT (startr1
);
3648 end1
= XFASTINT (endr1
);
3649 start2
= XFASTINT (startr2
);
3650 end2
= XFASTINT (endr2
);
3653 /* Swap the regions if they're reversed. */
3656 register int glumph
= start1
;
3664 len1
= end1
- start1
;
3665 len2
= end2
- start2
;
3668 error ("Transposed regions overlap");
3669 else if (start1
== end1
|| start2
== end2
)
3670 error ("Transposed region has length 0");
3672 /* The possibilities are:
3673 1. Adjacent (contiguous) regions, or separate but equal regions
3674 (no, really equal, in this case!), or
3675 2. Separate regions of unequal size.
3677 The worst case is usually No. 2. It means that (aside from
3678 potential need for getting the gap out of the way), there also
3679 needs to be a shifting of the text between the two regions. So
3680 if they are spread far apart, we are that much slower... sigh. */
3682 /* It must be pointed out that the really studly thing to do would
3683 be not to move the gap at all, but to leave it in place and work
3684 around it if necessary. This would be extremely efficient,
3685 especially considering that people are likely to do
3686 transpositions near where they are working interactively, which
3687 is exactly where the gap would be found. However, such code
3688 would be much harder to write and to read. So, if you are
3689 reading this comment and are feeling squirrely, by all means have
3690 a go! I just didn't feel like doing it, so I will simply move
3691 the gap the minimum distance to get it out of the way, and then
3692 deal with an unbroken array. */
3694 /* Make sure the gap won't interfere, by moving it out of the text
3695 we will operate on. */
3696 if (start1
< gap
&& gap
< end2
)
3698 if (gap
- start1
< end2
- gap
)
3704 start1_byte
= CHAR_TO_BYTE (start1
);
3705 start2_byte
= CHAR_TO_BYTE (start2
);
3706 len1_byte
= CHAR_TO_BYTE (end1
) - start1_byte
;
3707 len2_byte
= CHAR_TO_BYTE (end2
) - start2_byte
;
3709 #ifdef BYTE_COMBINING_DEBUG
3712 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
3713 len2_byte
, start1
, start1_byte
)
3714 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
3715 len1_byte
, end2
, start2_byte
+ len2_byte
)
3716 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
3717 len1_byte
, end2
, start2_byte
+ len2_byte
))
3722 if (count_combining_before (BYTE_POS_ADDR (start2_byte
),
3723 len2_byte
, start1
, start1_byte
)
3724 || count_combining_before (BYTE_POS_ADDR (start1_byte
),
3725 len1_byte
, start2
, start2_byte
)
3726 || count_combining_after (BYTE_POS_ADDR (start2_byte
),
3727 len2_byte
, end1
, start1_byte
+ len1_byte
)
3728 || count_combining_after (BYTE_POS_ADDR (start1_byte
),
3729 len1_byte
, end2
, start2_byte
+ len2_byte
))
3734 /* Hmmm... how about checking to see if the gap is large
3735 enough to use as the temporary storage? That would avoid an
3736 allocation... interesting. Later, don't fool with it now. */
3738 /* Working without memmove, for portability (sigh), so must be
3739 careful of overlapping subsections of the array... */
3741 if (end1
== start2
) /* adjacent regions */
3743 modify_region (current_buffer
, start1
, end2
);
3744 record_change (start1
, len1
+ len2
);
3746 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
3747 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
3748 Fset_text_properties (make_number (start1
), make_number (end2
),
3751 /* First region smaller than second. */
3752 if (len1_byte
< len2_byte
)
3754 /* We use alloca only if it is small,
3755 because we want to avoid stack overflow. */
3756 if (len2_byte
> 20000)
3757 temp
= (unsigned char *) xmalloc (len2_byte
);
3759 temp
= (unsigned char *) alloca (len2_byte
);
3761 /* Don't precompute these addresses. We have to compute them
3762 at the last minute, because the relocating allocator might
3763 have moved the buffer around during the xmalloc. */
3764 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3765 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3767 bcopy (start2_addr
, temp
, len2_byte
);
3768 bcopy (start1_addr
, start1_addr
+ len2_byte
, len1_byte
);
3769 bcopy (temp
, start1_addr
, len2_byte
);
3770 if (len2_byte
> 20000)
3774 /* First region not smaller than second. */
3776 if (len1_byte
> 20000)
3777 temp
= (unsigned char *) xmalloc (len1_byte
);
3779 temp
= (unsigned char *) alloca (len1_byte
);
3780 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3781 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3782 bcopy (start1_addr
, temp
, len1_byte
);
3783 bcopy (start2_addr
, start1_addr
, len2_byte
);
3784 bcopy (temp
, start1_addr
+ len2_byte
, len1_byte
);
3785 if (len1_byte
> 20000)
3788 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
3789 len1
, current_buffer
, 0);
3790 graft_intervals_into_buffer (tmp_interval2
, start1
,
3791 len2
, current_buffer
, 0);
3792 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
3793 update_compositions (start1
+ len2
, end2
, CHECK_TAIL
);
3795 /* Non-adjacent regions, because end1 != start2, bleagh... */
3798 len_mid
= start2_byte
- (start1_byte
+ len1_byte
);
3800 if (len1_byte
== len2_byte
)
3801 /* Regions are same size, though, how nice. */
3803 modify_region (current_buffer
, start1
, end1
);
3804 modify_region (current_buffer
, start2
, end2
);
3805 record_change (start1
, len1
);
3806 record_change (start2
, len2
);
3807 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
3808 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
3809 Fset_text_properties (make_number (start1
), make_number (end1
),
3811 Fset_text_properties (make_number (start2
), make_number (end2
),
3814 if (len1_byte
> 20000)
3815 temp
= (unsigned char *) xmalloc (len1_byte
);
3817 temp
= (unsigned char *) alloca (len1_byte
);
3818 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3819 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3820 bcopy (start1_addr
, temp
, len1_byte
);
3821 bcopy (start2_addr
, start1_addr
, len2_byte
);
3822 bcopy (temp
, start2_addr
, len1_byte
);
3823 if (len1_byte
> 20000)
3825 graft_intervals_into_buffer (tmp_interval1
, start2
,
3826 len1
, current_buffer
, 0);
3827 graft_intervals_into_buffer (tmp_interval2
, start1
,
3828 len2
, current_buffer
, 0);
3831 else if (len1_byte
< len2_byte
) /* Second region larger than first */
3832 /* Non-adjacent & unequal size, area between must also be shifted. */
3834 modify_region (current_buffer
, start1
, end2
);
3835 record_change (start1
, (end2
- start1
));
3836 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
3837 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
3838 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
3839 Fset_text_properties (make_number (start1
), make_number (end2
),
3842 /* holds region 2 */
3843 if (len2_byte
> 20000)
3844 temp
= (unsigned char *) xmalloc (len2_byte
);
3846 temp
= (unsigned char *) alloca (len2_byte
);
3847 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3848 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3849 bcopy (start2_addr
, temp
, len2_byte
);
3850 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2_byte
, len1_byte
);
3851 safe_bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
3852 bcopy (temp
, start1_addr
, len2_byte
);
3853 if (len2_byte
> 20000)
3855 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
3856 len1
, current_buffer
, 0);
3857 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
3858 len_mid
, current_buffer
, 0);
3859 graft_intervals_into_buffer (tmp_interval2
, start1
,
3860 len2
, current_buffer
, 0);
3863 /* Second region smaller than first. */
3865 record_change (start1
, (end2
- start1
));
3866 modify_region (current_buffer
, start1
, end2
);
3868 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
3869 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
3870 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
3871 Fset_text_properties (make_number (start1
), make_number (end2
),
3874 /* holds region 1 */
3875 if (len1_byte
> 20000)
3876 temp
= (unsigned char *) xmalloc (len1_byte
);
3878 temp
= (unsigned char *) alloca (len1_byte
);
3879 start1_addr
= BYTE_POS_ADDR (start1_byte
);
3880 start2_addr
= BYTE_POS_ADDR (start2_byte
);
3881 bcopy (start1_addr
, temp
, len1_byte
);
3882 bcopy (start2_addr
, start1_addr
, len2_byte
);
3883 bcopy (start1_addr
+ len1_byte
, start1_addr
+ len2_byte
, len_mid
);
3884 bcopy (temp
, start1_addr
+ len2_byte
+ len_mid
, len1_byte
);
3885 if (len1_byte
> 20000)
3887 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
3888 len1
, current_buffer
, 0);
3889 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
3890 len_mid
, current_buffer
, 0);
3891 graft_intervals_into_buffer (tmp_interval2
, start1
,
3892 len2
, current_buffer
, 0);
3895 update_compositions (start1
, start1
+ len2
, CHECK_BORDER
);
3896 update_compositions (end2
- len1
, end2
, CHECK_BORDER
);
3899 /* When doing multiple transpositions, it might be nice
3900 to optimize this. Perhaps the markers in any one buffer
3901 should be organized in some sorted data tree. */
3902 if (NILP (leave_markers
))
3904 transpose_markers (start1
, end1
, start2
, end2
,
3905 start1_byte
, start1_byte
+ len1_byte
,
3906 start2_byte
, start2_byte
+ len2_byte
);
3907 fix_overlays_in_range (start1
, end2
);
3919 Qbuffer_access_fontify_functions
3920 = intern ("buffer-access-fontify-functions");
3921 staticpro (&Qbuffer_access_fontify_functions
);
3923 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion
,
3924 doc
: /* Non-nil means text motion commands don't notice fields. */);
3925 Vinhibit_field_text_motion
= Qnil
;
3927 DEFVAR_LISP ("buffer-access-fontify-functions",
3928 &Vbuffer_access_fontify_functions
,
3929 doc
: /* List of functions called by `buffer-substring' to fontify if necessary.
3930 Each function is called with two arguments which specify the range
3931 of the buffer being accessed. */);
3932 Vbuffer_access_fontify_functions
= Qnil
;
3936 extern Lisp_Object Vprin1_to_string_buffer
;
3937 obuf
= Fcurrent_buffer ();
3938 /* Do this here, because init_buffer_once is too early--it won't work. */
3939 Fset_buffer (Vprin1_to_string_buffer
);
3940 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
3941 Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
3946 DEFVAR_LISP ("buffer-access-fontified-property",
3947 &Vbuffer_access_fontified_property
,
3948 doc
: /* Property which (if non-nil) indicates text has been fontified.
3949 `buffer-substring' need not call the `buffer-access-fontify-functions'
3950 functions if all the text being accessed has this property. */);
3951 Vbuffer_access_fontified_property
= Qnil
;
3953 DEFVAR_LISP ("system-name", &Vsystem_name
,
3954 doc
: /* The name of the machine Emacs is running on. */);
3956 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
3957 doc
: /* The full name of the user logged in. */);
3959 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
3960 doc
: /* The user's name, taken from environment variables if possible. */);
3962 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
3963 doc
: /* The user's name, based upon the real uid only. */);
3965 defsubr (&Spropertize
);
3966 defsubr (&Schar_equal
);
3967 defsubr (&Sgoto_char
);
3968 defsubr (&Sstring_to_char
);
3969 defsubr (&Schar_to_string
);
3970 defsubr (&Sbuffer_substring
);
3971 defsubr (&Sbuffer_substring_no_properties
);
3972 defsubr (&Sbuffer_string
);
3974 defsubr (&Spoint_marker
);
3975 defsubr (&Smark_marker
);
3977 defsubr (&Sregion_beginning
);
3978 defsubr (&Sregion_end
);
3980 staticpro (&Qfield
);
3981 Qfield
= intern ("field");
3982 staticpro (&Qboundary
);
3983 Qboundary
= intern ("boundary");
3984 defsubr (&Sfield_beginning
);
3985 defsubr (&Sfield_end
);
3986 defsubr (&Sfield_string
);
3987 defsubr (&Sfield_string_no_properties
);
3988 defsubr (&Sdelete_field
);
3989 defsubr (&Sconstrain_to_field
);
3991 defsubr (&Sline_beginning_position
);
3992 defsubr (&Sline_end_position
);
3994 /* defsubr (&Smark); */
3995 /* defsubr (&Sset_mark); */
3996 defsubr (&Ssave_excursion
);
3997 defsubr (&Ssave_current_buffer
);
3999 defsubr (&Sbufsize
);
4000 defsubr (&Spoint_max
);
4001 defsubr (&Spoint_min
);
4002 defsubr (&Spoint_min_marker
);
4003 defsubr (&Spoint_max_marker
);
4004 defsubr (&Sgap_position
);
4005 defsubr (&Sgap_size
);
4006 defsubr (&Sposition_bytes
);
4007 defsubr (&Sbyte_to_position
);
4013 defsubr (&Sfollowing_char
);
4014 defsubr (&Sprevious_char
);
4015 defsubr (&Schar_after
);
4016 defsubr (&Schar_before
);
4018 defsubr (&Sinsert_before_markers
);
4019 defsubr (&Sinsert_and_inherit
);
4020 defsubr (&Sinsert_and_inherit_before_markers
);
4021 defsubr (&Sinsert_char
);
4023 defsubr (&Suser_login_name
);
4024 defsubr (&Suser_real_login_name
);
4025 defsubr (&Suser_uid
);
4026 defsubr (&Suser_real_uid
);
4027 defsubr (&Suser_full_name
);
4028 defsubr (&Semacs_pid
);
4029 defsubr (&Scurrent_time
);
4030 defsubr (&Sformat_time_string
);
4031 defsubr (&Sfloat_time
);
4032 defsubr (&Sdecode_time
);
4033 defsubr (&Sencode_time
);
4034 defsubr (&Scurrent_time_string
);
4035 defsubr (&Scurrent_time_zone
);
4036 defsubr (&Sset_time_zone_rule
);
4037 defsubr (&Ssystem_name
);
4038 defsubr (&Smessage
);
4039 defsubr (&Smessage_box
);
4040 defsubr (&Smessage_or_box
);
4041 defsubr (&Scurrent_message
);
4044 defsubr (&Sinsert_buffer_substring
);
4045 defsubr (&Scompare_buffer_substrings
);
4046 defsubr (&Ssubst_char_in_region
);
4047 defsubr (&Stranslate_region
);
4048 defsubr (&Sdelete_region
);
4049 defsubr (&Sdelete_and_extract_region
);
4051 defsubr (&Snarrow_to_region
);
4052 defsubr (&Ssave_restriction
);
4053 defsubr (&Stranspose_regions
);