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 (stat(path, &st) < 0 && errno == ENOENT) {
625 /* strlen(".created_by_sxemacs") */
626 19 + _POSIX_PATH_MAX + 1];
627 mkdir(path, 0700); /* ignore retvals */
628 strncpy(warnpath, path, _POSIX_PATH_MAX);
629 warnpath[sizeof(warnpath)-1]=0;
631 /* we already are reserved these 20 bytes... */
632 strcat(warnpath, ".created_by_sxemacs");
633 if ((fd = open(warnpath, O_WRONLY | O_CREAT,
635 write(fd, "SXEmacs created this directory "
636 "because /tmp/<yourname> "
637 "was unavailable -- \nPlease check !\n", 89);
642 if (stat(path, &st) == 0 && st.st_uid == (uid_t) myuid
643 && S_ISDIR(st.st_mode)) {
651 return build_ext_string(tmpdir, Qfile_name);
654 DEFUN("user-login-name", Fuser_login_name, 0, 1, 0, /*
655 Return the name under which the user logged in, as a string.
656 This is based on the effective uid, not the real uid.
657 Also, if the environment variable LOGNAME or USER is set,
658 that determines the value of this function.
659 If the optional argument UID is present, then environment variables are
660 ignored and this function returns the login name for that UID, or nil.
669 local_uid = XINT(uid);
670 returned_name = user_login_name(&local_uid);
672 returned_name = user_login_name(NULL);
674 /* #### - I believe this should return nil instead of "unknown" when pw==0
675 pw=0 is indicated by a null return from user_login_name
677 return returned_name ? build_string(returned_name) : Qnil;
680 /* This function may be called from other C routines when a
681 character string representation of the user_login_name is
682 needed but a Lisp Object is not. The UID is passed by
683 reference. If UID == NULL, then the USER name
684 for the user running XEmacs will be returned. This
685 corresponds to a nil argument to Fuser_login_name.
687 char *user_login_name(uid_t * uid)
689 /* uid == NULL to return name of this user */
691 struct passwd *pw = getpwuid(*uid);
692 return pw ? pw->pw_name : NULL;
694 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
695 old environment (I site observed behavior on sunos and linux), so the
696 environment variables should be disregarded in that case. --Stig */
697 char *user_name = getenv("LOGNAME");
705 struct passwd *pw = getpwuid(geteuid());
706 return pw ? pw->pw_name : NULL;
711 DEFUN("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
712 Return the name of the user's real uid, as a string.
713 This ignores the environment variables LOGNAME and USER, so it differs from
714 `user-login-name' when running under `su'.
718 struct passwd *pw = getpwuid(getuid());
719 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
721 Lisp_Object tem = build_string(pw ? pw->pw_name : "unknown"); /* no gettext */
725 DEFUN("user-uid", Fuser_uid, 0, 0, 0, /*
726 Return the effective uid of Emacs, as an integer.
730 return make_int(geteuid());
733 DEFUN("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
734 Return the real uid of Emacs, as an integer.
738 return make_int(getuid());
741 DEFUN("user-full-name", Fuser_full_name, 0, 1, 0, /*
742 Return the full name of the user logged in, as a string.
743 If the optional argument USER is given, then the full name for that
744 user is returned, or nil. USER may be either a login name or a uid.
746 If USER is nil, and `user-full-name' contains a string, the
747 value of `user-full-name' is returned.
751 Lisp_Object user_name;
752 struct passwd *pw = NULL;
757 if (NILP(user) && STRINGP(Vuser_full_name))
758 return Vuser_full_name;
760 user_name = (STRINGP(user) ? user : Fuser_login_name(user));
761 if (!NILP(user_name)) { /* nil when nonexistent UID passed as arg */
762 const char *user_name_ext;
764 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
765 things get wedged if a SIGIO arrives during this time. */
766 TO_EXTERNAL_FORMAT(LISP_STRING, user_name,
767 C_STRING_ALLOCA, user_name_ext, Qnative);
768 slow_down_interrupts();
769 pw = (struct passwd *)getpwnam(user_name_ext);
770 speed_up_interrupts();
773 /* #### - Stig sez: this should return nil instead
774 * of "unknown" when pw==0 */
775 /* Ben sez: bad idea because it's likely to break something */
776 #ifndef AMPERSAND_FULL_NAME
777 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
780 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
783 tem = ((!NILP(user) && !pw)
785 : make_ext_string((Extbyte *) p, (q ? q - p : (int)strlen(p)),
788 #ifdef AMPERSAND_FULL_NAME
790 p = (char *)XSTRING_DATA(tem);
792 /* Substitute the login name for the &, upcasing the first character. */
795 (char *)alloca(strlen(p) +
796 XSTRING_LENGTH(user_name) + 1);
799 strcat(r, (char *)XSTRING_DATA(user_name));
800 /* #### current_buffer dependency! */
801 r[q - p] = UPCASE(current_buffer, r[q - p]);
803 tem = build_string(r);
806 #endif /* AMPERSAND_FULL_NAME */
811 static Extbyte *cached_home_directory;
813 void uncache_home_directory(void)
815 cached_home_directory = NULL; /* in some cases, this may cause the leaking
819 /* !!#### not Mule correct. */
821 /* Returns the home directory, in external format */
822 Extbyte *get_home_directory(void)
824 /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
825 about what format an external string is in. Could be Unicode, for all
826 we know, and then all the operations below are totally bogus.
827 Instead, convert all data to internal format *right* at the juncture
828 between XEmacs and the outside world, the very moment we first get
830 int output_home_warning = 0;
832 if (cached_home_directory == NULL) {
833 if ((cached_home_directory =
834 (Extbyte *) getenv("HOME")) == NULL) {
837 * Using "/" isn't quite right, but what should we do?
838 * We probably should try to extract pw_dir from /etc/passwd,
839 * before falling back to this.
841 cached_home_directory = (Extbyte *) "/";
842 output_home_warning = 1;
844 if (initialized && output_home_warning) {
845 warn_when_safe(Quser_files_and_directories, Qwarning,
847 " SXEmacs was unable to determine a good value for the user's $HOME\n"
848 " directory, and will be using the value:\n"
850 " This is probably incorrect.",
851 cached_home_directory);
854 return cached_home_directory;
857 DEFUN("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
858 Return the user's home directory, as a string.
862 Extbyte *path = get_home_directory();
864 return path == NULL ? Qnil :
865 Fexpand_file_name(Fsubstitute_in_file_name
866 (build_ext_string((char *)path, Qfile_name)),
870 DEFUN("system-name", Fsystem_name, 0, 0, 0, /*
871 Return the name of the machine you are running on, as a string.
875 return Fcopy_sequence(Vsystem_name);
878 DEFUN("emacs-pid", Femacs_pid, 0, 0, 0, /*
879 Return the process ID of Emacs, as an integer.
883 return make_int(getpid());
886 DEFUN("current-time", Fcurrent_time, 0, 0, 0, /*
887 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
888 The time is returned as a list of three integers. The first has the
889 most significant 16 bits of the seconds, while the second has the
890 least significant 16 bits. The third integer gives the microsecond
893 The microsecond count is zero on systems that do not provide
894 resolution finer than a second.
901 return list3(make_int((EMACS_SECS(t) >> 16) & 0xffff),
902 make_int((EMACS_SECS(t) >> 0) & 0xffff),
903 make_int(EMACS_USECS(t)));
906 #if defined(HAVE_MPZ) && defined(WITH_GMP)
907 DEFUN("current-btime", Fcurrent_btime, 0, 0, 0, /*
908 Return the current time, as the number of microseconds since
910 The time is returned as a big integer.
921 bigz_set_long(btime, EMACS_SECS(t));
922 mpz_mul_ui(btime, btime, 1000000UL);
923 mpz_add_ui(btime, btime, EMACS_USECS(t));
924 result = make_bigz_bz(btime);
930 DEFUN("time-to-btime", Ftime_to_btime, 1, 1, 0, /*
931 Return a big integer from SPECIFIED-TIME with the
932 number of microseconds since the Epoch.
936 if (CONSP(specified_time)) {
939 Lisp_Object high, low, ulow;
943 high = XCAR(specified_time);
944 low = XCDR(specified_time);
957 bigz_set_ulong(bz, (XINT(high) << 16) + (XINT(low) & 0xffff));
958 mpz_mul_ui(bz, bz, 1000000UL);
959 mpz_add_ui(bz, bz, XINT(ulow));
960 result = make_bigz_bz(bz);
964 } else if (BIGZP(specified_time)) {
965 return specified_time;
967 CHECK_CONS(specified_time);
972 DEFUN("btime-to-time", Fbtime_to_time, 1, 1, 0, /*
973 Return a time specified as (HIGH LOW USEC) as obtainable
974 from `current-time' from SPECIFIED-TIME.
978 if (CONSP(specified_time)) {
979 Lisp_Object high, low, ulow;
981 high = XCAR(specified_time);
982 low = XCDR(specified_time);
995 return list3(high, low, ulow);
996 } else if (BIGZP(specified_time)) {
1005 mpz_tdiv_qr_ui(bh, bl, XBIGZ_DATA(specified_time), 1000000UL);
1006 highlow = bigz_to_long(bh);
1007 usecs = bigz_to_long(bl);
1008 result = list3(make_int((highlow >> 16) & 0xffff),
1009 make_int((highlow >> 0) & 0xffff),
1016 CHECK_BIGZ(specified_time);
1020 #endif /* HAVE_MPZ && WITH_MPZ */
1022 DEFUN("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
1023 Return the amount of time used by this SXEmacs process so far.
1024 The return value is a list of three floating-point numbers, expressing
1025 the user, system, and real times used by the process. The user time
1026 measures the time actually spent by the CPU executing the code in this
1027 process. The system time measures time spent by the CPU executing kernel
1028 code on behalf of this process (e.g. I/O requests made by the process).
1030 Note that the user and system times measure processor time, as opposed
1031 to real time, and only accrue when the processor is actually doing
1032 something: Time spent in an idle wait (waiting for user events to come
1033 in or for I/O on a disk drive or other device to complete) does not
1034 count. Thus, the user and system times will often be considerably
1035 less than the real time.
1037 Some systems do not allow the user and system times to be distinguished.
1038 In this case, the user time will be the total processor time used by
1039 the process, and the system time will be 0.
1041 Some systems do not allow the real and processor times to be distinguished.
1042 In this case, the user and real times will be the same and the system
1047 double user, sys, real;
1049 get_process_times(&user, &sys, &real);
1050 return list3(make_float(user), make_float(sys), make_float(real));
1053 DEFUN("uptime", Fuptime, 0, 1, "P", /*
1054 Display SXEmacs \"uptime\".
1056 When called interactively, without a prefix arg, return a list of 4
1057 integers, being the elapsed days, hours, minutes, and seconds that
1058 this SXEmacs process has been running. Display this info prettyfied
1061 With optional prefix arg, USR-SYS-REAL, return a list of 3 floats:
1062 user time, system time, and real time. Also displayed in the echo
1063 area if called interactively. See: `current-process-time' for more
1068 double usr, sys, real;
1069 unsigned int days, hours, minutes, seconds;
1071 days = hours = minutes = seconds = 0;
1072 get_process_times(&usr, &sys, &real);
1074 if (!NILP(usr_sys_real)) {
1075 if (!NILP(Finteractive_p()))
1076 message("User: %0.2f, System: %0.2f, Real: %0.6f\n",
1078 return list3(make_float(usr), make_float(sys), make_float(real));
1080 /* convert the real time to an int (with rounding) */
1081 real = (unsigned long) (real + 0.5);
1083 if (real >= 86400) {
1084 days = real / 86400;
1085 real = real - (days * 86400);
1088 hours = real / 3600;
1089 real = real - (hours * 3600);
1092 minutes = real / 60;
1093 real = real - (minutes * 60);
1097 if (!NILP(Finteractive_p())) {
1099 message("Uptime: %d days, %d hours, %d minutes, %d seconds\n",
1100 days, hours, minutes, seconds);
1102 message("Uptime: %d hours, %d minutes, %d seconds\n",
1103 hours, minutes, seconds);
1104 else if (minutes > 0)
1105 message("Uptime: %d minutes, %d seconds\n",
1107 else if (seconds > 0)
1108 message("Uptime: %d seconds\n", seconds);
1110 return list4(make_int(days), make_int(hours),
1111 make_int(minutes), make_int(seconds));
1115 int lisp_to_time(Lisp_Object specified_time, time_t * result);
1116 int lisp_to_time(Lisp_Object specified_time, time_t * result)
1118 Lisp_Object high, low;
1120 if (NILP(specified_time))
1121 return time(result) != -1;
1123 if (CONSP(specified_time)) {
1124 high = XCAR(specified_time);
1125 low = XCDR(specified_time);
1130 *result = (XINT(high) << 16) + (XINT(low) & 0xffff);
1131 return *result >> 16 == XINT(high);
1132 #if defined HAVE_MPZ && defined WITH_GMP
1133 } else if (BIGZP(specified_time)) {
1136 bigz_set_ulong(bz, 1000000UL);
1137 bigz_div(bz, XBIGZ_DATA(specified_time), bz);
1138 *result = bigz_to_ulong(bz);
1143 CHECK_CONS(specified_time);
1148 Lisp_Object time_to_lisp(time_t the_time);
1149 Lisp_Object time_to_lisp(time_t the_time)
1151 unsigned int item = (unsigned int)the_time;
1152 return Fcons(make_int(item >> 16), make_int(item & 0xffff));
1155 size_t emacs_strftime(char *string, size_t max, const char *format,
1156 const struct tm * tm);
1157 static long difftm(const struct tm *a, const struct tm *b);
1159 DEFUN("format-time-string", Fformat_time_string, 1, 2, 0, /*
1160 Use FORMAT-STRING to format the time TIME.
1161 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1162 `current-time' and `file-attributes'. If TIME is not specified it
1163 defaults to the current time.
1165 If compiled with ENT, TIME may also be a big integer representing
1166 the number of microseconds since the Epoch, as output by
1169 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1170 %a is replaced by the abbreviated name of the day of week.
1171 %A is replaced by the full name of the day of week.
1172 %b is replaced by the abbreviated name of the month.
1173 %B is replaced by the full name of the month.
1174 %c is a synonym for "%x %X".
1175 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1176 %d is replaced by the day of month, zero-padded.
1177 %D is a synonym for "%m/%d/%y".
1178 %e is replaced by the day of month, blank-padded.
1179 %h is a synonym for "%b".
1180 %H is replaced by the hour (00-23).
1181 %I is replaced by the hour (00-12).
1182 %j is replaced by the day of the year (001-366).
1183 %k is replaced by the hour (0-23), blank padded.
1184 %l is replaced by the hour (1-12), blank padded.
1185 %m is replaced by the month (01-12).
1186 %M is replaced by the minute (00-59).
1187 %n is a synonym for "\\n".
1188 %p is replaced by AM or PM, as appropriate.
1189 %r is a synonym for "%I:%M:%S %p".
1190 %R is a synonym for "%H:%M".
1191 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1192 nonstandard extension)
1193 %S is replaced by the second (00-60).
1194 %t is a synonym for "\\t".
1195 %T is a synonym for "%H:%M:%S".
1196 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1197 %w is replaced by the day of week (0-6), Sunday is day 0.
1198 %W is replaced by the week of the year (00-53), first day of week is Monday.
1199 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1200 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1201 %y is replaced by the year without century (00-99).
1202 %Y is replaced by the year with century.
1203 %Z is replaced by the time zone abbreviation.
1205 The number of options reflects the `strftime' function.
1207 BUG: If the charset used by the current locale is not ISO 8859-1, the
1208 characters appearing in the day and month names may be incorrect.
1210 (format_string, time_))
1216 CHECK_STRING(format_string);
1218 if (!lisp_to_time(time_, &value) || !(tm = localtime(&value)))
1219 error("Invalid time specification");
1221 /* This is probably enough. */
1222 size = XSTRING_LENGTH(format_string) * 6 + 50;
1225 char *buf = (char *)alloca(size);
1227 if (emacs_strftime(buf, size,
1228 (const char *)XSTRING_DATA(format_string),
1231 return build_ext_string(buf, Qbinary);
1232 /* If buffer was too small, make it bigger. */
1237 DEFUN("decode-time", Fdecode_time, 0, 1, 0, /*
1238 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1239 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1240 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1241 to use the current time.
1242 If compiled with ENT, SPECIFIED-TIME may also be a big integer as
1243 output from `current-btime', with the number of mircoseconds since
1246 The list has the following nine members:
1247 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1248 only some operating systems support.
1249 MINUTE is an integer between 0 and 59.
1250 HOUR is an integer between 0 and 23.
1251 DAY is an integer between 1 and 31.
1252 MONTH is an integer between 1 and 12.
1253 YEAR is an integer indicating the four-digit year.
1254 DOW is the day of week, an integer between 0 and 6, where 0 is Sunday.
1255 DST is t if daylight savings time is effect, otherwise nil.
1256 ZONE is an integer indicating the number of seconds east of Greenwich.
1257 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1263 struct tm *decoded_time;
1264 Lisp_Object list_args[9];
1266 if (!lisp_to_time(specified_time, &time_spec)
1267 || !(decoded_time = localtime(&time_spec)))
1268 error("Invalid time specification");
1270 list_args[0] = make_int(decoded_time->tm_sec);
1271 list_args[1] = make_int(decoded_time->tm_min);
1272 list_args[2] = make_int(decoded_time->tm_hour);
1273 list_args[3] = make_int(decoded_time->tm_mday);
1274 list_args[4] = make_int(decoded_time->tm_mon + 1);
1275 list_args[5] = make_int(decoded_time->tm_year + 1900);
1276 list_args[6] = make_int(decoded_time->tm_wday);
1277 list_args[7] = (decoded_time->tm_isdst) ? Qt : Qnil;
1279 /* Make a copy, in case gmtime modifies the struct. */
1280 save_tm = *decoded_time;
1281 decoded_time = gmtime(&time_spec);
1282 if (decoded_time == 0)
1283 list_args[8] = Qnil;
1285 list_args[8] = make_int(difftm(&save_tm, decoded_time));
1286 return Flist(9, list_args);
1289 static void set_time_zone_rule(char *tzstring);
1291 /* from GNU Emacs 21, per Simon Josefsson, modified by stephen
1292 The slight inefficiency is justified since negative times are weird. */
1293 Lisp_Object make_time(time_t tval)
1295 return list2(make_int(tval < 0 ? tval / 0x10000 : tval >> 16),
1296 make_int(tval & 0xFFFF));
1299 DEFUN("encode-time", Fencode_time, 6, MANY, 0, /*
1300 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1301 This is the reverse operation of `decode-time', which see.
1302 ZONE defaults to the current time zone rule. This can
1303 be a string (as from `set-time-zone-rule'), or it can be a list
1304 \(as from `current-time-zone') or an integer (as from `decode-time')
1305 applied without consideration for daylight savings time.
1307 You can pass more than 7 arguments; then the first six arguments
1308 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1309 The intervening arguments are ignored.
1310 This feature lets (apply 'encode-time (decode-time ...)) work.
1312 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1313 for example, a DAY of 0 means the day preceding the given month.
1314 Year numbers less than 100 are treated just like other year numbers.
1315 If you want them to stand for years in this century, you must do that yourself.
1317 (int nargs, Lisp_Object * args))
1321 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1324 tm.tm_sec = XINT(*args++); /* second */
1326 tm.tm_min = XINT(*args++); /* minute */
1328 tm.tm_hour = XINT(*args++); /* hour */
1330 tm.tm_mday = XINT(*args++); /* day */
1332 tm.tm_mon = XINT(*args++) - 1; /* month */
1334 tm.tm_year = XINT(*args++) - 1900; /* year */
1342 the_time = mktime(&tm);
1346 char **oldenv = environ, **newenv;
1348 if (STRINGP(zone)) {
1349 tzstring = (char *)XSTRING_DATA(zone);
1350 } else if (INTP(zone)) {
1351 int abszone = abs(XINT(zone));
1352 int sz = snprintf(tzbuf, sizeof(tzbuf), "XXX%s%d:%02d:%02d",
1353 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1354 (abszone / 60) % 60, abszone % 60);
1355 assert(sz >= 0 && (size_t)sz < sizeof(tzbuf));
1358 error("Invalid time zone specification");
1361 /* Set TZ before calling mktime; merely adjusting mktime's
1362 returned value doesn't suffice, since that would mishandle
1364 set_time_zone_rule(tzstring);
1366 the_time = mktime(&tm);
1368 /* Restore TZ to previous value. */
1371 #if !defined EF_USE_BDWGC
1373 #endif /* !EF_USE_BDWGC */
1374 #ifdef LOCALTIME_CACHE
1379 if (the_time == (time_t) - 1) {
1380 error("Specified time is not representable");
1383 return make_time(the_time);
1386 #if defined(HAVE_MPZ) && defined WITH_GMP
1387 DEFUN("encode-btime", Fencode_btime, 6, MANY, 0, /*
1388 Like `encode-time' but return a big integer time instead.
1391 (int nargs, Lisp_Object * args))
1395 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1400 tm.tm_sec = XINT(*args++); /* second */
1402 tm.tm_min = XINT(*args++); /* minute */
1404 tm.tm_hour = XINT(*args++); /* hour */
1406 tm.tm_mday = XINT(*args++); /* day */
1408 tm.tm_mon = XINT(*args++) - 1; /* month */
1410 tm.tm_year = XINT(*args++) - 1900; /* year */
1417 the_time = mktime(&tm);
1421 char **oldenv = environ, **newenv;
1424 tzstring = (char *)XSTRING_DATA(zone);
1425 else if (INTP(zone)) {
1426 int abszone = abs(XINT(zone));
1427 int sz = snprintf(tzbuf, sizeof(tzbuf), "XXX%s%d:%02d:%02d",
1428 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1429 (abszone / 60) % 60, abszone % 60);
1430 assert(sz>=0 && (size_t)sz < sizeof(tzbuf));
1433 error("Invalid time zone specification");
1435 /* Set TZ before calling mktime; merely adjusting mktime's returned
1436 value doesn't suffice, since that would mishandle leap seconds. */
1437 set_time_zone_rule(tzstring);
1439 the_time = mktime(&tm);
1441 /* Restore TZ to previous value. */
1445 #ifdef LOCALTIME_CACHE
1450 if (the_time == (time_t) - 1)
1451 error("Specified time is not representable");
1454 bigz_set_ulong(bz, the_time);
1455 mpz_mul_ui(bz, bz, 1000000UL);
1456 result = make_bigz_bz(bz);
1463 DEFUN("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1464 Return the current time, as a human-readable string.
1465 Programs can use this function to decode a time,
1466 since the number of columns in each field is fixed.
1467 The format is `Sun Sep 16 01:03:52 1973'.
1468 If an argument is given, it specifies a time to format
1469 instead of the current time. The argument should have the form:
1472 (HIGH LOW . IGNORED).
1473 Thus, you can use times obtained from `current-time'
1474 and from `file-attributes'.
1476 If compiled with ENT, SPECIFIED-TIME may also be a big integer
1477 as obtained from `current-btime' with the number of microseconds
1486 if (!lisp_to_time(specified_time, &value))
1488 the_ctime = ctime(&value);
1490 /* ctime is documented as always returning a "\n\0"-terminated
1491 26-byte American time string, but let's be careful anyways. */
1492 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++) ;
1494 return make_ext_string((Extbyte *) the_ctime, len, Qbinary);
1497 #define TM_YEAR_ORIGIN 1900
1499 /* Yield A - B, measured in seconds. */
1500 static long difftm(const struct tm *a, const struct tm *b)
1502 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1503 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1504 /* Some compilers can't handle this as a single return statement. */
1506 /* difference in day of year */
1507 a->tm_yday - b->tm_yday
1508 /* + intervening leap days */
1509 + ((ay >> 2) - (by >> 2))
1510 - (ay / 100 - by / 100)
1511 + ((ay / 100 >> 2) - (by / 100 >> 2))
1512 /* + difference in years * 365 */
1513 + (long)(ay - by) * 365);
1514 return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
1515 + (a->tm_min - b->tm_min))
1516 + (a->tm_sec - b->tm_sec));
1519 DEFUN("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1520 Return the offset and name for the local time zone.
1521 This returns a list of the form (OFFSET NAME).
1522 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1523 A negative value means west of Greenwich.
1524 NAME is a string giving the name of the time zone.
1525 If an argument is given, it specifies when the time zone offset is determined
1526 instead of using the current time. The argument should have the form:
1529 (HIGH LOW . IGNORED).
1530 Thus, you can use times obtained from `current-time'
1531 and from `file-attributes'.
1533 Some operating systems cannot provide all this information to Emacs;
1534 in this case, `current-time-zone' returns a list containing nil for
1535 the data it can't find.
1540 struct tm *t = NULL;
1542 if (lisp_to_time(specified_time, &value)
1543 && (t = gmtime(&value)) != 0) {
1544 /* Make a copy, in case localtime modifies *t. */
1550 t = localtime(&value);
1551 offset = difftm(t, &gmt);
1555 s = (const char *)t->tm_zone;
1556 #else /* not HAVE_TM_ZONE */
1558 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1559 s = tzname[t->tm_isdst];
1561 #endif /* not HAVE_TM_ZONE */
1563 /* No local time zone name is available; use "+-NNNN"
1565 int am = (offset < 0 ? -offset : offset) / 60;
1566 int sz = snprintf(buf, sizeof(buf), "%c%02d%02d",
1567 (offset < 0 ? '-' : '+'),
1569 assert(sz>=0 && (size_t)sz < sizeof(buf));
1572 return list2(make_int(offset), build_string(s));
1574 return list2(Qnil, Qnil);
1578 #ifdef LOCALTIME_CACHE
1580 /* These two values are known to load tz files in buggy implementations,
1581 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1582 Their values shouldn't matter in non-buggy implementations.
1583 We don't use string literals for these strings,
1584 since if a string in the environment is in readonly
1585 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1586 See Sun bugs 1113095 and 1114114, ``Timezone routines
1587 improperly modify environment''. */
1589 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1590 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1594 /* Set the local time zone rule to TZSTRING.
1595 This allocates memory into `environ', which it is the caller's
1596 responsibility to free. */
1597 static void set_time_zone_rule(char *tzstring)
1600 char **from, **to, **newenv;
1602 for (from = environ; *from; from++)
1604 envptrs = from - environ + 2;
1605 newenv = to = (char **)xmalloc(envptrs * sizeof(char *)
1606 + (tzstring ? strlen(tzstring) + 4 : 0));
1608 char *t = (char *)(to + envptrs);
1610 strcat(t, tzstring);
1614 for (from = environ; *from; from++)
1615 if (strncmp(*from, "TZ=", 3) != 0)
1621 #ifdef LOCALTIME_CACHE
1623 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1624 "US/Pacific" that loads a tz file, then changes to a value like
1625 "XXX0" that does not load a tz file, and then changes back to
1626 its original value, the last change is (incorrectly) ignored.
1627 Also, if TZ changes twice in succession to values that do
1628 not load a tz file, tzset can dump core (see Sun bug#1225179).
1629 The following code works around these bugs. */
1632 /* Temporarily set TZ to a value that loads a tz file
1633 and that differs from tzstring. */
1636 (strcmp(tzstring, set_time_zone_rule_tz1 + 3) ==
1637 0 ? set_time_zone_rule_tz2 :
1638 set_time_zone_rule_tz1);
1642 /* The implied tzstring is unknown, so temporarily set TZ to
1643 two different values that each load a tz file. */
1644 *to = set_time_zone_rule_tz1;
1647 *to = set_time_zone_rule_tz2;
1652 /* Now TZ has the desired value, and tzset can be invoked safely. */
1659 DEFUN("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1660 Set the local time zone using TZ, a string specifying a time zone rule.
1661 If TZ is nil, use implementation-defined default time zone information.
1671 tzstring = (char *)XSTRING_DATA(tz);
1674 set_time_zone_rule(tzstring);
1677 environbuf = environ;
1682 void buffer_insert1(struct buffer *buf, Lisp_Object arg)
1684 /* This function can GC */
1685 struct gcpro gcpro1;
1688 if (CHAR_OR_CHAR_INTP(arg)) {
1689 buffer_insert_emacs_char(buf, XCHAR_OR_CHAR_INT(arg));
1690 } else if (STRINGP(arg)) {
1691 buffer_insert_lisp_string(buf, arg);
1693 arg = wrong_type_argument(Qchar_or_string_p, arg);
1699 /* Callers passing one argument to Finsert need not gcpro the
1700 argument "array", since the only element of the array will
1701 not be used after calling insert_emacs_char or insert_lisp_string,
1702 so we don't care if it gets trashed. */
1704 DEFUN("insert", Finsert, 0, MANY, 0, /*
1705 Insert the arguments, either strings or characters, at point.
1706 Point moves forward so that it ends up after the inserted text.
1707 Any other markers at the point of insertion remain before the text.
1708 If a string has non-null string-extent-data, new extents will be created.
1710 (int nargs, Lisp_Object * args))
1712 /* This function can GC */
1713 REGISTER int argnum;
1715 for (argnum = 0; argnum < nargs; argnum++) {
1716 buffer_insert1(current_buffer, args[argnum]);
1722 DEFUN("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1723 Insert strings or characters at point, relocating markers after the text.
1724 Point moves forward so that it ends up after the inserted text.
1725 Any other markers at the point of insertion also end up after the text.
1727 (int nargs, Lisp_Object * args))
1729 /* This function can GC */
1730 REGISTER int argnum;
1731 REGISTER Lisp_Object tem;
1733 for (argnum = 0; argnum < nargs; argnum++) {
1736 if (CHAR_OR_CHAR_INTP(tem)) {
1737 buffer_insert_emacs_char_1(current_buffer, -1,
1738 XCHAR_OR_CHAR_INT(tem),
1739 INSDEL_BEFORE_MARKERS);
1740 } else if (STRINGP(tem)) {
1741 buffer_insert_lisp_string_1(current_buffer, -1, tem,
1742 INSDEL_BEFORE_MARKERS);
1744 tem = wrong_type_argument(Qchar_or_string_p, tem);
1751 DEFUN("insert-string", Finsert_string, 1, 2, 0, /*
1752 Insert STRING into BUFFER at BUFFER's point.
1753 Point moves forward so that it ends up after the inserted text.
1754 Any other markers at the point of insertion remain before the text.
1755 If a string has non-null string-extent-data, new extents will be created.
1756 BUFFER defaults to the current buffer.
1760 struct buffer *b = decode_buffer(buffer, 1);
1761 CHECK_STRING(string);
1762 buffer_insert_lisp_string(b, string);
1766 /* Third argument in FSF is INHERIT:
1768 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1769 from adjoining text, if those properties are sticky."
1771 Jamie thinks this is bogus. */
1773 DEFUN("insert-char", Finsert_char, 1, 4, 0, /*
1774 Insert COUNT copies of CHARACTER into BUFFER.
1775 Point and all markers are affected as in the function `insert'.
1776 COUNT defaults to 1 if omitted.
1777 The optional third arg IGNORED is INHERIT under FSF Emacs.
1778 This is highly bogus, however, and SXEmacs always behaves as if
1779 `t' were passed to INHERIT.
1780 The optional fourth arg BUFFER specifies the buffer to insert the
1781 text into. If BUFFER is nil, the current buffer is assumed.
1783 (character, count, ignored, buffer))
1785 /* This function can GC */
1786 REGISTER Bufbyte *string;
1789 REGISTER Bytecount n;
1790 REGISTER Bytecount charlen;
1791 Bufbyte str[MAX_EMCHAR_LEN];
1792 struct buffer *b = decode_buffer(buffer, 1);
1795 CHECK_CHAR_COERCE_INT(character);
1803 charlen = set_charptr_emchar(str, XCHAR(character));
1808 string = alloca_array(Bufbyte, slen);
1809 /* Write as many copies of the character into the temp string as will fit. */
1810 for (i = 0; i + charlen <= slen; i += charlen)
1811 for (j = 0; j < charlen; j++)
1812 string[i + j] = str[j];
1815 buffer_insert_raw_string(b, string, slen);
1819 #if 0 /* FSFmacs bogosity */
1822 insert_and_inherit(string, n);
1827 buffer_insert_raw_string(b, string, n);
1833 /* Making strings from buffer contents. */
1835 DEFUN("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1836 Return the contents of part of BUFFER as a string.
1837 The two arguments START and END are character positions;
1838 they can be in either order. If omitted, they default to the beginning
1839 and end of BUFFER, respectively.
1840 If there are duplicable extents in the region, the string remembers
1841 them in its extent data.
1842 If BUFFER is nil, the current buffer is assumed.
1844 (start, end, buffer))
1846 /* This function can GC */
1848 struct buffer *b = decode_buffer(buffer, 1);
1850 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1851 return make_string_from_buffer(b, begv, zv - begv);
1854 /* It might make more sense to name this
1855 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1856 and what the function does is probably good enough for what the
1857 user-code will typically want to use it for. */
1858 DEFUN("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1859 Return the text from START to END as a string, without copying the extents.
1861 (start, end, buffer))
1863 /* This function can GC */
1865 struct buffer *b = decode_buffer(buffer, 1);
1867 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1868 return make_string_from_buffer_no_extents(b, begv, zv - begv);
1871 DEFUN("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1872 Insert before point a substring of the contents of buffer BUFFER.
1873 BUFFER may be a buffer or a buffer name.
1874 Arguments START and END are character numbers specifying the substring.
1875 They default to the beginning and the end of BUFFER.
1877 (buffer, start, end))
1879 /* This function can GC */
1882 Lisp_Object tmp_buf = emacs_get_buffer(buffer, 1);
1884 bp = XBUFFER(tmp_buf);
1885 get_buffer_range_char(bp, start, end, &b, &e, GB_ALLOW_NIL);
1888 buffer_insert_from_buffer(current_buffer, bp, b, e - b);
1893 DEFUN("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1894 Compare two substrings of two buffers; return result as number.
1895 the value is -N if first string is less after N-1 chars,
1896 +N if first string is greater after N-1 chars, or 0 if strings match.
1897 Each substring is represented as three arguments: BUFFER, START and END.
1898 That makes six args in all, three for each substring.
1900 The value of `case-fold-search' in the current buffer
1901 determines whether case is significant or ignored.
1903 (buffer1, start1, end1, buffer2, start2, end2))
1905 Bufpos begp1, endp1, begp2, endp2;
1906 REGISTER Charcount len1, len2, length, i;
1907 struct buffer *bp1, *bp2;
1908 Lisp_Object trt = ((!NILP(current_buffer->case_fold_search)) ?
1909 XCASE_TABLE_CANON(current_buffer->
1910 case_table) : Qnil);
1912 /* Find the first buffer and its substring. */
1914 bp1 = decode_buffer(buffer1, 1);
1915 get_buffer_range_char(bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1917 /* Likewise for second substring. */
1919 bp2 = decode_buffer(buffer2, 1);
1920 get_buffer_range_char(bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1922 len1 = endp1 - begp1;
1923 len2 = endp2 - begp2;
1928 for (i = 0; i < length; i++) {
1929 Emchar c1 = BUF_FETCH_CHAR(bp1, begp1 + i);
1930 Emchar c2 = BUF_FETCH_CHAR(bp2, begp2 + i);
1932 c1 = TRT_TABLE_OF(trt, c1);
1933 c2 = TRT_TABLE_OF(trt, c2);
1936 return make_int(-1 - i);
1938 return make_int(i + 1);
1941 /* The strings match as far as they go.
1942 If one is shorter, that one is less. */
1944 return make_int(length + 1);
1945 else if (length < len2)
1946 return make_int(-length - 1);
1948 /* Same length too => they are equal. */
1952 static Lisp_Object subst_char_in_region_unwind(Lisp_Object arg)
1954 XBUFFER(XCAR(arg))->undo_list = XCDR(arg);
1958 static Lisp_Object subst_char_in_region_unwind_1(Lisp_Object arg)
1960 XBUFFER(XCAR(arg))->filename = XCDR(arg);
1964 DEFUN("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1965 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1966 If optional arg NOUNDO is non-nil, don't record this change for undo
1967 and don't mark the buffer as really changed.
1969 (start, end, fromchar, tochar, noundo))
1971 /* This function can GC */
1975 struct buffer *buf = current_buffer;
1976 int count = specpdl_depth();
1978 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
1979 CHECK_CHAR_COERCE_INT(fromchar);
1980 CHECK_CHAR_COERCE_INT(tochar);
1982 fromc = XCHAR(fromchar);
1983 toc = XCHAR(tochar);
1985 /* If we don't want undo, turn off putting stuff on the list.
1986 That's faster than getting rid of things,
1987 and it prevents even the entry for a first change.
1988 Also inhibit locking the file. */
1989 if (!NILP(noundo)) {
1990 record_unwind_protect(subst_char_in_region_unwind,
1991 Fcons(Fcurrent_buffer(), buf->undo_list));
1992 buf->undo_list = Qt;
1993 /* Don't do file-locking. */
1994 record_unwind_protect(subst_char_in_region_unwind_1,
1995 Fcons(Fcurrent_buffer(), buf->filename));
1996 buf->filename = Qnil;
1999 mc_count = begin_multiple_change(buf, pos, stop);
2000 while (pos < stop) {
2001 if (BUF_FETCH_CHAR(buf, pos) == fromc) {
2002 /* There used to be some code here that set the buffer to
2003 unmodified if NOUNDO was specified and there was only
2004 one change to the buffer since it was last saved.
2005 This is a crock of shit, so I'm not duplicating this
2006 behavior. I think this was left over from when
2007 prepare_to_modify_buffer() actually bumped MODIFF,
2008 so that code was supposed to undo this change. --ben */
2009 buffer_replace_char(buf, pos, toc, !NILP(noundo), 0);
2011 /* If noundo is not nil then we don't mark the buffer as
2012 modified. In reality that needs to happen externally
2013 only. Internally redisplay needs to know that the actual
2014 contents it should be displaying have changed. */
2016 Fset_buffer_modified_p(Fbuffer_modified_p(Qnil),
2021 end_multiple_change(buf, mc_count);
2023 unbind_to(count, Qnil);
2027 /* #### Shouldn't this also accept a BUFFER argument, in the good old
2028 XEmacs tradition? */
2029 DEFUN("translate-region", Ftranslate_region, 3, 3, 0, /*
2030 Translate characters from START to END according to TABLE.
2032 If TABLE is a string, the Nth character in it is the mapping for the
2033 character with code N.
2035 If TABLE is a vector, its Nth element is the mapping for character
2036 with code N. The values of elements may be characters, strings, or
2037 nil (nil meaning don't replace.)
2039 If TABLE is a char-table, its elements describe the mapping between
2040 characters and their replacements. The char-table should be of type
2041 `char' or `generic'.
2043 Returns the number of substitutions performed.
2045 (start, end, table))
2047 /* This function can GC */
2048 Bufpos pos, stop; /* Limits of the region. */
2049 int cnt = 0; /* Number of changes made. */
2051 struct buffer *buf = current_buffer;
2054 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
2055 mc_count = begin_multiple_change(buf, pos, stop);
2056 if (STRINGP(table)) {
2057 Lisp_String *stable = XSTRING(table);
2058 Charcount size = string_char_length(stable);
2060 /* Under Mule, string_char(n) is O(n), so for large tables or
2061 large regions it makes sense to create an array of Emchars. */
2062 if (size * (stop - pos) > 65536) {
2063 Emchar *etable = alloca_array(Emchar, size);
2064 convert_bufbyte_string_into_emchar_string
2065 (string_data(stable), string_length(stable),
2067 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2070 Emchar nc = etable[oc];
2072 buffer_replace_char(buf, pos,
2081 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2084 Emchar nc = string_char(stable, oc);
2086 buffer_replace_char(buf, pos,
2093 } else if (VECTORP(table)) {
2094 Charcount size = XVECTOR_LENGTH(table);
2095 Lisp_Object *vtable = XVECTOR_DATA(table);
2097 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2099 Lisp_Object replacement = vtable[oc];
2101 if (CHAR_OR_CHAR_INTP(replacement)) {
2103 XCHAR_OR_CHAR_INT(replacement);
2105 buffer_replace_char(buf, pos,
2109 } else if (STRINGP(replacement)) {
2111 XSTRING_CHAR_LENGTH(replacement) -
2113 buffer_delete_range(buf, pos, pos + 1,
2115 buffer_insert_lisp_string_1(buf, pos,
2118 pos += incr, stop += incr;
2120 } else if (!NILP(replacement)) {
2123 (Qchar_or_string_p, replacement);
2128 } else if (CHAR_TABLEP(table)
2129 && (XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_GENERIC
2130 || XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_CHAR)) {
2131 Lisp_Char_Table *ctable = XCHAR_TABLE(table);
2133 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2134 Lisp_Object replacement = get_char_table(oc, ctable);
2136 if (CHAR_OR_CHAR_INTP(replacement)) {
2137 Emchar nc = XCHAR_OR_CHAR_INT(replacement);
2139 buffer_replace_char(buf, pos, nc, 0, 0);
2142 } else if (STRINGP(replacement)) {
2144 XSTRING_CHAR_LENGTH(replacement) - 1;
2145 buffer_delete_range(buf, pos, pos + 1, 0);
2146 buffer_insert_lisp_string_1(buf, pos,
2148 pos += incr, stop += incr;
2150 } else if (!NILP(replacement)) {
2152 wrong_type_argument(Qchar_or_string_p,
2158 dead_wrong_type_argument(Qstringp, table);
2159 end_multiple_change(buf, mc_count);
2161 return make_int(cnt);
2164 DEFUN("delete-region", Fdelete_region, 2, 3, "r", /*
2165 Delete the text between point and mark.
2166 When called from a program, expects two arguments START and END
2167 \(integers or markers) specifying the stretch to be deleted.
2168 If optional third arg BUFFER is nil, the current buffer is assumed.
2170 (start, end, buffer))
2172 /* This function can GC */
2173 Bufpos bp_start, bp_end;
2174 struct buffer *buf = decode_buffer(buffer, 1);
2176 get_buffer_range_char(buf, start, end, &bp_start, &bp_end, 0);
2177 buffer_delete_range(buf, bp_start, bp_end, 0);
2181 void widen_buffer(struct buffer *b, int no_clip)
2183 if (BUF_BEGV(b) != BUF_BEG(b)) {
2185 SET_BOTH_BUF_BEGV(b, BUF_BEG(b), BI_BUF_BEG(b));
2187 if (BUF_ZV(b) != BUF_Z(b)) {
2189 SET_BOTH_BUF_ZV(b, BUF_Z(b), BI_BUF_Z(b));
2194 /* Changing the buffer bounds invalidates any recorded current
2196 invalidate_current_column();
2197 narrow_line_number_cache(b);
2201 DEFUN("widen", Fwiden, 0, 1, "", /*
2202 Remove restrictions (narrowing) from BUFFER.
2203 This allows the buffer's full text to be seen and edited.
2204 If BUFFER is nil, the current buffer is assumed.
2208 struct buffer *b = decode_buffer(buffer, 1);
2213 DEFUN("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2214 Restrict editing in BUFFER to the current region.
2215 The rest of the text becomes temporarily invisible and untouchable
2216 but is not deleted; if you save the buffer in a file, the invisible
2217 text is included in the file. \\[widen] makes all visible again.
2218 If BUFFER is nil, the current buffer is assumed.
2219 See also `save-restriction'.
2221 When calling from a program, pass two arguments; positions (integers
2222 or markers) bounding the text that should remain visible.
2224 (start, end, buffer))
2226 Bufpos bp_start, bp_end;
2227 struct buffer *buf = decode_buffer(buffer, 1);
2228 Bytind bi_start, bi_end;
2230 get_buffer_range_char(buf, start, end, &bp_start, &bp_end,
2231 GB_ALLOW_PAST_ACCESSIBLE);
2232 bi_start = bufpos_to_bytind(buf, bp_start);
2233 bi_end = bufpos_to_bytind(buf, bp_end);
2235 SET_BOTH_BUF_BEGV(buf, bp_start, bi_start);
2236 SET_BOTH_BUF_ZV(buf, bp_end, bi_end);
2237 if (BUF_PT(buf) < bp_start)
2238 BUF_SET_PT(buf, bp_start);
2239 if (BUF_PT(buf) > bp_end)
2240 BUF_SET_PT(buf, bp_end);
2242 /* Changing the buffer bounds invalidates any recorded current column. */
2243 invalidate_current_column();
2244 narrow_line_number_cache(buf);
2248 Lisp_Object save_restriction_save(void)
2250 Lisp_Object bottom, top;
2251 /* Note: I tried using markers here, but it does not win
2252 because insertion at the end of the saved region
2253 does not advance mh and is considered "outside" the saved region. */
2254 bottom = make_int(BUF_BEGV(current_buffer) - BUF_BEG(current_buffer));
2255 top = make_int(BUF_Z(current_buffer) - BUF_ZV(current_buffer));
2257 return noseeum_cons(Fcurrent_buffer(), noseeum_cons(bottom, top));
2260 Lisp_Object save_restriction_restore(Lisp_Object data)
2263 Charcount newhead, newtail;
2265 int local_clip_changed = 0;
2267 buf = XBUFFER(XCAR(data));
2268 if (!BUFFER_LIVE_P(buf)) {
2269 /* someone could have killed the buffer in the meantime ... */
2270 free_cons(XCONS(XCDR(data)));
2271 free_cons(XCONS(data));
2275 newhead = XINT(XCAR(tem));
2276 newtail = XINT(XCDR(tem));
2278 free_cons(XCONS(XCDR(data)));
2279 free_cons(XCONS(data));
2281 if (newhead + newtail > BUF_Z(buf) - BUF_BEG(buf)) {
2288 Bytind bi_start, bi_end;
2290 start = BUF_BEG(buf) + newhead;
2291 end = BUF_Z(buf) - newtail;
2293 bi_start = bufpos_to_bytind(buf, start);
2294 bi_end = bufpos_to_bytind(buf, end);
2296 if (BUF_BEGV(buf) != start) {
2297 local_clip_changed = 1;
2298 SET_BOTH_BUF_BEGV(buf, start, bi_start);
2299 narrow_line_number_cache(buf);
2301 if (BUF_ZV(buf) != end) {
2302 local_clip_changed = 1;
2303 SET_BOTH_BUF_ZV(buf, end, bi_end);
2306 if (local_clip_changed)
2309 /* If point is outside the new visible range, move it inside. */
2311 bufpos_clip_to_bounds(BUF_BEGV(buf),
2312 BUF_PT(buf), BUF_ZV(buf)));
2317 DEFUN("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2318 Execute BODY, saving and restoring current buffer's restrictions.
2319 The buffer's restrictions make parts of the beginning and end invisible.
2320 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2321 This special form, `save-restriction', saves the current buffer's restrictions
2322 when it is entered, and restores them when it is exited.
2323 So any `narrow-to-region' within BODY lasts only until the end of the form.
2324 The old restrictions settings are restored
2325 even in case of abnormal exit (throw or error).
2327 The value returned is the value of the last form in BODY.
2329 `save-restriction' can get confused if, within the BODY, you widen
2330 and then make changes outside the area within the saved restrictions.
2332 Note: if you are using both `save-excursion' and `save-restriction',
2333 use `save-excursion' outermost:
2334 (save-excursion (save-restriction ...))
2338 /* This function can GC */
2339 int speccount = specpdl_depth();
2341 record_unwind_protect(save_restriction_restore,
2342 save_restriction_save());
2344 return unbind_to(speccount, Fprogn(body));
2347 DEFUN("format", Fformat, 1, MANY, 0, /*
2348 Return a formatted string out of a format string and arguments.
2350 Arguments: string &rest objects
2352 Hereby, STRING is the format string (also known as template) which
2353 consists of constant (immutable) portions and so called format
2354 specifiers (%-specs). For details on these see below.
2356 The remaining arguments, OBJECTS, are substituted into the format
2357 string to make the result, a string. The exact influence of OBJECTS
2358 on the final result is described below. In general, OBJECTS will be
2359 the lisp objects to be printed.
2363 The format string STRING is basically an ordinary string enriched with
2364 %-sequences (also known as specifiers or specs for short). The specs
2365 in STRING will be substituted for the according object in OBJECTS, to
2366 be precise with a string representation of the object. In the simplest
2367 case, the first specifier in STRING corresponds to the first element
2368 in OBJECTS, the second specifier corresponds to the second element, and
2371 The specifiers themselves look like
2372 %[r$][#][&][ ][+][~][0][-]['][!a][m][.p|*]{sSdioxXbucfeEgGZQFRBC}
2376 %s means print all objects as-is, using `princ'.
2377 %S means print all objects as s-expressions, using `prin1'.
2380 %d means print as an integer in decimal
2381 %i means print as an integer in decimal
2382 %o means print as an integer in octal
2383 %x means print as an integer in lowercase hex
2384 %X means print as an integer in uppercase hex
2385 %b means print as an integer in binary
2386 %u means print a non-negative integer.
2387 %c means print as a single character.
2390 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2391 %e or %E means print as a floating-point number in scientific notation
2393 %g or %G means print as a floating-point number in "pretty format";
2394 depending on the number, either %f or %e/%E format will be used, and
2395 trailing zeroes are removed from the fractional part.
2396 The argument used for all but %s and %S must be a number. It will be
2397 converted to an integer or a floating-point number as necessary.
2398 Please bear in mind that floating point numbers have a limited and fixed
2399 precision although the print output may suggest something else.
2400 The precision varies (depending on the machine) between 12 and 38 digits.
2401 This means if you use specifiers like %.60f on 1.0 or 1.5 only the first
2402 12 to 38 digits are real. Also note, that internally numbers are processed
2403 in a 2-adic arithmetic, so you may experience strange rounding effects,
2404 e.g. %.60f on 1.2 or %f on 1e+40, this is because you force the printer to
2405 be more precise than actually valid. No error is thrown in these cases!
2407 If SXEmacs was compiled with GMP support the following additional
2408 specifiers become available:
2409 %Z means print as big integer (convert to bigz)
2410 %Q means print as fraction (convert to bigq)
2411 %F means print as bigfr or bigf float (convert to in that order)
2412 this specifier always converts the argument, regardless the
2413 value of `read-real-as'
2414 %R means print as real number (convert to bigfr, bigf or float)
2415 this specifier respects the value of `read-real-as'
2416 %B means print as Gaussian number (convert to bigg)
2417 %C means print as complex number (convert to bigc)
2419 Both %B and %C are actually rewrites to %Z%+Z and %F%+F with the
2420 argument rewritten to (real-part arg) (imaginary-part arg).
2421 Flags are passed on to at least the real part specifier.
2425 Using above notation there are several tweaks, so called modifiers,
2426 to fine-tune the substitution. Modifiers are completely optional.
2429 r$ use the `r'-th element of OBJECTS instead the one in order
2430 # print 0x, 0o, 0b prefix for numbers in a different base
2431 & use lisp syntax for base!=10 numbers, as in #x73, implies ~
2432 if non-negative print a place holder ` ' for a sign, `-' otherwise
2433 + always print a sign, `-' if negative and `+' if non-negative
2434 ~ in conjunction with `#' and signed numbers print sign after 0[xob]
2435 0 pad numbers (only on the left) with zeroes instead of spaces
2437 ' group numbers in groups of three
2438 !a use `a' as pad character instead of space
2439 m specify a minimum width of the yielded string
2440 .p use `p' digits of precision, depends on the specifer
2441 * use the argument in order to obtain the precision
2443 %$ means reposition to read a specific numbered argument; for example,
2444 %3$s would apply the `%s' to the third argument after the control string,
2445 and the next format directive would use the fourth argument, the
2446 following one the fifth argument, etc. (There must be a positive integer
2447 between the % and the $).
2449 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2450 specified between the optional repositioning spec and the conversion
2451 character; see below.
2453 An optional minimum field width may be specified after any flag characters
2454 and before the conversion character; it specifies the minimum number of
2455 characters that the converted argument will take up. Padding will be
2456 added on the left (or on the right, if the `-' flag is specified), as
2457 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2460 If the field width is specified as `*', the field width is assumed to have
2461 been specified as an argument. Any repositioning specification that
2462 would normally specify the argument to be converted will now specify
2463 where to find this field width argument, not where to find the argument
2464 to be converted. If there is no repositioning specification, the normal
2465 next argument is used. The argument to be converted will be the next
2466 argument after the field width argument unless the precision is also
2467 specified as `*' (see below).
2469 An optional period character and precision may be specified after any
2470 minimum field width. It specifies the minimum number of digits to
2471 appear in %d, %i, %b, %o, %x, and %X conversions (the number is padded
2472 on the left with zeroes as necessary); the number of digits printed
2473 after the decimal point for %f, %e, and %E conversions; the number
2474 of significant digits printed in %g and %G conversions; and the
2475 maximum number of non-padding characters printed in %s and %S
2476 conversions. The default precision for floating-point conversions
2479 If the precision is specified as `*', the precision is assumed to have been
2480 specified as an argument. The argument used will be the next argument
2481 after the field width argument, if any. If the field width was not
2482 specified as an argument, any repositioning specification that would
2483 normally specify the argument to be converted will now specify where to
2484 find the precision argument. If there is no repositioning specification,
2485 the normal next argument is used.
2487 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2488 plus sign, respectively.
2490 The `#' flag means print numbers in an alternate, more verbose format:
2491 octal numbers begin with 0o; hex numbers begin with a 0x or 0X;
2492 and binary representations start with 0b;
2493 a decimal point is printed in %f, %e, and %E conversions even if no
2494 numbers are printed after it; and trailing zeroes are not omitted in
2495 %g and %G conversions.
2497 Use %% to put a single % into the output.
2499 (int nargs, Lisp_Object * args))
2501 /* It should not be necessary to GCPRO ARGS, because
2502 the caller in the interpreter should take care of that. */
2504 CHECK_STRING(args[0]);
2505 return emacs_doprnt_string_lisp(0, args[0], 0, nargs - 1, args + 1);
2508 DEFUN("char-equal", Fchar_equal, 2, 3, 0, /*
2509 Return t if two characters match, optionally ignoring case.
2510 Both arguments must be characters (i.e. NOT integers).
2511 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2512 If BUFFER is nil, the current buffer is assumed.
2514 (character1, character2, buffer))
2517 struct buffer *b = decode_buffer(buffer, 1);
2519 CHECK_CHAR_COERCE_INT(character1);
2520 CHECK_CHAR_COERCE_INT(character2);
2521 x1 = XCHAR(character1);
2522 x2 = XCHAR(character2);
2524 return (!NILP(b->case_fold_search)
2525 ? DOWNCASE(b, x1) == DOWNCASE(b, x2)
2530 DEFUN("char=", Fchar_Equal, 2, 2, 0, /*
2531 Return t if two characters match, case is significant.
2532 Both arguments must be characters (i.e. NOT integers).
2534 (character1, character2))
2536 CHECK_CHAR_COERCE_INT(character1);
2537 CHECK_CHAR_COERCE_INT(character2);
2539 return EQ(character1, character2) ? Qt : Qnil;
2542 #if 0 /* Undebugged FSFmacs code */
2543 /* Transpose the markers in two regions of the current buffer, and
2544 adjust the ones between them if necessary (i.e.: if the regions
2547 Traverses the entire marker list of the buffer to do so, adding an
2548 appropriate amount to some, subtracting from some, and leaving the
2549 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2551 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2553 void transpose_markers(Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2555 Charcount amt1, amt2, diff;
2557 struct buffer *buf = current_buffer;
2559 /* Update point as if it were a marker. */
2560 if (BUF_PT(buf) < start1) ;
2561 else if (BUF_PT(buf) < end1)
2562 BUF_SET_PT(buf, BUF_PT(buf) + (end2 - end1));
2563 else if (BUF_PT(buf) < start2)
2565 BUF_PT(buf) + (end2 - start2) - (end1 - start1));
2566 else if (BUF_PT(buf) < end2)
2567 BUF_SET_PT(buf, BUF_PT(buf) - (start2 - start1));
2569 /* We used to adjust the endpoints here to account for the gap, but that
2570 isn't good enough. Even if we assume the caller has tried to move the
2571 gap out of our way, it might still be at start1 exactly, for example;
2572 and that places it `inside' the interval, for our purposes. The amount
2573 of adjustment is nontrivial if there's a `denormalized' marker whose
2574 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2575 the dirty work to Fmarker_position, below. */
2577 /* The difference between the region's lengths */
2578 diff = (end2 - start2) - (end1 - start1);
2580 /* For shifting each marker in a region by the length of the other
2581 * region plus the distance between the regions.
2583 amt1 = (end2 - start2) + (start2 - end1);
2584 amt2 = (end1 - start1) + (start2 - end1);
2586 for (marker = BUF_MARKERS(buf); !NILP(marker);
2587 marker = XMARKER(marker)->chain) {
2588 Bufpos mpos = marker_position(marker);
2589 if (mpos >= start1 && mpos < end2) {
2592 else if (mpos < start2)
2596 set_marker_position(marker, mpos);
2603 DEFUN("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2604 Transpose region START1 to END1 with START2 to END2.
2605 The regions may not be overlapping, because the size of the buffer is
2606 never changed in a transposition.
2608 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
2609 any markers that happen to be located in the regions. (#### BUG: currently
2610 this function always acts as if LEAVE-MARKERS is non-nil.)
2612 Transposing beyond buffer boundaries is an error.
2614 (start1, end1, start2, end2, leave_markers))
2616 Bufpos startr1, endr1, startr2, endr2;
2617 Charcount len1, len2;
2618 Lisp_Object string1, string2;
2619 struct buffer *buf = current_buffer;
2621 get_buffer_range_char(buf, start1, end1, &startr1, &endr1, 0);
2622 get_buffer_range_char(buf, start2, end2, &startr2, &endr2, 0);
2624 len1 = endr1 - startr1;
2625 len2 = endr2 - startr2;
2627 if (startr2 < endr1)
2628 error("transposed regions not properly ordered");
2629 else if (startr1 == endr1 || startr2 == endr2)
2630 error("transposed region may not be of length 0");
2632 string1 = make_string_from_buffer(buf, startr1, len1);
2633 string2 = make_string_from_buffer(buf, startr2, len2);
2634 buffer_delete_range(buf, startr2, endr2, 0);
2635 buffer_insert_lisp_string_1(buf, startr2, string1, 0);
2636 buffer_delete_range(buf, startr1, endr1, 0);
2637 buffer_insert_lisp_string_1(buf, startr1, string2, 0);
2639 /* In FSFmacs there is a whole bunch of really ugly code here
2640 to attempt to transpose the regions without using up any
2641 extra memory. Although the intent may be good, the result
2642 was highly bogus. */
2647 /************************************************************************/
2648 /* initialization */
2649 /************************************************************************/
2651 void syms_of_editfns(void)
2653 defsymbol(&Qpoint, "point");
2654 defsymbol(&Qmark, "mark");
2655 defsymbol(&Qregion_beginning, "region-beginning");
2656 defsymbol(&Qregion_end, "region-end");
2657 defsymbol(&Qformat, "format");
2658 defsymbol(&Quser_files_and_directories, "user-files-and-directories");
2660 DEFSUBR(Fchar_equal);
2661 DEFSUBR(Fchar_Equal);
2662 DEFSUBR(Fgoto_char);
2663 DEFSUBR(Fstring_to_char);
2664 DEFSUBR(Fchar_to_string);
2665 DEFSUBR(Fbuffer_substring);
2666 DEFSUBR(Fbuffer_substring_no_properties);
2668 DEFSUBR(Fpoint_marker);
2669 DEFSUBR(Fmark_marker);
2671 DEFSUBR(Fregion_beginning);
2672 DEFSUBR(Fregion_end);
2673 DEFSUBR(Fsave_excursion);
2674 DEFSUBR(Fsave_current_buffer);
2676 DEFSUBR(Fbuffer_size);
2677 DEFSUBR(Fpoint_max);
2678 DEFSUBR(Fpoint_min);
2679 DEFSUBR(Fpoint_min_marker);
2680 DEFSUBR(Fpoint_max_marker);
2686 DEFSUBR(Ffollowing_char);
2687 DEFSUBR(Fpreceding_char);
2688 DEFSUBR(Fchar_after);
2689 DEFSUBR(Fchar_before);
2691 DEFSUBR(Finsert_string);
2692 DEFSUBR(Finsert_before_markers);
2693 DEFSUBR(Finsert_char);
2695 DEFSUBR(Ftemp_directory);
2696 DEFSUBR(Fuser_login_name);
2697 DEFSUBR(Fuser_real_login_name);
2699 DEFSUBR(Fuser_real_uid);
2700 DEFSUBR(Fuser_full_name);
2701 DEFSUBR(Fuser_home_directory);
2702 DEFSUBR(Femacs_pid);
2703 DEFSUBR(Fcurrent_time);
2704 #if defined(HAVE_MPZ) && defined(WITH_GMP)
2705 DEFSUBR(Fcurrent_btime);
2706 DEFSUBR(Ftime_to_btime);
2707 DEFSUBR(Fbtime_to_time);
2708 #endif /* HAVE_MPZ */
2709 DEFSUBR(Fcurrent_process_time);
2711 DEFSUBR(Fformat_time_string);
2712 DEFSUBR(Fdecode_time);
2713 DEFSUBR(Fencode_time);
2714 #if defined(HAVE_MPZ) && defined WITH_GMP
2715 DEFSUBR(Fencode_btime);
2717 DEFSUBR(Fcurrent_time_string);
2718 DEFSUBR(Fcurrent_time_zone);
2719 DEFSUBR(Fset_time_zone_rule);
2720 DEFSUBR(Fsystem_name);
2723 DEFSUBR(Finsert_buffer_substring);
2724 DEFSUBR(Fcompare_buffer_substrings);
2725 DEFSUBR(Fsubst_char_in_region);
2726 DEFSUBR(Ftranslate_region);
2727 DEFSUBR(Fdelete_region);
2729 DEFSUBR(Fnarrow_to_region);
2730 DEFSUBR(Fsave_restriction);
2731 DEFSUBR(Ftranspose_regions);
2733 defsymbol(&Qzmacs_update_region, "zmacs-update-region");
2734 defsymbol(&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2735 defsymbol(&Qzmacs_region_buffer, "zmacs-region-buffer");
2738 void vars_of_editfns(void)
2740 staticpro(&Vsystem_name);
2742 staticpro(&Vuser_name);
2743 staticpro(&Vuser_real_name);
2745 DEFVAR_BOOL("zmacs-regions", &zmacs_regions /*
2746 *Whether LISPM-style active regions should be used.
2747 This means that commands which operate on the region (the area between the
2748 point and the mark) will only work while the region is in the ``active''
2749 state, which is indicated by highlighting. Executing most commands causes
2750 the region to not be in the active state, so (for example) \\[kill-region] will only
2751 work immediately after activating the region.
2755 - Commands which operate on the region only work if the region is active.
2756 - Only a very small set of commands cause the region to become active:
2757 Those commands whose semantics are to mark an area, like `mark-defun'.
2758 - The region is deactivated after each command that is executed, except that:
2759 - "Motion" commands do not change whether the region is active or not.
2761 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2762 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2763 between point and the recently-pushed mark to be highlighted. It will
2764 remain highlighted until some non-motion command is executed.
2766 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2767 region and execute a command that operates on it, you can reactivate the
2768 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2771 Generally, commands which push marks as a means of navigation (like
2772 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2773 region. But commands which push marks as a means of marking an area of
2774 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2775 do activate the region.
2777 The way the command loop actually works with regard to deactivating the
2778 region is as follows:
2780 - If the variable `zmacs-region-stays' has been set to t during the command
2781 just executed, the region is left alone (this is how the motion commands
2782 make the region stay around; see the `_' flag in the `interactive'
2783 specification). `zmacs-region-stays' is reset to nil before each command
2785 - If the function `zmacs-activate-region' has been called during the command
2786 just executed, the region is left alone. Very few functions should
2787 actually call this function.
2788 - Otherwise, if the region is active, the region is deactivated and
2789 the `zmacs-deactivate-region-hook' is called.
2791 /* Zmacs style active regions are now ON by default */
2794 DEFVAR_BOOL("zmacs-region-active-p", &zmacs_region_active_p /*
2795 Do not alter this. It is for internal use only.
2797 zmacs_region_active_p = 0;
2799 DEFVAR_BOOL("zmacs-region-stays", &zmacs_region_stays /*
2800 Whether the current command will deactivate the region.
2801 Commands which do not wish to affect whether the region is currently
2802 highlighted should set this to t. Normally, the region is turned off after
2803 executing each command that did not explicitly turn it on with the function
2804 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2805 See the variable `zmacs-regions'.
2807 The same effect can be achieved using the `_' interactive specification.
2809 `zmacs-region-stays' is reset to nil before each command is executed.
2811 zmacs_region_stays = 0;
2813 DEFVAR_BOOL("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2814 Do not use this -- it will be going away soon.
2815 Indicates if `goto-char' has just been run. This information is allegedly
2816 needed to get the desired behavior for atomic extents and unfortunately
2817 is not available by any other means.
2819 atomic_extent_goto_char_p = 0;
2820 #ifdef AMPERSAND_FULL_NAME
2821 Fprovide(intern("ampersand-full-name"));
2824 DEFVAR_LISP("user-full-name", &Vuser_full_name /*
2825 *The name of the user.
2826 The function `user-full-name', which will return the value of this
2827 variable, when called without arguments.
2828 This is initialized to the value of the NAME environment variable.
2830 /* Initialized at run-time. */
2831 Vuser_full_name = Qnil;