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
;
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
);
1512 current_buffer
->clip_changed
= 1;
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
));
1548 current_buffer
->clip_changed
= 1;
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
);
1590 current_buffer
->clip_changed
= 1;
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 format control string, and the rest are data\n\
1637 to be formatted under control of the string. See `format' for details.\n\
1639 If the first argument is nil, clear any existing message; let the\n\
1640 minibuffer contents show.")
1652 register Lisp_Object val
;
1653 val
= Fformat (nargs
, args
);
1654 /* Copy the data so that it won't move when we GC. */
1657 message_text
= (char *)xmalloc (80);
1658 message_length
= 80;
1660 if (XSTRING (val
)->size
> message_length
)
1662 message_length
= XSTRING (val
)->size
;
1663 message_text
= (char *)xrealloc (message_text
, message_length
);
1665 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1666 message2 (message_text
, XSTRING (val
)->size
);
1671 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
1672 "Display a message, in a dialog box if possible.\n\
1673 If a dialog box is not available, use the echo area.\n\
1674 The first argument is a control string.\n\
1675 It may contain %s or %d or %c to print successive following arguments.\n\
1676 %s means print an argument as a string, %d means print as number in decimal,\n\
1677 %c means print a number as a single character.\n\
1678 The argument used by %s must be a string or a symbol;\n\
1679 the argument used by %d or %c must be a number.\n\
1680 If the first argument is nil, clear any existing message; let the\n\
1681 minibuffer contents show.")
1693 register Lisp_Object val
;
1694 val
= Fformat (nargs
, args
);
1697 Lisp_Object pane
, menu
, obj
;
1698 struct gcpro gcpro1
;
1699 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
1701 menu
= Fcons (val
, pane
);
1702 obj
= Fx_popup_dialog (Qt
, menu
);
1707 /* Copy the data so that it won't move when we GC. */
1710 message_text
= (char *)xmalloc (80);
1711 message_length
= 80;
1713 if (XSTRING (val
)->size
> message_length
)
1715 message_length
= XSTRING (val
)->size
;
1716 message_text
= (char *)xrealloc (message_text
, message_length
);
1718 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1719 message2 (message_text
, XSTRING (val
)->size
);
1725 extern Lisp_Object last_nonmenu_event
;
1727 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
1728 "Display a message in a dialog box or in the echo area.\n\
1729 If this command was invoked with the mouse, use a dialog box.\n\
1730 Otherwise, use the echo area.\n\
1732 The first argument is a control string.\n\
1733 It may contain %s or %d or %c to print successive following arguments.\n\
1734 %s means print an argument as a string, %d means print as number in decimal,\n\
1735 %c means print a number as a single character.\n\
1736 The argument used by %s must be a string or a symbol;\n\
1737 the argument used by %d or %c must be a number.\n\
1738 If the first argument is nil, clear any existing message; let the\n\
1739 minibuffer contents show.")
1745 if (NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
1746 return Fmessage_box (nargs
, args
);
1748 return Fmessage (nargs
, args
);
1751 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1752 "Format a string out of a control-string and arguments.\n\
1753 The first argument is a control string.\n\
1754 The other arguments are substituted into it to make the result, a string.\n\
1755 It may contain %-sequences meaning to substitute the next argument.\n\
1756 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1757 %d means print as number in decimal (%o octal, %x hex).\n\
1758 %c means print a number as a single character.\n\
1759 %S means print any object as an s-expression (using prin1).\n\
1760 The argument used for %d, %o, %x or %c must be a number.\n\
1761 Use %% to put a single % into the output.")
1764 register Lisp_Object
*args
;
1766 register int n
; /* The number of the next arg to substitute */
1767 register int total
= 5; /* An estimate of the final length */
1769 register unsigned char *format
, *end
;
1771 extern char *index ();
1772 /* It should not be necessary to GCPRO ARGS, because
1773 the caller in the interpreter should take care of that. */
1775 CHECK_STRING (args
[0], 0);
1776 format
= XSTRING (args
[0])->data
;
1777 end
= format
+ XSTRING (args
[0])->size
;
1780 while (format
!= end
)
1781 if (*format
++ == '%')
1785 /* Process a numeric arg and skip it. */
1786 minlen
= atoi (format
);
1791 while ((*format
>= '0' && *format
<= '9')
1792 || *format
== '-' || *format
== ' ' || *format
== '.')
1797 else if (++n
>= nargs
)
1798 error ("not enough arguments for format string");
1799 else if (*format
== 'S')
1801 /* For `S', prin1 the argument and then treat like a string. */
1802 register Lisp_Object tem
;
1803 tem
= Fprin1_to_string (args
[n
], Qnil
);
1807 else if (SYMBOLP (args
[n
]))
1809 XSETSTRING (args
[n
], XSYMBOL (args
[n
])->name
);
1812 else if (STRINGP (args
[n
]))
1815 if (*format
!= 's' && *format
!= 'S')
1816 error ("format specifier doesn't match argument type");
1817 total
+= XSTRING (args
[n
])->size
;
1819 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1820 else if (INTEGERP (args
[n
]) && *format
!= 's')
1822 #ifdef LISP_FLOAT_TYPE
1823 /* The following loop assumes the Lisp type indicates
1824 the proper way to pass the argument.
1825 So make sure we have a flonum if the argument should
1827 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1828 args
[n
] = Ffloat (args
[n
]);
1832 #ifdef LISP_FLOAT_TYPE
1833 else if (FLOATP (args
[n
]) && *format
!= 's')
1835 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1836 args
[n
] = Ftruncate (args
[n
]);
1842 /* Anything but a string, convert to a string using princ. */
1843 register Lisp_Object tem
;
1844 tem
= Fprin1_to_string (args
[n
], Qt
);
1851 register int nstrings
= n
+ 1;
1853 /* Allocate twice as many strings as we have %-escapes; floats occupy
1854 two slots, and we're not sure how many of those we have. */
1855 register unsigned char **strings
1856 = (unsigned char **) alloca (2 * nstrings
* sizeof (unsigned char *));
1860 for (n
= 0; n
< nstrings
; n
++)
1863 strings
[i
++] = (unsigned char *) "";
1864 else if (INTEGERP (args
[n
]))
1865 /* We checked above that the corresponding format effector
1866 isn't %s, which would cause MPV. */
1867 strings
[i
++] = (unsigned char *) XINT (args
[n
]);
1868 #ifdef LISP_FLOAT_TYPE
1869 else if (FLOATP (args
[n
]))
1871 union { double d
; char *half
[2]; } u
;
1873 u
.d
= XFLOAT (args
[n
])->data
;
1874 strings
[i
++] = (unsigned char *) u
.half
[0];
1875 strings
[i
++] = (unsigned char *) u
.half
[1];
1879 strings
[i
++] = XSTRING (args
[n
])->data
;
1882 /* Format it in bigger and bigger buf's until it all fits. */
1885 buf
= (char *) alloca (total
+ 1);
1888 length
= doprnt (buf
, total
+ 1, strings
[0], end
, i
-1, strings
+ 1);
1889 if (buf
[total
- 1] == 0)
1897 return make_string (buf
, length
);
1903 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1904 EMACS_INT arg0
, arg1
, arg2
, arg3
, arg4
;
1918 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, args
);
1920 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, &string1
+ 1);
1922 return build_string (buf
);
1925 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1926 "Return t if two characters match, optionally ignoring case.\n\
1927 Both arguments must be characters (i.e. integers).\n\
1928 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1930 register Lisp_Object c1
, c2
;
1932 unsigned char *downcase
= DOWNCASE_TABLE
;
1933 CHECK_NUMBER (c1
, 0);
1934 CHECK_NUMBER (c2
, 1);
1936 if (!NILP (current_buffer
->case_fold_search
)
1937 ? (downcase
[0xff & XFASTINT (c1
)] == downcase
[0xff & XFASTINT (c2
)]
1938 && (XFASTINT (c1
) & ~0xff) == (XFASTINT (c2
) & ~0xff))
1939 : XINT (c1
) == XINT (c2
))
1944 /* Transpose the markers in two regions of the current buffer, and
1945 adjust the ones between them if necessary (i.e.: if the regions
1948 Traverses the entire marker list of the buffer to do so, adding an
1949 appropriate amount to some, subtracting from some, and leaving the
1950 rest untouched. Most of this is copied from adjust_markers in insdel.c.
1952 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
1955 transpose_markers (start1
, end1
, start2
, end2
)
1956 register int start1
, end1
, start2
, end2
;
1958 register int amt1
, amt2
, diff
, mpos
;
1959 register Lisp_Object marker
;
1961 /* Update point as if it were a marker. */
1965 TEMP_SET_PT (PT
+ (end2
- end1
));
1966 else if (PT
< start2
)
1967 TEMP_SET_PT (PT
+ (end2
- start2
) - (end1
- start1
));
1969 TEMP_SET_PT (PT
- (start2
- start1
));
1971 /* We used to adjust the endpoints here to account for the gap, but that
1972 isn't good enough. Even if we assume the caller has tried to move the
1973 gap out of our way, it might still be at start1 exactly, for example;
1974 and that places it `inside' the interval, for our purposes. The amount
1975 of adjustment is nontrivial if there's a `denormalized' marker whose
1976 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
1977 the dirty work to Fmarker_position, below. */
1979 /* The difference between the region's lengths */
1980 diff
= (end2
- start2
) - (end1
- start1
);
1982 /* For shifting each marker in a region by the length of the other
1983 * region plus the distance between the regions.
1985 amt1
= (end2
- start2
) + (start2
- end1
);
1986 amt2
= (end1
- start1
) + (start2
- end1
);
1988 for (marker
= BUF_MARKERS (current_buffer
); !NILP (marker
);
1989 marker
= XMARKER (marker
)->chain
)
1991 mpos
= Fmarker_position (marker
);
1992 if (mpos
>= start1
&& mpos
< end2
)
1996 else if (mpos
< start2
)
2000 if (mpos
> GPT
) mpos
+= GAP_SIZE
;
2001 XMARKER (marker
)->bufpos
= mpos
;
2006 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
2007 "Transpose region START1 to END1 with START2 to END2.\n\
2008 The regions may not be overlapping, because the size of the buffer is\n\
2009 never changed in a transposition.\n\
2011 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose\n\
2012 any markers that happen to be located in the regions.\n\
2014 Transposing beyond buffer boundaries is an error.")
2015 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
2016 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
2018 register int start1
, end1
, start2
, end2
,
2019 gap
, len1
, len_mid
, len2
;
2020 unsigned char *start1_addr
, *start2_addr
, *temp
;
2022 #ifdef USE_TEXT_PROPERTIES
2023 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
;
2024 cur_intv
= BUF_INTERVALS (current_buffer
);
2025 #endif /* USE_TEXT_PROPERTIES */
2027 validate_region (&startr1
, &endr1
);
2028 validate_region (&startr2
, &endr2
);
2030 start1
= XFASTINT (startr1
);
2031 end1
= XFASTINT (endr1
);
2032 start2
= XFASTINT (startr2
);
2033 end2
= XFASTINT (endr2
);
2036 /* Swap the regions if they're reversed. */
2039 register int glumph
= start1
;
2047 len1
= end1
- start1
;
2048 len2
= end2
- start2
;
2051 error ("transposed regions not properly ordered");
2052 else if (start1
== end1
|| start2
== end2
)
2053 error ("transposed region may not be of length 0");
2055 /* The possibilities are:
2056 1. Adjacent (contiguous) regions, or separate but equal regions
2057 (no, really equal, in this case!), or
2058 2. Separate regions of unequal size.
2060 The worst case is usually No. 2. It means that (aside from
2061 potential need for getting the gap out of the way), there also
2062 needs to be a shifting of the text between the two regions. So
2063 if they are spread far apart, we are that much slower... sigh. */
2065 /* It must be pointed out that the really studly thing to do would
2066 be not to move the gap at all, but to leave it in place and work
2067 around it if necessary. This would be extremely efficient,
2068 especially considering that people are likely to do
2069 transpositions near where they are working interactively, which
2070 is exactly where the gap would be found. However, such code
2071 would be much harder to write and to read. So, if you are
2072 reading this comment and are feeling squirrely, by all means have
2073 a go! I just didn't feel like doing it, so I will simply move
2074 the gap the minimum distance to get it out of the way, and then
2075 deal with an unbroken array. */
2077 /* Make sure the gap won't interfere, by moving it out of the text
2078 we will operate on. */
2079 if (start1
< gap
&& gap
< end2
)
2081 if (gap
- start1
< end2
- gap
)
2087 /* Hmmm... how about checking to see if the gap is large
2088 enough to use as the temporary storage? That would avoid an
2089 allocation... interesting. Later, don't fool with it now. */
2091 /* Working without memmove, for portability (sigh), so must be
2092 careful of overlapping subsections of the array... */
2094 if (end1
== start2
) /* adjacent regions */
2096 modify_region (current_buffer
, start1
, end2
);
2097 record_change (start1
, len1
+ len2
);
2099 #ifdef USE_TEXT_PROPERTIES
2100 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2101 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2102 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2103 #endif /* USE_TEXT_PROPERTIES */
2105 /* First region smaller than second. */
2108 /* We use alloca only if it is small,
2109 because we want to avoid stack overflow. */
2111 temp
= (unsigned char *) xmalloc (len2
);
2113 temp
= (unsigned char *) alloca (len2
);
2115 /* Don't precompute these addresses. We have to compute them
2116 at the last minute, because the relocating allocator might
2117 have moved the buffer around during the xmalloc. */
2118 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2119 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2121 bcopy (start2_addr
, temp
, len2
);
2122 bcopy (start1_addr
, start1_addr
+ len2
, len1
);
2123 bcopy (temp
, start1_addr
, len2
);
2128 /* First region not smaller than second. */
2131 temp
= (unsigned char *) xmalloc (len1
);
2133 temp
= (unsigned char *) alloca (len1
);
2134 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2135 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2136 bcopy (start1_addr
, temp
, len1
);
2137 bcopy (start2_addr
, start1_addr
, len2
);
2138 bcopy (temp
, start1_addr
+ len2
, len1
);
2142 #ifdef USE_TEXT_PROPERTIES
2143 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
2144 len1
, current_buffer
, 0);
2145 graft_intervals_into_buffer (tmp_interval2
, start1
,
2146 len2
, current_buffer
, 0);
2147 #endif /* USE_TEXT_PROPERTIES */
2149 /* Non-adjacent regions, because end1 != start2, bleagh... */
2153 /* Regions are same size, though, how nice. */
2155 modify_region (current_buffer
, start1
, end1
);
2156 modify_region (current_buffer
, start2
, end2
);
2157 record_change (start1
, len1
);
2158 record_change (start2
, len2
);
2159 #ifdef USE_TEXT_PROPERTIES
2160 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2161 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2162 Fset_text_properties (start1
, end1
, Qnil
, Qnil
);
2163 Fset_text_properties (start2
, end2
, Qnil
, Qnil
);
2164 #endif /* USE_TEXT_PROPERTIES */
2167 temp
= (unsigned char *) xmalloc (len1
);
2169 temp
= (unsigned char *) alloca (len1
);
2170 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2171 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2172 bcopy (start1_addr
, temp
, len1
);
2173 bcopy (start2_addr
, start1_addr
, len2
);
2174 bcopy (temp
, start2_addr
, len1
);
2177 #ifdef USE_TEXT_PROPERTIES
2178 graft_intervals_into_buffer (tmp_interval1
, start2
,
2179 len1
, current_buffer
, 0);
2180 graft_intervals_into_buffer (tmp_interval2
, start1
,
2181 len2
, current_buffer
, 0);
2182 #endif /* USE_TEXT_PROPERTIES */
2185 else if (len1
< len2
) /* Second region larger than first */
2186 /* Non-adjacent & unequal size, area between must also be shifted. */
2188 len_mid
= start2
- end1
;
2189 modify_region (current_buffer
, start1
, end2
);
2190 record_change (start1
, (end2
- start1
));
2191 #ifdef USE_TEXT_PROPERTIES
2192 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2193 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2194 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2195 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2196 #endif /* USE_TEXT_PROPERTIES */
2198 /* holds region 2 */
2200 temp
= (unsigned char *) xmalloc (len2
);
2202 temp
= (unsigned char *) alloca (len2
);
2203 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2204 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2205 bcopy (start2_addr
, temp
, len2
);
2206 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2
, len1
);
2207 safe_bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2208 bcopy (temp
, start1_addr
, len2
);
2211 #ifdef USE_TEXT_PROPERTIES
2212 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2213 len1
, current_buffer
, 0);
2214 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2215 len_mid
, current_buffer
, 0);
2216 graft_intervals_into_buffer (tmp_interval2
, start1
,
2217 len2
, current_buffer
, 0);
2218 #endif /* USE_TEXT_PROPERTIES */
2221 /* Second region smaller than first. */
2223 len_mid
= start2
- end1
;
2224 record_change (start1
, (end2
- start1
));
2225 modify_region (current_buffer
, start1
, end2
);
2227 #ifdef USE_TEXT_PROPERTIES
2228 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2229 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2230 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2231 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2232 #endif /* USE_TEXT_PROPERTIES */
2234 /* holds region 1 */
2236 temp
= (unsigned char *) xmalloc (len1
);
2238 temp
= (unsigned char *) alloca (len1
);
2239 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2240 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2241 bcopy (start1_addr
, temp
, len1
);
2242 bcopy (start2_addr
, start1_addr
, len2
);
2243 bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2244 bcopy (temp
, start1_addr
+ len2
+ len_mid
, len1
);
2247 #ifdef USE_TEXT_PROPERTIES
2248 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2249 len1
, current_buffer
, 0);
2250 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2251 len_mid
, current_buffer
, 0);
2252 graft_intervals_into_buffer (tmp_interval2
, start1
,
2253 len2
, current_buffer
, 0);
2254 #endif /* USE_TEXT_PROPERTIES */
2258 /* todo: this will be slow, because for every transposition, we
2259 traverse the whole friggin marker list. Possible solutions:
2260 somehow get a list of *all* the markers across multiple
2261 transpositions and do it all in one swell phoop. Or maybe modify
2262 Emacs' marker code to keep an ordered list or tree. This might
2263 be nicer, and more beneficial in the long run, but would be a
2264 bunch of work. Plus the way they're arranged now is nice. */
2265 if (NILP (leave_markers
))
2267 transpose_markers (start1
, end1
, start2
, end2
);
2268 fix_overlays_in_range (start1
, end2
);
2278 DEFVAR_LISP ("system-name", &Vsystem_name
,
2279 "The name of the machine Emacs is running on.");
2281 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
2282 "The full name of the user logged in.");
2284 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
2285 "The user's name, taken from environment variables if possible.");
2287 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
2288 "The user's name, based upon the real uid only.");
2290 defsubr (&Schar_equal
);
2291 defsubr (&Sgoto_char
);
2292 defsubr (&Sstring_to_char
);
2293 defsubr (&Schar_to_string
);
2294 defsubr (&Sbuffer_substring
);
2295 defsubr (&Sbuffer_string
);
2297 defsubr (&Spoint_marker
);
2298 defsubr (&Smark_marker
);
2300 defsubr (&Sregion_beginning
);
2301 defsubr (&Sregion_end
);
2302 /* defsubr (&Smark); */
2303 /* defsubr (&Sset_mark); */
2304 defsubr (&Ssave_excursion
);
2306 defsubr (&Sbufsize
);
2307 defsubr (&Spoint_max
);
2308 defsubr (&Spoint_min
);
2309 defsubr (&Spoint_min_marker
);
2310 defsubr (&Spoint_max_marker
);
2316 defsubr (&Sfollowing_char
);
2317 defsubr (&Sprevious_char
);
2318 defsubr (&Schar_after
);
2320 defsubr (&Sinsert_before_markers
);
2321 defsubr (&Sinsert_and_inherit
);
2322 defsubr (&Sinsert_and_inherit_before_markers
);
2323 defsubr (&Sinsert_char
);
2325 defsubr (&Suser_login_name
);
2326 defsubr (&Suser_real_login_name
);
2327 defsubr (&Suser_uid
);
2328 defsubr (&Suser_real_uid
);
2329 defsubr (&Suser_full_name
);
2330 defsubr (&Semacs_pid
);
2331 defsubr (&Scurrent_time
);
2332 defsubr (&Sformat_time_string
);
2333 defsubr (&Sdecode_time
);
2334 defsubr (&Sencode_time
);
2335 defsubr (&Scurrent_time_string
);
2336 defsubr (&Scurrent_time_zone
);
2337 defsubr (&Ssystem_name
);
2338 defsubr (&Smessage
);
2339 defsubr (&Smessage_box
);
2340 defsubr (&Smessage_or_box
);
2343 defsubr (&Sinsert_buffer_substring
);
2344 defsubr (&Scompare_buffer_substrings
);
2345 defsubr (&Ssubst_char_in_region
);
2346 defsubr (&Stranslate_region
);
2347 defsubr (&Sdelete_region
);
2349 defsubr (&Snarrow_to_region
);
2350 defsubr (&Ssave_restriction
);
2351 defsubr (&Stranspose_regions
);