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"
46 #include "sysfile.h" /* for getcwd */
48 /* Some static data, and a function to initialize it for each run */
50 Lisp_Object Vsystem_name; /* #### - I don't see why this should be */
51 /* static, either... --Stig */
52 #if 0 /* XEmacs - this is now dynamic */
53 /* if at some point it's deemed desirable to
54 use lisp variables here, then they can be
55 initialized to nil and then set to their
56 real values upon the first call to the
57 functions that generate them. --stig */
58 Lisp_Object Vuser_real_login_name; /* login name of current user ID */
59 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */
62 /* It's useful to be able to set this as user customization, so we'll
64 Lisp_Object Vuser_full_name;
65 EXFUN(Fuser_full_name, 1);
69 Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
71 Lisp_Object Quser_files_and_directories;
73 /* This holds the value of `environ' produced by the previous
74 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
75 has never been called. */
76 static char **environbuf;
78 void init_editfns(void)
80 /* Only used in removed code below. */
85 /* Set up system_name even when dumping. */
93 if ((p = getenv("NAME")))
94 /* I don't think it's the right thing to do the ampersand
95 modification on NAME. Not that it matters anymore... -hniksic */
96 Vuser_full_name = build_ext_string(p, Qnative);
98 Vuser_full_name = Fuser_full_name(Qnil);
101 DEFUN("char-to-string", Fchar_to_string, 1, 1, 0, /*
102 Convert CHARACTER to a one-character string containing that character.
107 Bufbyte str[MAX_EMCHAR_LEN];
109 if (EVENTP(character)) {
111 Fevent_to_character(character, Qt, Qnil, Qnil);
114 signal_simple_continuable_error
115 ("character has no ASCII equivalent:",
116 Fcopy_event(character, Qnil));
120 CHECK_CHAR_COERCE_INT(character);
122 len = set_charptr_emchar(str, XCHAR(character));
123 return make_string(str, len);
126 DEFUN("string-to-char", Fstring_to_char, 1, 1, 0, /*
127 Convert arg STRING to a character, the first character of that string.
128 An empty string will return the constant `nil'.
133 CHECK_STRING(string);
136 if (string_length(p) != 0)
137 return make_char(string_char(p, 0));
139 /* This used to return Qzero. That is broken, broken, broken. */
140 /* It might be kinder to signal an error directly. -slb */
144 static Lisp_Object buildmark(Bufpos val, Lisp_Object buffer)
146 Lisp_Object mark = Fmake_marker();
147 Fset_marker(mark, make_int(val), buffer);
151 DEFUN("point", Fpoint, 0, 1, 0, /*
152 Return value of point, as an integer.
153 Beginning of buffer is position (point-min).
154 If BUFFER is nil, the current buffer is assumed.
158 struct buffer *b = decode_buffer(buffer, 1);
159 return make_int(BUF_PT(b));
162 DEFUN("point-marker", Fpoint_marker, 0, 2, 0, /*
163 Return value of point, as a marker object.
164 This marker is a copy; you may modify it with reckless abandon.
165 If optional argument DONT-COPY-P is non-nil, then it returns the real
166 point-marker; modifying the position of this marker will move point.
167 It is illegal to change the buffer of it, or make it point nowhere.
168 If BUFFER is nil, the current buffer is assumed.
170 (dont_copy_p, buffer))
172 struct buffer *b = decode_buffer(buffer, 1);
173 if (NILP(dont_copy_p))
174 return Fcopy_marker(b->point_marker, Qnil);
176 return b->point_marker;
179 /* The following two functions end up being identical but it's
180 cleaner to declare them separately. */
182 Bufpos bufpos_clip_to_bounds(Bufpos lower, Bufpos num, Bufpos upper)
184 return (num < lower ? lower : num > upper ? upper : num);
187 Bytind bytind_clip_to_bounds(Bytind lower, Bytind num, Bytind upper)
189 return (num < lower ? lower : num > upper ? upper : num);
194 * There is no absolute way to determine if goto-char is the function
195 * being run. this-command doesn't work because it is often eval'd
196 * and this-command ends up set to eval-expression. So this flag gets
199 * Jamie thinks he's wrong, but we'll leave this in for now.
201 int atomic_extent_goto_char_p;
203 DEFUN("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /*
204 Set point to POSITION, a number or marker.
205 Beginning of buffer is position (point-min), end is (point-max).
206 If BUFFER is nil, the current buffer is assumed.
207 Return value of POSITION, as an integer.
211 struct buffer *b = decode_buffer(buffer, 1);
212 Bufpos n = get_buffer_pos_char(b, position, GB_COERCE_RANGE);
214 atomic_extent_goto_char_p = 1;
218 static Lisp_Object region_limit(int beginningp, struct buffer *b)
223 if (!NILP(Vtransient_mark_mode) && NILP(Vmark_even_if_inactive)
224 && NILP(b->mark_active))
225 Fsignal(Qmark_inactive, Qnil);
227 m = Fmarker_position(b->mark);
229 error("There is no region now");
230 if (!!(BUF_PT(b) < XINT(m)) == !!beginningp)
231 return make_int(BUF_PT(b));
236 DEFUN("region-beginning", Fregion_beginning, 0, 1, 0, /*
237 Return position of beginning of region in BUFFER, as an integer.
238 If BUFFER is nil, the current buffer is assumed.
242 return region_limit(1, decode_buffer(buffer, 1));
245 DEFUN("region-end", Fregion_end, 0, 1, 0, /*
246 Return position of end of region in BUFFER, as an integer.
247 If BUFFER is nil, the current buffer is assumed.
251 return region_limit(0, decode_buffer(buffer, 1));
254 /* Whether to use lispm-style active-regions */
257 /* Whether the zmacs region is active. This is not per-buffer because
258 there can be only one active region at a time. #### Now that the
259 zmacs region are not directly tied to the X selections this may not
260 necessarily have to be true. */
261 int zmacs_region_active_p;
263 int zmacs_region_stays;
265 Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region;
266 Lisp_Object Qzmacs_region_buffer;
268 void zmacs_update_region(void)
270 /* This function can GC */
271 if (zmacs_region_active_p)
272 call0(Qzmacs_update_region);
275 void zmacs_deactivate_region(void)
277 /* This function can GC */
278 if (zmacs_region_active_p)
279 call0(Qzmacs_deactivate_region);
282 Lisp_Object zmacs_region_buffer(void)
284 if (zmacs_region_active_p)
285 return call0(Qzmacs_region_buffer);
290 DEFUN("mark-marker", Fmark_marker, 0, 2, 0, /*
291 Return this buffer's mark, as a marker object.
292 If `zmacs-regions' is true, then this returns nil unless the region is
293 currently in the active (highlighted) state. If optional argument FORCE
294 is t, this returns the mark (if there is one) regardless of the zmacs-region
295 state. You should *generally* not use the mark unless the region is active,
296 if the user has expressed a preference for the zmacs-region model.
297 Watch out! Moving this marker changes the mark position.
298 If you set the marker not to point anywhere, the buffer will have no mark.
299 If BUFFER is nil, the current buffer is assumed.
303 struct buffer *b = decode_buffer(buffer, 1);
304 if (!zmacs_regions || zmacs_region_active_p || !NILP(force))
309 /* The saved object is a cons:
311 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
313 We used to have another cons for a VISIBLE-P element, which was t
314 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
315 was unused for a long time, so I removed it. --hniksic */
316 Lisp_Object save_excursion_save(void)
320 /* #### Huh? --hniksic */
321 /*if (preparing_for_armageddon) return Qnil; */
323 #ifdef ERROR_CHECK_BUFPOS
324 assert(XINT(Fpoint(Qnil)) ==
325 XINT(Fmarker_position(Fpoint_marker(Qt, Qnil))));
330 return noseeum_cons(noseeum_copy_marker(b->point_marker, Qnil),
331 noseeum_copy_marker(b->mark, Qnil));
334 Lisp_Object save_excursion_restore(Lisp_Object info)
336 Lisp_Object buffer = Fmarker_buffer(XCAR(info));
338 /* If buffer being returned to is now deleted, avoid error --
339 otherwise could get error here while unwinding to top level and
340 crash. In that case, Fmarker_buffer returns nil now. */
342 struct buffer *buf = XBUFFER(buffer);
345 set_buffer_internal(buf);
346 Fgoto_char(XCAR(info), buffer);
347 Fset_marker(buf->mark, XCDR(info), buffer);
349 #if 0 /* We used to make the current buffer visible in the selected window
350 if that was true previously. That avoids some anomalies.
351 But it creates others, and it wasn't documented, and it is simpler
352 and cleaner never to alter the window/buffer connections. */
353 /* I'm certain some code somewhere depends on this behavior. --jwz */
354 /* Even if it did, it certainly doesn't matter anymore, because
355 this has been the behavior for countless XEmacs releases
358 && (current_buffer !=
359 XBUFFER(XWINDOW(selected_window)->buffer)))
360 switch_to_buffer(Fcurrent_buffer(), Qnil);
366 /* Free all the junk we allocated, so that a `save-excursion' comes
367 for free in terms of GC junk. */
368 free_marker(XMARKER(XCAR(info)));
369 free_marker(XMARKER(XCDR(info)));
370 free_cons(XCONS(info));
374 DEFUN("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
375 Save point, mark, and current buffer; execute BODY; restore those things.
376 Executes BODY just like `progn'.
377 The values of point, mark and the current buffer are restored
378 even in case of abnormal exit (throw or error).
382 /* This function can GC */
383 int speccount = specpdl_depth();
385 record_unwind_protect(save_excursion_restore, save_excursion_save());
387 return unbind_to(speccount, Fprogn(args));
390 Lisp_Object save_current_buffer_restore(Lisp_Object buffer)
392 struct buffer *buf = XBUFFER(buffer);
393 /* Avoid signaling an error if the buffer is no longer alive. This
394 is for consistency with save-excursion. */
395 if (BUFFER_LIVE_P(buf))
396 set_buffer_internal(buf);
400 DEFUN("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /*
401 Save the current buffer; execute BODY; restore the current buffer.
402 Executes BODY just like `progn'.
406 /* This function can GC */
407 int speccount = specpdl_depth();
409 record_unwind_protect(save_current_buffer_restore, Fcurrent_buffer());
411 return unbind_to(speccount, Fprogn(args));
414 DEFUN("buffer-size", Fbuffer_size, 0, 1, 0, /*
415 Return the number of characters in BUFFER.
416 If BUFFER is nil, the current buffer is assumed.
420 struct buffer *b = decode_buffer(buffer, 1);
421 return make_int(BUF_SIZE(b));
424 DEFUN("point-min", Fpoint_min, 0, 1, 0, /*
425 Return the minimum permissible value of point in BUFFER.
426 This is 1, unless narrowing (a buffer restriction)
427 is in effect, in which case it may be greater.
428 If BUFFER is nil, the current buffer is assumed.
432 struct buffer *b = decode_buffer(buffer, 1);
433 return make_int(BUF_BEGV(b));
436 DEFUN("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
437 Return a marker to the minimum permissible value of point in BUFFER.
438 This is the beginning, unless narrowing (a buffer restriction)
439 is in effect, in which case it may be greater.
440 If BUFFER is nil, the current buffer is assumed.
444 struct buffer *b = decode_buffer(buffer, 1);
445 return buildmark(BUF_BEGV(b), make_buffer(b));
448 DEFUN("point-max", Fpoint_max, 0, 1, 0, /*
449 Return the maximum permissible value of point in BUFFER.
450 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
451 is in effect, in which case it may be less.
452 If BUFFER is nil, the current buffer is assumed.
456 struct buffer *b = decode_buffer(buffer, 1);
457 return make_int(BUF_ZV(b));
460 DEFUN("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
461 Return a marker to the maximum permissible value of point in BUFFER.
462 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
463 is in effect, in which case it may be less.
464 If BUFFER is nil, the current buffer is assumed.
468 struct buffer *b = decode_buffer(buffer, 1);
469 return buildmark(BUF_ZV(b), make_buffer(b));
472 DEFUN("following-char", Ffollowing_char, 0, 1, 0, /*
473 Return the character following point.
474 At the end of the buffer or accessible region, return 0.
475 If BUFFER is nil, the current buffer is assumed.
479 struct buffer *b = decode_buffer(buffer, 1);
480 if (BUF_PT(b) >= BUF_ZV(b))
481 return Qzero; /* #### Gag me! */
483 return make_char(BUF_FETCH_CHAR(b, BUF_PT(b)));
486 DEFUN("preceding-char", Fpreceding_char, 0, 1, 0, /*
487 Return the character preceding point.
488 At the beginning of the buffer or accessible region, return 0.
489 If BUFFER is nil, the current buffer is assumed.
493 struct buffer *b = decode_buffer(buffer, 1);
494 if (BUF_PT(b) <= BUF_BEGV(b))
495 return Qzero; /* #### Gag me! */
497 return make_char(BUF_FETCH_CHAR(b, BUF_PT(b) - 1));
500 DEFUN("bobp", Fbobp, 0, 1, 0, /*
501 Return t if point is at the beginning of the buffer.
502 If the buffer is narrowed, this means the beginning of the narrowed part.
503 If BUFFER is nil, the current buffer is assumed.
507 struct buffer *b = decode_buffer(buffer, 1);
508 return BUF_PT(b) == BUF_BEGV(b) ? Qt : Qnil;
511 DEFUN("eobp", Feobp, 0, 1, 0, /*
512 Return t if point is at the end of the buffer.
513 If the buffer is narrowed, this means the end of the narrowed part.
514 If BUFFER is nil, the current buffer is assumed.
518 struct buffer *b = decode_buffer(buffer, 1);
519 return BUF_PT(b) == BUF_ZV(b) ? Qt : Qnil;
522 int beginning_of_line_p(struct buffer *b, Bufpos pt)
524 return pt <= BUF_BEGV(b) || BUF_FETCH_CHAR(b, pt - 1) == '\n';
527 DEFUN("bolp", Fbolp, 0, 1, 0, /*
528 Return t if point is at the beginning of a line.
529 If BUFFER is nil, the current buffer is assumed.
533 struct buffer *b = decode_buffer(buffer, 1);
534 return beginning_of_line_p(b, BUF_PT(b)) ? Qt : Qnil;
537 DEFUN("eolp", Feolp, 0, 1, 0, /*
538 Return t if point is at the end of a line.
539 `End of a line' includes point being at the end of the buffer.
540 If BUFFER is nil, the current buffer is assumed.
544 struct buffer *b = decode_buffer(buffer, 1);
545 return (BUF_PT(b) == BUF_ZV(b) || BUF_FETCH_CHAR(b, BUF_PT(b)) == '\n')
549 DEFUN("char-after", Fchar_after, 0, 2, 0, /*
550 Return the character at position POS in BUFFER.
551 POS is an integer or a marker.
552 If POS is out of range, the value is nil.
553 if POS is nil, the value of point is assumed.
554 If BUFFER is nil, the current buffer is assumed.
558 struct buffer *b = decode_buffer(buffer, 1);
559 Bufpos n = (NILP(pos) ? BUF_PT(b) :
560 get_buffer_pos_char(b, pos, GB_NO_ERROR_IF_BAD));
562 if (n < 0 || n == BUF_ZV(b))
564 return make_char(BUF_FETCH_CHAR(b, n));
567 DEFUN("char-before", Fchar_before, 0, 2, 0, /*
568 Return the character preceding position POS in BUFFER.
569 POS is an integer or a marker.
570 If POS is out of range, the value is nil.
571 if POS is nil, the value of point is assumed.
572 If BUFFER is nil, the current buffer is assumed.
576 struct buffer *b = decode_buffer(buffer, 1);
577 Bufpos n = (NILP(pos) ? BUF_PT(b) :
578 get_buffer_pos_char(b, pos, GB_NO_ERROR_IF_BAD));
584 return make_char(BUF_FETCH_CHAR(b, n));
587 #include <sys/stat.h>
593 DEFUN("temp-directory", Ftemp_directory, 0, 0, 0, /*
594 Return the pathname to the directory to use for temporary files.
595 On MS Windows, this is obtained from the TEMP or TMP environment variables,
596 defaulting to / if they are both undefined.
597 On Unix it is obtained from TMPDIR, with /tmp as the default.
602 tmpdir = getenv("TMPDIR");
603 char path[5 /* strlen ("/tmp/") */ + 1 + _POSIX_PATH_MAX];
606 int myuid = getuid();
608 strcpy(path, "/tmp/");
609 strncat(path, user_login_name(NULL), _POSIX_PATH_MAX);
610 path[sizeof(path)-1]=0;
611 if (lstat(path, &st) < 0 && errno == ENOENT) {
612 mkdir(path, 0700); /* ignore retval -- checked next anyway. */
614 if (lstat(path, &st) == 0 && st.st_uid == (uid_t) myuid &&
615 S_ISDIR(st.st_mode)) {
618 const char* home_env = getenv("HOME");
620 strncpy(path, home_env, sizeof(path)-1);
621 strncat(path, "/tmp/", sizeof(path)-1);
622 if ( mkdir(path, 0700) >= 0 || errno == EEXIST ) {
625 /* strlen(".created_by_sxemacs") */
626 19 + _POSIX_PATH_MAX + 1];
627 strncpy(warnpath, path, _POSIX_PATH_MAX);
628 warnpath[sizeof(warnpath)-1]=0;
630 /* we already are reserved these 20 bytes... */
631 strcat(warnpath, ".created_by_sxemacs");
632 if ((fd = open(warnpath, O_WRONLY | O_CREAT,
634 write(fd, "SXEmacs created this directory "
635 "because /tmp/<yourname> "
636 "was unavailable -- \nPlease check !\n", 89);
641 if (stat(path, &st) == 0 && st.st_uid == (uid_t) myuid
642 && S_ISDIR(st.st_mode)) {
650 return build_ext_string(tmpdir, Qfile_name);
653 DEFUN("user-login-name", Fuser_login_name, 0, 1, 0, /*
654 Return the name under which the user logged in, as a string.
655 This is based on the effective uid, not the real uid.
656 Also, if the environment variable LOGNAME or USER is set,
657 that determines the value of this function.
658 If the optional argument UID is present, then environment variables are
659 ignored and this function returns the login name for that UID, or nil.
668 local_uid = XINT(uid);
669 returned_name = user_login_name(&local_uid);
671 returned_name = user_login_name(NULL);
673 /* #### - I believe this should return nil instead of "unknown" when pw==0
674 pw=0 is indicated by a null return from user_login_name
676 return returned_name ? build_string(returned_name) : Qnil;
679 /* This function may be called from other C routines when a
680 character string representation of the user_login_name is
681 needed but a Lisp Object is not. The UID is passed by
682 reference. If UID == NULL, then the USER name
683 for the user running XEmacs will be returned. This
684 corresponds to a nil argument to Fuser_login_name.
686 char *user_login_name(uid_t * uid)
688 /* uid == NULL to return name of this user */
690 struct passwd *pw = getpwuid(*uid);
691 return pw ? pw->pw_name : NULL;
693 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
694 old environment (I site observed behavior on sunos and linux), so the
695 environment variables should be disregarded in that case. --Stig */
696 char *user_name = getenv("LOGNAME");
704 struct passwd *pw = getpwuid(geteuid());
705 return pw ? pw->pw_name : NULL;
710 DEFUN("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
711 Return the name of the user's real uid, as a string.
712 This ignores the environment variables LOGNAME and USER, so it differs from
713 `user-login-name' when running under `su'.
717 struct passwd *pw = getpwuid(getuid());
718 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
720 Lisp_Object tem = build_string(pw ? pw->pw_name : "unknown"); /* no gettext */
724 DEFUN("user-uid", Fuser_uid, 0, 0, 0, /*
725 Return the effective uid of Emacs, as an integer.
729 return make_int(geteuid());
732 DEFUN("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
733 Return the real uid of Emacs, as an integer.
737 return make_int(getuid());
740 DEFUN("user-full-name", Fuser_full_name, 0, 1, 0, /*
741 Return the full name of the user logged in, as a string.
742 If the optional argument USER is given, then the full name for that
743 user is returned, or nil. USER may be either a login name or a uid.
745 If USER is nil, and `user-full-name' contains a string, the
746 value of `user-full-name' is returned.
750 Lisp_Object user_name;
751 struct passwd *pw = NULL;
756 if (NILP(user) && STRINGP(Vuser_full_name))
757 return Vuser_full_name;
759 user_name = (STRINGP(user) ? user : Fuser_login_name(user));
760 if (!NILP(user_name)) { /* nil when nonexistent UID passed as arg */
761 const char *user_name_ext;
763 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
764 things get wedged if a SIGIO arrives during this time. */
765 TO_EXTERNAL_FORMAT(LISP_STRING, user_name,
766 C_STRING_ALLOCA, user_name_ext, Qnative);
767 slow_down_interrupts();
768 pw = (struct passwd *)getpwnam(user_name_ext);
769 speed_up_interrupts();
772 /* #### - Stig sez: this should return nil instead
773 * of "unknown" when pw==0 */
774 /* Ben sez: bad idea because it's likely to break something */
775 #ifndef AMPERSAND_FULL_NAME
776 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
779 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
782 tem = ((!NILP(user) && !pw)
784 : make_ext_string((Extbyte *) p, (q ? q - p : (int)strlen(p)),
787 #ifdef AMPERSAND_FULL_NAME
789 p = (char *)XSTRING_DATA(tem);
791 /* Substitute the login name for the &, upcasing the first character. */
794 (char *)alloca(strlen(p) +
795 XSTRING_LENGTH(user_name) + 1);
798 strcat(r, (char *)XSTRING_DATA(user_name));
799 /* #### current_buffer dependency! */
800 r[q - p] = UPCASE(current_buffer, r[q - p]);
802 tem = build_string(r);
805 #endif /* AMPERSAND_FULL_NAME */
810 static Extbyte *cached_home_directory;
812 void uncache_home_directory(void)
814 cached_home_directory = NULL; /* in some cases, this may cause the leaking
818 /* !!#### not Mule correct. */
820 /* Returns the home directory, in external format */
821 Extbyte *get_home_directory(void)
823 /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
824 about what format an external string is in. Could be Unicode, for all
825 we know, and then all the operations below are totally bogus.
826 Instead, convert all data to internal format *right* at the juncture
827 between XEmacs and the outside world, the very moment we first get
829 int output_home_warning = 0;
831 if (cached_home_directory == NULL) {
832 if ((cached_home_directory =
833 (Extbyte *) getenv("HOME")) == NULL) {
836 * Using "/" isn't quite right, but what should we do?
837 * We probably should try to extract pw_dir from /etc/passwd,
838 * before falling back to this.
840 cached_home_directory = (Extbyte *) "/";
841 output_home_warning = 1;
843 if (initialized && output_home_warning) {
844 warn_when_safe(Quser_files_and_directories, Qwarning,
846 " SXEmacs was unable to determine a good value for the user's $HOME\n"
847 " directory, and will be using the value:\n"
849 " This is probably incorrect.",
850 cached_home_directory);
853 return cached_home_directory;
856 DEFUN("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
857 Return the user's home directory, as a string.
861 Extbyte *path = get_home_directory();
863 return path == NULL ? Qnil :
864 Fexpand_file_name(Fsubstitute_in_file_name
865 (build_ext_string((char *)path, Qfile_name)),
869 DEFUN("system-name", Fsystem_name, 0, 0, 0, /*
870 Return the name of the machine you are running on, as a string.
874 return Fcopy_sequence(Vsystem_name);
877 DEFUN("emacs-pid", Femacs_pid, 0, 0, 0, /*
878 Return the process ID of Emacs, as an integer.
882 return make_int(getpid());
885 DEFUN("current-time", Fcurrent_time, 0, 0, 0, /*
886 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
887 The time is returned as a list of three integers. The first has the
888 most significant 16 bits of the seconds, while the second has the
889 least significant 16 bits. The third integer gives the microsecond
892 The microsecond count is zero on systems that do not provide
893 resolution finer than a second.
900 return list3(make_int((EMACS_SECS(t) >> 16) & 0xffff),
901 make_int((EMACS_SECS(t) >> 0) & 0xffff),
902 make_int(EMACS_USECS(t)));
905 #if defined(HAVE_MPZ) && defined(WITH_GMP)
906 DEFUN("current-btime", Fcurrent_btime, 0, 0, 0, /*
907 Return the current time, as the number of microseconds since
909 The time is returned as a big integer.
920 bigz_set_long(btime, EMACS_SECS(t));
921 mpz_mul_ui(btime, btime, 1000000UL);
922 mpz_add_ui(btime, btime, EMACS_USECS(t));
923 result = make_bigz_bz(btime);
929 DEFUN("time-to-btime", Ftime_to_btime, 1, 1, 0, /*
930 Return a big integer from SPECIFIED-TIME with the
931 number of microseconds since the Epoch.
935 if (CONSP(specified_time)) {
938 Lisp_Object high, low, ulow;
942 high = XCAR(specified_time);
943 low = XCDR(specified_time);
956 bigz_set_ulong(bz, (XINT(high) << 16) + (XINT(low) & 0xffff));
957 mpz_mul_ui(bz, bz, 1000000UL);
958 mpz_add_ui(bz, bz, XINT(ulow));
959 result = make_bigz_bz(bz);
963 } else if (BIGZP(specified_time)) {
964 return specified_time;
966 CHECK_CONS(specified_time);
971 DEFUN("btime-to-time", Fbtime_to_time, 1, 1, 0, /*
972 Return a time specified as (HIGH LOW USEC) as obtainable
973 from `current-time' from SPECIFIED-TIME.
977 if (CONSP(specified_time)) {
978 Lisp_Object high, low, ulow;
980 high = XCAR(specified_time);
981 low = XCDR(specified_time);
994 return list3(high, low, ulow);
995 } else if (BIGZP(specified_time)) {
1004 mpz_tdiv_qr_ui(bh, bl, XBIGZ_DATA(specified_time), 1000000UL);
1005 highlow = bigz_to_long(bh);
1006 usecs = bigz_to_long(bl);
1007 result = list3(make_int((highlow >> 16) & 0xffff),
1008 make_int((highlow >> 0) & 0xffff),
1015 CHECK_BIGZ(specified_time);
1019 #endif /* HAVE_MPZ && WITH_MPZ */
1021 DEFUN("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
1022 Return the amount of time used by this SXEmacs process so far.
1023 The return value is a list of three floating-point numbers, expressing
1024 the user, system, and real times used by the process. The user time
1025 measures the time actually spent by the CPU executing the code in this
1026 process. The system time measures time spent by the CPU executing kernel
1027 code on behalf of this process (e.g. I/O requests made by the process).
1029 Note that the user and system times measure processor time, as opposed
1030 to real time, and only accrue when the processor is actually doing
1031 something: Time spent in an idle wait (waiting for user events to come
1032 in or for I/O on a disk drive or other device to complete) does not
1033 count. Thus, the user and system times will often be considerably
1034 less than the real time.
1036 Some systems do not allow the user and system times to be distinguished.
1037 In this case, the user time will be the total processor time used by
1038 the process, and the system time will be 0.
1040 Some systems do not allow the real and processor times to be distinguished.
1041 In this case, the user and real times will be the same and the system
1046 double user, sys, real;
1048 get_process_times(&user, &sys, &real);
1049 return list3(make_float(user), make_float(sys), make_float(real));
1052 DEFUN("uptime", Fuptime, 0, 1, "P", /*
1053 Display SXEmacs \"uptime\".
1055 When called interactively, without a prefix arg, return a list of 4
1056 integers, being the elapsed days, hours, minutes, and seconds that
1057 this SXEmacs process has been running. Display this info prettyfied
1060 With optional prefix arg, USR-SYS-REAL, return a list of 3 floats:
1061 user time, system time, and real time. Also displayed in the echo
1062 area if called interactively. See: `current-process-time' for more
1067 double usr, sys, real;
1068 unsigned int days, hours, minutes, seconds;
1070 days = hours = minutes = seconds = 0;
1071 get_process_times(&usr, &sys, &real);
1073 if (!NILP(usr_sys_real)) {
1074 if (!NILP(Finteractive_p()))
1075 message("User: %0.2f, System: %0.2f, Real: %0.6f\n",
1077 return list3(make_float(usr), make_float(sys), make_float(real));
1079 /* convert the real time to an int (with rounding) */
1080 real = (unsigned long) (real + 0.5);
1082 if (real >= 86400) {
1083 days = real / 86400;
1084 real = real - (days * 86400);
1087 hours = real / 3600;
1088 real = real - (hours * 3600);
1091 minutes = real / 60;
1092 real = real - (minutes * 60);
1096 if (!NILP(Finteractive_p())) {
1098 message("Uptime: %d days, %d hours, %d minutes, %d seconds\n",
1099 days, hours, minutes, seconds);
1101 message("Uptime: %d hours, %d minutes, %d seconds\n",
1102 hours, minutes, seconds);
1103 else if (minutes > 0)
1104 message("Uptime: %d minutes, %d seconds\n",
1106 else if (seconds > 0)
1107 message("Uptime: %d seconds\n", seconds);
1109 return list4(make_int(days), make_int(hours),
1110 make_int(minutes), make_int(seconds));
1114 int lisp_to_time(Lisp_Object specified_time, time_t * result);
1115 int lisp_to_time(Lisp_Object specified_time, time_t * result)
1117 Lisp_Object high, low;
1119 if (NILP(specified_time))
1120 return time(result) != -1;
1122 if (CONSP(specified_time)) {
1123 high = XCAR(specified_time);
1124 low = XCDR(specified_time);
1129 *result = (XINT(high) << 16) + (XINT(low) & 0xffff);
1130 return *result >> 16 == XINT(high);
1131 #if defined HAVE_MPZ && defined WITH_GMP
1132 } else if (BIGZP(specified_time)) {
1135 bigz_set_ulong(bz, 1000000UL);
1136 bigz_div(bz, XBIGZ_DATA(specified_time), bz);
1137 *result = bigz_to_ulong(bz);
1142 CHECK_CONS(specified_time);
1147 Lisp_Object time_to_lisp(time_t the_time);
1148 Lisp_Object time_to_lisp(time_t the_time)
1150 unsigned int item = (unsigned int)the_time;
1151 return Fcons(make_int(item >> 16), make_int(item & 0xffff));
1154 size_t emacs_strftime(char *string, size_t max, const char *format,
1155 const struct tm * tm);
1156 static long difftm(const struct tm *a, const struct tm *b);
1158 DEFUN("format-time-string", Fformat_time_string, 1, 2, 0, /*
1159 Use FORMAT-STRING to format the time TIME.
1160 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1161 `current-time' and `file-attributes'. If TIME is not specified it
1162 defaults to the current time.
1164 If compiled with ENT, TIME may also be a big integer representing
1165 the number of microseconds since the Epoch, as output by
1168 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1169 %a is replaced by the abbreviated name of the day of week.
1170 %A is replaced by the full name of the day of week.
1171 %b is replaced by the abbreviated name of the month.
1172 %B is replaced by the full name of the month.
1173 %c is a synonym for "%x %X".
1174 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1175 %d is replaced by the day of month, zero-padded.
1176 %D is a synonym for "%m/%d/%y".
1177 %e is replaced by the day of month, blank-padded.
1178 %h is a synonym for "%b".
1179 %H is replaced by the hour (00-23).
1180 %I is replaced by the hour (00-12).
1181 %j is replaced by the day of the year (001-366).
1182 %k is replaced by the hour (0-23), blank padded.
1183 %l is replaced by the hour (1-12), blank padded.
1184 %m is replaced by the month (01-12).
1185 %M is replaced by the minute (00-59).
1186 %n is a synonym for "\\n".
1187 %p is replaced by AM or PM, as appropriate.
1188 %r is a synonym for "%I:%M:%S %p".
1189 %R is a synonym for "%H:%M".
1190 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1191 nonstandard extension)
1192 %S is replaced by the second (00-60).
1193 %t is a synonym for "\\t".
1194 %T is a synonym for "%H:%M:%S".
1195 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1196 %w is replaced by the day of week (0-6), Sunday is day 0.
1197 %W is replaced by the week of the year (00-53), first day of week is Monday.
1198 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1199 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1200 %y is replaced by the year without century (00-99).
1201 %Y is replaced by the year with century.
1202 %Z is replaced by the time zone abbreviation.
1204 The number of options reflects the `strftime' function.
1206 BUG: If the charset used by the current locale is not ISO 8859-1, the
1207 characters appearing in the day and month names may be incorrect.
1209 (format_string, time_))
1215 CHECK_STRING(format_string);
1217 if (!lisp_to_time(time_, &value) || !(tm = localtime(&value)))
1218 error("Invalid time specification");
1220 /* This is probably enough. */
1221 size = XSTRING_LENGTH(format_string) * 6 + 50;
1224 char *buf = (char *)alloca(size);
1226 if (emacs_strftime(buf, size,
1227 (const char *)XSTRING_DATA(format_string),
1230 return build_ext_string(buf, Qbinary);
1231 /* If buffer was too small, make it bigger. */
1236 DEFUN("decode-time", Fdecode_time, 0, 1, 0, /*
1237 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1238 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1239 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1240 to use the current time.
1241 If compiled with ENT, SPECIFIED-TIME may also be a big integer as
1242 output from `current-btime', with the number of mircoseconds since
1245 The list has the following nine members:
1246 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1247 only some operating systems support.
1248 MINUTE is an integer between 0 and 59.
1249 HOUR is an integer between 0 and 23.
1250 DAY is an integer between 1 and 31.
1251 MONTH is an integer between 1 and 12.
1252 YEAR is an integer indicating the four-digit year.
1253 DOW is the day of week, an integer between 0 and 6, where 0 is Sunday.
1254 DST is t if daylight savings time is effect, otherwise nil.
1255 ZONE is an integer indicating the number of seconds east of Greenwich.
1256 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1262 struct tm *decoded_time;
1263 Lisp_Object list_args[9];
1265 if (!lisp_to_time(specified_time, &time_spec)
1266 || !(decoded_time = localtime(&time_spec)))
1267 error("Invalid time specification");
1269 list_args[0] = make_int(decoded_time->tm_sec);
1270 list_args[1] = make_int(decoded_time->tm_min);
1271 list_args[2] = make_int(decoded_time->tm_hour);
1272 list_args[3] = make_int(decoded_time->tm_mday);
1273 list_args[4] = make_int(decoded_time->tm_mon + 1);
1274 list_args[5] = make_int(decoded_time->tm_year + 1900);
1275 list_args[6] = make_int(decoded_time->tm_wday);
1276 list_args[7] = (decoded_time->tm_isdst) ? Qt : Qnil;
1278 /* Make a copy, in case gmtime modifies the struct. */
1279 save_tm = *decoded_time;
1280 decoded_time = gmtime(&time_spec);
1281 if (decoded_time == 0)
1282 list_args[8] = Qnil;
1284 list_args[8] = make_int(difftm(&save_tm, decoded_time));
1285 return Flist(9, list_args);
1288 static void set_time_zone_rule(char *tzstring);
1290 /* from GNU Emacs 21, per Simon Josefsson, modified by stephen
1291 The slight inefficiency is justified since negative times are weird. */
1292 Lisp_Object make_time(time_t tval)
1294 return list2(make_int(tval < 0 ? tval / 0x10000 : tval >> 16),
1295 make_int(tval & 0xFFFF));
1298 DEFUN("encode-time", Fencode_time, 6, MANY, 0, /*
1299 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1300 This is the reverse operation of `decode-time', which see.
1301 ZONE defaults to the current time zone rule. This can
1302 be a string (as from `set-time-zone-rule'), or it can be a list
1303 \(as from `current-time-zone') or an integer (as from `decode-time')
1304 applied without consideration for daylight savings time.
1306 You can pass more than 7 arguments; then the first six arguments
1307 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1308 The intervening arguments are ignored.
1309 This feature lets (apply 'encode-time (decode-time ...)) work.
1311 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1312 for example, a DAY of 0 means the day preceding the given month.
1313 Year numbers less than 100 are treated just like other year numbers.
1314 If you want them to stand for years in this century, you must do that yourself.
1316 (int nargs, Lisp_Object * args))
1320 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1323 tm.tm_sec = XINT(*args++); /* second */
1325 tm.tm_min = XINT(*args++); /* minute */
1327 tm.tm_hour = XINT(*args++); /* hour */
1329 tm.tm_mday = XINT(*args++); /* day */
1331 tm.tm_mon = XINT(*args++) - 1; /* month */
1333 tm.tm_year = XINT(*args++) - 1900; /* year */
1341 the_time = mktime(&tm);
1345 char **oldenv = environ, **newenv;
1347 if (STRINGP(zone)) {
1348 tzstring = (char *)XSTRING_DATA(zone);
1349 } else if (INTP(zone)) {
1350 int abszone = abs(XINT(zone));
1351 int sz = snprintf(tzbuf, sizeof(tzbuf), "XXX%s%d:%02d:%02d",
1352 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1353 (abszone / 60) % 60, abszone % 60);
1354 assert(sz >= 0 && (size_t)sz < sizeof(tzbuf));
1357 error("Invalid time zone specification");
1360 /* Set TZ before calling mktime; merely adjusting mktime's
1361 returned value doesn't suffice, since that would mishandle
1363 set_time_zone_rule(tzstring);
1365 the_time = mktime(&tm);
1367 /* Restore TZ to previous value. */
1370 #if !defined EF_USE_BDWGC
1372 #endif /* !EF_USE_BDWGC */
1373 #ifdef LOCALTIME_CACHE
1378 if (the_time == (time_t) - 1) {
1379 error("Specified time is not representable");
1382 return make_time(the_time);
1385 #if defined(HAVE_MPZ) && defined WITH_GMP
1386 DEFUN("encode-btime", Fencode_btime, 6, MANY, 0, /*
1387 Like `encode-time' but return a big integer time instead.
1390 (int nargs, Lisp_Object * args))
1394 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1399 tm.tm_sec = XINT(*args++); /* second */
1401 tm.tm_min = XINT(*args++); /* minute */
1403 tm.tm_hour = XINT(*args++); /* hour */
1405 tm.tm_mday = XINT(*args++); /* day */
1407 tm.tm_mon = XINT(*args++) - 1; /* month */
1409 tm.tm_year = XINT(*args++) - 1900; /* year */
1416 the_time = mktime(&tm);
1420 char **oldenv = environ, **newenv;
1423 tzstring = (char *)XSTRING_DATA(zone);
1424 else if (INTP(zone)) {
1425 int abszone = abs(XINT(zone));
1426 int sz = snprintf(tzbuf, sizeof(tzbuf), "XXX%s%d:%02d:%02d",
1427 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1428 (abszone / 60) % 60, abszone % 60);
1429 assert(sz>=0 && (size_t)sz < sizeof(tzbuf));
1432 error("Invalid time zone specification");
1434 /* Set TZ before calling mktime; merely adjusting mktime's returned
1435 value doesn't suffice, since that would mishandle leap seconds. */
1436 set_time_zone_rule(tzstring);
1438 the_time = mktime(&tm);
1440 /* Restore TZ to previous value. */
1444 #ifdef LOCALTIME_CACHE
1449 if (the_time == (time_t) - 1)
1450 error("Specified time is not representable");
1453 bigz_set_ulong(bz, the_time);
1454 mpz_mul_ui(bz, bz, 1000000UL);
1455 result = make_bigz_bz(bz);
1462 DEFUN("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1463 Return the current time, as a human-readable string.
1464 Programs can use this function to decode a time,
1465 since the number of columns in each field is fixed.
1466 The format is `Sun Sep 16 01:03:52 1973'.
1467 If an argument is given, it specifies a time to format
1468 instead of the current time. The argument should have the form:
1471 (HIGH LOW . IGNORED).
1472 Thus, you can use times obtained from `current-time'
1473 and from `file-attributes'.
1475 If compiled with ENT, SPECIFIED-TIME may also be a big integer
1476 as obtained from `current-btime' with the number of microseconds
1485 if (!lisp_to_time(specified_time, &value))
1487 the_ctime = ctime(&value);
1489 /* ctime is documented as always returning a "\n\0"-terminated
1490 26-byte American time string, but let's be careful anyways. */
1491 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++) ;
1493 return make_ext_string((Extbyte *) the_ctime, len, Qbinary);
1496 #define TM_YEAR_ORIGIN 1900
1498 /* Yield A - B, measured in seconds. */
1499 static long difftm(const struct tm *a, const struct tm *b)
1501 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1502 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1503 /* Some compilers can't handle this as a single return statement. */
1505 /* difference in day of year */
1506 a->tm_yday - b->tm_yday
1507 /* + intervening leap days */
1508 + ((ay >> 2) - (by >> 2))
1509 - (ay / 100 - by / 100)
1510 + ((ay / 100 >> 2) - (by / 100 >> 2))
1511 /* + difference in years * 365 */
1512 + (long)(ay - by) * 365);
1513 return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
1514 + (a->tm_min - b->tm_min))
1515 + (a->tm_sec - b->tm_sec));
1518 DEFUN("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1519 Return the offset and name for the local time zone.
1520 This returns a list of the form (OFFSET NAME).
1521 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1522 A negative value means west of Greenwich.
1523 NAME is a string giving the name of the time zone.
1524 If an argument is given, it specifies when the time zone offset is determined
1525 instead of using the current time. The argument should have the form:
1528 (HIGH LOW . IGNORED).
1529 Thus, you can use times obtained from `current-time'
1530 and from `file-attributes'.
1532 Some operating systems cannot provide all this information to Emacs;
1533 in this case, `current-time-zone' returns a list containing nil for
1534 the data it can't find.
1539 struct tm *t = NULL;
1541 if (lisp_to_time(specified_time, &value)
1542 && (t = gmtime(&value)) != 0) {
1543 /* Make a copy, in case localtime modifies *t. */
1549 t = localtime(&value);
1550 offset = difftm(t, &gmt);
1554 s = (const char *)t->tm_zone;
1555 #else /* not HAVE_TM_ZONE */
1557 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1558 s = tzname[t->tm_isdst];
1560 #endif /* not HAVE_TM_ZONE */
1562 /* No local time zone name is available; use "+-NNNN"
1564 int am = (offset < 0 ? -offset : offset) / 60;
1565 int sz = snprintf(buf, sizeof(buf), "%c%02d%02d",
1566 (offset < 0 ? '-' : '+'),
1568 assert(sz>=0 && (size_t)sz < sizeof(buf));
1571 return list2(make_int(offset), build_string(s));
1573 return list2(Qnil, Qnil);
1577 #ifdef LOCALTIME_CACHE
1579 /* These two values are known to load tz files in buggy implementations,
1580 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1581 Their values shouldn't matter in non-buggy implementations.
1582 We don't use string literals for these strings,
1583 since if a string in the environment is in readonly
1584 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1585 See Sun bugs 1113095 and 1114114, ``Timezone routines
1586 improperly modify environment''. */
1588 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1589 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1593 /* Set the local time zone rule to TZSTRING.
1594 This allocates memory into `environ', which it is the caller's
1595 responsibility to free. */
1596 static void set_time_zone_rule(char *tzstring)
1599 char **from, **to, **newenv;
1601 for (from = environ; *from; from++)
1603 envptrs = from - environ + 2;
1604 newenv = to = (char **)xmalloc(envptrs * sizeof(char *)
1605 + (tzstring ? strlen(tzstring) + 4 : 0));
1607 char *t = (char *)(to + envptrs);
1609 strcat(t, tzstring);
1613 for (from = environ; *from; from++)
1614 if (strncmp(*from, "TZ=", 3) != 0)
1620 #ifdef LOCALTIME_CACHE
1622 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1623 "US/Pacific" that loads a tz file, then changes to a value like
1624 "XXX0" that does not load a tz file, and then changes back to
1625 its original value, the last change is (incorrectly) ignored.
1626 Also, if TZ changes twice in succession to values that do
1627 not load a tz file, tzset can dump core (see Sun bug#1225179).
1628 The following code works around these bugs. */
1631 /* Temporarily set TZ to a value that loads a tz file
1632 and that differs from tzstring. */
1635 (strcmp(tzstring, set_time_zone_rule_tz1 + 3) ==
1636 0 ? set_time_zone_rule_tz2 :
1637 set_time_zone_rule_tz1);
1641 /* The implied tzstring is unknown, so temporarily set TZ to
1642 two different values that each load a tz file. */
1643 *to = set_time_zone_rule_tz1;
1646 *to = set_time_zone_rule_tz2;
1651 /* Now TZ has the desired value, and tzset can be invoked safely. */
1658 DEFUN("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1659 Set the local time zone using TZ, a string specifying a time zone rule.
1660 If TZ is nil, use implementation-defined default time zone information.
1670 tzstring = (char *)XSTRING_DATA(tz);
1673 set_time_zone_rule(tzstring);
1676 environbuf = environ;
1681 void buffer_insert1(struct buffer *buf, Lisp_Object arg)
1683 /* This function can GC */
1684 struct gcpro gcpro1;
1687 if (CHAR_OR_CHAR_INTP(arg)) {
1688 buffer_insert_emacs_char(buf, XCHAR_OR_CHAR_INT(arg));
1689 } else if (STRINGP(arg)) {
1690 buffer_insert_lisp_string(buf, arg);
1692 arg = wrong_type_argument(Qchar_or_string_p, arg);
1698 /* Callers passing one argument to Finsert need not gcpro the
1699 argument "array", since the only element of the array will
1700 not be used after calling insert_emacs_char or insert_lisp_string,
1701 so we don't care if it gets trashed. */
1703 DEFUN("insert", Finsert, 0, MANY, 0, /*
1704 Insert the arguments, either strings or characters, at point.
1705 Point moves forward so that it ends up after the inserted text.
1706 Any other markers at the point of insertion remain before the text.
1707 If a string has non-null string-extent-data, new extents will be created.
1709 (int nargs, Lisp_Object * args))
1711 /* This function can GC */
1712 REGISTER int argnum;
1714 for (argnum = 0; argnum < nargs; argnum++) {
1715 buffer_insert1(current_buffer, args[argnum]);
1721 DEFUN("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1722 Insert strings or characters at point, relocating markers after the text.
1723 Point moves forward so that it ends up after the inserted text.
1724 Any other markers at the point of insertion also end up after the text.
1726 (int nargs, Lisp_Object * args))
1728 /* This function can GC */
1729 REGISTER int argnum;
1730 REGISTER Lisp_Object tem;
1732 for (argnum = 0; argnum < nargs; argnum++) {
1735 if (CHAR_OR_CHAR_INTP(tem)) {
1736 buffer_insert_emacs_char_1(current_buffer, -1,
1737 XCHAR_OR_CHAR_INT(tem),
1738 INSDEL_BEFORE_MARKERS);
1739 } else if (STRINGP(tem)) {
1740 buffer_insert_lisp_string_1(current_buffer, -1, tem,
1741 INSDEL_BEFORE_MARKERS);
1743 tem = wrong_type_argument(Qchar_or_string_p, tem);
1750 DEFUN("insert-string", Finsert_string, 1, 2, 0, /*
1751 Insert STRING into BUFFER at BUFFER's point.
1752 Point moves forward so that it ends up after the inserted text.
1753 Any other markers at the point of insertion remain before the text.
1754 If a string has non-null string-extent-data, new extents will be created.
1755 BUFFER defaults to the current buffer.
1759 struct buffer *b = decode_buffer(buffer, 1);
1760 CHECK_STRING(string);
1761 buffer_insert_lisp_string(b, string);
1765 /* Third argument in FSF is INHERIT:
1767 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1768 from adjoining text, if those properties are sticky."
1770 Jamie thinks this is bogus. */
1772 DEFUN("insert-char", Finsert_char, 1, 4, 0, /*
1773 Insert COUNT copies of CHARACTER into BUFFER.
1774 Point and all markers are affected as in the function `insert'.
1775 COUNT defaults to 1 if omitted.
1776 The optional third arg IGNORED is INHERIT under FSF Emacs.
1777 This is highly bogus, however, and SXEmacs always behaves as if
1778 `t' were passed to INHERIT.
1779 The optional fourth arg BUFFER specifies the buffer to insert the
1780 text into. If BUFFER is nil, the current buffer is assumed.
1782 (character, count, ignored, buffer))
1784 /* This function can GC */
1785 REGISTER Bufbyte *string;
1788 REGISTER Bytecount n;
1789 REGISTER Bytecount charlen;
1790 Bufbyte str[MAX_EMCHAR_LEN];
1791 struct buffer *b = decode_buffer(buffer, 1);
1794 CHECK_CHAR_COERCE_INT(character);
1802 charlen = set_charptr_emchar(str, XCHAR(character));
1807 string = alloca_array(Bufbyte, slen);
1808 /* Write as many copies of the character into the temp string as will fit. */
1809 for (i = 0; i + charlen <= slen; i += charlen)
1810 for (j = 0; j < charlen; j++)
1811 string[i + j] = str[j];
1814 buffer_insert_raw_string(b, string, slen);
1818 #if 0 /* FSFmacs bogosity */
1821 insert_and_inherit(string, n);
1826 buffer_insert_raw_string(b, string, n);
1832 /* Making strings from buffer contents. */
1834 DEFUN("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1835 Return the contents of part of BUFFER as a string.
1836 The two arguments START and END are character positions;
1837 they can be in either order. If omitted, they default to the beginning
1838 and end of BUFFER, respectively.
1839 If there are duplicable extents in the region, the string remembers
1840 them in its extent data.
1841 If BUFFER is nil, the current buffer is assumed.
1843 (start, end, buffer))
1845 /* This function can GC */
1847 struct buffer *b = decode_buffer(buffer, 1);
1849 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1850 return make_string_from_buffer(b, begv, zv - begv);
1853 /* It might make more sense to name this
1854 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1855 and what the function does is probably good enough for what the
1856 user-code will typically want to use it for. */
1857 DEFUN("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1858 Return the text from START to END as a string, without copying the extents.
1860 (start, end, buffer))
1862 /* This function can GC */
1864 struct buffer *b = decode_buffer(buffer, 1);
1866 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1867 return make_string_from_buffer_no_extents(b, begv, zv - begv);
1870 DEFUN("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1871 Insert before point a substring of the contents of buffer BUFFER.
1872 BUFFER may be a buffer or a buffer name.
1873 Arguments START and END are character numbers specifying the substring.
1874 They default to the beginning and the end of BUFFER.
1876 (buffer, start, end))
1878 /* This function can GC */
1881 Lisp_Object tmp_buf = emacs_get_buffer(buffer, 1);
1883 bp = XBUFFER(tmp_buf);
1884 get_buffer_range_char(bp, start, end, &b, &e, GB_ALLOW_NIL);
1887 buffer_insert_from_buffer(current_buffer, bp, b, e - b);
1892 DEFUN("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1893 Compare two substrings of two buffers; return result as number.
1894 the value is -N if first string is less after N-1 chars,
1895 +N if first string is greater after N-1 chars, or 0 if strings match.
1896 Each substring is represented as three arguments: BUFFER, START and END.
1897 That makes six args in all, three for each substring.
1899 The value of `case-fold-search' in the current buffer
1900 determines whether case is significant or ignored.
1902 (buffer1, start1, end1, buffer2, start2, end2))
1904 Bufpos begp1, endp1, begp2, endp2;
1905 REGISTER Charcount len1, len2, length, i;
1906 struct buffer *bp1, *bp2;
1907 Lisp_Object trt = ((!NILP(current_buffer->case_fold_search)) ?
1908 XCASE_TABLE_CANON(current_buffer->
1909 case_table) : Qnil);
1911 /* Find the first buffer and its substring. */
1913 bp1 = decode_buffer(buffer1, 1);
1914 get_buffer_range_char(bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1916 /* Likewise for second substring. */
1918 bp2 = decode_buffer(buffer2, 1);
1919 get_buffer_range_char(bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1921 len1 = endp1 - begp1;
1922 len2 = endp2 - begp2;
1927 for (i = 0; i < length; i++) {
1928 Emchar c1 = BUF_FETCH_CHAR(bp1, begp1 + i);
1929 Emchar c2 = BUF_FETCH_CHAR(bp2, begp2 + i);
1931 c1 = TRT_TABLE_OF(trt, c1);
1932 c2 = TRT_TABLE_OF(trt, c2);
1935 return make_int(-1 - i);
1937 return make_int(i + 1);
1940 /* The strings match as far as they go.
1941 If one is shorter, that one is less. */
1943 return make_int(length + 1);
1944 else if (length < len2)
1945 return make_int(-length - 1);
1947 /* Same length too => they are equal. */
1951 static Lisp_Object subst_char_in_region_unwind(Lisp_Object arg)
1953 XBUFFER(XCAR(arg))->undo_list = XCDR(arg);
1957 static Lisp_Object subst_char_in_region_unwind_1(Lisp_Object arg)
1959 XBUFFER(XCAR(arg))->filename = XCDR(arg);
1963 DEFUN("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1964 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1965 If optional arg NOUNDO is non-nil, don't record this change for undo
1966 and don't mark the buffer as really changed.
1968 (start, end, fromchar, tochar, noundo))
1970 /* This function can GC */
1974 struct buffer *buf = current_buffer;
1975 int count = specpdl_depth();
1977 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
1978 CHECK_CHAR_COERCE_INT(fromchar);
1979 CHECK_CHAR_COERCE_INT(tochar);
1981 fromc = XCHAR(fromchar);
1982 toc = XCHAR(tochar);
1984 /* If we don't want undo, turn off putting stuff on the list.
1985 That's faster than getting rid of things,
1986 and it prevents even the entry for a first change.
1987 Also inhibit locking the file. */
1988 if (!NILP(noundo)) {
1989 record_unwind_protect(subst_char_in_region_unwind,
1990 Fcons(Fcurrent_buffer(), buf->undo_list));
1991 buf->undo_list = Qt;
1992 /* Don't do file-locking. */
1993 record_unwind_protect(subst_char_in_region_unwind_1,
1994 Fcons(Fcurrent_buffer(), buf->filename));
1995 buf->filename = Qnil;
1998 mc_count = begin_multiple_change(buf, pos, stop);
1999 while (pos < stop) {
2000 if (BUF_FETCH_CHAR(buf, pos) == fromc) {
2001 /* There used to be some code here that set the buffer to
2002 unmodified if NOUNDO was specified and there was only
2003 one change to the buffer since it was last saved.
2004 This is a crock of shit, so I'm not duplicating this
2005 behavior. I think this was left over from when
2006 prepare_to_modify_buffer() actually bumped MODIFF,
2007 so that code was supposed to undo this change. --ben */
2008 buffer_replace_char(buf, pos, toc, !NILP(noundo), 0);
2010 /* If noundo is not nil then we don't mark the buffer as
2011 modified. In reality that needs to happen externally
2012 only. Internally redisplay needs to know that the actual
2013 contents it should be displaying have changed. */
2015 Fset_buffer_modified_p(Fbuffer_modified_p(Qnil),
2020 end_multiple_change(buf, mc_count);
2022 unbind_to(count, Qnil);
2026 /* #### Shouldn't this also accept a BUFFER argument, in the good old
2027 XEmacs tradition? */
2028 DEFUN("translate-region", Ftranslate_region, 3, 3, 0, /*
2029 Translate characters from START to END according to TABLE.
2031 If TABLE is a string, the Nth character in it is the mapping for the
2032 character with code N.
2034 If TABLE is a vector, its Nth element is the mapping for character
2035 with code N. The values of elements may be characters, strings, or
2036 nil (nil meaning don't replace.)
2038 If TABLE is a char-table, its elements describe the mapping between
2039 characters and their replacements. The char-table should be of type
2040 `char' or `generic'.
2042 Returns the number of substitutions performed.
2044 (start, end, table))
2046 /* This function can GC */
2047 Bufpos pos, stop; /* Limits of the region. */
2048 int cnt = 0; /* Number of changes made. */
2050 struct buffer *buf = current_buffer;
2053 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
2054 mc_count = begin_multiple_change(buf, pos, stop);
2055 if (STRINGP(table)) {
2056 Lisp_String *stable = XSTRING(table);
2057 Charcount size = string_char_length(stable);
2059 /* Under Mule, string_char(n) is O(n), so for large tables or
2060 large regions it makes sense to create an array of Emchars. */
2061 if (size * (stop - pos) > 65536) {
2062 Emchar *etable = alloca_array(Emchar, size);
2063 convert_bufbyte_string_into_emchar_string
2064 (string_data(stable), string_length(stable),
2066 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2069 Emchar nc = etable[oc];
2071 buffer_replace_char(buf, pos,
2080 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2083 Emchar nc = string_char(stable, oc);
2085 buffer_replace_char(buf, pos,
2092 } else if (VECTORP(table)) {
2093 Charcount size = XVECTOR_LENGTH(table);
2094 Lisp_Object *vtable = XVECTOR_DATA(table);
2096 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2098 Lisp_Object replacement = vtable[oc];
2100 if (CHAR_OR_CHAR_INTP(replacement)) {
2102 XCHAR_OR_CHAR_INT(replacement);
2104 buffer_replace_char(buf, pos,
2108 } else if (STRINGP(replacement)) {
2110 XSTRING_CHAR_LENGTH(replacement) -
2112 buffer_delete_range(buf, pos, pos + 1,
2114 buffer_insert_lisp_string_1(buf, pos,
2117 pos += incr, stop += incr;
2119 } else if (!NILP(replacement)) {
2122 (Qchar_or_string_p, replacement);
2127 } else if (CHAR_TABLEP(table)
2128 && (XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_GENERIC
2129 || XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_CHAR)) {
2130 Lisp_Char_Table *ctable = XCHAR_TABLE(table);
2132 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2133 Lisp_Object replacement = get_char_table(oc, ctable);
2135 if (CHAR_OR_CHAR_INTP(replacement)) {
2136 Emchar nc = XCHAR_OR_CHAR_INT(replacement);
2138 buffer_replace_char(buf, pos, nc, 0, 0);
2141 } else if (STRINGP(replacement)) {
2143 XSTRING_CHAR_LENGTH(replacement) - 1;
2144 buffer_delete_range(buf, pos, pos + 1, 0);
2145 buffer_insert_lisp_string_1(buf, pos,
2147 pos += incr, stop += incr;
2149 } else if (!NILP(replacement)) {
2151 wrong_type_argument(Qchar_or_string_p,
2157 dead_wrong_type_argument(Qstringp, table);
2158 end_multiple_change(buf, mc_count);
2160 return make_int(cnt);
2163 DEFUN("delete-region", Fdelete_region, 2, 3, "r", /*
2164 Delete the text between point and mark.
2165 When called from a program, expects two arguments START and END
2166 \(integers or markers) specifying the stretch to be deleted.
2167 If optional third arg BUFFER is nil, the current buffer is assumed.
2169 (start, end, buffer))
2171 /* This function can GC */
2172 Bufpos bp_start, bp_end;
2173 struct buffer *buf = decode_buffer(buffer, 1);
2175 get_buffer_range_char(buf, start, end, &bp_start, &bp_end, 0);
2176 buffer_delete_range(buf, bp_start, bp_end, 0);
2180 void widen_buffer(struct buffer *b, int no_clip)
2182 if (BUF_BEGV(b) != BUF_BEG(b)) {
2184 SET_BOTH_BUF_BEGV(b, BUF_BEG(b), BI_BUF_BEG(b));
2186 if (BUF_ZV(b) != BUF_Z(b)) {
2188 SET_BOTH_BUF_ZV(b, BUF_Z(b), BI_BUF_Z(b));
2193 /* Changing the buffer bounds invalidates any recorded current
2195 invalidate_current_column();
2196 narrow_line_number_cache(b);
2200 DEFUN("widen", Fwiden, 0, 1, "", /*
2201 Remove restrictions (narrowing) from BUFFER.
2202 This allows the buffer's full text to be seen and edited.
2203 If BUFFER is nil, the current buffer is assumed.
2207 struct buffer *b = decode_buffer(buffer, 1);
2212 DEFUN("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2213 Restrict editing in BUFFER to the current region.
2214 The rest of the text becomes temporarily invisible and untouchable
2215 but is not deleted; if you save the buffer in a file, the invisible
2216 text is included in the file. \\[widen] makes all visible again.
2217 If BUFFER is nil, the current buffer is assumed.
2218 See also `save-restriction'.
2220 When calling from a program, pass two arguments; positions (integers
2221 or markers) bounding the text that should remain visible.
2223 (start, end, buffer))
2225 Bufpos bp_start, bp_end;
2226 struct buffer *buf = decode_buffer(buffer, 1);
2227 Bytind bi_start, bi_end;
2229 get_buffer_range_char(buf, start, end, &bp_start, &bp_end,
2230 GB_ALLOW_PAST_ACCESSIBLE);
2231 bi_start = bufpos_to_bytind(buf, bp_start);
2232 bi_end = bufpos_to_bytind(buf, bp_end);
2234 SET_BOTH_BUF_BEGV(buf, bp_start, bi_start);
2235 SET_BOTH_BUF_ZV(buf, bp_end, bi_end);
2236 if (BUF_PT(buf) < bp_start)
2237 BUF_SET_PT(buf, bp_start);
2238 if (BUF_PT(buf) > bp_end)
2239 BUF_SET_PT(buf, bp_end);
2241 /* Changing the buffer bounds invalidates any recorded current column. */
2242 invalidate_current_column();
2243 narrow_line_number_cache(buf);
2247 Lisp_Object save_restriction_save(void)
2249 Lisp_Object bottom, top;
2250 /* Note: I tried using markers here, but it does not win
2251 because insertion at the end of the saved region
2252 does not advance mh and is considered "outside" the saved region. */
2253 bottom = make_int(BUF_BEGV(current_buffer) - BUF_BEG(current_buffer));
2254 top = make_int(BUF_Z(current_buffer) - BUF_ZV(current_buffer));
2256 return noseeum_cons(Fcurrent_buffer(), noseeum_cons(bottom, top));
2259 Lisp_Object save_restriction_restore(Lisp_Object data)
2262 Charcount newhead, newtail;
2264 int local_clip_changed = 0;
2266 buf = XBUFFER(XCAR(data));
2267 if (!BUFFER_LIVE_P(buf)) {
2268 /* someone could have killed the buffer in the meantime ... */
2269 free_cons(XCONS(XCDR(data)));
2270 free_cons(XCONS(data));
2274 newhead = XINT(XCAR(tem));
2275 newtail = XINT(XCDR(tem));
2277 free_cons(XCONS(XCDR(data)));
2278 free_cons(XCONS(data));
2280 if (newhead + newtail > BUF_Z(buf) - BUF_BEG(buf)) {
2287 Bytind bi_start, bi_end;
2289 start = BUF_BEG(buf) + newhead;
2290 end = BUF_Z(buf) - newtail;
2292 bi_start = bufpos_to_bytind(buf, start);
2293 bi_end = bufpos_to_bytind(buf, end);
2295 if (BUF_BEGV(buf) != start) {
2296 local_clip_changed = 1;
2297 SET_BOTH_BUF_BEGV(buf, start, bi_start);
2298 narrow_line_number_cache(buf);
2300 if (BUF_ZV(buf) != end) {
2301 local_clip_changed = 1;
2302 SET_BOTH_BUF_ZV(buf, end, bi_end);
2305 if (local_clip_changed)
2308 /* If point is outside the new visible range, move it inside. */
2310 bufpos_clip_to_bounds(BUF_BEGV(buf),
2311 BUF_PT(buf), BUF_ZV(buf)));
2316 DEFUN("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2317 Execute BODY, saving and restoring current buffer's restrictions.
2318 The buffer's restrictions make parts of the beginning and end invisible.
2319 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2320 This special form, `save-restriction', saves the current buffer's restrictions
2321 when it is entered, and restores them when it is exited.
2322 So any `narrow-to-region' within BODY lasts only until the end of the form.
2323 The old restrictions settings are restored
2324 even in case of abnormal exit (throw or error).
2326 The value returned is the value of the last form in BODY.
2328 `save-restriction' can get confused if, within the BODY, you widen
2329 and then make changes outside the area within the saved restrictions.
2331 Note: if you are using both `save-excursion' and `save-restriction',
2332 use `save-excursion' outermost:
2333 (save-excursion (save-restriction ...))
2337 /* This function can GC */
2338 int speccount = specpdl_depth();
2340 record_unwind_protect(save_restriction_restore,
2341 save_restriction_save());
2343 return unbind_to(speccount, Fprogn(body));
2346 DEFUN("format", Fformat, 1, MANY, 0, /*
2347 Return a formatted string out of a format string and arguments.
2349 Arguments: string &rest objects
2351 Hereby, STRING is the format string (also known as template) which
2352 consists of constant (immutable) portions and so called format
2353 specifiers (%-specs). For details on these see below.
2355 The remaining arguments, OBJECTS, are substituted into the format
2356 string to make the result, a string. The exact influence of OBJECTS
2357 on the final result is described below. In general, OBJECTS will be
2358 the lisp objects to be printed.
2362 The format string STRING is basically an ordinary string enriched with
2363 %-sequences (also known as specifiers or specs for short). The specs
2364 in STRING will be substituted for the according object in OBJECTS, to
2365 be precise with a string representation of the object. In the simplest
2366 case, the first specifier in STRING corresponds to the first element
2367 in OBJECTS, the second specifier corresponds to the second element, and
2370 The specifiers themselves look like
2371 %[r$][#][&][ ][+][~][0][-]['][!a][m][.p|*]{sSdioxXbucfeEgGZQFRBC}
2375 %s means print all objects as-is, using `princ'.
2376 %S means print all objects as s-expressions, using `prin1'.
2379 %d means print as an integer in decimal
2380 %i means print as an integer in decimal
2381 %o means print as an integer in octal
2382 %x means print as an integer in lowercase hex
2383 %X means print as an integer in uppercase hex
2384 %b means print as an integer in binary
2385 %u means print a non-negative integer.
2386 %c means print as a single character.
2389 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2390 %e or %E means print as a floating-point number in scientific notation
2392 %g or %G means print as a floating-point number in "pretty format";
2393 depending on the number, either %f or %e/%E format will be used, and
2394 trailing zeroes are removed from the fractional part.
2395 The argument used for all but %s and %S must be a number. It will be
2396 converted to an integer or a floating-point number as necessary.
2397 Please bear in mind that floating point numbers have a limited and fixed
2398 precision although the print output may suggest something else.
2399 The precision varies (depending on the machine) between 12 and 38 digits.
2400 This means if you use specifiers like %.60f on 1.0 or 1.5 only the first
2401 12 to 38 digits are real. Also note, that internally numbers are processed
2402 in a 2-adic arithmetic, so you may experience strange rounding effects,
2403 e.g. %.60f on 1.2 or %f on 1e+40, this is because you force the printer to
2404 be more precise than actually valid. No error is thrown in these cases!
2406 If SXEmacs was compiled with GMP support the following additional
2407 specifiers become available:
2408 %Z means print as big integer (convert to bigz)
2409 %Q means print as fraction (convert to bigq)
2410 %F means print as bigfr or bigf float (convert to in that order)
2411 this specifier always converts the argument, regardless the
2412 value of `read-real-as'
2413 %R means print as real number (convert to bigfr, bigf or float)
2414 this specifier respects the value of `read-real-as'
2415 %B means print as Gaussian number (convert to bigg)
2416 %C means print as complex number (convert to bigc)
2418 Both %B and %C are actually rewrites to %Z%+Z and %F%+F with the
2419 argument rewritten to (real-part arg) (imaginary-part arg).
2420 Flags are passed on to at least the real part specifier.
2424 Using above notation there are several tweaks, so called modifiers,
2425 to fine-tune the substitution. Modifiers are completely optional.
2428 r$ use the `r'-th element of OBJECTS instead the one in order
2429 # print 0x, 0o, 0b prefix for numbers in a different base
2430 & use lisp syntax for base!=10 numbers, as in #x73, implies ~
2431 if non-negative print a place holder ` ' for a sign, `-' otherwise
2432 + always print a sign, `-' if negative and `+' if non-negative
2433 ~ in conjunction with `#' and signed numbers print sign after 0[xob]
2434 0 pad numbers (only on the left) with zeroes instead of spaces
2436 ' group numbers in groups of three
2437 !a use `a' as pad character instead of space
2438 m specify a minimum width of the yielded string
2439 .p use `p' digits of precision, depends on the specifer
2440 * use the argument in order to obtain the precision
2442 %$ means reposition to read a specific numbered argument; for example,
2443 %3$s would apply the `%s' to the third argument after the control string,
2444 and the next format directive would use the fourth argument, the
2445 following one the fifth argument, etc. (There must be a positive integer
2446 between the % and the $).
2448 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2449 specified between the optional repositioning spec and the conversion
2450 character; see below.
2452 An optional minimum field width may be specified after any flag characters
2453 and before the conversion character; it specifies the minimum number of
2454 characters that the converted argument will take up. Padding will be
2455 added on the left (or on the right, if the `-' flag is specified), as
2456 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2459 If the field width is specified as `*', the field width is assumed to have
2460 been specified as an argument. Any repositioning specification that
2461 would normally specify the argument to be converted will now specify
2462 where to find this field width argument, not where to find the argument
2463 to be converted. If there is no repositioning specification, the normal
2464 next argument is used. The argument to be converted will be the next
2465 argument after the field width argument unless the precision is also
2466 specified as `*' (see below).
2468 An optional period character and precision may be specified after any
2469 minimum field width. It specifies the minimum number of digits to
2470 appear in %d, %i, %b, %o, %x, and %X conversions (the number is padded
2471 on the left with zeroes as necessary); the number of digits printed
2472 after the decimal point for %f, %e, and %E conversions; the number
2473 of significant digits printed in %g and %G conversions; and the
2474 maximum number of non-padding characters printed in %s and %S
2475 conversions. The default precision for floating-point conversions
2478 If the precision is specified as `*', the precision is assumed to have been
2479 specified as an argument. The argument used will be the next argument
2480 after the field width argument, if any. If the field width was not
2481 specified as an argument, any repositioning specification that would
2482 normally specify the argument to be converted will now specify where to
2483 find the precision argument. If there is no repositioning specification,
2484 the normal next argument is used.
2486 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2487 plus sign, respectively.
2489 The `#' flag means print numbers in an alternate, more verbose format:
2490 octal numbers begin with 0o; hex numbers begin with a 0x or 0X;
2491 and binary representations start with 0b;
2492 a decimal point is printed in %f, %e, and %E conversions even if no
2493 numbers are printed after it; and trailing zeroes are not omitted in
2494 %g and %G conversions.
2496 Use %% to put a single % into the output.
2498 (int nargs, Lisp_Object * args))
2500 /* It should not be necessary to GCPRO ARGS, because
2501 the caller in the interpreter should take care of that. */
2503 CHECK_STRING(args[0]);
2504 return emacs_doprnt_string_lisp(0, args[0], 0, nargs - 1, args + 1);
2507 DEFUN("char-equal", Fchar_equal, 2, 3, 0, /*
2508 Return t if two characters match, optionally ignoring case.
2509 Both arguments must be characters (i.e. NOT integers).
2510 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2511 If BUFFER is nil, the current buffer is assumed.
2513 (character1, character2, buffer))
2516 struct buffer *b = decode_buffer(buffer, 1);
2518 CHECK_CHAR_COERCE_INT(character1);
2519 CHECK_CHAR_COERCE_INT(character2);
2520 x1 = XCHAR(character1);
2521 x2 = XCHAR(character2);
2523 return (!NILP(b->case_fold_search)
2524 ? DOWNCASE(b, x1) == DOWNCASE(b, x2)
2529 DEFUN("char=", Fchar_Equal, 2, 2, 0, /*
2530 Return t if two characters match, case is significant.
2531 Both arguments must be characters (i.e. NOT integers).
2533 (character1, character2))
2535 CHECK_CHAR_COERCE_INT(character1);
2536 CHECK_CHAR_COERCE_INT(character2);
2538 return EQ(character1, character2) ? Qt : Qnil;
2541 #if 0 /* Undebugged FSFmacs code */
2542 /* Transpose the markers in two regions of the current buffer, and
2543 adjust the ones between them if necessary (i.e.: if the regions
2546 Traverses the entire marker list of the buffer to do so, adding an
2547 appropriate amount to some, subtracting from some, and leaving the
2548 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2550 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2552 void transpose_markers(Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2554 Charcount amt1, amt2, diff;
2556 struct buffer *buf = current_buffer;
2558 /* Update point as if it were a marker. */
2559 if (BUF_PT(buf) < start1) ;
2560 else if (BUF_PT(buf) < end1)
2561 BUF_SET_PT(buf, BUF_PT(buf) + (end2 - end1));
2562 else if (BUF_PT(buf) < start2)
2564 BUF_PT(buf) + (end2 - start2) - (end1 - start1));
2565 else if (BUF_PT(buf) < end2)
2566 BUF_SET_PT(buf, BUF_PT(buf) - (start2 - start1));
2568 /* We used to adjust the endpoints here to account for the gap, but that
2569 isn't good enough. Even if we assume the caller has tried to move the
2570 gap out of our way, it might still be at start1 exactly, for example;
2571 and that places it `inside' the interval, for our purposes. The amount
2572 of adjustment is nontrivial if there's a `denormalized' marker whose
2573 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2574 the dirty work to Fmarker_position, below. */
2576 /* The difference between the region's lengths */
2577 diff = (end2 - start2) - (end1 - start1);
2579 /* For shifting each marker in a region by the length of the other
2580 * region plus the distance between the regions.
2582 amt1 = (end2 - start2) + (start2 - end1);
2583 amt2 = (end1 - start1) + (start2 - end1);
2585 for (marker = BUF_MARKERS(buf); !NILP(marker);
2586 marker = XMARKER(marker)->chain) {
2587 Bufpos mpos = marker_position(marker);
2588 if (mpos >= start1 && mpos < end2) {
2591 else if (mpos < start2)
2595 set_marker_position(marker, mpos);
2602 DEFUN("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2603 Transpose region START1 to END1 with START2 to END2.
2604 The regions may not be overlapping, because the size of the buffer is
2605 never changed in a transposition.
2607 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
2608 any markers that happen to be located in the regions. (#### BUG: currently
2609 this function always acts as if LEAVE-MARKERS is non-nil.)
2611 Transposing beyond buffer boundaries is an error.
2613 (start1, end1, start2, end2, leave_markers))
2615 Bufpos startr1, endr1, startr2, endr2;
2616 Charcount len1, len2;
2617 Lisp_Object string1, string2;
2618 struct buffer *buf = current_buffer;
2620 get_buffer_range_char(buf, start1, end1, &startr1, &endr1, 0);
2621 get_buffer_range_char(buf, start2, end2, &startr2, &endr2, 0);
2623 len1 = endr1 - startr1;
2624 len2 = endr2 - startr2;
2626 if (startr2 < endr1)
2627 error("transposed regions not properly ordered");
2628 else if (startr1 == endr1 || startr2 == endr2)
2629 error("transposed region may not be of length 0");
2631 string1 = make_string_from_buffer(buf, startr1, len1);
2632 string2 = make_string_from_buffer(buf, startr2, len2);
2633 buffer_delete_range(buf, startr2, endr2, 0);
2634 buffer_insert_lisp_string_1(buf, startr2, string1, 0);
2635 buffer_delete_range(buf, startr1, endr1, 0);
2636 buffer_insert_lisp_string_1(buf, startr1, string2, 0);
2638 /* In FSFmacs there is a whole bunch of really ugly code here
2639 to attempt to transpose the regions without using up any
2640 extra memory. Although the intent may be good, the result
2641 was highly bogus. */
2646 /************************************************************************/
2647 /* initialization */
2648 /************************************************************************/
2650 void syms_of_editfns(void)
2652 defsymbol(&Qpoint, "point");
2653 defsymbol(&Qmark, "mark");
2654 defsymbol(&Qregion_beginning, "region-beginning");
2655 defsymbol(&Qregion_end, "region-end");
2656 defsymbol(&Qformat, "format");
2657 defsymbol(&Quser_files_and_directories, "user-files-and-directories");
2659 DEFSUBR(Fchar_equal);
2660 DEFSUBR(Fchar_Equal);
2661 DEFSUBR(Fgoto_char);
2662 DEFSUBR(Fstring_to_char);
2663 DEFSUBR(Fchar_to_string);
2664 DEFSUBR(Fbuffer_substring);
2665 DEFSUBR(Fbuffer_substring_no_properties);
2667 DEFSUBR(Fpoint_marker);
2668 DEFSUBR(Fmark_marker);
2670 DEFSUBR(Fregion_beginning);
2671 DEFSUBR(Fregion_end);
2672 DEFSUBR(Fsave_excursion);
2673 DEFSUBR(Fsave_current_buffer);
2675 DEFSUBR(Fbuffer_size);
2676 DEFSUBR(Fpoint_max);
2677 DEFSUBR(Fpoint_min);
2678 DEFSUBR(Fpoint_min_marker);
2679 DEFSUBR(Fpoint_max_marker);
2685 DEFSUBR(Ffollowing_char);
2686 DEFSUBR(Fpreceding_char);
2687 DEFSUBR(Fchar_after);
2688 DEFSUBR(Fchar_before);
2690 DEFSUBR(Finsert_string);
2691 DEFSUBR(Finsert_before_markers);
2692 DEFSUBR(Finsert_char);
2694 DEFSUBR(Ftemp_directory);
2695 DEFSUBR(Fuser_login_name);
2696 DEFSUBR(Fuser_real_login_name);
2698 DEFSUBR(Fuser_real_uid);
2699 DEFSUBR(Fuser_full_name);
2700 DEFSUBR(Fuser_home_directory);
2701 DEFSUBR(Femacs_pid);
2702 DEFSUBR(Fcurrent_time);
2703 #if defined(HAVE_MPZ) && defined(WITH_GMP)
2704 DEFSUBR(Fcurrent_btime);
2705 DEFSUBR(Ftime_to_btime);
2706 DEFSUBR(Fbtime_to_time);
2707 #endif /* HAVE_MPZ */
2708 DEFSUBR(Fcurrent_process_time);
2710 DEFSUBR(Fformat_time_string);
2711 DEFSUBR(Fdecode_time);
2712 DEFSUBR(Fencode_time);
2713 #if defined(HAVE_MPZ) && defined WITH_GMP
2714 DEFSUBR(Fencode_btime);
2716 DEFSUBR(Fcurrent_time_string);
2717 DEFSUBR(Fcurrent_time_zone);
2718 DEFSUBR(Fset_time_zone_rule);
2719 DEFSUBR(Fsystem_name);
2722 DEFSUBR(Finsert_buffer_substring);
2723 DEFSUBR(Fcompare_buffer_substrings);
2724 DEFSUBR(Fsubst_char_in_region);
2725 DEFSUBR(Ftranslate_region);
2726 DEFSUBR(Fdelete_region);
2728 DEFSUBR(Fnarrow_to_region);
2729 DEFSUBR(Fsave_restriction);
2730 DEFSUBR(Ftranspose_regions);
2732 defsymbol(&Qzmacs_update_region, "zmacs-update-region");
2733 defsymbol(&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2734 defsymbol(&Qzmacs_region_buffer, "zmacs-region-buffer");
2737 void vars_of_editfns(void)
2739 staticpro(&Vsystem_name);
2741 staticpro(&Vuser_name);
2742 staticpro(&Vuser_real_name);
2744 DEFVAR_BOOL("zmacs-regions", &zmacs_regions /*
2745 *Whether LISPM-style active regions should be used.
2746 This means that commands which operate on the region (the area between the
2747 point and the mark) will only work while the region is in the ``active''
2748 state, which is indicated by highlighting. Executing most commands causes
2749 the region to not be in the active state, so (for example) \\[kill-region] will only
2750 work immediately after activating the region.
2754 - Commands which operate on the region only work if the region is active.
2755 - Only a very small set of commands cause the region to become active:
2756 Those commands whose semantics are to mark an area, like `mark-defun'.
2757 - The region is deactivated after each command that is executed, except that:
2758 - "Motion" commands do not change whether the region is active or not.
2760 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2761 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2762 between point and the recently-pushed mark to be highlighted. It will
2763 remain highlighted until some non-motion command is executed.
2765 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2766 region and execute a command that operates on it, you can reactivate the
2767 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2770 Generally, commands which push marks as a means of navigation (like
2771 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2772 region. But commands which push marks as a means of marking an area of
2773 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2774 do activate the region.
2776 The way the command loop actually works with regard to deactivating the
2777 region is as follows:
2779 - If the variable `zmacs-region-stays' has been set to t during the command
2780 just executed, the region is left alone (this is how the motion commands
2781 make the region stay around; see the `_' flag in the `interactive'
2782 specification). `zmacs-region-stays' is reset to nil before each command
2784 - If the function `zmacs-activate-region' has been called during the command
2785 just executed, the region is left alone. Very few functions should
2786 actually call this function.
2787 - Otherwise, if the region is active, the region is deactivated and
2788 the `zmacs-deactivate-region-hook' is called.
2790 /* Zmacs style active regions are now ON by default */
2793 DEFVAR_BOOL("zmacs-region-active-p", &zmacs_region_active_p /*
2794 Do not alter this. It is for internal use only.
2796 zmacs_region_active_p = 0;
2798 DEFVAR_BOOL("zmacs-region-stays", &zmacs_region_stays /*
2799 Whether the current command will deactivate the region.
2800 Commands which do not wish to affect whether the region is currently
2801 highlighted should set this to t. Normally, the region is turned off after
2802 executing each command that did not explicitly turn it on with the function
2803 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2804 See the variable `zmacs-regions'.
2806 The same effect can be achieved using the `_' interactive specification.
2808 `zmacs-region-stays' is reset to nil before each command is executed.
2810 zmacs_region_stays = 0;
2812 DEFVAR_BOOL("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2813 Do not use this -- it will be going away soon.
2814 Indicates if `goto-char' has just been run. This information is allegedly
2815 needed to get the desired behavior for atomic extents and unfortunately
2816 is not available by any other means.
2818 atomic_extent_goto_char_p = 0;
2819 #ifdef AMPERSAND_FULL_NAME
2820 Fprovide(intern("ampersand-full-name"));
2823 DEFVAR_LISP("user-full-name", &Vuser_full_name /*
2824 *The name of the user.
2825 The function `user-full-name', which will return the value of this
2826 variable, when called without arguments.
2827 This is initialized to the value of the NAME environment variable.
2829 /* Initialized at run-time. */
2830 Vuser_full_name = Qnil;