1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985,86,87,89,93,94,95 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 #include <sys/types.h>
33 #include "intervals.h"
39 #define min(a, b) ((a) < (b) ? (a) : (b))
40 #define max(a, b) ((a) > (b) ? (a) : (b))
42 extern char **environ
;
43 extern Lisp_Object
make_time ();
44 extern void insert_from_buffer ();
45 static long difftm ();
46 static void update_buffer_properties ();
47 void set_time_zone_rule ();
49 Lisp_Object Vbuffer_access_fontify_functions
;
50 Lisp_Object Qbuffer_access_fontify_functions
;
51 Lisp_Object Vbuffer_access_fontified_property
;
53 /* Some static data, and a function to initialize it for each run */
55 Lisp_Object Vsystem_name
;
56 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
57 Lisp_Object Vuser_full_name
; /* full name of current user */
58 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
64 register unsigned char *p
, *q
, *r
;
65 struct passwd
*pw
; /* password entry for the current user */
66 extern char *index ();
69 /* Set up system_name even when dumping. */
73 /* Don't bother with this on initial start when just dumping out */
76 #endif /* not CANNOT_DUMP */
78 pw
= (struct passwd
*) getpwuid (getuid ());
80 /* We let the real user name default to "root" because that's quite
81 accurate on MSDOG and because it lets Emacs find the init file.
82 (The DVX libraries override the Djgpp libraries here.) */
83 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
85 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
88 /* Get the effective user name, by consulting environment variables,
89 or the effective uid if those are unset. */
90 user_name
= (char *) getenv ("LOGNAME");
93 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
95 user_name
= (char *) getenv ("USER");
96 #endif /* WINDOWSNT */
99 pw
= (struct passwd
*) getpwuid (geteuid ());
100 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
102 Vuser_login_name
= build_string (user_name
);
104 /* If the user name claimed in the environment vars differs from
105 the real uid, use the claimed name to find the full name. */
106 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
108 pw
= (struct passwd
*) getpwnam (XSTRING (Vuser_login_name
)->data
);
110 p
= (unsigned char *) (pw
? USER_FULL_NAME
: "unknown");
111 q
= (unsigned char *) index (p
, ',');
112 Vuser_full_name
= make_string (p
, q
? q
- p
: strlen (p
));
114 #ifdef AMPERSAND_FULL_NAME
115 p
= XSTRING (Vuser_full_name
)->data
;
116 q
= (unsigned char *) index (p
, '&');
117 /* Substitute the login name for the &, upcasing the first character. */
120 r
= (unsigned char *) alloca (strlen (p
)
121 + XSTRING (Vuser_login_name
)->size
+ 1);
124 strcat (r
, XSTRING (Vuser_login_name
)->data
);
125 r
[q
- p
] = UPCASE (r
[q
- p
]);
127 Vuser_full_name
= build_string (r
);
129 #endif /* AMPERSAND_FULL_NAME */
131 p
= (unsigned char *) getenv ("NAME");
133 Vuser_full_name
= build_string (p
);
136 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
137 "Convert arg CHARACTER to a one-character string containing that character.")
139 Lisp_Object character
;
142 CHECK_NUMBER (character
, 0);
144 c
= XINT (character
);
145 return make_string (&c
, 1);
148 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
149 "Convert arg STRING to a character, the first character of that string.")
151 register Lisp_Object string
;
153 register Lisp_Object val
;
154 register struct Lisp_String
*p
;
155 CHECK_STRING (string
, 0);
157 p
= XSTRING (string
);
159 XSETFASTINT (val
, ((unsigned char *) p
->data
)[0]);
161 XSETFASTINT (val
, 0);
169 register Lisp_Object mark
;
170 mark
= Fmake_marker ();
171 Fset_marker (mark
, make_number (val
), Qnil
);
175 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
176 "Return value of point, as an integer.\n\
177 Beginning of buffer is position (point-min)")
181 XSETFASTINT (temp
, point
);
185 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
186 "Return value of point, as a marker object.")
189 return buildmark (point
);
193 clip_to_bounds (lower
, num
, upper
)
194 int lower
, num
, upper
;
198 else if (num
> upper
)
204 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
205 "Set point to POSITION, a number or marker.\n\
206 Beginning of buffer is position (point-min), end is (point-max).")
208 register Lisp_Object position
;
210 CHECK_NUMBER_COERCE_MARKER (position
, 0);
212 SET_PT (clip_to_bounds (BEGV
, XINT (position
), ZV
));
217 region_limit (beginningp
)
220 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
221 register Lisp_Object m
;
222 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
223 && NILP (current_buffer
->mark_active
))
224 Fsignal (Qmark_inactive
, Qnil
);
225 m
= Fmarker_position (current_buffer
->mark
);
226 if (NILP (m
)) error ("There is no region now");
227 if ((point
< XFASTINT (m
)) == beginningp
)
228 return (make_number (point
));
233 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
234 "Return position of beginning of region, as an integer.")
237 return (region_limit (1));
240 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
241 "Return position of end of region, as an integer.")
244 return (region_limit (0));
247 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
248 "Return this buffer's mark, as a marker object.\n\
249 Watch out! Moving this marker changes the mark position.\n\
250 If you set the marker not to point anywhere, the buffer will have no mark.")
253 return current_buffer
->mark
;
257 save_excursion_save ()
259 register int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
262 return Fcons (Fpoint_marker (),
263 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
264 Fcons (visible
? Qt
: Qnil
,
265 current_buffer
->mark_active
)));
269 save_excursion_restore (info
)
270 register Lisp_Object info
;
272 register Lisp_Object tem
, tem1
, omark
, nmark
;
274 tem
= Fmarker_buffer (Fcar (info
));
275 /* If buffer being returned to is now deleted, avoid error */
276 /* Otherwise could get error here while unwinding to top level
278 /* In that case, Fmarker_buffer returns nil now. */
284 unchain_marker (tem
);
285 tem
= Fcar (Fcdr (info
));
286 omark
= Fmarker_position (current_buffer
->mark
);
287 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
288 nmark
= Fmarker_position (tem
);
289 unchain_marker (tem
);
290 tem
= Fcdr (Fcdr (info
));
291 #if 0 /* We used to make the current buffer visible in the selected window
292 if that was true previously. That avoids some anomalies.
293 But it creates others, and it wasn't documented, and it is simpler
294 and cleaner never to alter the window/buffer connections. */
297 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
298 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
301 tem1
= current_buffer
->mark_active
;
302 current_buffer
->mark_active
= Fcdr (tem
);
303 if (!NILP (Vrun_hooks
))
305 /* If mark is active now, and either was not active
306 or was at a different place, run the activate hook. */
307 if (! NILP (current_buffer
->mark_active
))
309 if (! EQ (omark
, nmark
))
310 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
312 /* If mark has ceased to be active, run deactivate hook. */
313 else if (! NILP (tem1
))
314 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
319 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
320 "Save point, mark, and current buffer; execute BODY; restore those things.\n\
321 Executes BODY just like `progn'.\n\
322 The values of point, mark and the current buffer are restored\n\
323 even in case of abnormal exit (throw or error).\n\
324 The state of activation of the mark is also restored.")
328 register Lisp_Object val
;
329 int count
= specpdl_ptr
- specpdl
;
331 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
334 return unbind_to (count
, val
);
337 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 0, 0,
338 "Return the number of characters in the current buffer.")
342 XSETFASTINT (temp
, Z
- BEG
);
346 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
347 "Return the minimum permissible value of point in the current buffer.\n\
348 This is 1, unless narrowing (a buffer restriction) is in effect.")
352 XSETFASTINT (temp
, BEGV
);
356 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
357 "Return a marker to the minimum permissible value of point in this buffer.\n\
358 This is the beginning, unless narrowing (a buffer restriction) is in effect.")
361 return buildmark (BEGV
);
364 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
365 "Return the maximum permissible value of point in the current buffer.\n\
366 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
367 is in effect, in which case it is less.")
371 XSETFASTINT (temp
, ZV
);
375 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
376 "Return a marker to the maximum permissible value of point in this buffer.\n\
377 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
378 is in effect, in which case it is less.")
381 return buildmark (ZV
);
384 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
385 "Return the character following point, as a number.\n\
386 At the end of the buffer or accessible region, return 0.")
391 XSETFASTINT (temp
, 0);
393 XSETFASTINT (temp
, FETCH_CHAR (point
));
397 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
398 "Return the character preceding point, as a number.\n\
399 At the beginning of the buffer or accessible region, return 0.")
404 XSETFASTINT (temp
, 0);
406 XSETFASTINT (temp
, FETCH_CHAR (point
- 1));
410 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
411 "Return T if point is at the beginning of the buffer.\n\
412 If the buffer is narrowed, this means the beginning of the narrowed part.")
420 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
421 "Return T if point is at the end of the buffer.\n\
422 If the buffer is narrowed, this means the end of the narrowed part.")
430 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
431 "Return T if point is at the beginning of a line.")
434 if (point
== BEGV
|| FETCH_CHAR (point
- 1) == '\n')
439 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
440 "Return T if point is at the end of a line.\n\
441 `End of a line' includes point being at the end of the buffer.")
444 if (point
== ZV
|| FETCH_CHAR (point
) == '\n')
449 DEFUN ("char-after", Fchar_after
, Schar_after
, 1, 1, 0,
450 "Return character in current buffer at position POS.\n\
451 POS is an integer or a buffer pointer.\n\
452 If POS is out of range, the value is nil.")
456 register Lisp_Object val
;
459 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
462 if (n
< BEGV
|| n
>= ZV
) return Qnil
;
464 XSETFASTINT (val
, FETCH_CHAR (n
));
468 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
469 "Return the name under which the user logged in, as a string.\n\
470 This is based on the effective uid, not the real uid.\n\
471 Also, if the environment variable LOGNAME or USER is set,\n\
472 that determines the value of this function.\n\n\
473 If optional argument UID is an integer, return the login name of the user\n\
474 with that uid, or nil if there is no such user.")
480 /* Set up the user name info if we didn't do it before.
481 (That can happen if Emacs is dumpable
482 but you decide to run `temacs -l loadup' and not dump. */
483 if (INTEGERP (Vuser_login_name
))
487 return Vuser_login_name
;
489 CHECK_NUMBER (uid
, 0);
490 pw
= (struct passwd
*) getpwuid (XINT (uid
));
491 return (pw
? build_string (pw
->pw_name
) : Qnil
);
494 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
496 "Return the name of the user's real uid, as a string.\n\
497 This ignores the environment variables LOGNAME and USER, so it differs from\n\
498 `user-login-name' when running under `su'.")
501 /* Set up the user name info if we didn't do it before.
502 (That can happen if Emacs is dumpable
503 but you decide to run `temacs -l loadup' and not dump. */
504 if (INTEGERP (Vuser_login_name
))
506 return Vuser_real_login_name
;
509 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
510 "Return the effective uid of Emacs, as an integer.")
513 return make_number (geteuid ());
516 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
517 "Return the real uid of Emacs, as an integer.")
520 return make_number (getuid ());
523 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 0, 0,
524 "Return the full name of the user logged in, as a string.")
527 return Vuser_full_name
;
530 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
531 "Return the name of the machine you are running on, as a string.")
537 /* For the benefit of callers who don't want to include lisp.h */
541 return (char *) XSTRING (Vsystem_name
)->data
;
544 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
545 "Return the process ID of Emacs, as an integer.")
548 return make_number (getpid ());
551 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
552 "Return the current time, as the number of seconds since 1970-01-01 00:00:00.\n\
553 The time is returned as a list of three integers. The first has the\n\
554 most significant 16 bits of the seconds, while the second has the\n\
555 least significant 16 bits. The third integer gives the microsecond\n\
558 The microsecond count is zero on systems that do not provide\n\
559 resolution finer than a second.")
563 Lisp_Object result
[3];
566 XSETINT (result
[0], (EMACS_SECS (t
) >> 16) & 0xffff);
567 XSETINT (result
[1], (EMACS_SECS (t
) >> 0) & 0xffff);
568 XSETINT (result
[2], EMACS_USECS (t
));
570 return Flist (3, result
);
575 lisp_time_argument (specified_time
, result
)
576 Lisp_Object specified_time
;
579 if (NILP (specified_time
))
580 return time (result
) != -1;
583 Lisp_Object high
, low
;
584 high
= Fcar (specified_time
);
585 CHECK_NUMBER (high
, 0);
586 low
= Fcdr (specified_time
);
589 CHECK_NUMBER (low
, 0);
590 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
591 return *result
>> 16 == XINT (high
);
595 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 1, 2, 0,
596 "Use FORMAT-STRING to format the time TIME.\n\
597 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from\n\
598 `current-time' and `file-attributes'.\n\
599 FORMAT-STRING may contain %-sequences to substitute parts of the time.\n\
600 %a is replaced by the abbreviated name of the day of week.\n\
601 %A is replaced by the full name of the day of week.\n\
602 %b is replaced by the abbreviated name of the month.\n\
603 %B is replaced by the full name of the month.\n\
604 %c is a synonym for \"%x %X\".\n\
605 %C is a locale-specific synonym, which defaults to \"%A, %B %e, %Y\" in the C locale.\n\
606 %d is replaced by the day of month, zero-padded.\n\
607 %D is a synonym for \"%m/%d/%y\".\n\
608 %e is replaced by the day of month, blank-padded.\n\
609 %h is a synonym for \"%b\".\n\
610 %H is replaced by the hour (00-23).\n\
611 %I is replaced by the hour (00-12).\n\
612 %j is replaced by the day of the year (001-366).\n\
613 %k is replaced by the hour (0-23), blank padded.\n\
614 %l is replaced by the hour (1-12), blank padded.\n\
615 %m is replaced by the month (01-12).\n\
616 %M is replaced by the minute (00-59).\n\
617 %n is a synonym for \"\\n\".\n\
618 %p is replaced by AM or PM, as appropriate.\n\
619 %r is a synonym for \"%I:%M:%S %p\".\n\
620 %R is a synonym for \"%H:%M\".\n\
621 %S is replaced by the second (00-60).\n\
622 %t is a synonym for \"\\t\".\n\
623 %T is a synonym for \"%H:%M:%S\".\n\
624 %U is replaced by the week of the year (00-53), first day of week is Sunday.\n\
625 %w is replaced by the day of week (0-6), Sunday is day 0.\n\
626 %W is replaced by the week of the year (00-53), first day of week is Monday.\n\
627 %x is a locale-specific synonym, which defaults to \"%D\" in the C locale.\n\
628 %X is a locale-specific synonym, which defaults to \"%T\" in the C locale.\n\
629 %y is replaced by the year without century (00-99).\n\
630 %Y is replaced by the year with century.\n\
631 %Z is replaced by the time zone abbreviation.\n\
633 The number of options reflects the `strftime' function.")
634 (format_string
, time
)
635 Lisp_Object format_string
, time
;
640 CHECK_STRING (format_string
, 1);
642 if (! lisp_time_argument (time
, &value
))
643 error ("Invalid time specification");
645 /* This is probably enough. */
646 size
= XSTRING (format_string
)->size
* 6 + 50;
650 char *buf
= (char *) alloca (size
);
652 if (emacs_strftime (buf
, size
, XSTRING (format_string
)->data
,
655 return build_string (buf
);
656 /* If buffer was too small, make it bigger. */
661 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
662 "Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).\n\
663 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)\n\
664 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'\n\
665 to use the current time. The list has the following nine members:\n\
666 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which\n\
667 only some operating systems support. MINUTE is an integer between 0 and 59.\n\
668 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.\n\
669 MONTH is an integer between 1 and 12. YEAR is an integer indicating the\n\
670 four-digit year. DOW is the day of week, an integer between 0 and 6, where\n\
671 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.\n\
672 ZONE is an integer indicating the number of seconds east of Greenwich.\n\
673 \(Note that Common Lisp has different meanings for DOW and ZONE.)")
675 Lisp_Object specified_time
;
679 struct tm
*decoded_time
;
680 Lisp_Object list_args
[9];
682 if (! lisp_time_argument (specified_time
, &time_spec
))
683 error ("Invalid time specification");
685 decoded_time
= localtime (&time_spec
);
686 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
687 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
688 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
689 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
690 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
691 XSETFASTINT (list_args
[5], decoded_time
->tm_year
+ 1900);
692 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
693 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
695 /* Make a copy, in case gmtime modifies the struct. */
696 save_tm
= *decoded_time
;
697 decoded_time
= gmtime (&time_spec
);
698 if (decoded_time
== 0)
701 XSETINT (list_args
[8], difftm (&save_tm
, decoded_time
));
702 return Flist (9, list_args
);
705 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, 7, 0,
706 "Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.\n\
707 This is the reverse operation of `decode-time', which see. ZONE defaults\n\
708 to the current time zone rule if not specified; if specified, it can\n\
709 be a string (as from `set-time-zone-rule'), or it can be a list\n\
710 (as from `current-time-zone') or an integer (as from `decode-time')\n\
711 applied without consideration for daylight savings time.\n\
712 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;\n\
713 for example, a DAY of 0 means the day preceding the given month.\n\
714 Year numbers less than 100 are treated just like other year numbers.\n\
715 If you want them to stand for years in this century, you must do that yourself.")
716 (second
, minute
, hour
, day
, month
, year
, zone
)
717 Lisp_Object second
, minute
, hour
, day
, month
, year
, zone
;
722 CHECK_NUMBER (second
, 0);
723 CHECK_NUMBER (minute
, 1);
724 CHECK_NUMBER (hour
, 2);
725 CHECK_NUMBER (day
, 3);
726 CHECK_NUMBER (month
, 4);
727 CHECK_NUMBER (year
, 5);
729 tm
.tm_sec
= XINT (second
);
730 tm
.tm_min
= XINT (minute
);
731 tm
.tm_hour
= XINT (hour
);
732 tm
.tm_mday
= XINT (day
);
733 tm
.tm_mon
= XINT (month
) - 1;
734 tm
.tm_year
= XINT (year
) - 1900;
745 char **oldenv
= environ
, **newenv
;
748 tzstring
= (char *) XSTRING (zone
)->data
;
749 else if (INTEGERP (zone
))
751 int abszone
= abs (XINT (zone
));
752 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
753 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
757 error ("Invalid time zone specification");
759 /* Set TZ before calling mktime; merely adjusting mktime's returned
760 value doesn't suffice, since that would mishandle leap seconds. */
761 set_time_zone_rule (tzstring
);
765 /* Restore TZ to previous value. */
769 #ifdef LOCALTIME_CACHE
774 if (time
== (time_t) -1)
775 error ("Specified time is not representable");
777 return make_time (time
);
780 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
781 "Return the current time, as a human-readable string.\n\
782 Programs can use this function to decode a time,\n\
783 since the number of columns in each field is fixed.\n\
784 The format is `Sun Sep 16 01:03:52 1973'.\n\
785 If an argument is given, it specifies a time to format\n\
786 instead of the current time. The argument should have the form:\n\
789 (HIGH LOW . IGNORED).\n\
790 Thus, you can use times obtained from `current-time'\n\
791 and from `file-attributes'.")
793 Lisp_Object specified_time
;
799 if (! lisp_time_argument (specified_time
, &value
))
801 tem
= (char *) ctime (&value
);
803 strncpy (buf
, tem
, 24);
806 return build_string (buf
);
809 #define TM_YEAR_ORIGIN 1900
811 /* Yield A - B, measured in seconds. */
816 int ay
= a
->tm_year
+ (TM_YEAR_ORIGIN
- 1);
817 int by
= b
->tm_year
+ (TM_YEAR_ORIGIN
- 1);
818 /* Some compilers can't handle this as a single return statement. */
820 /* difference in day of year */
821 a
->tm_yday
- b
->tm_yday
822 /* + intervening leap days */
823 + ((ay
>> 2) - (by
>> 2))
825 + ((ay
/100 >> 2) - (by
/100 >> 2))
826 /* + difference in years * 365 */
827 + (long)(ay
-by
) * 365
829 return (60*(60*(24*days
+ (a
->tm_hour
- b
->tm_hour
))
830 + (a
->tm_min
- b
->tm_min
))
831 + (a
->tm_sec
- b
->tm_sec
));
834 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
835 "Return the offset and name for the local time zone.\n\
836 This returns a list of the form (OFFSET NAME).\n\
837 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).\n\
838 A negative value means west of Greenwich.\n\
839 NAME is a string giving the name of the time zone.\n\
840 If an argument is given, it specifies when the time zone offset is determined\n\
841 instead of using the current time. The argument should have the form:\n\
844 (HIGH LOW . IGNORED).\n\
845 Thus, you can use times obtained from `current-time'\n\
846 and from `file-attributes'.\n\
848 Some operating systems cannot provide all this information to Emacs;\n\
849 in this case, `current-time-zone' returns a list containing nil for\n\
850 the data it can't find.")
852 Lisp_Object specified_time
;
857 if (lisp_time_argument (specified_time
, &value
)
858 && (t
= gmtime (&value
)) != 0)
864 gmt
= *t
; /* Make a copy, in case localtime modifies *t. */
865 t
= localtime (&value
);
866 offset
= difftm (t
, &gmt
);
870 s
= (char *)t
->tm_zone
;
871 #else /* not HAVE_TM_ZONE */
873 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
874 s
= tzname
[t
->tm_isdst
];
876 #endif /* not HAVE_TM_ZONE */
879 /* No local time zone name is available; use "+-NNNN" instead. */
880 int am
= (offset
< 0 ? -offset
: offset
) / 60;
881 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
884 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
887 return Fmake_list (2, Qnil
);
890 /* This holds the value of `environ' produced by the previous
891 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
892 has never been called. */
893 static char **environbuf
;
895 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
896 "Set the local time zone using TZ, a string specifying a time zone rule.\n\
897 If TZ is nil, use implementation-defined default time zone information.")
907 CHECK_STRING (tz
, 0);
908 tzstring
= (char *) XSTRING (tz
)->data
;
911 set_time_zone_rule (tzstring
);
914 environbuf
= environ
;
919 /* Set the local time zone rule to TZSTRING.
920 This allocates memory into `environ', which it is the caller's
921 responsibility to free. */
923 set_time_zone_rule (tzstring
)
927 char **from
, **to
, **newenv
;
929 for (from
= environ
; *from
; from
++)
931 envptrs
= from
- environ
+ 2;
932 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
933 + (tzstring
? strlen (tzstring
) + 4 : 0));
936 char *t
= (char *) (to
+ envptrs
);
938 strcat (t
, tzstring
);
942 for (from
= environ
; *from
; from
++)
943 if (strncmp (*from
, "TZ=", 3) != 0)
949 #ifdef LOCALTIME_CACHE
962 /* Callers passing one argument to Finsert need not gcpro the
963 argument "array", since the only element of the array will
964 not be used after calling insert or insert_from_string, so
965 we don't care if it gets trashed. */
967 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
968 "Insert the arguments, either strings or characters, at point.\n\
969 Point moves forward so that it ends up after the inserted text.\n\
970 Any other markers at the point of insertion remain before the text.")
973 register Lisp_Object
*args
;
976 register Lisp_Object tem
;
979 for (argnum
= 0; argnum
< nargs
; argnum
++)
988 else if (STRINGP (tem
))
990 insert_from_string (tem
, 0, XSTRING (tem
)->size
, 0);
994 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1002 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
1004 "Insert the arguments at point, inheriting properties from adjoining text.\n\
1005 Point moves forward so that it ends up after the inserted text.\n\
1006 Any other markers at the point of insertion remain before the text.")
1009 register Lisp_Object
*args
;
1011 register int argnum
;
1012 register Lisp_Object tem
;
1015 for (argnum
= 0; argnum
< nargs
; argnum
++)
1021 str
[0] = XINT (tem
);
1022 insert_and_inherit (str
, 1);
1024 else if (STRINGP (tem
))
1026 insert_from_string (tem
, 0, XSTRING (tem
)->size
, 1);
1030 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1038 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
1039 "Insert strings or characters at point, relocating markers after the text.\n\
1040 Point moves forward so that it ends up after the inserted text.\n\
1041 Any other markers at the point of insertion also end up after the text.")
1044 register Lisp_Object
*args
;
1046 register int argnum
;
1047 register Lisp_Object tem
;
1050 for (argnum
= 0; argnum
< nargs
; argnum
++)
1056 str
[0] = XINT (tem
);
1057 insert_before_markers (str
, 1);
1059 else if (STRINGP (tem
))
1061 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
, 0);
1065 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1073 DEFUN ("insert-before-markers-and-inherit",
1074 Finsert_and_inherit_before_markers
, Sinsert_and_inherit_before_markers
,
1076 "Insert text at point, relocating markers and inheriting properties.\n\
1077 Point moves forward so that it ends up after the inserted text.\n\
1078 Any other markers at the point of insertion also end up after the text.")
1081 register Lisp_Object
*args
;
1083 register int argnum
;
1084 register Lisp_Object tem
;
1087 for (argnum
= 0; argnum
< nargs
; argnum
++)
1093 str
[0] = XINT (tem
);
1094 insert_before_markers_and_inherit (str
, 1);
1096 else if (STRINGP (tem
))
1098 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
, 1);
1102 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1110 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
1111 "Insert COUNT (second arg) copies of CHARACTER (first arg).\n\
1112 Point and all markers are affected as in the function `insert'.\n\
1113 Both arguments are required.\n\
1114 The optional third arg INHERIT, if non-nil, says to inherit text properties\n\
1115 from adjoining text, if those properties are sticky.")
1116 (character
, count
, inherit
)
1117 Lisp_Object character
, count
, inherit
;
1119 register unsigned char *string
;
1120 register int strlen
;
1123 CHECK_NUMBER (character
, 0);
1124 CHECK_NUMBER (count
, 1);
1129 strlen
= min (n
, 256);
1130 string
= (unsigned char *) alloca (strlen
);
1131 for (i
= 0; i
< strlen
; i
++)
1132 string
[i
] = XFASTINT (character
);
1135 if (!NILP (inherit
))
1136 insert_and_inherit (string
, strlen
);
1138 insert (string
, strlen
);
1143 if (!NILP (inherit
))
1144 insert_and_inherit (string
, n
);
1152 /* Making strings from buffer contents. */
1154 /* Return a Lisp_String containing the text of the current buffer from
1155 START to END. If text properties are in use and the current buffer
1156 has properties in the range specified, the resulting string will also
1157 have them, if PROPS is nonzero.
1159 We don't want to use plain old make_string here, because it calls
1160 make_uninit_string, which can cause the buffer arena to be
1161 compacted. make_string has no way of knowing that the data has
1162 been moved, and thus copies the wrong data into the string. This
1163 doesn't effect most of the other users of make_string, so it should
1164 be left as is. But we should use this function when conjuring
1165 buffer substrings. */
1168 make_buffer_string (start
, end
, props
)
1172 Lisp_Object result
, tem
, tem1
;
1174 if (start
< GPT
&& GPT
< end
)
1177 result
= make_uninit_string (end
- start
);
1178 bcopy (&FETCH_CHAR (start
), XSTRING (result
)->data
, end
- start
);
1180 /* If desired, update and copy the text properties. */
1181 #ifdef USE_TEXT_PROPERTIES
1184 update_buffer_properties (start
, end
);
1186 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
1187 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
1189 if (XINT (tem
) != end
|| !NILP (tem1
))
1190 copy_intervals_to_string (result
, current_buffer
, start
, end
- start
);
1197 /* Call Vbuffer_access_fontify_functions for the range START ... END
1198 in the current buffer, if necessary. */
1201 update_buffer_properties (start
, end
)
1204 #ifdef USE_TEXT_PROPERTIES
1205 /* If this buffer has some access functions,
1206 call them, specifying the range of the buffer being accessed. */
1207 if (!NILP (Vbuffer_access_fontify_functions
))
1209 Lisp_Object args
[3];
1212 args
[0] = Qbuffer_access_fontify_functions
;
1213 XSETINT (args
[1], start
);
1214 XSETINT (args
[2], end
);
1216 /* But don't call them if we can tell that the work
1217 has already been done. */
1218 if (!NILP (Vbuffer_access_fontified_property
))
1220 tem
= Ftext_property_any (args
[1], args
[2],
1221 Vbuffer_access_fontified_property
,
1224 Frun_hook_with_args (3, args
);
1227 Frun_hook_with_args (3, args
);
1232 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
1233 "Return the contents of part of the current buffer as a string.\n\
1234 The two arguments START and END are character positions;\n\
1235 they can be in either order.")
1237 Lisp_Object start
, end
;
1241 validate_region (&start
, &end
);
1245 return make_buffer_string (b
, e
, 1);
1248 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties
,
1249 Sbuffer_substring_no_properties
, 2, 2, 0,
1250 "Return the characters of part of the buffer, without the text properties.\n\
1251 The two arguments START and END are character positions;\n\
1252 they can be in either order.")
1254 Lisp_Object start
, end
;
1258 validate_region (&start
, &end
);
1262 return make_buffer_string (b
, e
, 0);
1265 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
1266 "Return the contents of the current buffer as a string.\n\
1267 If narrowing is in effect, this function returns only the visible part\n\
1271 return make_buffer_string (BEGV
, ZV
, 1);
1274 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
1276 "Insert before point a substring of the contents of buffer BUFFER.\n\
1277 BUFFER may be a buffer or a buffer name.\n\
1278 Arguments START and END are character numbers specifying the substring.\n\
1279 They default to the beginning and the end of BUFFER.")
1281 Lisp_Object buf
, start
, end
;
1283 register int b
, e
, temp
;
1284 register struct buffer
*bp
, *obuf
;
1287 buffer
= Fget_buffer (buf
);
1290 bp
= XBUFFER (buffer
);
1296 CHECK_NUMBER_COERCE_MARKER (start
, 0);
1303 CHECK_NUMBER_COERCE_MARKER (end
, 1);
1308 temp
= b
, b
= e
, e
= temp
;
1310 if (!(BUF_BEGV (bp
) <= b
&& e
<= BUF_ZV (bp
)))
1311 args_out_of_range (start
, end
);
1313 obuf
= current_buffer
;
1314 set_buffer_internal_1 (bp
);
1315 update_buffer_properties (b
, e
);
1316 set_buffer_internal_1 (obuf
);
1318 insert_from_buffer (bp
, b
, e
- b
, 0);
1322 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
1324 "Compare two substrings of two buffers; return result as number.\n\
1325 the value is -N if first string is less after N-1 chars,\n\
1326 +N if first string is greater after N-1 chars, or 0 if strings match.\n\
1327 Each substring is represented as three arguments: BUFFER, START and END.\n\
1328 That makes six args in all, three for each substring.\n\n\
1329 The value of `case-fold-search' in the current buffer\n\
1330 determines whether case is significant or ignored.")
1331 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
1332 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
1334 register int begp1
, endp1
, begp2
, endp2
, temp
, len1
, len2
, length
, i
;
1335 register struct buffer
*bp1
, *bp2
;
1336 register Lisp_Object
*trt
1337 = (!NILP (current_buffer
->case_fold_search
)
1338 ? XCHAR_TABLE (current_buffer
->case_canon_table
)->contents
: 0);
1340 /* Find the first buffer and its substring. */
1343 bp1
= current_buffer
;
1347 buf1
= Fget_buffer (buffer1
);
1350 bp1
= XBUFFER (buf1
);
1354 begp1
= BUF_BEGV (bp1
);
1357 CHECK_NUMBER_COERCE_MARKER (start1
, 1);
1358 begp1
= XINT (start1
);
1361 endp1
= BUF_ZV (bp1
);
1364 CHECK_NUMBER_COERCE_MARKER (end1
, 2);
1365 endp1
= XINT (end1
);
1369 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
1371 if (!(BUF_BEGV (bp1
) <= begp1
1373 && endp1
<= BUF_ZV (bp1
)))
1374 args_out_of_range (start1
, end1
);
1376 /* Likewise for second substring. */
1379 bp2
= current_buffer
;
1383 buf2
= Fget_buffer (buffer2
);
1386 bp2
= XBUFFER (buf2
);
1390 begp2
= BUF_BEGV (bp2
);
1393 CHECK_NUMBER_COERCE_MARKER (start2
, 4);
1394 begp2
= XINT (start2
);
1397 endp2
= BUF_ZV (bp2
);
1400 CHECK_NUMBER_COERCE_MARKER (end2
, 5);
1401 endp2
= XINT (end2
);
1405 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
1407 if (!(BUF_BEGV (bp2
) <= begp2
1409 && endp2
<= BUF_ZV (bp2
)))
1410 args_out_of_range (start2
, end2
);
1412 len1
= endp1
- begp1
;
1413 len2
= endp2
- begp2
;
1418 for (i
= 0; i
< length
; i
++)
1420 int c1
= *BUF_CHAR_ADDRESS (bp1
, begp1
+ i
);
1421 int c2
= *BUF_CHAR_ADDRESS (bp2
, begp2
+ i
);
1428 return make_number (- 1 - i
);
1430 return make_number (i
+ 1);
1433 /* The strings match as far as they go.
1434 If one is shorter, that one is less. */
1436 return make_number (length
+ 1);
1437 else if (length
< len2
)
1438 return make_number (- length
- 1);
1440 /* Same length too => they are equal. */
1441 return make_number (0);
1445 subst_char_in_region_unwind (arg
)
1448 return current_buffer
->undo_list
= arg
;
1452 subst_char_in_region_unwind_1 (arg
)
1455 return current_buffer
->filename
= arg
;
1458 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
1459 Ssubst_char_in_region
, 4, 5, 0,
1460 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
1461 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
1462 and don't mark the buffer as really changed.")
1463 (start
, end
, fromchar
, tochar
, noundo
)
1464 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
1466 register int pos
, stop
, look
;
1468 int count
= specpdl_ptr
- specpdl
;
1470 validate_region (&start
, &end
);
1471 CHECK_NUMBER (fromchar
, 2);
1472 CHECK_NUMBER (tochar
, 3);
1476 look
= XINT (fromchar
);
1478 /* If we don't want undo, turn off putting stuff on the list.
1479 That's faster than getting rid of things,
1480 and it prevents even the entry for a first change.
1481 Also inhibit locking the file. */
1484 record_unwind_protect (subst_char_in_region_unwind
,
1485 current_buffer
->undo_list
);
1486 current_buffer
->undo_list
= Qt
;
1487 /* Don't do file-locking. */
1488 record_unwind_protect (subst_char_in_region_unwind_1
,
1489 current_buffer
->filename
);
1490 current_buffer
->filename
= Qnil
;
1495 if (FETCH_CHAR (pos
) == look
)
1499 modify_region (current_buffer
, XINT (start
), stop
);
1501 if (! NILP (noundo
))
1503 if (MODIFF
- 1 == SAVE_MODIFF
)
1505 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
1506 current_buffer
->auto_save_modified
++;
1513 record_change (pos
, 1);
1514 FETCH_CHAR (pos
) = XINT (tochar
);
1520 signal_after_change (XINT (start
),
1521 stop
- XINT (start
), stop
- XINT (start
));
1523 unbind_to (count
, Qnil
);
1527 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
1528 "From START to END, translate characters according to TABLE.\n\
1529 TABLE is a string; the Nth character in it is the mapping\n\
1530 for the character with code N. Returns the number of characters changed.")
1534 register Lisp_Object table
;
1536 register int pos
, stop
; /* Limits of the region. */
1537 register unsigned char *tt
; /* Trans table. */
1538 register int oc
; /* Old character. */
1539 register int nc
; /* New character. */
1540 int cnt
; /* Number of changes made. */
1541 Lisp_Object z
; /* Return. */
1542 int size
; /* Size of translate table. */
1544 validate_region (&start
, &end
);
1545 CHECK_STRING (table
, 2);
1547 size
= XSTRING (table
)->size
;
1548 tt
= XSTRING (table
)->data
;
1552 modify_region (current_buffer
, pos
, stop
);
1555 for (; pos
< stop
; ++pos
)
1557 oc
= FETCH_CHAR (pos
);
1563 record_change (pos
, 1);
1564 FETCH_CHAR (pos
) = nc
;
1565 signal_after_change (pos
, 1, 1);
1571 XSETFASTINT (z
, cnt
);
1575 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
1576 "Delete the text between point and mark.\n\
1577 When called from a program, expects two arguments,\n\
1578 positions (integers or markers) specifying the stretch to be deleted.")
1580 Lisp_Object start
, end
;
1582 validate_region (&start
, &end
);
1583 del_range (XINT (start
), XINT (end
));
1587 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
1588 "Remove restrictions (narrowing) from current buffer.\n\
1589 This allows the buffer's full text to be seen and edited.")
1593 SET_BUF_ZV (current_buffer
, Z
);
1594 current_buffer
->clip_changed
= 1;
1595 /* Changing the buffer bounds invalidates any recorded current column. */
1596 invalidate_current_column ();
1600 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
1601 "Restrict editing in this buffer to the current region.\n\
1602 The rest of the text becomes temporarily invisible and untouchable\n\
1603 but is not deleted; if you save the buffer in a file, the invisible\n\
1604 text is included in the file. \\[widen] makes all visible again.\n\
1605 See also `save-restriction'.\n\
1607 When calling from a program, pass two arguments; positions (integers\n\
1608 or markers) bounding the text that should remain visible.")
1610 register Lisp_Object start
, end
;
1612 CHECK_NUMBER_COERCE_MARKER (start
, 0);
1613 CHECK_NUMBER_COERCE_MARKER (end
, 1);
1615 if (XINT (start
) > XINT (end
))
1618 tem
= start
; start
= end
; end
= tem
;
1621 if (!(BEG
<= XINT (start
) && XINT (start
) <= XINT (end
) && XINT (end
) <= Z
))
1622 args_out_of_range (start
, end
);
1624 BEGV
= XFASTINT (start
);
1625 SET_BUF_ZV (current_buffer
, XFASTINT (end
));
1626 if (point
< XFASTINT (start
))
1627 SET_PT (XFASTINT (start
));
1628 if (point
> XFASTINT (end
))
1629 SET_PT (XFASTINT (end
));
1630 current_buffer
->clip_changed
= 1;
1631 /* Changing the buffer bounds invalidates any recorded current column. */
1632 invalidate_current_column ();
1637 save_restriction_save ()
1639 register Lisp_Object bottom
, top
;
1640 /* Note: I tried using markers here, but it does not win
1641 because insertion at the end of the saved region
1642 does not advance mh and is considered "outside" the saved region. */
1643 XSETFASTINT (bottom
, BEGV
- BEG
);
1644 XSETFASTINT (top
, Z
- ZV
);
1646 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
1650 save_restriction_restore (data
)
1653 register struct buffer
*buf
;
1654 register int newhead
, newtail
;
1655 register Lisp_Object tem
;
1657 buf
= XBUFFER (XCONS (data
)->car
);
1659 data
= XCONS (data
)->cdr
;
1661 tem
= XCONS (data
)->car
;
1662 newhead
= XINT (tem
);
1663 tem
= XCONS (data
)->cdr
;
1664 newtail
= XINT (tem
);
1665 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
1670 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
1671 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
1672 current_buffer
->clip_changed
= 1;
1674 /* If point is outside the new visible range, move it inside. */
1676 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
1681 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
1682 "Execute BODY, saving and restoring current buffer's restrictions.\n\
1683 The buffer's restrictions make parts of the beginning and end invisible.\n\
1684 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
1685 This special form, `save-restriction', saves the current buffer's restrictions\n\
1686 when it is entered, and restores them when it is exited.\n\
1687 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
1688 The old restrictions settings are restored\n\
1689 even in case of abnormal exit (throw or error).\n\
1691 The value returned is the value of the last form in BODY.\n\
1693 `save-restriction' can get confused if, within the BODY, you widen\n\
1694 and then make changes outside the area within the saved restrictions.\n\
1696 Note: if you are using both `save-excursion' and `save-restriction',\n\
1697 use `save-excursion' outermost:\n\
1698 (save-excursion (save-restriction ...))")
1702 register Lisp_Object val
;
1703 int count
= specpdl_ptr
- specpdl
;
1705 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1706 val
= Fprogn (body
);
1707 return unbind_to (count
, val
);
1710 /* Buffer for the most recent text displayed by Fmessage. */
1711 static char *message_text
;
1713 /* Allocated length of that buffer. */
1714 static int message_length
;
1716 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
1717 "Print a one-line message at the bottom of the screen.\n\
1718 The first argument is a format control string, and the rest are data\n\
1719 to be formatted under control of the string. See `format' for details.\n\
1721 If the first argument is nil, clear any existing message; let the\n\
1722 minibuffer contents show.")
1734 register Lisp_Object val
;
1735 val
= Fformat (nargs
, args
);
1736 /* Copy the data so that it won't move when we GC. */
1739 message_text
= (char *)xmalloc (80);
1740 message_length
= 80;
1742 if (XSTRING (val
)->size
> message_length
)
1744 message_length
= XSTRING (val
)->size
;
1745 message_text
= (char *)xrealloc (message_text
, message_length
);
1747 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1748 message2 (message_text
, XSTRING (val
)->size
);
1753 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
1754 "Display a message, in a dialog box if possible.\n\
1755 If a dialog box is not available, use the echo area.\n\
1756 The first argument is a format control string, and the rest are data\n\
1757 to be formatted under control of the string. See `format' for details.\n\
1759 If the first argument is nil, clear any existing message; let the\n\
1760 minibuffer contents show.")
1772 register Lisp_Object val
;
1773 val
= Fformat (nargs
, args
);
1776 Lisp_Object pane
, menu
, obj
;
1777 struct gcpro gcpro1
;
1778 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
1780 menu
= Fcons (val
, pane
);
1781 obj
= Fx_popup_dialog (Qt
, menu
);
1785 #else /* not HAVE_MENUS */
1786 /* Copy the data so that it won't move when we GC. */
1789 message_text
= (char *)xmalloc (80);
1790 message_length
= 80;
1792 if (XSTRING (val
)->size
> message_length
)
1794 message_length
= XSTRING (val
)->size
;
1795 message_text
= (char *)xrealloc (message_text
, message_length
);
1797 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1798 message2 (message_text
, XSTRING (val
)->size
);
1800 #endif /* not HAVE_MENUS */
1804 extern Lisp_Object last_nonmenu_event
;
1807 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
1808 "Display a message in a dialog box or in the echo area.\n\
1809 If this command was invoked with the mouse, use a dialog box.\n\
1810 Otherwise, use the echo area.\n\
1811 The first argument is a format control string, and the rest are data\n\
1812 to be formatted under control of the string. See `format' for details.\n\
1814 If the first argument is nil, clear any existing message; let the\n\
1815 minibuffer contents show.")
1821 if (NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
1822 return Fmessage_box (nargs
, args
);
1824 return Fmessage (nargs
, args
);
1827 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1828 "Format a string out of a control-string and arguments.\n\
1829 The first argument is a control string.\n\
1830 The other arguments are substituted into it to make the result, a string.\n\
1831 It may contain %-sequences meaning to substitute the next argument.\n\
1832 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1833 %d means print as number in decimal (%o octal, %x hex).\n\
1834 %e means print a number in exponential notation.\n\
1835 %f means print a number in decimal-point notation.\n\
1836 %g means print a number in exponential notation\n\
1837 or decimal-point notation, whichever uses fewer characters.\n\
1838 %c means print a number as a single character.\n\
1839 %S means print any object as an s-expression (using prin1).\n\
1840 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.\n\
1841 Use %% to put a single % into the output.")
1844 register Lisp_Object
*args
;
1846 register int n
; /* The number of the next arg to substitute */
1847 register int total
= 5; /* An estimate of the final length */
1849 register unsigned char *format
, *end
;
1851 extern char *index ();
1852 /* It should not be necessary to GCPRO ARGS, because
1853 the caller in the interpreter should take care of that. */
1855 CHECK_STRING (args
[0], 0);
1856 format
= XSTRING (args
[0])->data
;
1857 end
= format
+ XSTRING (args
[0])->size
;
1860 while (format
!= end
)
1861 if (*format
++ == '%')
1865 /* Process a numeric arg and skip it. */
1866 minlen
= atoi (format
);
1870 while ((*format
>= '0' && *format
<= '9')
1871 || *format
== '-' || *format
== ' ' || *format
== '.')
1876 else if (++n
>= nargs
)
1877 error ("Not enough arguments for format string");
1878 else if (*format
== 'S')
1880 /* For `S', prin1 the argument and then treat like a string. */
1881 register Lisp_Object tem
;
1882 tem
= Fprin1_to_string (args
[n
], Qnil
);
1886 else if (SYMBOLP (args
[n
]))
1888 XSETSTRING (args
[n
], XSYMBOL (args
[n
])->name
);
1891 else if (STRINGP (args
[n
]))
1894 if (*format
!= 's' && *format
!= 'S')
1895 error ("format specifier doesn't match argument type");
1896 total
+= XSTRING (args
[n
])->size
;
1897 /* We have to put an arbitrary limit on minlen
1898 since otherwise it could make alloca fail. */
1899 if (minlen
< XSTRING (args
[n
])->size
+ 1000)
1902 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1903 else if (INTEGERP (args
[n
]) && *format
!= 's')
1905 #ifdef LISP_FLOAT_TYPE
1906 /* The following loop assumes the Lisp type indicates
1907 the proper way to pass the argument.
1908 So make sure we have a flonum if the argument should
1910 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1911 args
[n
] = Ffloat (args
[n
]);
1914 /* We have to put an arbitrary limit on minlen
1915 since otherwise it could make alloca fail. */
1919 #ifdef LISP_FLOAT_TYPE
1920 else if (FLOATP (args
[n
]) && *format
!= 's')
1922 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1923 args
[n
] = Ftruncate (args
[n
]);
1925 /* We have to put an arbitrary limit on minlen
1926 since otherwise it could make alloca fail. */
1933 /* Anything but a string, convert to a string using princ. */
1934 register Lisp_Object tem
;
1935 tem
= Fprin1_to_string (args
[n
], Qt
);
1942 register int nstrings
= n
+ 1;
1944 /* Allocate twice as many strings as we have %-escapes; floats occupy
1945 two slots, and we're not sure how many of those we have. */
1946 register unsigned char **strings
1947 = (unsigned char **) alloca (2 * nstrings
* sizeof (unsigned char *));
1951 for (n
= 0; n
< nstrings
; n
++)
1954 strings
[i
++] = (unsigned char *) "";
1955 else if (INTEGERP (args
[n
]))
1956 /* We checked above that the corresponding format effector
1957 isn't %s, which would cause MPV. */
1958 strings
[i
++] = (unsigned char *) XINT (args
[n
]);
1959 #ifdef LISP_FLOAT_TYPE
1960 else if (FLOATP (args
[n
]))
1962 union { double d
; char *half
[2]; } u
;
1964 u
.d
= XFLOAT (args
[n
])->data
;
1965 strings
[i
++] = (unsigned char *) u
.half
[0];
1966 strings
[i
++] = (unsigned char *) u
.half
[1];
1970 /* The first string is treated differently
1971 because it is the format string. */
1972 strings
[i
++] = XSTRING (args
[n
])->data
;
1974 strings
[i
++] = (unsigned char *) XFASTINT (args
[n
]);
1977 /* Make room in result for all the non-%-codes in the control string. */
1978 total
+= XSTRING (args
[0])->size
;
1980 /* Format it in bigger and bigger buf's until it all fits. */
1983 buf
= (char *) alloca (total
+ 1);
1986 length
= doprnt_lisp (buf
, total
+ 1, strings
[0],
1987 end
, i
-1, strings
+ 1);
1988 if (buf
[total
- 1] == 0)
1996 return make_string (buf
, length
);
2002 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
2003 EMACS_INT arg0
, arg1
, arg2
, arg3
, arg4
;
2017 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, args
);
2019 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, &string1
+ 1);
2021 return build_string (buf
);
2024 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
2025 "Return t if two characters match, optionally ignoring case.\n\
2026 Both arguments must be characters (i.e. integers).\n\
2027 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
2029 register Lisp_Object c1
, c2
;
2031 Lisp_Object
*downcase
= DOWNCASE_TABLE
;
2032 CHECK_NUMBER (c1
, 0);
2033 CHECK_NUMBER (c2
, 1);
2035 if (!NILP (current_buffer
->case_fold_search
)
2036 ? ((XINT (downcase
[0xff & XFASTINT (c1
)])
2037 == XINT (downcase
[0xff & XFASTINT (c2
)]))
2038 && (XFASTINT (c1
) & ~0xff) == (XFASTINT (c2
) & ~0xff))
2039 : XINT (c1
) == XINT (c2
))
2044 /* Transpose the markers in two regions of the current buffer, and
2045 adjust the ones between them if necessary (i.e.: if the regions
2048 Traverses the entire marker list of the buffer to do so, adding an
2049 appropriate amount to some, subtracting from some, and leaving the
2050 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2052 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2055 transpose_markers (start1
, end1
, start2
, end2
)
2056 register int start1
, end1
, start2
, end2
;
2058 register int amt1
, amt2
, diff
, mpos
;
2059 register Lisp_Object marker
;
2061 /* Update point as if it were a marker. */
2065 TEMP_SET_PT (PT
+ (end2
- end1
));
2066 else if (PT
< start2
)
2067 TEMP_SET_PT (PT
+ (end2
- start2
) - (end1
- start1
));
2069 TEMP_SET_PT (PT
- (start2
- start1
));
2071 /* We used to adjust the endpoints here to account for the gap, but that
2072 isn't good enough. Even if we assume the caller has tried to move the
2073 gap out of our way, it might still be at start1 exactly, for example;
2074 and that places it `inside' the interval, for our purposes. The amount
2075 of adjustment is nontrivial if there's a `denormalized' marker whose
2076 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2077 the dirty work to Fmarker_position, below. */
2079 /* The difference between the region's lengths */
2080 diff
= (end2
- start2
) - (end1
- start1
);
2082 /* For shifting each marker in a region by the length of the other
2083 * region plus the distance between the regions.
2085 amt1
= (end2
- start2
) + (start2
- end1
);
2086 amt2
= (end1
- start1
) + (start2
- end1
);
2088 for (marker
= BUF_MARKERS (current_buffer
); !NILP (marker
);
2089 marker
= XMARKER (marker
)->chain
)
2091 mpos
= Fmarker_position (marker
);
2092 if (mpos
>= start1
&& mpos
< end2
)
2096 else if (mpos
< start2
)
2100 if (mpos
> GPT
) mpos
+= GAP_SIZE
;
2101 XMARKER (marker
)->bufpos
= mpos
;
2106 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
2107 "Transpose region START1 to END1 with START2 to END2.\n\
2108 The regions may not be overlapping, because the size of the buffer is\n\
2109 never changed in a transposition.\n\
2111 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose\n\
2112 any markers that happen to be located in the regions.\n\
2114 Transposing beyond buffer boundaries is an error.")
2115 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
2116 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
2118 register int start1
, end1
, start2
, end2
,
2119 gap
, len1
, len_mid
, len2
;
2120 unsigned char *start1_addr
, *start2_addr
, *temp
;
2122 #ifdef USE_TEXT_PROPERTIES
2123 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
;
2124 cur_intv
= BUF_INTERVALS (current_buffer
);
2125 #endif /* USE_TEXT_PROPERTIES */
2127 validate_region (&startr1
, &endr1
);
2128 validate_region (&startr2
, &endr2
);
2130 start1
= XFASTINT (startr1
);
2131 end1
= XFASTINT (endr1
);
2132 start2
= XFASTINT (startr2
);
2133 end2
= XFASTINT (endr2
);
2136 /* Swap the regions if they're reversed. */
2139 register int glumph
= start1
;
2147 len1
= end1
- start1
;
2148 len2
= end2
- start2
;
2151 error ("transposed regions not properly ordered");
2152 else if (start1
== end1
|| start2
== end2
)
2153 error ("transposed region may not be of length 0");
2155 /* The possibilities are:
2156 1. Adjacent (contiguous) regions, or separate but equal regions
2157 (no, really equal, in this case!), or
2158 2. Separate regions of unequal size.
2160 The worst case is usually No. 2. It means that (aside from
2161 potential need for getting the gap out of the way), there also
2162 needs to be a shifting of the text between the two regions. So
2163 if they are spread far apart, we are that much slower... sigh. */
2165 /* It must be pointed out that the really studly thing to do would
2166 be not to move the gap at all, but to leave it in place and work
2167 around it if necessary. This would be extremely efficient,
2168 especially considering that people are likely to do
2169 transpositions near where they are working interactively, which
2170 is exactly where the gap would be found. However, such code
2171 would be much harder to write and to read. So, if you are
2172 reading this comment and are feeling squirrely, by all means have
2173 a go! I just didn't feel like doing it, so I will simply move
2174 the gap the minimum distance to get it out of the way, and then
2175 deal with an unbroken array. */
2177 /* Make sure the gap won't interfere, by moving it out of the text
2178 we will operate on. */
2179 if (start1
< gap
&& gap
< end2
)
2181 if (gap
- start1
< end2
- gap
)
2187 /* Hmmm... how about checking to see if the gap is large
2188 enough to use as the temporary storage? That would avoid an
2189 allocation... interesting. Later, don't fool with it now. */
2191 /* Working without memmove, for portability (sigh), so must be
2192 careful of overlapping subsections of the array... */
2194 if (end1
== start2
) /* adjacent regions */
2196 modify_region (current_buffer
, start1
, end2
);
2197 record_change (start1
, len1
+ len2
);
2199 #ifdef USE_TEXT_PROPERTIES
2200 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2201 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2202 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2203 #endif /* USE_TEXT_PROPERTIES */
2205 /* First region smaller than second. */
2208 /* We use alloca only if it is small,
2209 because we want to avoid stack overflow. */
2211 temp
= (unsigned char *) xmalloc (len2
);
2213 temp
= (unsigned char *) alloca (len2
);
2215 /* Don't precompute these addresses. We have to compute them
2216 at the last minute, because the relocating allocator might
2217 have moved the buffer around during the xmalloc. */
2218 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2219 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2221 bcopy (start2_addr
, temp
, len2
);
2222 bcopy (start1_addr
, start1_addr
+ len2
, len1
);
2223 bcopy (temp
, start1_addr
, len2
);
2228 /* First region not smaller than second. */
2231 temp
= (unsigned char *) xmalloc (len1
);
2233 temp
= (unsigned char *) alloca (len1
);
2234 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2235 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2236 bcopy (start1_addr
, temp
, len1
);
2237 bcopy (start2_addr
, start1_addr
, len2
);
2238 bcopy (temp
, start1_addr
+ len2
, len1
);
2242 #ifdef USE_TEXT_PROPERTIES
2243 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
2244 len1
, current_buffer
, 0);
2245 graft_intervals_into_buffer (tmp_interval2
, start1
,
2246 len2
, current_buffer
, 0);
2247 #endif /* USE_TEXT_PROPERTIES */
2249 /* Non-adjacent regions, because end1 != start2, bleagh... */
2253 /* Regions are same size, though, how nice. */
2255 modify_region (current_buffer
, start1
, end1
);
2256 modify_region (current_buffer
, start2
, end2
);
2257 record_change (start1
, len1
);
2258 record_change (start2
, len2
);
2259 #ifdef USE_TEXT_PROPERTIES
2260 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2261 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2262 Fset_text_properties (start1
, end1
, Qnil
, Qnil
);
2263 Fset_text_properties (start2
, end2
, Qnil
, Qnil
);
2264 #endif /* USE_TEXT_PROPERTIES */
2267 temp
= (unsigned char *) xmalloc (len1
);
2269 temp
= (unsigned char *) alloca (len1
);
2270 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2271 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2272 bcopy (start1_addr
, temp
, len1
);
2273 bcopy (start2_addr
, start1_addr
, len2
);
2274 bcopy (temp
, start2_addr
, len1
);
2277 #ifdef USE_TEXT_PROPERTIES
2278 graft_intervals_into_buffer (tmp_interval1
, start2
,
2279 len1
, current_buffer
, 0);
2280 graft_intervals_into_buffer (tmp_interval2
, start1
,
2281 len2
, current_buffer
, 0);
2282 #endif /* USE_TEXT_PROPERTIES */
2285 else if (len1
< len2
) /* Second region larger than first */
2286 /* Non-adjacent & unequal size, area between must also be shifted. */
2288 len_mid
= start2
- end1
;
2289 modify_region (current_buffer
, start1
, end2
);
2290 record_change (start1
, (end2
- start1
));
2291 #ifdef USE_TEXT_PROPERTIES
2292 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2293 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2294 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2295 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2296 #endif /* USE_TEXT_PROPERTIES */
2298 /* holds region 2 */
2300 temp
= (unsigned char *) xmalloc (len2
);
2302 temp
= (unsigned char *) alloca (len2
);
2303 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2304 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2305 bcopy (start2_addr
, temp
, len2
);
2306 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2
, len1
);
2307 safe_bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2308 bcopy (temp
, start1_addr
, len2
);
2311 #ifdef USE_TEXT_PROPERTIES
2312 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2313 len1
, current_buffer
, 0);
2314 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2315 len_mid
, current_buffer
, 0);
2316 graft_intervals_into_buffer (tmp_interval2
, start1
,
2317 len2
, current_buffer
, 0);
2318 #endif /* USE_TEXT_PROPERTIES */
2321 /* Second region smaller than first. */
2323 len_mid
= start2
- end1
;
2324 record_change (start1
, (end2
- start1
));
2325 modify_region (current_buffer
, start1
, end2
);
2327 #ifdef USE_TEXT_PROPERTIES
2328 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2329 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2330 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2331 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2332 #endif /* USE_TEXT_PROPERTIES */
2334 /* holds region 1 */
2336 temp
= (unsigned char *) xmalloc (len1
);
2338 temp
= (unsigned char *) alloca (len1
);
2339 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2340 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2341 bcopy (start1_addr
, temp
, len1
);
2342 bcopy (start2_addr
, start1_addr
, len2
);
2343 bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2344 bcopy (temp
, start1_addr
+ len2
+ len_mid
, len1
);
2347 #ifdef USE_TEXT_PROPERTIES
2348 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2349 len1
, current_buffer
, 0);
2350 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2351 len_mid
, current_buffer
, 0);
2352 graft_intervals_into_buffer (tmp_interval2
, start1
,
2353 len2
, current_buffer
, 0);
2354 #endif /* USE_TEXT_PROPERTIES */
2358 /* todo: this will be slow, because for every transposition, we
2359 traverse the whole friggin marker list. Possible solutions:
2360 somehow get a list of *all* the markers across multiple
2361 transpositions and do it all in one swell phoop. Or maybe modify
2362 Emacs' marker code to keep an ordered list or tree. This might
2363 be nicer, and more beneficial in the long run, but would be a
2364 bunch of work. Plus the way they're arranged now is nice. */
2365 if (NILP (leave_markers
))
2367 transpose_markers (start1
, end1
, start2
, end2
);
2368 fix_overlays_in_range (start1
, end2
);
2380 Qbuffer_access_fontify_functions
2381 = intern ("buffer-access-fontify-functions");
2382 staticpro (&Qbuffer_access_fontify_functions
);
2384 DEFVAR_LISP ("buffer-access-fontify-functions",
2385 &Vbuffer_access_fontify_functions
,
2386 "List of functions called by `buffer-substring' to fontify if necessary.\n\
2387 Each function is called with two arguments which specify the range\n\
2388 of the buffer being accessed.");
2389 Vbuffer_access_fontify_functions
= Qnil
;
2393 extern Lisp_Object Vprin1_to_string_buffer
;
2394 obuf
= Fcurrent_buffer ();
2395 /* Do this here, because init_buffer_once is too early--it won't work. */
2396 Fset_buffer (Vprin1_to_string_buffer
);
2397 /* Make sure buffer-access-fontify-functions is nil in this buffer. */
2398 Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
2403 DEFVAR_LISP ("buffer-access-fontified-property",
2404 &Vbuffer_access_fontified_property
,
2405 "Property which (if non-nil) indicates text has been fontified.\n\
2406 `buffer-substring' need not call the `buffer-access-fontify-functions'\n\
2407 functions if all the text being accessed has this property.");
2408 Vbuffer_access_fontified_property
= Qnil
;
2410 DEFVAR_LISP ("system-name", &Vsystem_name
,
2411 "The name of the machine Emacs is running on.");
2413 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
2414 "The full name of the user logged in.");
2416 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
2417 "The user's name, taken from environment variables if possible.");
2419 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
2420 "The user's name, based upon the real uid only.");
2422 defsubr (&Schar_equal
);
2423 defsubr (&Sgoto_char
);
2424 defsubr (&Sstring_to_char
);
2425 defsubr (&Schar_to_string
);
2426 defsubr (&Sbuffer_substring
);
2427 defsubr (&Sbuffer_substring_no_properties
);
2428 defsubr (&Sbuffer_string
);
2430 defsubr (&Spoint_marker
);
2431 defsubr (&Smark_marker
);
2433 defsubr (&Sregion_beginning
);
2434 defsubr (&Sregion_end
);
2435 /* defsubr (&Smark); */
2436 /* defsubr (&Sset_mark); */
2437 defsubr (&Ssave_excursion
);
2439 defsubr (&Sbufsize
);
2440 defsubr (&Spoint_max
);
2441 defsubr (&Spoint_min
);
2442 defsubr (&Spoint_min_marker
);
2443 defsubr (&Spoint_max_marker
);
2449 defsubr (&Sfollowing_char
);
2450 defsubr (&Sprevious_char
);
2451 defsubr (&Schar_after
);
2453 defsubr (&Sinsert_before_markers
);
2454 defsubr (&Sinsert_and_inherit
);
2455 defsubr (&Sinsert_and_inherit_before_markers
);
2456 defsubr (&Sinsert_char
);
2458 defsubr (&Suser_login_name
);
2459 defsubr (&Suser_real_login_name
);
2460 defsubr (&Suser_uid
);
2461 defsubr (&Suser_real_uid
);
2462 defsubr (&Suser_full_name
);
2463 defsubr (&Semacs_pid
);
2464 defsubr (&Scurrent_time
);
2465 defsubr (&Sformat_time_string
);
2466 defsubr (&Sdecode_time
);
2467 defsubr (&Sencode_time
);
2468 defsubr (&Scurrent_time_string
);
2469 defsubr (&Scurrent_time_zone
);
2470 defsubr (&Sset_time_zone_rule
);
2471 defsubr (&Ssystem_name
);
2472 defsubr (&Smessage
);
2473 defsubr (&Smessage_box
);
2474 defsubr (&Smessage_or_box
);
2477 defsubr (&Sinsert_buffer_substring
);
2478 defsubr (&Scompare_buffer_substrings
);
2479 defsubr (&Ssubst_char_in_region
);
2480 defsubr (&Stranslate_region
);
2481 defsubr (&Sdelete_region
);
2483 defsubr (&Snarrow_to_region
);
2484 defsubr (&Ssave_restriction
);
2485 defsubr (&Stranspose_regions
);