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, 675 Mass Ave, Cambridge, MA 02139, USA. */
21 #include <sys/types.h>
32 #include "intervals.h"
38 #define min(a, b) ((a) < (b) ? (a) : (b))
39 #define max(a, b) ((a) > (b) ? (a) : (b))
41 extern void insert_from_buffer ();
42 static long difftm ();
44 /* Some static data, and a function to initialize it for each run */
46 Lisp_Object Vsystem_name
;
47 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
48 Lisp_Object Vuser_full_name
; /* full name of current user */
49 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
55 register unsigned char *p
, *q
, *r
;
56 struct passwd
*pw
; /* password entry for the current user */
57 extern char *index ();
60 /* Set up system_name even when dumping. */
64 /* Don't bother with this on initial start when just dumping out */
67 #endif /* not CANNOT_DUMP */
69 pw
= (struct passwd
*) getpwuid (getuid ());
71 /* We let the real user name default to "root" because that's quite
72 accurate on MSDOG and because it lets Emacs find the init file.
73 (The DVX libraries override the Djgpp libraries here.) */
74 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
76 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
79 /* Get the effective user name, by consulting environment variables,
80 or the effective uid if those are unset. */
81 user_name
= (char *) getenv ("LOGNAME");
84 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
86 user_name
= (char *) getenv ("USER");
87 #endif /* WINDOWSNT */
90 pw
= (struct passwd
*) getpwuid (geteuid ());
91 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
93 Vuser_login_name
= build_string (user_name
);
95 /* If the user name claimed in the environment vars differs from
96 the real uid, use the claimed name to find the full name. */
97 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
99 pw
= (struct passwd
*) getpwnam (XSTRING (Vuser_login_name
)->data
);
101 p
= (unsigned char *) (pw
? USER_FULL_NAME
: "unknown");
102 q
= (unsigned char *) index (p
, ',');
103 Vuser_full_name
= make_string (p
, q
? q
- p
: strlen (p
));
105 #ifdef AMPERSAND_FULL_NAME
106 p
= XSTRING (Vuser_full_name
)->data
;
107 q
= (unsigned char *) index (p
, '&');
108 /* Substitute the login name for the &, upcasing the first character. */
111 r
= (unsigned char *) alloca (strlen (p
)
112 + XSTRING (Vuser_login_name
)->size
+ 1);
115 strcat (r
, XSTRING (Vuser_login_name
)->data
);
116 r
[q
- p
] = UPCASE (r
[q
- p
]);
118 Vuser_full_name
= build_string (r
);
120 #endif /* AMPERSAND_FULL_NAME */
122 p
= (unsigned char *) getenv ("NAME");
124 Vuser_full_name
= build_string (p
);
127 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
128 "Convert arg CHAR to a one-character string containing that character.")
136 return make_string (&c
, 1);
139 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
140 "Convert arg STRING to a character, the first character of that string.")
142 register Lisp_Object str
;
144 register Lisp_Object val
;
145 register struct Lisp_String
*p
;
146 CHECK_STRING (str
, 0);
150 XSETFASTINT (val
, ((unsigned char *) p
->data
)[0]);
152 XSETFASTINT (val
, 0);
160 register Lisp_Object mark
;
161 mark
= Fmake_marker ();
162 Fset_marker (mark
, make_number (val
), Qnil
);
166 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
167 "Return value of point, as an integer.\n\
168 Beginning of buffer is position (point-min)")
172 XSETFASTINT (temp
, point
);
176 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
177 "Return value of point, as a marker object.")
180 return buildmark (point
);
184 clip_to_bounds (lower
, num
, upper
)
185 int lower
, num
, upper
;
189 else if (num
> upper
)
195 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
196 "Set point to POSITION, a number or marker.\n\
197 Beginning of buffer is position (point-min), end is (point-max).")
199 register Lisp_Object n
;
201 CHECK_NUMBER_COERCE_MARKER (n
, 0);
203 SET_PT (clip_to_bounds (BEGV
, XINT (n
), ZV
));
208 region_limit (beginningp
)
211 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
212 register Lisp_Object m
;
213 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
214 && NILP (current_buffer
->mark_active
))
215 Fsignal (Qmark_inactive
, Qnil
);
216 m
= Fmarker_position (current_buffer
->mark
);
217 if (NILP (m
)) error ("There is no region now");
218 if ((point
< XFASTINT (m
)) == beginningp
)
219 return (make_number (point
));
224 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
225 "Return position of beginning of region, as an integer.")
228 return (region_limit (1));
231 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
232 "Return position of end of region, as an integer.")
235 return (region_limit (0));
238 #if 0 /* now in lisp code */
239 DEFUN ("mark", Fmark
, Smark
, 0, 0, 0,
240 "Return this buffer's mark value as integer, or nil if no mark.\n\
241 If you are using this in an editing command, you are most likely making\n\
242 a mistake; see the documentation of `set-mark'.")
245 return Fmarker_position (current_buffer
->mark
);
247 #endif /* commented out code */
249 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
250 "Return this buffer's mark, as a marker object.\n\
251 Watch out! Moving this marker changes the mark position.\n\
252 If you set the marker not to point anywhere, the buffer will have no mark.")
255 return current_buffer
->mark
;
258 #if 0 /* this is now in lisp code */
259 DEFUN ("set-mark", Fset_mark
, Sset_mark
, 1, 1, 0,
260 "Set this buffer's mark to POS. Don't use this function!\n\
261 That is to say, don't use this function unless you want\n\
262 the user to see that the mark has moved, and you want the previous\n\
263 mark position to be lost.\n\
265 Normally, when a new mark is set, the old one should go on the stack.\n\
266 This is why most applications should use push-mark, not set-mark.\n\
268 Novice programmers often try to use the mark for the wrong purposes.\n\
269 The mark saves a location for the user's convenience.\n\
270 Most editing commands should not alter the mark.\n\
271 To remember a location for internal use in the Lisp program,\n\
272 store it in a Lisp variable. Example:\n\
274 (let ((beg (point))) (forward-line 1) (delete-region beg (point))).")
280 current_buffer
->mark
= Qnil
;
283 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
285 if (NILP (current_buffer
->mark
))
286 current_buffer
->mark
= Fmake_marker ();
288 Fset_marker (current_buffer
->mark
, pos
, Qnil
);
291 #endif /* commented-out code */
294 save_excursion_save ()
296 register int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
299 return Fcons (Fpoint_marker (),
300 Fcons (Fcopy_marker (current_buffer
->mark
),
301 Fcons (visible
? Qt
: Qnil
,
302 current_buffer
->mark_active
)));
306 save_excursion_restore (info
)
307 register Lisp_Object info
;
309 register Lisp_Object tem
, tem1
, omark
, nmark
;
311 tem
= Fmarker_buffer (Fcar (info
));
312 /* If buffer being returned to is now deleted, avoid error */
313 /* Otherwise could get error here while unwinding to top level
315 /* In that case, Fmarker_buffer returns nil now. */
321 unchain_marker (tem
);
322 tem
= Fcar (Fcdr (info
));
323 omark
= Fmarker_position (current_buffer
->mark
);
324 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
325 nmark
= Fmarker_position (tem
);
326 unchain_marker (tem
);
327 tem
= Fcdr (Fcdr (info
));
328 #if 0 /* We used to make the current buffer visible in the selected window
329 if that was true previously. That avoids some anomalies.
330 But it creates others, and it wasn't documented, and it is simpler
331 and cleaner never to alter the window/buffer connections. */
334 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
335 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
338 tem1
= current_buffer
->mark_active
;
339 current_buffer
->mark_active
= Fcdr (tem
);
340 if (!NILP (Vrun_hooks
))
342 /* If mark is active now, and either was not active
343 or was at a different place, run the activate hook. */
344 if (! NILP (current_buffer
->mark_active
))
346 if (! EQ (omark
, nmark
))
347 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
349 /* If mark has ceased to be active, run deactivate hook. */
350 else if (! NILP (tem1
))
351 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
356 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
357 "Save point, mark, and current buffer; execute BODY; restore those things.\n\
358 Executes BODY just like `progn'.\n\
359 The values of point, mark and the current buffer are restored\n\
360 even in case of abnormal exit (throw or error).\n\
361 The state of activation of the mark is also restored.")
365 register Lisp_Object val
;
366 int count
= specpdl_ptr
- specpdl
;
368 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
371 return unbind_to (count
, val
);
374 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 0, 0,
375 "Return the number of characters in the current buffer.")
379 XSETFASTINT (temp
, Z
- BEG
);
383 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
384 "Return the minimum permissible value of point in the current buffer.\n\
385 This is 1, unless narrowing (a buffer restriction) is in effect.")
389 XSETFASTINT (temp
, BEGV
);
393 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
394 "Return a marker to the minimum permissible value of point in this buffer.\n\
395 This is the beginning, unless narrowing (a buffer restriction) is in effect.")
398 return buildmark (BEGV
);
401 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
402 "Return the maximum permissible value of point in the current buffer.\n\
403 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
404 is in effect, in which case it is less.")
408 XSETFASTINT (temp
, ZV
);
412 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
413 "Return a marker to the maximum permissible value of point in this buffer.\n\
414 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
415 is in effect, in which case it is less.")
418 return buildmark (ZV
);
421 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
422 "Return the character following point, as a number.\n\
423 At the end of the buffer or accessible region, return 0.")
428 XSETFASTINT (temp
, 0);
430 XSETFASTINT (temp
, FETCH_CHAR (point
));
434 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
435 "Return the character preceding point, as a number.\n\
436 At the beginning of the buffer or accessible region, return 0.")
441 XSETFASTINT (temp
, 0);
443 XSETFASTINT (temp
, FETCH_CHAR (point
- 1));
447 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
448 "Return T if point is at the beginning of the buffer.\n\
449 If the buffer is narrowed, this means the beginning of the narrowed part.")
457 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
458 "Return T if point is at the end of the buffer.\n\
459 If the buffer is narrowed, this means the end of the narrowed part.")
467 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
468 "Return T if point is at the beginning of a line.")
471 if (point
== BEGV
|| FETCH_CHAR (point
- 1) == '\n')
476 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
477 "Return T if point is at the end of a line.\n\
478 `End of a line' includes point being at the end of the buffer.")
481 if (point
== ZV
|| FETCH_CHAR (point
) == '\n')
486 DEFUN ("char-after", Fchar_after
, Schar_after
, 1, 1, 0,
487 "Return character in current buffer at position POS.\n\
488 POS is an integer or a buffer pointer.\n\
489 If POS is out of range, the value is nil.")
493 register Lisp_Object val
;
496 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
499 if (n
< BEGV
|| n
>= ZV
) return Qnil
;
501 XSETFASTINT (val
, FETCH_CHAR (n
));
505 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
506 "Return the name under which the user logged in, as a string.\n\
507 This is based on the effective uid, not the real uid.\n\
508 Also, if the environment variable LOGNAME or USER is set,\n\
509 that determines the value of this function.\n\n\
510 If optional argument UID is an integer, return the login name of the user\n\
511 with that uid, or nil if there is no such user.")
517 /* Set up the user name info if we didn't do it before.
518 (That can happen if Emacs is dumpable
519 but you decide to run `temacs -l loadup' and not dump. */
520 if (INTEGERP (Vuser_login_name
))
524 return Vuser_login_name
;
526 CHECK_NUMBER (uid
, 0);
527 pw
= (struct passwd
*) getpwuid (XINT (uid
));
528 return (pw
? build_string (pw
->pw_name
) : Qnil
);
531 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
533 "Return the name of the user's real uid, as a string.\n\
534 This ignores the environment variables LOGNAME and USER, so it differs from\n\
535 `user-login-name' when running under `su'.")
538 /* Set up the user name info if we didn't do it before.
539 (That can happen if Emacs is dumpable
540 but you decide to run `temacs -l loadup' and not dump. */
541 if (INTEGERP (Vuser_login_name
))
543 return Vuser_real_login_name
;
546 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
547 "Return the effective uid of Emacs, as an integer.")
550 return make_number (geteuid ());
553 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
554 "Return the real uid of Emacs, as an integer.")
557 return make_number (getuid ());
560 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 0, 0,
561 "Return the full name of the user logged in, as a string.")
564 return Vuser_full_name
;
567 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
568 "Return the name of the machine you are running on, as a string.")
574 /* For the benefit of callers who don't want to include lisp.h */
578 return (char *) XSTRING (Vsystem_name
)->data
;
581 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
582 "Return the process ID of Emacs, as an integer.")
585 return make_number (getpid ());
588 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
589 "Return the current time, as the number of seconds since 12:00 AM January 1970.\n\
590 The time is returned as a list of three integers. The first has the\n\
591 most significant 16 bits of the seconds, while the second has the\n\
592 least significant 16 bits. The third integer gives the microsecond\n\
595 The microsecond count is zero on systems that do not provide\n\
596 resolution finer than a second.")
600 Lisp_Object result
[3];
603 XSETINT (result
[0], (EMACS_SECS (t
) >> 16) & 0xffff);
604 XSETINT (result
[1], (EMACS_SECS (t
) >> 0) & 0xffff);
605 XSETINT (result
[2], EMACS_USECS (t
));
607 return Flist (3, result
);
612 lisp_time_argument (specified_time
, result
)
613 Lisp_Object specified_time
;
616 if (NILP (specified_time
))
617 return time (result
) != -1;
620 Lisp_Object high
, low
;
621 high
= Fcar (specified_time
);
622 CHECK_NUMBER (high
, 0);
623 low
= Fcdr (specified_time
);
626 CHECK_NUMBER (low
, 0);
627 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
628 return *result
>> 16 == XINT (high
);
632 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 2, 2, 0,
633 "Use FORMAT-STRING to format the time TIME.\n\
634 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from\n\
635 `current-time' and `file-attributes'.\n\
636 FORMAT-STRING may contain %-sequences to substitute parts of the time.\n\
637 %a is replaced by the abbreviated name of the day of week.\n\
638 %A is replaced by the full name of the day of week.\n\
639 %b is replaced by the abbreviated name of the month.\n\
640 %B is replaced by the full name of the month.\n\
641 %c is a synonym for \"%x %X\".\n\
642 %C is a locale-specific synonym, which defaults to \"%A, %B %e, %Y\" in the C locale.\n\
643 %d is replaced by the day of month, zero-padded.\n\
644 %D is a synonym for \"%m/%d/%y\".\n\
645 %e is replaced by the day of month, blank-padded.\n\
646 %h is a synonym for \"%b\".\n\
647 %H is replaced by the hour (00-23).\n\
648 %I is replaced by the hour (00-12).\n\
649 %j is replaced by the day of the year (001-366).\n\
650 %k is replaced by the hour (0-23), blank padded.\n\
651 %l is replaced by the hour (1-12), blank padded.\n\
652 %m is replaced by the month (01-12).\n\
653 %M is replaced by the minut (00-59).\n\
654 %n is a synonym for \"\\n\".\n\
655 %p is replaced by AM or PM, as appropriate.\n\
656 %r is a synonym for \"%I:%M:%S %p\".\n\
657 %R is a synonym for \"%H:%M\".\n\
658 %S is replaced by the seconds (00-60).\n\
659 %t is a synonym for \"\\t\".\n\
660 %T is a synonym for \"%H:%M:%S\".\n\
661 %U is replaced by the week of the year (01-52), first day of week is Sunday.\n\
662 %w is replaced by the day of week (0-6), Sunday is day 0.\n\
663 %W is replaced by the week of the year (01-52), first day of week is Monday.\n\
664 %x is a locale-specific synonym, which defaults to \"%D\" in the C locale.\n\
665 %X is a locale-specific synonym, which defaults to \"%T\" in the C locale.\n\
666 %y is replaced by the year without century (00-99).\n\
667 %Y is replaced by the year with century.\n\
668 %Z is replaced by the time zone abbreviation.\n\
670 The number of options reflects the `strftime' function.")
671 (format_string
, time
)
672 Lisp_Object format_string
, time
;
677 CHECK_STRING (format_string
, 1);
679 if (! lisp_time_argument (time
, &value
))
680 error ("Invalid time specification");
682 /* This is probably enough. */
683 size
= XSTRING (format_string
)->size
* 6 + 50;
687 char *buf
= (char *) alloca (size
);
688 if (emacs_strftime (buf
, size
, XSTRING (format_string
)->data
,
690 return build_string (buf
);
691 /* If buffer was too small, make it bigger. */
696 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
697 "Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).\n\
698 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)\n\
699 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'\n\
700 to use the current time. The list has the following nine members:\n\
701 SEC is an integer between 0 and 59. MINUTE is an integer between 0 and 59.\n\
702 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.\n\
703 MONTH is an integer between 1 and 12. YEAR is an integer indicating the\n\
704 four-digit year. DOW is the day of week, an integer between 0 and 6, where\n\
705 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.\n\
706 ZONE is an integer indicating the number of seconds east of Greenwich.\n\
707 (Note that Common Lisp has different meanings for DOW and ZONE.)")
709 Lisp_Object specified_time
;
713 struct tm
*decoded_time
;
714 Lisp_Object list_args
[9];
716 if (! lisp_time_argument (specified_time
, &time_spec
))
717 error ("Invalid time specification");
719 decoded_time
= localtime (&time_spec
);
720 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
721 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
722 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
723 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
724 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
725 XSETFASTINT (list_args
[5], decoded_time
->tm_year
+ 1900);
726 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
727 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
729 /* Make a copy, in case gmtime modifies the struct. */
730 save_tm
= *decoded_time
;
731 decoded_time
= gmtime (&time_spec
);
732 if (decoded_time
== 0)
735 XSETINT (list_args
[8], difftm (&save_tm
, decoded_time
));
736 return Flist (9, list_args
);
739 static char days_per_month
[11]
740 = { 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 };
742 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, 7, 0,
743 "Convert SEC, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.\n\
744 This is the reverse operation of `decode-time', which see. ZONE defaults\n\
745 to the current time zone and daylight savings time if not specified; if\n\
746 specified, it can be either a list (as from `current-time-zone') or an\n\
747 integer (as from `decode-time'), and is applied without consideration for\n\
748 daylight savings time.\n\
749 Year numbers less than 100 are treated just like other year numbers.\n\
750 If you want them to stand for years above 1900, you must do that yourself.")
751 (sec
, minute
, hour
, day
, month
, year
, zone
)
752 Lisp_Object sec
, minute
, hour
, day
, month
, year
, zone
;
755 int fullyear
, mon
, days
, seconds
, tz
= 0;
757 CHECK_NATNUM (sec
, 0);
758 CHECK_NATNUM (minute
, 1);
759 CHECK_NATNUM (hour
, 2);
760 CHECK_NATNUM (day
, 3);
761 CHECK_NATNUM (month
, 4);
762 CHECK_NATNUM (year
, 5);
764 fullyear
= XINT (year
);
766 /* Adjust incoming datespec to epoch = March 1, year 0.
767 The "date" March 1, year 0, is an abstraction used purely for its
768 computational convenience; year 0 never existed. */
769 mon
= XINT (month
) - 1 + 10;
770 fullyear
+= mon
/12 - 1;
773 days
= XINT (day
) - 1; /* day of month */
774 while (mon
-- > 0) /* day of year */
775 days
+= days_per_month
[mon
];
776 days
+= 146097 * (fullyear
/400); /* 400 years = 146097 days */
778 days
+= 36524 * (fullyear
/100); /* 100 years = 36524 days */
780 days
+= 1461 * (fullyear
/4); /* 4 years = 1461 days */
782 days
+= 365 * fullyear
; /* 1 year = 365 days */
784 /* Adjust computed datespec to epoch = January 1, 1970. */
785 days
+= 59; /* March 1 is 59th day. */
786 days
-= 719527; /* 1970 years = 719527 days */
788 seconds
= XINT (sec
) + 60 * XINT (minute
) + 3600 * XINT (hour
);
790 if (sizeof (time_t) == 4
791 && ((days
+(seconds
/86400) > 24854) || (days
+(seconds
/86400) < -24854)))
792 error ("the specified time is outside the representable range");
794 time
= days
* 86400 + seconds
;
796 /* We have the correct value for UTC. Adjust for timezones. */
800 time_t adjusted_time
;
802 /* If the system does not use timezones, gmtime returns 0, and we
803 already have the correct value, by definition. */
804 if ((t
= gmtime (&time
)) != 0)
807 t
= localtime (&time
);
808 tz
= difftm (t
, &gmt
);
809 /* The timezone returned is that at the specified Universal Time,
810 not the local time, which is what we want. Adjust, repeat. */
811 adjusted_time
= time
- tz
;
812 gmt
= *gmtime (&adjusted_time
); /* this is safe now */
813 t
= localtime (&adjusted_time
);
814 adjusted_tz
= difftm (t
, &gmt
);
815 /* In case of discrepancy, adjust again for extra accuracy. */
816 if (adjusted_tz
!= tz
)
818 adjusted_time
= time
- adjusted_tz
;
819 gmt
= *gmtime (&adjusted_time
);
820 t
= localtime (&adjusted_time
);
821 adjusted_tz
= difftm (t
, &gmt
);
830 CHECK_NUMBER (zone
, 6);
834 return make_time (time
- tz
);
837 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
838 "Return the current time, as a human-readable string.\n\
839 Programs can use this function to decode a time,\n\
840 since the number of columns in each field is fixed.\n\
841 The format is `Sun Sep 16 01:03:52 1973'.\n\
842 If an argument is given, it specifies a time to format\n\
843 instead of the current time. The argument should have the form:\n\
846 (HIGH LOW . IGNORED).\n\
847 Thus, you can use times obtained from `current-time'\n\
848 and from `file-attributes'.")
850 Lisp_Object specified_time
;
856 if (! lisp_time_argument (specified_time
, &value
))
858 tem
= (char *) ctime (&value
);
860 strncpy (buf
, tem
, 24);
863 return build_string (buf
);
866 #define TM_YEAR_ORIGIN 1900
868 /* Yield A - B, measured in seconds. */
873 int ay
= a
->tm_year
+ (TM_YEAR_ORIGIN
- 1);
874 int by
= b
->tm_year
+ (TM_YEAR_ORIGIN
- 1);
875 /* Some compilers can't handle this as a single return statement. */
877 /* difference in day of year */
878 a
->tm_yday
- b
->tm_yday
879 /* + intervening leap days */
880 + ((ay
>> 2) - (by
>> 2))
882 + ((ay
/100 >> 2) - (by
/100 >> 2))
883 /* + difference in years * 365 */
884 + (long)(ay
-by
) * 365
886 return (60*(60*(24*days
+ (a
->tm_hour
- b
->tm_hour
))
887 + (a
->tm_min
- b
->tm_min
))
888 + (a
->tm_sec
- b
->tm_sec
));
891 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
892 "Return the offset and name for the local time zone.\n\
893 This returns a list of the form (OFFSET NAME).\n\
894 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).\n\
895 A negative value means west of Greenwich.\n\
896 NAME is a string giving the name of the time zone.\n\
897 If an argument is given, it specifies when the time zone offset is determined\n\
898 instead of using the current time. The argument should have the form:\n\
901 (HIGH LOW . IGNORED).\n\
902 Thus, you can use times obtained from `current-time'\n\
903 and from `file-attributes'.\n\
905 Some operating systems cannot provide all this information to Emacs;\n\
906 in this case, `current-time-zone' returns a list containing nil for\n\
907 the data it can't find.")
909 Lisp_Object specified_time
;
914 if (lisp_time_argument (specified_time
, &value
)
915 && (t
= gmtime (&value
)) != 0)
921 gmt
= *t
; /* Make a copy, in case localtime modifies *t. */
922 t
= localtime (&value
);
923 offset
= difftm (t
, &gmt
);
927 s
= (char *)t
->tm_zone
;
928 #else /* not HAVE_TM_ZONE */
930 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
931 s
= tzname
[t
->tm_isdst
];
933 #endif /* not HAVE_TM_ZONE */
936 /* No local time zone name is available; use "+-NNNN" instead. */
937 int am
= (offset
< 0 ? -offset
: offset
) / 60;
938 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
941 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
944 return Fmake_list (2, Qnil
);
956 /* Callers passing one argument to Finsert need not gcpro the
957 argument "array", since the only element of the array will
958 not be used after calling insert or insert_from_string, so
959 we don't care if it gets trashed. */
961 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
962 "Insert the arguments, either strings or characters, at point.\n\
963 Point moves forward so that it ends up after the inserted text.\n\
964 Any other markers at the point of insertion remain before the text.")
967 register Lisp_Object
*args
;
970 register Lisp_Object tem
;
973 for (argnum
= 0; argnum
< nargs
; argnum
++)
982 else if (STRINGP (tem
))
984 insert_from_string (tem
, 0, XSTRING (tem
)->size
, 0);
988 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
996 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
998 "Insert the arguments at point, inheriting properties from adjoining text.\n\
999 Point moves forward so that it ends up after the inserted text.\n\
1000 Any other markers at the point of insertion remain before the text.")
1003 register Lisp_Object
*args
;
1005 register int argnum
;
1006 register Lisp_Object tem
;
1009 for (argnum
= 0; argnum
< nargs
; argnum
++)
1015 str
[0] = XINT (tem
);
1016 insert_and_inherit (str
, 1);
1018 else if (STRINGP (tem
))
1020 insert_from_string (tem
, 0, XSTRING (tem
)->size
, 1);
1024 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1032 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
1033 "Insert strings or characters at point, relocating markers after the text.\n\
1034 Point moves forward so that it ends up after the inserted text.\n\
1035 Any other markers at the point of insertion also end up after the text.")
1038 register Lisp_Object
*args
;
1040 register int argnum
;
1041 register Lisp_Object tem
;
1044 for (argnum
= 0; argnum
< nargs
; argnum
++)
1050 str
[0] = XINT (tem
);
1051 insert_before_markers (str
, 1);
1053 else if (STRINGP (tem
))
1055 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
, 0);
1059 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1067 DEFUN ("insert-before-markers-and-inherit",
1068 Finsert_and_inherit_before_markers
, Sinsert_and_inherit_before_markers
,
1070 "Insert text at point, relocating markers and inheriting properties.\n\
1071 Point moves forward so that it ends up after the inserted text.\n\
1072 Any other markers at the point of insertion also end up after the text.")
1075 register Lisp_Object
*args
;
1077 register int argnum
;
1078 register Lisp_Object tem
;
1081 for (argnum
= 0; argnum
< nargs
; argnum
++)
1087 str
[0] = XINT (tem
);
1088 insert_before_markers_and_inherit (str
, 1);
1090 else if (STRINGP (tem
))
1092 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
, 1);
1096 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1104 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
1105 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
1106 Point and all markers are affected as in the function `insert'.\n\
1107 Both arguments are required.\n\
1108 The optional third arg INHERIT, if non-nil, says to inherit text properties\n\
1109 from adjoining text, if those properties are sticky.")
1110 (chr
, count
, inherit
)
1111 Lisp_Object chr
, count
, inherit
;
1113 register unsigned char *string
;
1114 register int strlen
;
1117 CHECK_NUMBER (chr
, 0);
1118 CHECK_NUMBER (count
, 1);
1123 strlen
= min (n
, 256);
1124 string
= (unsigned char *) alloca (strlen
);
1125 for (i
= 0; i
< strlen
; i
++)
1126 string
[i
] = XFASTINT (chr
);
1129 if (!NILP (inherit
))
1130 insert_and_inherit (string
, strlen
);
1132 insert (string
, strlen
);
1137 if (!NILP (inherit
))
1138 insert_and_inherit (string
, n
);
1146 /* Making strings from buffer contents. */
1148 /* Return a Lisp_String containing the text of the current buffer from
1149 START to END. If text properties are in use and the current buffer
1150 has properties in the range specified, the resulting string will also
1153 We don't want to use plain old make_string here, because it calls
1154 make_uninit_string, which can cause the buffer arena to be
1155 compacted. make_string has no way of knowing that the data has
1156 been moved, and thus copies the wrong data into the string. This
1157 doesn't effect most of the other users of make_string, so it should
1158 be left as is. But we should use this function when conjuring
1159 buffer substrings. */
1162 make_buffer_string (start
, end
)
1165 Lisp_Object result
, tem
, tem1
;
1167 if (start
< GPT
&& GPT
< end
)
1170 result
= make_uninit_string (end
- start
);
1171 bcopy (&FETCH_CHAR (start
), XSTRING (result
)->data
, end
- start
);
1173 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
1174 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
1176 #ifdef USE_TEXT_PROPERTIES
1177 if (XINT (tem
) != end
|| !NILP (tem1
))
1178 copy_intervals_to_string (result
, current_buffer
, start
, end
- start
);
1184 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
1185 "Return the contents of part of the current buffer as a string.\n\
1186 The two arguments START and END are character positions;\n\
1187 they can be in either order.")
1191 register int beg
, end
;
1193 validate_region (&b
, &e
);
1197 return make_buffer_string (beg
, end
);
1200 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
1201 "Return the contents of the current buffer as a string.\n\
1202 If narrowing is in effect, this function returns only the visible part\n\
1206 return make_buffer_string (BEGV
, ZV
);
1209 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
1211 "Insert before point a substring of the contents of buffer BUFFER.\n\
1212 BUFFER may be a buffer or a buffer name.\n\
1213 Arguments START and END are character numbers specifying the substring.\n\
1214 They default to the beginning and the end of BUFFER.")
1216 Lisp_Object buf
, b
, e
;
1218 register int beg
, end
, temp
;
1219 register struct buffer
*bp
;
1222 buffer
= Fget_buffer (buf
);
1225 bp
= XBUFFER (buffer
);
1228 beg
= BUF_BEGV (bp
);
1231 CHECK_NUMBER_COERCE_MARKER (b
, 0);
1238 CHECK_NUMBER_COERCE_MARKER (e
, 1);
1243 temp
= beg
, beg
= end
, end
= temp
;
1245 if (!(BUF_BEGV (bp
) <= beg
&& end
<= BUF_ZV (bp
)))
1246 args_out_of_range (b
, e
);
1248 insert_from_buffer (bp
, beg
, end
- beg
, 0);
1252 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
1254 "Compare two substrings of two buffers; return result as number.\n\
1255 the value is -N if first string is less after N-1 chars,\n\
1256 +N if first string is greater after N-1 chars, or 0 if strings match.\n\
1257 Each substring is represented as three arguments: BUFFER, START and END.\n\
1258 That makes six args in all, three for each substring.\n\n\
1259 The value of `case-fold-search' in the current buffer\n\
1260 determines whether case is significant or ignored.")
1261 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
1262 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
1264 register int begp1
, endp1
, begp2
, endp2
, temp
, len1
, len2
, length
, i
;
1265 register struct buffer
*bp1
, *bp2
;
1266 register unsigned char *trt
1267 = (!NILP (current_buffer
->case_fold_search
)
1268 ? XSTRING (current_buffer
->case_canon_table
)->data
: 0);
1270 /* Find the first buffer and its substring. */
1273 bp1
= current_buffer
;
1277 buf1
= Fget_buffer (buffer1
);
1280 bp1
= XBUFFER (buf1
);
1284 begp1
= BUF_BEGV (bp1
);
1287 CHECK_NUMBER_COERCE_MARKER (start1
, 1);
1288 begp1
= XINT (start1
);
1291 endp1
= BUF_ZV (bp1
);
1294 CHECK_NUMBER_COERCE_MARKER (end1
, 2);
1295 endp1
= XINT (end1
);
1299 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
1301 if (!(BUF_BEGV (bp1
) <= begp1
1303 && endp1
<= BUF_ZV (bp1
)))
1304 args_out_of_range (start1
, end1
);
1306 /* Likewise for second substring. */
1309 bp2
= current_buffer
;
1313 buf2
= Fget_buffer (buffer2
);
1316 bp2
= XBUFFER (buffer2
);
1320 begp2
= BUF_BEGV (bp2
);
1323 CHECK_NUMBER_COERCE_MARKER (start2
, 4);
1324 begp2
= XINT (start2
);
1327 endp2
= BUF_ZV (bp2
);
1330 CHECK_NUMBER_COERCE_MARKER (end2
, 5);
1331 endp2
= XINT (end2
);
1335 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
1337 if (!(BUF_BEGV (bp2
) <= begp2
1339 && endp2
<= BUF_ZV (bp2
)))
1340 args_out_of_range (start2
, end2
);
1342 len1
= endp1
- begp1
;
1343 len2
= endp2
- begp2
;
1348 for (i
= 0; i
< length
; i
++)
1350 int c1
= *BUF_CHAR_ADDRESS (bp1
, begp1
+ i
);
1351 int c2
= *BUF_CHAR_ADDRESS (bp2
, begp2
+ i
);
1358 return make_number (- 1 - i
);
1360 return make_number (i
+ 1);
1363 /* The strings match as far as they go.
1364 If one is shorter, that one is less. */
1366 return make_number (length
+ 1);
1367 else if (length
< len2
)
1368 return make_number (- length
- 1);
1370 /* Same length too => they are equal. */
1371 return make_number (0);
1375 subst_char_in_region_unwind (arg
)
1378 return current_buffer
->undo_list
= arg
;
1382 subst_char_in_region_unwind_1 (arg
)
1385 return current_buffer
->filename
= arg
;
1388 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
1389 Ssubst_char_in_region
, 4, 5, 0,
1390 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
1391 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
1392 and don't mark the buffer as really changed.")
1393 (start
, end
, fromchar
, tochar
, noundo
)
1394 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
1396 register int pos
, stop
, look
;
1398 int count
= specpdl_ptr
- specpdl
;
1400 validate_region (&start
, &end
);
1401 CHECK_NUMBER (fromchar
, 2);
1402 CHECK_NUMBER (tochar
, 3);
1406 look
= XINT (fromchar
);
1408 /* If we don't want undo, turn off putting stuff on the list.
1409 That's faster than getting rid of things,
1410 and it prevents even the entry for a first change.
1411 Also inhibit locking the file. */
1414 record_unwind_protect (subst_char_in_region_unwind
,
1415 current_buffer
->undo_list
);
1416 current_buffer
->undo_list
= Qt
;
1417 /* Don't do file-locking. */
1418 record_unwind_protect (subst_char_in_region_unwind_1
,
1419 current_buffer
->filename
);
1420 current_buffer
->filename
= Qnil
;
1425 if (FETCH_CHAR (pos
) == look
)
1429 modify_region (current_buffer
, XINT (start
), stop
);
1431 if (! NILP (noundo
))
1433 if (MODIFF
- 1 == SAVE_MODIFF
)
1435 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
1436 current_buffer
->auto_save_modified
++;
1443 record_change (pos
, 1);
1444 FETCH_CHAR (pos
) = XINT (tochar
);
1450 signal_after_change (XINT (start
),
1451 stop
- XINT (start
), stop
- XINT (start
));
1453 unbind_to (count
, Qnil
);
1457 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
1458 "From START to END, translate characters according to TABLE.\n\
1459 TABLE is a string; the Nth character in it is the mapping\n\
1460 for the character with code N. Returns the number of characters changed.")
1464 register Lisp_Object table
;
1466 register int pos
, stop
; /* Limits of the region. */
1467 register unsigned char *tt
; /* Trans table. */
1468 register int oc
; /* Old character. */
1469 register int nc
; /* New character. */
1470 int cnt
; /* Number of changes made. */
1471 Lisp_Object z
; /* Return. */
1472 int size
; /* Size of translate table. */
1474 validate_region (&start
, &end
);
1475 CHECK_STRING (table
, 2);
1477 size
= XSTRING (table
)->size
;
1478 tt
= XSTRING (table
)->data
;
1482 modify_region (current_buffer
, pos
, stop
);
1485 for (; pos
< stop
; ++pos
)
1487 oc
= FETCH_CHAR (pos
);
1493 record_change (pos
, 1);
1494 FETCH_CHAR (pos
) = nc
;
1495 signal_after_change (pos
, 1, 1);
1501 XSETFASTINT (z
, cnt
);
1505 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
1506 "Delete the text between point and mark.\n\
1507 When called from a program, expects two arguments,\n\
1508 positions (integers or markers) specifying the stretch to be deleted.")
1512 validate_region (&b
, &e
);
1513 del_range (XINT (b
), XINT (e
));
1517 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
1518 "Remove restrictions (narrowing) from current buffer.\n\
1519 This allows the buffer's full text to be seen and edited.")
1523 SET_BUF_ZV (current_buffer
, Z
);
1524 current_buffer
->clip_changed
= 1;
1525 /* Changing the buffer bounds invalidates any recorded current column. */
1526 invalidate_current_column ();
1530 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
1531 "Restrict editing in this buffer to the current region.\n\
1532 The rest of the text becomes temporarily invisible and untouchable\n\
1533 but is not deleted; if you save the buffer in a file, the invisible\n\
1534 text is included in the file. \\[widen] makes all visible again.\n\
1535 See also `save-restriction'.\n\
1537 When calling from a program, pass two arguments; positions (integers\n\
1538 or markers) bounding the text that should remain visible.")
1540 register Lisp_Object b
, e
;
1542 CHECK_NUMBER_COERCE_MARKER (b
, 0);
1543 CHECK_NUMBER_COERCE_MARKER (e
, 1);
1545 if (XINT (b
) > XINT (e
))
1548 tem
= b
; b
= e
; e
= tem
;
1551 if (!(BEG
<= XINT (b
) && XINT (b
) <= XINT (e
) && XINT (e
) <= Z
))
1552 args_out_of_range (b
, e
);
1554 BEGV
= XFASTINT (b
);
1555 SET_BUF_ZV (current_buffer
, XFASTINT (e
));
1556 if (point
< XFASTINT (b
))
1557 SET_PT (XFASTINT (b
));
1558 if (point
> XFASTINT (e
))
1559 SET_PT (XFASTINT (e
));
1560 current_buffer
->clip_changed
= 1;
1561 /* Changing the buffer bounds invalidates any recorded current column. */
1562 invalidate_current_column ();
1567 save_restriction_save ()
1569 register Lisp_Object bottom
, top
;
1570 /* Note: I tried using markers here, but it does not win
1571 because insertion at the end of the saved region
1572 does not advance mh and is considered "outside" the saved region. */
1573 XSETFASTINT (bottom
, BEGV
- BEG
);
1574 XSETFASTINT (top
, Z
- ZV
);
1576 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
1580 save_restriction_restore (data
)
1583 register struct buffer
*buf
;
1584 register int newhead
, newtail
;
1585 register Lisp_Object tem
;
1587 buf
= XBUFFER (XCONS (data
)->car
);
1589 data
= XCONS (data
)->cdr
;
1591 tem
= XCONS (data
)->car
;
1592 newhead
= XINT (tem
);
1593 tem
= XCONS (data
)->cdr
;
1594 newtail
= XINT (tem
);
1595 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
1600 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
1601 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
1602 current_buffer
->clip_changed
= 1;
1604 /* If point is outside the new visible range, move it inside. */
1606 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
1611 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
1612 "Execute BODY, saving and restoring current buffer's restrictions.\n\
1613 The buffer's restrictions make parts of the beginning and end invisible.\n\
1614 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
1615 This special form, `save-restriction', saves the current buffer's restrictions\n\
1616 when it is entered, and restores them when it is exited.\n\
1617 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
1618 The old restrictions settings are restored\n\
1619 even in case of abnormal exit (throw or error).\n\
1621 The value returned is the value of the last form in BODY.\n\
1623 `save-restriction' can get confused if, within the BODY, you widen\n\
1624 and then make changes outside the area within the saved restrictions.\n\
1626 Note: if you are using both `save-excursion' and `save-restriction',\n\
1627 use `save-excursion' outermost:\n\
1628 (save-excursion (save-restriction ...))")
1632 register Lisp_Object val
;
1633 int count
= specpdl_ptr
- specpdl
;
1635 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1636 val
= Fprogn (body
);
1637 return unbind_to (count
, val
);
1640 /* Buffer for the most recent text displayed by Fmessage. */
1641 static char *message_text
;
1643 /* Allocated length of that buffer. */
1644 static int message_length
;
1646 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
1647 "Print a one-line message at the bottom of the screen.\n\
1648 The first argument is a format control string, and the rest are data\n\
1649 to be formatted under control of the string. See `format' for details.\n\
1651 If the first argument is nil, clear any existing message; let the\n\
1652 minibuffer contents show.")
1664 register Lisp_Object val
;
1665 val
= Fformat (nargs
, args
);
1666 /* Copy the data so that it won't move when we GC. */
1669 message_text
= (char *)xmalloc (80);
1670 message_length
= 80;
1672 if (XSTRING (val
)->size
> message_length
)
1674 message_length
= XSTRING (val
)->size
;
1675 message_text
= (char *)xrealloc (message_text
, message_length
);
1677 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1678 message2 (message_text
, XSTRING (val
)->size
);
1683 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
1684 "Display a message, in a dialog box if possible.\n\
1685 If a dialog box is not available, use the echo area.\n\
1686 The first argument is a control string.\n\
1687 It may contain %s or %d or %c to print successive following arguments.\n\
1688 %s means print an argument as a string, %d means print as number in decimal,\n\
1689 %c means print a number as a single character.\n\
1690 The argument used by %s must be a string or a symbol;\n\
1691 the argument used by %d or %c must be a number.\n\
1692 If the first argument is nil, clear any existing message; let the\n\
1693 minibuffer contents show.")
1705 register Lisp_Object val
;
1706 val
= Fformat (nargs
, args
);
1709 Lisp_Object pane
, menu
, obj
;
1710 struct gcpro gcpro1
;
1711 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
1713 menu
= Fcons (val
, pane
);
1714 obj
= Fx_popup_dialog (Qt
, menu
);
1719 /* Copy the data so that it won't move when we GC. */
1722 message_text
= (char *)xmalloc (80);
1723 message_length
= 80;
1725 if (XSTRING (val
)->size
> message_length
)
1727 message_length
= XSTRING (val
)->size
;
1728 message_text
= (char *)xrealloc (message_text
, message_length
);
1730 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1731 message2 (message_text
, XSTRING (val
)->size
);
1737 extern Lisp_Object last_nonmenu_event
;
1739 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
1740 "Display a message in a dialog box or in the echo area.\n\
1741 If this command was invoked with the mouse, use a dialog box.\n\
1742 Otherwise, use the echo area.\n\
1744 The first argument is a control string.\n\
1745 It may contain %s or %d or %c to print successive following arguments.\n\
1746 %s means print an argument as a string, %d means print as number in decimal,\n\
1747 %c means print a number as a single character.\n\
1748 The argument used by %s must be a string or a symbol;\n\
1749 the argument used by %d or %c must be a number.\n\
1750 If the first argument is nil, clear any existing message; let the\n\
1751 minibuffer contents show.")
1757 if (NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
1758 return Fmessage_box (nargs
, args
);
1760 return Fmessage (nargs
, args
);
1763 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1764 "Format a string out of a control-string and arguments.\n\
1765 The first argument is a control string.\n\
1766 The other arguments are substituted into it to make the result, a string.\n\
1767 It may contain %-sequences meaning to substitute the next argument.\n\
1768 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1769 %d means print as number in decimal (%o octal, %x hex).\n\
1770 %e means print a number in exponential notation.\n\
1771 %f means print a number in decimal-point notation.\n\
1772 %g means print a number in exponential notation\n\
1773 or decimal-point notation, whichever uses fewer characters.\n\
1774 %c means print a number as a single character.\n\
1775 %S means print any object as an s-expression (using prin1).\n\
1776 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.\n\
1777 Use %% to put a single % into the output.")
1780 register Lisp_Object
*args
;
1782 register int n
; /* The number of the next arg to substitute */
1783 register int total
= 5; /* An estimate of the final length */
1785 register unsigned char *format
, *end
;
1787 extern char *index ();
1788 /* It should not be necessary to GCPRO ARGS, because
1789 the caller in the interpreter should take care of that. */
1791 CHECK_STRING (args
[0], 0);
1792 format
= XSTRING (args
[0])->data
;
1793 end
= format
+ XSTRING (args
[0])->size
;
1796 while (format
!= end
)
1797 if (*format
++ == '%')
1801 /* Process a numeric arg and skip it. */
1802 minlen
= atoi (format
);
1807 while ((*format
>= '0' && *format
<= '9')
1808 || *format
== '-' || *format
== ' ' || *format
== '.')
1813 else if (++n
>= nargs
)
1814 error ("not enough arguments for format string");
1815 else if (*format
== 'S')
1817 /* For `S', prin1 the argument and then treat like a string. */
1818 register Lisp_Object tem
;
1819 tem
= Fprin1_to_string (args
[n
], Qnil
);
1823 else if (SYMBOLP (args
[n
]))
1825 XSETSTRING (args
[n
], XSYMBOL (args
[n
])->name
);
1828 else if (STRINGP (args
[n
]))
1831 if (*format
!= 's' && *format
!= 'S')
1832 error ("format specifier doesn't match argument type");
1833 total
+= XSTRING (args
[n
])->size
;
1835 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1836 else if (INTEGERP (args
[n
]) && *format
!= 's')
1838 #ifdef LISP_FLOAT_TYPE
1839 /* The following loop assumes the Lisp type indicates
1840 the proper way to pass the argument.
1841 So make sure we have a flonum if the argument should
1843 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1844 args
[n
] = Ffloat (args
[n
]);
1848 #ifdef LISP_FLOAT_TYPE
1849 else if (FLOATP (args
[n
]) && *format
!= 's')
1851 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1852 args
[n
] = Ftruncate (args
[n
]);
1858 /* Anything but a string, convert to a string using princ. */
1859 register Lisp_Object tem
;
1860 tem
= Fprin1_to_string (args
[n
], Qt
);
1867 register int nstrings
= n
+ 1;
1869 /* Allocate twice as many strings as we have %-escapes; floats occupy
1870 two slots, and we're not sure how many of those we have. */
1871 register unsigned char **strings
1872 = (unsigned char **) alloca (2 * nstrings
* sizeof (unsigned char *));
1876 for (n
= 0; n
< nstrings
; n
++)
1879 strings
[i
++] = (unsigned char *) "";
1880 else if (INTEGERP (args
[n
]))
1881 /* We checked above that the corresponding format effector
1882 isn't %s, which would cause MPV. */
1883 strings
[i
++] = (unsigned char *) XINT (args
[n
]);
1884 #ifdef LISP_FLOAT_TYPE
1885 else if (FLOATP (args
[n
]))
1887 union { double d
; char *half
[2]; } u
;
1889 u
.d
= XFLOAT (args
[n
])->data
;
1890 strings
[i
++] = (unsigned char *) u
.half
[0];
1891 strings
[i
++] = (unsigned char *) u
.half
[1];
1895 strings
[i
++] = XSTRING (args
[n
])->data
;
1898 /* Make room in result for all the non-%-codes in the control string. */
1899 total
+= XSTRING (args
[0])->size
;
1901 /* Format it in bigger and bigger buf's until it all fits. */
1904 buf
= (char *) alloca (total
+ 1);
1907 length
= doprnt (buf
, total
+ 1, strings
[0], end
, i
-1, strings
+ 1);
1908 if (buf
[total
- 1] == 0)
1916 return make_string (buf
, length
);
1922 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1923 EMACS_INT arg0
, arg1
, arg2
, arg3
, arg4
;
1937 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, args
);
1939 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, &string1
+ 1);
1941 return build_string (buf
);
1944 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1945 "Return t if two characters match, optionally ignoring case.\n\
1946 Both arguments must be characters (i.e. integers).\n\
1947 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1949 register Lisp_Object c1
, c2
;
1951 unsigned char *downcase
= DOWNCASE_TABLE
;
1952 CHECK_NUMBER (c1
, 0);
1953 CHECK_NUMBER (c2
, 1);
1955 if (!NILP (current_buffer
->case_fold_search
)
1956 ? (downcase
[0xff & XFASTINT (c1
)] == downcase
[0xff & XFASTINT (c2
)]
1957 && (XFASTINT (c1
) & ~0xff) == (XFASTINT (c2
) & ~0xff))
1958 : XINT (c1
) == XINT (c2
))
1963 /* Transpose the markers in two regions of the current buffer, and
1964 adjust the ones between them if necessary (i.e.: if the regions
1967 Traverses the entire marker list of the buffer to do so, adding an
1968 appropriate amount to some, subtracting from some, and leaving the
1969 rest untouched. Most of this is copied from adjust_markers in insdel.c.
1971 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
1974 transpose_markers (start1
, end1
, start2
, end2
)
1975 register int start1
, end1
, start2
, end2
;
1977 register int amt1
, amt2
, diff
, mpos
;
1978 register Lisp_Object marker
;
1980 /* Update point as if it were a marker. */
1984 TEMP_SET_PT (PT
+ (end2
- end1
));
1985 else if (PT
< start2
)
1986 TEMP_SET_PT (PT
+ (end2
- start2
) - (end1
- start1
));
1988 TEMP_SET_PT (PT
- (start2
- start1
));
1990 /* We used to adjust the endpoints here to account for the gap, but that
1991 isn't good enough. Even if we assume the caller has tried to move the
1992 gap out of our way, it might still be at start1 exactly, for example;
1993 and that places it `inside' the interval, for our purposes. The amount
1994 of adjustment is nontrivial if there's a `denormalized' marker whose
1995 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
1996 the dirty work to Fmarker_position, below. */
1998 /* The difference between the region's lengths */
1999 diff
= (end2
- start2
) - (end1
- start1
);
2001 /* For shifting each marker in a region by the length of the other
2002 * region plus the distance between the regions.
2004 amt1
= (end2
- start2
) + (start2
- end1
);
2005 amt2
= (end1
- start1
) + (start2
- end1
);
2007 for (marker
= BUF_MARKERS (current_buffer
); !NILP (marker
);
2008 marker
= XMARKER (marker
)->chain
)
2010 mpos
= Fmarker_position (marker
);
2011 if (mpos
>= start1
&& mpos
< end2
)
2015 else if (mpos
< start2
)
2019 if (mpos
> GPT
) mpos
+= GAP_SIZE
;
2020 XMARKER (marker
)->bufpos
= mpos
;
2025 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
2026 "Transpose region START1 to END1 with START2 to END2.\n\
2027 The regions may not be overlapping, because the size of the buffer is\n\
2028 never changed in a transposition.\n\
2030 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose\n\
2031 any markers that happen to be located in the regions.\n\
2033 Transposing beyond buffer boundaries is an error.")
2034 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
2035 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
2037 register int start1
, end1
, start2
, end2
,
2038 gap
, len1
, len_mid
, len2
;
2039 unsigned char *start1_addr
, *start2_addr
, *temp
;
2041 #ifdef USE_TEXT_PROPERTIES
2042 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
;
2043 cur_intv
= BUF_INTERVALS (current_buffer
);
2044 #endif /* USE_TEXT_PROPERTIES */
2046 validate_region (&startr1
, &endr1
);
2047 validate_region (&startr2
, &endr2
);
2049 start1
= XFASTINT (startr1
);
2050 end1
= XFASTINT (endr1
);
2051 start2
= XFASTINT (startr2
);
2052 end2
= XFASTINT (endr2
);
2055 /* Swap the regions if they're reversed. */
2058 register int glumph
= start1
;
2066 len1
= end1
- start1
;
2067 len2
= end2
- start2
;
2070 error ("transposed regions not properly ordered");
2071 else if (start1
== end1
|| start2
== end2
)
2072 error ("transposed region may not be of length 0");
2074 /* The possibilities are:
2075 1. Adjacent (contiguous) regions, or separate but equal regions
2076 (no, really equal, in this case!), or
2077 2. Separate regions of unequal size.
2079 The worst case is usually No. 2. It means that (aside from
2080 potential need for getting the gap out of the way), there also
2081 needs to be a shifting of the text between the two regions. So
2082 if they are spread far apart, we are that much slower... sigh. */
2084 /* It must be pointed out that the really studly thing to do would
2085 be not to move the gap at all, but to leave it in place and work
2086 around it if necessary. This would be extremely efficient,
2087 especially considering that people are likely to do
2088 transpositions near where they are working interactively, which
2089 is exactly where the gap would be found. However, such code
2090 would be much harder to write and to read. So, if you are
2091 reading this comment and are feeling squirrely, by all means have
2092 a go! I just didn't feel like doing it, so I will simply move
2093 the gap the minimum distance to get it out of the way, and then
2094 deal with an unbroken array. */
2096 /* Make sure the gap won't interfere, by moving it out of the text
2097 we will operate on. */
2098 if (start1
< gap
&& gap
< end2
)
2100 if (gap
- start1
< end2
- gap
)
2106 /* Hmmm... how about checking to see if the gap is large
2107 enough to use as the temporary storage? That would avoid an
2108 allocation... interesting. Later, don't fool with it now. */
2110 /* Working without memmove, for portability (sigh), so must be
2111 careful of overlapping subsections of the array... */
2113 if (end1
== start2
) /* adjacent regions */
2115 modify_region (current_buffer
, start1
, end2
);
2116 record_change (start1
, len1
+ len2
);
2118 #ifdef USE_TEXT_PROPERTIES
2119 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2120 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2121 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2122 #endif /* USE_TEXT_PROPERTIES */
2124 /* First region smaller than second. */
2127 /* We use alloca only if it is small,
2128 because we want to avoid stack overflow. */
2130 temp
= (unsigned char *) xmalloc (len2
);
2132 temp
= (unsigned char *) alloca (len2
);
2134 /* Don't precompute these addresses. We have to compute them
2135 at the last minute, because the relocating allocator might
2136 have moved the buffer around during the xmalloc. */
2137 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2138 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2140 bcopy (start2_addr
, temp
, len2
);
2141 bcopy (start1_addr
, start1_addr
+ len2
, len1
);
2142 bcopy (temp
, start1_addr
, len2
);
2147 /* First region not smaller than second. */
2150 temp
= (unsigned char *) xmalloc (len1
);
2152 temp
= (unsigned char *) alloca (len1
);
2153 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2154 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2155 bcopy (start1_addr
, temp
, len1
);
2156 bcopy (start2_addr
, start1_addr
, len2
);
2157 bcopy (temp
, start1_addr
+ len2
, len1
);
2161 #ifdef USE_TEXT_PROPERTIES
2162 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
2163 len1
, current_buffer
, 0);
2164 graft_intervals_into_buffer (tmp_interval2
, start1
,
2165 len2
, current_buffer
, 0);
2166 #endif /* USE_TEXT_PROPERTIES */
2168 /* Non-adjacent regions, because end1 != start2, bleagh... */
2172 /* Regions are same size, though, how nice. */
2174 modify_region (current_buffer
, start1
, end1
);
2175 modify_region (current_buffer
, start2
, end2
);
2176 record_change (start1
, len1
);
2177 record_change (start2
, len2
);
2178 #ifdef USE_TEXT_PROPERTIES
2179 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2180 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2181 Fset_text_properties (start1
, end1
, Qnil
, Qnil
);
2182 Fset_text_properties (start2
, end2
, Qnil
, Qnil
);
2183 #endif /* USE_TEXT_PROPERTIES */
2186 temp
= (unsigned char *) xmalloc (len1
);
2188 temp
= (unsigned char *) alloca (len1
);
2189 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2190 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2191 bcopy (start1_addr
, temp
, len1
);
2192 bcopy (start2_addr
, start1_addr
, len2
);
2193 bcopy (temp
, start2_addr
, len1
);
2196 #ifdef USE_TEXT_PROPERTIES
2197 graft_intervals_into_buffer (tmp_interval1
, start2
,
2198 len1
, current_buffer
, 0);
2199 graft_intervals_into_buffer (tmp_interval2
, start1
,
2200 len2
, current_buffer
, 0);
2201 #endif /* USE_TEXT_PROPERTIES */
2204 else if (len1
< len2
) /* Second region larger than first */
2205 /* Non-adjacent & unequal size, area between must also be shifted. */
2207 len_mid
= start2
- end1
;
2208 modify_region (current_buffer
, start1
, end2
);
2209 record_change (start1
, (end2
- start1
));
2210 #ifdef USE_TEXT_PROPERTIES
2211 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2212 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2213 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2214 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2215 #endif /* USE_TEXT_PROPERTIES */
2217 /* holds region 2 */
2219 temp
= (unsigned char *) xmalloc (len2
);
2221 temp
= (unsigned char *) alloca (len2
);
2222 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2223 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2224 bcopy (start2_addr
, temp
, len2
);
2225 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2
, len1
);
2226 safe_bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2227 bcopy (temp
, start1_addr
, len2
);
2230 #ifdef USE_TEXT_PROPERTIES
2231 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2232 len1
, current_buffer
, 0);
2233 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2234 len_mid
, current_buffer
, 0);
2235 graft_intervals_into_buffer (tmp_interval2
, start1
,
2236 len2
, current_buffer
, 0);
2237 #endif /* USE_TEXT_PROPERTIES */
2240 /* Second region smaller than first. */
2242 len_mid
= start2
- end1
;
2243 record_change (start1
, (end2
- start1
));
2244 modify_region (current_buffer
, start1
, end2
);
2246 #ifdef USE_TEXT_PROPERTIES
2247 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2248 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2249 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2250 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2251 #endif /* USE_TEXT_PROPERTIES */
2253 /* holds region 1 */
2255 temp
= (unsigned char *) xmalloc (len1
);
2257 temp
= (unsigned char *) alloca (len1
);
2258 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2259 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2260 bcopy (start1_addr
, temp
, len1
);
2261 bcopy (start2_addr
, start1_addr
, len2
);
2262 bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2263 bcopy (temp
, start1_addr
+ len2
+ len_mid
, len1
);
2266 #ifdef USE_TEXT_PROPERTIES
2267 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2268 len1
, current_buffer
, 0);
2269 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2270 len_mid
, current_buffer
, 0);
2271 graft_intervals_into_buffer (tmp_interval2
, start1
,
2272 len2
, current_buffer
, 0);
2273 #endif /* USE_TEXT_PROPERTIES */
2277 /* todo: this will be slow, because for every transposition, we
2278 traverse the whole friggin marker list. Possible solutions:
2279 somehow get a list of *all* the markers across multiple
2280 transpositions and do it all in one swell phoop. Or maybe modify
2281 Emacs' marker code to keep an ordered list or tree. This might
2282 be nicer, and more beneficial in the long run, but would be a
2283 bunch of work. Plus the way they're arranged now is nice. */
2284 if (NILP (leave_markers
))
2286 transpose_markers (start1
, end1
, start2
, end2
);
2287 fix_overlays_in_range (start1
, end2
);
2297 DEFVAR_LISP ("system-name", &Vsystem_name
,
2298 "The name of the machine Emacs is running on.");
2300 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
2301 "The full name of the user logged in.");
2303 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
2304 "The user's name, taken from environment variables if possible.");
2306 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
2307 "The user's name, based upon the real uid only.");
2309 defsubr (&Schar_equal
);
2310 defsubr (&Sgoto_char
);
2311 defsubr (&Sstring_to_char
);
2312 defsubr (&Schar_to_string
);
2313 defsubr (&Sbuffer_substring
);
2314 defsubr (&Sbuffer_string
);
2316 defsubr (&Spoint_marker
);
2317 defsubr (&Smark_marker
);
2319 defsubr (&Sregion_beginning
);
2320 defsubr (&Sregion_end
);
2321 /* defsubr (&Smark); */
2322 /* defsubr (&Sset_mark); */
2323 defsubr (&Ssave_excursion
);
2325 defsubr (&Sbufsize
);
2326 defsubr (&Spoint_max
);
2327 defsubr (&Spoint_min
);
2328 defsubr (&Spoint_min_marker
);
2329 defsubr (&Spoint_max_marker
);
2335 defsubr (&Sfollowing_char
);
2336 defsubr (&Sprevious_char
);
2337 defsubr (&Schar_after
);
2339 defsubr (&Sinsert_before_markers
);
2340 defsubr (&Sinsert_and_inherit
);
2341 defsubr (&Sinsert_and_inherit_before_markers
);
2342 defsubr (&Sinsert_char
);
2344 defsubr (&Suser_login_name
);
2345 defsubr (&Suser_real_login_name
);
2346 defsubr (&Suser_uid
);
2347 defsubr (&Suser_real_uid
);
2348 defsubr (&Suser_full_name
);
2349 defsubr (&Semacs_pid
);
2350 defsubr (&Scurrent_time
);
2351 defsubr (&Sformat_time_string
);
2352 defsubr (&Sdecode_time
);
2353 defsubr (&Sencode_time
);
2354 defsubr (&Scurrent_time_string
);
2355 defsubr (&Scurrent_time_zone
);
2356 defsubr (&Ssystem_name
);
2357 defsubr (&Smessage
);
2358 defsubr (&Smessage_box
);
2359 defsubr (&Smessage_or_box
);
2362 defsubr (&Sinsert_buffer_substring
);
2363 defsubr (&Scompare_buffer_substrings
);
2364 defsubr (&Ssubst_char_in_region
);
2365 defsubr (&Stranslate_region
);
2366 defsubr (&Sdelete_region
);
2368 defsubr (&Snarrow_to_region
);
2369 defsubr (&Ssave_restriction
);
2370 defsubr (&Stranspose_regions
);