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 char **environ
;
42 extern Lisp_Object
make_time ();
43 extern void insert_from_buffer ();
44 static long difftm ();
45 static void set_time_zone_rule ();
47 /* Some static data, and a function to initialize it for each run */
49 Lisp_Object Vsystem_name
;
50 Lisp_Object Vuser_real_login_name
; /* login name of current user ID */
51 Lisp_Object Vuser_full_name
; /* full name of current user */
52 Lisp_Object Vuser_login_name
; /* user name from LOGNAME or USER */
58 register unsigned char *p
, *q
, *r
;
59 struct passwd
*pw
; /* password entry for the current user */
60 extern char *index ();
63 /* Set up system_name even when dumping. */
67 /* Don't bother with this on initial start when just dumping out */
70 #endif /* not CANNOT_DUMP */
72 pw
= (struct passwd
*) getpwuid (getuid ());
74 /* We let the real user name default to "root" because that's quite
75 accurate on MSDOG and because it lets Emacs find the init file.
76 (The DVX libraries override the Djgpp libraries here.) */
77 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "root");
79 Vuser_real_login_name
= build_string (pw
? pw
->pw_name
: "unknown");
82 /* Get the effective user name, by consulting environment variables,
83 or the effective uid if those are unset. */
84 user_name
= (char *) getenv ("LOGNAME");
87 user_name
= (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
89 user_name
= (char *) getenv ("USER");
90 #endif /* WINDOWSNT */
93 pw
= (struct passwd
*) getpwuid (geteuid ());
94 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
96 Vuser_login_name
= build_string (user_name
);
98 /* If the user name claimed in the environment vars differs from
99 the real uid, use the claimed name to find the full name. */
100 tem
= Fstring_equal (Vuser_login_name
, Vuser_real_login_name
);
102 pw
= (struct passwd
*) getpwnam (XSTRING (Vuser_login_name
)->data
);
104 p
= (unsigned char *) (pw
? USER_FULL_NAME
: "unknown");
105 q
= (unsigned char *) index (p
, ',');
106 Vuser_full_name
= make_string (p
, q
? q
- p
: strlen (p
));
108 #ifdef AMPERSAND_FULL_NAME
109 p
= XSTRING (Vuser_full_name
)->data
;
110 q
= (unsigned char *) index (p
, '&');
111 /* Substitute the login name for the &, upcasing the first character. */
114 r
= (unsigned char *) alloca (strlen (p
)
115 + XSTRING (Vuser_login_name
)->size
+ 1);
118 strcat (r
, XSTRING (Vuser_login_name
)->data
);
119 r
[q
- p
] = UPCASE (r
[q
- p
]);
121 Vuser_full_name
= build_string (r
);
123 #endif /* AMPERSAND_FULL_NAME */
125 p
= (unsigned char *) getenv ("NAME");
127 Vuser_full_name
= build_string (p
);
130 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
131 "Convert arg CHAR to a one-character string containing that character.")
139 return make_string (&c
, 1);
142 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
143 "Convert arg STRING to a character, the first character of that string.")
145 register Lisp_Object str
;
147 register Lisp_Object val
;
148 register struct Lisp_String
*p
;
149 CHECK_STRING (str
, 0);
153 XSETFASTINT (val
, ((unsigned char *) p
->data
)[0]);
155 XSETFASTINT (val
, 0);
163 register Lisp_Object mark
;
164 mark
= Fmake_marker ();
165 Fset_marker (mark
, make_number (val
), Qnil
);
169 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
170 "Return value of point, as an integer.\n\
171 Beginning of buffer is position (point-min)")
175 XSETFASTINT (temp
, point
);
179 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
180 "Return value of point, as a marker object.")
183 return buildmark (point
);
187 clip_to_bounds (lower
, num
, upper
)
188 int lower
, num
, upper
;
192 else if (num
> upper
)
198 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
199 "Set point to POSITION, a number or marker.\n\
200 Beginning of buffer is position (point-min), end is (point-max).")
202 register Lisp_Object n
;
204 CHECK_NUMBER_COERCE_MARKER (n
, 0);
206 SET_PT (clip_to_bounds (BEGV
, XINT (n
), ZV
));
211 region_limit (beginningp
)
214 extern Lisp_Object Vmark_even_if_inactive
; /* Defined in callint.c. */
215 register Lisp_Object m
;
216 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
217 && NILP (current_buffer
->mark_active
))
218 Fsignal (Qmark_inactive
, Qnil
);
219 m
= Fmarker_position (current_buffer
->mark
);
220 if (NILP (m
)) error ("There is no region now");
221 if ((point
< XFASTINT (m
)) == beginningp
)
222 return (make_number (point
));
227 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
228 "Return position of beginning of region, as an integer.")
231 return (region_limit (1));
234 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
235 "Return position of end of region, as an integer.")
238 return (region_limit (0));
241 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
242 "Return this buffer's mark, as a marker object.\n\
243 Watch out! Moving this marker changes the mark position.\n\
244 If you set the marker not to point anywhere, the buffer will have no mark.")
247 return current_buffer
->mark
;
251 save_excursion_save ()
253 register int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
256 return Fcons (Fpoint_marker (),
257 Fcons (Fcopy_marker (current_buffer
->mark
, Qnil
),
258 Fcons (visible
? Qt
: Qnil
,
259 current_buffer
->mark_active
)));
263 save_excursion_restore (info
)
264 register Lisp_Object info
;
266 register Lisp_Object tem
, tem1
, omark
, nmark
;
268 tem
= Fmarker_buffer (Fcar (info
));
269 /* If buffer being returned to is now deleted, avoid error */
270 /* Otherwise could get error here while unwinding to top level
272 /* In that case, Fmarker_buffer returns nil now. */
278 unchain_marker (tem
);
279 tem
= Fcar (Fcdr (info
));
280 omark
= Fmarker_position (current_buffer
->mark
);
281 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
282 nmark
= Fmarker_position (tem
);
283 unchain_marker (tem
);
284 tem
= Fcdr (Fcdr (info
));
285 #if 0 /* We used to make the current buffer visible in the selected window
286 if that was true previously. That avoids some anomalies.
287 But it creates others, and it wasn't documented, and it is simpler
288 and cleaner never to alter the window/buffer connections. */
291 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
292 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
295 tem1
= current_buffer
->mark_active
;
296 current_buffer
->mark_active
= Fcdr (tem
);
297 if (!NILP (Vrun_hooks
))
299 /* If mark is active now, and either was not active
300 or was at a different place, run the activate hook. */
301 if (! NILP (current_buffer
->mark_active
))
303 if (! EQ (omark
, nmark
))
304 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
306 /* If mark has ceased to be active, run deactivate hook. */
307 else if (! NILP (tem1
))
308 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
313 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
314 "Save point, mark, and current buffer; execute BODY; restore those things.\n\
315 Executes BODY just like `progn'.\n\
316 The values of point, mark and the current buffer are restored\n\
317 even in case of abnormal exit (throw or error).\n\
318 The state of activation of the mark is also restored.")
322 register Lisp_Object val
;
323 int count
= specpdl_ptr
- specpdl
;
325 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
328 return unbind_to (count
, val
);
331 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 0, 0,
332 "Return the number of characters in the current buffer.")
336 XSETFASTINT (temp
, Z
- BEG
);
340 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
341 "Return the minimum permissible value of point in the current buffer.\n\
342 This is 1, unless narrowing (a buffer restriction) is in effect.")
346 XSETFASTINT (temp
, BEGV
);
350 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
351 "Return a marker to the minimum permissible value of point in this buffer.\n\
352 This is the beginning, unless narrowing (a buffer restriction) is in effect.")
355 return buildmark (BEGV
);
358 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
359 "Return the maximum permissible value of point in the current buffer.\n\
360 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
361 is in effect, in which case it is less.")
365 XSETFASTINT (temp
, ZV
);
369 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
370 "Return a marker to the maximum permissible value of point in this buffer.\n\
371 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
372 is in effect, in which case it is less.")
375 return buildmark (ZV
);
378 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
379 "Return the character following point, as a number.\n\
380 At the end of the buffer or accessible region, return 0.")
385 XSETFASTINT (temp
, 0);
387 XSETFASTINT (temp
, FETCH_CHAR (point
));
391 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
392 "Return the character preceding point, as a number.\n\
393 At the beginning of the buffer or accessible region, return 0.")
398 XSETFASTINT (temp
, 0);
400 XSETFASTINT (temp
, FETCH_CHAR (point
- 1));
404 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
405 "Return T if point is at the beginning of the buffer.\n\
406 If the buffer is narrowed, this means the beginning of the narrowed part.")
414 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
415 "Return T if point is at the end of the buffer.\n\
416 If the buffer is narrowed, this means the end of the narrowed part.")
424 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
425 "Return T if point is at the beginning of a line.")
428 if (point
== BEGV
|| FETCH_CHAR (point
- 1) == '\n')
433 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
434 "Return T if point is at the end of a line.\n\
435 `End of a line' includes point being at the end of the buffer.")
438 if (point
== ZV
|| FETCH_CHAR (point
) == '\n')
443 DEFUN ("char-after", Fchar_after
, Schar_after
, 1, 1, 0,
444 "Return character in current buffer at position POS.\n\
445 POS is an integer or a buffer pointer.\n\
446 If POS is out of range, the value is nil.")
450 register Lisp_Object val
;
453 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
456 if (n
< BEGV
|| n
>= ZV
) return Qnil
;
458 XSETFASTINT (val
, FETCH_CHAR (n
));
462 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 1, 0,
463 "Return the name under which the user logged in, as a string.\n\
464 This is based on the effective uid, not the real uid.\n\
465 Also, if the environment variable LOGNAME or USER is set,\n\
466 that determines the value of this function.\n\n\
467 If optional argument UID is an integer, return the login name of the user\n\
468 with that uid, or nil if there is no such user.")
474 /* Set up the user name info if we didn't do it before.
475 (That can happen if Emacs is dumpable
476 but you decide to run `temacs -l loadup' and not dump. */
477 if (INTEGERP (Vuser_login_name
))
481 return Vuser_login_name
;
483 CHECK_NUMBER (uid
, 0);
484 pw
= (struct passwd
*) getpwuid (XINT (uid
));
485 return (pw
? build_string (pw
->pw_name
) : Qnil
);
488 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
490 "Return the name of the user's real uid, as a string.\n\
491 This ignores the environment variables LOGNAME and USER, so it differs from\n\
492 `user-login-name' when running under `su'.")
495 /* Set up the user name info if we didn't do it before.
496 (That can happen if Emacs is dumpable
497 but you decide to run `temacs -l loadup' and not dump. */
498 if (INTEGERP (Vuser_login_name
))
500 return Vuser_real_login_name
;
503 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
504 "Return the effective uid of Emacs, as an integer.")
507 return make_number (geteuid ());
510 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
511 "Return the real uid of Emacs, as an integer.")
514 return make_number (getuid ());
517 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 0, 0,
518 "Return the full name of the user logged in, as a string.")
521 return Vuser_full_name
;
524 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
525 "Return the name of the machine you are running on, as a string.")
531 /* For the benefit of callers who don't want to include lisp.h */
535 return (char *) XSTRING (Vsystem_name
)->data
;
538 DEFUN ("emacs-pid", Femacs_pid
, Semacs_pid
, 0, 0, 0,
539 "Return the process ID of Emacs, as an integer.")
542 return make_number (getpid ());
545 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
546 "Return the current time, as the number of seconds since 12:00 AM January 1970.\n\
547 The time is returned as a list of three integers. The first has the\n\
548 most significant 16 bits of the seconds, while the second has the\n\
549 least significant 16 bits. The third integer gives the microsecond\n\
552 The microsecond count is zero on systems that do not provide\n\
553 resolution finer than a second.")
557 Lisp_Object result
[3];
560 XSETINT (result
[0], (EMACS_SECS (t
) >> 16) & 0xffff);
561 XSETINT (result
[1], (EMACS_SECS (t
) >> 0) & 0xffff);
562 XSETINT (result
[2], EMACS_USECS (t
));
564 return Flist (3, result
);
569 lisp_time_argument (specified_time
, result
)
570 Lisp_Object specified_time
;
573 if (NILP (specified_time
))
574 return time (result
) != -1;
577 Lisp_Object high
, low
;
578 high
= Fcar (specified_time
);
579 CHECK_NUMBER (high
, 0);
580 low
= Fcdr (specified_time
);
583 CHECK_NUMBER (low
, 0);
584 *result
= (XINT (high
) << 16) + (XINT (low
) & 0xffff);
585 return *result
>> 16 == XINT (high
);
589 DEFUN ("format-time-string", Fformat_time_string
, Sformat_time_string
, 2, 2, 0,
590 "Use FORMAT-STRING to format the time TIME.\n\
591 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from\n\
592 `current-time' and `file-attributes'.\n\
593 FORMAT-STRING may contain %-sequences to substitute parts of the time.\n\
594 %a is replaced by the abbreviated name of the day of week.\n\
595 %A is replaced by the full name of the day of week.\n\
596 %b is replaced by the abbreviated name of the month.\n\
597 %B is replaced by the full name of the month.\n\
598 %c is a synonym for \"%x %X\".\n\
599 %C is a locale-specific synonym, which defaults to \"%A, %B %e, %Y\" in the C locale.\n\
600 %d is replaced by the day of month, zero-padded.\n\
601 %D is a synonym for \"%m/%d/%y\".\n\
602 %e is replaced by the day of month, blank-padded.\n\
603 %h is a synonym for \"%b\".\n\
604 %H is replaced by the hour (00-23).\n\
605 %I is replaced by the hour (00-12).\n\
606 %j is replaced by the day of the year (001-366).\n\
607 %k is replaced by the hour (0-23), blank padded.\n\
608 %l is replaced by the hour (1-12), blank padded.\n\
609 %m is replaced by the month (01-12).\n\
610 %M is replaced by the minut (00-59).\n\
611 %n is a synonym for \"\\n\".\n\
612 %p is replaced by AM or PM, as appropriate.\n\
613 %r is a synonym for \"%I:%M:%S %p\".\n\
614 %R is a synonym for \"%H:%M\".\n\
615 %S is replaced by the seconds (00-60).\n\
616 %t is a synonym for \"\\t\".\n\
617 %T is a synonym for \"%H:%M:%S\".\n\
618 %U is replaced by the week of the year (01-52), first day of week is Sunday.\n\
619 %w is replaced by the day of week (0-6), Sunday is day 0.\n\
620 %W is replaced by the week of the year (01-52), first day of week is Monday.\n\
621 %x is a locale-specific synonym, which defaults to \"%D\" in the C locale.\n\
622 %X is a locale-specific synonym, which defaults to \"%T\" in the C locale.\n\
623 %y is replaced by the year without century (00-99).\n\
624 %Y is replaced by the year with century.\n\
625 %Z is replaced by the time zone abbreviation.\n\
627 The number of options reflects the `strftime' function.")
628 (format_string
, time
)
629 Lisp_Object format_string
, time
;
634 CHECK_STRING (format_string
, 1);
636 if (! lisp_time_argument (time
, &value
))
637 error ("Invalid time specification");
639 /* This is probably enough. */
640 size
= XSTRING (format_string
)->size
* 6 + 50;
644 char *buf
= (char *) alloca (size
);
645 if (emacs_strftime (buf
, size
, XSTRING (format_string
)->data
,
647 return build_string (buf
);
648 /* If buffer was too small, make it bigger. */
653 DEFUN ("decode-time", Fdecode_time
, Sdecode_time
, 0, 1, 0,
654 "Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).\n\
655 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)\n\
656 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'\n\
657 to use the current time. The list has the following nine members:\n\
658 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which\n\
659 only some operating systems support. MINUTE is an integer between 0 and 59.\n\
660 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.\n\
661 MONTH is an integer between 1 and 12. YEAR is an integer indicating the\n\
662 four-digit year. DOW is the day of week, an integer between 0 and 6, where\n\
663 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.\n\
664 ZONE is an integer indicating the number of seconds east of Greenwich.\n\
665 \(Note that Common Lisp has different meanings for DOW and ZONE.)")
667 Lisp_Object specified_time
;
671 struct tm
*decoded_time
;
672 Lisp_Object list_args
[9];
674 if (! lisp_time_argument (specified_time
, &time_spec
))
675 error ("Invalid time specification");
677 decoded_time
= localtime (&time_spec
);
678 XSETFASTINT (list_args
[0], decoded_time
->tm_sec
);
679 XSETFASTINT (list_args
[1], decoded_time
->tm_min
);
680 XSETFASTINT (list_args
[2], decoded_time
->tm_hour
);
681 XSETFASTINT (list_args
[3], decoded_time
->tm_mday
);
682 XSETFASTINT (list_args
[4], decoded_time
->tm_mon
+ 1);
683 XSETFASTINT (list_args
[5], decoded_time
->tm_year
+ 1900);
684 XSETFASTINT (list_args
[6], decoded_time
->tm_wday
);
685 list_args
[7] = (decoded_time
->tm_isdst
)? Qt
: Qnil
;
687 /* Make a copy, in case gmtime modifies the struct. */
688 save_tm
= *decoded_time
;
689 decoded_time
= gmtime (&time_spec
);
690 if (decoded_time
== 0)
693 XSETINT (list_args
[8], difftm (&save_tm
, decoded_time
));
694 return Flist (9, list_args
);
697 DEFUN ("encode-time", Fencode_time
, Sencode_time
, 6, 7, 0,
698 "Convert SEC, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.\n\
699 This is the reverse operation of `decode-time', which see. ZONE defaults\n\
700 to the current time zone rule if not specified; if specified, it can\n\
701 be a string (as from `set-time-zone-rule'), or it can be a list\n\
702 (as from `current-time-zone') or an integer (as from `decode-time')\n\
703 applied without consideration for daylight savings time.\n\
704 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;\n\
705 for example, a DAY of 0 means the day preceding the given month.\n\
706 Year numbers less than 100 are treated just like other year numbers.\n\
707 If you want them to stand for years in this century, you must do that yourself.")
708 (sec
, minute
, hour
, day
, month
, year
, zone
)
709 Lisp_Object sec
, minute
, hour
, day
, month
, year
, zone
;
714 CHECK_NUMBER (sec
, 0);
715 CHECK_NUMBER (minute
, 1);
716 CHECK_NUMBER (hour
, 2);
717 CHECK_NUMBER (day
, 3);
718 CHECK_NUMBER (month
, 4);
719 CHECK_NUMBER (year
, 5);
721 tm
.tm_sec
= XINT (sec
);
722 tm
.tm_min
= XINT (minute
);
723 tm
.tm_hour
= XINT (hour
);
724 tm
.tm_mday
= XINT (day
);
725 tm
.tm_mon
= XINT (month
) - 1;
726 tm
.tm_year
= XINT (year
) - 1900;
737 char **oldenv
= environ
, **newenv
;
740 tzstring
= XSTRING (zone
)->data
;
741 else if (INTEGERP (zone
))
743 int abszone
= abs (XINT (zone
));
744 sprintf (tzbuf
, "XXX%s%d:%02d:%02d", "-" + (XINT (zone
) < 0),
745 abszone
/ (60*60), (abszone
/60) % 60, abszone
% 60);
749 error ("Invalid time zone specification");
751 /* Set TZ before calling mktime; merely adjusting mktime's returned
752 value doesn't suffice, since that would mishandle leap seconds. */
753 set_time_zone_rule (tzstring
);
757 /* Restore TZ to previous value. */
761 #ifdef LOCALTIME_CACHE
766 if (time
== (time_t) -1)
767 error ("Specified time is not representable");
769 return make_time (time
);
772 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
773 "Return the current time, as a human-readable string.\n\
774 Programs can use this function to decode a time,\n\
775 since the number of columns in each field is fixed.\n\
776 The format is `Sun Sep 16 01:03:52 1973'.\n\
777 If an argument is given, it specifies a time to format\n\
778 instead of the current time. The argument should have the form:\n\
781 (HIGH LOW . IGNORED).\n\
782 Thus, you can use times obtained from `current-time'\n\
783 and from `file-attributes'.")
785 Lisp_Object specified_time
;
791 if (! lisp_time_argument (specified_time
, &value
))
793 tem
= (char *) ctime (&value
);
795 strncpy (buf
, tem
, 24);
798 return build_string (buf
);
801 #define TM_YEAR_ORIGIN 1900
803 /* Yield A - B, measured in seconds. */
808 int ay
= a
->tm_year
+ (TM_YEAR_ORIGIN
- 1);
809 int by
= b
->tm_year
+ (TM_YEAR_ORIGIN
- 1);
810 /* Some compilers can't handle this as a single return statement. */
812 /* difference in day of year */
813 a
->tm_yday
- b
->tm_yday
814 /* + intervening leap days */
815 + ((ay
>> 2) - (by
>> 2))
817 + ((ay
/100 >> 2) - (by
/100 >> 2))
818 /* + difference in years * 365 */
819 + (long)(ay
-by
) * 365
821 return (60*(60*(24*days
+ (a
->tm_hour
- b
->tm_hour
))
822 + (a
->tm_min
- b
->tm_min
))
823 + (a
->tm_sec
- b
->tm_sec
));
826 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 1, 0,
827 "Return the offset and name for the local time zone.\n\
828 This returns a list of the form (OFFSET NAME).\n\
829 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).\n\
830 A negative value means west of Greenwich.\n\
831 NAME is a string giving the name of the time zone.\n\
832 If an argument is given, it specifies when the time zone offset is determined\n\
833 instead of using the current time. The argument should have the form:\n\
836 (HIGH LOW . IGNORED).\n\
837 Thus, you can use times obtained from `current-time'\n\
838 and from `file-attributes'.\n\
840 Some operating systems cannot provide all this information to Emacs;\n\
841 in this case, `current-time-zone' returns a list containing nil for\n\
842 the data it can't find.")
844 Lisp_Object specified_time
;
849 if (lisp_time_argument (specified_time
, &value
)
850 && (t
= gmtime (&value
)) != 0)
856 gmt
= *t
; /* Make a copy, in case localtime modifies *t. */
857 t
= localtime (&value
);
858 offset
= difftm (t
, &gmt
);
862 s
= (char *)t
->tm_zone
;
863 #else /* not HAVE_TM_ZONE */
865 if (t
->tm_isdst
== 0 || t
->tm_isdst
== 1)
866 s
= tzname
[t
->tm_isdst
];
868 #endif /* not HAVE_TM_ZONE */
871 /* No local time zone name is available; use "+-NNNN" instead. */
872 int am
= (offset
< 0 ? -offset
: offset
) / 60;
873 sprintf (buf
, "%c%02d%02d", (offset
< 0 ? '-' : '+'), am
/60, am
%60);
876 return Fcons (make_number (offset
), Fcons (build_string (s
), Qnil
));
879 return Fmake_list (2, Qnil
);
882 DEFUN ("set-time-zone-rule", Fset_time_zone_rule
, Sset_time_zone_rule
, 1, 1, 0,
883 "Set the local time zone using TZ, a string specifying a time zone rule.\n\
884 If TZ is nil, use implementation-defined default time zone information.")
888 static char **environbuf
;
895 CHECK_STRING (tz
, 0);
896 tzstring
= XSTRING (tz
)->data
;
899 set_time_zone_rule (tzstring
);
902 environbuf
= environ
;
907 /* Set the local time zone rule to TZSTRING.
908 This allocates memory into `environ', which it is the caller's
909 responsibility to free. */
911 set_time_zone_rule (tzstring
)
915 char **from
, **to
, **newenv
;
917 for (from
= environ
; *from
; from
++)
919 envptrs
= from
- environ
+ 2;
920 newenv
= to
= (char **) xmalloc (envptrs
* sizeof (char *)
921 + (tzstring
? strlen (tzstring
) + 4 : 0));
924 char *t
= (char *) (to
+ envptrs
);
926 strcat (t
, tzstring
);
930 for (from
= environ
; *from
; from
++)
931 if (strncmp (*from
, "TZ=", 3) != 0)
937 #ifdef LOCALTIME_CACHE
950 /* Callers passing one argument to Finsert need not gcpro the
951 argument "array", since the only element of the array will
952 not be used after calling insert or insert_from_string, so
953 we don't care if it gets trashed. */
955 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
956 "Insert the arguments, either strings or characters, at point.\n\
957 Point moves forward so that it ends up after the inserted text.\n\
958 Any other markers at the point of insertion remain before the text.")
961 register Lisp_Object
*args
;
964 register Lisp_Object tem
;
967 for (argnum
= 0; argnum
< nargs
; argnum
++)
976 else if (STRINGP (tem
))
978 insert_from_string (tem
, 0, XSTRING (tem
)->size
, 0);
982 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
990 DEFUN ("insert-and-inherit", Finsert_and_inherit
, Sinsert_and_inherit
,
992 "Insert the arguments at point, inheriting properties from adjoining text.\n\
993 Point moves forward so that it ends up after the inserted text.\n\
994 Any other markers at the point of insertion remain before the text.")
997 register Lisp_Object
*args
;
1000 register Lisp_Object tem
;
1003 for (argnum
= 0; argnum
< nargs
; argnum
++)
1009 str
[0] = XINT (tem
);
1010 insert_and_inherit (str
, 1);
1012 else if (STRINGP (tem
))
1014 insert_from_string (tem
, 0, XSTRING (tem
)->size
, 1);
1018 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1026 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
1027 "Insert strings or characters at point, relocating markers after the text.\n\
1028 Point moves forward so that it ends up after the inserted text.\n\
1029 Any other markers at the point of insertion also end up after the text.")
1032 register Lisp_Object
*args
;
1034 register int argnum
;
1035 register Lisp_Object tem
;
1038 for (argnum
= 0; argnum
< nargs
; argnum
++)
1044 str
[0] = XINT (tem
);
1045 insert_before_markers (str
, 1);
1047 else if (STRINGP (tem
))
1049 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
, 0);
1053 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1061 DEFUN ("insert-before-markers-and-inherit",
1062 Finsert_and_inherit_before_markers
, Sinsert_and_inherit_before_markers
,
1064 "Insert text at point, relocating markers and inheriting properties.\n\
1065 Point moves forward so that it ends up after the inserted text.\n\
1066 Any other markers at the point of insertion also end up after the text.")
1069 register Lisp_Object
*args
;
1071 register int argnum
;
1072 register Lisp_Object tem
;
1075 for (argnum
= 0; argnum
< nargs
; argnum
++)
1081 str
[0] = XINT (tem
);
1082 insert_before_markers_and_inherit (str
, 1);
1084 else if (STRINGP (tem
))
1086 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
, 1);
1090 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
1098 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 3, 0,
1099 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
1100 Point and all markers are affected as in the function `insert'.\n\
1101 Both arguments are required.\n\
1102 The optional third arg INHERIT, if non-nil, says to inherit text properties\n\
1103 from adjoining text, if those properties are sticky.")
1104 (chr
, count
, inherit
)
1105 Lisp_Object chr
, count
, inherit
;
1107 register unsigned char *string
;
1108 register int strlen
;
1111 CHECK_NUMBER (chr
, 0);
1112 CHECK_NUMBER (count
, 1);
1117 strlen
= min (n
, 256);
1118 string
= (unsigned char *) alloca (strlen
);
1119 for (i
= 0; i
< strlen
; i
++)
1120 string
[i
] = XFASTINT (chr
);
1123 if (!NILP (inherit
))
1124 insert_and_inherit (string
, strlen
);
1126 insert (string
, strlen
);
1131 if (!NILP (inherit
))
1132 insert_and_inherit (string
, n
);
1140 /* Making strings from buffer contents. */
1142 /* Return a Lisp_String containing the text of the current buffer from
1143 START to END. If text properties are in use and the current buffer
1144 has properties in the range specified, the resulting string will also
1147 We don't want to use plain old make_string here, because it calls
1148 make_uninit_string, which can cause the buffer arena to be
1149 compacted. make_string has no way of knowing that the data has
1150 been moved, and thus copies the wrong data into the string. This
1151 doesn't effect most of the other users of make_string, so it should
1152 be left as is. But we should use this function when conjuring
1153 buffer substrings. */
1156 make_buffer_string (start
, end
)
1159 Lisp_Object result
, tem
, tem1
;
1161 if (start
< GPT
&& GPT
< end
)
1164 result
= make_uninit_string (end
- start
);
1165 bcopy (&FETCH_CHAR (start
), XSTRING (result
)->data
, end
- start
);
1167 tem
= Fnext_property_change (make_number (start
), Qnil
, make_number (end
));
1168 tem1
= Ftext_properties_at (make_number (start
), Qnil
);
1170 #ifdef USE_TEXT_PROPERTIES
1171 if (XINT (tem
) != end
|| !NILP (tem1
))
1172 copy_intervals_to_string (result
, current_buffer
, start
, end
- start
);
1178 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
1179 "Return the contents of part of the current buffer as a string.\n\
1180 The two arguments START and END are character positions;\n\
1181 they can be in either order.")
1185 register int beg
, end
;
1187 validate_region (&b
, &e
);
1191 return make_buffer_string (beg
, end
);
1194 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
1195 "Return the contents of the current buffer as a string.\n\
1196 If narrowing is in effect, this function returns only the visible part\n\
1200 return make_buffer_string (BEGV
, ZV
);
1203 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
1205 "Insert before point a substring of the contents of buffer BUFFER.\n\
1206 BUFFER may be a buffer or a buffer name.\n\
1207 Arguments START and END are character numbers specifying the substring.\n\
1208 They default to the beginning and the end of BUFFER.")
1210 Lisp_Object buf
, b
, e
;
1212 register int beg
, end
, temp
;
1213 register struct buffer
*bp
;
1216 buffer
= Fget_buffer (buf
);
1219 bp
= XBUFFER (buffer
);
1222 beg
= BUF_BEGV (bp
);
1225 CHECK_NUMBER_COERCE_MARKER (b
, 0);
1232 CHECK_NUMBER_COERCE_MARKER (e
, 1);
1237 temp
= beg
, beg
= end
, end
= temp
;
1239 if (!(BUF_BEGV (bp
) <= beg
&& end
<= BUF_ZV (bp
)))
1240 args_out_of_range (b
, e
);
1242 insert_from_buffer (bp
, beg
, end
- beg
, 0);
1246 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
1248 "Compare two substrings of two buffers; return result as number.\n\
1249 the value is -N if first string is less after N-1 chars,\n\
1250 +N if first string is greater after N-1 chars, or 0 if strings match.\n\
1251 Each substring is represented as three arguments: BUFFER, START and END.\n\
1252 That makes six args in all, three for each substring.\n\n\
1253 The value of `case-fold-search' in the current buffer\n\
1254 determines whether case is significant or ignored.")
1255 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
1256 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
1258 register int begp1
, endp1
, begp2
, endp2
, temp
, len1
, len2
, length
, i
;
1259 register struct buffer
*bp1
, *bp2
;
1260 register unsigned char *trt
1261 = (!NILP (current_buffer
->case_fold_search
)
1262 ? XSTRING (current_buffer
->case_canon_table
)->data
: 0);
1264 /* Find the first buffer and its substring. */
1267 bp1
= current_buffer
;
1271 buf1
= Fget_buffer (buffer1
);
1274 bp1
= XBUFFER (buf1
);
1278 begp1
= BUF_BEGV (bp1
);
1281 CHECK_NUMBER_COERCE_MARKER (start1
, 1);
1282 begp1
= XINT (start1
);
1285 endp1
= BUF_ZV (bp1
);
1288 CHECK_NUMBER_COERCE_MARKER (end1
, 2);
1289 endp1
= XINT (end1
);
1293 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
1295 if (!(BUF_BEGV (bp1
) <= begp1
1297 && endp1
<= BUF_ZV (bp1
)))
1298 args_out_of_range (start1
, end1
);
1300 /* Likewise for second substring. */
1303 bp2
= current_buffer
;
1307 buf2
= Fget_buffer (buffer2
);
1310 bp2
= XBUFFER (buffer2
);
1314 begp2
= BUF_BEGV (bp2
);
1317 CHECK_NUMBER_COERCE_MARKER (start2
, 4);
1318 begp2
= XINT (start2
);
1321 endp2
= BUF_ZV (bp2
);
1324 CHECK_NUMBER_COERCE_MARKER (end2
, 5);
1325 endp2
= XINT (end2
);
1329 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
1331 if (!(BUF_BEGV (bp2
) <= begp2
1333 && endp2
<= BUF_ZV (bp2
)))
1334 args_out_of_range (start2
, end2
);
1336 len1
= endp1
- begp1
;
1337 len2
= endp2
- begp2
;
1342 for (i
= 0; i
< length
; i
++)
1344 int c1
= *BUF_CHAR_ADDRESS (bp1
, begp1
+ i
);
1345 int c2
= *BUF_CHAR_ADDRESS (bp2
, begp2
+ i
);
1352 return make_number (- 1 - i
);
1354 return make_number (i
+ 1);
1357 /* The strings match as far as they go.
1358 If one is shorter, that one is less. */
1360 return make_number (length
+ 1);
1361 else if (length
< len2
)
1362 return make_number (- length
- 1);
1364 /* Same length too => they are equal. */
1365 return make_number (0);
1369 subst_char_in_region_unwind (arg
)
1372 return current_buffer
->undo_list
= arg
;
1376 subst_char_in_region_unwind_1 (arg
)
1379 return current_buffer
->filename
= arg
;
1382 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
1383 Ssubst_char_in_region
, 4, 5, 0,
1384 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
1385 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
1386 and don't mark the buffer as really changed.")
1387 (start
, end
, fromchar
, tochar
, noundo
)
1388 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
1390 register int pos
, stop
, look
;
1392 int count
= specpdl_ptr
- specpdl
;
1394 validate_region (&start
, &end
);
1395 CHECK_NUMBER (fromchar
, 2);
1396 CHECK_NUMBER (tochar
, 3);
1400 look
= XINT (fromchar
);
1402 /* If we don't want undo, turn off putting stuff on the list.
1403 That's faster than getting rid of things,
1404 and it prevents even the entry for a first change.
1405 Also inhibit locking the file. */
1408 record_unwind_protect (subst_char_in_region_unwind
,
1409 current_buffer
->undo_list
);
1410 current_buffer
->undo_list
= Qt
;
1411 /* Don't do file-locking. */
1412 record_unwind_protect (subst_char_in_region_unwind_1
,
1413 current_buffer
->filename
);
1414 current_buffer
->filename
= Qnil
;
1419 if (FETCH_CHAR (pos
) == look
)
1423 modify_region (current_buffer
, XINT (start
), stop
);
1425 if (! NILP (noundo
))
1427 if (MODIFF
- 1 == SAVE_MODIFF
)
1429 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
1430 current_buffer
->auto_save_modified
++;
1437 record_change (pos
, 1);
1438 FETCH_CHAR (pos
) = XINT (tochar
);
1444 signal_after_change (XINT (start
),
1445 stop
- XINT (start
), stop
- XINT (start
));
1447 unbind_to (count
, Qnil
);
1451 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
1452 "From START to END, translate characters according to TABLE.\n\
1453 TABLE is a string; the Nth character in it is the mapping\n\
1454 for the character with code N. Returns the number of characters changed.")
1458 register Lisp_Object table
;
1460 register int pos
, stop
; /* Limits of the region. */
1461 register unsigned char *tt
; /* Trans table. */
1462 register int oc
; /* Old character. */
1463 register int nc
; /* New character. */
1464 int cnt
; /* Number of changes made. */
1465 Lisp_Object z
; /* Return. */
1466 int size
; /* Size of translate table. */
1468 validate_region (&start
, &end
);
1469 CHECK_STRING (table
, 2);
1471 size
= XSTRING (table
)->size
;
1472 tt
= XSTRING (table
)->data
;
1476 modify_region (current_buffer
, pos
, stop
);
1479 for (; pos
< stop
; ++pos
)
1481 oc
= FETCH_CHAR (pos
);
1487 record_change (pos
, 1);
1488 FETCH_CHAR (pos
) = nc
;
1489 signal_after_change (pos
, 1, 1);
1495 XSETFASTINT (z
, cnt
);
1499 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
1500 "Delete the text between point and mark.\n\
1501 When called from a program, expects two arguments,\n\
1502 positions (integers or markers) specifying the stretch to be deleted.")
1506 validate_region (&b
, &e
);
1507 del_range (XINT (b
), XINT (e
));
1511 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
1512 "Remove restrictions (narrowing) from current buffer.\n\
1513 This allows the buffer's full text to be seen and edited.")
1517 SET_BUF_ZV (current_buffer
, Z
);
1518 current_buffer
->clip_changed
= 1;
1519 /* Changing the buffer bounds invalidates any recorded current column. */
1520 invalidate_current_column ();
1524 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
1525 "Restrict editing in this buffer to the current region.\n\
1526 The rest of the text becomes temporarily invisible and untouchable\n\
1527 but is not deleted; if you save the buffer in a file, the invisible\n\
1528 text is included in the file. \\[widen] makes all visible again.\n\
1529 See also `save-restriction'.\n\
1531 When calling from a program, pass two arguments; positions (integers\n\
1532 or markers) bounding the text that should remain visible.")
1534 register Lisp_Object b
, e
;
1536 CHECK_NUMBER_COERCE_MARKER (b
, 0);
1537 CHECK_NUMBER_COERCE_MARKER (e
, 1);
1539 if (XINT (b
) > XINT (e
))
1542 tem
= b
; b
= e
; e
= tem
;
1545 if (!(BEG
<= XINT (b
) && XINT (b
) <= XINT (e
) && XINT (e
) <= Z
))
1546 args_out_of_range (b
, e
);
1548 BEGV
= XFASTINT (b
);
1549 SET_BUF_ZV (current_buffer
, XFASTINT (e
));
1550 if (point
< XFASTINT (b
))
1551 SET_PT (XFASTINT (b
));
1552 if (point
> XFASTINT (e
))
1553 SET_PT (XFASTINT (e
));
1554 current_buffer
->clip_changed
= 1;
1555 /* Changing the buffer bounds invalidates any recorded current column. */
1556 invalidate_current_column ();
1561 save_restriction_save ()
1563 register Lisp_Object bottom
, top
;
1564 /* Note: I tried using markers here, but it does not win
1565 because insertion at the end of the saved region
1566 does not advance mh and is considered "outside" the saved region. */
1567 XSETFASTINT (bottom
, BEGV
- BEG
);
1568 XSETFASTINT (top
, Z
- ZV
);
1570 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
1574 save_restriction_restore (data
)
1577 register struct buffer
*buf
;
1578 register int newhead
, newtail
;
1579 register Lisp_Object tem
;
1581 buf
= XBUFFER (XCONS (data
)->car
);
1583 data
= XCONS (data
)->cdr
;
1585 tem
= XCONS (data
)->car
;
1586 newhead
= XINT (tem
);
1587 tem
= XCONS (data
)->cdr
;
1588 newtail
= XINT (tem
);
1589 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
1594 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
1595 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
1596 current_buffer
->clip_changed
= 1;
1598 /* If point is outside the new visible range, move it inside. */
1600 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
1605 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
1606 "Execute BODY, saving and restoring current buffer's restrictions.\n\
1607 The buffer's restrictions make parts of the beginning and end invisible.\n\
1608 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
1609 This special form, `save-restriction', saves the current buffer's restrictions\n\
1610 when it is entered, and restores them when it is exited.\n\
1611 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
1612 The old restrictions settings are restored\n\
1613 even in case of abnormal exit (throw or error).\n\
1615 The value returned is the value of the last form in BODY.\n\
1617 `save-restriction' can get confused if, within the BODY, you widen\n\
1618 and then make changes outside the area within the saved restrictions.\n\
1620 Note: if you are using both `save-excursion' and `save-restriction',\n\
1621 use `save-excursion' outermost:\n\
1622 (save-excursion (save-restriction ...))")
1626 register Lisp_Object val
;
1627 int count
= specpdl_ptr
- specpdl
;
1629 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1630 val
= Fprogn (body
);
1631 return unbind_to (count
, val
);
1634 /* Buffer for the most recent text displayed by Fmessage. */
1635 static char *message_text
;
1637 /* Allocated length of that buffer. */
1638 static int message_length
;
1640 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
1641 "Print a one-line message at the bottom of the screen.\n\
1642 The first argument is a format control string, and the rest are data\n\
1643 to be formatted under control of the string. See `format' for details.\n\
1645 If the first argument is nil, clear any existing message; let the\n\
1646 minibuffer contents show.")
1658 register Lisp_Object val
;
1659 val
= Fformat (nargs
, args
);
1660 /* Copy the data so that it won't move when we GC. */
1663 message_text
= (char *)xmalloc (80);
1664 message_length
= 80;
1666 if (XSTRING (val
)->size
> message_length
)
1668 message_length
= XSTRING (val
)->size
;
1669 message_text
= (char *)xrealloc (message_text
, message_length
);
1671 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1672 message2 (message_text
, XSTRING (val
)->size
);
1677 DEFUN ("message-box", Fmessage_box
, Smessage_box
, 1, MANY
, 0,
1678 "Display a message, in a dialog box if possible.\n\
1679 If a dialog box is not available, use the echo area.\n\
1680 The first argument is a control string.\n\
1681 It may contain %s or %d or %c to print successive following arguments.\n\
1682 %s means print an argument as a string, %d means print as number in decimal,\n\
1683 %c means print a number as a single character.\n\
1684 The argument used by %s must be a string or a symbol;\n\
1685 the argument used by %d or %c must be a number.\n\
1686 If the first argument is nil, clear any existing message; let the\n\
1687 minibuffer contents show.")
1699 register Lisp_Object val
;
1700 val
= Fformat (nargs
, args
);
1703 Lisp_Object pane
, menu
, obj
;
1704 struct gcpro gcpro1
;
1705 pane
= Fcons (Fcons (build_string ("OK"), Qt
), Qnil
);
1707 menu
= Fcons (val
, pane
);
1708 obj
= Fx_popup_dialog (Qt
, menu
);
1713 /* Copy the data so that it won't move when we GC. */
1716 message_text
= (char *)xmalloc (80);
1717 message_length
= 80;
1719 if (XSTRING (val
)->size
> message_length
)
1721 message_length
= XSTRING (val
)->size
;
1722 message_text
= (char *)xrealloc (message_text
, message_length
);
1724 bcopy (XSTRING (val
)->data
, message_text
, XSTRING (val
)->size
);
1725 message2 (message_text
, XSTRING (val
)->size
);
1731 extern Lisp_Object last_nonmenu_event
;
1733 DEFUN ("message-or-box", Fmessage_or_box
, Smessage_or_box
, 1, MANY
, 0,
1734 "Display a message in a dialog box or in the echo area.\n\
1735 If this command was invoked with the mouse, use a dialog box.\n\
1736 Otherwise, use the echo area.\n\
1738 The first argument is a control string.\n\
1739 It may contain %s or %d or %c to print successive following arguments.\n\
1740 %s means print an argument as a string, %d means print as number in decimal,\n\
1741 %c means print a number as a single character.\n\
1742 The argument used by %s must be a string or a symbol;\n\
1743 the argument used by %d or %c must be a number.\n\
1744 If the first argument is nil, clear any existing message; let the\n\
1745 minibuffer contents show.")
1751 if (NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
1752 return Fmessage_box (nargs
, args
);
1754 return Fmessage (nargs
, args
);
1757 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1758 "Format a string out of a control-string and arguments.\n\
1759 The first argument is a control string.\n\
1760 The other arguments are substituted into it to make the result, a string.\n\
1761 It may contain %-sequences meaning to substitute the next argument.\n\
1762 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1763 %d means print as number in decimal (%o octal, %x hex).\n\
1764 %e means print a number in exponential notation.\n\
1765 %f means print a number in decimal-point notation.\n\
1766 %g means print a number in exponential notation\n\
1767 or decimal-point notation, whichever uses fewer characters.\n\
1768 %c means print a number as a single character.\n\
1769 %S means print any object as an s-expression (using prin1).\n\
1770 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.\n\
1771 Use %% to put a single % into the output.")
1774 register Lisp_Object
*args
;
1776 register int n
; /* The number of the next arg to substitute */
1777 register int total
= 5; /* An estimate of the final length */
1779 register unsigned char *format
, *end
;
1781 extern char *index ();
1782 /* It should not be necessary to GCPRO ARGS, because
1783 the caller in the interpreter should take care of that. */
1785 CHECK_STRING (args
[0], 0);
1786 format
= XSTRING (args
[0])->data
;
1787 end
= format
+ XSTRING (args
[0])->size
;
1790 while (format
!= end
)
1791 if (*format
++ == '%')
1795 /* Process a numeric arg and skip it. */
1796 minlen
= atoi (format
);
1800 while ((*format
>= '0' && *format
<= '9')
1801 || *format
== '-' || *format
== ' ' || *format
== '.')
1806 else if (++n
>= nargs
)
1807 error ("Not enough arguments for format string");
1808 else if (*format
== 'S')
1810 /* For `S', prin1 the argument and then treat like a string. */
1811 register Lisp_Object tem
;
1812 tem
= Fprin1_to_string (args
[n
], Qnil
);
1816 else if (SYMBOLP (args
[n
]))
1818 XSETSTRING (args
[n
], XSYMBOL (args
[n
])->name
);
1821 else if (STRINGP (args
[n
]))
1824 if (*format
!= 's' && *format
!= 'S')
1825 error ("format specifier doesn't match argument type");
1826 total
+= XSTRING (args
[n
])->size
;
1827 /* We have to put an arbitrary limit on minlen
1828 since otherwise it could make alloca fail. */
1829 if (minlen
< XSTRING (args
[n
])->size
+ 1000)
1832 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1833 else if (INTEGERP (args
[n
]) && *format
!= 's')
1835 #ifdef LISP_FLOAT_TYPE
1836 /* The following loop assumes the Lisp type indicates
1837 the proper way to pass the argument.
1838 So make sure we have a flonum if the argument should
1840 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1841 args
[n
] = Ffloat (args
[n
]);
1844 /* We have to put an arbitrary limit on minlen
1845 since otherwise it could make alloca fail. */
1849 #ifdef LISP_FLOAT_TYPE
1850 else if (FLOATP (args
[n
]) && *format
!= 's')
1852 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1853 args
[n
] = Ftruncate (args
[n
]);
1855 /* We have to put an arbitrary limit on minlen
1856 since otherwise it could make alloca fail. */
1863 /* Anything but a string, convert to a string using princ. */
1864 register Lisp_Object tem
;
1865 tem
= Fprin1_to_string (args
[n
], Qt
);
1872 register int nstrings
= n
+ 1;
1874 /* Allocate twice as many strings as we have %-escapes; floats occupy
1875 two slots, and we're not sure how many of those we have. */
1876 register unsigned char **strings
1877 = (unsigned char **) alloca (2 * nstrings
* sizeof (unsigned char *));
1881 for (n
= 0; n
< nstrings
; n
++)
1884 strings
[i
++] = (unsigned char *) "";
1885 else if (INTEGERP (args
[n
]))
1886 /* We checked above that the corresponding format effector
1887 isn't %s, which would cause MPV. */
1888 strings
[i
++] = (unsigned char *) XINT (args
[n
]);
1889 #ifdef LISP_FLOAT_TYPE
1890 else if (FLOATP (args
[n
]))
1892 union { double d
; char *half
[2]; } u
;
1894 u
.d
= XFLOAT (args
[n
])->data
;
1895 strings
[i
++] = (unsigned char *) u
.half
[0];
1896 strings
[i
++] = (unsigned char *) u
.half
[1];
1900 strings
[i
++] = XSTRING (args
[n
])->data
;
1903 /* Make room in result for all the non-%-codes in the control string. */
1904 total
+= XSTRING (args
[0])->size
;
1906 /* Format it in bigger and bigger buf's until it all fits. */
1909 buf
= (char *) alloca (total
+ 1);
1912 length
= doprnt (buf
, total
+ 1, strings
[0], end
, i
-1, strings
+ 1);
1913 if (buf
[total
- 1] == 0)
1921 return make_string (buf
, length
);
1927 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1928 EMACS_INT arg0
, arg1
, arg2
, arg3
, arg4
;
1942 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, args
);
1944 doprnt (buf
, sizeof buf
, string1
, (char *)0, 5, &string1
+ 1);
1946 return build_string (buf
);
1949 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1950 "Return t if two characters match, optionally ignoring case.\n\
1951 Both arguments must be characters (i.e. integers).\n\
1952 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1954 register Lisp_Object c1
, c2
;
1956 Lisp_Object
*downcase
= DOWNCASE_TABLE
;
1957 CHECK_NUMBER (c1
, 0);
1958 CHECK_NUMBER (c2
, 1);
1960 if (!NILP (current_buffer
->case_fold_search
)
1961 ? ((XINT (downcase
[0xff & XFASTINT (c1
)])
1962 == XINT (downcase
[0xff & XFASTINT (c2
)]))
1963 && (XFASTINT (c1
) & ~0xff) == (XFASTINT (c2
) & ~0xff))
1964 : XINT (c1
) == XINT (c2
))
1969 /* Transpose the markers in two regions of the current buffer, and
1970 adjust the ones between them if necessary (i.e.: if the regions
1973 Traverses the entire marker list of the buffer to do so, adding an
1974 appropriate amount to some, subtracting from some, and leaving the
1975 rest untouched. Most of this is copied from adjust_markers in insdel.c.
1977 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
1980 transpose_markers (start1
, end1
, start2
, end2
)
1981 register int start1
, end1
, start2
, end2
;
1983 register int amt1
, amt2
, diff
, mpos
;
1984 register Lisp_Object marker
;
1986 /* Update point as if it were a marker. */
1990 TEMP_SET_PT (PT
+ (end2
- end1
));
1991 else if (PT
< start2
)
1992 TEMP_SET_PT (PT
+ (end2
- start2
) - (end1
- start1
));
1994 TEMP_SET_PT (PT
- (start2
- start1
));
1996 /* We used to adjust the endpoints here to account for the gap, but that
1997 isn't good enough. Even if we assume the caller has tried to move the
1998 gap out of our way, it might still be at start1 exactly, for example;
1999 and that places it `inside' the interval, for our purposes. The amount
2000 of adjustment is nontrivial if there's a `denormalized' marker whose
2001 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2002 the dirty work to Fmarker_position, below. */
2004 /* The difference between the region's lengths */
2005 diff
= (end2
- start2
) - (end1
- start1
);
2007 /* For shifting each marker in a region by the length of the other
2008 * region plus the distance between the regions.
2010 amt1
= (end2
- start2
) + (start2
- end1
);
2011 amt2
= (end1
- start1
) + (start2
- end1
);
2013 for (marker
= BUF_MARKERS (current_buffer
); !NILP (marker
);
2014 marker
= XMARKER (marker
)->chain
)
2016 mpos
= Fmarker_position (marker
);
2017 if (mpos
>= start1
&& mpos
< end2
)
2021 else if (mpos
< start2
)
2025 if (mpos
> GPT
) mpos
+= GAP_SIZE
;
2026 XMARKER (marker
)->bufpos
= mpos
;
2031 DEFUN ("transpose-regions", Ftranspose_regions
, Stranspose_regions
, 4, 5, 0,
2032 "Transpose region START1 to END1 with START2 to END2.\n\
2033 The regions may not be overlapping, because the size of the buffer is\n\
2034 never changed in a transposition.\n\
2036 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose\n\
2037 any markers that happen to be located in the regions.\n\
2039 Transposing beyond buffer boundaries is an error.")
2040 (startr1
, endr1
, startr2
, endr2
, leave_markers
)
2041 Lisp_Object startr1
, endr1
, startr2
, endr2
, leave_markers
;
2043 register int start1
, end1
, start2
, end2
,
2044 gap
, len1
, len_mid
, len2
;
2045 unsigned char *start1_addr
, *start2_addr
, *temp
;
2047 #ifdef USE_TEXT_PROPERTIES
2048 INTERVAL cur_intv
, tmp_interval1
, tmp_interval_mid
, tmp_interval2
;
2049 cur_intv
= BUF_INTERVALS (current_buffer
);
2050 #endif /* USE_TEXT_PROPERTIES */
2052 validate_region (&startr1
, &endr1
);
2053 validate_region (&startr2
, &endr2
);
2055 start1
= XFASTINT (startr1
);
2056 end1
= XFASTINT (endr1
);
2057 start2
= XFASTINT (startr2
);
2058 end2
= XFASTINT (endr2
);
2061 /* Swap the regions if they're reversed. */
2064 register int glumph
= start1
;
2072 len1
= end1
- start1
;
2073 len2
= end2
- start2
;
2076 error ("transposed regions not properly ordered");
2077 else if (start1
== end1
|| start2
== end2
)
2078 error ("transposed region may not be of length 0");
2080 /* The possibilities are:
2081 1. Adjacent (contiguous) regions, or separate but equal regions
2082 (no, really equal, in this case!), or
2083 2. Separate regions of unequal size.
2085 The worst case is usually No. 2. It means that (aside from
2086 potential need for getting the gap out of the way), there also
2087 needs to be a shifting of the text between the two regions. So
2088 if they are spread far apart, we are that much slower... sigh. */
2090 /* It must be pointed out that the really studly thing to do would
2091 be not to move the gap at all, but to leave it in place and work
2092 around it if necessary. This would be extremely efficient,
2093 especially considering that people are likely to do
2094 transpositions near where they are working interactively, which
2095 is exactly where the gap would be found. However, such code
2096 would be much harder to write and to read. So, if you are
2097 reading this comment and are feeling squirrely, by all means have
2098 a go! I just didn't feel like doing it, so I will simply move
2099 the gap the minimum distance to get it out of the way, and then
2100 deal with an unbroken array. */
2102 /* Make sure the gap won't interfere, by moving it out of the text
2103 we will operate on. */
2104 if (start1
< gap
&& gap
< end2
)
2106 if (gap
- start1
< end2
- gap
)
2112 /* Hmmm... how about checking to see if the gap is large
2113 enough to use as the temporary storage? That would avoid an
2114 allocation... interesting. Later, don't fool with it now. */
2116 /* Working without memmove, for portability (sigh), so must be
2117 careful of overlapping subsections of the array... */
2119 if (end1
== start2
) /* adjacent regions */
2121 modify_region (current_buffer
, start1
, end2
);
2122 record_change (start1
, len1
+ len2
);
2124 #ifdef USE_TEXT_PROPERTIES
2125 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2126 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2127 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2128 #endif /* USE_TEXT_PROPERTIES */
2130 /* First region smaller than second. */
2133 /* We use alloca only if it is small,
2134 because we want to avoid stack overflow. */
2136 temp
= (unsigned char *) xmalloc (len2
);
2138 temp
= (unsigned char *) alloca (len2
);
2140 /* Don't precompute these addresses. We have to compute them
2141 at the last minute, because the relocating allocator might
2142 have moved the buffer around during the xmalloc. */
2143 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2144 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2146 bcopy (start2_addr
, temp
, len2
);
2147 bcopy (start1_addr
, start1_addr
+ len2
, len1
);
2148 bcopy (temp
, start1_addr
, len2
);
2153 /* First region not smaller than second. */
2156 temp
= (unsigned char *) xmalloc (len1
);
2158 temp
= (unsigned char *) alloca (len1
);
2159 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2160 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2161 bcopy (start1_addr
, temp
, len1
);
2162 bcopy (start2_addr
, start1_addr
, len2
);
2163 bcopy (temp
, start1_addr
+ len2
, len1
);
2167 #ifdef USE_TEXT_PROPERTIES
2168 graft_intervals_into_buffer (tmp_interval1
, start1
+ len2
,
2169 len1
, current_buffer
, 0);
2170 graft_intervals_into_buffer (tmp_interval2
, start1
,
2171 len2
, current_buffer
, 0);
2172 #endif /* USE_TEXT_PROPERTIES */
2174 /* Non-adjacent regions, because end1 != start2, bleagh... */
2178 /* Regions are same size, though, how nice. */
2180 modify_region (current_buffer
, start1
, end1
);
2181 modify_region (current_buffer
, start2
, end2
);
2182 record_change (start1
, len1
);
2183 record_change (start2
, len2
);
2184 #ifdef USE_TEXT_PROPERTIES
2185 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2186 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2187 Fset_text_properties (start1
, end1
, Qnil
, Qnil
);
2188 Fset_text_properties (start2
, end2
, Qnil
, Qnil
);
2189 #endif /* USE_TEXT_PROPERTIES */
2192 temp
= (unsigned char *) xmalloc (len1
);
2194 temp
= (unsigned char *) alloca (len1
);
2195 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2196 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2197 bcopy (start1_addr
, temp
, len1
);
2198 bcopy (start2_addr
, start1_addr
, len2
);
2199 bcopy (temp
, start2_addr
, len1
);
2202 #ifdef USE_TEXT_PROPERTIES
2203 graft_intervals_into_buffer (tmp_interval1
, start2
,
2204 len1
, current_buffer
, 0);
2205 graft_intervals_into_buffer (tmp_interval2
, start1
,
2206 len2
, current_buffer
, 0);
2207 #endif /* USE_TEXT_PROPERTIES */
2210 else if (len1
< len2
) /* Second region larger than first */
2211 /* Non-adjacent & unequal size, area between must also be shifted. */
2213 len_mid
= start2
- end1
;
2214 modify_region (current_buffer
, start1
, end2
);
2215 record_change (start1
, (end2
- start1
));
2216 #ifdef USE_TEXT_PROPERTIES
2217 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2218 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2219 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2220 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2221 #endif /* USE_TEXT_PROPERTIES */
2223 /* holds region 2 */
2225 temp
= (unsigned char *) xmalloc (len2
);
2227 temp
= (unsigned char *) alloca (len2
);
2228 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2229 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2230 bcopy (start2_addr
, temp
, len2
);
2231 bcopy (start1_addr
, start1_addr
+ len_mid
+ len2
, len1
);
2232 safe_bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2233 bcopy (temp
, start1_addr
, len2
);
2236 #ifdef USE_TEXT_PROPERTIES
2237 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2238 len1
, current_buffer
, 0);
2239 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2240 len_mid
, current_buffer
, 0);
2241 graft_intervals_into_buffer (tmp_interval2
, start1
,
2242 len2
, current_buffer
, 0);
2243 #endif /* USE_TEXT_PROPERTIES */
2246 /* Second region smaller than first. */
2248 len_mid
= start2
- end1
;
2249 record_change (start1
, (end2
- start1
));
2250 modify_region (current_buffer
, start1
, end2
);
2252 #ifdef USE_TEXT_PROPERTIES
2253 tmp_interval1
= copy_intervals (cur_intv
, start1
, len1
);
2254 tmp_interval_mid
= copy_intervals (cur_intv
, end1
, len_mid
);
2255 tmp_interval2
= copy_intervals (cur_intv
, start2
, len2
);
2256 Fset_text_properties (start1
, end2
, Qnil
, Qnil
);
2257 #endif /* USE_TEXT_PROPERTIES */
2259 /* holds region 1 */
2261 temp
= (unsigned char *) xmalloc (len1
);
2263 temp
= (unsigned char *) alloca (len1
);
2264 start1_addr
= BUF_CHAR_ADDRESS (current_buffer
, start1
);
2265 start2_addr
= BUF_CHAR_ADDRESS (current_buffer
, start2
);
2266 bcopy (start1_addr
, temp
, len1
);
2267 bcopy (start2_addr
, start1_addr
, len2
);
2268 bcopy (start1_addr
+ len1
, start1_addr
+ len2
, len_mid
);
2269 bcopy (temp
, start1_addr
+ len2
+ len_mid
, len1
);
2272 #ifdef USE_TEXT_PROPERTIES
2273 graft_intervals_into_buffer (tmp_interval1
, end2
- len1
,
2274 len1
, current_buffer
, 0);
2275 graft_intervals_into_buffer (tmp_interval_mid
, start1
+ len2
,
2276 len_mid
, current_buffer
, 0);
2277 graft_intervals_into_buffer (tmp_interval2
, start1
,
2278 len2
, current_buffer
, 0);
2279 #endif /* USE_TEXT_PROPERTIES */
2283 /* todo: this will be slow, because for every transposition, we
2284 traverse the whole friggin marker list. Possible solutions:
2285 somehow get a list of *all* the markers across multiple
2286 transpositions and do it all in one swell phoop. Or maybe modify
2287 Emacs' marker code to keep an ordered list or tree. This might
2288 be nicer, and more beneficial in the long run, but would be a
2289 bunch of work. Plus the way they're arranged now is nice. */
2290 if (NILP (leave_markers
))
2292 transpose_markers (start1
, end1
, start2
, end2
);
2293 fix_overlays_in_range (start1
, end2
);
2303 DEFVAR_LISP ("system-name", &Vsystem_name
,
2304 "The name of the machine Emacs is running on.");
2306 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
2307 "The full name of the user logged in.");
2309 DEFVAR_LISP ("user-login-name", &Vuser_login_name
,
2310 "The user's name, taken from environment variables if possible.");
2312 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name
,
2313 "The user's name, based upon the real uid only.");
2315 defsubr (&Schar_equal
);
2316 defsubr (&Sgoto_char
);
2317 defsubr (&Sstring_to_char
);
2318 defsubr (&Schar_to_string
);
2319 defsubr (&Sbuffer_substring
);
2320 defsubr (&Sbuffer_string
);
2322 defsubr (&Spoint_marker
);
2323 defsubr (&Smark_marker
);
2325 defsubr (&Sregion_beginning
);
2326 defsubr (&Sregion_end
);
2327 /* defsubr (&Smark); */
2328 /* defsubr (&Sset_mark); */
2329 defsubr (&Ssave_excursion
);
2331 defsubr (&Sbufsize
);
2332 defsubr (&Spoint_max
);
2333 defsubr (&Spoint_min
);
2334 defsubr (&Spoint_min_marker
);
2335 defsubr (&Spoint_max_marker
);
2341 defsubr (&Sfollowing_char
);
2342 defsubr (&Sprevious_char
);
2343 defsubr (&Schar_after
);
2345 defsubr (&Sinsert_before_markers
);
2346 defsubr (&Sinsert_and_inherit
);
2347 defsubr (&Sinsert_and_inherit_before_markers
);
2348 defsubr (&Sinsert_char
);
2350 defsubr (&Suser_login_name
);
2351 defsubr (&Suser_real_login_name
);
2352 defsubr (&Suser_uid
);
2353 defsubr (&Suser_real_uid
);
2354 defsubr (&Suser_full_name
);
2355 defsubr (&Semacs_pid
);
2356 defsubr (&Scurrent_time
);
2357 defsubr (&Sformat_time_string
);
2358 defsubr (&Sdecode_time
);
2359 defsubr (&Sencode_time
);
2360 defsubr (&Scurrent_time_string
);
2361 defsubr (&Scurrent_time_zone
);
2362 defsubr (&Sset_time_zone_rule
);
2363 defsubr (&Ssystem_name
);
2364 defsubr (&Smessage
);
2365 defsubr (&Smessage_box
);
2366 defsubr (&Smessage_or_box
);
2369 defsubr (&Sinsert_buffer_substring
);
2370 defsubr (&Scompare_buffer_substrings
);
2371 defsubr (&Ssubst_char_in_region
);
2372 defsubr (&Stranslate_region
);
2373 defsubr (&Sdelete_region
);
2375 defsubr (&Snarrow_to_region
);
2376 defsubr (&Ssave_restriction
);
2377 defsubr (&Stranspose_regions
);