1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985-1987, 1989, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
4 Copyright (C) 1996 Ben Wing.
6 This file is part of SXEmacs
8 SXEmacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 SXEmacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
22 /* Synched up with: Mule 2.0, FSF 19.30. */
24 /* This file has been Mule-ized. */
26 /* Hacked on for Mule by Ben Wing, December 1994. */
33 #define INCLUDE_EVENTS_H_PRIVATE_SPHERE
34 #include "events/events.h" /* for EVENTP */
37 #include "ui/insdel.h"
38 #include "ui/window.h"
41 #include "line-number.h"
48 #include "sysfile.h" /* for getcwd */
50 /* Some static data, and a function to initialize it for each run */
52 Lisp_Object Vsystem_name; /* #### - I don't see why this should be */
53 /* static, either... --Stig */
54 #if 0 /* XEmacs - this is now dynamic */
55 /* if at some point it's deemed desirable to
56 use lisp variables here, then they can be
57 initialized to nil and then set to their
58 real values upon the first call to the
59 functions that generate them. --stig */
60 Lisp_Object Vuser_real_login_name; /* login name of current user ID */
61 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */
64 /* It's useful to be able to set this as user customization, so we'll
66 Lisp_Object Vuser_full_name;
67 EXFUN(Fuser_full_name, 1);
71 Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
73 Lisp_Object Quser_files_and_directories;
75 /* This holds the value of `environ' produced by the previous
76 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
77 has never been called. */
78 static char **environbuf;
80 void init_editfns(void)
82 /* Only used in removed code below. */
87 /* Set up system_name even when dumping. */
95 if ((p = getenv("NAME")))
96 /* I don't think it's the right thing to do the ampersand
97 modification on NAME. Not that it matters anymore... -hniksic */
98 Vuser_full_name = build_ext_string(p, Qnative);
100 Vuser_full_name = Fuser_full_name(Qnil);
103 DEFUN("char-to-string", Fchar_to_string, 1, 1, 0, /*
104 Convert CHARACTER to a one-character string containing that character.
109 Bufbyte str[MAX_EMCHAR_LEN];
111 if (EVENTP(character)) {
113 Fevent_to_character(character, Qt, Qnil, Qnil);
116 signal_simple_continuable_error
117 ("character has no ASCII equivalent:",
118 Fcopy_event(character, Qnil));
122 CHECK_CHAR_COERCE_INT(character);
124 len = set_charptr_emchar(str, XCHAR(character));
125 return make_string(str, len);
128 DEFUN("string-to-char", Fstring_to_char, 1, 1, 0, /*
129 Convert arg STRING to a character, the first character of that string.
130 An empty string will return the constant `nil'.
135 CHECK_STRING(string);
138 if (string_length(p) != 0)
139 return make_char(string_char(p, 0));
141 /* This used to return Qzero. That is broken, broken, broken. */
142 /* It might be kinder to signal an error directly. -slb */
146 static Lisp_Object buildmark(Bufpos val, Lisp_Object buffer)
148 Lisp_Object mark = Fmake_marker();
149 Fset_marker(mark, make_int(val), buffer);
153 DEFUN("point", Fpoint, 0, 1, 0, /*
154 Return value of point, as an integer.
155 Beginning of buffer is position (point-min).
156 If BUFFER is nil, the current buffer is assumed.
160 struct buffer *b = decode_buffer(buffer, 1);
161 return make_int(BUF_PT(b));
164 DEFUN("point-marker", Fpoint_marker, 0, 2, 0, /*
165 Return value of point, as a marker object.
166 This marker is a copy; you may modify it with reckless abandon.
167 If optional argument DONT-COPY-P is non-nil, then it returns the real
168 point-marker; modifying the position of this marker will move point.
169 It is illegal to change the buffer of it, or make it point nowhere.
170 If BUFFER is nil, the current buffer is assumed.
172 (dont_copy_p, buffer))
174 struct buffer *b = decode_buffer(buffer, 1);
175 if (NILP(dont_copy_p))
176 return Fcopy_marker(b->point_marker, Qnil);
178 return b->point_marker;
181 /* The following two functions end up being identical but it's
182 cleaner to declare them separately. */
184 Bufpos bufpos_clip_to_bounds(Bufpos lower, Bufpos num, Bufpos upper)
186 return (num < lower ? lower : num > upper ? upper : num);
189 Bytind bytind_clip_to_bounds(Bytind lower, Bytind num, Bytind upper)
191 return (num < lower ? lower : num > upper ? upper : num);
196 * There is no absolute way to determine if goto-char is the function
197 * being run. this-command doesn't work because it is often eval'd
198 * and this-command ends up set to eval-expression. So this flag gets
201 * Jamie thinks he's wrong, but we'll leave this in for now.
203 int atomic_extent_goto_char_p;
205 DEFUN("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /*
206 Set point to POSITION, a number or marker.
207 Beginning of buffer is position (point-min), end is (point-max).
208 If BUFFER is nil, the current buffer is assumed.
209 Return value of POSITION, as an integer.
213 struct buffer *b = decode_buffer(buffer, 1);
214 Bufpos n = get_buffer_pos_char(b, position, GB_COERCE_RANGE);
216 atomic_extent_goto_char_p = 1;
220 static Lisp_Object region_limit(int beginningp, struct buffer *b)
225 if (!NILP(Vtransient_mark_mode) && NILP(Vmark_even_if_inactive)
226 && NILP(b->mark_active))
227 Fsignal(Qmark_inactive, Qnil);
229 m = Fmarker_position(b->mark);
231 error("There is no region now");
232 if (!!(BUF_PT(b) < XINT(m)) == !!beginningp)
233 return make_int(BUF_PT(b));
238 DEFUN("region-beginning", Fregion_beginning, 0, 1, 0, /*
239 Return position of beginning of region in BUFFER, as an integer.
240 If BUFFER is nil, the current buffer is assumed.
244 return region_limit(1, decode_buffer(buffer, 1));
247 DEFUN("region-end", Fregion_end, 0, 1, 0, /*
248 Return position of end of region in BUFFER, as an integer.
249 If BUFFER is nil, the current buffer is assumed.
253 return region_limit(0, decode_buffer(buffer, 1));
256 /* Whether to use lispm-style active-regions */
259 /* Whether the zmacs region is active. This is not per-buffer because
260 there can be only one active region at a time. #### Now that the
261 zmacs region are not directly tied to the X selections this may not
262 necessarily have to be true. */
263 int zmacs_region_active_p;
265 int zmacs_region_stays;
267 Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region;
268 Lisp_Object Qzmacs_region_buffer;
270 void zmacs_update_region(void)
272 /* This function can GC */
273 if (zmacs_region_active_p)
274 call0(Qzmacs_update_region);
277 void zmacs_deactivate_region(void)
279 /* This function can GC */
280 if (zmacs_region_active_p)
281 call0(Qzmacs_deactivate_region);
284 Lisp_Object zmacs_region_buffer(void)
286 if (zmacs_region_active_p)
287 return call0(Qzmacs_region_buffer);
292 DEFUN("mark-marker", Fmark_marker, 0, 2, 0, /*
293 Return this buffer's mark, as a marker object.
294 If `zmacs-regions' is true, then this returns nil unless the region is
295 currently in the active (highlighted) state. If optional argument FORCE
296 is t, this returns the mark (if there is one) regardless of the zmacs-region
297 state. You should *generally* not use the mark unless the region is active,
298 if the user has expressed a preference for the zmacs-region model.
299 Watch out! Moving this marker changes the mark position.
300 If you set the marker not to point anywhere, the buffer will have no mark.
301 If BUFFER is nil, the current buffer is assumed.
305 struct buffer *b = decode_buffer(buffer, 1);
306 if (!zmacs_regions || zmacs_region_active_p || !NILP(force))
311 /* The saved object is a cons:
313 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
315 We used to have another cons for a VISIBLE-P element, which was t
316 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
317 was unused for a long time, so I removed it. --hniksic */
318 Lisp_Object save_excursion_save(void)
322 /* #### Huh? --hniksic */
323 /*if (preparing_for_armageddon) return Qnil; */
325 #ifdef ERROR_CHECK_BUFPOS
326 assert(XINT(Fpoint(Qnil)) ==
327 XINT(Fmarker_position(Fpoint_marker(Qt, Qnil))));
332 return noseeum_cons(noseeum_copy_marker(b->point_marker, Qnil),
333 noseeum_copy_marker(b->mark, Qnil));
336 Lisp_Object save_excursion_restore(Lisp_Object info)
338 Lisp_Object buffer = Fmarker_buffer(XCAR(info));
340 /* If buffer being returned to is now deleted, avoid error --
341 otherwise could get error here while unwinding to top level and
342 crash. In that case, Fmarker_buffer returns nil now. */
344 struct buffer *buf = XBUFFER(buffer);
347 set_buffer_internal(buf);
348 Fgoto_char(XCAR(info), buffer);
349 Fset_marker(buf->mark, XCDR(info), buffer);
351 #if 0 /* We used to make the current buffer visible in the selected window
352 if that was true previously. That avoids some anomalies.
353 But it creates others, and it wasn't documented, and it is simpler
354 and cleaner never to alter the window/buffer connections. */
355 /* I'm certain some code somewhere depends on this behavior. --jwz */
356 /* Even if it did, it certainly doesn't matter anymore, because
357 this has been the behavior for countless XEmacs releases
360 && (current_buffer !=
361 XBUFFER(XWINDOW(selected_window)->buffer)))
362 switch_to_buffer(Fcurrent_buffer(), Qnil);
368 /* Free all the junk we allocated, so that a `save-excursion' comes
369 for free in terms of GC junk. */
370 free_marker(XMARKER(XCAR(info)));
371 free_marker(XMARKER(XCDR(info)));
372 free_cons(XCONS(info));
376 DEFUN("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
377 Save point, mark, and current buffer; execute BODY; restore those things.
378 Executes BODY just like `progn'.
379 The values of point, mark and the current buffer are restored
380 even in case of abnormal exit (throw or error).
384 /* This function can GC */
385 int speccount = specpdl_depth();
387 record_unwind_protect(save_excursion_restore, save_excursion_save());
389 return unbind_to(speccount, Fprogn(args));
392 Lisp_Object save_current_buffer_restore(Lisp_Object buffer)
394 struct buffer *buf = XBUFFER(buffer);
395 /* Avoid signaling an error if the buffer is no longer alive. This
396 is for consistency with save-excursion. */
397 if (BUFFER_LIVE_P(buf))
398 set_buffer_internal(buf);
402 DEFUN("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /*
403 Save the current buffer; execute BODY; restore the current buffer.
404 Executes BODY just like `progn'.
408 /* This function can GC */
409 int speccount = specpdl_depth();
411 record_unwind_protect(save_current_buffer_restore, Fcurrent_buffer());
413 return unbind_to(speccount, Fprogn(args));
416 DEFUN("buffer-size", Fbuffer_size, 0, 1, 0, /*
417 Return the number of characters in BUFFER.
418 If BUFFER is nil, the current buffer is assumed.
422 struct buffer *b = decode_buffer(buffer, 1);
423 return make_int(BUF_SIZE(b));
426 DEFUN("point-min", Fpoint_min, 0, 1, 0, /*
427 Return the minimum permissible value of point in BUFFER.
428 This is 1, unless narrowing (a buffer restriction)
429 is in effect, in which case it may be greater.
430 If BUFFER is nil, the current buffer is assumed.
434 struct buffer *b = decode_buffer(buffer, 1);
435 return make_int(BUF_BEGV(b));
438 DEFUN("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
439 Return a marker to the minimum permissible value of point in BUFFER.
440 This is the beginning, unless narrowing (a buffer restriction)
441 is in effect, in which case it may be greater.
442 If BUFFER is nil, the current buffer is assumed.
446 struct buffer *b = decode_buffer(buffer, 1);
447 return buildmark(BUF_BEGV(b), make_buffer(b));
450 DEFUN("point-max", Fpoint_max, 0, 1, 0, /*
451 Return the maximum permissible value of point in BUFFER.
452 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
453 is in effect, in which case it may be less.
454 If BUFFER is nil, the current buffer is assumed.
458 struct buffer *b = decode_buffer(buffer, 1);
459 return make_int(BUF_ZV(b));
462 DEFUN("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
463 Return a marker to the maximum permissible value of point in BUFFER.
464 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
465 is in effect, in which case it may be less.
466 If BUFFER is nil, the current buffer is assumed.
470 struct buffer *b = decode_buffer(buffer, 1);
471 return buildmark(BUF_ZV(b), make_buffer(b));
474 DEFUN("following-char", Ffollowing_char, 0, 1, 0, /*
475 Return the character following point.
476 At the end of the buffer or accessible region, return 0.
477 If BUFFER is nil, the current buffer is assumed.
481 struct buffer *b = decode_buffer(buffer, 1);
482 if (BUF_PT(b) >= BUF_ZV(b))
483 return Qzero; /* #### Gag me! */
485 return make_char(BUF_FETCH_CHAR(b, BUF_PT(b)));
488 DEFUN("preceding-char", Fpreceding_char, 0, 1, 0, /*
489 Return the character preceding point.
490 At the beginning of the buffer or accessible region, return 0.
491 If BUFFER is nil, the current buffer is assumed.
495 struct buffer *b = decode_buffer(buffer, 1);
496 if (BUF_PT(b) <= BUF_BEGV(b))
497 return Qzero; /* #### Gag me! */
499 return make_char(BUF_FETCH_CHAR(b, BUF_PT(b) - 1));
502 DEFUN("bobp", Fbobp, 0, 1, 0, /*
503 Return t if point is at the beginning of the buffer.
504 If the buffer is narrowed, this means the beginning of the narrowed part.
505 If BUFFER is nil, the current buffer is assumed.
509 struct buffer *b = decode_buffer(buffer, 1);
510 return BUF_PT(b) == BUF_BEGV(b) ? Qt : Qnil;
513 DEFUN("eobp", Feobp, 0, 1, 0, /*
514 Return t if point is at the end of the buffer.
515 If the buffer is narrowed, this means the end of the narrowed part.
516 If BUFFER is nil, the current buffer is assumed.
520 struct buffer *b = decode_buffer(buffer, 1);
521 return BUF_PT(b) == BUF_ZV(b) ? Qt : Qnil;
524 int beginning_of_line_p(struct buffer *b, Bufpos pt)
526 return pt <= BUF_BEGV(b) || BUF_FETCH_CHAR(b, pt - 1) == '\n';
529 DEFUN("bolp", Fbolp, 0, 1, 0, /*
530 Return t if point is at the beginning of a line.
531 If BUFFER is nil, the current buffer is assumed.
535 struct buffer *b = decode_buffer(buffer, 1);
536 return beginning_of_line_p(b, BUF_PT(b)) ? Qt : Qnil;
539 DEFUN("eolp", Feolp, 0, 1, 0, /*
540 Return t if point is at the end of a line.
541 `End of a line' includes point being at the end of the buffer.
542 If BUFFER is nil, the current buffer is assumed.
546 struct buffer *b = decode_buffer(buffer, 1);
547 return (BUF_PT(b) == BUF_ZV(b) || BUF_FETCH_CHAR(b, BUF_PT(b)) == '\n')
551 DEFUN("char-after", Fchar_after, 0, 2, 0, /*
552 Return the character at position POS in BUFFER.
553 POS is an integer or a marker.
554 If POS is out of range, the value is nil.
555 if POS is nil, the value of point is assumed.
556 If BUFFER is nil, the current buffer is assumed.
560 struct buffer *b = decode_buffer(buffer, 1);
561 Bufpos n = (NILP(pos) ? BUF_PT(b) :
562 get_buffer_pos_char(b, pos, GB_NO_ERROR_IF_BAD));
564 if (n < 0 || n == BUF_ZV(b))
566 return make_char(BUF_FETCH_CHAR(b, n));
569 DEFUN("char-before", Fchar_before, 0, 2, 0, /*
570 Return the character preceding position POS in BUFFER.
571 POS is an integer or a marker.
572 If POS is out of range, the value is nil.
573 if POS is nil, the value of point is assumed.
574 If BUFFER is nil, the current buffer is assumed.
578 struct buffer *b = decode_buffer(buffer, 1);
579 Bufpos n = (NILP(pos) ? BUF_PT(b) :
580 get_buffer_pos_char(b, pos, GB_NO_ERROR_IF_BAD));
586 return make_char(BUF_FETCH_CHAR(b, n));
589 #include <sys/stat.h>
595 DEFUN("temp-directory", Ftemp_directory, 0, 0, 0, /*
596 Return the pathname to the directory to use for temporary files.
597 On MS Windows, this is obtained from the TEMP or TMP environment variables,
598 defaulting to / if they are both undefined.
599 On Unix it is obtained from TMPDIR, with /tmp as the default.
604 tmpdir = getenv("TMPDIR");
605 char path[5 /* strlen ("/tmp/") */ + 1 + _POSIX_PATH_MAX];
608 int myuid = getuid();
610 strcpy(path, "/tmp/");
611 strncat(path, user_login_name(NULL), _POSIX_PATH_MAX);
612 path[sizeof(path)-1]=0;
613 if (lstat(path, &st) < 0 && errno == ENOENT) {
614 mkdir(path, 0700); /* ignore retval -- checked next anyway. */
616 if (lstat(path, &st) == 0 && st.st_uid == (uid_t) myuid &&
617 S_ISDIR(st.st_mode)) {
620 const char* home_env = getenv("HOME");
622 xstrncpy(path, home_env, sizeof(path));
623 xstrncat(path, "/tmp/", sizeof(path)-1);
624 if ( mkdir(path, 0700) >= 0 || errno == EEXIST ) {
627 /* strlen(".created_by_sxemacs") */
628 19 + _POSIX_PATH_MAX + 1];
629 xstrncpy(warnpath, path, sizeof(warnpath));
631 /* we already are reserved these 20 bytes... */
632 xstrncat(warnpath, ".created_by_sxemacs",
634 if ((fd = open(warnpath, O_WRONLY | O_CREAT,
636 write(fd, "SXEmacs created this directory "
637 "because /tmp/<yourname> "
638 "was unavailable -- \nPlease check !\n",
644 if (stat(path, &st) == 0 && st.st_uid == (uid_t) myuid
645 && S_ISDIR(st.st_mode)) {
653 return build_ext_string(tmpdir, Qfile_name);
656 DEFUN("user-login-name", Fuser_login_name, 0, 1, 0, /*
657 Return the name under which the user logged in, as a string.
658 This is based on the effective uid, not the real uid.
659 Also, if the environment variable LOGNAME or USER is set,
660 that determines the value of this function.
661 If the optional argument UID is present, then environment variables are
662 ignored and this function returns the login name for that UID, or nil.
671 local_uid = XINT(uid);
672 returned_name = user_login_name(&local_uid);
674 returned_name = user_login_name(NULL);
676 /* #### - I believe this should return nil instead of "unknown" when pw==0
677 pw=0 is indicated by a null return from user_login_name
679 return returned_name ? build_string(returned_name) : Qnil;
682 /* This function may be called from other C routines when a
683 character string representation of the user_login_name is
684 needed but a Lisp Object is not. The UID is passed by
685 reference. If UID == NULL, then the USER name
686 for the user running XEmacs will be returned. This
687 corresponds to a nil argument to Fuser_login_name.
689 char *user_login_name(uid_t * uid)
691 /* uid == NULL to return name of this user */
693 struct passwd *pw = getpwuid(*uid);
694 return pw ? pw->pw_name : NULL;
696 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
697 old environment (I site observed behavior on sunos and linux), so the
698 environment variables should be disregarded in that case. --Stig */
699 char *user_name = getenv("LOGNAME");
701 user_name = getenv("USER");
705 struct passwd *pw = getpwuid(geteuid());
706 return pw ? pw->pw_name : NULL;
711 DEFUN("user-group-name", Fuser_group_name, 0, 1, 0, /*
712 Return the group name under which the user logged in, as a string.
713 This is based on the effective gid, not the real gid.
714 If the optional argument GID is present, then this function returns
715 the group name for that UID, or nil.
724 local_gid = XINT(gid);
725 returned_name = user_group_name(&local_gid);
727 returned_name = user_group_name(NULL);
729 /* #### - I believe this should return nil instead of "unknown" when pw==0
730 pw=0 is indicated by a null return from user_login_name
732 return returned_name ? build_string(returned_name) : Qnil;
735 /* This function may be called from other C routines when a
736 character string representation of the user_group_name is
737 needed but a Lisp Object is not. The GID is passed by
738 reference. If GID == NULL, then the group for
739 for the user running XEmacs will be returned. This
740 corresponds to a nil argument to Fuser_group_name.
742 char *user_group_name(gid_t * gid)
744 /* gid == NULL to return the group of this user */
745 struct group * grp = getgrgid( gid ? *gid : getegid());
752 DEFUN("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
753 Return the name of the user's real uid, as a string.
754 This ignores the environment variables LOGNAME and USER, so it differs from
755 `user-login-name' when running under `su'.
759 struct passwd *pw = getpwuid(getuid());
760 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
762 Lisp_Object tem = build_string(pw ? pw->pw_name : "unknown"); /* no gettext */
766 DEFUN("user-uid", Fuser_uid, 0, 1, 0, /*
767 Return the effective uid of the Emacs process, as an integer.
768 If the optional argument `user_name' is specified it returns the uid of
769 the user with that name. Will return `nil' if there is no user with the
774 if (!NILP(user_name)) {
775 const char * user_name_ext = NULL;
777 CHECK_STRING(user_name);
779 TO_EXTERNAL_FORMAT(LISP_STRING, user_name,
780 C_STRING_ALLOCA, user_name_ext, Qnative);
782 struct passwd *pw = getpwnam(user_name_ext);
784 return make_int(pw->pw_uid);
789 return make_int(geteuid());
793 DEFUN("user-gid", Fuser_gid, 0, 1, 0, /*
794 Return the effective gid of the Emacs process, as an integer.
795 If the optional argument `group_name' is specified it returns the gid of
796 the group with that name. It will return `nil' if the system has no
797 group with the specified name.
801 if (!NILP(group_name)) {
802 const char *group_name_ext = NULL;
804 CHECK_STRING(group_name);
806 TO_EXTERNAL_FORMAT(LISP_STRING, group_name,
807 C_STRING_ALLOCA, group_name_ext, Qnative);
809 struct group *grp = getgrnam(group_name_ext);
811 return make_int(grp->gr_gid);
816 return make_int(getegid());
820 DEFUN("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
821 Return the real uid of the Emacs process, as an integer.
825 return make_int(getuid());
828 DEFUN("user-real-gid", Fuser_real_gid, 0, 0, 0, /*
829 Return the real gid of the Emacs process, as an integer.
833 return make_int(getgid());
836 DEFUN("user-full-name", Fuser_full_name, 0, 1, 0, /*
837 Return the full name of the user logged in, as a string.
838 If the optional argument USER is given, then the full name for that
839 user is returned, or nil. USER may be either a login name or a uid.
841 If USER is nil, and `user-full-name' contains a string, the
842 value of `user-full-name' is returned.
846 Lisp_Object user_name;
847 struct passwd *pw = NULL;
852 if (NILP(user) && STRINGP(Vuser_full_name))
853 return Vuser_full_name;
855 user_name = (STRINGP(user) ? user : Fuser_login_name(user));
856 if (!NILP(user_name)) { /* nil when nonexistent UID passed as arg */
857 const char *user_name_ext;
859 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
860 things get wedged if a SIGIO arrives during this time. */
861 TO_EXTERNAL_FORMAT(LISP_STRING, user_name,
862 C_STRING_ALLOCA, user_name_ext, Qnative);
863 slow_down_interrupts();
864 pw = (struct passwd *)getpwnam(user_name_ext);
865 speed_up_interrupts();
868 /* #### - Stig sez: this should return nil instead
869 * of "unknown" when pw==0 */
870 /* Ben sez: bad idea because it's likely to break something */
871 #ifndef AMPERSAND_FULL_NAME
872 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
875 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
878 tem = ((!NILP(user) && !pw)
880 : make_ext_string((Extbyte *) p, (q ? q - p : (int)strlen(p)),
883 #ifdef AMPERSAND_FULL_NAME
885 p = (char *)XSTRING_DATA(tem);
887 /* Substitute the login name for the &, upcasing the first character. */
890 (char *)alloca(strlen(p) +
891 XSTRING_LENGTH(user_name) + 1);
894 strcat(r, (char *)XSTRING_DATA(user_name));
895 /* #### current_buffer dependency! */
896 r[q - p] = UPCASE(current_buffer, r[q - p]);
898 tem = build_string(r);
901 #endif /* AMPERSAND_FULL_NAME */
906 static Extbyte *cached_home_directory;
908 void uncache_home_directory(void)
910 cached_home_directory = NULL; /* in some cases, this may cause the leaking
914 /* !!#### not Mule correct. */
916 /* Returns the home directory, in external format */
917 Extbyte *get_home_directory(void)
919 /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
920 about what format an external string is in. Could be Unicode, for all
921 we know, and then all the operations below are totally bogus.
922 Instead, convert all data to internal format *right* at the juncture
923 between XEmacs and the outside world, the very moment we first get
925 int output_home_warning = 0;
927 if (cached_home_directory == NULL) {
928 if ((cached_home_directory =
929 (Extbyte *) getenv("HOME")) == NULL) {
932 * Using "/" isn't quite right, but what should we do?
933 * We probably should try to extract pw_dir from /etc/passwd,
934 * before falling back to this.
936 cached_home_directory = (Extbyte *) "/";
937 output_home_warning = 1;
939 if (initialized && output_home_warning) {
940 warn_when_safe(Quser_files_and_directories, Qwarning,
942 " SXEmacs was unable to determine a good value for the user's $HOME\n"
943 " directory, and will be using the value:\n"
945 " This is probably incorrect.",
946 cached_home_directory);
949 return cached_home_directory;
952 DEFUN("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
953 Return the user's home directory, as a string.
957 Extbyte *path = get_home_directory();
959 return path == NULL ? Qnil :
960 Fexpand_file_name(Fsubstitute_in_file_name
961 (build_ext_string((char *)path, Qfile_name)),
965 DEFUN("system-name", Fsystem_name, 0, 0, 0, /*
966 Return the name of the machine you are running on, as a string.
970 return Fcopy_sequence(Vsystem_name);
973 DEFUN("emacs-pid", Femacs_pid, 0, 0, 0, /*
974 Return the process ID of Emacs, as an integer.
978 return make_int(getpid());
981 DEFUN("current-time", Fcurrent_time, 0, 0, 0, /*
982 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
983 The time is returned as a list of three integers. The first has the
984 most significant 16 bits of the seconds, while the second has the
985 least significant 16 bits. The third integer gives the microsecond
988 The microsecond count is zero on systems that do not provide
989 resolution finer than a second.
996 return list3(make_int((EMACS_SECS(t) >> 16) & 0xffff),
997 make_int((EMACS_SECS(t) >> 0) & 0xffff),
998 make_int(EMACS_USECS(t)));
1001 #if defined(HAVE_MPZ) && defined(WITH_GMP)
1002 DEFUN("current-btime", Fcurrent_btime, 0, 0, 0, /*
1003 Return the current time, as the number of microseconds since
1004 1970-01-01 00:00:00.
1005 The time is returned as a big integer.
1016 bigz_set_long(btime, EMACS_SECS(t));
1017 mpz_mul_ui(btime, btime, 1000000UL);
1018 mpz_add_ui(btime, btime, EMACS_USECS(t));
1019 result = make_bigz_bz(btime);
1025 DEFUN("time-to-btime", Ftime_to_btime, 1, 1, 0, /*
1026 Return a big integer from SPECIFIED-TIME with the
1027 number of microseconds since the Epoch.
1031 if (CONSP(specified_time)) {
1034 Lisp_Object high, low, ulow;
1038 high = XCAR(specified_time);
1039 low = XCDR(specified_time);
1044 ulow = make_int(0L);
1052 bigz_set_ulong(bz, (XINT(high) << 16) + (XINT(low) & 0xffff));
1053 mpz_mul_ui(bz, bz, 1000000UL);
1054 mpz_add_ui(bz, bz, XINT(ulow));
1055 result = make_bigz_bz(bz);
1059 } else if (BIGZP(specified_time)) {
1060 return specified_time;
1062 CHECK_CONS(specified_time);
1067 DEFUN("btime-to-time", Fbtime_to_time, 1, 1, 0, /*
1068 Return a time specified as (HIGH LOW USEC) as obtainable
1069 from `current-time' from SPECIFIED-TIME.
1073 if (CONSP(specified_time)) {
1074 Lisp_Object high, low, ulow;
1076 high = XCAR(specified_time);
1077 low = XCDR(specified_time);
1082 ulow = make_int(0L);
1090 return list3(high, low, ulow);
1091 } else if (BIGZP(specified_time)) {
1100 mpz_tdiv_qr_ui(bh, bl, XBIGZ_DATA(specified_time), 1000000UL);
1101 highlow = bigz_to_long(bh);
1102 usecs = bigz_to_long(bl);
1103 result = list3(make_int((highlow >> 16) & 0xffff),
1104 make_int((highlow >> 0) & 0xffff),
1111 CHECK_BIGZ(specified_time);
1115 #endif /* HAVE_MPZ && WITH_MPZ */
1117 DEFUN("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
1118 Return the amount of time used by this SXEmacs process so far.
1119 The return value is a list of three floating-point numbers, expressing
1120 the user, system, and real times used by the process. The user time
1121 measures the time actually spent by the CPU executing the code in this
1122 process. The system time measures time spent by the CPU executing kernel
1123 code on behalf of this process (e.g. I/O requests made by the process).
1125 Note that the user and system times measure processor time, as opposed
1126 to real time, and only accrue when the processor is actually doing
1127 something: Time spent in an idle wait (waiting for user events to come
1128 in or for I/O on a disk drive or other device to complete) does not
1129 count. Thus, the user and system times will often be considerably
1130 less than the real time.
1132 Some systems do not allow the user and system times to be distinguished.
1133 In this case, the user time will be the total processor time used by
1134 the process, and the system time will be 0.
1136 Some systems do not allow the real and processor times to be distinguished.
1137 In this case, the user and real times will be the same and the system
1142 double user, sys, real;
1144 get_process_times(&user, &sys, &real);
1145 return list3(make_float(user), make_float(sys), make_float(real));
1148 DEFUN("uptime", Fuptime, 0, 1, "P", /*
1149 Display SXEmacs \"uptime\".
1151 When called interactively, without a prefix arg, return a list of 4
1152 integers, being the elapsed days, hours, minutes, and seconds that
1153 this SXEmacs process has been running. Display this info prettyfied
1156 With optional prefix arg, USR-SYS-REAL, return a list of 3 floats:
1157 user time, system time, and real time. Also displayed in the echo
1158 area if called interactively. See: `current-process-time' for more
1163 double usr, sys, real;
1164 unsigned int days, hours, minutes, seconds;
1166 days = hours = minutes = seconds = 0;
1167 get_process_times(&usr, &sys, &real);
1169 if (!NILP(usr_sys_real)) {
1170 if (!NILP(Finteractive_p()))
1171 message("User: %0.2f, System: %0.2f, Real: %0.6f\n",
1173 return list3(make_float(usr), make_float(sys), make_float(real));
1175 /* convert the real time to an int (with rounding) */
1176 real = (unsigned long) (real + 0.5);
1178 if (real >= 86400) {
1179 days = real / 86400;
1180 real = real - (days * 86400);
1183 hours = real / 3600;
1184 real = real - (hours * 3600);
1187 minutes = real / 60;
1188 real = real - (minutes * 60);
1192 if (!NILP(Finteractive_p())) {
1194 message("Uptime: %d days, %d hours, %d minutes, %d seconds\n",
1195 days, hours, minutes, seconds);
1197 message("Uptime: %d hours, %d minutes, %d seconds\n",
1198 hours, minutes, seconds);
1199 else if (minutes > 0)
1200 message("Uptime: %d minutes, %d seconds\n",
1202 else if (seconds > 0)
1203 message("Uptime: %d seconds\n", seconds);
1205 return list4(make_int(days), make_int(hours),
1206 make_int(minutes), make_int(seconds));
1210 int lisp_to_time(Lisp_Object specified_time, time_t * result);
1211 int lisp_to_time(Lisp_Object specified_time, time_t * result)
1213 Lisp_Object high, low;
1215 if (NILP(specified_time))
1216 return time(result) != -1;
1218 if (CONSP(specified_time)) {
1219 high = XCAR(specified_time);
1220 low = XCDR(specified_time);
1225 *result = (XINT(high) << 16) + (XINT(low) & 0xffff);
1226 return *result >> 16 == XINT(high);
1227 #if defined HAVE_MPZ && defined WITH_GMP
1228 } else if (BIGZP(specified_time)) {
1231 bigz_set_ulong(bz, 1000000UL);
1232 bigz_div(bz, XBIGZ_DATA(specified_time), bz);
1233 *result = bigz_to_ulong(bz);
1238 CHECK_CONS(specified_time);
1243 Lisp_Object time_to_lisp(time_t the_time);
1244 Lisp_Object time_to_lisp(time_t the_time)
1246 unsigned int item = (unsigned int)the_time;
1247 return Fcons(make_int(item >> 16), make_int(item & 0xffff));
1250 size_t emacs_strftime(char *string, size_t max, const char *format,
1251 const struct tm * tm);
1252 static long difftm(const struct tm *a, const struct tm *b);
1254 DEFUN("format-time-string", Fformat_time_string, 1, 2, 0, /*
1255 Use FORMAT-STRING to format the time TIME.
1256 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1257 `current-time' and `file-attributes'. If TIME is not specified it
1258 defaults to the current time.
1260 If compiled with ENT, TIME may also be a big integer representing
1261 the number of microseconds since the Epoch, as output by
1264 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1265 %a is replaced by the abbreviated name of the day of week.
1266 %A is replaced by the full name of the day of week.
1267 %b is replaced by the abbreviated name of the month.
1268 %B is replaced by the full name of the month.
1269 %c is a synonym for "%x %X".
1270 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1271 %d is replaced by the day of month, zero-padded.
1272 %D is a synonym for "%m/%d/%y".
1273 %e is replaced by the day of month, blank-padded.
1274 %h is a synonym for "%b".
1275 %H is replaced by the hour (00-23).
1276 %I is replaced by the hour (00-12).
1277 %j is replaced by the day of the year (001-366).
1278 %k is replaced by the hour (0-23), blank padded.
1279 %l is replaced by the hour (1-12), blank padded.
1280 %m is replaced by the month (01-12).
1281 %M is replaced by the minute (00-59).
1282 %n is a synonym for "\\n".
1283 %p is replaced by AM or PM, as appropriate.
1284 %r is a synonym for "%I:%M:%S %p".
1285 %R is a synonym for "%H:%M".
1286 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1287 nonstandard extension)
1288 %S is replaced by the second (00-60).
1289 %t is a synonym for "\\t".
1290 %T is a synonym for "%H:%M:%S".
1291 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1292 %w is replaced by the day of week (0-6), Sunday is day 0.
1293 %W is replaced by the week of the year (00-53), first day of week is Monday.
1294 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1295 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1296 %y is replaced by the year without century (00-99).
1297 %Y is replaced by the year with century.
1298 %Z is replaced by the time zone abbreviation.
1300 The number of options reflects the `strftime' function.
1302 BUG: If the charset used by the current locale is not ISO 8859-1, the
1303 characters appearing in the day and month names may be incorrect.
1305 (format_string, time_))
1311 CHECK_STRING(format_string);
1313 if (!lisp_to_time(time_, &value) || !(tm = localtime(&value)))
1314 error("Invalid time specification");
1316 /* This is probably enough. */
1317 size = XSTRING_LENGTH(format_string) * 6 + 50;
1320 char *buf = (char *)alloca(size);
1322 if (emacs_strftime(buf, size,
1323 (const char *)XSTRING_DATA(format_string),
1326 return build_ext_string(buf, Qbinary);
1327 /* If buffer was too small, make it bigger. */
1332 DEFUN("decode-time", Fdecode_time, 0, 1, 0, /*
1333 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1334 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1335 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1336 to use the current time.
1337 If compiled with ENT, SPECIFIED-TIME may also be a big integer as
1338 output from `current-btime', with the number of mircoseconds since
1341 The list has the following nine members:
1342 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1343 only some operating systems support.
1344 MINUTE is an integer between 0 and 59.
1345 HOUR is an integer between 0 and 23.
1346 DAY is an integer between 1 and 31.
1347 MONTH is an integer between 1 and 12.
1348 YEAR is an integer indicating the four-digit year.
1349 DOW is the day of week, an integer between 0 and 6, where 0 is Sunday.
1350 DST is t if daylight savings time is effect, otherwise nil.
1351 ZONE is an integer indicating the number of seconds east of Greenwich.
1352 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1358 struct tm *decoded_time;
1359 Lisp_Object list_args[9];
1361 if (!lisp_to_time(specified_time, &time_spec)
1362 || !(decoded_time = localtime(&time_spec)))
1363 error("Invalid time specification");
1365 list_args[0] = make_int(decoded_time->tm_sec);
1366 list_args[1] = make_int(decoded_time->tm_min);
1367 list_args[2] = make_int(decoded_time->tm_hour);
1368 list_args[3] = make_int(decoded_time->tm_mday);
1369 list_args[4] = make_int(decoded_time->tm_mon + 1);
1370 list_args[5] = make_int(decoded_time->tm_year + 1900);
1371 list_args[6] = make_int(decoded_time->tm_wday);
1372 list_args[7] = (decoded_time->tm_isdst) ? Qt : Qnil;
1374 /* Make a copy, in case gmtime modifies the struct. */
1375 save_tm = *decoded_time;
1376 decoded_time = gmtime(&time_spec);
1377 if (decoded_time == 0)
1378 list_args[8] = Qnil;
1380 list_args[8] = make_int(difftm(&save_tm, decoded_time));
1381 return Flist(9, list_args);
1384 static void set_time_zone_rule(char *tzstring);
1386 /* from GNU Emacs 21, per Simon Josefsson, modified by stephen
1387 The slight inefficiency is justified since negative times are weird. */
1388 Lisp_Object make_time(time_t tval)
1390 return list2(make_int(tval < 0 ? tval / 0x10000 : tval >> 16),
1391 make_int(tval & 0xFFFF));
1394 DEFUN("encode-time", Fencode_time, 6, MANY, 0, /*
1395 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1396 This is the reverse operation of `decode-time', which see.
1397 ZONE defaults to the current time zone rule. This can
1398 be a string (as from `set-time-zone-rule'), or it can be a list
1399 \(as from `current-time-zone') or an integer (as from `decode-time')
1400 applied without consideration for daylight savings time.
1402 You can pass more than 7 arguments; then the first six arguments
1403 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1404 The intervening arguments are ignored.
1405 This feature lets (apply 'encode-time (decode-time ...)) work.
1407 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1408 for example, a DAY of 0 means the day preceding the given month.
1409 Year numbers less than 100 are treated just like other year numbers.
1410 If you want them to stand for years in this century, you must do that yourself.
1412 (int nargs, Lisp_Object * args))
1416 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1419 tm.tm_sec = XINT(*args++); /* second */
1421 tm.tm_min = XINT(*args++); /* minute */
1423 tm.tm_hour = XINT(*args++); /* hour */
1425 tm.tm_mday = XINT(*args++); /* day */
1427 tm.tm_mon = XINT(*args++) - 1; /* month */
1429 tm.tm_year = XINT(*args++) - 1900; /* year */
1437 the_time = mktime(&tm);
1441 char **oldenv = environ, **newenv;
1443 if (STRINGP(zone)) {
1444 tzstring = (char *)XSTRING_DATA(zone);
1445 } else if (INTP(zone)) {
1446 int abszone = abs(XINT(zone));
1447 int sz = snprintf(tzbuf, sizeof(tzbuf), "XXX%s%d:%02d:%02d",
1448 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1449 (abszone / 60) % 60, abszone % 60);
1450 assert(sz >= 0 && (size_t)sz < sizeof(tzbuf));
1453 error("Invalid time zone specification");
1456 /* Set TZ before calling mktime; merely adjusting mktime's
1457 returned value doesn't suffice, since that would mishandle
1459 set_time_zone_rule(tzstring);
1461 the_time = mktime(&tm);
1463 /* Restore TZ to previous value. */
1466 #if !defined EF_USE_BDWGC
1468 #endif /* !EF_USE_BDWGC */
1469 #ifdef LOCALTIME_CACHE
1474 if (the_time == (time_t) - 1) {
1475 error("Specified time is not representable");
1478 return make_time(the_time);
1481 #if defined(HAVE_MPZ) && defined WITH_GMP
1482 DEFUN("encode-btime", Fencode_btime, 6, MANY, 0, /*
1483 Like `encode-time' but return a big integer time instead.
1486 (int nargs, Lisp_Object * args))
1490 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1495 tm.tm_sec = XINT(*args++); /* second */
1497 tm.tm_min = XINT(*args++); /* minute */
1499 tm.tm_hour = XINT(*args++); /* hour */
1501 tm.tm_mday = XINT(*args++); /* day */
1503 tm.tm_mon = XINT(*args++) - 1; /* month */
1505 tm.tm_year = XINT(*args++) - 1900; /* year */
1512 the_time = mktime(&tm);
1516 char **oldenv = environ, **newenv;
1519 tzstring = (char *)XSTRING_DATA(zone);
1520 else if (INTP(zone)) {
1521 int abszone = abs(XINT(zone));
1522 int sz = snprintf(tzbuf, sizeof(tzbuf), "XXX%s%d:%02d:%02d",
1523 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1524 (abszone / 60) % 60, abszone % 60);
1525 assert(sz>=0 && (size_t)sz < sizeof(tzbuf));
1528 error("Invalid time zone specification");
1530 /* Set TZ before calling mktime; merely adjusting mktime's returned
1531 value doesn't suffice, since that would mishandle leap seconds. */
1532 set_time_zone_rule(tzstring);
1534 the_time = mktime(&tm);
1536 /* Restore TZ to previous value. */
1540 #ifdef LOCALTIME_CACHE
1545 if (the_time == (time_t) - 1)
1546 error("Specified time is not representable");
1549 bigz_set_ulong(bz, the_time);
1550 mpz_mul_ui(bz, bz, 1000000UL);
1551 result = make_bigz_bz(bz);
1558 DEFUN("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1559 Return the current time, as a human-readable string.
1560 Programs can use this function to decode a time,
1561 since the number of columns in each field is fixed.
1562 The format is `Sun Sep 16 01:03:52 1973'.
1563 If an argument is given, it specifies a time to format
1564 instead of the current time. The argument should have the form:
1567 (HIGH LOW . IGNORED).
1568 Thus, you can use times obtained from `current-time'
1569 and from `file-attributes'.
1571 If compiled with ENT, SPECIFIED-TIME may also be a big integer
1572 as obtained from `current-btime' with the number of microseconds
1581 if (!lisp_to_time(specified_time, &value))
1583 the_ctime = ctime(&value);
1585 /* ctime is documented as always returning a "\n\0"-terminated
1586 26-byte American time string, but let's be careful anyways. */
1587 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++) ;
1589 return make_ext_string((Extbyte *) the_ctime, len, Qbinary);
1592 #define TM_YEAR_ORIGIN 1900
1594 /* Yield A - B, measured in seconds. */
1595 static long difftm(const struct tm *a, const struct tm *b)
1597 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1598 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1599 /* Some compilers can't handle this as a single return statement. */
1601 /* difference in day of year */
1602 a->tm_yday - b->tm_yday
1603 /* + intervening leap days */
1604 + ((ay >> 2) - (by >> 2))
1605 - (ay / 100 - by / 100)
1606 + ((ay / 100 >> 2) - (by / 100 >> 2))
1607 /* + difference in years * 365 */
1608 + (long)(ay - by) * 365);
1609 return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
1610 + (a->tm_min - b->tm_min))
1611 + (a->tm_sec - b->tm_sec));
1614 DEFUN("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1615 Return the offset and name for the local time zone.
1616 This returns a list of the form (OFFSET NAME).
1617 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1618 A negative value means west of Greenwich.
1619 NAME is a string giving the name of the time zone.
1620 If an argument is given, it specifies when the time zone offset is determined
1621 instead of using the current time. The argument should have the form:
1624 (HIGH LOW . IGNORED).
1625 Thus, you can use times obtained from `current-time'
1626 and from `file-attributes'.
1628 Some operating systems cannot provide all this information to Emacs;
1629 in this case, `current-time-zone' returns a list containing nil for
1630 the data it can't find.
1635 struct tm *t = NULL;
1637 if (lisp_to_time(specified_time, &value)
1638 && (t = gmtime(&value)) != 0) {
1639 /* Make a copy, in case localtime modifies *t. */
1645 t = localtime(&value);
1646 offset = difftm(t, &gmt);
1650 s = (const char *)t->tm_zone;
1651 #else /* not HAVE_TM_ZONE */
1653 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1654 s = tzname[t->tm_isdst];
1656 #endif /* not HAVE_TM_ZONE */
1658 /* No local time zone name is available; use "+-NNNN"
1660 int am = (offset < 0 ? -offset : offset) / 60;
1661 int sz = snprintf(buf, sizeof(buf), "%c%02d%02d",
1662 (offset < 0 ? '-' : '+'),
1664 assert(sz>=0 && (size_t)sz < sizeof(buf));
1667 return list2(make_int(offset), build_string(s));
1669 return list2(Qnil, Qnil);
1673 #ifdef LOCALTIME_CACHE
1675 /* These two values are known to load tz files in buggy implementations,
1676 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1677 Their values shouldn't matter in non-buggy implementations.
1678 We don't use string literals for these strings,
1679 since if a string in the environment is in readonly
1680 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1681 See Sun bugs 1113095 and 1114114, ``Timezone routines
1682 improperly modify environment''. */
1684 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1685 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1689 /* Set the local time zone rule to TZSTRING.
1690 This allocates memory into `environ', which it is the caller's
1691 responsibility to free. */
1692 static void set_time_zone_rule(char *tzstring)
1695 char **from, **to, **newenv;
1697 for (from = environ; *from; from++)
1699 envptrs = from - environ + 2;
1700 newenv = to = (char **)xmalloc(envptrs * sizeof(char *)
1701 + (tzstring ? strlen(tzstring) + 4 : 0));
1703 char *t = (char *)(to + envptrs);
1705 strcat(t, tzstring);
1709 for (from = environ; *from; from++)
1710 if (strncmp(*from, "TZ=", 3) != 0)
1716 #ifdef LOCALTIME_CACHE
1718 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1719 "US/Pacific" that loads a tz file, then changes to a value like
1720 "XXX0" that does not load a tz file, and then changes back to
1721 its original value, the last change is (incorrectly) ignored.
1722 Also, if TZ changes twice in succession to values that do
1723 not load a tz file, tzset can dump core (see Sun bug#1225179).
1724 The following code works around these bugs. */
1727 /* Temporarily set TZ to a value that loads a tz file
1728 and that differs from tzstring. */
1731 (strcmp(tzstring, set_time_zone_rule_tz1 + 3) ==
1732 0 ? set_time_zone_rule_tz2 :
1733 set_time_zone_rule_tz1);
1737 /* The implied tzstring is unknown, so temporarily set TZ to
1738 two different values that each load a tz file. */
1739 *to = set_time_zone_rule_tz1;
1742 *to = set_time_zone_rule_tz2;
1747 /* Now TZ has the desired value, and tzset can be invoked safely. */
1754 DEFUN("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1755 Set the local time zone using TZ, a string specifying a time zone rule.
1756 If TZ is nil, use implementation-defined default time zone information.
1766 tzstring = (char *)XSTRING_DATA(tz);
1769 set_time_zone_rule(tzstring);
1772 environbuf = environ;
1777 void buffer_insert1(struct buffer *buf, Lisp_Object arg)
1779 /* This function can GC */
1780 struct gcpro gcpro1;
1783 if (CHAR_OR_CHAR_INTP(arg)) {
1784 buffer_insert_emacs_char(buf, XCHAR_OR_CHAR_INT(arg));
1785 } else if (STRINGP(arg)) {
1786 buffer_insert_lisp_string(buf, arg);
1788 arg = wrong_type_argument(Qchar_or_string_p, arg);
1794 /* Callers passing one argument to Finsert need not gcpro the
1795 argument "array", since the only element of the array will
1796 not be used after calling insert_emacs_char or insert_lisp_string,
1797 so we don't care if it gets trashed. */
1799 DEFUN("insert", Finsert, 0, MANY, 0, /*
1800 Insert the arguments, either strings or characters, at point.
1801 Point moves forward so that it ends up after the inserted text.
1802 Any other markers at the point of insertion remain before the text.
1803 If a string has non-null string-extent-data, new extents will be created.
1805 (int nargs, Lisp_Object * args))
1807 /* This function can GC */
1808 REGISTER int argnum;
1810 for (argnum = 0; argnum < nargs; argnum++) {
1811 buffer_insert1(current_buffer, args[argnum]);
1817 DEFUN("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1818 Insert strings or characters at point, relocating markers after the text.
1819 Point moves forward so that it ends up after the inserted text.
1820 Any other markers at the point of insertion also end up after the text.
1822 (int nargs, Lisp_Object * args))
1824 /* This function can GC */
1825 REGISTER int argnum;
1826 REGISTER Lisp_Object tem;
1828 for (argnum = 0; argnum < nargs; argnum++) {
1831 if (CHAR_OR_CHAR_INTP(tem)) {
1832 buffer_insert_emacs_char_1(current_buffer, -1,
1833 XCHAR_OR_CHAR_INT(tem),
1834 INSDEL_BEFORE_MARKERS);
1835 } else if (STRINGP(tem)) {
1836 buffer_insert_lisp_string_1(current_buffer, -1, tem,
1837 INSDEL_BEFORE_MARKERS);
1839 tem = wrong_type_argument(Qchar_or_string_p, tem);
1846 DEFUN("insert-string", Finsert_string, 1, 2, 0, /*
1847 Insert STRING into BUFFER at BUFFER's point.
1848 Point moves forward so that it ends up after the inserted text.
1849 Any other markers at the point of insertion remain before the text.
1850 If a string has non-null, duplicable string-extent-data, new extents will be created.
1851 BUFFER defaults to the current buffer.
1855 struct buffer *b = decode_buffer(buffer, 1);
1856 CHECK_STRING(string);
1857 buffer_insert_lisp_string(b, string);
1861 /* Third argument in FSF is INHERIT:
1863 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1864 from adjoining text, if those properties are sticky."
1866 Jamie thinks this is bogus. */
1868 DEFUN("insert-char", Finsert_char, 1, 4, 0, /*
1869 Insert COUNT copies of CHARACTER into BUFFER.
1870 Point and all markers are affected as in the function `insert'.
1871 COUNT defaults to 1 if omitted.
1872 The optional third arg IGNORED is INHERIT under FSF Emacs.
1873 This is highly bogus, however, and SXEmacs always behaves as if
1874 `t' were passed to INHERIT.
1875 The optional fourth arg BUFFER specifies the buffer to insert the
1876 text into. If BUFFER is nil, the current buffer is assumed.
1878 (character, count, ignored, buffer))
1880 /* This function can GC */
1881 REGISTER Bufbyte *string;
1884 REGISTER Bytecount n;
1885 REGISTER Bytecount charlen;
1886 Bufbyte str[MAX_EMCHAR_LEN];
1887 struct buffer *b = decode_buffer(buffer, 1);
1890 CHECK_CHAR_COERCE_INT(character);
1898 charlen = set_charptr_emchar(str, XCHAR(character));
1903 string = alloca_array(Bufbyte, slen);
1904 /* Write as many copies of the character into the temp string as will fit. */
1905 for (i = 0; i + charlen <= slen; i += charlen)
1906 for (j = 0; j < charlen; j++)
1907 string[i + j] = str[j];
1910 buffer_insert_raw_string(b, string, slen);
1914 #if 0 /* FSFmacs bogosity */
1917 insert_and_inherit(string, n);
1922 buffer_insert_raw_string(b, string, n);
1928 /* Making strings from buffer contents. */
1930 DEFUN("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1931 Return the contents of part of BUFFER as a string.
1932 The two arguments START and END are character positions;
1933 they can be in either order. If omitted, they default to the beginning
1934 and end of BUFFER, respectively.
1935 If there are duplicable extents in the region, the string remembers
1936 them in its extent data.
1937 If BUFFER is nil, the current buffer is assumed.
1939 (start, end, buffer))
1941 /* This function can GC */
1943 struct buffer *b = decode_buffer(buffer, 1);
1945 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1946 return make_string_from_buffer(b, begv, zv - begv);
1949 /* It might make more sense to name this
1950 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1951 and what the function does is probably good enough for what the
1952 user-code will typically want to use it for. */
1953 DEFUN("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1954 Return the text from START to END as a string, without copying the extents.
1956 (start, end, buffer))
1958 /* This function can GC */
1960 struct buffer *b = decode_buffer(buffer, 1);
1962 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1963 return make_string_from_buffer_no_extents(b, begv, zv - begv);
1966 DEFUN("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1967 Insert before point a substring of the contents of buffer BUFFER.
1968 BUFFER may be a buffer or a buffer name.
1969 Arguments START and END are character numbers specifying the substring.
1970 They default to the beginning and the end of BUFFER.
1972 (buffer, start, end))
1974 /* This function can GC */
1977 Lisp_Object tmp_buf = emacs_get_buffer(buffer, 1);
1979 bp = XBUFFER(tmp_buf);
1980 get_buffer_range_char(bp, start, end, &b, &e, GB_ALLOW_NIL);
1983 buffer_insert_from_buffer(current_buffer, bp, b, e - b);
1988 DEFUN("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1989 Compare two substrings of two buffers; return result as number.
1990 the value is -N if first string is less after N-1 chars,
1991 +N if first string is greater after N-1 chars, or 0 if strings match.
1992 Each substring is represented as three arguments: BUFFER, START and END.
1993 That makes six args in all, three for each substring.
1995 The value of `case-fold-search' in the current buffer
1996 determines whether case is significant or ignored.
1998 (buffer1, start1, end1, buffer2, start2, end2))
2000 Bufpos begp1, endp1, begp2, endp2;
2001 REGISTER Charcount len1, len2, length, i;
2002 struct buffer *bp1, *bp2;
2003 Lisp_Object trt = ((!NILP(current_buffer->case_fold_search)) ?
2004 XCASE_TABLE_CANON(current_buffer->
2005 case_table) : Qnil);
2007 /* Find the first buffer and its substring. */
2009 bp1 = decode_buffer(buffer1, 1);
2010 get_buffer_range_char(bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
2012 /* Likewise for second substring. */
2014 bp2 = decode_buffer(buffer2, 1);
2015 get_buffer_range_char(bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
2017 len1 = endp1 - begp1;
2018 len2 = endp2 - begp2;
2023 for (i = 0; i < length; i++) {
2024 Emchar c1 = BUF_FETCH_CHAR(bp1, begp1 + i);
2025 Emchar c2 = BUF_FETCH_CHAR(bp2, begp2 + i);
2027 c1 = TRT_TABLE_OF(trt, c1);
2028 c2 = TRT_TABLE_OF(trt, c2);
2031 return make_int(-1 - i);
2033 return make_int(i + 1);
2036 /* The strings match as far as they go.
2037 If one is shorter, that one is less. */
2039 return make_int(length + 1);
2040 else if (length < len2)
2041 return make_int(-length - 1);
2043 /* Same length too => they are equal. */
2047 static Lisp_Object subst_char_in_region_unwind(Lisp_Object arg)
2049 XBUFFER(XCAR(arg))->undo_list = XCDR(arg);
2053 static Lisp_Object subst_char_in_region_unwind_1(Lisp_Object arg)
2055 XBUFFER(XCAR(arg))->filename = XCDR(arg);
2059 DEFUN("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
2060 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
2061 If optional arg NOUNDO is non-nil, don't record this change for undo
2062 and don't mark the buffer as really changed.
2064 (start, end, fromchar, tochar, noundo))
2066 /* This function can GC */
2070 struct buffer *buf = current_buffer;
2071 int count = specpdl_depth();
2073 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
2074 CHECK_CHAR_COERCE_INT(fromchar);
2075 CHECK_CHAR_COERCE_INT(tochar);
2077 fromc = XCHAR(fromchar);
2078 toc = XCHAR(tochar);
2080 /* If we don't want undo, turn off putting stuff on the list.
2081 That's faster than getting rid of things,
2082 and it prevents even the entry for a first change.
2083 Also inhibit locking the file. */
2084 if (!NILP(noundo)) {
2085 record_unwind_protect(subst_char_in_region_unwind,
2086 Fcons(Fcurrent_buffer(), buf->undo_list));
2087 buf->undo_list = Qt;
2088 /* Don't do file-locking. */
2089 record_unwind_protect(subst_char_in_region_unwind_1,
2090 Fcons(Fcurrent_buffer(), buf->filename));
2091 buf->filename = Qnil;
2094 mc_count = begin_multiple_change(buf, pos, stop);
2095 while (pos < stop) {
2096 if (BUF_FETCH_CHAR(buf, pos) == fromc) {
2097 /* There used to be some code here that set the buffer to
2098 unmodified if NOUNDO was specified and there was only
2099 one change to the buffer since it was last saved.
2100 This is a crock of shit, so I'm not duplicating this
2101 behavior. I think this was left over from when
2102 prepare_to_modify_buffer() actually bumped MODIFF,
2103 so that code was supposed to undo this change. --ben */
2104 buffer_replace_char(buf, pos, toc, !NILP(noundo), 0);
2106 /* If noundo is not nil then we don't mark the buffer as
2107 modified. In reality that needs to happen externally
2108 only. Internally redisplay needs to know that the actual
2109 contents it should be displaying have changed. */
2111 Fset_buffer_modified_p(Fbuffer_modified_p(Qnil),
2116 end_multiple_change(buf, mc_count);
2118 unbind_to(count, Qnil);
2122 /* #### Shouldn't this also accept a BUFFER argument, in the good old
2123 XEmacs tradition? */
2124 DEFUN("translate-region", Ftranslate_region, 3, 3, 0, /*
2125 Translate characters from START to END according to TABLE.
2127 If TABLE is a string, the Nth character in it is the mapping for the
2128 character with code N.
2130 If TABLE is a vector, its Nth element is the mapping for character
2131 with code N. The values of elements may be characters, strings, or
2132 nil (nil meaning don't replace.)
2134 If TABLE is a char-table, its elements describe the mapping between
2135 characters and their replacements. The char-table should be of type
2136 `char' or `generic'.
2138 Returns the number of substitutions performed.
2140 (start, end, table))
2142 /* This function can GC */
2143 Bufpos pos, stop; /* Limits of the region. */
2144 int cnt = 0; /* Number of changes made. */
2146 struct buffer *buf = current_buffer;
2149 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
2150 mc_count = begin_multiple_change(buf, pos, stop);
2151 if (STRINGP(table)) {
2152 Lisp_String *stable = XSTRING(table);
2153 Charcount size = string_char_length(stable);
2155 /* Under Mule, string_char(n) is O(n), so for large tables or
2156 large regions it makes sense to create an array of Emchars. */
2157 if (size * (stop - pos) > 65536) {
2158 Emchar *etable = alloca_array(Emchar, size);
2159 convert_bufbyte_string_into_emchar_string
2160 (string_data(stable), string_length(stable),
2162 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2165 Emchar nc = etable[oc];
2167 buffer_replace_char(buf, pos,
2176 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2179 Emchar nc = string_char(stable, oc);
2181 buffer_replace_char(buf, pos,
2188 } else if (VECTORP(table)) {
2189 Charcount size = XVECTOR_LENGTH(table);
2190 Lisp_Object *vtable = XVECTOR_DATA(table);
2192 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2194 Lisp_Object replacement = vtable[oc];
2196 if (CHAR_OR_CHAR_INTP(replacement)) {
2198 XCHAR_OR_CHAR_INT(replacement);
2200 buffer_replace_char(buf, pos,
2204 } else if (STRINGP(replacement)) {
2206 XSTRING_CHAR_LENGTH(replacement) -
2208 buffer_delete_range(buf, pos, pos + 1,
2210 buffer_insert_lisp_string_1(buf, pos,
2213 pos += incr, stop += incr;
2215 } else if (!NILP(replacement)) {
2218 (Qchar_or_string_p, replacement);
2223 } else if (CHAR_TABLEP(table)
2224 && (XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_GENERIC
2225 || XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_CHAR)) {
2226 Lisp_Char_Table *ctable = XCHAR_TABLE(table);
2228 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2229 Lisp_Object replacement = get_char_table(oc, ctable);
2231 if (CHAR_OR_CHAR_INTP(replacement)) {
2232 Emchar nc = XCHAR_OR_CHAR_INT(replacement);
2234 buffer_replace_char(buf, pos, nc, 0, 0);
2237 } else if (STRINGP(replacement)) {
2239 XSTRING_CHAR_LENGTH(replacement) - 1;
2240 buffer_delete_range(buf, pos, pos + 1, 0);
2241 buffer_insert_lisp_string_1(buf, pos,
2243 pos += incr, stop += incr;
2245 } else if (!NILP(replacement)) {
2247 wrong_type_argument(Qchar_or_string_p,
2253 dead_wrong_type_argument(Qstringp, table);
2254 end_multiple_change(buf, mc_count);
2256 return make_int(cnt);
2259 DEFUN("delete-region", Fdelete_region, 2, 3, "r", /*
2260 Delete the text between point and mark.
2261 When called from a program, expects two arguments START and END
2262 \(integers or markers) specifying the stretch to be deleted.
2263 If optional third arg BUFFER is nil, the current buffer is assumed.
2265 (start, end, buffer))
2267 /* This function can GC */
2268 Bufpos bp_start, bp_end;
2269 struct buffer *buf = decode_buffer(buffer, 1);
2271 get_buffer_range_char(buf, start, end, &bp_start, &bp_end, 0);
2272 buffer_delete_range(buf, bp_start, bp_end, 0);
2276 void widen_buffer(struct buffer *b, int no_clip)
2278 if (BUF_BEGV(b) != BUF_BEG(b)) {
2280 SET_BOTH_BUF_BEGV(b, BUF_BEG(b), BI_BUF_BEG(b));
2282 if (BUF_ZV(b) != BUF_Z(b)) {
2284 SET_BOTH_BUF_ZV(b, BUF_Z(b), BI_BUF_Z(b));
2289 /* Changing the buffer bounds invalidates any recorded current
2291 invalidate_current_column();
2292 narrow_line_number_cache(b);
2296 DEFUN("widen", Fwiden, 0, 1, "", /*
2297 Remove restrictions (narrowing) from BUFFER.
2298 This allows the buffer's full text to be seen and edited.
2299 If BUFFER is nil, the current buffer is assumed.
2303 struct buffer *b = decode_buffer(buffer, 1);
2308 DEFUN("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2309 Restrict editing in BUFFER to the current region.
2310 The rest of the text becomes temporarily invisible and untouchable
2311 but is not deleted; if you save the buffer in a file, the invisible
2312 text is included in the file. \\[widen] makes all visible again.
2313 If BUFFER is nil, the current buffer is assumed.
2314 See also `save-restriction'.
2316 When calling from a program, pass two arguments; positions (integers
2317 or markers) bounding the text that should remain visible.
2319 (start, end, buffer))
2321 Bufpos bp_start, bp_end;
2322 struct buffer *buf = decode_buffer(buffer, 1);
2323 Bytind bi_start, bi_end;
2325 get_buffer_range_char(buf, start, end, &bp_start, &bp_end,
2326 GB_ALLOW_PAST_ACCESSIBLE);
2327 bi_start = bufpos_to_bytind(buf, bp_start);
2328 bi_end = bufpos_to_bytind(buf, bp_end);
2330 SET_BOTH_BUF_BEGV(buf, bp_start, bi_start);
2331 SET_BOTH_BUF_ZV(buf, bp_end, bi_end);
2332 if (BUF_PT(buf) < bp_start)
2333 BUF_SET_PT(buf, bp_start);
2334 if (BUF_PT(buf) > bp_end)
2335 BUF_SET_PT(buf, bp_end);
2337 /* Changing the buffer bounds invalidates any recorded current column. */
2338 invalidate_current_column();
2339 narrow_line_number_cache(buf);
2343 Lisp_Object save_restriction_save(void)
2345 Lisp_Object bottom, top;
2346 /* Note: I tried using markers here, but it does not win
2347 because insertion at the end of the saved region
2348 does not advance mh and is considered "outside" the saved region. */
2349 bottom = make_int(BUF_BEGV(current_buffer) - BUF_BEG(current_buffer));
2350 top = make_int(BUF_Z(current_buffer) - BUF_ZV(current_buffer));
2352 return noseeum_cons(Fcurrent_buffer(), noseeum_cons(bottom, top));
2355 Lisp_Object save_restriction_restore(Lisp_Object data)
2358 Charcount newhead, newtail;
2360 int local_clip_changed = 0;
2362 buf = XBUFFER(XCAR(data));
2363 if (!BUFFER_LIVE_P(buf)) {
2364 /* someone could have killed the buffer in the meantime ... */
2365 free_cons(XCONS(XCDR(data)));
2366 free_cons(XCONS(data));
2370 newhead = XINT(XCAR(tem));
2371 newtail = XINT(XCDR(tem));
2373 free_cons(XCONS(XCDR(data)));
2374 free_cons(XCONS(data));
2376 if (newhead + newtail > BUF_Z(buf) - BUF_BEG(buf)) {
2383 Bytind bi_start, bi_end;
2385 start = BUF_BEG(buf) + newhead;
2386 end = BUF_Z(buf) - newtail;
2388 bi_start = bufpos_to_bytind(buf, start);
2389 bi_end = bufpos_to_bytind(buf, end);
2391 if (BUF_BEGV(buf) != start) {
2392 local_clip_changed = 1;
2393 SET_BOTH_BUF_BEGV(buf, start, bi_start);
2394 narrow_line_number_cache(buf);
2396 if (BUF_ZV(buf) != end) {
2397 local_clip_changed = 1;
2398 SET_BOTH_BUF_ZV(buf, end, bi_end);
2401 if (local_clip_changed)
2404 /* If point is outside the new visible range, move it inside. */
2406 bufpos_clip_to_bounds(BUF_BEGV(buf),
2407 BUF_PT(buf), BUF_ZV(buf)));
2412 DEFUN("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2413 Execute BODY, saving and restoring current buffer's restrictions.
2414 The buffer's restrictions make parts of the beginning and end invisible.
2415 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2416 This special form, `save-restriction', saves the current buffer's restrictions
2417 when it is entered, and restores them when it is exited.
2418 So any `narrow-to-region' within BODY lasts only until the end of the form.
2419 The old restrictions settings are restored
2420 even in case of abnormal exit (throw or error).
2422 The value returned is the value of the last form in BODY.
2424 `save-restriction' can get confused if, within the BODY, you widen
2425 and then make changes outside the area within the saved restrictions.
2427 Note: if you are using both `save-excursion' and `save-restriction',
2428 use `save-excursion' outermost:
2429 (save-excursion (save-restriction ...))
2433 /* This function can GC */
2434 int speccount = specpdl_depth();
2436 record_unwind_protect(save_restriction_restore,
2437 save_restriction_save());
2439 return unbind_to(speccount, Fprogn(body));
2442 DEFUN("format", Fformat, 1, MANY, 0, /*
2443 Return a formatted string out of a format string and arguments.
2445 Arguments: string &rest objects
2447 Hereby, STRING is the format string (also known as template) which
2448 consists of constant (immutable) portions and so called format
2449 specifiers (%-specs). For details on these see below.
2451 The remaining arguments, OBJECTS, are substituted into the format
2452 string to make the result, a string. The exact influence of OBJECTS
2453 on the final result is described below. In general, OBJECTS will be
2454 the lisp objects to be printed.
2458 The format string STRING is basically an ordinary string enriched with
2459 %-sequences (also known as specifiers or specs for short). The specs
2460 in STRING will be substituted for the according object in OBJECTS, to
2461 be precise with a string representation of the object. In the simplest
2462 case, the first specifier in STRING corresponds to the first element
2463 in OBJECTS, the second specifier corresponds to the second element, and
2466 The specifiers themselves look like
2467 %[r$][#][&][ ][+][~][0][-]['][!a][m][.p|*]{sSdioxXbucfeEgGZQFRBC}
2471 %s means print all objects as-is, using `princ'.
2472 %S means print all objects as s-expressions, using `prin1'.
2475 %d means print as an integer in decimal
2476 %i means print as an integer in decimal
2477 %o means print as an integer in octal
2478 %x means print as an integer in lowercase hex
2479 %X means print as an integer in uppercase hex
2480 %b means print as an integer in binary
2481 %u means print a non-negative integer.
2482 %c means print as a single character.
2485 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2486 %e or %E means print as a floating-point number in scientific notation
2488 %g or %G means print as a floating-point number in "pretty format";
2489 depending on the number, either %f or %e/%E format will be used, and
2490 trailing zeroes are removed from the fractional part.
2491 The argument used for all but %s and %S must be a number. It will be
2492 converted to an integer or a floating-point number as necessary.
2493 Please bear in mind that floating point numbers have a limited and fixed
2494 precision although the print output may suggest something else.
2495 The precision varies (depending on the machine) between 12 and 38 digits.
2496 This means if you use specifiers like %.60f on 1.0 or 1.5 only the first
2497 12 to 38 digits are real. Also note, that internally numbers are processed
2498 in a 2-adic arithmetic, so you may experience strange rounding effects,
2499 e.g. %.60f on 1.2 or %f on 1e+40, this is because you force the printer to
2500 be more precise than actually valid. No error is thrown in these cases!
2502 If SXEmacs was compiled with GMP support the following additional
2503 specifiers become available:
2504 %Z means print as big integer (convert to bigz)
2505 %Q means print as fraction (convert to bigq)
2506 %F means print as bigfr or bigf float (convert to in that order)
2507 this specifier always converts the argument, regardless the
2508 value of `read-real-as'
2509 %R means print as real number (convert to bigfr, bigf or float)
2510 this specifier respects the value of `read-real-as'
2511 %B means print as Gaussian number (convert to bigg)
2512 %C means print as complex number (convert to bigc)
2514 Both %B and %C are actually rewrites to %Z%+Z and %F%+F with the
2515 argument rewritten to (real-part arg) (imaginary-part arg).
2516 Flags are passed on to at least the real part specifier.
2520 Using above notation there are several tweaks, so called modifiers,
2521 to fine-tune the substitution. Modifiers are completely optional.
2524 r$ use the `r'-th element of OBJECTS instead the one in order
2525 # print 0x, 0o, 0b prefix for numbers in a different base
2526 & use lisp syntax for base!=10 numbers, as in #x73, implies ~
2527 if non-negative print a place holder ` ' for a sign, `-' otherwise
2528 + always print a sign, `-' if negative and `+' if non-negative
2529 ~ in conjunction with `#' and signed numbers print sign after 0[xob]
2530 0 pad numbers (only on the left) with zeroes instead of spaces
2532 ' group numbers in groups of three
2533 !a use `a' as pad character instead of space
2534 m specify a minimum width of the yielded string
2535 .p use `p' digits of precision, depends on the specifer
2536 * use the argument in order to obtain the precision
2538 %$ means reposition to read a specific numbered argument; for example,
2539 %3$s would apply the `%s' to the third argument after the control string,
2540 and the next format directive would use the fourth argument, the
2541 following one the fifth argument, etc. (There must be a positive integer
2542 between the % and the $).
2544 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2545 specified between the optional repositioning spec and the conversion
2546 character; see below.
2548 An optional minimum field width may be specified after any flag characters
2549 and before the conversion character; it specifies the minimum number of
2550 characters that the converted argument will take up. Padding will be
2551 added on the left (or on the right, if the `-' flag is specified), as
2552 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2555 If the field width is specified as `*', the field width is assumed to have
2556 been specified as an argument. Any repositioning specification that
2557 would normally specify the argument to be converted will now specify
2558 where to find this field width argument, not where to find the argument
2559 to be converted. If there is no repositioning specification, the normal
2560 next argument is used. The argument to be converted will be the next
2561 argument after the field width argument unless the precision is also
2562 specified as `*' (see below).
2564 An optional period character and precision may be specified after any
2565 minimum field width. It specifies the minimum number of digits to
2566 appear in %d, %i, %b, %o, %x, and %X conversions (the number is padded
2567 on the left with zeroes as necessary); the number of digits printed
2568 after the decimal point for %f, %e, and %E conversions; the number
2569 of significant digits printed in %g and %G conversions; and the
2570 maximum number of non-padding characters printed in %s and %S
2571 conversions. The default precision for floating-point conversions
2574 If the precision is specified as `*', the precision is assumed to have been
2575 specified as an argument. The argument used will be the next argument
2576 after the field width argument, if any. If the field width was not
2577 specified as an argument, any repositioning specification that would
2578 normally specify the argument to be converted will now specify where to
2579 find the precision argument. If there is no repositioning specification,
2580 the normal next argument is used.
2582 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2583 plus sign, respectively.
2585 The `#' flag means print numbers in an alternate, more verbose format:
2586 octal numbers begin with 0o; hex numbers begin with a 0x or 0X;
2587 and binary representations start with 0b;
2588 a decimal point is printed in %f, %e, and %E conversions even if no
2589 numbers are printed after it; and trailing zeroes are not omitted in
2590 %g and %G conversions.
2592 Use %% to put a single % into the output.
2594 (int nargs, Lisp_Object * args))
2596 /* It should not be necessary to GCPRO ARGS, because
2597 the caller in the interpreter should take care of that. */
2599 CHECK_STRING(args[0]);
2600 return emacs_doprnt_string_lisp(0, args[0], 0, nargs - 1, args + 1);
2603 DEFUN("char-equal", Fchar_equal, 2, 3, 0, /*
2604 Return t if two characters match, optionally ignoring case.
2605 Both arguments must be characters (i.e. NOT integers).
2606 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2607 If BUFFER is nil, the current buffer is assumed.
2609 (character1, character2, buffer))
2612 struct buffer *b = decode_buffer(buffer, 1);
2614 CHECK_CHAR_COERCE_INT(character1);
2615 CHECK_CHAR_COERCE_INT(character2);
2616 x1 = XCHAR(character1);
2617 x2 = XCHAR(character2);
2619 return (!NILP(b->case_fold_search)
2620 ? DOWNCASE(b, x1) == DOWNCASE(b, x2)
2625 DEFUN("char=", Fchar_Equal, 2, 2, 0, /*
2626 Return t if two characters match, case is significant.
2627 Both arguments must be characters (i.e. NOT integers).
2629 (character1, character2))
2631 CHECK_CHAR_COERCE_INT(character1);
2632 CHECK_CHAR_COERCE_INT(character2);
2634 return EQ(character1, character2) ? Qt : Qnil;
2637 #if 0 /* Undebugged FSFmacs code */
2638 /* Transpose the markers in two regions of the current buffer, and
2639 adjust the ones between them if necessary (i.e.: if the regions
2642 Traverses the entire marker list of the buffer to do so, adding an
2643 appropriate amount to some, subtracting from some, and leaving the
2644 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2646 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2648 void transpose_markers(Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2650 Charcount amt1, amt2, diff;
2652 struct buffer *buf = current_buffer;
2654 /* Update point as if it were a marker. */
2655 if (BUF_PT(buf) < start1) ;
2656 else if (BUF_PT(buf) < end1)
2657 BUF_SET_PT(buf, BUF_PT(buf) + (end2 - end1));
2658 else if (BUF_PT(buf) < start2)
2660 BUF_PT(buf) + (end2 - start2) - (end1 - start1));
2661 else if (BUF_PT(buf) < end2)
2662 BUF_SET_PT(buf, BUF_PT(buf) - (start2 - start1));
2664 /* We used to adjust the endpoints here to account for the gap, but that
2665 isn't good enough. Even if we assume the caller has tried to move the
2666 gap out of our way, it might still be at start1 exactly, for example;
2667 and that places it `inside' the interval, for our purposes. The amount
2668 of adjustment is nontrivial if there's a `denormalized' marker whose
2669 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2670 the dirty work to Fmarker_position, below. */
2672 /* The difference between the region's lengths */
2673 diff = (end2 - start2) - (end1 - start1);
2675 /* For shifting each marker in a region by the length of the other
2676 * region plus the distance between the regions.
2678 amt1 = (end2 - start2) + (start2 - end1);
2679 amt2 = (end1 - start1) + (start2 - end1);
2681 for (marker = BUF_MARKERS(buf); !NILP(marker);
2682 marker = XMARKER(marker)->chain) {
2683 Bufpos mpos = marker_position(marker);
2684 if (mpos >= start1 && mpos < end2) {
2687 else if (mpos < start2)
2691 set_marker_position(marker, mpos);
2698 DEFUN("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2699 Transpose region START1 to END1 with START2 to END2.
2700 The regions may not be overlapping, because the size of the buffer is
2701 never changed in a transposition.
2703 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
2704 any markers that happen to be located in the regions. (#### BUG: currently
2705 this function always acts as if LEAVE-MARKERS is non-nil.)
2707 Transposing beyond buffer boundaries is an error.
2709 (start1, end1, start2, end2, leave_markers))
2711 Bufpos startr1, endr1, startr2, endr2;
2712 Charcount len1, len2;
2713 Lisp_Object string1, string2;
2714 struct buffer *buf = current_buffer;
2716 get_buffer_range_char(buf, start1, end1, &startr1, &endr1, 0);
2717 get_buffer_range_char(buf, start2, end2, &startr2, &endr2, 0);
2719 len1 = endr1 - startr1;
2720 len2 = endr2 - startr2;
2722 if (startr2 < endr1)
2723 error("transposed regions not properly ordered");
2724 else if (startr1 == endr1 || startr2 == endr2)
2725 error("transposed region may not be of length 0");
2727 string1 = make_string_from_buffer(buf, startr1, len1);
2728 string2 = make_string_from_buffer(buf, startr2, len2);
2729 buffer_delete_range(buf, startr2, endr2, 0);
2730 buffer_insert_lisp_string_1(buf, startr2, string1, 0);
2731 buffer_delete_range(buf, startr1, endr1, 0);
2732 buffer_insert_lisp_string_1(buf, startr1, string2, 0);
2734 /* In FSFmacs there is a whole bunch of really ugly code here
2735 to attempt to transpose the regions without using up any
2736 extra memory. Although the intent may be good, the result
2737 was highly bogus. */
2742 /************************************************************************/
2743 /* initialization */
2744 /************************************************************************/
2746 void syms_of_editfns(void)
2748 defsymbol(&Qpoint, "point");
2749 defsymbol(&Qmark, "mark");
2750 defsymbol(&Qregion_beginning, "region-beginning");
2751 defsymbol(&Qregion_end, "region-end");
2752 defsymbol(&Qformat, "format");
2753 defsymbol(&Quser_files_and_directories, "user-files-and-directories");
2755 DEFSUBR(Fchar_equal);
2756 DEFSUBR(Fchar_Equal);
2757 DEFSUBR(Fgoto_char);
2758 DEFSUBR(Fstring_to_char);
2759 DEFSUBR(Fchar_to_string);
2760 DEFSUBR(Fbuffer_substring);
2761 DEFSUBR(Fbuffer_substring_no_properties);
2763 DEFSUBR(Fpoint_marker);
2764 DEFSUBR(Fmark_marker);
2766 DEFSUBR(Fregion_beginning);
2767 DEFSUBR(Fregion_end);
2768 DEFSUBR(Fsave_excursion);
2769 DEFSUBR(Fsave_current_buffer);
2771 DEFSUBR(Fbuffer_size);
2772 DEFSUBR(Fpoint_max);
2773 DEFSUBR(Fpoint_min);
2774 DEFSUBR(Fpoint_min_marker);
2775 DEFSUBR(Fpoint_max_marker);
2781 DEFSUBR(Ffollowing_char);
2782 DEFSUBR(Fpreceding_char);
2783 DEFSUBR(Fchar_after);
2784 DEFSUBR(Fchar_before);
2786 DEFSUBR(Finsert_string);
2787 DEFSUBR(Finsert_before_markers);
2788 DEFSUBR(Finsert_char);
2790 DEFSUBR(Ftemp_directory);
2791 DEFSUBR(Fuser_login_name);
2792 DEFSUBR(Fuser_group_name);
2793 DEFSUBR(Fuser_real_login_name);
2795 DEFSUBR(Fuser_real_uid);
2797 DEFSUBR(Fuser_real_gid);
2798 DEFSUBR(Fuser_full_name);
2799 DEFSUBR(Fuser_home_directory);
2800 DEFSUBR(Femacs_pid);
2801 DEFSUBR(Fcurrent_time);
2802 #if defined(HAVE_MPZ) && defined(WITH_GMP)
2803 DEFSUBR(Fcurrent_btime);
2804 DEFSUBR(Ftime_to_btime);
2805 DEFSUBR(Fbtime_to_time);
2806 #endif /* HAVE_MPZ */
2807 DEFSUBR(Fcurrent_process_time);
2809 DEFSUBR(Fformat_time_string);
2810 DEFSUBR(Fdecode_time);
2811 DEFSUBR(Fencode_time);
2812 #if defined(HAVE_MPZ) && defined WITH_GMP
2813 DEFSUBR(Fencode_btime);
2815 DEFSUBR(Fcurrent_time_string);
2816 DEFSUBR(Fcurrent_time_zone);
2817 DEFSUBR(Fset_time_zone_rule);
2818 DEFSUBR(Fsystem_name);
2821 DEFSUBR(Finsert_buffer_substring);
2822 DEFSUBR(Fcompare_buffer_substrings);
2823 DEFSUBR(Fsubst_char_in_region);
2824 DEFSUBR(Ftranslate_region);
2825 DEFSUBR(Fdelete_region);
2827 DEFSUBR(Fnarrow_to_region);
2828 DEFSUBR(Fsave_restriction);
2829 DEFSUBR(Ftranspose_regions);
2831 defsymbol(&Qzmacs_update_region, "zmacs-update-region");
2832 defsymbol(&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2833 defsymbol(&Qzmacs_region_buffer, "zmacs-region-buffer");
2836 void vars_of_editfns(void)
2838 staticpro(&Vsystem_name);
2840 staticpro(&Vuser_name);
2841 staticpro(&Vuser_real_name);
2843 DEFVAR_BOOL("zmacs-regions", &zmacs_regions /*
2844 *Whether LISPM-style active regions should be used.
2845 This means that commands which operate on the region (the area between the
2846 point and the mark) will only work while the region is in the ``active''
2847 state, which is indicated by highlighting. Executing most commands causes
2848 the region to not be in the active state, so (for example) \\[kill-region] will only
2849 work immediately after activating the region.
2853 - Commands which operate on the region only work if the region is active.
2854 - Only a very small set of commands cause the region to become active:
2855 Those commands whose semantics are to mark an area, like `mark-defun'.
2856 - The region is deactivated after each command that is executed, except that:
2857 - "Motion" commands do not change whether the region is active or not.
2859 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2860 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2861 between point and the recently-pushed mark to be highlighted. It will
2862 remain highlighted until some non-motion command is executed.
2864 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2865 region and execute a command that operates on it, you can reactivate the
2866 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2869 Generally, commands which push marks as a means of navigation (like
2870 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2871 region. But commands which push marks as a means of marking an area of
2872 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2873 do activate the region.
2875 The way the command loop actually works with regard to deactivating the
2876 region is as follows:
2878 - If the variable `zmacs-region-stays' has been set to t during the command
2879 just executed, the region is left alone (this is how the motion commands
2880 make the region stay around; see the `_' flag in the `interactive'
2881 specification). `zmacs-region-stays' is reset to nil before each command
2883 - If the function `zmacs-activate-region' has been called during the command
2884 just executed, the region is left alone. Very few functions should
2885 actually call this function.
2886 - Otherwise, if the region is active, the region is deactivated and
2887 the `zmacs-deactivate-region-hook' is called.
2889 /* Zmacs style active regions are now ON by default */
2892 DEFVAR_BOOL("zmacs-region-active-p", &zmacs_region_active_p /*
2893 Do not alter this. It is for internal use only.
2895 zmacs_region_active_p = 0;
2897 DEFVAR_BOOL("zmacs-region-stays", &zmacs_region_stays /*
2898 Whether the current command will deactivate the region.
2899 Commands which do not wish to affect whether the region is currently
2900 highlighted should set this to t. Normally, the region is turned off after
2901 executing each command that did not explicitly turn it on with the function
2902 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2903 See the variable `zmacs-regions'.
2905 The same effect can be achieved using the `_' interactive specification.
2907 `zmacs-region-stays' is reset to nil before each command is executed.
2909 zmacs_region_stays = 0;
2911 DEFVAR_BOOL("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2912 Do not use this -- it will be going away soon.
2913 Indicates if `goto-char' has just been run. This information is allegedly
2914 needed to get the desired behavior for atomic extents and unfortunately
2915 is not available by any other means.
2917 atomic_extent_goto_char_p = 0;
2918 #ifdef AMPERSAND_FULL_NAME
2919 Fprovide(intern("ampersand-full-name"));
2922 DEFVAR_LISP("user-full-name", &Vuser_full_name /*
2923 *The name of the user.
2924 The function `user-full-name', which will return the value of this
2925 variable, when called without arguments.
2926 This is initialized to the value of the NAME environment variable.
2928 /* Initialized at run-time. */
2929 Vuser_full_name = Qnil;