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");
605 int myuid = getuid();
606 char path[5 /* strlen ("/tmp/") */ + 1 +
609 strcpy(path, "/tmp/");
610 strncat(path, user_login_name(NULL), _POSIX_PATH_MAX);
611 path[sizeof(path)-1]=0;
612 if (lstat(path, &st) < 0 && errno == ENOENT) {
613 mkdir(path, 0700); /* ignore retval -- checked next anyway. */
615 if (lstat(path, &st) == 0 && st.st_uid == (uid_t) myuid &&
616 S_ISDIR(st.st_mode)) {
619 const char* home_env = getenv("HOME");
621 strncpy(path, home_env, sizeof(path)-1);
622 strncat(path, "/tmp/", sizeof(path)-1);
623 if (stat(path, &st) < 0 && errno == ENOENT) {
626 /* strlen(".created_by_sxemacs") */
627 19 + _POSIX_PATH_MAX + 1];
628 mkdir(path, 0700); /* ignore retvals */
629 strncpy(warnpath, path, _POSIX_PATH_MAX);
630 warnpath[sizeof(warnpath)-1]=0;
632 /* we already are reserved these 20 bytes... */
633 strcat(warnpath, ".created_by_sxemacs");
634 if ((fd = open(warnpath, O_WRONLY | O_CREAT,
636 write(fd, "SXEmacs created this directory "
637 "because /tmp/<yourname> "
638 "was unavailable -- \nPlease check !\n", 89);
643 if (stat(path, &st) == 0 && st.st_uid == (uid_t) myuid
644 && S_ISDIR(st.st_mode)) {
652 return build_ext_string(tmpdir, Qfile_name);
655 DEFUN("user-login-name", Fuser_login_name, 0, 1, 0, /*
656 Return the name under which the user logged in, as a string.
657 This is based on the effective uid, not the real uid.
658 Also, if the environment variable LOGNAME or USER is set,
659 that determines the value of this function.
660 If the optional argument UID is present, then environment variables are
661 ignored and this function returns the login name for that UID, or nil.
670 local_uid = XINT(uid);
671 returned_name = user_login_name(&local_uid);
673 returned_name = user_login_name(NULL);
675 /* #### - I believe this should return nil instead of "unknown" when pw==0
676 pw=0 is indicated by a null return from user_login_name
678 return returned_name ? build_string(returned_name) : Qnil;
681 /* This function may be called from other C routines when a
682 character string representation of the user_login_name is
683 needed but a Lisp Object is not. The UID is passed by
684 reference. If UID == NULL, then the USER name
685 for the user running XEmacs will be returned. This
686 corresponds to a nil argument to Fuser_login_name.
688 char *user_login_name(uid_t * uid)
690 /* uid == NULL to return name of this user */
692 struct passwd *pw = getpwuid(*uid);
693 return pw ? pw->pw_name : NULL;
695 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
696 old environment (I site observed behavior on sunos and linux), so the
697 environment variables should be disregarded in that case. --Stig */
698 char *user_name = getenv("LOGNAME");
706 struct passwd *pw = getpwuid(geteuid());
707 return pw ? pw->pw_name : NULL;
712 DEFUN("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
713 Return the name of the user's real uid, as a string.
714 This ignores the environment variables LOGNAME and USER, so it differs from
715 `user-login-name' when running under `su'.
719 struct passwd *pw = getpwuid(getuid());
720 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
722 Lisp_Object tem = build_string(pw ? pw->pw_name : "unknown"); /* no gettext */
726 DEFUN("user-uid", Fuser_uid, 0, 0, 0, /*
727 Return the effective uid of Emacs, as an integer.
731 return make_int(geteuid());
734 DEFUN("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
735 Return the real uid of Emacs, as an integer.
739 return make_int(getuid());
742 DEFUN("user-full-name", Fuser_full_name, 0, 1, 0, /*
743 Return the full name of the user logged in, as a string.
744 If the optional argument USER is given, then the full name for that
745 user is returned, or nil. USER may be either a login name or a uid.
747 If USER is nil, and `user-full-name' contains a string, the
748 value of `user-full-name' is returned.
752 Lisp_Object user_name;
753 struct passwd *pw = NULL;
758 if (NILP(user) && STRINGP(Vuser_full_name))
759 return Vuser_full_name;
761 user_name = (STRINGP(user) ? user : Fuser_login_name(user));
762 if (!NILP(user_name)) { /* nil when nonexistent UID passed as arg */
763 const char *user_name_ext;
765 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
766 things get wedged if a SIGIO arrives during this time. */
767 TO_EXTERNAL_FORMAT(LISP_STRING, user_name,
768 C_STRING_ALLOCA, user_name_ext, Qnative);
769 slow_down_interrupts();
770 pw = (struct passwd *)getpwnam(user_name_ext);
771 speed_up_interrupts();
774 /* #### - Stig sez: this should return nil instead
775 * of "unknown" when pw==0 */
776 /* Ben sez: bad idea because it's likely to break something */
777 #ifndef AMPERSAND_FULL_NAME
778 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
781 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
784 tem = ((!NILP(user) && !pw)
786 : make_ext_string((Extbyte *) p, (q ? q - p : (int)strlen(p)),
789 #ifdef AMPERSAND_FULL_NAME
791 p = (char *)XSTRING_DATA(tem);
793 /* Substitute the login name for the &, upcasing the first character. */
796 (char *)alloca(strlen(p) +
797 XSTRING_LENGTH(user_name) + 1);
800 strcat(r, (char *)XSTRING_DATA(user_name));
801 /* #### current_buffer dependency! */
802 r[q - p] = UPCASE(current_buffer, r[q - p]);
804 tem = build_string(r);
807 #endif /* AMPERSAND_FULL_NAME */
812 static Extbyte *cached_home_directory;
814 void uncache_home_directory(void)
816 cached_home_directory = NULL; /* in some cases, this may cause the leaking
820 /* !!#### not Mule correct. */
822 /* Returns the home directory, in external format */
823 Extbyte *get_home_directory(void)
825 /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
826 about what format an external string is in. Could be Unicode, for all
827 we know, and then all the operations below are totally bogus.
828 Instead, convert all data to internal format *right* at the juncture
829 between XEmacs and the outside world, the very moment we first get
831 int output_home_warning = 0;
833 if (cached_home_directory == NULL) {
834 if ((cached_home_directory =
835 (Extbyte *) getenv("HOME")) == NULL) {
838 * Using "/" isn't quite right, but what should we do?
839 * We probably should try to extract pw_dir from /etc/passwd,
840 * before falling back to this.
842 cached_home_directory = (Extbyte *) "/";
843 output_home_warning = 1;
845 if (initialized && output_home_warning) {
846 warn_when_safe(Quser_files_and_directories, Qwarning,
848 " SXEmacs was unable to determine a good value for the user's $HOME\n"
849 " directory, and will be using the value:\n"
851 " This is probably incorrect.",
852 cached_home_directory);
855 return cached_home_directory;
858 DEFUN("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
859 Return the user's home directory, as a string.
863 Extbyte *path = get_home_directory();
865 return path == NULL ? Qnil :
866 Fexpand_file_name(Fsubstitute_in_file_name
867 (build_ext_string((char *)path, Qfile_name)),
871 DEFUN("system-name", Fsystem_name, 0, 0, 0, /*
872 Return the name of the machine you are running on, as a string.
876 return Fcopy_sequence(Vsystem_name);
879 DEFUN("emacs-pid", Femacs_pid, 0, 0, 0, /*
880 Return the process ID of Emacs, as an integer.
884 return make_int(getpid());
887 DEFUN("current-time", Fcurrent_time, 0, 0, 0, /*
888 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
889 The time is returned as a list of three integers. The first has the
890 most significant 16 bits of the seconds, while the second has the
891 least significant 16 bits. The third integer gives the microsecond
894 The microsecond count is zero on systems that do not provide
895 resolution finer than a second.
902 return list3(make_int((EMACS_SECS(t) >> 16) & 0xffff),
903 make_int((EMACS_SECS(t) >> 0) & 0xffff),
904 make_int(EMACS_USECS(t)));
907 #if defined(HAVE_MPZ) && defined(WITH_GMP)
908 DEFUN("current-btime", Fcurrent_btime, 0, 0, 0, /*
909 Return the current time, as the number of microseconds since
911 The time is returned as a big integer.
922 bigz_set_long(btime, EMACS_SECS(t));
923 mpz_mul_ui(btime, btime, 1000000UL);
924 mpz_add_ui(btime, btime, EMACS_USECS(t));
925 result = make_bigz_bz(btime);
931 DEFUN("time-to-btime", Ftime_to_btime, 1, 1, 0, /*
932 Return a big integer from SPECIFIED-TIME with the
933 number of microseconds since the Epoch.
937 if (CONSP(specified_time)) {
940 Lisp_Object high, low, ulow;
944 high = XCAR(specified_time);
945 low = XCDR(specified_time);
958 bigz_set_ulong(bz, (XINT(high) << 16) + (XINT(low) & 0xffff));
959 mpz_mul_ui(bz, bz, 1000000UL);
960 mpz_add_ui(bz, bz, XINT(ulow));
961 result = make_bigz_bz(bz);
965 } else if (BIGZP(specified_time)) {
966 return specified_time;
968 CHECK_CONS(specified_time);
973 DEFUN("btime-to-time", Fbtime_to_time, 1, 1, 0, /*
974 Return a time specified as (HIGH LOW USEC) as obtainable
975 from `current-time' from SPECIFIED-TIME.
979 if (CONSP(specified_time)) {
980 Lisp_Object high, low, ulow;
982 high = XCAR(specified_time);
983 low = XCDR(specified_time);
996 return list3(high, low, ulow);
997 } else if (BIGZP(specified_time)) {
1006 mpz_tdiv_qr_ui(bh, bl, XBIGZ_DATA(specified_time), 1000000UL);
1007 highlow = bigz_to_long(bh);
1008 usecs = bigz_to_long(bl);
1009 result = list3(make_int((highlow >> 16) & 0xffff),
1010 make_int((highlow >> 0) & 0xffff),
1017 CHECK_BIGZ(specified_time);
1021 #endif /* HAVE_MPZ && WITH_MPZ */
1023 DEFUN("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
1024 Return the amount of time used by this SXEmacs process so far.
1025 The return value is a list of three floating-point numbers, expressing
1026 the user, system, and real times used by the process. The user time
1027 measures the time actually spent by the CPU executing the code in this
1028 process. The system time measures time spent by the CPU executing kernel
1029 code on behalf of this process (e.g. I/O requests made by the process).
1031 Note that the user and system times measure processor time, as opposed
1032 to real time, and only accrue when the processor is actually doing
1033 something: Time spent in an idle wait (waiting for user events to come
1034 in or for I/O on a disk drive or other device to complete) does not
1035 count. Thus, the user and system times will often be considerably
1036 less than the real time.
1038 Some systems do not allow the user and system times to be distinguished.
1039 In this case, the user time will be the total processor time used by
1040 the process, and the system time will be 0.
1042 Some systems do not allow the real and processor times to be distinguished.
1043 In this case, the user and real times will be the same and the system
1048 double user, sys, real;
1050 get_process_times(&user, &sys, &real);
1051 return list3(make_float(user), make_float(sys), make_float(real));
1054 DEFUN("uptime", Fuptime, 0, 1, "P", /*
1055 Display SXEmacs \"uptime\".
1057 When called interactively, without a prefix arg, return a list of 4
1058 integers, being the elapsed days, hours, minutes, and seconds that
1059 this SXEmacs process has been running. Display this info prettyfied
1062 With optional prefix arg, USR-SYS-REAL, return a list of 3 floats:
1063 user time, system time, and real time. Also displayed in the echo
1064 area if called interactively. See: `current-process-time' for more
1069 double usr, sys, real;
1070 unsigned int days, hours, minutes, seconds;
1072 days = hours = minutes = seconds = 0;
1073 get_process_times(&usr, &sys, &real);
1075 if (!NILP(usr_sys_real)) {
1076 if (!NILP(Finteractive_p()))
1077 message("User: %0.2f, System: %0.2f, Real: %0.6f\n",
1079 return list3(make_float(usr), make_float(sys), make_float(real));
1081 /* convert the real time to an int (with rounding) */
1082 real = (unsigned long) (real + 0.5);
1084 if (real >= 86400) {
1085 days = real / 86400;
1086 real = real - (days * 86400);
1089 hours = real / 3600;
1090 real = real - (hours * 3600);
1093 minutes = real / 60;
1094 real = real - (minutes * 60);
1098 if (!NILP(Finteractive_p())) {
1100 message("Uptime: %d days, %d hours, %d minutes, %d seconds\n",
1101 days, hours, minutes, seconds);
1103 message("Uptime: %d hours, %d minutes, %d seconds\n",
1104 hours, minutes, seconds);
1105 else if (minutes > 0)
1106 message("Uptime: %d minutes, %d seconds\n",
1108 else if (seconds > 0)
1109 message("Uptime: %d seconds\n", seconds);
1111 return list4(make_int(days), make_int(hours),
1112 make_int(minutes), make_int(seconds));
1116 int lisp_to_time(Lisp_Object specified_time, time_t * result);
1117 int lisp_to_time(Lisp_Object specified_time, time_t * result)
1119 Lisp_Object high, low;
1121 if (NILP(specified_time))
1122 return time(result) != -1;
1124 if (CONSP(specified_time)) {
1125 high = XCAR(specified_time);
1126 low = XCDR(specified_time);
1131 *result = (XINT(high) << 16) + (XINT(low) & 0xffff);
1132 return *result >> 16 == XINT(high);
1133 #if defined HAVE_MPZ && defined WITH_GMP
1134 } else if (BIGZP(specified_time)) {
1137 bigz_set_ulong(bz, 1000000UL);
1138 bigz_div(bz, XBIGZ_DATA(specified_time), bz);
1139 *result = bigz_to_ulong(bz);
1144 CHECK_CONS(specified_time);
1149 Lisp_Object time_to_lisp(time_t the_time);
1150 Lisp_Object time_to_lisp(time_t the_time)
1152 unsigned int item = (unsigned int)the_time;
1153 return Fcons(make_int(item >> 16), make_int(item & 0xffff));
1156 size_t emacs_strftime(char *string, size_t max, const char *format,
1157 const struct tm * tm);
1158 static long difftm(const struct tm *a, const struct tm *b);
1160 DEFUN("format-time-string", Fformat_time_string, 1, 2, 0, /*
1161 Use FORMAT-STRING to format the time TIME.
1162 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1163 `current-time' and `file-attributes'. If TIME is not specified it
1164 defaults to the current time.
1166 If compiled with ENT, TIME may also be a big integer representing
1167 the number of microseconds since the Epoch, as output by
1170 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1171 %a is replaced by the abbreviated name of the day of week.
1172 %A is replaced by the full name of the day of week.
1173 %b is replaced by the abbreviated name of the month.
1174 %B is replaced by the full name of the month.
1175 %c is a synonym for "%x %X".
1176 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1177 %d is replaced by the day of month, zero-padded.
1178 %D is a synonym for "%m/%d/%y".
1179 %e is replaced by the day of month, blank-padded.
1180 %h is a synonym for "%b".
1181 %H is replaced by the hour (00-23).
1182 %I is replaced by the hour (00-12).
1183 %j is replaced by the day of the year (001-366).
1184 %k is replaced by the hour (0-23), blank padded.
1185 %l is replaced by the hour (1-12), blank padded.
1186 %m is replaced by the month (01-12).
1187 %M is replaced by the minute (00-59).
1188 %n is a synonym for "\\n".
1189 %p is replaced by AM or PM, as appropriate.
1190 %r is a synonym for "%I:%M:%S %p".
1191 %R is a synonym for "%H:%M".
1192 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1193 nonstandard extension)
1194 %S is replaced by the second (00-60).
1195 %t is a synonym for "\\t".
1196 %T is a synonym for "%H:%M:%S".
1197 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1198 %w is replaced by the day of week (0-6), Sunday is day 0.
1199 %W is replaced by the week of the year (00-53), first day of week is Monday.
1200 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1201 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1202 %y is replaced by the year without century (00-99).
1203 %Y is replaced by the year with century.
1204 %Z is replaced by the time zone abbreviation.
1206 The number of options reflects the `strftime' function.
1208 BUG: If the charset used by the current locale is not ISO 8859-1, the
1209 characters appearing in the day and month names may be incorrect.
1211 (format_string, time_))
1217 CHECK_STRING(format_string);
1219 if (!lisp_to_time(time_, &value) || !(tm = localtime(&value)))
1220 error("Invalid time specification");
1222 /* This is probably enough. */
1223 size = XSTRING_LENGTH(format_string) * 6 + 50;
1226 char *buf = (char *)alloca(size);
1228 if (emacs_strftime(buf, size,
1229 (const char *)XSTRING_DATA(format_string),
1232 return build_ext_string(buf, Qbinary);
1233 /* If buffer was too small, make it bigger. */
1238 DEFUN("decode-time", Fdecode_time, 0, 1, 0, /*
1239 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1240 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1241 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1242 to use the current time.
1243 If compiled with ENT, SPECIFIED-TIME may also be a big integer as
1244 output from `current-btime', with the number of mircoseconds since
1247 The list has the following nine members:
1248 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1249 only some operating systems support.
1250 MINUTE is an integer between 0 and 59.
1251 HOUR is an integer between 0 and 23.
1252 DAY is an integer between 1 and 31.
1253 MONTH is an integer between 1 and 12.
1254 YEAR is an integer indicating the four-digit year.
1255 DOW is the day of week, an integer between 0 and 6, where 0 is Sunday.
1256 DST is t if daylight savings time is effect, otherwise nil.
1257 ZONE is an integer indicating the number of seconds east of Greenwich.
1258 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1264 struct tm *decoded_time;
1265 Lisp_Object list_args[9];
1267 if (!lisp_to_time(specified_time, &time_spec)
1268 || !(decoded_time = localtime(&time_spec)))
1269 error("Invalid time specification");
1271 list_args[0] = make_int(decoded_time->tm_sec);
1272 list_args[1] = make_int(decoded_time->tm_min);
1273 list_args[2] = make_int(decoded_time->tm_hour);
1274 list_args[3] = make_int(decoded_time->tm_mday);
1275 list_args[4] = make_int(decoded_time->tm_mon + 1);
1276 list_args[5] = make_int(decoded_time->tm_year + 1900);
1277 list_args[6] = make_int(decoded_time->tm_wday);
1278 list_args[7] = (decoded_time->tm_isdst) ? Qt : Qnil;
1280 /* Make a copy, in case gmtime modifies the struct. */
1281 save_tm = *decoded_time;
1282 decoded_time = gmtime(&time_spec);
1283 if (decoded_time == 0)
1284 list_args[8] = Qnil;
1286 list_args[8] = make_int(difftm(&save_tm, decoded_time));
1287 return Flist(9, list_args);
1290 static void set_time_zone_rule(char *tzstring);
1292 /* from GNU Emacs 21, per Simon Josefsson, modified by stephen
1293 The slight inefficiency is justified since negative times are weird. */
1294 Lisp_Object make_time(time_t tval)
1296 return list2(make_int(tval < 0 ? tval / 0x10000 : tval >> 16),
1297 make_int(tval & 0xFFFF));
1300 DEFUN("encode-time", Fencode_time, 6, MANY, 0, /*
1301 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1302 This is the reverse operation of `decode-time', which see.
1303 ZONE defaults to the current time zone rule. This can
1304 be a string (as from `set-time-zone-rule'), or it can be a list
1305 \(as from `current-time-zone') or an integer (as from `decode-time')
1306 applied without consideration for daylight savings time.
1308 You can pass more than 7 arguments; then the first six arguments
1309 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1310 The intervening arguments are ignored.
1311 This feature lets (apply 'encode-time (decode-time ...)) work.
1313 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1314 for example, a DAY of 0 means the day preceding the given month.
1315 Year numbers less than 100 are treated just like other year numbers.
1316 If you want them to stand for years in this century, you must do that yourself.
1318 (int nargs, Lisp_Object * args))
1322 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1325 tm.tm_sec = XINT(*args++); /* second */
1327 tm.tm_min = XINT(*args++); /* minute */
1329 tm.tm_hour = XINT(*args++); /* hour */
1331 tm.tm_mday = XINT(*args++); /* day */
1333 tm.tm_mon = XINT(*args++) - 1; /* month */
1335 tm.tm_year = XINT(*args++) - 1900; /* year */
1343 the_time = mktime(&tm);
1347 char **oldenv = environ, **newenv;
1349 if (STRINGP(zone)) {
1350 tzstring = (char *)XSTRING_DATA(zone);
1351 } else if (INTP(zone)) {
1352 int abszone = abs(XINT(zone));
1353 snprintf(tzbuf, countof(tzbuf) - 1, "XXX%s%d:%02d:%02d",
1354 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1355 (abszone / 60) % 60, abszone % 60);
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 sprintf(tzbuf, "XXX%s%d:%02d:%02d",
1428 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1429 (abszone / 60) % 60, abszone % 60);
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 sprintf(buf, "%c%02d%02d", (offset < 0 ? '-' : '+'),
1569 return list2(make_int(offset), build_string(s));
1571 return list2(Qnil, Qnil);
1575 #ifdef LOCALTIME_CACHE
1577 /* These two values are known to load tz files in buggy implementations,
1578 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1579 Their values shouldn't matter in non-buggy implementations.
1580 We don't use string literals for these strings,
1581 since if a string in the environment is in readonly
1582 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1583 See Sun bugs 1113095 and 1114114, ``Timezone routines
1584 improperly modify environment''. */
1586 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1587 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1591 /* Set the local time zone rule to TZSTRING.
1592 This allocates memory into `environ', which it is the caller's
1593 responsibility to free. */
1594 static void set_time_zone_rule(char *tzstring)
1597 char **from, **to, **newenv;
1599 for (from = environ; *from; from++)
1601 envptrs = from - environ + 2;
1602 newenv = to = (char **)xmalloc(envptrs * sizeof(char *)
1603 + (tzstring ? strlen(tzstring) + 4 : 0));
1605 char *t = (char *)(to + envptrs);
1607 strcat(t, tzstring);
1611 for (from = environ; *from; from++)
1612 if (strncmp(*from, "TZ=", 3) != 0)
1618 #ifdef LOCALTIME_CACHE
1620 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1621 "US/Pacific" that loads a tz file, then changes to a value like
1622 "XXX0" that does not load a tz file, and then changes back to
1623 its original value, the last change is (incorrectly) ignored.
1624 Also, if TZ changes twice in succession to values that do
1625 not load a tz file, tzset can dump core (see Sun bug#1225179).
1626 The following code works around these bugs. */
1629 /* Temporarily set TZ to a value that loads a tz file
1630 and that differs from tzstring. */
1633 (strcmp(tzstring, set_time_zone_rule_tz1 + 3) ==
1634 0 ? set_time_zone_rule_tz2 :
1635 set_time_zone_rule_tz1);
1639 /* The implied tzstring is unknown, so temporarily set TZ to
1640 two different values that each load a tz file. */
1641 *to = set_time_zone_rule_tz1;
1644 *to = set_time_zone_rule_tz2;
1649 /* Now TZ has the desired value, and tzset can be invoked safely. */
1656 DEFUN("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1657 Set the local time zone using TZ, a string specifying a time zone rule.
1658 If TZ is nil, use implementation-defined default time zone information.
1668 tzstring = (char *)XSTRING_DATA(tz);
1671 set_time_zone_rule(tzstring);
1674 environbuf = environ;
1679 void buffer_insert1(struct buffer *buf, Lisp_Object arg)
1681 /* This function can GC */
1682 struct gcpro gcpro1;
1685 if (CHAR_OR_CHAR_INTP(arg)) {
1686 buffer_insert_emacs_char(buf, XCHAR_OR_CHAR_INT(arg));
1687 } else if (STRINGP(arg)) {
1688 buffer_insert_lisp_string(buf, arg);
1690 arg = wrong_type_argument(Qchar_or_string_p, arg);
1696 /* Callers passing one argument to Finsert need not gcpro the
1697 argument "array", since the only element of the array will
1698 not be used after calling insert_emacs_char or insert_lisp_string,
1699 so we don't care if it gets trashed. */
1701 DEFUN("insert", Finsert, 0, MANY, 0, /*
1702 Insert the arguments, either strings or characters, at point.
1703 Point moves forward so that it ends up after the inserted text.
1704 Any other markers at the point of insertion remain before the text.
1705 If a string has non-null string-extent-data, new extents will be created.
1707 (int nargs, Lisp_Object * args))
1709 /* This function can GC */
1710 REGISTER int argnum;
1712 for (argnum = 0; argnum < nargs; argnum++) {
1713 buffer_insert1(current_buffer, args[argnum]);
1719 DEFUN("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1720 Insert strings or characters at point, relocating markers after the text.
1721 Point moves forward so that it ends up after the inserted text.
1722 Any other markers at the point of insertion also end up after the text.
1724 (int nargs, Lisp_Object * args))
1726 /* This function can GC */
1727 REGISTER int argnum;
1728 REGISTER Lisp_Object tem;
1730 for (argnum = 0; argnum < nargs; argnum++) {
1733 if (CHAR_OR_CHAR_INTP(tem)) {
1734 buffer_insert_emacs_char_1(current_buffer, -1,
1735 XCHAR_OR_CHAR_INT(tem),
1736 INSDEL_BEFORE_MARKERS);
1737 } else if (STRINGP(tem)) {
1738 buffer_insert_lisp_string_1(current_buffer, -1, tem,
1739 INSDEL_BEFORE_MARKERS);
1741 tem = wrong_type_argument(Qchar_or_string_p, tem);
1748 DEFUN("insert-string", Finsert_string, 1, 2, 0, /*
1749 Insert STRING into BUFFER at BUFFER's point.
1750 Point moves forward so that it ends up after the inserted text.
1751 Any other markers at the point of insertion remain before the text.
1752 If a string has non-null string-extent-data, new extents will be created.
1753 BUFFER defaults to the current buffer.
1757 struct buffer *b = decode_buffer(buffer, 1);
1758 CHECK_STRING(string);
1759 buffer_insert_lisp_string(b, string);
1763 /* Third argument in FSF is INHERIT:
1765 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1766 from adjoining text, if those properties are sticky."
1768 Jamie thinks this is bogus. */
1770 DEFUN("insert-char", Finsert_char, 1, 4, 0, /*
1771 Insert COUNT copies of CHARACTER into BUFFER.
1772 Point and all markers are affected as in the function `insert'.
1773 COUNT defaults to 1 if omitted.
1774 The optional third arg IGNORED is INHERIT under FSF Emacs.
1775 This is highly bogus, however, and SXEmacs always behaves as if
1776 `t' were passed to INHERIT.
1777 The optional fourth arg BUFFER specifies the buffer to insert the
1778 text into. If BUFFER is nil, the current buffer is assumed.
1780 (character, count, ignored, buffer))
1782 /* This function can GC */
1783 REGISTER Bufbyte *string;
1786 REGISTER Bytecount n;
1787 REGISTER Bytecount charlen;
1788 Bufbyte str[MAX_EMCHAR_LEN];
1789 struct buffer *b = decode_buffer(buffer, 1);
1792 CHECK_CHAR_COERCE_INT(character);
1800 charlen = set_charptr_emchar(str, XCHAR(character));
1805 string = alloca_array(Bufbyte, slen);
1806 /* Write as many copies of the character into the temp string as will fit. */
1807 for (i = 0; i + charlen <= slen; i += charlen)
1808 for (j = 0; j < charlen; j++)
1809 string[i + j] = str[j];
1812 buffer_insert_raw_string(b, string, slen);
1816 #if 0 /* FSFmacs bogosity */
1819 insert_and_inherit(string, n);
1824 buffer_insert_raw_string(b, string, n);
1830 /* Making strings from buffer contents. */
1832 DEFUN("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1833 Return the contents of part of BUFFER as a string.
1834 The two arguments START and END are character positions;
1835 they can be in either order. If omitted, they default to the beginning
1836 and end of BUFFER, respectively.
1837 If there are duplicable extents in the region, the string remembers
1838 them in its extent data.
1839 If BUFFER is nil, the current buffer is assumed.
1841 (start, end, buffer))
1843 /* This function can GC */
1845 struct buffer *b = decode_buffer(buffer, 1);
1847 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1848 return make_string_from_buffer(b, begv, zv - begv);
1851 /* It might make more sense to name this
1852 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1853 and what the function does is probably good enough for what the
1854 user-code will typically want to use it for. */
1855 DEFUN("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1856 Return the text from START to END as a string, without copying the extents.
1858 (start, end, buffer))
1860 /* This function can GC */
1862 struct buffer *b = decode_buffer(buffer, 1);
1864 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1865 return make_string_from_buffer_no_extents(b, begv, zv - begv);
1868 DEFUN("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1869 Insert before point a substring of the contents of buffer BUFFER.
1870 BUFFER may be a buffer or a buffer name.
1871 Arguments START and END are character numbers specifying the substring.
1872 They default to the beginning and the end of BUFFER.
1874 (buffer, start, end))
1876 /* This function can GC */
1879 Lisp_Object tmp_buf = emacs_get_buffer(buffer, 1);
1881 bp = XBUFFER(tmp_buf);
1882 get_buffer_range_char(bp, start, end, &b, &e, GB_ALLOW_NIL);
1885 buffer_insert_from_buffer(current_buffer, bp, b, e - b);
1890 DEFUN("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1891 Compare two substrings of two buffers; return result as number.
1892 the value is -N if first string is less after N-1 chars,
1893 +N if first string is greater after N-1 chars, or 0 if strings match.
1894 Each substring is represented as three arguments: BUFFER, START and END.
1895 That makes six args in all, three for each substring.
1897 The value of `case-fold-search' in the current buffer
1898 determines whether case is significant or ignored.
1900 (buffer1, start1, end1, buffer2, start2, end2))
1902 Bufpos begp1, endp1, begp2, endp2;
1903 REGISTER Charcount len1, len2, length, i;
1904 struct buffer *bp1, *bp2;
1905 Lisp_Object trt = ((!NILP(current_buffer->case_fold_search)) ?
1906 XCASE_TABLE_CANON(current_buffer->
1907 case_table) : Qnil);
1909 /* Find the first buffer and its substring. */
1911 bp1 = decode_buffer(buffer1, 1);
1912 get_buffer_range_char(bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1914 /* Likewise for second substring. */
1916 bp2 = decode_buffer(buffer2, 1);
1917 get_buffer_range_char(bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1919 len1 = endp1 - begp1;
1920 len2 = endp2 - begp2;
1925 for (i = 0; i < length; i++) {
1926 Emchar c1 = BUF_FETCH_CHAR(bp1, begp1 + i);
1927 Emchar c2 = BUF_FETCH_CHAR(bp2, begp2 + i);
1929 c1 = TRT_TABLE_OF(trt, c1);
1930 c2 = TRT_TABLE_OF(trt, c2);
1933 return make_int(-1 - i);
1935 return make_int(i + 1);
1938 /* The strings match as far as they go.
1939 If one is shorter, that one is less. */
1941 return make_int(length + 1);
1942 else if (length < len2)
1943 return make_int(-length - 1);
1945 /* Same length too => they are equal. */
1949 static Lisp_Object subst_char_in_region_unwind(Lisp_Object arg)
1951 XBUFFER(XCAR(arg))->undo_list = XCDR(arg);
1955 static Lisp_Object subst_char_in_region_unwind_1(Lisp_Object arg)
1957 XBUFFER(XCAR(arg))->filename = XCDR(arg);
1961 DEFUN("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1962 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1963 If optional arg NOUNDO is non-nil, don't record this change for undo
1964 and don't mark the buffer as really changed.
1966 (start, end, fromchar, tochar, noundo))
1968 /* This function can GC */
1972 struct buffer *buf = current_buffer;
1973 int count = specpdl_depth();
1975 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
1976 CHECK_CHAR_COERCE_INT(fromchar);
1977 CHECK_CHAR_COERCE_INT(tochar);
1979 fromc = XCHAR(fromchar);
1980 toc = XCHAR(tochar);
1982 /* If we don't want undo, turn off putting stuff on the list.
1983 That's faster than getting rid of things,
1984 and it prevents even the entry for a first change.
1985 Also inhibit locking the file. */
1986 if (!NILP(noundo)) {
1987 record_unwind_protect(subst_char_in_region_unwind,
1988 Fcons(Fcurrent_buffer(), buf->undo_list));
1989 buf->undo_list = Qt;
1990 /* Don't do file-locking. */
1991 record_unwind_protect(subst_char_in_region_unwind_1,
1992 Fcons(Fcurrent_buffer(), buf->filename));
1993 buf->filename = Qnil;
1996 mc_count = begin_multiple_change(buf, pos, stop);
1997 while (pos < stop) {
1998 if (BUF_FETCH_CHAR(buf, pos) == fromc) {
1999 /* There used to be some code here that set the buffer to
2000 unmodified if NOUNDO was specified and there was only
2001 one change to the buffer since it was last saved.
2002 This is a crock of shit, so I'm not duplicating this
2003 behavior. I think this was left over from when
2004 prepare_to_modify_buffer() actually bumped MODIFF,
2005 so that code was supposed to undo this change. --ben */
2006 buffer_replace_char(buf, pos, toc, !NILP(noundo), 0);
2008 /* If noundo is not nil then we don't mark the buffer as
2009 modified. In reality that needs to happen externally
2010 only. Internally redisplay needs to know that the actual
2011 contents it should be displaying have changed. */
2013 Fset_buffer_modified_p(Fbuffer_modified_p(Qnil),
2018 end_multiple_change(buf, mc_count);
2020 unbind_to(count, Qnil);
2024 /* #### Shouldn't this also accept a BUFFER argument, in the good old
2025 XEmacs tradition? */
2026 DEFUN("translate-region", Ftranslate_region, 3, 3, 0, /*
2027 Translate characters from START to END according to TABLE.
2029 If TABLE is a string, the Nth character in it is the mapping for the
2030 character with code N.
2032 If TABLE is a vector, its Nth element is the mapping for character
2033 with code N. The values of elements may be characters, strings, or
2034 nil (nil meaning don't replace.)
2036 If TABLE is a char-table, its elements describe the mapping between
2037 characters and their replacements. The char-table should be of type
2038 `char' or `generic'.
2040 Returns the number of substitutions performed.
2042 (start, end, table))
2044 /* This function can GC */
2045 Bufpos pos, stop; /* Limits of the region. */
2046 int cnt = 0; /* Number of changes made. */
2048 struct buffer *buf = current_buffer;
2051 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
2052 mc_count = begin_multiple_change(buf, pos, stop);
2053 if (STRINGP(table)) {
2054 Lisp_String *stable = XSTRING(table);
2055 Charcount size = string_char_length(stable);
2057 /* Under Mule, string_char(n) is O(n), so for large tables or
2058 large regions it makes sense to create an array of Emchars. */
2059 if (size * (stop - pos) > 65536) {
2060 Emchar *etable = alloca_array(Emchar, size);
2061 convert_bufbyte_string_into_emchar_string
2062 (string_data(stable), string_length(stable),
2064 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2067 Emchar nc = etable[oc];
2069 buffer_replace_char(buf, pos,
2078 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2081 Emchar nc = string_char(stable, oc);
2083 buffer_replace_char(buf, pos,
2090 } else if (VECTORP(table)) {
2091 Charcount size = XVECTOR_LENGTH(table);
2092 Lisp_Object *vtable = XVECTOR_DATA(table);
2094 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2096 Lisp_Object replacement = vtable[oc];
2098 if (CHAR_OR_CHAR_INTP(replacement)) {
2100 XCHAR_OR_CHAR_INT(replacement);
2102 buffer_replace_char(buf, pos,
2106 } else if (STRINGP(replacement)) {
2108 XSTRING_CHAR_LENGTH(replacement) -
2110 buffer_delete_range(buf, pos, pos + 1,
2112 buffer_insert_lisp_string_1(buf, pos,
2115 pos += incr, stop += incr;
2117 } else if (!NILP(replacement)) {
2120 (Qchar_or_string_p, replacement);
2125 } else if (CHAR_TABLEP(table)
2126 && (XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_GENERIC
2127 || XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_CHAR)) {
2128 Lisp_Char_Table *ctable = XCHAR_TABLE(table);
2130 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2131 Lisp_Object replacement = get_char_table(oc, ctable);
2133 if (CHAR_OR_CHAR_INTP(replacement)) {
2134 Emchar nc = XCHAR_OR_CHAR_INT(replacement);
2136 buffer_replace_char(buf, pos, nc, 0, 0);
2139 } else if (STRINGP(replacement)) {
2141 XSTRING_CHAR_LENGTH(replacement) - 1;
2142 buffer_delete_range(buf, pos, pos + 1, 0);
2143 buffer_insert_lisp_string_1(buf, pos,
2145 pos += incr, stop += incr;
2147 } else if (!NILP(replacement)) {
2149 wrong_type_argument(Qchar_or_string_p,
2155 dead_wrong_type_argument(Qstringp, table);
2156 end_multiple_change(buf, mc_count);
2158 return make_int(cnt);
2161 DEFUN("delete-region", Fdelete_region, 2, 3, "r", /*
2162 Delete the text between point and mark.
2163 When called from a program, expects two arguments START and END
2164 \(integers or markers) specifying the stretch to be deleted.
2165 If optional third arg BUFFER is nil, the current buffer is assumed.
2167 (start, end, buffer))
2169 /* This function can GC */
2170 Bufpos bp_start, bp_end;
2171 struct buffer *buf = decode_buffer(buffer, 1);
2173 get_buffer_range_char(buf, start, end, &bp_start, &bp_end, 0);
2174 buffer_delete_range(buf, bp_start, bp_end, 0);
2178 void widen_buffer(struct buffer *b, int no_clip)
2180 if (BUF_BEGV(b) != BUF_BEG(b)) {
2182 SET_BOTH_BUF_BEGV(b, BUF_BEG(b), BI_BUF_BEG(b));
2184 if (BUF_ZV(b) != BUF_Z(b)) {
2186 SET_BOTH_BUF_ZV(b, BUF_Z(b), BI_BUF_Z(b));
2191 /* Changing the buffer bounds invalidates any recorded current
2193 invalidate_current_column();
2194 narrow_line_number_cache(b);
2198 DEFUN("widen", Fwiden, 0, 1, "", /*
2199 Remove restrictions (narrowing) from BUFFER.
2200 This allows the buffer's full text to be seen and edited.
2201 If BUFFER is nil, the current buffer is assumed.
2205 struct buffer *b = decode_buffer(buffer, 1);
2210 DEFUN("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2211 Restrict editing in BUFFER to the current region.
2212 The rest of the text becomes temporarily invisible and untouchable
2213 but is not deleted; if you save the buffer in a file, the invisible
2214 text is included in the file. \\[widen] makes all visible again.
2215 If BUFFER is nil, the current buffer is assumed.
2216 See also `save-restriction'.
2218 When calling from a program, pass two arguments; positions (integers
2219 or markers) bounding the text that should remain visible.
2221 (start, end, buffer))
2223 Bufpos bp_start, bp_end;
2224 struct buffer *buf = decode_buffer(buffer, 1);
2225 Bytind bi_start, bi_end;
2227 get_buffer_range_char(buf, start, end, &bp_start, &bp_end,
2228 GB_ALLOW_PAST_ACCESSIBLE);
2229 bi_start = bufpos_to_bytind(buf, bp_start);
2230 bi_end = bufpos_to_bytind(buf, bp_end);
2232 SET_BOTH_BUF_BEGV(buf, bp_start, bi_start);
2233 SET_BOTH_BUF_ZV(buf, bp_end, bi_end);
2234 if (BUF_PT(buf) < bp_start)
2235 BUF_SET_PT(buf, bp_start);
2236 if (BUF_PT(buf) > bp_end)
2237 BUF_SET_PT(buf, bp_end);
2239 /* Changing the buffer bounds invalidates any recorded current column. */
2240 invalidate_current_column();
2241 narrow_line_number_cache(buf);
2245 Lisp_Object save_restriction_save(void)
2247 Lisp_Object bottom, top;
2248 /* Note: I tried using markers here, but it does not win
2249 because insertion at the end of the saved region
2250 does not advance mh and is considered "outside" the saved region. */
2251 bottom = make_int(BUF_BEGV(current_buffer) - BUF_BEG(current_buffer));
2252 top = make_int(BUF_Z(current_buffer) - BUF_ZV(current_buffer));
2254 return noseeum_cons(Fcurrent_buffer(), noseeum_cons(bottom, top));
2257 Lisp_Object save_restriction_restore(Lisp_Object data)
2260 Charcount newhead, newtail;
2262 int local_clip_changed = 0;
2264 buf = XBUFFER(XCAR(data));
2265 if (!BUFFER_LIVE_P(buf)) {
2266 /* someone could have killed the buffer in the meantime ... */
2267 free_cons(XCONS(XCDR(data)));
2268 free_cons(XCONS(data));
2272 newhead = XINT(XCAR(tem));
2273 newtail = XINT(XCDR(tem));
2275 free_cons(XCONS(XCDR(data)));
2276 free_cons(XCONS(data));
2278 if (newhead + newtail > BUF_Z(buf) - BUF_BEG(buf)) {
2285 Bytind bi_start, bi_end;
2287 start = BUF_BEG(buf) + newhead;
2288 end = BUF_Z(buf) - newtail;
2290 bi_start = bufpos_to_bytind(buf, start);
2291 bi_end = bufpos_to_bytind(buf, end);
2293 if (BUF_BEGV(buf) != start) {
2294 local_clip_changed = 1;
2295 SET_BOTH_BUF_BEGV(buf, start, bi_start);
2296 narrow_line_number_cache(buf);
2298 if (BUF_ZV(buf) != end) {
2299 local_clip_changed = 1;
2300 SET_BOTH_BUF_ZV(buf, end, bi_end);
2303 if (local_clip_changed)
2306 /* If point is outside the new visible range, move it inside. */
2308 bufpos_clip_to_bounds(BUF_BEGV(buf),
2309 BUF_PT(buf), BUF_ZV(buf)));
2314 DEFUN("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2315 Execute BODY, saving and restoring current buffer's restrictions.
2316 The buffer's restrictions make parts of the beginning and end invisible.
2317 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2318 This special form, `save-restriction', saves the current buffer's restrictions
2319 when it is entered, and restores them when it is exited.
2320 So any `narrow-to-region' within BODY lasts only until the end of the form.
2321 The old restrictions settings are restored
2322 even in case of abnormal exit (throw or error).
2324 The value returned is the value of the last form in BODY.
2326 `save-restriction' can get confused if, within the BODY, you widen
2327 and then make changes outside the area within the saved restrictions.
2329 Note: if you are using both `save-excursion' and `save-restriction',
2330 use `save-excursion' outermost:
2331 (save-excursion (save-restriction ...))
2335 /* This function can GC */
2336 int speccount = specpdl_depth();
2338 record_unwind_protect(save_restriction_restore,
2339 save_restriction_save());
2341 return unbind_to(speccount, Fprogn(body));
2344 DEFUN("format", Fformat, 1, MANY, 0, /*
2345 Return a formatted string out of a format string and arguments.
2347 Arguments: string &rest objects
2349 Hereby, STRING is the format string (also known as template) which
2350 consists of constant (immutable) portions and so called format
2351 specifiers (%-specs). For details on these see below.
2353 The remaining arguments, OBJECTS, are substituted into the format
2354 string to make the result, a string. The exact influence of OBJECTS
2355 on the final result is described below. In general, OBJECTS will be
2356 the lisp objects to be printed.
2360 The format string STRING is basically an ordinary string enriched with
2361 %-sequences (also known as specifiers or specs for short). The specs
2362 in STRING will be substituted for the according object in OBJECTS, to
2363 be precise with a string representation of the object. In the simplest
2364 case, the first specifier in STRING corresponds to the first element
2365 in OBJECTS, the second specifier corresponds to the second element, and
2368 The specifiers themselves look like
2369 %[r$][#][&][ ][+][~][0][-]['][!a][m][.p|*]{sSdioxXbucfeEgGZQFRBC}
2373 %s means print all objects as-is, using `princ'.
2374 %S means print all objects as s-expressions, using `prin1'.
2377 %d means print as an integer in decimal
2378 %i means print as an integer in decimal
2379 %o means print as an integer in octal
2380 %x means print as an integer in lowercase hex
2381 %X means print as an integer in uppercase hex
2382 %b means print as an integer in binary
2383 %u means print a non-negative integer.
2384 %c means print as a single character.
2387 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2388 %e or %E means print as a floating-point number in scientific notation
2390 %g or %G means print as a floating-point number in "pretty format";
2391 depending on the number, either %f or %e/%E format will be used, and
2392 trailing zeroes are removed from the fractional part.
2393 The argument used for all but %s and %S must be a number. It will be
2394 converted to an integer or a floating-point number as necessary.
2395 Please bear in mind that floating point numbers have a limited and fixed
2396 precision although the print output may suggest something else.
2397 The precision varies (depending on the machine) between 12 and 38 digits.
2398 This means if you use specifiers like %.60f on 1.0 or 1.5 only the first
2399 12 to 38 digits are real. Also note, that internally numbers are processed
2400 in a 2-adic arithmetic, so you may experience strange rounding effects,
2401 e.g. %.60f on 1.2 or %f on 1e+40, this is because you force the printer to
2402 be more precise than actually valid. No error is thrown in these cases!
2404 If SXEmacs was compiled with GMP support the following additional
2405 specifiers become available:
2406 %Z means print as big integer (convert to bigz)
2407 %Q means print as fraction (convert to bigq)
2408 %F means print as bigfr or bigf float (convert to in that order)
2409 this specifier always converts the argument, regardless the
2410 value of `read-real-as'
2411 %R means print as real number (convert to bigfr, bigf or float)
2412 this specifier respects the value of `read-real-as'
2413 %B means print as Gaussian number (convert to bigg)
2414 %C means print as complex number (convert to bigc)
2416 Both %B and %C are actually rewrites to %Z%+Z and %F%+F with the
2417 argument rewritten to (real-part arg) (imaginary-part arg).
2418 Flags are passed on to at least the real part specifier.
2422 Using above notation there are several tweaks, so called modifiers,
2423 to fine-tune the substitution. Modifiers are completely optional.
2426 r$ use the `r'-th element of OBJECTS instead the one in order
2427 # print 0x, 0o, 0b prefix for numbers in a different base
2428 & use lisp syntax for base!=10 numbers, as in #x73, implies ~
2429 if non-negative print a place holder ` ' for a sign, `-' otherwise
2430 + always print a sign, `-' if negative and `+' if non-negative
2431 ~ in conjunction with `#' and signed numbers print sign after 0[xob]
2432 0 pad numbers (only on the left) with zeroes instead of spaces
2434 ' group numbers in groups of three
2435 !a use `a' as pad character instead of space
2436 m specify a minimum width of the yielded string
2437 .p use `p' digits of precision, depends on the specifer
2438 * use the argument in order to obtain the precision
2440 %$ means reposition to read a specific numbered argument; for example,
2441 %3$s would apply the `%s' to the third argument after the control string,
2442 and the next format directive would use the fourth argument, the
2443 following one the fifth argument, etc. (There must be a positive integer
2444 between the % and the $).
2446 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2447 specified between the optional repositioning spec and the conversion
2448 character; see below.
2450 An optional minimum field width may be specified after any flag characters
2451 and before the conversion character; it specifies the minimum number of
2452 characters that the converted argument will take up. Padding will be
2453 added on the left (or on the right, if the `-' flag is specified), as
2454 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2457 If the field width is specified as `*', the field width is assumed to have
2458 been specified as an argument. Any repositioning specification that
2459 would normally specify the argument to be converted will now specify
2460 where to find this field width argument, not where to find the argument
2461 to be converted. If there is no repositioning specification, the normal
2462 next argument is used. The argument to be converted will be the next
2463 argument after the field width argument unless the precision is also
2464 specified as `*' (see below).
2466 An optional period character and precision may be specified after any
2467 minimum field width. It specifies the minimum number of digits to
2468 appear in %d, %i, %b, %o, %x, and %X conversions (the number is padded
2469 on the left with zeroes as necessary); the number of digits printed
2470 after the decimal point for %f, %e, and %E conversions; the number
2471 of significant digits printed in %g and %G conversions; and the
2472 maximum number of non-padding characters printed in %s and %S
2473 conversions. The default precision for floating-point conversions
2476 If the precision is specified as `*', the precision is assumed to have been
2477 specified as an argument. The argument used will be the next argument
2478 after the field width argument, if any. If the field width was not
2479 specified as an argument, any repositioning specification that would
2480 normally specify the argument to be converted will now specify where to
2481 find the precision argument. If there is no repositioning specification,
2482 the normal next argument is used.
2484 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2485 plus sign, respectively.
2487 The `#' flag means print numbers in an alternate, more verbose format:
2488 octal numbers begin with 0o; hex numbers begin with a 0x or 0X;
2489 and binary representations start with 0b;
2490 a decimal point is printed in %f, %e, and %E conversions even if no
2491 numbers are printed after it; and trailing zeroes are not omitted in
2492 %g and %G conversions.
2494 Use %% to put a single % into the output.
2496 (int nargs, Lisp_Object * args))
2498 /* It should not be necessary to GCPRO ARGS, because
2499 the caller in the interpreter should take care of that. */
2501 CHECK_STRING(args[0]);
2502 return emacs_doprnt_string_lisp(0, args[0], 0, nargs - 1, args + 1);
2505 DEFUN("char-equal", Fchar_equal, 2, 3, 0, /*
2506 Return t if two characters match, optionally ignoring case.
2507 Both arguments must be characters (i.e. NOT integers).
2508 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2509 If BUFFER is nil, the current buffer is assumed.
2511 (character1, character2, buffer))
2514 struct buffer *b = decode_buffer(buffer, 1);
2516 CHECK_CHAR_COERCE_INT(character1);
2517 CHECK_CHAR_COERCE_INT(character2);
2518 x1 = XCHAR(character1);
2519 x2 = XCHAR(character2);
2521 return (!NILP(b->case_fold_search)
2522 ? DOWNCASE(b, x1) == DOWNCASE(b, x2)
2527 DEFUN("char=", Fchar_Equal, 2, 2, 0, /*
2528 Return t if two characters match, case is significant.
2529 Both arguments must be characters (i.e. NOT integers).
2531 (character1, character2))
2533 CHECK_CHAR_COERCE_INT(character1);
2534 CHECK_CHAR_COERCE_INT(character2);
2536 return EQ(character1, character2) ? Qt : Qnil;
2539 #if 0 /* Undebugged FSFmacs code */
2540 /* Transpose the markers in two regions of the current buffer, and
2541 adjust the ones between them if necessary (i.e.: if the regions
2544 Traverses the entire marker list of the buffer to do so, adding an
2545 appropriate amount to some, subtracting from some, and leaving the
2546 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2548 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2550 void transpose_markers(Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2552 Charcount amt1, amt2, diff;
2554 struct buffer *buf = current_buffer;
2556 /* Update point as if it were a marker. */
2557 if (BUF_PT(buf) < start1) ;
2558 else if (BUF_PT(buf) < end1)
2559 BUF_SET_PT(buf, BUF_PT(buf) + (end2 - end1));
2560 else if (BUF_PT(buf) < start2)
2562 BUF_PT(buf) + (end2 - start2) - (end1 - start1));
2563 else if (BUF_PT(buf) < end2)
2564 BUF_SET_PT(buf, BUF_PT(buf) - (start2 - start1));
2566 /* We used to adjust the endpoints here to account for the gap, but that
2567 isn't good enough. Even if we assume the caller has tried to move the
2568 gap out of our way, it might still be at start1 exactly, for example;
2569 and that places it `inside' the interval, for our purposes. The amount
2570 of adjustment is nontrivial if there's a `denormalized' marker whose
2571 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2572 the dirty work to Fmarker_position, below. */
2574 /* The difference between the region's lengths */
2575 diff = (end2 - start2) - (end1 - start1);
2577 /* For shifting each marker in a region by the length of the other
2578 * region plus the distance between the regions.
2580 amt1 = (end2 - start2) + (start2 - end1);
2581 amt2 = (end1 - start1) + (start2 - end1);
2583 for (marker = BUF_MARKERS(buf); !NILP(marker);
2584 marker = XMARKER(marker)->chain) {
2585 Bufpos mpos = marker_position(marker);
2586 if (mpos >= start1 && mpos < end2) {
2589 else if (mpos < start2)
2593 set_marker_position(marker, mpos);
2600 DEFUN("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2601 Transpose region START1 to END1 with START2 to END2.
2602 The regions may not be overlapping, because the size of the buffer is
2603 never changed in a transposition.
2605 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
2606 any markers that happen to be located in the regions. (#### BUG: currently
2607 this function always acts as if LEAVE-MARKERS is non-nil.)
2609 Transposing beyond buffer boundaries is an error.
2611 (start1, end1, start2, end2, leave_markers))
2613 Bufpos startr1, endr1, startr2, endr2;
2614 Charcount len1, len2;
2615 Lisp_Object string1, string2;
2616 struct buffer *buf = current_buffer;
2618 get_buffer_range_char(buf, start1, end1, &startr1, &endr1, 0);
2619 get_buffer_range_char(buf, start2, end2, &startr2, &endr2, 0);
2621 len1 = endr1 - startr1;
2622 len2 = endr2 - startr2;
2624 if (startr2 < endr1)
2625 error("transposed regions not properly ordered");
2626 else if (startr1 == endr1 || startr2 == endr2)
2627 error("transposed region may not be of length 0");
2629 string1 = make_string_from_buffer(buf, startr1, len1);
2630 string2 = make_string_from_buffer(buf, startr2, len2);
2631 buffer_delete_range(buf, startr2, endr2, 0);
2632 buffer_insert_lisp_string_1(buf, startr2, string1, 0);
2633 buffer_delete_range(buf, startr1, endr1, 0);
2634 buffer_insert_lisp_string_1(buf, startr1, string2, 0);
2636 /* In FSFmacs there is a whole bunch of really ugly code here
2637 to attempt to transpose the regions without using up any
2638 extra memory. Although the intent may be good, the result
2639 was highly bogus. */
2644 /************************************************************************/
2645 /* initialization */
2646 /************************************************************************/
2648 void syms_of_editfns(void)
2650 defsymbol(&Qpoint, "point");
2651 defsymbol(&Qmark, "mark");
2652 defsymbol(&Qregion_beginning, "region-beginning");
2653 defsymbol(&Qregion_end, "region-end");
2654 defsymbol(&Qformat, "format");
2655 defsymbol(&Quser_files_and_directories, "user-files-and-directories");
2657 DEFSUBR(Fchar_equal);
2658 DEFSUBR(Fchar_Equal);
2659 DEFSUBR(Fgoto_char);
2660 DEFSUBR(Fstring_to_char);
2661 DEFSUBR(Fchar_to_string);
2662 DEFSUBR(Fbuffer_substring);
2663 DEFSUBR(Fbuffer_substring_no_properties);
2665 DEFSUBR(Fpoint_marker);
2666 DEFSUBR(Fmark_marker);
2668 DEFSUBR(Fregion_beginning);
2669 DEFSUBR(Fregion_end);
2670 DEFSUBR(Fsave_excursion);
2671 DEFSUBR(Fsave_current_buffer);
2673 DEFSUBR(Fbuffer_size);
2674 DEFSUBR(Fpoint_max);
2675 DEFSUBR(Fpoint_min);
2676 DEFSUBR(Fpoint_min_marker);
2677 DEFSUBR(Fpoint_max_marker);
2683 DEFSUBR(Ffollowing_char);
2684 DEFSUBR(Fpreceding_char);
2685 DEFSUBR(Fchar_after);
2686 DEFSUBR(Fchar_before);
2688 DEFSUBR(Finsert_string);
2689 DEFSUBR(Finsert_before_markers);
2690 DEFSUBR(Finsert_char);
2692 DEFSUBR(Ftemp_directory);
2693 DEFSUBR(Fuser_login_name);
2694 DEFSUBR(Fuser_real_login_name);
2696 DEFSUBR(Fuser_real_uid);
2697 DEFSUBR(Fuser_full_name);
2698 DEFSUBR(Fuser_home_directory);
2699 DEFSUBR(Femacs_pid);
2700 DEFSUBR(Fcurrent_time);
2701 #if defined(HAVE_MPZ) && defined(WITH_GMP)
2702 DEFSUBR(Fcurrent_btime);
2703 DEFSUBR(Ftime_to_btime);
2704 DEFSUBR(Fbtime_to_time);
2705 #endif /* HAVE_MPZ */
2706 DEFSUBR(Fcurrent_process_time);
2708 DEFSUBR(Fformat_time_string);
2709 DEFSUBR(Fdecode_time);
2710 DEFSUBR(Fencode_time);
2711 #if defined(HAVE_MPZ) && defined WITH_GMP
2712 DEFSUBR(Fencode_btime);
2714 DEFSUBR(Fcurrent_time_string);
2715 DEFSUBR(Fcurrent_time_zone);
2716 DEFSUBR(Fset_time_zone_rule);
2717 DEFSUBR(Fsystem_name);
2720 DEFSUBR(Finsert_buffer_substring);
2721 DEFSUBR(Fcompare_buffer_substrings);
2722 DEFSUBR(Fsubst_char_in_region);
2723 DEFSUBR(Ftranslate_region);
2724 DEFSUBR(Fdelete_region);
2726 DEFSUBR(Fnarrow_to_region);
2727 DEFSUBR(Fsave_restriction);
2728 DEFSUBR(Ftranspose_regions);
2730 defsymbol(&Qzmacs_update_region, "zmacs-update-region");
2731 defsymbol(&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2732 defsymbol(&Qzmacs_region_buffer, "zmacs-region-buffer");
2735 void vars_of_editfns(void)
2737 staticpro(&Vsystem_name);
2739 staticpro(&Vuser_name);
2740 staticpro(&Vuser_real_name);
2742 DEFVAR_BOOL("zmacs-regions", &zmacs_regions /*
2743 *Whether LISPM-style active regions should be used.
2744 This means that commands which operate on the region (the area between the
2745 point and the mark) will only work while the region is in the ``active''
2746 state, which is indicated by highlighting. Executing most commands causes
2747 the region to not be in the active state, so (for example) \\[kill-region] will only
2748 work immediately after activating the region.
2752 - Commands which operate on the region only work if the region is active.
2753 - Only a very small set of commands cause the region to become active:
2754 Those commands whose semantics are to mark an area, like `mark-defun'.
2755 - The region is deactivated after each command that is executed, except that:
2756 - "Motion" commands do not change whether the region is active or not.
2758 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2759 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2760 between point and the recently-pushed mark to be highlighted. It will
2761 remain highlighted until some non-motion command is executed.
2763 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2764 region and execute a command that operates on it, you can reactivate the
2765 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2768 Generally, commands which push marks as a means of navigation (like
2769 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2770 region. But commands which push marks as a means of marking an area of
2771 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2772 do activate the region.
2774 The way the command loop actually works with regard to deactivating the
2775 region is as follows:
2777 - If the variable `zmacs-region-stays' has been set to t during the command
2778 just executed, the region is left alone (this is how the motion commands
2779 make the region stay around; see the `_' flag in the `interactive'
2780 specification). `zmacs-region-stays' is reset to nil before each command
2782 - If the function `zmacs-activate-region' has been called during the command
2783 just executed, the region is left alone. Very few functions should
2784 actually call this function.
2785 - Otherwise, if the region is active, the region is deactivated and
2786 the `zmacs-deactivate-region-hook' is called.
2788 /* Zmacs style active regions are now ON by default */
2791 DEFVAR_BOOL("zmacs-region-active-p", &zmacs_region_active_p /*
2792 Do not alter this. It is for internal use only.
2794 zmacs_region_active_p = 0;
2796 DEFVAR_BOOL("zmacs-region-stays", &zmacs_region_stays /*
2797 Whether the current command will deactivate the region.
2798 Commands which do not wish to affect whether the region is currently
2799 highlighted should set this to t. Normally, the region is turned off after
2800 executing each command that did not explicitly turn it on with the function
2801 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2802 See the variable `zmacs-regions'.
2804 The same effect can be achieved using the `_' interactive specification.
2806 `zmacs-region-stays' is reset to nil before each command is executed.
2808 zmacs_region_stays = 0;
2810 DEFVAR_BOOL("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2811 Do not use this -- it will be going away soon.
2812 Indicates if `goto-char' has just been run. This information is allegedly
2813 needed to get the desired behavior for atomic extents and unfortunately
2814 is not available by any other means.
2816 atomic_extent_goto_char_p = 0;
2817 #ifdef AMPERSAND_FULL_NAME
2818 Fprovide(intern("ampersand-full-name"));
2821 DEFVAR_LISP("user-full-name", &Vuser_full_name /*
2822 *The name of the user.
2823 The function `user-full-name', which will return the value of this
2824 variable, when called without arguments.
2825 This is initialized to the value of the NAME environment variable.
2827 /* Initialized at run-time. */
2828 Vuser_full_name = Qnil;