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 strncpy(path, getenv("HOME"), sizeof(path)-1);
620 strncat(path, "/tmp/", sizeof(path)-strlen(path)-1);
621 if (stat(path, &st) < 0 && errno == ENOENT) {
624 /* strlen(".created_by_sxemacs") */
625 19 + _POSIX_PATH_MAX + 1];
626 mkdir(path, 0700); /* ignore retvals */
627 strncpy(warnpath, path, _POSIX_PATH_MAX);
628 warnpath[sizeof(warnpath)-1]=0;
630 /* we already are reserved these 20 bytes... */
631 strcat(warnpath, ".created_by_sxemacs");
633 open(warnpath, O_WRONLY | O_CREAT,
636 "SXEmacs created this directory because /tmp/<yourname> was unavailable -- \nPlease check !\n",
641 if (stat(path, &st) == 0 && S_ISDIR(st.st_mode)) {
649 return build_ext_string(tmpdir, Qfile_name);
652 DEFUN("user-login-name", Fuser_login_name, 0, 1, 0, /*
653 Return the name under which the user logged in, as a string.
654 This is based on the effective uid, not the real uid.
655 Also, if the environment variable LOGNAME or USER is set,
656 that determines the value of this function.
657 If the optional argument UID is present, then environment variables are
658 ignored and this function returns the login name for that UID, or nil.
667 local_uid = XINT(uid);
668 returned_name = user_login_name(&local_uid);
670 returned_name = user_login_name(NULL);
672 /* #### - I believe this should return nil instead of "unknown" when pw==0
673 pw=0 is indicated by a null return from user_login_name
675 return returned_name ? build_string(returned_name) : Qnil;
678 /* This function may be called from other C routines when a
679 character string representation of the user_login_name is
680 needed but a Lisp Object is not. The UID is passed by
681 reference. If UID == NULL, then the USER name
682 for the user running XEmacs will be returned. This
683 corresponds to a nil argument to Fuser_login_name.
685 char *user_login_name(uid_t * uid)
687 /* uid == NULL to return name of this user */
689 struct passwd *pw = getpwuid(*uid);
690 return pw ? pw->pw_name : NULL;
692 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
693 old environment (I site observed behavior on sunos and linux), so the
694 environment variables should be disregarded in that case. --Stig */
695 char *user_name = getenv("LOGNAME");
703 struct passwd *pw = getpwuid(geteuid());
704 return pw ? pw->pw_name : NULL;
709 DEFUN("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
710 Return the name of the user's real uid, as a string.
711 This ignores the environment variables LOGNAME and USER, so it differs from
712 `user-login-name' when running under `su'.
716 struct passwd *pw = getpwuid(getuid());
717 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
719 Lisp_Object tem = build_string(pw ? pw->pw_name : "unknown"); /* no gettext */
723 DEFUN("user-uid", Fuser_uid, 0, 0, 0, /*
724 Return the effective uid of Emacs, as an integer.
728 return make_int(geteuid());
731 DEFUN("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
732 Return the real uid of Emacs, as an integer.
736 return make_int(getuid());
739 DEFUN("user-full-name", Fuser_full_name, 0, 1, 0, /*
740 Return the full name of the user logged in, as a string.
741 If the optional argument USER is given, then the full name for that
742 user is returned, or nil. USER may be either a login name or a uid.
744 If USER is nil, and `user-full-name' contains a string, the
745 value of `user-full-name' is returned.
749 Lisp_Object user_name;
750 struct passwd *pw = NULL;
755 if (NILP(user) && STRINGP(Vuser_full_name))
756 return Vuser_full_name;
758 user_name = (STRINGP(user) ? user : Fuser_login_name(user));
759 if (!NILP(user_name)) { /* nil when nonexistent UID passed as arg */
760 const char *user_name_ext;
762 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
763 things get wedged if a SIGIO arrives during this time. */
764 TO_EXTERNAL_FORMAT(LISP_STRING, user_name,
765 C_STRING_ALLOCA, user_name_ext, Qnative);
766 slow_down_interrupts();
767 pw = (struct passwd *)getpwnam(user_name_ext);
768 speed_up_interrupts();
771 /* #### - Stig sez: this should return nil instead
772 * of "unknown" when pw==0 */
773 /* Ben sez: bad idea because it's likely to break something */
774 #ifndef AMPERSAND_FULL_NAME
775 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
778 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
781 tem = ((!NILP(user) && !pw)
783 : make_ext_string((Extbyte *) p, (q ? q - p : (int)strlen(p)),
786 #ifdef AMPERSAND_FULL_NAME
788 p = (char *)XSTRING_DATA(tem);
790 /* Substitute the login name for the &, upcasing the first character. */
793 (char *)alloca(strlen(p) +
794 XSTRING_LENGTH(user_name) + 1);
797 strcat(r, (char *)XSTRING_DATA(user_name));
798 /* #### current_buffer dependency! */
799 r[q - p] = UPCASE(current_buffer, r[q - p]);
801 tem = build_string(r);
804 #endif /* AMPERSAND_FULL_NAME */
809 static Extbyte *cached_home_directory;
811 void uncache_home_directory(void)
813 cached_home_directory = NULL; /* in some cases, this may cause the leaking
817 /* !!#### not Mule correct. */
819 /* Returns the home directory, in external format */
820 Extbyte *get_home_directory(void)
822 /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
823 about what format an external string is in. Could be Unicode, for all
824 we know, and then all the operations below are totally bogus.
825 Instead, convert all data to internal format *right* at the juncture
826 between XEmacs and the outside world, the very moment we first get
828 int output_home_warning = 0;
830 if (cached_home_directory == NULL) {
831 if ((cached_home_directory =
832 (Extbyte *) getenv("HOME")) == NULL) {
835 * Using "/" isn't quite right, but what should we do?
836 * We probably should try to extract pw_dir from /etc/passwd,
837 * before falling back to this.
839 cached_home_directory = (Extbyte *) "/";
840 output_home_warning = 1;
842 if (initialized && output_home_warning) {
843 warn_when_safe(Quser_files_and_directories, Qwarning,
845 " SXEmacs was unable to determine a good value for the user's $HOME\n"
846 " directory, and will be using the value:\n"
848 " This is probably incorrect.",
849 cached_home_directory);
852 return cached_home_directory;
855 DEFUN("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
856 Return the user's home directory, as a string.
860 Extbyte *path = get_home_directory();
862 return path == NULL ? Qnil :
863 Fexpand_file_name(Fsubstitute_in_file_name
864 (build_ext_string((char *)path, Qfile_name)),
868 DEFUN("system-name", Fsystem_name, 0, 0, 0, /*
869 Return the name of the machine you are running on, as a string.
873 return Fcopy_sequence(Vsystem_name);
876 DEFUN("emacs-pid", Femacs_pid, 0, 0, 0, /*
877 Return the process ID of Emacs, as an integer.
881 return make_int(getpid());
884 DEFUN("current-time", Fcurrent_time, 0, 0, 0, /*
885 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
886 The time is returned as a list of three integers. The first has the
887 most significant 16 bits of the seconds, while the second has the
888 least significant 16 bits. The third integer gives the microsecond
891 The microsecond count is zero on systems that do not provide
892 resolution finer than a second.
899 return list3(make_int((EMACS_SECS(t) >> 16) & 0xffff),
900 make_int((EMACS_SECS(t) >> 0) & 0xffff),
901 make_int(EMACS_USECS(t)));
904 #if defined(HAVE_MPZ) && defined(WITH_GMP)
905 DEFUN("current-btime", Fcurrent_btime, 0, 0, 0, /*
906 Return the current time, as the number of microseconds since
908 The time is returned as a big integer.
919 bigz_set_long(btime, EMACS_SECS(t));
920 mpz_mul_ui(btime, btime, 1000000UL);
921 mpz_add_ui(btime, btime, EMACS_USECS(t));
922 result = make_bigz_bz(btime);
928 DEFUN("time-to-btime", Ftime_to_btime, 1, 1, 0, /*
929 Return a big integer from SPECIFIED-TIME with the
930 number of microseconds since the Epoch.
934 if (CONSP(specified_time)) {
937 Lisp_Object high, low, ulow;
941 high = XCAR(specified_time);
942 low = XCDR(specified_time);
955 bigz_set_ulong(bz, (XINT(high) << 16) + (XINT(low) & 0xffff));
956 mpz_mul_ui(bz, bz, 1000000UL);
957 mpz_add_ui(bz, bz, XINT(ulow));
958 result = make_bigz_bz(bz);
962 } else if (BIGZP(specified_time)) {
963 return specified_time;
965 CHECK_CONS(specified_time);
970 DEFUN("btime-to-time", Fbtime_to_time, 1, 1, 0, /*
971 Return a time specified as (HIGH LOW USEC) as obtainable
972 from `current-time' from SPECIFIED-TIME.
976 if (CONSP(specified_time)) {
977 Lisp_Object high, low, ulow;
979 high = XCAR(specified_time);
980 low = XCDR(specified_time);
993 return list3(high, low, ulow);
994 } else if (BIGZP(specified_time)) {
1003 mpz_tdiv_qr_ui(bh, bl, XBIGZ_DATA(specified_time), 1000000UL);
1004 highlow = bigz_to_long(bh);
1005 usecs = bigz_to_long(bl);
1006 result = list3(make_int((highlow >> 16) & 0xffff),
1007 make_int((highlow >> 0) & 0xffff),
1014 CHECK_BIGZ(specified_time);
1018 #endif /* HAVE_MPZ && WITH_MPZ */
1020 DEFUN("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
1021 Return the amount of time used by this SXEmacs process so far.
1022 The return value is a list of three floating-point numbers, expressing
1023 the user, system, and real times used by the process. The user time
1024 measures the time actually spent by the CPU executing the code in this
1025 process. The system time measures time spent by the CPU executing kernel
1026 code on behalf of this process (e.g. I/O requests made by the process).
1028 Note that the user and system times measure processor time, as opposed
1029 to real time, and only accrue when the processor is actually doing
1030 something: Time spent in an idle wait (waiting for user events to come
1031 in or for I/O on a disk drive or other device to complete) does not
1032 count. Thus, the user and system times will often be considerably
1033 less than the real time.
1035 Some systems do not allow the user and system times to be distinguished.
1036 In this case, the user time will be the total processor time used by
1037 the process, and the system time will be 0.
1039 Some systems do not allow the real and processor times to be distinguished.
1040 In this case, the user and real times will be the same and the system
1045 double user, sys, real;
1047 get_process_times(&user, &sys, &real);
1048 return list3(make_float(user), make_float(sys), make_float(real));
1051 DEFUN("uptime", Fuptime, 0, 1, "P", /*
1052 Display SXEmacs \"uptime\".
1054 When called interactively, without a prefix arg, return a list of 4
1055 integers, being the elapsed days, hours, minutes, and seconds that
1056 this SXEmacs process has been running. Display this info prettyfied
1059 With optional prefix arg, USR-SYS-REAL, return a list of 3 floats:
1060 user time, system time, and real time. Also displayed in the echo
1061 area if called interactively. See: `current-process-time' for more
1066 double usr, sys, real;
1067 unsigned int days, hours, minutes, seconds;
1069 days = hours = minutes = seconds = 0;
1070 get_process_times(&usr, &sys, &real);
1072 if (!NILP(usr_sys_real)) {
1073 if (!NILP(Finteractive_p()))
1074 message("User: %0.2f, System: %0.2f, Real: %0.6f\n",
1076 return list3(make_float(usr), make_float(sys), make_float(real));
1078 /* convert the real time to an int (with rounding) */
1079 real = (unsigned long) (real + 0.5);
1081 if (real >= 86400) {
1082 days = real / 86400;
1083 real = real - (days * 86400);
1086 hours = real / 3600;
1087 real = real - (hours * 3600);
1090 minutes = real / 60;
1091 real = real - (minutes * 60);
1095 if (!NILP(Finteractive_p())) {
1097 message("Uptime: %d days, %d hours, %d minutes, %d seconds\n",
1098 days, hours, minutes, seconds);
1100 message("Uptime: %d hours, %d minutes, %d seconds\n",
1101 hours, minutes, seconds);
1102 else if (minutes > 0)
1103 message("Uptime: %d minutes, %d seconds\n",
1105 else if (seconds > 0)
1106 message("Uptime: %d seconds\n", seconds);
1108 return list4(make_int(days), make_int(hours),
1109 make_int(minutes), make_int(seconds));
1113 int lisp_to_time(Lisp_Object specified_time, time_t * result);
1114 int lisp_to_time(Lisp_Object specified_time, time_t * result)
1116 Lisp_Object high, low;
1118 if (NILP(specified_time))
1119 return time(result) != -1;
1121 if (CONSP(specified_time)) {
1122 high = XCAR(specified_time);
1123 low = XCDR(specified_time);
1128 *result = (XINT(high) << 16) + (XINT(low) & 0xffff);
1129 return *result >> 16 == XINT(high);
1130 #if defined HAVE_MPZ && defined WITH_GMP
1131 } else if (BIGZP(specified_time)) {
1134 bigz_set_ulong(bz, 1000000UL);
1135 bigz_div(bz, XBIGZ_DATA(specified_time), bz);
1136 *result = bigz_to_ulong(bz);
1141 CHECK_CONS(specified_time);
1146 Lisp_Object time_to_lisp(time_t the_time);
1147 Lisp_Object time_to_lisp(time_t the_time)
1149 unsigned int item = (unsigned int)the_time;
1150 return Fcons(make_int(item >> 16), make_int(item & 0xffff));
1153 size_t emacs_strftime(char *string, size_t max, const char *format,
1154 const struct tm * tm);
1155 static long difftm(const struct tm *a, const struct tm *b);
1157 DEFUN("format-time-string", Fformat_time_string, 1, 2, 0, /*
1158 Use FORMAT-STRING to format the time TIME.
1159 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1160 `current-time' and `file-attributes'. If TIME is not specified it
1161 defaults to the current time.
1163 If compiled with ENT, TIME may also be a big integer representing
1164 the number of microseconds since the Epoch, as output by
1167 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1168 %a is replaced by the abbreviated name of the day of week.
1169 %A is replaced by the full name of the day of week.
1170 %b is replaced by the abbreviated name of the month.
1171 %B is replaced by the full name of the month.
1172 %c is a synonym for "%x %X".
1173 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1174 %d is replaced by the day of month, zero-padded.
1175 %D is a synonym for "%m/%d/%y".
1176 %e is replaced by the day of month, blank-padded.
1177 %h is a synonym for "%b".
1178 %H is replaced by the hour (00-23).
1179 %I is replaced by the hour (00-12).
1180 %j is replaced by the day of the year (001-366).
1181 %k is replaced by the hour (0-23), blank padded.
1182 %l is replaced by the hour (1-12), blank padded.
1183 %m is replaced by the month (01-12).
1184 %M is replaced by the minute (00-59).
1185 %n is a synonym for "\\n".
1186 %p is replaced by AM or PM, as appropriate.
1187 %r is a synonym for "%I:%M:%S %p".
1188 %R is a synonym for "%H:%M".
1189 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1190 nonstandard extension)
1191 %S is replaced by the second (00-60).
1192 %t is a synonym for "\\t".
1193 %T is a synonym for "%H:%M:%S".
1194 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1195 %w is replaced by the day of week (0-6), Sunday is day 0.
1196 %W is replaced by the week of the year (00-53), first day of week is Monday.
1197 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1198 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1199 %y is replaced by the year without century (00-99).
1200 %Y is replaced by the year with century.
1201 %Z is replaced by the time zone abbreviation.
1203 The number of options reflects the `strftime' function.
1205 BUG: If the charset used by the current locale is not ISO 8859-1, the
1206 characters appearing in the day and month names may be incorrect.
1208 (format_string, time_))
1214 CHECK_STRING(format_string);
1216 if (!lisp_to_time(time_, &value) || !(tm = localtime(&value)))
1217 error("Invalid time specification");
1219 /* This is probably enough. */
1220 size = XSTRING_LENGTH(format_string) * 6 + 50;
1223 char *buf = (char *)alloca(size);
1225 if (emacs_strftime(buf, size,
1226 (const char *)XSTRING_DATA(format_string),
1229 return build_ext_string(buf, Qbinary);
1230 /* If buffer was too small, make it bigger. */
1235 DEFUN("decode-time", Fdecode_time, 0, 1, 0, /*
1236 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1237 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1238 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1239 to use the current time.
1240 If compiled with ENT, SPECIFIED-TIME may also be a big integer as
1241 output from `current-btime', with the number of mircoseconds since
1244 The list has the following nine members:
1245 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1246 only some operating systems support.
1247 MINUTE is an integer between 0 and 59.
1248 HOUR is an integer between 0 and 23.
1249 DAY is an integer between 1 and 31.
1250 MONTH is an integer between 1 and 12.
1251 YEAR is an integer indicating the four-digit year.
1252 DOW is the day of week, an integer between 0 and 6, where 0 is Sunday.
1253 DST is t if daylight savings time is effect, otherwise nil.
1254 ZONE is an integer indicating the number of seconds east of Greenwich.
1255 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1261 struct tm *decoded_time;
1262 Lisp_Object list_args[9];
1264 if (!lisp_to_time(specified_time, &time_spec)
1265 || !(decoded_time = localtime(&time_spec)))
1266 error("Invalid time specification");
1268 list_args[0] = make_int(decoded_time->tm_sec);
1269 list_args[1] = make_int(decoded_time->tm_min);
1270 list_args[2] = make_int(decoded_time->tm_hour);
1271 list_args[3] = make_int(decoded_time->tm_mday);
1272 list_args[4] = make_int(decoded_time->tm_mon + 1);
1273 list_args[5] = make_int(decoded_time->tm_year + 1900);
1274 list_args[6] = make_int(decoded_time->tm_wday);
1275 list_args[7] = (decoded_time->tm_isdst) ? Qt : Qnil;
1277 /* Make a copy, in case gmtime modifies the struct. */
1278 save_tm = *decoded_time;
1279 decoded_time = gmtime(&time_spec);
1280 if (decoded_time == 0)
1281 list_args[8] = Qnil;
1283 list_args[8] = make_int(difftm(&save_tm, decoded_time));
1284 return Flist(9, list_args);
1287 static void set_time_zone_rule(char *tzstring);
1289 /* from GNU Emacs 21, per Simon Josefsson, modified by stephen
1290 The slight inefficiency is justified since negative times are weird. */
1291 Lisp_Object make_time(time_t tval)
1293 return list2(make_int(tval < 0 ? tval / 0x10000 : tval >> 16),
1294 make_int(tval & 0xFFFF));
1297 DEFUN("encode-time", Fencode_time, 6, MANY, 0, /*
1298 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1299 This is the reverse operation of `decode-time', which see.
1300 ZONE defaults to the current time zone rule. This can
1301 be a string (as from `set-time-zone-rule'), or it can be a list
1302 \(as from `current-time-zone') or an integer (as from `decode-time')
1303 applied without consideration for daylight savings time.
1305 You can pass more than 7 arguments; then the first six arguments
1306 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1307 The intervening arguments are ignored.
1308 This feature lets (apply 'encode-time (decode-time ...)) work.
1310 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1311 for example, a DAY of 0 means the day preceding the given month.
1312 Year numbers less than 100 are treated just like other year numbers.
1313 If you want them to stand for years in this century, you must do that yourself.
1315 (int nargs, Lisp_Object * args))
1319 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1322 tm.tm_sec = XINT(*args++); /* second */
1324 tm.tm_min = XINT(*args++); /* minute */
1326 tm.tm_hour = XINT(*args++); /* hour */
1328 tm.tm_mday = XINT(*args++); /* day */
1330 tm.tm_mon = XINT(*args++) - 1; /* month */
1332 tm.tm_year = XINT(*args++) - 1900; /* year */
1340 the_time = mktime(&tm);
1344 char **oldenv = environ, **newenv;
1346 if (STRINGP(zone)) {
1347 tzstring = (char *)XSTRING_DATA(zone);
1348 } else if (INTP(zone)) {
1349 int abszone = abs(XINT(zone));
1350 snprintf(tzbuf, countof(tzbuf) - 1, "XXX%s%d:%02d:%02d",
1351 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1352 (abszone / 60) % 60, abszone % 60);
1355 error("Invalid time zone specification");
1358 /* Set TZ before calling mktime; merely adjusting mktime's
1359 returned value doesn't suffice, since that would mishandle
1361 set_time_zone_rule(tzstring);
1363 the_time = mktime(&tm);
1365 /* Restore TZ to previous value. */
1368 #if !defined EF_USE_BDWGC
1370 #endif /* !EF_USE_BDWGC */
1371 #ifdef LOCALTIME_CACHE
1376 if (the_time == (time_t) - 1) {
1377 error("Specified time is not representable");
1380 return make_time(the_time);
1383 #if defined(HAVE_MPZ) && defined WITH_GMP
1384 DEFUN("encode-btime", Fencode_btime, 6, MANY, 0, /*
1385 Like `encode-time' but return a big integer time instead.
1388 (int nargs, Lisp_Object * args))
1392 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1397 tm.tm_sec = XINT(*args++); /* second */
1399 tm.tm_min = XINT(*args++); /* minute */
1401 tm.tm_hour = XINT(*args++); /* hour */
1403 tm.tm_mday = XINT(*args++); /* day */
1405 tm.tm_mon = XINT(*args++) - 1; /* month */
1407 tm.tm_year = XINT(*args++) - 1900; /* year */
1414 the_time = mktime(&tm);
1418 char **oldenv = environ, **newenv;
1421 tzstring = (char *)XSTRING_DATA(zone);
1422 else if (INTP(zone)) {
1423 int abszone = abs(XINT(zone));
1424 sprintf(tzbuf, "XXX%s%d:%02d:%02d",
1425 "-" + (XINT(zone) < 0), abszone / (60 * 60),
1426 (abszone / 60) % 60, abszone % 60);
1429 error("Invalid time zone specification");
1431 /* Set TZ before calling mktime; merely adjusting mktime's returned
1432 value doesn't suffice, since that would mishandle leap seconds. */
1433 set_time_zone_rule(tzstring);
1435 the_time = mktime(&tm);
1437 /* Restore TZ to previous value. */
1441 #ifdef LOCALTIME_CACHE
1446 if (the_time == (time_t) - 1)
1447 error("Specified time is not representable");
1450 bigz_set_ulong(bz, the_time);
1451 mpz_mul_ui(bz, bz, 1000000UL);
1452 result = make_bigz_bz(bz);
1459 DEFUN("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1460 Return the current time, as a human-readable string.
1461 Programs can use this function to decode a time,
1462 since the number of columns in each field is fixed.
1463 The format is `Sun Sep 16 01:03:52 1973'.
1464 If an argument is given, it specifies a time to format
1465 instead of the current time. The argument should have the form:
1468 (HIGH LOW . IGNORED).
1469 Thus, you can use times obtained from `current-time'
1470 and from `file-attributes'.
1472 If compiled with ENT, SPECIFIED-TIME may also be a big integer
1473 as obtained from `current-btime' with the number of microseconds
1482 if (!lisp_to_time(specified_time, &value))
1484 the_ctime = ctime(&value);
1486 /* ctime is documented as always returning a "\n\0"-terminated
1487 26-byte American time string, but let's be careful anyways. */
1488 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++) ;
1490 return make_ext_string((Extbyte *) the_ctime, len, Qbinary);
1493 #define TM_YEAR_ORIGIN 1900
1495 /* Yield A - B, measured in seconds. */
1496 static long difftm(const struct tm *a, const struct tm *b)
1498 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1499 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1500 /* Some compilers can't handle this as a single return statement. */
1502 /* difference in day of year */
1503 a->tm_yday - b->tm_yday
1504 /* + intervening leap days */
1505 + ((ay >> 2) - (by >> 2))
1506 - (ay / 100 - by / 100)
1507 + ((ay / 100 >> 2) - (by / 100 >> 2))
1508 /* + difference in years * 365 */
1509 + (long)(ay - by) * 365);
1510 return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
1511 + (a->tm_min - b->tm_min))
1512 + (a->tm_sec - b->tm_sec));
1515 DEFUN("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1516 Return the offset and name for the local time zone.
1517 This returns a list of the form (OFFSET NAME).
1518 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1519 A negative value means west of Greenwich.
1520 NAME is a string giving the name of the time zone.
1521 If an argument is given, it specifies when the time zone offset is determined
1522 instead of using the current time. The argument should have the form:
1525 (HIGH LOW . IGNORED).
1526 Thus, you can use times obtained from `current-time'
1527 and from `file-attributes'.
1529 Some operating systems cannot provide all this information to Emacs;
1530 in this case, `current-time-zone' returns a list containing nil for
1531 the data it can't find.
1536 struct tm *t = NULL;
1538 if (lisp_to_time(specified_time, &value)
1539 && (t = gmtime(&value)) != 0) {
1540 /* Make a copy, in case localtime modifies *t. */
1546 t = localtime(&value);
1547 offset = difftm(t, &gmt);
1551 s = (const char *)t->tm_zone;
1552 #else /* not HAVE_TM_ZONE */
1554 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1555 s = tzname[t->tm_isdst];
1557 #endif /* not HAVE_TM_ZONE */
1559 /* No local time zone name is available; use "+-NNNN"
1561 int am = (offset < 0 ? -offset : offset) / 60;
1562 sprintf(buf, "%c%02d%02d", (offset < 0 ? '-' : '+'),
1566 return list2(make_int(offset), build_string(s));
1568 return list2(Qnil, Qnil);
1572 #ifdef LOCALTIME_CACHE
1574 /* These two values are known to load tz files in buggy implementations,
1575 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1576 Their values shouldn't matter in non-buggy implementations.
1577 We don't use string literals for these strings,
1578 since if a string in the environment is in readonly
1579 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1580 See Sun bugs 1113095 and 1114114, ``Timezone routines
1581 improperly modify environment''. */
1583 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1584 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1588 /* Set the local time zone rule to TZSTRING.
1589 This allocates memory into `environ', which it is the caller's
1590 responsibility to free. */
1591 static void set_time_zone_rule(char *tzstring)
1594 char **from, **to, **newenv;
1596 for (from = environ; *from; from++)
1598 envptrs = from - environ + 2;
1599 newenv = to = (char **)xmalloc(envptrs * sizeof(char *)
1600 + (tzstring ? strlen(tzstring) + 4 : 0));
1602 char *t = (char *)(to + envptrs);
1604 strcat(t, tzstring);
1608 for (from = environ; *from; from++)
1609 if (strncmp(*from, "TZ=", 3) != 0)
1615 #ifdef LOCALTIME_CACHE
1617 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1618 "US/Pacific" that loads a tz file, then changes to a value like
1619 "XXX0" that does not load a tz file, and then changes back to
1620 its original value, the last change is (incorrectly) ignored.
1621 Also, if TZ changes twice in succession to values that do
1622 not load a tz file, tzset can dump core (see Sun bug#1225179).
1623 The following code works around these bugs. */
1626 /* Temporarily set TZ to a value that loads a tz file
1627 and that differs from tzstring. */
1630 (strcmp(tzstring, set_time_zone_rule_tz1 + 3) ==
1631 0 ? set_time_zone_rule_tz2 :
1632 set_time_zone_rule_tz1);
1636 /* The implied tzstring is unknown, so temporarily set TZ to
1637 two different values that each load a tz file. */
1638 *to = set_time_zone_rule_tz1;
1641 *to = set_time_zone_rule_tz2;
1646 /* Now TZ has the desired value, and tzset can be invoked safely. */
1653 DEFUN("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1654 Set the local time zone using TZ, a string specifying a time zone rule.
1655 If TZ is nil, use implementation-defined default time zone information.
1665 tzstring = (char *)XSTRING_DATA(tz);
1668 set_time_zone_rule(tzstring);
1671 environbuf = environ;
1676 void buffer_insert1(struct buffer *buf, Lisp_Object arg)
1678 /* This function can GC */
1679 struct gcpro gcpro1;
1682 if (CHAR_OR_CHAR_INTP(arg)) {
1683 buffer_insert_emacs_char(buf, XCHAR_OR_CHAR_INT(arg));
1684 } else if (STRINGP(arg)) {
1685 buffer_insert_lisp_string(buf, arg);
1687 arg = wrong_type_argument(Qchar_or_string_p, arg);
1693 /* Callers passing one argument to Finsert need not gcpro the
1694 argument "array", since the only element of the array will
1695 not be used after calling insert_emacs_char or insert_lisp_string,
1696 so we don't care if it gets trashed. */
1698 DEFUN("insert", Finsert, 0, MANY, 0, /*
1699 Insert the arguments, either strings or characters, at point.
1700 Point moves forward so that it ends up after the inserted text.
1701 Any other markers at the point of insertion remain before the text.
1702 If a string has non-null string-extent-data, new extents will be created.
1704 (int nargs, Lisp_Object * args))
1706 /* This function can GC */
1707 REGISTER int argnum;
1709 for (argnum = 0; argnum < nargs; argnum++) {
1710 buffer_insert1(current_buffer, args[argnum]);
1716 DEFUN("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1717 Insert strings or characters at point, relocating markers after the text.
1718 Point moves forward so that it ends up after the inserted text.
1719 Any other markers at the point of insertion also end up after the text.
1721 (int nargs, Lisp_Object * args))
1723 /* This function can GC */
1724 REGISTER int argnum;
1725 REGISTER Lisp_Object tem;
1727 for (argnum = 0; argnum < nargs; argnum++) {
1730 if (CHAR_OR_CHAR_INTP(tem)) {
1731 buffer_insert_emacs_char_1(current_buffer, -1,
1732 XCHAR_OR_CHAR_INT(tem),
1733 INSDEL_BEFORE_MARKERS);
1734 } else if (STRINGP(tem)) {
1735 buffer_insert_lisp_string_1(current_buffer, -1, tem,
1736 INSDEL_BEFORE_MARKERS);
1738 tem = wrong_type_argument(Qchar_or_string_p, tem);
1745 DEFUN("insert-string", Finsert_string, 1, 2, 0, /*
1746 Insert STRING into BUFFER at BUFFER's point.
1747 Point moves forward so that it ends up after the inserted text.
1748 Any other markers at the point of insertion remain before the text.
1749 If a string has non-null string-extent-data, new extents will be created.
1750 BUFFER defaults to the current buffer.
1754 struct buffer *b = decode_buffer(buffer, 1);
1755 CHECK_STRING(string);
1756 buffer_insert_lisp_string(b, string);
1760 /* Third argument in FSF is INHERIT:
1762 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1763 from adjoining text, if those properties are sticky."
1765 Jamie thinks this is bogus. */
1767 DEFUN("insert-char", Finsert_char, 1, 4, 0, /*
1768 Insert COUNT copies of CHARACTER into BUFFER.
1769 Point and all markers are affected as in the function `insert'.
1770 COUNT defaults to 1 if omitted.
1771 The optional third arg IGNORED is INHERIT under FSF Emacs.
1772 This is highly bogus, however, and SXEmacs always behaves as if
1773 `t' were passed to INHERIT.
1774 The optional fourth arg BUFFER specifies the buffer to insert the
1775 text into. If BUFFER is nil, the current buffer is assumed.
1777 (character, count, ignored, buffer))
1779 /* This function can GC */
1780 REGISTER Bufbyte *string;
1783 REGISTER Bytecount n;
1784 REGISTER Bytecount charlen;
1785 Bufbyte str[MAX_EMCHAR_LEN];
1786 struct buffer *b = decode_buffer(buffer, 1);
1789 CHECK_CHAR_COERCE_INT(character);
1797 charlen = set_charptr_emchar(str, XCHAR(character));
1802 string = alloca_array(Bufbyte, slen);
1803 /* Write as many copies of the character into the temp string as will fit. */
1804 for (i = 0; i + charlen <= slen; i += charlen)
1805 for (j = 0; j < charlen; j++)
1806 string[i + j] = str[j];
1809 buffer_insert_raw_string(b, string, slen);
1813 #if 0 /* FSFmacs bogosity */
1816 insert_and_inherit(string, n);
1821 buffer_insert_raw_string(b, string, n);
1827 /* Making strings from buffer contents. */
1829 DEFUN("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1830 Return the contents of part of BUFFER as a string.
1831 The two arguments START and END are character positions;
1832 they can be in either order. If omitted, they default to the beginning
1833 and end of BUFFER, respectively.
1834 If there are duplicable extents in the region, the string remembers
1835 them in its extent data.
1836 If BUFFER is nil, the current buffer is assumed.
1838 (start, end, buffer))
1840 /* This function can GC */
1842 struct buffer *b = decode_buffer(buffer, 1);
1844 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1845 return make_string_from_buffer(b, begv, zv - begv);
1848 /* It might make more sense to name this
1849 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1850 and what the function does is probably good enough for what the
1851 user-code will typically want to use it for. */
1852 DEFUN("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1853 Return the text from START to END as a string, without copying the extents.
1855 (start, end, buffer))
1857 /* This function can GC */
1859 struct buffer *b = decode_buffer(buffer, 1);
1861 get_buffer_range_char(b, start, end, &begv, &zv, GB_ALLOW_NIL);
1862 return make_string_from_buffer_no_extents(b, begv, zv - begv);
1865 DEFUN("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1866 Insert before point a substring of the contents of buffer BUFFER.
1867 BUFFER may be a buffer or a buffer name.
1868 Arguments START and END are character numbers specifying the substring.
1869 They default to the beginning and the end of BUFFER.
1871 (buffer, start, end))
1873 /* This function can GC */
1876 Lisp_Object tmp_buf = emacs_get_buffer(buffer, 1);
1878 bp = XBUFFER(tmp_buf);
1879 get_buffer_range_char(bp, start, end, &b, &e, GB_ALLOW_NIL);
1882 buffer_insert_from_buffer(current_buffer, bp, b, e - b);
1887 DEFUN("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1888 Compare two substrings of two buffers; return result as number.
1889 the value is -N if first string is less after N-1 chars,
1890 +N if first string is greater after N-1 chars, or 0 if strings match.
1891 Each substring is represented as three arguments: BUFFER, START and END.
1892 That makes six args in all, three for each substring.
1894 The value of `case-fold-search' in the current buffer
1895 determines whether case is significant or ignored.
1897 (buffer1, start1, end1, buffer2, start2, end2))
1899 Bufpos begp1, endp1, begp2, endp2;
1900 REGISTER Charcount len1, len2, length, i;
1901 struct buffer *bp1, *bp2;
1902 Lisp_Object trt = ((!NILP(current_buffer->case_fold_search)) ?
1903 XCASE_TABLE_CANON(current_buffer->
1904 case_table) : Qnil);
1906 /* Find the first buffer and its substring. */
1908 bp1 = decode_buffer(buffer1, 1);
1909 get_buffer_range_char(bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1911 /* Likewise for second substring. */
1913 bp2 = decode_buffer(buffer2, 1);
1914 get_buffer_range_char(bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1916 len1 = endp1 - begp1;
1917 len2 = endp2 - begp2;
1922 for (i = 0; i < length; i++) {
1923 Emchar c1 = BUF_FETCH_CHAR(bp1, begp1 + i);
1924 Emchar c2 = BUF_FETCH_CHAR(bp2, begp2 + i);
1926 c1 = TRT_TABLE_OF(trt, c1);
1927 c2 = TRT_TABLE_OF(trt, c2);
1930 return make_int(-1 - i);
1932 return make_int(i + 1);
1935 /* The strings match as far as they go.
1936 If one is shorter, that one is less. */
1938 return make_int(length + 1);
1939 else if (length < len2)
1940 return make_int(-length - 1);
1942 /* Same length too => they are equal. */
1946 static Lisp_Object subst_char_in_region_unwind(Lisp_Object arg)
1948 XBUFFER(XCAR(arg))->undo_list = XCDR(arg);
1952 static Lisp_Object subst_char_in_region_unwind_1(Lisp_Object arg)
1954 XBUFFER(XCAR(arg))->filename = XCDR(arg);
1958 DEFUN("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1959 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1960 If optional arg NOUNDO is non-nil, don't record this change for undo
1961 and don't mark the buffer as really changed.
1963 (start, end, fromchar, tochar, noundo))
1965 /* This function can GC */
1969 struct buffer *buf = current_buffer;
1970 int count = specpdl_depth();
1972 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
1973 CHECK_CHAR_COERCE_INT(fromchar);
1974 CHECK_CHAR_COERCE_INT(tochar);
1976 fromc = XCHAR(fromchar);
1977 toc = XCHAR(tochar);
1979 /* If we don't want undo, turn off putting stuff on the list.
1980 That's faster than getting rid of things,
1981 and it prevents even the entry for a first change.
1982 Also inhibit locking the file. */
1983 if (!NILP(noundo)) {
1984 record_unwind_protect(subst_char_in_region_unwind,
1985 Fcons(Fcurrent_buffer(), buf->undo_list));
1986 buf->undo_list = Qt;
1987 /* Don't do file-locking. */
1988 record_unwind_protect(subst_char_in_region_unwind_1,
1989 Fcons(Fcurrent_buffer(), buf->filename));
1990 buf->filename = Qnil;
1993 mc_count = begin_multiple_change(buf, pos, stop);
1994 while (pos < stop) {
1995 if (BUF_FETCH_CHAR(buf, pos) == fromc) {
1996 /* There used to be some code here that set the buffer to
1997 unmodified if NOUNDO was specified and there was only
1998 one change to the buffer since it was last saved.
1999 This is a crock of shit, so I'm not duplicating this
2000 behavior. I think this was left over from when
2001 prepare_to_modify_buffer() actually bumped MODIFF,
2002 so that code was supposed to undo this change. --ben */
2003 buffer_replace_char(buf, pos, toc, !NILP(noundo), 0);
2005 /* If noundo is not nil then we don't mark the buffer as
2006 modified. In reality that needs to happen externally
2007 only. Internally redisplay needs to know that the actual
2008 contents it should be displaying have changed. */
2010 Fset_buffer_modified_p(Fbuffer_modified_p(Qnil),
2015 end_multiple_change(buf, mc_count);
2017 unbind_to(count, Qnil);
2021 /* #### Shouldn't this also accept a BUFFER argument, in the good old
2022 XEmacs tradition? */
2023 DEFUN("translate-region", Ftranslate_region, 3, 3, 0, /*
2024 Translate characters from START to END according to TABLE.
2026 If TABLE is a string, the Nth character in it is the mapping for the
2027 character with code N.
2029 If TABLE is a vector, its Nth element is the mapping for character
2030 with code N. The values of elements may be characters, strings, or
2031 nil (nil meaning don't replace.)
2033 If TABLE is a char-table, its elements describe the mapping between
2034 characters and their replacements. The char-table should be of type
2035 `char' or `generic'.
2037 Returns the number of substitutions performed.
2039 (start, end, table))
2041 /* This function can GC */
2042 Bufpos pos, stop; /* Limits of the region. */
2043 int cnt = 0; /* Number of changes made. */
2045 struct buffer *buf = current_buffer;
2048 get_buffer_range_char(buf, start, end, &pos, &stop, 0);
2049 mc_count = begin_multiple_change(buf, pos, stop);
2050 if (STRINGP(table)) {
2051 Lisp_String *stable = XSTRING(table);
2052 Charcount size = string_char_length(stable);
2054 /* Under Mule, string_char(n) is O(n), so for large tables or
2055 large regions it makes sense to create an array of Emchars. */
2056 if (size * (stop - pos) > 65536) {
2057 Emchar *etable = alloca_array(Emchar, size);
2058 convert_bufbyte_string_into_emchar_string
2059 (string_data(stable), string_length(stable),
2061 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2064 Emchar nc = etable[oc];
2066 buffer_replace_char(buf, pos,
2075 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1);
2078 Emchar nc = string_char(stable, oc);
2080 buffer_replace_char(buf, pos,
2087 } else if (VECTORP(table)) {
2088 Charcount size = XVECTOR_LENGTH(table);
2089 Lisp_Object *vtable = XVECTOR_DATA(table);
2091 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2093 Lisp_Object replacement = vtable[oc];
2095 if (CHAR_OR_CHAR_INTP(replacement)) {
2097 XCHAR_OR_CHAR_INT(replacement);
2099 buffer_replace_char(buf, pos,
2103 } else if (STRINGP(replacement)) {
2105 XSTRING_CHAR_LENGTH(replacement) -
2107 buffer_delete_range(buf, pos, pos + 1,
2109 buffer_insert_lisp_string_1(buf, pos,
2112 pos += incr, stop += incr;
2114 } else if (!NILP(replacement)) {
2117 (Qchar_or_string_p, replacement);
2122 } else if (CHAR_TABLEP(table)
2123 && (XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_GENERIC
2124 || XCHAR_TABLE_TYPE(table) == CHAR_TABLE_TYPE_CHAR)) {
2125 Lisp_Char_Table *ctable = XCHAR_TABLE(table);
2127 for (; pos < stop && (oc = BUF_FETCH_CHAR(buf, pos), 1); pos++) {
2128 Lisp_Object replacement = get_char_table(oc, ctable);
2130 if (CHAR_OR_CHAR_INTP(replacement)) {
2131 Emchar nc = XCHAR_OR_CHAR_INT(replacement);
2133 buffer_replace_char(buf, pos, nc, 0, 0);
2136 } else if (STRINGP(replacement)) {
2138 XSTRING_CHAR_LENGTH(replacement) - 1;
2139 buffer_delete_range(buf, pos, pos + 1, 0);
2140 buffer_insert_lisp_string_1(buf, pos,
2142 pos += incr, stop += incr;
2144 } else if (!NILP(replacement)) {
2146 wrong_type_argument(Qchar_or_string_p,
2152 dead_wrong_type_argument(Qstringp, table);
2153 end_multiple_change(buf, mc_count);
2155 return make_int(cnt);
2158 DEFUN("delete-region", Fdelete_region, 2, 3, "r", /*
2159 Delete the text between point and mark.
2160 When called from a program, expects two arguments START and END
2161 \(integers or markers) specifying the stretch to be deleted.
2162 If optional third arg BUFFER is nil, the current buffer is assumed.
2164 (start, end, buffer))
2166 /* This function can GC */
2167 Bufpos bp_start, bp_end;
2168 struct buffer *buf = decode_buffer(buffer, 1);
2170 get_buffer_range_char(buf, start, end, &bp_start, &bp_end, 0);
2171 buffer_delete_range(buf, bp_start, bp_end, 0);
2175 void widen_buffer(struct buffer *b, int no_clip)
2177 if (BUF_BEGV(b) != BUF_BEG(b)) {
2179 SET_BOTH_BUF_BEGV(b, BUF_BEG(b), BI_BUF_BEG(b));
2181 if (BUF_ZV(b) != BUF_Z(b)) {
2183 SET_BOTH_BUF_ZV(b, BUF_Z(b), BI_BUF_Z(b));
2188 /* Changing the buffer bounds invalidates any recorded current
2190 invalidate_current_column();
2191 narrow_line_number_cache(b);
2195 DEFUN("widen", Fwiden, 0, 1, "", /*
2196 Remove restrictions (narrowing) from BUFFER.
2197 This allows the buffer's full text to be seen and edited.
2198 If BUFFER is nil, the current buffer is assumed.
2202 struct buffer *b = decode_buffer(buffer, 1);
2207 DEFUN("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2208 Restrict editing in BUFFER to the current region.
2209 The rest of the text becomes temporarily invisible and untouchable
2210 but is not deleted; if you save the buffer in a file, the invisible
2211 text is included in the file. \\[widen] makes all visible again.
2212 If BUFFER is nil, the current buffer is assumed.
2213 See also `save-restriction'.
2215 When calling from a program, pass two arguments; positions (integers
2216 or markers) bounding the text that should remain visible.
2218 (start, end, buffer))
2220 Bufpos bp_start, bp_end;
2221 struct buffer *buf = decode_buffer(buffer, 1);
2222 Bytind bi_start, bi_end;
2224 get_buffer_range_char(buf, start, end, &bp_start, &bp_end,
2225 GB_ALLOW_PAST_ACCESSIBLE);
2226 bi_start = bufpos_to_bytind(buf, bp_start);
2227 bi_end = bufpos_to_bytind(buf, bp_end);
2229 SET_BOTH_BUF_BEGV(buf, bp_start, bi_start);
2230 SET_BOTH_BUF_ZV(buf, bp_end, bi_end);
2231 if (BUF_PT(buf) < bp_start)
2232 BUF_SET_PT(buf, bp_start);
2233 if (BUF_PT(buf) > bp_end)
2234 BUF_SET_PT(buf, bp_end);
2236 /* Changing the buffer bounds invalidates any recorded current column. */
2237 invalidate_current_column();
2238 narrow_line_number_cache(buf);
2242 Lisp_Object save_restriction_save(void)
2244 Lisp_Object bottom, top;
2245 /* Note: I tried using markers here, but it does not win
2246 because insertion at the end of the saved region
2247 does not advance mh and is considered "outside" the saved region. */
2248 bottom = make_int(BUF_BEGV(current_buffer) - BUF_BEG(current_buffer));
2249 top = make_int(BUF_Z(current_buffer) - BUF_ZV(current_buffer));
2251 return noseeum_cons(Fcurrent_buffer(), noseeum_cons(bottom, top));
2254 Lisp_Object save_restriction_restore(Lisp_Object data)
2257 Charcount newhead, newtail;
2259 int local_clip_changed = 0;
2261 buf = XBUFFER(XCAR(data));
2262 if (!BUFFER_LIVE_P(buf)) {
2263 /* someone could have killed the buffer in the meantime ... */
2264 free_cons(XCONS(XCDR(data)));
2265 free_cons(XCONS(data));
2269 newhead = XINT(XCAR(tem));
2270 newtail = XINT(XCDR(tem));
2272 free_cons(XCONS(XCDR(data)));
2273 free_cons(XCONS(data));
2275 if (newhead + newtail > BUF_Z(buf) - BUF_BEG(buf)) {
2282 Bytind bi_start, bi_end;
2284 start = BUF_BEG(buf) + newhead;
2285 end = BUF_Z(buf) - newtail;
2287 bi_start = bufpos_to_bytind(buf, start);
2288 bi_end = bufpos_to_bytind(buf, end);
2290 if (BUF_BEGV(buf) != start) {
2291 local_clip_changed = 1;
2292 SET_BOTH_BUF_BEGV(buf, start, bi_start);
2293 narrow_line_number_cache(buf);
2295 if (BUF_ZV(buf) != end) {
2296 local_clip_changed = 1;
2297 SET_BOTH_BUF_ZV(buf, end, bi_end);
2300 if (local_clip_changed)
2303 /* If point is outside the new visible range, move it inside. */
2305 bufpos_clip_to_bounds(BUF_BEGV(buf),
2306 BUF_PT(buf), BUF_ZV(buf)));
2311 DEFUN("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2312 Execute BODY, saving and restoring current buffer's restrictions.
2313 The buffer's restrictions make parts of the beginning and end invisible.
2314 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2315 This special form, `save-restriction', saves the current buffer's restrictions
2316 when it is entered, and restores them when it is exited.
2317 So any `narrow-to-region' within BODY lasts only until the end of the form.
2318 The old restrictions settings are restored
2319 even in case of abnormal exit (throw or error).
2321 The value returned is the value of the last form in BODY.
2323 `save-restriction' can get confused if, within the BODY, you widen
2324 and then make changes outside the area within the saved restrictions.
2326 Note: if you are using both `save-excursion' and `save-restriction',
2327 use `save-excursion' outermost:
2328 (save-excursion (save-restriction ...))
2332 /* This function can GC */
2333 int speccount = specpdl_depth();
2335 record_unwind_protect(save_restriction_restore,
2336 save_restriction_save());
2338 return unbind_to(speccount, Fprogn(body));
2341 DEFUN("format", Fformat, 1, MANY, 0, /*
2342 Return a formatted string out of a format string and arguments.
2344 Arguments: string &rest objects
2346 Hereby, STRING is the format string (also known as template) which
2347 consists of constant (immutable) portions and so called format
2348 specifiers (%-specs). For details on these see below.
2350 The remaining arguments, OBJECTS, are substituted into the format
2351 string to make the result, a string. The exact influence of OBJECTS
2352 on the final result is described below. In general, OBJECTS will be
2353 the lisp objects to be printed.
2357 The format string STRING is basically an ordinary string enriched with
2358 %-sequences (also known as specifiers or specs for short). The specs
2359 in STRING will be substituted for the according object in OBJECTS, to
2360 be precise with a string representation of the object. In the simplest
2361 case, the first specifier in STRING corresponds to the first element
2362 in OBJECTS, the second specifier corresponds to the second element, and
2365 The specifiers themselves look like
2366 %[r$][#][&][ ][+][~][0][-]['][!a][m][.p|*]{sSdioxXbucfeEgGZQFRBC}
2370 %s means print all objects as-is, using `princ'.
2371 %S means print all objects as s-expressions, using `prin1'.
2374 %d means print as an integer in decimal
2375 %i means print as an integer in decimal
2376 %o means print as an integer in octal
2377 %x means print as an integer in lowercase hex
2378 %X means print as an integer in uppercase hex
2379 %b means print as an integer in binary
2380 %u means print a non-negative integer.
2381 %c means print as a single character.
2384 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2385 %e or %E means print as a floating-point number in scientific notation
2387 %g or %G means print as a floating-point number in "pretty format";
2388 depending on the number, either %f or %e/%E format will be used, and
2389 trailing zeroes are removed from the fractional part.
2390 The argument used for all but %s and %S must be a number. It will be
2391 converted to an integer or a floating-point number as necessary.
2392 Please bear in mind that floating point numbers have a limited and fixed
2393 precision although the print output may suggest something else.
2394 The precision varies (depending on the machine) between 12 and 38 digits.
2395 This means if you use specifiers like %.60f on 1.0 or 1.5 only the first
2396 12 to 38 digits are real. Also note, that internally numbers are processed
2397 in a 2-adic arithmetic, so you may experience strange rounding effects,
2398 e.g. %.60f on 1.2 or %f on 1e+40, this is because you force the printer to
2399 be more precise than actually valid. No error is thrown in these cases!
2401 If SXEmacs was compiled with GMP support the following additional
2402 specifiers become available:
2403 %Z means print as big integer (convert to bigz)
2404 %Q means print as fraction (convert to bigq)
2405 %F means print as bigfr or bigf float (convert to in that order)
2406 this specifier always converts the argument, regardless the
2407 value of `read-real-as'
2408 %R means print as real number (convert to bigfr, bigf or float)
2409 this specifier respects the value of `read-real-as'
2410 %B means print as Gaussian number (convert to bigg)
2411 %C means print as complex number (convert to bigc)
2413 Both %B and %C are actually rewrites to %Z%+Z and %F%+F with the
2414 argument rewritten to (real-part arg) (imaginary-part arg).
2415 Flags are passed on to at least the real part specifier.
2419 Using above notation there are several tweaks, so called modifiers,
2420 to fine-tune the substitution. Modifiers are completely optional.
2423 r$ use the `r'-th element of OBJECTS instead the one in order
2424 # print 0x, 0o, 0b prefix for numbers in a different base
2425 & use lisp syntax for base!=10 numbers, as in #x73, implies ~
2426 if non-negative print a place holder ` ' for a sign, `-' otherwise
2427 + always print a sign, `-' if negative and `+' if non-negative
2428 ~ in conjunction with `#' and signed numbers print sign after 0[xob]
2429 0 pad numbers (only on the left) with zeroes instead of spaces
2431 ' group numbers in groups of three
2432 !a use `a' as pad character instead of space
2433 m specify a minimum width of the yielded string
2434 .p use `p' digits of precision, depends on the specifer
2435 * use the argument in order to obtain the precision
2437 %$ means reposition to read a specific numbered argument; for example,
2438 %3$s would apply the `%s' to the third argument after the control string,
2439 and the next format directive would use the fourth argument, the
2440 following one the fifth argument, etc. (There must be a positive integer
2441 between the % and the $).
2443 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2444 specified between the optional repositioning spec and the conversion
2445 character; see below.
2447 An optional minimum field width may be specified after any flag characters
2448 and before the conversion character; it specifies the minimum number of
2449 characters that the converted argument will take up. Padding will be
2450 added on the left (or on the right, if the `-' flag is specified), as
2451 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2454 If the field width is specified as `*', the field width is assumed to have
2455 been specified as an argument. Any repositioning specification that
2456 would normally specify the argument to be converted will now specify
2457 where to find this field width argument, not where to find the argument
2458 to be converted. If there is no repositioning specification, the normal
2459 next argument is used. The argument to be converted will be the next
2460 argument after the field width argument unless the precision is also
2461 specified as `*' (see below).
2463 An optional period character and precision may be specified after any
2464 minimum field width. It specifies the minimum number of digits to
2465 appear in %d, %i, %b, %o, %x, and %X conversions (the number is padded
2466 on the left with zeroes as necessary); the number of digits printed
2467 after the decimal point for %f, %e, and %E conversions; the number
2468 of significant digits printed in %g and %G conversions; and the
2469 maximum number of non-padding characters printed in %s and %S
2470 conversions. The default precision for floating-point conversions
2473 If the precision is specified as `*', the precision is assumed to have been
2474 specified as an argument. The argument used will be the next argument
2475 after the field width argument, if any. If the field width was not
2476 specified as an argument, any repositioning specification that would
2477 normally specify the argument to be converted will now specify where to
2478 find the precision argument. If there is no repositioning specification,
2479 the normal next argument is used.
2481 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2482 plus sign, respectively.
2484 The `#' flag means print numbers in an alternate, more verbose format:
2485 octal numbers begin with 0o; hex numbers begin with a 0x or 0X;
2486 and binary representations start with 0b;
2487 a decimal point is printed in %f, %e, and %E conversions even if no
2488 numbers are printed after it; and trailing zeroes are not omitted in
2489 %g and %G conversions.
2491 Use %% to put a single % into the output.
2493 (int nargs, Lisp_Object * args))
2495 /* It should not be necessary to GCPRO ARGS, because
2496 the caller in the interpreter should take care of that. */
2498 CHECK_STRING(args[0]);
2499 return emacs_doprnt_string_lisp(0, args[0], 0, nargs - 1, args + 1);
2502 DEFUN("char-equal", Fchar_equal, 2, 3, 0, /*
2503 Return t if two characters match, optionally ignoring case.
2504 Both arguments must be characters (i.e. NOT integers).
2505 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2506 If BUFFER is nil, the current buffer is assumed.
2508 (character1, character2, buffer))
2511 struct buffer *b = decode_buffer(buffer, 1);
2513 CHECK_CHAR_COERCE_INT(character1);
2514 CHECK_CHAR_COERCE_INT(character2);
2515 x1 = XCHAR(character1);
2516 x2 = XCHAR(character2);
2518 return (!NILP(b->case_fold_search)
2519 ? DOWNCASE(b, x1) == DOWNCASE(b, x2)
2524 DEFUN("char=", Fchar_Equal, 2, 2, 0, /*
2525 Return t if two characters match, case is significant.
2526 Both arguments must be characters (i.e. NOT integers).
2528 (character1, character2))
2530 CHECK_CHAR_COERCE_INT(character1);
2531 CHECK_CHAR_COERCE_INT(character2);
2533 return EQ(character1, character2) ? Qt : Qnil;
2536 #if 0 /* Undebugged FSFmacs code */
2537 /* Transpose the markers in two regions of the current buffer, and
2538 adjust the ones between them if necessary (i.e.: if the regions
2541 Traverses the entire marker list of the buffer to do so, adding an
2542 appropriate amount to some, subtracting from some, and leaving the
2543 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2545 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2547 void transpose_markers(Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2549 Charcount amt1, amt2, diff;
2551 struct buffer *buf = current_buffer;
2553 /* Update point as if it were a marker. */
2554 if (BUF_PT(buf) < start1) ;
2555 else if (BUF_PT(buf) < end1)
2556 BUF_SET_PT(buf, BUF_PT(buf) + (end2 - end1));
2557 else if (BUF_PT(buf) < start2)
2559 BUF_PT(buf) + (end2 - start2) - (end1 - start1));
2560 else if (BUF_PT(buf) < end2)
2561 BUF_SET_PT(buf, BUF_PT(buf) - (start2 - start1));
2563 /* We used to adjust the endpoints here to account for the gap, but that
2564 isn't good enough. Even if we assume the caller has tried to move the
2565 gap out of our way, it might still be at start1 exactly, for example;
2566 and that places it `inside' the interval, for our purposes. The amount
2567 of adjustment is nontrivial if there's a `denormalized' marker whose
2568 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2569 the dirty work to Fmarker_position, below. */
2571 /* The difference between the region's lengths */
2572 diff = (end2 - start2) - (end1 - start1);
2574 /* For shifting each marker in a region by the length of the other
2575 * region plus the distance between the regions.
2577 amt1 = (end2 - start2) + (start2 - end1);
2578 amt2 = (end1 - start1) + (start2 - end1);
2580 for (marker = BUF_MARKERS(buf); !NILP(marker);
2581 marker = XMARKER(marker)->chain) {
2582 Bufpos mpos = marker_position(marker);
2583 if (mpos >= start1 && mpos < end2) {
2586 else if (mpos < start2)
2590 set_marker_position(marker, mpos);
2597 DEFUN("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2598 Transpose region START1 to END1 with START2 to END2.
2599 The regions may not be overlapping, because the size of the buffer is
2600 never changed in a transposition.
2602 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
2603 any markers that happen to be located in the regions. (#### BUG: currently
2604 this function always acts as if LEAVE-MARKERS is non-nil.)
2606 Transposing beyond buffer boundaries is an error.
2608 (start1, end1, start2, end2, leave_markers))
2610 Bufpos startr1, endr1, startr2, endr2;
2611 Charcount len1, len2;
2612 Lisp_Object string1, string2;
2613 struct buffer *buf = current_buffer;
2615 get_buffer_range_char(buf, start1, end1, &startr1, &endr1, 0);
2616 get_buffer_range_char(buf, start2, end2, &startr2, &endr2, 0);
2618 len1 = endr1 - startr1;
2619 len2 = endr2 - startr2;
2621 if (startr2 < endr1)
2622 error("transposed regions not properly ordered");
2623 else if (startr1 == endr1 || startr2 == endr2)
2624 error("transposed region may not be of length 0");
2626 string1 = make_string_from_buffer(buf, startr1, len1);
2627 string2 = make_string_from_buffer(buf, startr2, len2);
2628 buffer_delete_range(buf, startr2, endr2, 0);
2629 buffer_insert_lisp_string_1(buf, startr2, string1, 0);
2630 buffer_delete_range(buf, startr1, endr1, 0);
2631 buffer_insert_lisp_string_1(buf, startr1, string2, 0);
2633 /* In FSFmacs there is a whole bunch of really ugly code here
2634 to attempt to transpose the regions without using up any
2635 extra memory. Although the intent may be good, the result
2636 was highly bogus. */
2641 /************************************************************************/
2642 /* initialization */
2643 /************************************************************************/
2645 void syms_of_editfns(void)
2647 defsymbol(&Qpoint, "point");
2648 defsymbol(&Qmark, "mark");
2649 defsymbol(&Qregion_beginning, "region-beginning");
2650 defsymbol(&Qregion_end, "region-end");
2651 defsymbol(&Qformat, "format");
2652 defsymbol(&Quser_files_and_directories, "user-files-and-directories");
2654 DEFSUBR(Fchar_equal);
2655 DEFSUBR(Fchar_Equal);
2656 DEFSUBR(Fgoto_char);
2657 DEFSUBR(Fstring_to_char);
2658 DEFSUBR(Fchar_to_string);
2659 DEFSUBR(Fbuffer_substring);
2660 DEFSUBR(Fbuffer_substring_no_properties);
2662 DEFSUBR(Fpoint_marker);
2663 DEFSUBR(Fmark_marker);
2665 DEFSUBR(Fregion_beginning);
2666 DEFSUBR(Fregion_end);
2667 DEFSUBR(Fsave_excursion);
2668 DEFSUBR(Fsave_current_buffer);
2670 DEFSUBR(Fbuffer_size);
2671 DEFSUBR(Fpoint_max);
2672 DEFSUBR(Fpoint_min);
2673 DEFSUBR(Fpoint_min_marker);
2674 DEFSUBR(Fpoint_max_marker);
2680 DEFSUBR(Ffollowing_char);
2681 DEFSUBR(Fpreceding_char);
2682 DEFSUBR(Fchar_after);
2683 DEFSUBR(Fchar_before);
2685 DEFSUBR(Finsert_string);
2686 DEFSUBR(Finsert_before_markers);
2687 DEFSUBR(Finsert_char);
2689 DEFSUBR(Ftemp_directory);
2690 DEFSUBR(Fuser_login_name);
2691 DEFSUBR(Fuser_real_login_name);
2693 DEFSUBR(Fuser_real_uid);
2694 DEFSUBR(Fuser_full_name);
2695 DEFSUBR(Fuser_home_directory);
2696 DEFSUBR(Femacs_pid);
2697 DEFSUBR(Fcurrent_time);
2698 #if defined(HAVE_MPZ) && defined(WITH_GMP)
2699 DEFSUBR(Fcurrent_btime);
2700 DEFSUBR(Ftime_to_btime);
2701 DEFSUBR(Fbtime_to_time);
2702 #endif /* HAVE_MPZ */
2703 DEFSUBR(Fcurrent_process_time);
2705 DEFSUBR(Fformat_time_string);
2706 DEFSUBR(Fdecode_time);
2707 DEFSUBR(Fencode_time);
2708 #if defined(HAVE_MPZ) && defined WITH_GMP
2709 DEFSUBR(Fencode_btime);
2711 DEFSUBR(Fcurrent_time_string);
2712 DEFSUBR(Fcurrent_time_zone);
2713 DEFSUBR(Fset_time_zone_rule);
2714 DEFSUBR(Fsystem_name);
2717 DEFSUBR(Finsert_buffer_substring);
2718 DEFSUBR(Fcompare_buffer_substrings);
2719 DEFSUBR(Fsubst_char_in_region);
2720 DEFSUBR(Ftranslate_region);
2721 DEFSUBR(Fdelete_region);
2723 DEFSUBR(Fnarrow_to_region);
2724 DEFSUBR(Fsave_restriction);
2725 DEFSUBR(Ftranspose_regions);
2727 defsymbol(&Qzmacs_update_region, "zmacs-update-region");
2728 defsymbol(&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2729 defsymbol(&Qzmacs_region_buffer, "zmacs-region-buffer");
2732 void vars_of_editfns(void)
2734 staticpro(&Vsystem_name);
2736 staticpro(&Vuser_name);
2737 staticpro(&Vuser_real_name);
2739 DEFVAR_BOOL("zmacs-regions", &zmacs_regions /*
2740 *Whether LISPM-style active regions should be used.
2741 This means that commands which operate on the region (the area between the
2742 point and the mark) will only work while the region is in the ``active''
2743 state, which is indicated by highlighting. Executing most commands causes
2744 the region to not be in the active state, so (for example) \\[kill-region] will only
2745 work immediately after activating the region.
2749 - Commands which operate on the region only work if the region is active.
2750 - Only a very small set of commands cause the region to become active:
2751 Those commands whose semantics are to mark an area, like `mark-defun'.
2752 - The region is deactivated after each command that is executed, except that:
2753 - "Motion" commands do not change whether the region is active or not.
2755 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2756 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2757 between point and the recently-pushed mark to be highlighted. It will
2758 remain highlighted until some non-motion command is executed.
2760 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2761 region and execute a command that operates on it, you can reactivate the
2762 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2765 Generally, commands which push marks as a means of navigation (like
2766 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2767 region. But commands which push marks as a means of marking an area of
2768 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2769 do activate the region.
2771 The way the command loop actually works with regard to deactivating the
2772 region is as follows:
2774 - If the variable `zmacs-region-stays' has been set to t during the command
2775 just executed, the region is left alone (this is how the motion commands
2776 make the region stay around; see the `_' flag in the `interactive'
2777 specification). `zmacs-region-stays' is reset to nil before each command
2779 - If the function `zmacs-activate-region' has been called during the command
2780 just executed, the region is left alone. Very few functions should
2781 actually call this function.
2782 - Otherwise, if the region is active, the region is deactivated and
2783 the `zmacs-deactivate-region-hook' is called.
2785 /* Zmacs style active regions are now ON by default */
2788 DEFVAR_BOOL("zmacs-region-active-p", &zmacs_region_active_p /*
2789 Do not alter this. It is for internal use only.
2791 zmacs_region_active_p = 0;
2793 DEFVAR_BOOL("zmacs-region-stays", &zmacs_region_stays /*
2794 Whether the current command will deactivate the region.
2795 Commands which do not wish to affect whether the region is currently
2796 highlighted should set this to t. Normally, the region is turned off after
2797 executing each command that did not explicitly turn it on with the function
2798 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2799 See the variable `zmacs-regions'.
2801 The same effect can be achieved using the `_' interactive specification.
2803 `zmacs-region-stays' is reset to nil before each command is executed.
2805 zmacs_region_stays = 0;
2807 DEFVAR_BOOL("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2808 Do not use this -- it will be going away soon.
2809 Indicates if `goto-char' has just been run. This information is allegedly
2810 needed to get the desired behavior for atomic extents and unfortunately
2811 is not available by any other means.
2813 atomic_extent_goto_char_p = 0;
2814 #ifdef AMPERSAND_FULL_NAME
2815 Fprovide(intern("ampersand-full-name"));
2818 DEFVAR_LISP("user-full-name", &Vuser_full_name /*
2819 *The name of the user.
2820 The function `user-full-name', which will return the value of this
2821 variable, when called without arguments.
2822 This is initialized to the value of the NAME environment variable.
2824 /* Initialized at run-time. */
2825 Vuser_full_name = Qnil;