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 snprintf(tzbuf, countof(tzbuf) - 1, "XXX%s%d:%02d:%02d",
1353 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1354 (abszone / 60) % 60, abszone % 60);
1357 error("Invalid time zone specification");
1360 /* Set TZ before calling mktime; merely adjusting mktime's
1361 returned value doesn't suffice, since that would mishandle
1363 set_time_zone_rule(tzstring);
1365 the_time = mktime(&tm);
1367 /* Restore TZ to previous value. */
1370 #if !defined EF_USE_BDWGC
1372 #endif /* !EF_USE_BDWGC */
1373 #ifdef LOCALTIME_CACHE
1378 if (the_time == (time_t) - 1) {
1379 error("Specified time is not representable");
1382 return make_time(the_time);
1385 #if defined(HAVE_MPZ) && defined WITH_GMP
1386 DEFUN("encode-btime", Fencode_btime, 6, MANY, 0, /*
1387 Like `encode-time' but return a big integer time instead.
1390 (int nargs, Lisp_Object * args))
1394 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1399 tm.tm_sec = XINT(*args++); /* second */
1401 tm.tm_min = XINT(*args++); /* minute */
1403 tm.tm_hour = XINT(*args++); /* hour */
1405 tm.tm_mday = XINT(*args++); /* day */
1407 tm.tm_mon = XINT(*args++) - 1; /* month */
1409 tm.tm_year = XINT(*args++) - 1900; /* year */
1416 the_time = mktime(&tm);
1420 char **oldenv = environ, **newenv;
1423 tzstring = (char *)XSTRING_DATA(zone);
1424 else if (INTP(zone)) {
1425 int abszone = abs(XINT(zone));
1426 sprintf(tzbuf, "XXX%s%d:%02d:%02d",
1427 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1428 (abszone / 60) % 60, abszone % 60);
1431 error("Invalid time zone specification");
1433 /* Set TZ before calling mktime; merely adjusting mktime's returned
1434 value doesn't suffice, since that would mishandle leap seconds. */
1435 set_time_zone_rule(tzstring);
1437 the_time = mktime(&tm);
1439 /* Restore TZ to previous value. */
1443 #ifdef LOCALTIME_CACHE
1448 if (the_time == (time_t) - 1)
1449 error("Specified time is not representable");
1452 bigz_set_ulong(bz, the_time);
1453 mpz_mul_ui(bz, bz, 1000000UL);
1454 result = make_bigz_bz(bz);
1461 DEFUN("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1462 Return the current time, as a human-readable string.
1463 Programs can use this function to decode a time,
1464 since the number of columns in each field is fixed.
1465 The format is `Sun Sep 16 01:03:52 1973'.
1466 If an argument is given, it specifies a time to format
1467 instead of the current time. The argument should have the form:
1470 (HIGH LOW . IGNORED).
1471 Thus, you can use times obtained from `current-time'
1472 and from `file-attributes'.
1474 If compiled with ENT, SPECIFIED-TIME may also be a big integer
1475 as obtained from `current-btime' with the number of microseconds
1484 if (!lisp_to_time(specified_time, &value))
1486 the_ctime = ctime(&value);
1488 /* ctime is documented as always returning a "\n\0"-terminated
1489 26-byte American time string, but let's be careful anyways. */
1490 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++) ;
1492 return make_ext_string((Extbyte *) the_ctime, len, Qbinary);
1495 #define TM_YEAR_ORIGIN 1900
1497 /* Yield A - B, measured in seconds. */
1498 static long difftm(const struct tm *a, const struct tm *b)
1500 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1501 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1502 /* Some compilers can't handle this as a single return statement. */
1504 /* difference in day of year */
1505 a->tm_yday - b->tm_yday
1506 /* + intervening leap days */
1507 + ((ay >> 2) - (by >> 2))
1508 - (ay / 100 - by / 100)
1509 + ((ay / 100 >> 2) - (by / 100 >> 2))
1510 /* + difference in years * 365 */
1511 + (long)(ay - by) * 365);
1512 return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
1513 + (a->tm_min - b->tm_min))
1514 + (a->tm_sec - b->tm_sec));
1517 DEFUN("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1518 Return the offset and name for the local time zone.
1519 This returns a list of the form (OFFSET NAME).
1520 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1521 A negative value means west of Greenwich.
1522 NAME is a string giving the name of the time zone.
1523 If an argument is given, it specifies when the time zone offset is determined
1524 instead of using the current time. The argument should have the form:
1527 (HIGH LOW . IGNORED).
1528 Thus, you can use times obtained from `current-time'
1529 and from `file-attributes'.
1531 Some operating systems cannot provide all this information to Emacs;
1532 in this case, `current-time-zone' returns a list containing nil for
1533 the data it can't find.
1538 struct tm *t = NULL;
1540 if (lisp_to_time(specified_time, &value)
1541 && (t = gmtime(&value)) != 0) {
1542 /* Make a copy, in case localtime modifies *t. */
1548 t = localtime(&value);
1549 offset = difftm(t, &gmt);
1553 s = (const char *)t->tm_zone;
1554 #else /* not HAVE_TM_ZONE */
1556 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1557 s = tzname[t->tm_isdst];
1559 #endif /* not HAVE_TM_ZONE */
1561 /* No local time zone name is available; use "+-NNNN"
1563 int am = (offset < 0 ? -offset : offset) / 60;
1564 sprintf(buf, "%c%02d%02d", (offset < 0 ? '-' : '+'),
1568 return list2(make_int(offset), build_string(s));
1570 return list2(Qnil, Qnil);
1574 #ifdef LOCALTIME_CACHE
1576 /* These two values are known to load tz files in buggy implementations,
1577 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1578 Their values shouldn't matter in non-buggy implementations.
1579 We don't use string literals for these strings,
1580 since if a string in the environment is in readonly
1581 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1582 See Sun bugs 1113095 and 1114114, ``Timezone routines
1583 improperly modify environment''. */
1585 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1586 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1590 /* Set the local time zone rule to TZSTRING.
1591 This allocates memory into `environ', which it is the caller's
1592 responsibility to free. */
1593 static void set_time_zone_rule(char *tzstring)
1596 char **from, **to, **newenv;
1598 for (from = environ; *from; from++)
1600 envptrs = from - environ + 2;
1601 newenv = to = (char **)xmalloc(envptrs * sizeof(char *)
1602 + (tzstring ? strlen(tzstring) + 4 : 0));
1604 char *t = (char *)(to + envptrs);
1606 strcat(t, tzstring);
1610 for (from = environ; *from; from++)
1611 if (strncmp(*from, "TZ=", 3) != 0)
1617 #ifdef LOCALTIME_CACHE
1619 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1620 "US/Pacific" that loads a tz file, then changes to a value like
1621 "XXX0" that does not load a tz file, and then changes back to
1622 its original value, the last change is (incorrectly) ignored.
1623 Also, if TZ changes twice in succession to values that do
1624 not load a tz file, tzset can dump core (see Sun bug#1225179).
1625 The following code works around these bugs. */
1628 /* Temporarily set TZ to a value that loads a tz file
1629 and that differs from tzstring. */
1632 (strcmp(tzstring, set_time_zone_rule_tz1 + 3) ==
1633 0 ? set_time_zone_rule_tz2 :
1634 set_time_zone_rule_tz1);
1638 /* The implied tzstring is unknown, so temporarily set TZ to
1639 two different values that each load a tz file. */
1640 *to = set_time_zone_rule_tz1;
1643 *to = set_time_zone_rule_tz2;
1648 /* Now TZ has the desired value, and tzset can be invoked safely. */
1655 DEFUN("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1656 Set the local time zone using TZ, a string specifying a time zone rule.
1657 If TZ is nil, use implementation-defined default time zone information.
1667 tzstring = (char *)XSTRING_DATA(tz);
1670 set_time_zone_rule(tzstring);
1673 environbuf = environ;
1678 void buffer_insert1(struct buffer *buf, Lisp_Object arg)
1680 /* This function can GC */
1681 struct gcpro gcpro1;
1684 if (CHAR_OR_CHAR_INTP(arg)) {
1685 buffer_insert_emacs_char(buf, XCHAR_OR_CHAR_INT(arg));
1686 } else if (STRINGP(arg)) {
1687 buffer_insert_lisp_string(buf, arg);
1689 arg = wrong_type_argument(Qchar_or_string_p, arg);
1695 /* Callers passing one argument to Finsert need not gcpro the
1696 argument "array", since the only element of the array will
1697 not be used after calling insert_emacs_char or insert_lisp_string,
1698 so we don't care if it gets trashed. */
1700 DEFUN("insert", Finsert, 0, MANY, 0, /*
1701 Insert the arguments, either strings or characters, at point.
1702 Point moves forward so that it ends up after the inserted text.
1703 Any other markers at the point of insertion remain before the text.
1704 If a string has non-null string-extent-data, new extents will be created.
1706 (int nargs, Lisp_Object * args))
1708 /* This function can GC */
1709 REGISTER int argnum;
1711 for (argnum = 0; argnum < nargs; argnum++) {
1712 buffer_insert1(current_buffer, args[argnum]);
1718 DEFUN("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1719 Insert strings or characters at point, relocating markers after the text.
1720 Point moves forward so that it ends up after the inserted text.
1721 Any other markers at the point of insertion also end up after the text.
1723 (int nargs, Lisp_Object * args))
1725 /* This function can GC */
1726 REGISTER int argnum;
1727 REGISTER Lisp_Object tem;
1729 for (argnum = 0; argnum < nargs; argnum++) {
1732 if (CHAR_OR_CHAR_INTP(tem)) {
1733 buffer_insert_emacs_char_1(current_buffer, -1,
1734 XCHAR_OR_CHAR_INT(tem),
1735 INSDEL_BEFORE_MARKERS);
1736 } else if (STRINGP(tem)) {
1737 buffer_insert_lisp_string_1(current_buffer, -1, tem,
1738 INSDEL_BEFORE_MARKERS);
1740 tem = wrong_type_argument(Qchar_or_string_p, tem);
1747 DEFUN("insert-string", Finsert_string, 1, 2, 0, /*
1748 Insert STRING into BUFFER at BUFFER's point.
1749 Point moves forward so that it ends up after the inserted text.
1750 Any other markers at the point of insertion remain before the text.
1751 If a string has non-null string-extent-data, new extents will be created.
1752 BUFFER defaults to the current buffer.
1756 struct buffer *b = decode_buffer(buffer, 1);
1757 CHECK_STRING(string);
1758 buffer_insert_lisp_string(b, string);
1762 /* Third argument in FSF is INHERIT:
1764 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1765 from adjoining text, if those properties are sticky."
1767 Jamie thinks this is bogus. */
1769 DEFUN("insert-char", Finsert_char, 1, 4, 0, /*
1770 Insert COUNT copies of CHARACTER into BUFFER.
1771 Point and all markers are affected as in the function `insert'.
1772 COUNT defaults to 1 if omitted.
1773 The optional third arg IGNORED is INHERIT under FSF Emacs.
1774 This is highly bogus, however, and SXEmacs always behaves as if
1775 `t' were passed to INHERIT.
1776 The optional fourth arg BUFFER specifies the buffer to insert the
1777 text into. If BUFFER is nil, the current buffer is assumed.
1779 (character, count, ignored, buffer))
1781 /* This function can GC */
1782 REGISTER Bufbyte *string;
1785 REGISTER Bytecount n;
1786 REGISTER Bytecount charlen;
1787 Bufbyte str[MAX_EMCHAR_LEN];
1788 struct buffer *b = decode_buffer(buffer, 1);
1791 CHECK_CHAR_COERCE_INT(character);
1799 charlen = set_charptr_emchar(str, XCHAR(character));
1804 string = alloca_array(Bufbyte, slen);
1805 /* Write as many copies of the character into the temp string as will fit. */
1806 for (i = 0; i + charlen <= slen; i += charlen)
1807 for (j = 0; j < charlen; j++)
1808 string[i + j] = str[j];
1811 buffer_insert_raw_string(b, string, slen);
1815 #if 0 /* FSFmacs bogosity */
1818 insert_and_inherit(string, n);
1823 buffer_insert_raw_string(b, string, n);
1829 /* Making strings from buffer contents. */
1831 DEFUN("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1832 Return the contents of part of BUFFER as a string.
1833 The two arguments START and END are character positions;
1834 they can be in either order. If omitted, they default to the beginning
1835 and end of BUFFER, respectively.
1836 If there are duplicable extents in the region, the string remembers
1837 them in its extent data.
1838 If BUFFER is nil, the current buffer is assumed.
1840 (start, end, buffer))
1842 /* This function can GC */
1844 struct buffer *b = decode_buffer(buffer, 1);
1846 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1847 return make_string_from_buffer(b, begv, zv - begv);
1850 /* It might make more sense to name this
1851 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1852 and what the function does is probably good enough for what the
1853 user-code will typically want to use it for. */
1854 DEFUN("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1855 Return the text from START to END as a string, without copying the extents.
1857 (start, end, buffer))
1859 /* This function can GC */
1861 struct buffer *b = decode_buffer(buffer, 1);
1863 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1864 return make_string_from_buffer_no_extents(b, begv, zv - begv);
1867 DEFUN("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1868 Insert before point a substring of the contents of buffer BUFFER.
1869 BUFFER may be a buffer or a buffer name.
1870 Arguments START and END are character numbers specifying the substring.
1871 They default to the beginning and the end of BUFFER.
1873 (buffer, start, end))
1875 /* This function can GC */
1878 Lisp_Object tmp_buf = emacs_get_buffer(buffer, 1);
1880 bp = XBUFFER(tmp_buf);
1881 get_buffer_range_char(bp, start, end, &b, &e, GB_ALLOW_NIL);
1884 buffer_insert_from_buffer(current_buffer, bp, b, e - b);
1889 DEFUN("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1890 Compare two substrings of two buffers; return result as number.
1891 the value is -N if first string is less after N-1 chars,
1892 +N if first string is greater after N-1 chars, or 0 if strings match.
1893 Each substring is represented as three arguments: BUFFER, START and END.
1894 That makes six args in all, three for each substring.
1896 The value of `case-fold-search' in the current buffer
1897 determines whether case is significant or ignored.
1899 (buffer1, start1, end1, buffer2, start2, end2))
1901 Bufpos begp1, endp1, begp2, endp2;
1902 REGISTER Charcount len1, len2, length, i;
1903 struct buffer *bp1, *bp2;
1904 Lisp_Object trt = ((!NILP(current_buffer->case_fold_search)) ?
1905 XCASE_TABLE_CANON(current_buffer->
1906 case_table) : Qnil);
1908 /* Find the first buffer and its substring. */
1910 bp1 = decode_buffer(buffer1, 1);
1911 get_buffer_range_char(bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1913 /* Likewise for second substring. */
1915 bp2 = decode_buffer(buffer2, 1);
1916 get_buffer_range_char(bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1918 len1 = endp1 - begp1;
1919 len2 = endp2 - begp2;
1924 for (i = 0; i < length; i++) {
1925 Emchar c1 = BUF_FETCH_CHAR(bp1, begp1 + i);
1926 Emchar c2 = BUF_FETCH_CHAR(bp2, begp2 + i);
1928 c1 = TRT_TABLE_OF(trt, c1);
1929 c2 = TRT_TABLE_OF(trt, c2);
1932 return make_int(-1 - i);
1934 return make_int(i + 1);
1937 /* The strings match as far as they go.
1938 If one is shorter, that one is less. */
1940 return make_int(length + 1);
1941 else if (length < len2)
1942 return make_int(-length - 1);
1944 /* Same length too => they are equal. */
1948 static Lisp_Object subst_char_in_region_unwind(Lisp_Object arg)
1950 XBUFFER(XCAR(arg))->undo_list = XCDR(arg);
1954 static Lisp_Object subst_char_in_region_unwind_1(Lisp_Object arg)
1956 XBUFFER(XCAR(arg))->filename = XCDR(arg);
1960 DEFUN("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1961 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1962 If optional arg NOUNDO is non-nil, don't record this change for undo
1963 and don't mark the buffer as really changed.
1965 (start, end, fromchar, tochar, noundo))
1967 /* This function can GC */
1971 struct buffer *buf = current_buffer;
1972 int count = specpdl_depth();
1974 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
1975 CHECK_CHAR_COERCE_INT(fromchar);
1976 CHECK_CHAR_COERCE_INT(tochar);
1978 fromc = XCHAR(fromchar);
1979 toc = XCHAR(tochar);
1981 /* If we don't want undo, turn off putting stuff on the list.
1982 That's faster than getting rid of things,
1983 and it prevents even the entry for a first change.
1984 Also inhibit locking the file. */
1985 if (!NILP(noundo)) {
1986 record_unwind_protect(subst_char_in_region_unwind,
1987 Fcons(Fcurrent_buffer(), buf->undo_list));
1988 buf->undo_list = Qt;
1989 /* Don't do file-locking. */
1990 record_unwind_protect(subst_char_in_region_unwind_1,
1991 Fcons(Fcurrent_buffer(), buf->filename));
1992 buf->filename = Qnil;
1995 mc_count = begin_multiple_change(buf, pos, stop);
1996 while (pos < stop) {
1997 if (BUF_FETCH_CHAR(buf, pos) == fromc) {
1998 /* There used to be some code here that set the buffer to
1999 unmodified if NOUNDO was specified and there was only
2000 one change to the buffer since it was last saved.
2001 This is a crock of shit, so I'm not duplicating this
2002 behavior. I think this was left over from when
2003 prepare_to_modify_buffer() actually bumped MODIFF,
2004 so that code was supposed to undo this change. --ben */
2005 buffer_replace_char(buf, pos, toc, !NILP(noundo), 0);
2007 /* If noundo is not nil then we don't mark the buffer as
2008 modified. In reality that needs to happen externally
2009 only. Internally redisplay needs to know that the actual
2010 contents it should be displaying have changed. */
2012 Fset_buffer_modified_p(Fbuffer_modified_p(Qnil),
2017 end_multiple_change(buf, mc_count);
2019 unbind_to(count, Qnil);
2023 /* #### Shouldn't this also accept a BUFFER argument, in the good old
2024 XEmacs tradition? */
2025 DEFUN("translate-region", Ftranslate_region, 3, 3, 0, /*
2026 Translate characters from START to END according to TABLE.
2028 If TABLE is a string, the Nth character in it is the mapping for the
2029 character with code N.
2031 If TABLE is a vector, its Nth element is the mapping for character
2032 with code N. The values of elements may be characters, strings, or
2033 nil (nil meaning don't replace.)
2035 If TABLE is a char-table, its elements describe the mapping between
2036 characters and their replacements. The char-table should be of type
2037 `char' or `generic'.
2039 Returns the number of substitutions performed.
2041 (start, end, table))
2043 /* This function can GC */
2044 Bufpos pos, stop; /* Limits of the region. */
2045 int cnt = 0; /* Number of changes made. */
2047 struct buffer *buf = current_buffer;
2050 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
2051 mc_count = begin_multiple_change(buf, pos, stop);
2052 if (STRINGP(table)) {
2053 Lisp_String *stable = XSTRING(table);
2054 Charcount size = string_char_length(stable);
2056 /* Under Mule, string_char(n) is O(n), so for large tables or
2057 large regions it makes sense to create an array of Emchars. */
2058 if (size * (stop - pos) > 65536) {
2059 Emchar *etable = alloca_array(Emchar, size);
2060 convert_bufbyte_string_into_emchar_string
2061 (string_data(stable), string_length(stable),
2063 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2066 Emchar nc = etable[oc];
2068 buffer_replace_char(buf, pos,
2077 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2080 Emchar nc = string_char(stable, oc);
2082 buffer_replace_char(buf, pos,
2089 } else if (VECTORP(table)) {
2090 Charcount size = XVECTOR_LENGTH(table);
2091 Lisp_Object *vtable = XVECTOR_DATA(table);
2093 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2095 Lisp_Object replacement = vtable[oc];
2097 if (CHAR_OR_CHAR_INTP(replacement)) {
2099 XCHAR_OR_CHAR_INT(replacement);
2101 buffer_replace_char(buf, pos,
2105 } else if (STRINGP(replacement)) {
2107 XSTRING_CHAR_LENGTH(replacement) -
2109 buffer_delete_range(buf, pos, pos + 1,
2111 buffer_insert_lisp_string_1(buf, pos,
2114 pos += incr, stop += incr;
2116 } else if (!NILP(replacement)) {
2119 (Qchar_or_string_p, replacement);
2124 } else if (CHAR_TABLEP(table)
2125 && (XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_GENERIC
2126 || XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_CHAR)) {
2127 Lisp_Char_Table *ctable = XCHAR_TABLE(table);
2129 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2130 Lisp_Object replacement = get_char_table(oc, ctable);
2132 if (CHAR_OR_CHAR_INTP(replacement)) {
2133 Emchar nc = XCHAR_OR_CHAR_INT(replacement);
2135 buffer_replace_char(buf, pos, nc, 0, 0);
2138 } else if (STRINGP(replacement)) {
2140 XSTRING_CHAR_LENGTH(replacement) - 1;
2141 buffer_delete_range(buf, pos, pos + 1, 0);
2142 buffer_insert_lisp_string_1(buf, pos,
2144 pos += incr, stop += incr;
2146 } else if (!NILP(replacement)) {
2148 wrong_type_argument(Qchar_or_string_p,
2154 dead_wrong_type_argument(Qstringp, table);
2155 end_multiple_change(buf, mc_count);
2157 return make_int(cnt);
2160 DEFUN("delete-region", Fdelete_region, 2, 3, "r", /*
2161 Delete the text between point and mark.
2162 When called from a program, expects two arguments START and END
2163 \(integers or markers) specifying the stretch to be deleted.
2164 If optional third arg BUFFER is nil, the current buffer is assumed.
2166 (start, end, buffer))
2168 /* This function can GC */
2169 Bufpos bp_start, bp_end;
2170 struct buffer *buf = decode_buffer(buffer, 1);
2172 get_buffer_range_char(buf, start, end, &bp_start, &bp_end, 0);
2173 buffer_delete_range(buf, bp_start, bp_end, 0);
2177 void widen_buffer(struct buffer *b, int no_clip)
2179 if (BUF_BEGV(b) != BUF_BEG(b)) {
2181 SET_BOTH_BUF_BEGV(b, BUF_BEG(b), BI_BUF_BEG(b));
2183 if (BUF_ZV(b) != BUF_Z(b)) {
2185 SET_BOTH_BUF_ZV(b, BUF_Z(b), BI_BUF_Z(b));
2190 /* Changing the buffer bounds invalidates any recorded current
2192 invalidate_current_column();
2193 narrow_line_number_cache(b);
2197 DEFUN("widen", Fwiden, 0, 1, "", /*
2198 Remove restrictions (narrowing) from BUFFER.
2199 This allows the buffer's full text to be seen and edited.
2200 If BUFFER is nil, the current buffer is assumed.
2204 struct buffer *b = decode_buffer(buffer, 1);
2209 DEFUN("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2210 Restrict editing in BUFFER to the current region.
2211 The rest of the text becomes temporarily invisible and untouchable
2212 but is not deleted; if you save the buffer in a file, the invisible
2213 text is included in the file. \\[widen] makes all visible again.
2214 If BUFFER is nil, the current buffer is assumed.
2215 See also `save-restriction'.
2217 When calling from a program, pass two arguments; positions (integers
2218 or markers) bounding the text that should remain visible.
2220 (start, end, buffer))
2222 Bufpos bp_start, bp_end;
2223 struct buffer *buf = decode_buffer(buffer, 1);
2224 Bytind bi_start, bi_end;
2226 get_buffer_range_char(buf, start, end, &bp_start, &bp_end,
2227 GB_ALLOW_PAST_ACCESSIBLE);
2228 bi_start = bufpos_to_bytind(buf, bp_start);
2229 bi_end = bufpos_to_bytind(buf, bp_end);
2231 SET_BOTH_BUF_BEGV(buf, bp_start, bi_start);
2232 SET_BOTH_BUF_ZV(buf, bp_end, bi_end);
2233 if (BUF_PT(buf) < bp_start)
2234 BUF_SET_PT(buf, bp_start);
2235 if (BUF_PT(buf) > bp_end)
2236 BUF_SET_PT(buf, bp_end);
2238 /* Changing the buffer bounds invalidates any recorded current column. */
2239 invalidate_current_column();
2240 narrow_line_number_cache(buf);
2244 Lisp_Object save_restriction_save(void)
2246 Lisp_Object bottom, top;
2247 /* Note: I tried using markers here, but it does not win
2248 because insertion at the end of the saved region
2249 does not advance mh and is considered "outside" the saved region. */
2250 bottom = make_int(BUF_BEGV(current_buffer) - BUF_BEG(current_buffer));
2251 top = make_int(BUF_Z(current_buffer) - BUF_ZV(current_buffer));
2253 return noseeum_cons(Fcurrent_buffer(), noseeum_cons(bottom, top));
2256 Lisp_Object save_restriction_restore(Lisp_Object data)
2259 Charcount newhead, newtail;
2261 int local_clip_changed = 0;
2263 buf = XBUFFER(XCAR(data));
2264 if (!BUFFER_LIVE_P(buf)) {
2265 /* someone could have killed the buffer in the meantime ... */
2266 free_cons(XCONS(XCDR(data)));
2267 free_cons(XCONS(data));
2271 newhead = XINT(XCAR(tem));
2272 newtail = XINT(XCDR(tem));
2274 free_cons(XCONS(XCDR(data)));
2275 free_cons(XCONS(data));
2277 if (newhead + newtail > BUF_Z(buf) - BUF_BEG(buf)) {
2284 Bytind bi_start, bi_end;
2286 start = BUF_BEG(buf) + newhead;
2287 end = BUF_Z(buf) - newtail;
2289 bi_start = bufpos_to_bytind(buf, start);
2290 bi_end = bufpos_to_bytind(buf, end);
2292 if (BUF_BEGV(buf) != start) {
2293 local_clip_changed = 1;
2294 SET_BOTH_BUF_BEGV(buf, start, bi_start);
2295 narrow_line_number_cache(buf);
2297 if (BUF_ZV(buf) != end) {
2298 local_clip_changed = 1;
2299 SET_BOTH_BUF_ZV(buf, end, bi_end);
2302 if (local_clip_changed)
2305 /* If point is outside the new visible range, move it inside. */
2307 bufpos_clip_to_bounds(BUF_BEGV(buf),
2308 BUF_PT(buf), BUF_ZV(buf)));
2313 DEFUN("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2314 Execute BODY, saving and restoring current buffer's restrictions.
2315 The buffer's restrictions make parts of the beginning and end invisible.
2316 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2317 This special form, `save-restriction', saves the current buffer's restrictions
2318 when it is entered, and restores them when it is exited.
2319 So any `narrow-to-region' within BODY lasts only until the end of the form.
2320 The old restrictions settings are restored
2321 even in case of abnormal exit (throw or error).
2323 The value returned is the value of the last form in BODY.
2325 `save-restriction' can get confused if, within the BODY, you widen
2326 and then make changes outside the area within the saved restrictions.
2328 Note: if you are using both `save-excursion' and `save-restriction',
2329 use `save-excursion' outermost:
2330 (save-excursion (save-restriction ...))
2334 /* This function can GC */
2335 int speccount = specpdl_depth();
2337 record_unwind_protect(save_restriction_restore,
2338 save_restriction_save());
2340 return unbind_to(speccount, Fprogn(body));
2343 DEFUN("format", Fformat, 1, MANY, 0, /*
2344 Return a formatted string out of a format string and arguments.
2346 Arguments: string &rest objects
2348 Hereby, STRING is the format string (also known as template) which
2349 consists of constant (immutable) portions and so called format
2350 specifiers (%-specs). For details on these see below.
2352 The remaining arguments, OBJECTS, are substituted into the format
2353 string to make the result, a string. The exact influence of OBJECTS
2354 on the final result is described below. In general, OBJECTS will be
2355 the lisp objects to be printed.
2359 The format string STRING is basically an ordinary string enriched with
2360 %-sequences (also known as specifiers or specs for short). The specs
2361 in STRING will be substituted for the according object in OBJECTS, to
2362 be precise with a string representation of the object. In the simplest
2363 case, the first specifier in STRING corresponds to the first element
2364 in OBJECTS, the second specifier corresponds to the second element, and
2367 The specifiers themselves look like
2368 %[r$][#][&][ ][+][~][0][-]['][!a][m][.p|*]{sSdioxXbucfeEgGZQFRBC}
2372 %s means print all objects as-is, using `princ'.
2373 %S means print all objects as s-expressions, using `prin1'.
2376 %d means print as an integer in decimal
2377 %i means print as an integer in decimal
2378 %o means print as an integer in octal
2379 %x means print as an integer in lowercase hex
2380 %X means print as an integer in uppercase hex
2381 %b means print as an integer in binary
2382 %u means print a non-negative integer.
2383 %c means print as a single character.
2386 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2387 %e or %E means print as a floating-point number in scientific notation
2389 %g or %G means print as a floating-point number in "pretty format";
2390 depending on the number, either %f or %e/%E format will be used, and
2391 trailing zeroes are removed from the fractional part.
2392 The argument used for all but %s and %S must be a number. It will be
2393 converted to an integer or a floating-point number as necessary.
2394 Please bear in mind that floating point numbers have a limited and fixed
2395 precision although the print output may suggest something else.
2396 The precision varies (depending on the machine) between 12 and 38 digits.
2397 This means if you use specifiers like %.60f on 1.0 or 1.5 only the first
2398 12 to 38 digits are real. Also note, that internally numbers are processed
2399 in a 2-adic arithmetic, so you may experience strange rounding effects,
2400 e.g. %.60f on 1.2 or %f on 1e+40, this is because you force the printer to
2401 be more precise than actually valid. No error is thrown in these cases!
2403 If SXEmacs was compiled with GMP support the following additional
2404 specifiers become available:
2405 %Z means print as big integer (convert to bigz)
2406 %Q means print as fraction (convert to bigq)
2407 %F means print as bigfr or bigf float (convert to in that order)
2408 this specifier always converts the argument, regardless the
2409 value of `read-real-as'
2410 %R means print as real number (convert to bigfr, bigf or float)
2411 this specifier respects the value of `read-real-as'
2412 %B means print as Gaussian number (convert to bigg)
2413 %C means print as complex number (convert to bigc)
2415 Both %B and %C are actually rewrites to %Z%+Z and %F%+F with the
2416 argument rewritten to (real-part arg) (imaginary-part arg).
2417 Flags are passed on to at least the real part specifier.
2421 Using above notation there are several tweaks, so called modifiers,
2422 to fine-tune the substitution. Modifiers are completely optional.
2425 r$ use the `r'-th element of OBJECTS instead the one in order
2426 # print 0x, 0o, 0b prefix for numbers in a different base
2427 & use lisp syntax for base!=10 numbers, as in #x73, implies ~
2428 if non-negative print a place holder ` ' for a sign, `-' otherwise
2429 + always print a sign, `-' if negative and `+' if non-negative
2430 ~ in conjunction with `#' and signed numbers print sign after 0[xob]
2431 0 pad numbers (only on the left) with zeroes instead of spaces
2433 ' group numbers in groups of three
2434 !a use `a' as pad character instead of space
2435 m specify a minimum width of the yielded string
2436 .p use `p' digits of precision, depends on the specifer
2437 * use the argument in order to obtain the precision
2439 %$ means reposition to read a specific numbered argument; for example,
2440 %3$s would apply the `%s' to the third argument after the control string,
2441 and the next format directive would use the fourth argument, the
2442 following one the fifth argument, etc. (There must be a positive integer
2443 between the % and the $).
2445 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2446 specified between the optional repositioning spec and the conversion
2447 character; see below.
2449 An optional minimum field width may be specified after any flag characters
2450 and before the conversion character; it specifies the minimum number of
2451 characters that the converted argument will take up. Padding will be
2452 added on the left (or on the right, if the `-' flag is specified), as
2453 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2456 If the field width is specified as `*', the field width is assumed to have
2457 been specified as an argument. Any repositioning specification that
2458 would normally specify the argument to be converted will now specify
2459 where to find this field width argument, not where to find the argument
2460 to be converted. If there is no repositioning specification, the normal
2461 next argument is used. The argument to be converted will be the next
2462 argument after the field width argument unless the precision is also
2463 specified as `*' (see below).
2465 An optional period character and precision may be specified after any
2466 minimum field width. It specifies the minimum number of digits to
2467 appear in %d, %i, %b, %o, %x, and %X conversions (the number is padded
2468 on the left with zeroes as necessary); the number of digits printed
2469 after the decimal point for %f, %e, and %E conversions; the number
2470 of significant digits printed in %g and %G conversions; and the
2471 maximum number of non-padding characters printed in %s and %S
2472 conversions. The default precision for floating-point conversions
2475 If the precision is specified as `*', the precision is assumed to have been
2476 specified as an argument. The argument used will be the next argument
2477 after the field width argument, if any. If the field width was not
2478 specified as an argument, any repositioning specification that would
2479 normally specify the argument to be converted will now specify where to
2480 find the precision argument. If there is no repositioning specification,
2481 the normal next argument is used.
2483 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2484 plus sign, respectively.
2486 The `#' flag means print numbers in an alternate, more verbose format:
2487 octal numbers begin with 0o; hex numbers begin with a 0x or 0X;
2488 and binary representations start with 0b;
2489 a decimal point is printed in %f, %e, and %E conversions even if no
2490 numbers are printed after it; and trailing zeroes are not omitted in
2491 %g and %G conversions.
2493 Use %% to put a single % into the output.
2495 (int nargs, Lisp_Object * args))
2497 /* It should not be necessary to GCPRO ARGS, because
2498 the caller in the interpreter should take care of that. */
2500 CHECK_STRING(args[0]);
2501 return emacs_doprnt_string_lisp(0, args[0], 0, nargs - 1, args + 1);
2504 DEFUN("char-equal", Fchar_equal, 2, 3, 0, /*
2505 Return t if two characters match, optionally ignoring case.
2506 Both arguments must be characters (i.e. NOT integers).
2507 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2508 If BUFFER is nil, the current buffer is assumed.
2510 (character1, character2, buffer))
2513 struct buffer *b = decode_buffer(buffer, 1);
2515 CHECK_CHAR_COERCE_INT(character1);
2516 CHECK_CHAR_COERCE_INT(character2);
2517 x1 = XCHAR(character1);
2518 x2 = XCHAR(character2);
2520 return (!NILP(b->case_fold_search)
2521 ? DOWNCASE(b, x1) == DOWNCASE(b, x2)
2526 DEFUN("char=", Fchar_Equal, 2, 2, 0, /*
2527 Return t if two characters match, case is significant.
2528 Both arguments must be characters (i.e. NOT integers).
2530 (character1, character2))
2532 CHECK_CHAR_COERCE_INT(character1);
2533 CHECK_CHAR_COERCE_INT(character2);
2535 return EQ(character1, character2) ? Qt : Qnil;
2538 #if 0 /* Undebugged FSFmacs code */
2539 /* Transpose the markers in two regions of the current buffer, and
2540 adjust the ones between them if necessary (i.e.: if the regions
2543 Traverses the entire marker list of the buffer to do so, adding an
2544 appropriate amount to some, subtracting from some, and leaving the
2545 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2547 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2549 void transpose_markers(Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2551 Charcount amt1, amt2, diff;
2553 struct buffer *buf = current_buffer;
2555 /* Update point as if it were a marker. */
2556 if (BUF_PT(buf) < start1) ;
2557 else if (BUF_PT(buf) < end1)
2558 BUF_SET_PT(buf, BUF_PT(buf) + (end2 - end1));
2559 else if (BUF_PT(buf) < start2)
2561 BUF_PT(buf) + (end2 - start2) - (end1 - start1));
2562 else if (BUF_PT(buf) < end2)
2563 BUF_SET_PT(buf, BUF_PT(buf) - (start2 - start1));
2565 /* We used to adjust the endpoints here to account for the gap, but that
2566 isn't good enough. Even if we assume the caller has tried to move the
2567 gap out of our way, it might still be at start1 exactly, for example;
2568 and that places it `inside' the interval, for our purposes. The amount
2569 of adjustment is nontrivial if there's a `denormalized' marker whose
2570 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2571 the dirty work to Fmarker_position, below. */
2573 /* The difference between the region's lengths */
2574 diff = (end2 - start2) - (end1 - start1);
2576 /* For shifting each marker in a region by the length of the other
2577 * region plus the distance between the regions.
2579 amt1 = (end2 - start2) + (start2 - end1);
2580 amt2 = (end1 - start1) + (start2 - end1);
2582 for (marker = BUF_MARKERS(buf); !NILP(marker);
2583 marker = XMARKER(marker)->chain) {
2584 Bufpos mpos = marker_position(marker);
2585 if (mpos >= start1 && mpos < end2) {
2588 else if (mpos < start2)
2592 set_marker_position(marker, mpos);
2599 DEFUN("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2600 Transpose region START1 to END1 with START2 to END2.
2601 The regions may not be overlapping, because the size of the buffer is
2602 never changed in a transposition.
2604 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
2605 any markers that happen to be located in the regions. (#### BUG: currently
2606 this function always acts as if LEAVE-MARKERS is non-nil.)
2608 Transposing beyond buffer boundaries is an error.
2610 (start1, end1, start2, end2, leave_markers))
2612 Bufpos startr1, endr1, startr2, endr2;
2613 Charcount len1, len2;
2614 Lisp_Object string1, string2;
2615 struct buffer *buf = current_buffer;
2617 get_buffer_range_char(buf, start1, end1, &startr1, &endr1, 0);
2618 get_buffer_range_char(buf, start2, end2, &startr2, &endr2, 0);
2620 len1 = endr1 - startr1;
2621 len2 = endr2 - startr2;
2623 if (startr2 < endr1)
2624 error("transposed regions not properly ordered");
2625 else if (startr1 == endr1 || startr2 == endr2)
2626 error("transposed region may not be of length 0");
2628 string1 = make_string_from_buffer(buf, startr1, len1);
2629 string2 = make_string_from_buffer(buf, startr2, len2);
2630 buffer_delete_range(buf, startr2, endr2, 0);
2631 buffer_insert_lisp_string_1(buf, startr2, string1, 0);
2632 buffer_delete_range(buf, startr1, endr1, 0);
2633 buffer_insert_lisp_string_1(buf, startr1, string2, 0);
2635 /* In FSFmacs there is a whole bunch of really ugly code here
2636 to attempt to transpose the regions without using up any
2637 extra memory. Although the intent may be good, the result
2638 was highly bogus. */
2643 /************************************************************************/
2644 /* initialization */
2645 /************************************************************************/
2647 void syms_of_editfns(void)
2649 defsymbol(&Qpoint, "point");
2650 defsymbol(&Qmark, "mark");
2651 defsymbol(&Qregion_beginning, "region-beginning");
2652 defsymbol(&Qregion_end, "region-end");
2653 defsymbol(&Qformat, "format");
2654 defsymbol(&Quser_files_and_directories, "user-files-and-directories");
2656 DEFSUBR(Fchar_equal);
2657 DEFSUBR(Fchar_Equal);
2658 DEFSUBR(Fgoto_char);
2659 DEFSUBR(Fstring_to_char);
2660 DEFSUBR(Fchar_to_string);
2661 DEFSUBR(Fbuffer_substring);
2662 DEFSUBR(Fbuffer_substring_no_properties);
2664 DEFSUBR(Fpoint_marker);
2665 DEFSUBR(Fmark_marker);
2667 DEFSUBR(Fregion_beginning);
2668 DEFSUBR(Fregion_end);
2669 DEFSUBR(Fsave_excursion);
2670 DEFSUBR(Fsave_current_buffer);
2672 DEFSUBR(Fbuffer_size);
2673 DEFSUBR(Fpoint_max);
2674 DEFSUBR(Fpoint_min);
2675 DEFSUBR(Fpoint_min_marker);
2676 DEFSUBR(Fpoint_max_marker);
2682 DEFSUBR(Ffollowing_char);
2683 DEFSUBR(Fpreceding_char);
2684 DEFSUBR(Fchar_after);
2685 DEFSUBR(Fchar_before);
2687 DEFSUBR(Finsert_string);
2688 DEFSUBR(Finsert_before_markers);
2689 DEFSUBR(Finsert_char);
2691 DEFSUBR(Ftemp_directory);
2692 DEFSUBR(Fuser_login_name);
2693 DEFSUBR(Fuser_real_login_name);
2695 DEFSUBR(Fuser_real_uid);
2696 DEFSUBR(Fuser_full_name);
2697 DEFSUBR(Fuser_home_directory);
2698 DEFSUBR(Femacs_pid);
2699 DEFSUBR(Fcurrent_time);
2700 #if defined(HAVE_MPZ) && defined(WITH_GMP)
2701 DEFSUBR(Fcurrent_btime);
2702 DEFSUBR(Ftime_to_btime);
2703 DEFSUBR(Fbtime_to_time);
2704 #endif /* HAVE_MPZ */
2705 DEFSUBR(Fcurrent_process_time);
2707 DEFSUBR(Fformat_time_string);
2708 DEFSUBR(Fdecode_time);
2709 DEFSUBR(Fencode_time);
2710 #if defined(HAVE_MPZ) && defined WITH_GMP
2711 DEFSUBR(Fencode_btime);
2713 DEFSUBR(Fcurrent_time_string);
2714 DEFSUBR(Fcurrent_time_zone);
2715 DEFSUBR(Fset_time_zone_rule);
2716 DEFSUBR(Fsystem_name);
2719 DEFSUBR(Finsert_buffer_substring);
2720 DEFSUBR(Fcompare_buffer_substrings);
2721 DEFSUBR(Fsubst_char_in_region);
2722 DEFSUBR(Ftranslate_region);
2723 DEFSUBR(Fdelete_region);
2725 DEFSUBR(Fnarrow_to_region);
2726 DEFSUBR(Fsave_restriction);
2727 DEFSUBR(Ftranspose_regions);
2729 defsymbol(&Qzmacs_update_region, "zmacs-update-region");
2730 defsymbol(&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2731 defsymbol(&Qzmacs_region_buffer, "zmacs-region-buffer");
2734 void vars_of_editfns(void)
2736 staticpro(&Vsystem_name);
2738 staticpro(&Vuser_name);
2739 staticpro(&Vuser_real_name);
2741 DEFVAR_BOOL("zmacs-regions", &zmacs_regions /*
2742 *Whether LISPM-style active regions should be used.
2743 This means that commands which operate on the region (the area between the
2744 point and the mark) will only work while the region is in the ``active''
2745 state, which is indicated by highlighting. Executing most commands causes
2746 the region to not be in the active state, so (for example) \\[kill-region] will only
2747 work immediately after activating the region.
2751 - Commands which operate on the region only work if the region is active.
2752 - Only a very small set of commands cause the region to become active:
2753 Those commands whose semantics are to mark an area, like `mark-defun'.
2754 - The region is deactivated after each command that is executed, except that:
2755 - "Motion" commands do not change whether the region is active or not.
2757 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2758 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2759 between point and the recently-pushed mark to be highlighted. It will
2760 remain highlighted until some non-motion command is executed.
2762 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2763 region and execute a command that operates on it, you can reactivate the
2764 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2767 Generally, commands which push marks as a means of navigation (like
2768 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2769 region. But commands which push marks as a means of marking an area of
2770 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2771 do activate the region.
2773 The way the command loop actually works with regard to deactivating the
2774 region is as follows:
2776 - If the variable `zmacs-region-stays' has been set to t during the command
2777 just executed, the region is left alone (this is how the motion commands
2778 make the region stay around; see the `_' flag in the `interactive'
2779 specification). `zmacs-region-stays' is reset to nil before each command
2781 - If the function `zmacs-activate-region' has been called during the command
2782 just executed, the region is left alone. Very few functions should
2783 actually call this function.
2784 - Otherwise, if the region is active, the region is deactivated and
2785 the `zmacs-deactivate-region-hook' is called.
2787 /* Zmacs style active regions are now ON by default */
2790 DEFVAR_BOOL("zmacs-region-active-p", &zmacs_region_active_p /*
2791 Do not alter this. It is for internal use only.
2793 zmacs_region_active_p = 0;
2795 DEFVAR_BOOL("zmacs-region-stays", &zmacs_region_stays /*
2796 Whether the current command will deactivate the region.
2797 Commands which do not wish to affect whether the region is currently
2798 highlighted should set this to t. Normally, the region is turned off after
2799 executing each command that did not explicitly turn it on with the function
2800 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2801 See the variable `zmacs-regions'.
2803 The same effect can be achieved using the `_' interactive specification.
2805 `zmacs-region-stays' is reset to nil before each command is executed.
2807 zmacs_region_stays = 0;
2809 DEFVAR_BOOL("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2810 Do not use this -- it will be going away soon.
2811 Indicates if `goto-char' has just been run. This information is allegedly
2812 needed to get the desired behavior for atomic extents and unfortunately
2813 is not available by any other means.
2815 atomic_extent_goto_char_p = 0;
2816 #ifdef AMPERSAND_FULL_NAME
2817 Fprovide(intern("ampersand-full-name"));
2820 DEFVAR_LISP("user-full-name", &Vuser_full_name /*
2821 *The name of the user.
2822 The function `user-full-name', which will return the value of this
2823 variable, when called without arguments.
2824 This is initialized to the value of the NAME environment variable.
2826 /* Initialized at run-time. */
2827 Vuser_full_name = Qnil;