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 1, 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 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
;
1381 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
1382 Ssubst_char_in_region
, 4, 5, 0,
1383 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
1384 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
1385 and don't mark the buffer as really changed.")
1386 (start
, end
, fromchar
, tochar
, noundo
)
1387 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
1389 register int pos
, stop
, look
;
1391 int count
= specpdl_ptr
- specpdl
;
1393 validate_region (&start
, &end
);
1394 CHECK_NUMBER (fromchar
, 2);
1395 CHECK_NUMBER (tochar
, 3);
1399 look
= XINT (fromchar
);
1401 /* If we don't want undo, turn off putting stuff on the list.
1402 That's faster than getting rid of things,
1403 and it prevents even the entry for a first change. */
1406 record_unwind_protect (subst_char_in_region_unwind
,
1407 current_buffer
->undo_list
);
1408 current_buffer
->undo_list
= Qt
;
1413 if (FETCH_CHAR (pos
) == look
)
1417 modify_region (current_buffer
, XINT (start
), stop
);
1419 if (! NILP (noundo
))
1421 if (MODIFF
- 1 == SAVE_MODIFF
)
1423 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
1424 current_buffer
->auto_save_modified
++;
1431 record_change (pos
, 1);
1432 FETCH_CHAR (pos
) = XINT (tochar
);
1438 signal_after_change (XINT (start
),
1439 stop
- XINT (start
), stop
- XINT (start
));
1441 unbind_to (count
, Qnil
);
1445 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
1446 "From START to END, translate characters according to TABLE.\n\
1447 TABLE is a string; the Nth character in it is the mapping\n\
1448 for the character with code N. Returns the number of characters changed.")
1452 register Lisp_Object table
;
1454 register int pos
, stop
; /* Limits of the region. */
1455 register unsigned char *tt
; /* Trans table. */
1456 register int oc
; /* Old character. */
1457 register int nc
; /* New character. */
1458 int cnt
; /* Number of changes made. */
1459 Lisp_Object z
; /* Return. */
1460 int size
; /* Size of translate table. */
1462 validate_region (&start
, &end
);
1463 CHECK_STRING (table
, 2);
1465 size
= XSTRING (table
)->size
;
1466 tt
= XSTRING (table
)->data
;
1470 modify_region (current_buffer
, pos
, stop
);
1473 for (; pos
< stop
; ++pos
)
1475 oc
= FETCH_CHAR (pos
);
1481 record_change (pos
, 1);
1482 FETCH_CHAR (pos
) = nc
;
1483 signal_after_change (pos
, 1, 1);
1489 XSETFASTINT (z
, cnt
);
1493 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
1494 "Delete the text between point and mark.\n\
1495 When called from a program, expects two arguments,\n\
1496 positions (integers or markers) specifying the stretch to be deleted.")
1500 validate_region (&b
, &e
);
1501 del_range (XINT (b
), XINT (e
));
1505 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
1506 "Remove restrictions (narrowing) from current buffer.\n\
1507 This allows the buffer's full text to be seen and edited.")
1511 SET_BUF_ZV (current_buffer
, Z
);
1513 /* Changing the buffer bounds invalidates any recorded current column. */
1514 invalidate_current_column ();
1518 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
1519 "Restrict editing in this buffer to the current region.\n\
1520 The rest of the text becomes temporarily invisible and untouchable\n\
1521 but is not deleted; if you save the buffer in a file, the invisible\n\
1522 text is included in the file. \\[widen] makes all visible again.\n\
1523 See also `save-restriction'.\n\
1525 When calling from a program, pass two arguments; positions (integers\n\
1526 or markers) bounding the text that should remain visible.")
1528 register Lisp_Object b
, e
;
1530 CHECK_NUMBER_COERCE_MARKER (b
, 0);
1531 CHECK_NUMBER_COERCE_MARKER (e
, 1);
1533 if (XINT (b
) > XINT (e
))
1536 tem
= b
; b
= e
; e
= tem
;
1539 if (!(BEG
<= XINT (b
) && XINT (b
) <= XINT (e
) && XINT (e
) <= Z
))
1540 args_out_of_range (b
, e
);
1542 BEGV
= XFASTINT (b
);
1543 SET_BUF_ZV (current_buffer
, XFASTINT (e
));
1544 if (point
< XFASTINT (b
))
1545 SET_PT (XFASTINT (b
));
1546 if (point
> XFASTINT (e
))
1547 SET_PT (XFASTINT (e
));
1549 /* Changing the buffer bounds invalidates any recorded current column. */
1550 invalidate_current_column ();
1555 save_restriction_save ()
1557 register Lisp_Object bottom
, top
;
1558 /* Note: I tried using markers here, but it does not win
1559 because insertion at the end of the saved region
1560 does not advance mh and is considered "outside" the saved region. */
1561 XSETFASTINT (bottom
, BEGV
- BEG
);
1562 XSETFASTINT (top
, Z
- ZV
);
1564 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
1568 save_restriction_restore (data
)
1571 register struct buffer
*buf
;
1572 register int newhead
, newtail
;
1573 register Lisp_Object tem
;
1575 buf
= XBUFFER (XCONS (data
)->car
);
1577 data
= XCONS (data
)->cdr
;
1579 tem
= XCONS (data
)->car
;
1580 newhead
= XINT (tem
);
1581 tem
= XCONS (data
)->cdr
;
1582 newtail
= XINT (tem
);
1583 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
1588 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
1589 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
1592 /* If point is outside the new visible range, move it inside. */
1594 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
1599 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
1600 "Execute BODY, saving and restoring current buffer's restrictions.\n\
1601 The buffer's restrictions make parts of the beginning and end invisible.\n\
1602 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
1603 This special form, `save-restriction', saves the current buffer's restrictions\n\
1604 when it is entered, and restores them when it is exited.\n\
1605 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
1606 The old restrictions settings are restored\n\
1607 even in case of abnormal exit (throw or error).\n\
1609 The value returned is the value of the last form in BODY.\n\
1611 `save-restriction' can get confused if, within the BODY, you widen\n\
1612 and then make changes outside the area within the saved restrictions.\n\
1614 Note: if you are using both `save-excursion' and `save-restriction',\n\
1615 use `save-excursion' outermost:\n\
1616 (save-excursion (save-restriction ...))")
1620 register Lisp_Object val
;
1621 int count
= specpdl_ptr
- specpdl
;
1623 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1624 val
= Fprogn (body
);
1625 return unbind_to (count
, val
);
1628 /* Buffer for the most recent text displayed by Fmessage. */
1629 static char *message_text
;
1631 /* Allocated length of that buffer. */
1632 static int message_length
;
1634 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
1635 "Print a one-line message at the bottom of the screen.\n\
1636 The first argument is a control string.\n\
1637 It may contain %s or %d or %c to print successive following arguments.\n\
1638 %s means print an argument as a string, %d means print as number in decimal,\n\
1639 %c means print a number as a single character.\n\
1640 The argument used by %s must be a string or a symbol;\n\
1641 the argument used by %d or %c must be a number.\n\
1642 If the first argument is nil, clear any existing message; let the\n\
1643 minibuffer contents show.")
1655 register Lisp_Object val
;
1656 val
= Fformat (nargs
, args
);
1657 /* Copy the data so that it won't move when we GC. */
1660 message_text
= (char *)xmalloc (80);
1661 message_length
= 80;
1663 if (XSTRING (val
)->size
> message_length
)
1665 message_length
= XSTRING (val
)->size
;
1666 message_text
= (char *)xrealloc (message_text
, message_length
);
1668 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1669 message2 (message_text
, XSTRING (val
)->size
);
1674 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
1675 "Display a message, in a dialog box if possible.\n\
1676 If a dialog box is not available, use the echo area.\n\
1677 The first argument is a control string.\n\
1678 It may contain %s or %d or %c to print successive following arguments.\n\
1679 %s means print an argument as a string, %d means print as number in decimal,\n\
1680 %c means print a number as a single character.\n\
1681 The argument used by %s must be a string or a symbol;\n\
1682 the argument used by %d or %c must be a number.\n\
1683 If the first argument is nil, clear any existing message; let the\n\
1684 minibuffer contents show.")
1696 register Lisp_Object val
;
1697 val
= Fformat (nargs
, args
);
1700 Lisp_Object pane
, menu
, obj
;
1701 struct gcpro gcpro1
;
1702 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
1704 menu
= Fcons (val
, pane
);
1705 obj
= Fx_popup_dialog (Qt
, menu
);
1710 /* Copy the data so that it won't move when we GC. */
1713 message_text
= (char *)xmalloc (80);
1714 message_length
= 80;
1716 if (XSTRING (val
)->size
> message_length
)
1718 message_length
= XSTRING (val
)->size
;
1719 message_text
= (char *)xrealloc (message_text
, message_length
);
1721 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1722 message2 (message_text
, XSTRING (val
)->size
);
1728 extern Lisp_Object last_nonmenu_event
;
1730 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
1731 "Display a message in a dialog box or in the echo area.\n\
1732 If this command was invoked with the mouse, use a dialog box.\n\
1733 Otherwise, use the echo area.\n\
1735 The first argument is a control string.\n\
1736 It may contain %s or %d or %c to print successive following arguments.\n\
1737 %s means print an argument as a string, %d means print as number in decimal,\n\
1738 %c means print a number as a single character.\n\
1739 The argument used by %s must be a string or a symbol;\n\
1740 the argument used by %d or %c must be a number.\n\
1741 If the first argument is nil, clear any existing message; let the\n\
1742 minibuffer contents show.")
1748 if (NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
1749 return Fmessage_box (nargs
, args
);
1751 return Fmessage (nargs
, args
);
1754 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1755 "Format a string out of a control-string and arguments.\n\
1756 The first argument is a control string.\n\
1757 The other arguments are substituted into it to make the result, a string.\n\
1758 It may contain %-sequences meaning to substitute the next argument.\n\
1759 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1760 %d means print as number in decimal (%o octal, %x hex).\n\
1761 %c means print a number as a single character.\n\
1762 %S means print any object as an s-expression (using prin1).\n\
1763 The argument used for %d, %o, %x or %c must be a number.\n\
1764 Use %% to put a single % into the output.")
1767 register Lisp_Object
*args
;
1769 register int n
; /* The number of the next arg to substitute */
1770 register int total
= 5; /* An estimate of the final length */
1772 register unsigned char *format
, *end
;
1774 extern char *index ();
1775 /* It should not be necessary to GCPRO ARGS, because
1776 the caller in the interpreter should take care of that. */
1778 CHECK_STRING (args
[0], 0);
1779 format
= XSTRING (args
[0])->data
;
1780 end
= format
+ XSTRING (args
[0])->size
;
1783 while (format
!= end
)
1784 if (*format
++ == '%')
1788 /* Process a numeric arg and skip it. */
1789 minlen
= atoi (format
);
1794 while ((*format
>= '0' && *format
<= '9')
1795 || *format
== '-' || *format
== ' ' || *format
== '.')
1800 else if (++n
>= nargs
)
1801 error ("not enough arguments for format string");
1802 else if (*format
== 'S')
1804 /* For `S', prin1 the argument and then treat like a string. */
1805 register Lisp_Object tem
;
1806 tem
= Fprin1_to_string (args
[n
], Qnil
);
1810 else if (SYMBOLP (args
[n
]))
1812 XSETSTRING (args
[n
], XSYMBOL (args
[n
])->name
);
1815 else if (STRINGP (args
[n
]))
1818 if (*format
!= 's' && *format
!= 'S')
1819 error ("format specifier doesn't match argument type");
1820 total
+= XSTRING (args
[n
])->size
;
1822 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1823 else if (INTEGERP (args
[n
]) && *format
!= 's')
1825 #ifdef LISP_FLOAT_TYPE
1826 /* The following loop assumes the Lisp type indicates
1827 the proper way to pass the argument.
1828 So make sure we have a flonum if the argument should
1830 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1831 args
[n
] = Ffloat (args
[n
]);
1835 #ifdef LISP_FLOAT_TYPE
1836 else if (FLOATP (args
[n
]) && *format
!= 's')
1838 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1839 args
[n
] = Ftruncate (args
[n
]);
1845 /* Anything but a string, convert to a string using princ. */
1846 register Lisp_Object tem
;
1847 tem
= Fprin1_to_string (args
[n
], Qt
);
1854 register int nstrings
= n
+ 1;
1856 /* Allocate twice as many strings as we have %-escapes; floats occupy
1857 two slots, and we're not sure how many of those we have. */
1858 register unsigned char **strings
1859 = (unsigned char **) alloca (2 * nstrings
* sizeof (unsigned char *));
1863 for (n
= 0; n
< nstrings
; n
++)
1866 strings
[i
++] = (unsigned char *) "";
1867 else if (INTEGERP (args
[n
]))
1868 /* We checked above that the corresponding format effector
1869 isn't %s, which would cause MPV. */
1870 strings
[i
++] = (unsigned char *) XINT (args
[n
]);
1871 #ifdef LISP_FLOAT_TYPE
1872 else if (FLOATP (args
[n
]))
1874 union { double d
; char *half
[2]; } u
;
1876 u
.d
= XFLOAT (args
[n
])->data
;
1877 strings
[i
++] = (unsigned char *) u
.half
[0];
1878 strings
[i
++] = (unsigned char *) u
.half
[1];
1882 strings
[i
++] = XSTRING (args
[n
])->data
;
1885 /* Format it in bigger and bigger buf's until it all fits. */
1888 buf
= (char *) alloca (total
+ 1);
1891 length
= doprnt (buf
, total
+ 1, strings
[0], end
, i
-1, strings
+ 1);
1892 if (buf
[total
- 1] == 0)
1900 return make_string (buf
, length
);
1906 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1907 EMACS_INT arg0
, arg1
, arg2
, arg3
, arg4
;
1921 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, args
);
1923 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, &string1
+ 1);
1925 return build_string (buf
);
1928 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1929 "Return t if two characters match, optionally ignoring case.\n\
1930 Both arguments must be characters (i.e. integers).\n\
1931 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1933 register Lisp_Object c1
, c2
;
1935 unsigned char *downcase
= DOWNCASE_TABLE
;
1936 CHECK_NUMBER (c1
, 0);
1937 CHECK_NUMBER (c2
, 1);
1939 if (!NILP (current_buffer
->case_fold_search
)
1940 ? (downcase
[0xff & XFASTINT (c1
)] == downcase
[0xff & XFASTINT (c2
)]
1941 && (XFASTINT (c1
) & ~0xff) == (XFASTINT (c2
) & ~0xff))
1942 : XINT (c1
) == XINT (c2
))
1947 /* Transpose the markers in two regions of the current buffer, and
1948 adjust the ones between them if necessary (i.e.: if the regions
1951 Traverses the entire marker list of the buffer to do so, adding an
1952 appropriate amount to some, subtracting from some, and leaving the
1953 rest untouched. Most of this is copied from adjust_markers in insdel.c.
1955 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
1958 transpose_markers (start1
, end1
, start2
, end2
)
1959 register int start1
, end1
, start2
, end2
;
1961 register int amt1
, amt2
, diff
, mpos
;
1962 register Lisp_Object marker
;
1964 /* Update point as if it were a marker. */
1968 TEMP_SET_PT (PT
+ (end2
- end1
));
1969 else if (PT
< start2
)
1970 TEMP_SET_PT (PT
+ (end2
- start2
) - (end1
- start1
));
1972 TEMP_SET_PT (PT
- (start2
- start1
));
1974 /* We used to adjust the endpoints here to account for the gap, but that
1975 isn't good enough. Even if we assume the caller has tried to move the
1976 gap out of our way, it might still be at start1 exactly, for example;
1977 and that places it `inside' the interval, for our purposes. The amount
1978 of adjustment is nontrivial if there's a `denormalized' marker whose
1979 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
1980 the dirty work to Fmarker_position, below. */
1982 /* The difference between the region's lengths */
1983 diff
= (end2
- start2
) - (end1
- start1
);
1985 /* For shifting each marker in a region by the length of the other
1986 * region plus the distance between the regions.
1988 amt1
= (end2
- start2
) + (start2
- end1
);
1989 amt2
= (end1
- start1
) + (start2
- end1
);
1991 for (marker
= BUF_MARKERS (current_buffer
); !NILP (marker
);
1992 marker
= XMARKER (marker
)->chain
)
1994 mpos
= Fmarker_position (marker
);
1995 if (mpos
>= start1
&& mpos
< end2
)
1999 else if (mpos
< start2
)
2003 if (mpos
> GPT
) mpos
+= GAP_SIZE
;
2004 XMARKER (marker
)->bufpos
= mpos
;
2009 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
2010 "Transpose region START1 to END1 with START2 to END2.\n\
2011 The regions may not be overlapping, because the size of the buffer is\n\
2012 never changed in a transposition.\n\
2014 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose\n\
2015 any markers that happen to be located in the regions.\n\
2017 Transposing beyond buffer boundaries is an error.")
2018 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
2019 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
2021 register int start1
, end1
, start2
, end2
,
2022 gap
, len1
, len_mid
, len2
;
2023 unsigned char *start1_addr
, *start2_addr
, *temp
;
2025 #ifdef USE_TEXT_PROPERTIES
2026 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
;
2027 cur_intv
= BUF_INTERVALS (current_buffer
);
2028 #endif /* USE_TEXT_PROPERTIES */
2030 validate_region (&startr1
, &endr1
);
2031 validate_region (&startr2
, &endr2
);
2033 start1
= XFASTINT (startr1
);
2034 end1
= XFASTINT (endr1
);
2035 start2
= XFASTINT (startr2
);
2036 end2
= XFASTINT (endr2
);
2039 /* Swap the regions if they're reversed. */
2042 register int glumph
= start1
;
2050 len1
= end1
- start1
;
2051 len2
= end2
- start2
;
2054 error ("transposed regions not properly ordered");
2055 else if (start1
== end1
|| start2
== end2
)
2056 error ("transposed region may not be of length 0");
2058 /* The possibilities are:
2059 1. Adjacent (contiguous) regions, or separate but equal regions
2060 (no, really equal, in this case!), or
2061 2. Separate regions of unequal size.
2063 The worst case is usually No. 2. It means that (aside from
2064 potential need for getting the gap out of the way), there also
2065 needs to be a shifting of the text between the two regions. So
2066 if they are spread far apart, we are that much slower... sigh. */
2068 /* It must be pointed out that the really studly thing to do would
2069 be not to move the gap at all, but to leave it in place and work
2070 around it if necessary. This would be extremely efficient,
2071 especially considering that people are likely to do
2072 transpositions near where they are working interactively, which
2073 is exactly where the gap would be found. However, such code
2074 would be much harder to write and to read. So, if you are
2075 reading this comment and are feeling squirrely, by all means have
2076 a go! I just didn't feel like doing it, so I will simply move
2077 the gap the minimum distance to get it out of the way, and then
2078 deal with an unbroken array. */
2080 /* Make sure the gap won't interfere, by moving it out of the text
2081 we will operate on. */
2082 if (start1
< gap
&& gap
< end2
)
2084 if (gap
- start1
< end2
- gap
)
2090 /* Hmmm... how about checking to see if the gap is large
2091 enough to use as the temporary storage? That would avoid an
2092 allocation... interesting. Later, don't fool with it now. */
2094 /* Working without memmove, for portability (sigh), so must be
2095 careful of overlapping subsections of the array... */
2097 if (end1
== start2
) /* adjacent regions */
2099 modify_region (current_buffer
, start1
, end2
);
2100 record_change (start1
, len1
+ len2
);
2102 #ifdef USE_TEXT_PROPERTIES
2103 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2104 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2105 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2106 #endif /* USE_TEXT_PROPERTIES */
2108 /* First region smaller than second. */
2111 /* We use alloca only if it is small,
2112 because we want to avoid stack overflow. */
2114 temp
= (unsigned char *) xmalloc (len2
);
2116 temp
= (unsigned char *) alloca (len2
);
2118 /* Don't precompute these addresses. We have to compute them
2119 at the last minute, because the relocating allocator might
2120 have moved the buffer around during the xmalloc. */
2121 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2122 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2124 bcopy (start2_addr
, temp
, len2
);
2125 bcopy (start1_addr
, start1_addr
+ len2
, len1
);
2126 bcopy (temp
, start1_addr
, len2
);
2131 /* First region not smaller than second. */
2134 temp
= (unsigned char *) xmalloc (len1
);
2136 temp
= (unsigned char *) alloca (len1
);
2137 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2138 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2139 bcopy (start1_addr
, temp
, len1
);
2140 bcopy (start2_addr
, start1_addr
, len2
);
2141 bcopy (temp
, start1_addr
+ len2
, len1
);
2145 #ifdef USE_TEXT_PROPERTIES
2146 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
2147 len1
, current_buffer
, 0);
2148 graft_intervals_into_buffer (tmp_interval2
, start1
,
2149 len2
, current_buffer
, 0);
2150 #endif /* USE_TEXT_PROPERTIES */
2152 /* Non-adjacent regions, because end1 != start2, bleagh... */
2156 /* Regions are same size, though, how nice. */
2158 modify_region (current_buffer
, start1
, end1
);
2159 modify_region (current_buffer
, start2
, end2
);
2160 record_change (start1
, len1
);
2161 record_change (start2
, len2
);
2162 #ifdef USE_TEXT_PROPERTIES
2163 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2164 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2165 Fset_text_properties (start1
, end1
, Qnil
, Qnil
);
2166 Fset_text_properties (start2
, end2
, Qnil
, Qnil
);
2167 #endif /* USE_TEXT_PROPERTIES */
2170 temp
= (unsigned char *) xmalloc (len1
);
2172 temp
= (unsigned char *) alloca (len1
);
2173 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2174 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2175 bcopy (start1_addr
, temp
, len1
);
2176 bcopy (start2_addr
, start1_addr
, len2
);
2177 bcopy (temp
, start2_addr
, len1
);
2180 #ifdef USE_TEXT_PROPERTIES
2181 graft_intervals_into_buffer (tmp_interval1
, start2
,
2182 len1
, current_buffer
, 0);
2183 graft_intervals_into_buffer (tmp_interval2
, start1
,
2184 len2
, current_buffer
, 0);
2185 #endif /* USE_TEXT_PROPERTIES */
2188 else if (len1
< len2
) /* Second region larger than first */
2189 /* Non-adjacent & unequal size, area between must also be shifted. */
2191 len_mid
= start2
- end1
;
2192 modify_region (current_buffer
, start1
, end2
);
2193 record_change (start1
, (end2
- start1
));
2194 #ifdef USE_TEXT_PROPERTIES
2195 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2196 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2197 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2198 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2199 #endif /* USE_TEXT_PROPERTIES */
2201 /* holds region 2 */
2203 temp
= (unsigned char *) xmalloc (len2
);
2205 temp
= (unsigned char *) alloca (len2
);
2206 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2207 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2208 bcopy (start2_addr
, temp
, len2
);
2209 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2
, len1
);
2210 safe_bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2211 bcopy (temp
, start1_addr
, len2
);
2214 #ifdef USE_TEXT_PROPERTIES
2215 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2216 len1
, current_buffer
, 0);
2217 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2218 len_mid
, current_buffer
, 0);
2219 graft_intervals_into_buffer (tmp_interval2
, start1
,
2220 len2
, current_buffer
, 0);
2221 #endif /* USE_TEXT_PROPERTIES */
2224 /* Second region smaller than first. */
2226 len_mid
= start2
- end1
;
2227 record_change (start1
, (end2
- start1
));
2228 modify_region (current_buffer
, start1
, end2
);
2230 #ifdef USE_TEXT_PROPERTIES
2231 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2232 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2233 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2234 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2235 #endif /* USE_TEXT_PROPERTIES */
2237 /* holds region 1 */
2239 temp
= (unsigned char *) xmalloc (len1
);
2241 temp
= (unsigned char *) alloca (len1
);
2242 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2243 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2244 bcopy (start1_addr
, temp
, len1
);
2245 bcopy (start2_addr
, start1_addr
, len2
);
2246 bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2247 bcopy (temp
, start1_addr
+ len2
+ len_mid
, len1
);
2250 #ifdef USE_TEXT_PROPERTIES
2251 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2252 len1
, current_buffer
, 0);
2253 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2254 len_mid
, current_buffer
, 0);
2255 graft_intervals_into_buffer (tmp_interval2
, start1
,
2256 len2
, current_buffer
, 0);
2257 #endif /* USE_TEXT_PROPERTIES */
2261 /* todo: this will be slow, because for every transposition, we
2262 traverse the whole friggin marker list. Possible solutions:
2263 somehow get a list of *all* the markers across multiple
2264 transpositions and do it all in one swell phoop. Or maybe modify
2265 Emacs' marker code to keep an ordered list or tree. This might
2266 be nicer, and more beneficial in the long run, but would be a
2267 bunch of work. Plus the way they're arranged now is nice. */
2268 if (NILP (leave_markers
))
2270 transpose_markers (start1
, end1
, start2
, end2
);
2271 fix_overlays_in_range (start1
, end2
);
2281 DEFVAR_LISP ("system-name", &Vsystem_name
,
2282 "The name of the machine Emacs is running on.");
2284 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
2285 "The full name of the user logged in.");
2287 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
2288 "The user's name, taken from environment variables if possible.");
2290 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
2291 "The user's name, based upon the real uid only.");
2293 defsubr (&Schar_equal
);
2294 defsubr (&Sgoto_char
);
2295 defsubr (&Sstring_to_char
);
2296 defsubr (&Schar_to_string
);
2297 defsubr (&Sbuffer_substring
);
2298 defsubr (&Sbuffer_string
);
2300 defsubr (&Spoint_marker
);
2301 defsubr (&Smark_marker
);
2303 defsubr (&Sregion_beginning
);
2304 defsubr (&Sregion_end
);
2305 /* defsubr (&Smark); */
2306 /* defsubr (&Sset_mark); */
2307 defsubr (&Ssave_excursion
);
2309 defsubr (&Sbufsize
);
2310 defsubr (&Spoint_max
);
2311 defsubr (&Spoint_min
);
2312 defsubr (&Spoint_min_marker
);
2313 defsubr (&Spoint_max_marker
);
2319 defsubr (&Sfollowing_char
);
2320 defsubr (&Sprevious_char
);
2321 defsubr (&Schar_after
);
2323 defsubr (&Sinsert_before_markers
);
2324 defsubr (&Sinsert_and_inherit
);
2325 defsubr (&Sinsert_and_inherit_before_markers
);
2326 defsubr (&Sinsert_char
);
2328 defsubr (&Suser_login_name
);
2329 defsubr (&Suser_real_login_name
);
2330 defsubr (&Suser_uid
);
2331 defsubr (&Suser_real_uid
);
2332 defsubr (&Suser_full_name
);
2333 defsubr (&Semacs_pid
);
2334 defsubr (&Scurrent_time
);
2335 defsubr (&Sformat_time_string
);
2336 defsubr (&Sdecode_time
);
2337 defsubr (&Sencode_time
);
2338 defsubr (&Scurrent_time_string
);
2339 defsubr (&Scurrent_time_zone
);
2340 defsubr (&Ssystem_name
);
2341 defsubr (&Smessage
);
2342 defsubr (&Smessage_box
);
2343 defsubr (&Smessage_or_box
);
2346 defsubr (&Sinsert_buffer_substring
);
2347 defsubr (&Scompare_buffer_substrings
);
2348 defsubr (&Ssubst_char_in_region
);
2349 defsubr (&Stranslate_region
);
2350 defsubr (&Sdelete_region
);
2352 defsubr (&Snarrow_to_region
);
2353 defsubr (&Ssave_restriction
);
2354 defsubr (&Stranspose_regions
);