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 XEmacs.
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
23 /* Synched up with: Mule 2.0, FSF 19.30. */
25 /* This file has been Mule-ized. */
27 /* Hacked on for Mule by Ben Wing, December 1994. */
37 #include "events.h" /* for EVENTP */
43 #include "line-number.h"
48 #include "sysfile.h" /* for getcwd */
50 /* Some static data, and a function to initialize it for each run */
52 Lisp_Object Vsystem_name; /* #### - I don't see why this should be */
53 /* static, either... --Stig */
54 #if 0 /* XEmacs - this is now dynamic */
55 /* if at some point it's deemed desirable to
56 use lisp variables here, then they can be
57 initialized to nil and then set to their
58 real values upon the first call to the
59 functions that generate them. --stig */
60 Lisp_Object Vuser_real_login_name; /* login name of current user ID */
61 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */
64 /* It's useful to be able to set this as user customization, so we'll
66 Lisp_Object Vuser_full_name;
67 EXFUN (Fuser_full_name, 1);
71 Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
73 Lisp_Object Quser_files_and_directories;
75 /* This holds the value of `environ' produced by the previous
76 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
77 has never been called. */
78 static char **environbuf;
83 /* Only used in removed code below. */
88 /* Set up system_name even when dumping. */
96 if ((p = getenv ("NAME")))
97 /* I don't think it's the right thing to do the ampersand
98 modification on NAME. Not that it matters anymore... -hniksic */
99 Vuser_full_name = build_ext_string (p, FORMAT_OS);
101 Vuser_full_name = Fuser_full_name (Qnil);
104 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
105 Convert arg CH to a one-character string containing that character.
110 Bufbyte str[MAX_EMCHAR_LEN];
114 Lisp_Object ch2 = Fevent_to_character (ch, Qt, Qnil, Qnil);
117 signal_simple_continuable_error
118 ("character has no ASCII equivalent:", Fcopy_event (ch, Qnil));
122 CHECK_CHAR_COERCE_INT (ch);
124 len = set_charptr_emchar (str, XCHAR (ch));
125 return make_string (str, len);
128 DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /*
129 Convert arg STRING to a character, the first character of that string.
130 An empty string will return the constant `nil'.
134 struct Lisp_String *p;
138 if (string_length (p) != 0)
139 return make_char (string_char (p, 0));
141 /* This used to return Qzero. That is broken, broken, broken. */
142 /* It might be kinder to signal an error directly. -slb */
148 buildmark (Bufpos val, Lisp_Object buffer)
150 Lisp_Object mark = Fmake_marker ();
151 Fset_marker (mark, make_int (val), buffer);
155 DEFUN ("point", Fpoint, 0, 1, 0, /*
156 Return value of point, as an integer.
157 Beginning of buffer is position (point-min).
158 If BUFFER is nil, the current buffer is assumed.
162 struct buffer *b = decode_buffer (buffer, 1);
163 return make_int (BUF_PT (b));
166 DEFUN ("point-marker", Fpoint_marker, 0, 2, 0, /*
167 Return value of point, as a marker object.
168 This marker is a copy; you may modify it with reckless abandon.
169 If optional argument DONT-COPY-P is non-nil, then it returns the real
170 point-marker; modifying the position of this marker will move point.
171 It is illegal to change the buffer of it, or make it point nowhere.
172 If BUFFER is nil, the current buffer is assumed.
174 (dont_copy_p, buffer))
176 struct buffer *b = decode_buffer (buffer, 1);
177 if (NILP (dont_copy_p))
178 return Fcopy_marker (b->point_marker, Qnil);
180 return b->point_marker;
183 /* The following two functions end up being identical but it's
184 cleaner to declare them separately. */
187 bufpos_clip_to_bounds (Bufpos lower, Bufpos num, Bufpos upper)
189 return (num < lower ? lower :
190 num > upper ? upper :
195 bytind_clip_to_bounds (Bytind lower, Bytind num, Bytind upper)
197 return (num < lower ? lower :
198 num > upper ? upper :
204 * There is no absolute way to determine if goto-char is the function
205 * being run. this-command doesn't work because it is often eval'd
206 * and this-command ends up set to eval-expression. So this flag gets
209 * Jamie thinks he's wrong, but we'll leave this in for now.
211 int atomic_extent_goto_char_p;
213 DEFUN ("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /*
214 Set point to POSITION, a number or marker.
215 Beginning of buffer is position (point-min), end is (point-max).
216 If BUFFER is nil, the current buffer is assumed.
217 Return value of POSITION, as an integer.
221 struct buffer *b = decode_buffer (buffer, 1);
222 Bufpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE);
224 atomic_extent_goto_char_p = 1;
229 region_limit (int beginningp, struct buffer *b)
234 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
235 && NILP (b->mark_active))
236 Fsignal (Qmark_inactive, Qnil);
238 m = Fmarker_position (b->mark);
239 if (NILP (m)) error ("There is no region now");
240 if (!!(BUF_PT (b) < XINT (m)) == !!beginningp)
241 return make_int (BUF_PT (b));
246 DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /*
247 Return position of beginning of region in BUFFER, as an integer.
248 If BUFFER is nil, the current buffer is assumed.
252 return region_limit (1, decode_buffer (buffer, 1));
255 DEFUN ("region-end", Fregion_end, 0, 1, 0, /*
256 Return position of end of region in BUFFER, as an integer.
257 If BUFFER is nil, the current buffer is assumed.
261 return region_limit (0, decode_buffer (buffer, 1));
264 /* Whether to use lispm-style active-regions */
267 /* Whether the zmacs region is active. This is not per-buffer because
268 there can be only one active region at a time. #### Now that the
269 zmacs region are not directly tied to the X selections this may not
270 necessarily have to be true. */
271 int zmacs_region_active_p;
273 int zmacs_region_stays;
275 Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region;
276 Lisp_Object Qzmacs_region_buffer;
279 zmacs_update_region (void)
281 /* This function can GC */
282 if (zmacs_region_active_p)
283 call0 (Qzmacs_update_region);
287 zmacs_deactivate_region (void)
289 /* This function can GC */
290 if (zmacs_region_active_p)
291 call0 (Qzmacs_deactivate_region);
295 zmacs_region_buffer (void)
297 if (zmacs_region_active_p)
298 return call0 (Qzmacs_region_buffer);
303 DEFUN ("mark-marker", Fmark_marker, 0, 2, 0, /*
304 Return this buffer's mark, as a marker object.
305 If `zmacs-regions' is true, then this returns nil unless the region is
306 currently in the active (highlighted) state. If optional argument FORCE
307 is t, this returns the mark (if there is one) regardless of the zmacs-region
308 state. You should *generally* not use the mark unless the region is active,
309 if the user has expressed a preference for the zmacs-region model.
310 Watch out! Moving this marker changes the mark position.
311 If you set the marker not to point anywhere, the buffer will have no mark.
312 If BUFFER is nil, the current buffer is assumed.
316 struct buffer *b = decode_buffer (buffer, 1);
317 if (! zmacs_regions || zmacs_region_active_p || !NILP (force))
323 /* The saved object is a cons:
325 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
327 We used to have another cons for a VISIBLE-P element, which was t
328 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
329 was unused for a long time, so I removed it. --hniksic */
331 save_excursion_save (void)
335 /* #### Huh? --hniksic */
336 /*if (preparing_for_armageddon) return Qnil;*/
338 #ifdef ERROR_CHECK_BUFPOS
339 assert (XINT (Fpoint (Qnil)) ==
340 XINT (Fmarker_position (Fpoint_marker (Qt, Qnil))));
345 return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil),
346 noseeum_copy_marker (b->mark, Qnil));
350 save_excursion_restore (Lisp_Object info)
352 Lisp_Object buffer = Fmarker_buffer (XCAR (info));
354 /* If buffer being returned to is now deleted, avoid error --
355 otherwise could get error here while unwinding to top level and
356 crash. In that case, Fmarker_buffer returns nil now. */
359 struct buffer *buf = XBUFFER (buffer);
362 set_buffer_internal (buf);
363 Fgoto_char (XCAR (info), buffer);
364 Fset_marker (buf->mark, XCDR (info), buffer);
366 #if 0 /* We used to make the current buffer visible in the selected window
367 if that was true previously. That avoids some anomalies.
368 But it creates others, and it wasn't documented, and it is simpler
369 and cleaner never to alter the window/buffer connections. */
370 /* I'm certain some code somewhere depends on this behavior. --jwz */
371 /* Even if it did, it certainly doesn't matter anymore, because
372 this has been the behavior for countless XEmacs releases
375 && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
376 switch_to_buffer (Fcurrent_buffer (), Qnil);
382 /* Free all the junk we allocated, so that a `save-excursion' comes
383 for free in terms of GC junk. */
384 free_marker (XMARKER (XCAR (info)));
385 free_marker (XMARKER (XCDR (info)));
386 free_cons (XCONS (info));
390 DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
391 Save point, mark, and current buffer; execute BODY; restore those things.
392 Executes BODY just like `progn'.
393 The values of point, mark and the current buffer are restored
394 even in case of abnormal exit (throw or error).
398 /* This function can GC */
399 int speccount = specpdl_depth ();
401 record_unwind_protect (save_excursion_restore, save_excursion_save ());
403 return unbind_to (speccount, Fprogn (args));
407 save_current_buffer_restore (Lisp_Object buffer)
409 struct buffer *buf = XBUFFER (buffer);
410 /* Avoid signaling an error if the buffer is no longer alive. This
411 is for consistency with save-excursion. */
412 if (BUFFER_LIVE_P (buf))
413 set_buffer_internal (buf);
417 DEFUN ("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /*
418 Save the current buffer; execute BODY; restore the current buffer.
419 Executes BODY just like `progn'.
423 /* This function can GC */
424 int speccount = specpdl_depth ();
426 record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ());
428 return unbind_to (speccount, Fprogn (args));
431 DEFUN ("buffer-size", Fbuffer_size, 0, 1, 0, /*
432 Return the number of characters in BUFFER.
433 If BUFFER is nil, the current buffer is assumed.
437 struct buffer *b = decode_buffer (buffer, 1);
438 return make_int (BUF_SIZE (b));
441 DEFUN ("point-min", Fpoint_min, 0, 1, 0, /*
442 Return the minimum permissible value of point in BUFFER.
443 This is 1, unless narrowing (a buffer restriction) is in effect.
444 If BUFFER is nil, the current buffer is assumed.
448 struct buffer *b = decode_buffer (buffer, 1);
449 return make_int (BUF_BEGV (b));
452 DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
453 Return a marker to the minimum permissible value of point in BUFFER.
454 This is the beginning, unless narrowing (a buffer restriction) is in effect.
455 If BUFFER is nil, the current buffer is assumed.
459 struct buffer *b = decode_buffer (buffer, 1);
460 return buildmark (BUF_BEGV (b), make_buffer (b));
463 DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
464 Return the maximum permissible value of point in BUFFER.
465 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
466 is in effect, in which case it is less.
467 If BUFFER is nil, the current buffer is assumed.
471 struct buffer *b = decode_buffer (buffer, 1);
472 return make_int (BUF_ZV (b));
475 DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
476 Return a marker to the maximum permissible value of point BUFFER.
477 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
478 is in effect, in which case it is less.
479 If BUFFER is nil, the current buffer is assumed.
483 struct buffer *b = decode_buffer (buffer, 1);
484 return buildmark (BUF_ZV (b), make_buffer (b));
487 DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /*
488 Return the character following point.
489 At the end of the buffer or accessible region, return 0.
490 If BUFFER is nil, the current buffer is assumed.
494 struct buffer *b = decode_buffer (buffer, 1);
495 if (BUF_PT (b) >= BUF_ZV (b))
496 return Qzero; /* #### Gag me! */
498 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b)));
501 DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /*
502 Return the character preceding point.
503 At the beginning of the buffer or accessible region, return 0.
504 If BUFFER is nil, the current buffer is assumed.
508 struct buffer *b = decode_buffer (buffer, 1);
509 if (BUF_PT (b) <= BUF_BEGV (b))
510 return Qzero; /* #### Gag me! */
512 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1));
515 DEFUN ("bobp", Fbobp, 0, 1, 0, /*
516 Return t if point is at the beginning of the buffer.
517 If the buffer is narrowed, this means the beginning of the narrowed part.
518 If BUFFER is nil, the current buffer is assumed.
522 struct buffer *b = decode_buffer (buffer, 1);
523 return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil;
526 DEFUN ("eobp", Feobp, 0, 1, 0, /*
527 Return t if point is at the end of the buffer.
528 If the buffer is narrowed, this means the end of the narrowed part.
529 If BUFFER is nil, the current buffer is assumed.
533 struct buffer *b = decode_buffer (buffer, 1);
534 return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil;
538 beginning_of_line_p (struct buffer *b, Bufpos pt)
540 return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n';
544 DEFUN ("bolp", Fbolp, 0, 1, 0, /*
545 Return t if point is at the beginning of a line.
546 If BUFFER is nil, the current buffer is assumed.
550 struct buffer *b = decode_buffer (buffer, 1);
551 return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
554 DEFUN ("eolp", Feolp, 0, 1, 0, /*
555 Return t if point is at the end of a line.
556 `End of a line' includes point being at the end of the buffer.
557 If BUFFER is nil, the current buffer is assumed.
561 struct buffer *b = decode_buffer (buffer, 1);
562 return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n')
566 DEFUN ("char-after", Fchar_after, 0, 2, 0, /*
567 Return character in BUFFER at position POS.
568 POS is an integer or a buffer pointer.
569 If POS is out of range, the value is nil.
570 If BUFFER is nil, the current buffer is assumed.
571 if POS is nil, the value of point is assumed.
575 struct buffer *b = decode_buffer (buffer, 1);
576 Bufpos n = (NILP (pos) ? BUF_PT (b) :
577 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
579 if (n < 0 || n == BUF_ZV (b))
581 return make_char (BUF_FETCH_CHAR (b, n));
584 DEFUN ("char-before", Fchar_before, 0, 2, 0, /*
585 Return character in BUFFER before position POS.
586 POS is an integer or a buffer pointer.
587 If POS is out of range, the value is nil.
588 If BUFFER is nil, the current buffer is assumed.
589 if POS is nil, the value of point is assumed.
593 struct buffer *b = decode_buffer (buffer, 1);
594 Bufpos n = ((NILP (pos) ? BUF_PT (b) :
595 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD)));
599 if (n < BUF_BEGV (b))
601 return make_char (BUF_FETCH_CHAR (b, n));
605 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
606 Return the pathname to the directory to use for temporary files.
607 On NT/MSDOS, this is obtained from the TEMP or TMP environment variables,
608 defaulting to / if they are both undefined.
609 On Unix it is obtained from TMPDIR, with /tmp as the default
614 #if defined(WINDOWSNT) || defined(MSDOS)
615 tmpdir = getenv ("TEMP");
617 tmpdir = getenv ("TMP");
620 #else /* WINDOWSNT || MSDOS */
621 tmpdir = getenv ("TMPDIR");
626 return build_ext_string (tmpdir, FORMAT_FILENAME);
629 DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
630 Return the name under which the user logged in, as a string.
631 This is based on the effective uid, not the real uid.
632 Also, if the environment variable LOGNAME or USER is set,
633 that determines the value of this function.
634 If the optional argument UID is present, then environment variables are
635 ignored and this function returns the login name for that UID, or nil.
645 local_uid = XINT (uid);
646 returned_name = user_login_name (&local_uid);
650 returned_name = user_login_name (NULL);
652 /* #### - I believe this should return nil instead of "unknown" when pw==0
653 pw=0 is indicated by a null return from user_login_name
655 return returned_name ? build_string (returned_name) : Qnil;
658 /* This function may be called from other C routines when a
659 character string representation of the user_login_name is
660 needed but a Lisp Object is not. The UID is passed by
661 reference. If UID == NULL, then the USER name
662 for the user running XEmacs will be returned. This
663 corresponds to a nil argument to Fuser_login_name.
666 user_login_name (uid_t *uid)
668 /* uid == NULL to return name of this user */
671 struct passwd *pw = getpwuid (*uid);
672 return pw ? pw->pw_name : NULL;
676 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
677 old environment (I site observed behavior on sunos and linux), so the
678 environment variables should be disregarded in that case. --Stig */
679 char *user_name = getenv ("LOGNAME");
683 "USERNAME" /* it's USERNAME on NT */
692 struct passwd *pw = getpwuid (geteuid ());
694 /* Since the Cygwin environment may not have an /etc/passwd,
695 return "unknown" instead of the null if the username
696 cannot be determined.
698 return pw ? pw->pw_name : "unknown";
700 /* For all but Cygwin return NULL (nil) */
701 return pw ? pw->pw_name : NULL;
707 DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
708 Return the name of the user's real uid, as a string.
709 This ignores the environment variables LOGNAME and USER, so it differs from
710 `user-login-name' when running under `su'.
714 struct passwd *pw = getpwuid (getuid ());
715 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
718 /* We let the real user name default to "root" because that's quite
719 accurate on MSDOG and because it lets Emacs find the init file.
720 (The DVX libraries override the Djgpp libraries here.) */
721 Lisp_Object tem = build_string (pw ? pw->pw_name : "root");/* no gettext */
723 Lisp_Object tem = build_string (pw ? pw->pw_name : "unknown");/* no gettext */
728 DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /*
729 Return the effective uid of Emacs, as an integer.
733 return make_int (geteuid ());
736 DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
737 Return the real uid of Emacs, as an integer.
741 return make_int (getuid ());
744 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
745 Return the full name of the user logged in, as a string.
746 If the optional argument USER is given, then the full name for that
747 user is returned, or nil. USER may be either a login name or a uid.
749 If USER is nil, and `user-full-name' contains a string, the
750 value of `user-full-name' is returned.
754 Lisp_Object user_name;
755 struct passwd *pw = NULL;
759 if (NILP (user) && STRINGP (Vuser_full_name))
760 return Vuser_full_name;
762 user_name = (STRINGP (user) ? user : Fuser_login_name (user));
763 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
765 CONST char *user_name_ext;
767 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
768 things get wedged if a SIGIO arrives during this time. */
769 GET_C_STRING_OS_DATA_ALLOCA (user_name, user_name_ext);
770 slow_down_interrupts ();
771 pw = (struct passwd *) getpwnam (user_name_ext);
772 speed_up_interrupts ();
775 /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
776 /* Ben sez: bad idea because it's likely to break something */
777 #ifndef AMPERSAND_FULL_NAME
778 p = ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext */
781 p = ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext */
784 tem = ((!NILP (user) && !pw)
786 : make_ext_string ((Extbyte *) p, (q ? q - p : strlen (p)),
789 #ifdef AMPERSAND_FULL_NAME
792 p = (char *) XSTRING_DATA (tem);
794 /* Substitute the login name for the &, upcasing the first character. */
797 char *r = (char *) alloca (strlen (p) + XSTRING_LENGTH (user_name) + 1);
798 memcpy (r, p, q - p);
800 strcat (r, (char *) XSTRING_DATA (user_name));
801 /* #### current_buffer dependency! */
802 r[q - p] = UPCASE (current_buffer, r[q - p]);
804 tem = build_string (r);
807 #endif /* AMPERSAND_FULL_NAME */
812 static char *cached_home_directory;
815 uncache_home_directory (void)
817 cached_home_directory = NULL; /* in some cases, this may cause the leaking
821 /* Returns the home directory, in external format */
823 get_home_directory (void)
825 int output_home_warning = 0;
827 if (cached_home_directory == NULL)
829 if ((cached_home_directory = getenv("HOME")) == NULL)
831 #if defined(WINDOWSNT) && !defined(__CYGWIN32__)
832 char *homedrive, *homepath;
834 if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
835 (homepath = getenv("HOMEPATH")) != NULL)
837 cached_home_directory =
838 (char *) xmalloc(strlen(homedrive) + strlen(homepath) + 1);
839 sprintf(cached_home_directory, "%s%s", homedrive, homepath);
845 * Use the current directory.
846 * This preserves the existing XEmacs behavior, but is different
849 if (initial_directory[0] != '\0')
851 cached_home_directory = initial_directory;
855 /* This will probably give the wrong value */
856 cached_home_directory = getcwd (NULL, 0);
860 * This is NT Emacs behavior
862 cached_home_directory = "C:\\";
863 output_home_warning = 1;
866 #else /* !WINDOWSNT */
869 * Using "/" isn't quite right, but what should we do?
870 * We probably should try to extract pw_dir from /etc/passwd,
871 * before falling back to this.
873 cached_home_directory = "/";
874 output_home_warning = 1;
875 #endif /* !WINDOWSNT */
877 if (initialized && output_home_warning)
879 warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
880 " XEmacs was unable to determine a good value for the user's $HOME\n"
881 " directory, and will be using the value:\n"
883 " This is probably incorrect.",
884 cached_home_directory
888 return cached_home_directory;
891 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
892 Return the user's home directory, as a string.
896 char *path = get_home_directory ();
898 return path == NULL ? Qnil :
899 Fexpand_file_name (Fsubstitute_in_file_name
900 (build_ext_string (path, FORMAT_FILENAME)),
904 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
905 Return the name of the machine you are running on, as a string.
909 return Fcopy_sequence (Vsystem_name);
912 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
913 Return the process ID of Emacs, as an integer.
917 return make_int (getpid ());
920 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
921 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
922 The time is returned as a list of three integers. The first has the
923 most significant 16 bits of the seconds, while the second has the
924 least significant 16 bits. The third integer gives the microsecond
927 The microsecond count is zero on systems that do not provide
928 resolution finer than a second.
935 return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
936 make_int ((EMACS_SECS (t) >> 0) & 0xffff),
937 make_int (EMACS_USECS (t)));
940 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
941 Return the amount of time used by this XEmacs process so far.
942 The return value is a list of three floating-point numbers, expressing
943 the user, system, and real times used by the process. The user time
944 measures the time actually spent by the CPU executing the code in this
945 process. The system time measures time spent by the CPU executing kernel
946 code on behalf of this process (e.g. I/O requests made by the process).
948 Note that the user and system times measure processor time, as opposed
949 to real time, and only accrue when the processor is actually doing
950 something: Time spent in an idle wait (waiting for user events to come
951 in or for I/O on a disk drive or other device to complete) does not
952 count. Thus, the user and system times will often be considerably
953 less than the real time.
955 Some systems do not allow the user and system times to be distinguished.
956 In this case, the user time will be the total processor time used by
957 the process, and the system time will be 0.
959 Some systems do not allow the real and processor times to be distinguished.
960 In this case, the user and real times will be the same and the system
965 double user, sys, real;
967 get_process_times (&user, &sys, &real);
968 return list3 (make_float (user), make_float (sys), make_float (real));
972 int lisp_to_time (Lisp_Object specified_time, time_t *result);
974 lisp_to_time (Lisp_Object specified_time, time_t *result)
976 Lisp_Object high, low;
978 if (NILP (specified_time))
979 return time (result) != -1;
981 CHECK_CONS (specified_time);
982 high = XCAR (specified_time);
983 low = XCDR (specified_time);
988 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
989 return *result >> 16 == XINT (high);
992 Lisp_Object time_to_lisp (time_t the_time);
994 time_to_lisp (time_t the_time)
996 unsigned int item = (unsigned int) the_time;
997 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
1000 size_t emacs_strftime (char *string, size_t max, CONST char *format,
1001 CONST struct tm *tm);
1002 static long difftm (CONST struct tm *a, CONST struct tm *b);
1005 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
1006 Use FORMAT-STRING to format the time TIME.
1007 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1008 `current-time' and `file-attributes'. If TIME is not specified it
1009 defaults to the current time.
1010 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1011 %a is replaced by the abbreviated name of the day of week.
1012 %A is replaced by the full name of the day of week.
1013 %b is replaced by the abbreviated name of the month.
1014 %B is replaced by the full name of the month.
1015 %c is a synonym for "%x %X".
1016 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1017 %d is replaced by the day of month, zero-padded.
1018 %D is a synonym for "%m/%d/%y".
1019 %e is replaced by the day of month, blank-padded.
1020 %h is a synonym for "%b".
1021 %H is replaced by the hour (00-23).
1022 %I is replaced by the hour (00-12).
1023 %j is replaced by the day of the year (001-366).
1024 %k is replaced by the hour (0-23), blank padded.
1025 %l is replaced by the hour (1-12), blank padded.
1026 %m is replaced by the month (01-12).
1027 %M is replaced by the minute (00-59).
1028 %n is a synonym for "\\n".
1029 %p is replaced by AM or PM, as appropriate.
1030 %r is a synonym for "%I:%M:%S %p".
1031 %R is a synonym for "%H:%M".
1032 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1033 nonstandard extension)
1034 %S is replaced by the second (00-60).
1035 %t is a synonym for "\\t".
1036 %T is a synonym for "%H:%M:%S".
1037 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1038 %w is replaced by the day of week (0-6), Sunday is day 0.
1039 %W is replaced by the week of the year (00-53), first day of week is Monday.
1040 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1041 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1042 %y is replaced by the year without century (00-99).
1043 %Y is replaced by the year with century.
1044 %Z is replaced by the time zone abbreviation.
1046 The number of options reflects the `strftime' function.
1048 BUG: If the charset used by the current locale is not ISO 8859-1, the
1049 characters appearing in the day and month names may be incorrect.
1051 (format_string, time_))
1056 CHECK_STRING (format_string);
1058 if (! lisp_to_time (time_, &value))
1059 error ("Invalid time specification");
1061 /* This is probably enough. */
1062 size = XSTRING_LENGTH (format_string) * 6 + 50;
1066 char *buf = (char *) alloca (size);
1068 if (emacs_strftime (buf, size,
1069 (CONST char *) XSTRING_DATA (format_string),
1072 return build_ext_string (buf, FORMAT_BINARY);
1073 /* If buffer was too small, make it bigger. */
1078 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
1079 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1080 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1081 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1082 to use the current time. The list has the following nine members:
1083 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1084 only some operating systems support. MINUTE is an integer between 0 and 59.
1085 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
1086 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
1087 four-digit year. DOW is the day of week, an integer between 0 and 6, where
1088 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
1089 ZONE is an integer indicating the number of seconds east of Greenwich.
1090 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1096 struct tm *decoded_time;
1097 Lisp_Object list_args[9];
1099 if (! lisp_to_time (specified_time, &time_spec))
1100 error ("Invalid time specification");
1102 decoded_time = localtime (&time_spec);
1103 list_args[0] = make_int (decoded_time->tm_sec);
1104 list_args[1] = make_int (decoded_time->tm_min);
1105 list_args[2] = make_int (decoded_time->tm_hour);
1106 list_args[3] = make_int (decoded_time->tm_mday);
1107 list_args[4] = make_int (decoded_time->tm_mon + 1);
1108 list_args[5] = make_int (decoded_time->tm_year + 1900);
1109 list_args[6] = make_int (decoded_time->tm_wday);
1110 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
1112 /* Make a copy, in case gmtime modifies the struct. */
1113 save_tm = *decoded_time;
1114 decoded_time = gmtime (&time_spec);
1115 if (decoded_time == 0)
1116 list_args[8] = Qnil;
1118 list_args[8] = make_int (difftm (&save_tm, decoded_time));
1119 return Flist (9, list_args);
1122 static void set_time_zone_rule (char *tzstring);
1124 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
1125 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1126 This is the reverse operation of `decode-time', which see.
1127 ZONE defaults to the current time zone rule. This can
1128 be a string (as from `set-time-zone-rule'), or it can be a list
1129 \(as from `current-time-zone') or an integer (as from `decode-time')
1130 applied without consideration for daylight savings time.
1132 You can pass more than 7 arguments; then the first six arguments
1133 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1134 The intervening arguments are ignored.
1135 This feature lets (apply 'encode-time (decode-time ...)) work.
1137 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1138 for example, a DAY of 0 means the day preceding the given month.
1139 Year numbers less than 100 are treated just like other year numbers.
1140 If you want them to stand for years in this century, you must do that yourself.
1142 (int nargs, Lisp_Object *args))
1146 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1148 CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */
1149 CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */
1150 CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */
1151 CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */
1152 CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */
1153 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
1160 the_time = mktime (&tm);
1165 char **oldenv = environ, **newenv;
1168 tzstring = (char *) XSTRING_DATA (zone);
1169 else if (INTP (zone))
1171 int abszone = abs (XINT (zone));
1172 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
1173 abszone / (60*60), (abszone/60) % 60, abszone % 60);
1177 error ("Invalid time zone specification");
1179 /* Set TZ before calling mktime; merely adjusting mktime's returned
1180 value doesn't suffice, since that would mishandle leap seconds. */
1181 set_time_zone_rule (tzstring);
1183 the_time = mktime (&tm);
1185 /* Restore TZ to previous value. */
1189 #ifdef LOCALTIME_CACHE
1194 if (the_time == (time_t) -1)
1195 error ("Specified time is not representable");
1197 return wasteful_word_to_lisp (the_time);
1200 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1201 Return the current time, as a human-readable string.
1202 Programs can use this function to decode a time,
1203 since the number of columns in each field is fixed.
1204 The format is `Sun Sep 16 01:03:52 1973'.
1205 If an argument is given, it specifies a time to format
1206 instead of the current time. The argument should have the form:
1209 (HIGH LOW . IGNORED).
1210 Thus, you can use times obtained from `current-time'
1211 and from `file-attributes'.
1219 if (! lisp_to_time (specified_time, &value))
1221 tem = (char *) ctime (&value);
1223 strncpy (buf, tem, 24);
1226 return build_ext_string (buf, FORMAT_BINARY);
1229 #define TM_YEAR_ORIGIN 1900
1231 /* Yield A - B, measured in seconds. */
1233 difftm (CONST struct tm *a, CONST struct tm *b)
1235 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1236 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1237 /* Some compilers can't handle this as a single return statement. */
1239 /* difference in day of year */
1240 a->tm_yday - b->tm_yday
1241 /* + intervening leap days */
1242 + ((ay >> 2) - (by >> 2))
1244 + ((ay/100 >> 2) - (by/100 >> 2))
1245 /* + difference in years * 365 */
1246 + (long)(ay-by) * 365
1248 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
1249 + (a->tm_min - b->tm_min))
1250 + (a->tm_sec - b->tm_sec));
1253 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1254 Return the offset and name for the local time zone.
1255 This returns a list of the form (OFFSET NAME).
1256 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1257 A negative value means west of Greenwich.
1258 NAME is a string giving the name of the time zone.
1259 If an argument is given, it specifies when the time zone offset is determined
1260 instead of using the current time. The argument should have the form:
1263 (HIGH LOW . IGNORED).
1264 Thus, you can use times obtained from `current-time'
1265 and from `file-attributes'.
1267 Some operating systems cannot provide all this information to Emacs;
1268 in this case, `current-time-zone' returns a list containing nil for
1269 the data it can't find.
1274 struct tm *t = NULL;
1276 if (lisp_to_time (specified_time, &value)
1277 && (t = gmtime (&value)) != 0)
1279 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */
1283 t = localtime (&value);
1284 offset = difftm (t, &gmt);
1288 s = (char *)t->tm_zone;
1289 #else /* not HAVE_TM_ZONE */
1291 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1292 s = tzname[t->tm_isdst];
1294 #endif /* not HAVE_TM_ZONE */
1297 /* No local time zone name is available; use "+-NNNN" instead. */
1298 int am = (offset < 0 ? -offset : offset) / 60;
1299 sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
1302 return list2 (make_int (offset), build_string (s));
1305 return list2 (Qnil, Qnil);
1308 #ifdef LOCALTIME_CACHE
1310 /* These two values are known to load tz files in buggy implementations,
1311 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1312 Their values shouldn't matter in non-buggy implementations.
1313 We don't use string literals for these strings,
1314 since if a string in the environment is in readonly
1315 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1316 See Sun bugs 1113095 and 1114114, ``Timezone routines
1317 improperly modify environment''. */
1319 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1320 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1324 /* Set the local time zone rule to TZSTRING.
1325 This allocates memory into `environ', which it is the caller's
1326 responsibility to free. */
1328 set_time_zone_rule (char *tzstring)
1331 char **from, **to, **newenv;
1333 for (from = environ; *from; from++)
1335 envptrs = from - environ + 2;
1336 newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
1337 + (tzstring ? strlen (tzstring) + 4 : 0));
1340 char *t = (char *) (to + envptrs);
1342 strcat (t, tzstring);
1346 for (from = environ; *from; from++)
1347 if (strncmp (*from, "TZ=", 3) != 0)
1353 #ifdef LOCALTIME_CACHE
1355 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1356 "US/Pacific" that loads a tz file, then changes to a value like
1357 "XXX0" that does not load a tz file, and then changes back to
1358 its original value, the last change is (incorrectly) ignored.
1359 Also, if TZ changes twice in succession to values that do
1360 not load a tz file, tzset can dump core (see Sun bug#1225179).
1361 The following code works around these bugs. */
1365 /* Temporarily set TZ to a value that loads a tz file
1366 and that differs from tzstring. */
1368 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
1369 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
1375 /* The implied tzstring is unknown, so temporarily set TZ to
1376 two different values that each load a tz file. */
1377 *to = set_time_zone_rule_tz1;
1380 *to = set_time_zone_rule_tz2;
1385 /* Now TZ has the desired value, and tzset can be invoked safely. */
1392 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1393 Set the local time zone using TZ, a string specifying a time zone rule.
1394 If TZ is nil, use implementation-defined default time zone information.
1405 tzstring = (char *) XSTRING_DATA (tz);
1408 set_time_zone_rule (tzstring);
1411 environbuf = environ;
1418 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
1420 /* This function can GC */
1421 struct gcpro gcpro1;
1424 if (CHAR_OR_CHAR_INTP (arg))
1426 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
1428 else if (STRINGP (arg))
1430 buffer_insert_lisp_string (buf, arg);
1434 arg = wrong_type_argument (Qchar_or_string_p, arg);
1437 zmacs_region_stays = 0;
1442 /* Callers passing one argument to Finsert need not gcpro the
1443 argument "array", since the only element of the array will
1444 not be used after calling insert_emacs_char or insert_lisp_string,
1445 so we don't care if it gets trashed. */
1447 DEFUN ("insert", Finsert, 0, MANY, 0, /*
1448 Insert the arguments, either strings or characters, at point.
1449 Point moves forward so that it ends up after the inserted text.
1450 Any other markers at the point of insertion remain before the text.
1451 If a string has non-null string-extent-data, new extents will be created.
1453 (int nargs, Lisp_Object *args))
1455 /* This function can GC */
1456 REGISTER int argnum;
1458 for (argnum = 0; argnum < nargs; argnum++)
1460 buffer_insert1 (current_buffer, args[argnum]);
1466 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1467 Insert strings or characters at point, relocating markers after the text.
1468 Point moves forward so that it ends up after the inserted text.
1469 Any other markers at the point of insertion also end up after the text.
1471 (int nargs, Lisp_Object *args))
1473 /* This function can GC */
1474 REGISTER int argnum;
1475 REGISTER Lisp_Object tem;
1477 for (argnum = 0; argnum < nargs; argnum++)
1481 if (CHAR_OR_CHAR_INTP (tem))
1483 buffer_insert_emacs_char_1 (current_buffer, -1,
1484 XCHAR_OR_CHAR_INT (tem),
1485 INSDEL_BEFORE_MARKERS);
1487 else if (STRINGP (tem))
1489 buffer_insert_lisp_string_1 (current_buffer, -1, tem,
1490 INSDEL_BEFORE_MARKERS);
1494 tem = wrong_type_argument (Qchar_or_string_p, tem);
1498 zmacs_region_stays = 0;
1502 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
1503 Insert STRING into BUFFER at BUFFER's point.
1504 Point moves forward so that it ends up after the inserted text.
1505 Any other markers at the point of insertion remain before the text.
1506 If a string has non-null string-extent-data, new extents will be created.
1507 BUFFER defaults to the current buffer.
1511 struct buffer *b = decode_buffer (buffer, 1);
1512 CHECK_STRING (string);
1513 buffer_insert_lisp_string (b, string);
1514 zmacs_region_stays = 0;
1518 /* Third argument in FSF is INHERIT:
1520 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1521 from adjoining text, if those properties are sticky."
1523 Jamie thinks this is bogus. */
1526 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
1527 Insert COUNT (second arg) copies of CHR (first arg).
1528 Point and all markers are affected as in the function `insert'.
1529 COUNT defaults to 1 if omitted.
1530 The optional third arg IGNORED is INHERIT under FSF Emacs.
1531 This is highly bogus, however, and XEmacs always behaves as if
1532 `t' were passed to INHERIT.
1533 The optional fourth arg BUFFER specifies the buffer to insert the
1534 text into. If BUFFER is nil, the current buffer is assumed.
1536 (chr, count, ignored, buffer))
1538 /* This function can GC */
1539 REGISTER Bufbyte *string;
1542 REGISTER Bytecount n;
1543 REGISTER Bytecount charlen;
1544 Bufbyte str[MAX_EMCHAR_LEN];
1545 struct buffer *b = decode_buffer (buffer, 1);
1548 CHECK_CHAR_COERCE_INT (chr);
1557 charlen = set_charptr_emchar (str, XCHAR (chr));
1561 slen = min (n, 768);
1562 string = alloca_array (Bufbyte, slen);
1563 /* Write as many copies of the character into the temp string as will fit. */
1564 for (i = 0; i + charlen <= slen; i += charlen)
1565 for (j = 0; j < charlen; j++)
1566 string[i + j] = str[j];
1570 buffer_insert_raw_string (b, string, slen);
1574 #if 0 /* FSFmacs bogosity */
1576 if (!NILP (inherit))
1577 insert_and_inherit (string, n);
1582 buffer_insert_raw_string (b, string, n);
1585 zmacs_region_stays = 0;
1590 /* Making strings from buffer contents. */
1592 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1593 Return the contents of part of BUFFER as a string.
1594 The two arguments START and END are character positions;
1595 they can be in either order. If omitted, they default to the beginning
1596 and end of BUFFER, respectively.
1597 If there are duplicable extents in the region, the string remembers
1598 them in its extent data.
1599 If BUFFER is nil, the current buffer is assumed.
1601 (start, end, buffer))
1603 /* This function can GC */
1605 struct buffer *b = decode_buffer (buffer, 1);
1607 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1608 return make_string_from_buffer (b, begv, zv - begv);
1611 /* It might make more sense to name this
1612 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1613 and what the function does is probably good enough for what the
1614 user-code will typically want to use it for. */
1615 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1616 Return the text from BEG to END, as a string, without copying the extents.
1618 (start, end, buffer))
1620 /* This function can GC */
1622 struct buffer *b = decode_buffer (buffer, 1);
1624 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1625 return make_string_from_buffer_no_extents (b, begv, zv - begv);
1628 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1629 Insert before point a substring of the contents of buffer BUFFER.
1630 BUFFER may be a buffer or a buffer name.
1631 Arguments START and END are character numbers specifying the substring.
1632 They default to the beginning and the end of BUFFER.
1634 (buffer, start, end))
1636 /* This function can GC */
1640 bp = XBUFFER (get_buffer (buffer, 1));
1641 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
1644 buffer_insert_from_buffer (current_buffer, bp, b, e - b);
1649 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1650 Compare two substrings of two buffers; return result as number.
1651 the value is -N if first string is less after N-1 chars,
1652 +N if first string is greater after N-1 chars, or 0 if strings match.
1653 Each substring is represented as three arguments: BUFFER, START and END.
1654 That makes six args in all, three for each substring.
1656 The value of `case-fold-search' in the current buffer
1657 determines whether case is significant or ignored.
1659 (buffer1, start1, end1, buffer2, start2, end2))
1661 Bufpos begp1, endp1, begp2, endp2;
1662 REGISTER Charcount len1, len2, length, i;
1663 struct buffer *bp1, *bp2;
1664 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
1665 current_buffer->case_canon_table : Qnil);
1667 /* Find the first buffer and its substring. */
1669 bp1 = decode_buffer (buffer1, 1);
1670 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1672 /* Likewise for second substring. */
1674 bp2 = decode_buffer (buffer2, 1);
1675 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1677 len1 = endp1 - begp1;
1678 len2 = endp2 - begp2;
1683 for (i = 0; i < length; i++)
1685 Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
1686 Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
1689 c1 = TRT_TABLE_OF (trt, c1);
1690 c2 = TRT_TABLE_OF (trt, c2);
1693 return make_int (- 1 - i);
1695 return make_int (i + 1);
1698 /* The strings match as far as they go.
1699 If one is shorter, that one is less. */
1701 return make_int (length + 1);
1702 else if (length < len2)
1703 return make_int (- length - 1);
1705 /* Same length too => they are equal. */
1711 subst_char_in_region_unwind (Lisp_Object arg)
1713 XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
1718 subst_char_in_region_unwind_1 (Lisp_Object arg)
1720 XBUFFER (XCAR (arg))->filename = XCDR (arg);
1724 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1725 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1726 If optional arg NOUNDO is non-nil, don't record this change for undo
1727 and don't mark the buffer as really changed.
1729 (start, end, fromchar, tochar, noundo))
1731 /* This function can GC */
1735 struct buffer *buf = current_buffer;
1736 int count = specpdl_depth ();
1738 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1739 CHECK_CHAR_COERCE_INT (fromchar);
1740 CHECK_CHAR_COERCE_INT (tochar);
1742 fromc = XCHAR (fromchar);
1743 toc = XCHAR (tochar);
1745 /* If we don't want undo, turn off putting stuff on the list.
1746 That's faster than getting rid of things,
1747 and it prevents even the entry for a first change.
1748 Also inhibit locking the file. */
1751 record_unwind_protect (subst_char_in_region_unwind,
1752 Fcons (Fcurrent_buffer (), buf->undo_list));
1753 buf->undo_list = Qt;
1754 /* Don't do file-locking. */
1755 record_unwind_protect (subst_char_in_region_unwind_1,
1756 Fcons (Fcurrent_buffer (), buf->filename));
1757 buf->filename = Qnil;
1760 mc_count = begin_multiple_change (buf, pos, stop);
1763 if (BUF_FETCH_CHAR (buf, pos) == fromc)
1765 /* There used to be some code here that set the buffer to
1766 unmodified if NOUNDO was specified and there was only
1767 one change to the buffer since it was last saved.
1768 This is a crock of shit, so I'm not duplicating this
1769 behavior. I think this was left over from when
1770 prepare_to_modify_buffer() actually bumped MODIFF,
1771 so that code was supposed to undo this change. --ben */
1772 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
1774 /* If noundo is not nil then we don't mark the buffer as
1775 modified. In reality that needs to happen externally
1776 only. Internally redisplay needs to know that the actual
1777 contents it should be displaying have changed. */
1779 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
1783 end_multiple_change (buf, mc_count);
1785 unbind_to (count, Qnil);
1789 /* #### Shouldn't this also accept a BUFFER argument, in the good old
1790 XEmacs tradition? */
1791 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
1792 Translate characters from START to END according to TABLE.
1794 If TABLE is a string, the Nth character in it is the mapping for the
1795 character with code N.
1797 If TABLE is a vector, its Nth element is the mapping for character
1798 with code N. The values of elements may be characters, strings, or
1799 nil (nil meaning don't replace.)
1801 If TABLE is a char-table, its elements describe the mapping between
1802 characters and their replacements. The char-table should be of type
1803 `char' or `generic'.
1805 Returns the number of substitutions performed.
1807 (start, end, table))
1809 /* This function can GC */
1810 Bufpos pos, stop; /* Limits of the region. */
1811 int cnt = 0; /* Number of changes made. */
1813 struct buffer *buf = current_buffer;
1816 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1817 mc_count = begin_multiple_change (buf, pos, stop);
1818 if (STRINGP (table))
1820 struct Lisp_String *stable = XSTRING (table);
1821 Charcount size = string_char_length (stable);
1823 /* Under Mule, string_char(n) is O(n), so for large tables or
1824 large regions it makes sense to create an array of Emchars. */
1825 if (size * (stop - pos) > 65536)
1827 Emchar *etable = alloca_array (Emchar, size);
1828 convert_bufbyte_string_into_emchar_string
1829 (string_data (stable), string_length (stable), etable);
1830 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1834 Emchar nc = etable[oc];
1837 buffer_replace_char (buf, pos, nc, 0, 0);
1846 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1850 Emchar nc = string_char (stable, oc);
1853 buffer_replace_char (buf, pos, nc, 0, 0);
1860 else if (VECTORP (table))
1862 Charcount size = XVECTOR_LENGTH (table);
1863 Lisp_Object *vtable = XVECTOR_DATA (table);
1865 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1869 Lisp_Object replacement = vtable[oc];
1871 if (CHAR_OR_CHAR_INTP (replacement))
1873 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1876 buffer_replace_char (buf, pos, nc, 0, 0);
1880 else if (STRINGP (replacement))
1882 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1883 buffer_delete_range (buf, pos, pos + 1, 0);
1884 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1885 pos += incr, stop += incr;
1888 else if (!NILP (replacement))
1890 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1896 else if (CHAR_TABLEP (table)
1897 && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
1898 || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
1900 struct Lisp_Char_Table *ctable = XCHAR_TABLE (table);
1902 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1904 Lisp_Object replacement = get_char_table (oc, ctable);
1906 if (CHAR_OR_CHAR_INTP (replacement))
1908 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1911 buffer_replace_char (buf, pos, nc, 0, 0);
1915 else if (STRINGP (replacement))
1917 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1918 buffer_delete_range (buf, pos, pos + 1, 0);
1919 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1920 pos += incr, stop += incr;
1923 else if (!NILP (replacement))
1925 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1931 dead_wrong_type_argument (Qstringp, table);
1932 end_multiple_change (buf, mc_count);
1934 return make_int (cnt);
1937 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
1938 Delete the text between point and mark.
1939 When called from a program, expects two arguments,
1940 positions (integers or markers) specifying the stretch to be deleted.
1941 If BUFFER is nil, the current buffer is assumed.
1945 /* This function can GC */
1947 struct buffer *buf = decode_buffer (buffer, 1);
1949 get_buffer_range_char (buf, b, e, &start, &end, 0);
1950 buffer_delete_range (buf, start, end, 0);
1951 zmacs_region_stays = 0;
1956 widen_buffer (struct buffer *b, int no_clip)
1958 if (BUF_BEGV (b) != BUF_BEG (b))
1961 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b));
1963 if (BUF_ZV (b) != BUF_Z (b))
1966 SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b));
1972 /* Changing the buffer bounds invalidates any recorded current
1974 invalidate_current_column ();
1975 narrow_line_number_cache (b);
1979 DEFUN ("widen", Fwiden, 0, 1, "", /*
1980 Remove restrictions (narrowing) from BUFFER.
1981 This allows the buffer's full text to be seen and edited.
1982 If BUFFER is nil, the current buffer is assumed.
1986 struct buffer *b = decode_buffer (buffer, 1);
1987 widen_buffer (b, 0);
1988 zmacs_region_stays = 0;
1992 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
1993 Restrict editing in BUFFER to the current region.
1994 The rest of the text becomes temporarily invisible and untouchable
1995 but is not deleted; if you save the buffer in a file, the invisible
1996 text is included in the file. \\[widen] makes all visible again.
1997 If BUFFER is nil, the current buffer is assumed.
1998 See also `save-restriction'.
2000 When calling from a program, pass two arguments; positions (integers
2001 or markers) bounding the text that should remain visible.
2006 struct buffer *buf = decode_buffer (buffer, 1);
2007 Bytind bi_start, bi_end;
2009 get_buffer_range_char (buf, b, e, &start, &end, GB_ALLOW_PAST_ACCESSIBLE);
2010 bi_start = bufpos_to_bytind (buf, start);
2011 bi_end = bufpos_to_bytind (buf, end);
2013 SET_BOTH_BUF_BEGV (buf, start, bi_start);
2014 SET_BOTH_BUF_ZV (buf, end, bi_end);
2015 if (BUF_PT (buf) < start)
2016 BUF_SET_PT (buf, start);
2017 if (BUF_PT (buf) > end)
2018 BUF_SET_PT (buf, end);
2020 /* Changing the buffer bounds invalidates any recorded current column. */
2021 invalidate_current_column ();
2022 narrow_line_number_cache (buf);
2023 zmacs_region_stays = 0;
2028 save_restriction_save (void)
2030 Lisp_Object bottom, top;
2031 /* Note: I tried using markers here, but it does not win
2032 because insertion at the end of the saved region
2033 does not advance mh and is considered "outside" the saved region. */
2034 bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer));
2035 top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer));
2037 return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top));
2041 save_restriction_restore (Lisp_Object data)
2044 Charcount newhead, newtail;
2046 int local_clip_changed = 0;
2048 buf = XBUFFER (XCAR (data));
2049 if (!BUFFER_LIVE_P (buf))
2051 /* someone could have killed the buffer in the meantime ... */
2052 free_cons (XCONS (XCDR (data)));
2053 free_cons (XCONS (data));
2057 newhead = XINT (XCAR (tem));
2058 newtail = XINT (XCDR (tem));
2060 free_cons (XCONS (XCDR (data)));
2061 free_cons (XCONS (data));
2063 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
2071 Bytind bi_start, bi_end;
2073 start = BUF_BEG (buf) + newhead;
2074 end = BUF_Z (buf) - newtail;
2076 bi_start = bufpos_to_bytind (buf, start);
2077 bi_end = bufpos_to_bytind (buf, end);
2079 if (BUF_BEGV (buf) != start)
2081 local_clip_changed = 1;
2082 SET_BOTH_BUF_BEGV (buf, start, bi_start);
2083 narrow_line_number_cache (buf);
2085 if (BUF_ZV (buf) != end)
2087 local_clip_changed = 1;
2088 SET_BOTH_BUF_ZV (buf, end, bi_end);
2091 if (local_clip_changed)
2094 /* If point is outside the new visible range, move it inside. */
2096 bufpos_clip_to_bounds (BUF_BEGV (buf),
2103 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2104 Execute BODY, saving and restoring current buffer's restrictions.
2105 The buffer's restrictions make parts of the beginning and end invisible.
2106 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2107 This special form, `save-restriction', saves the current buffer's restrictions
2108 when it is entered, and restores them when it is exited.
2109 So any `narrow-to-region' within BODY lasts only until the end of the form.
2110 The old restrictions settings are restored
2111 even in case of abnormal exit (throw or error).
2113 The value returned is the value of the last form in BODY.
2115 `save-restriction' can get confused if, within the BODY, you widen
2116 and then make changes outside the area within the saved restrictions.
2118 Note: if you are using both `save-excursion' and `save-restriction',
2119 use `save-excursion' outermost:
2120 (save-excursion (save-restriction ...))
2124 /* This function can GC */
2125 int speccount = specpdl_depth ();
2127 record_unwind_protect (save_restriction_restore, save_restriction_save ());
2129 return unbind_to (speccount, Fprogn (body));
2133 DEFUN ("format", Fformat, 1, MANY, 0, /*
2134 Format a string out of a control-string and arguments.
2135 The first argument is a control string.
2136 The other arguments are substituted into it to make the result, a string.
2137 It may contain %-sequences meaning to substitute the next argument.
2138 %s means print all objects as-is, using `princ'.
2139 %S means print all objects as s-expressions, using `prin1'.
2140 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
2142 %c means print as a single character.
2143 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2144 %e or %E means print as a floating-point number in scientific notation
2146 %g or %G means print as a floating-point number in "pretty format";
2147 depending on the number, either %f or %e/%E format will be used, and
2148 trailing zeroes are removed from the fractional part.
2149 The argument used for all but %s and %S must be a number. It will be
2150 converted to an integer or a floating-point number as necessary.
2152 %$ means reposition to read a specific numbered argument; for example,
2153 %3$s would apply the `%s' to the third argument after the control string,
2154 and the next format directive would use the fourth argument, the
2155 following one the fifth argument, etc. (There must be a positive integer
2156 between the % and the $).
2157 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2158 specified between the optional repositioning spec and the conversion
2159 character; see below.
2160 An optional minimum field width may be specified after any flag characters
2161 and before the conversion character; it specifies the minimum number of
2162 characters that the converted argument will take up. Padding will be
2163 added on the left (or on the right, if the `-' flag is specified), as
2164 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2166 If the field width is specified as `*', the field width is assumed to have
2167 been specified as an argument. Any repositioning specification that
2168 would normally specify the argument to be converted will now specify
2169 where to find this field width argument, not where to find the argument
2170 to be converted. If there is no repositioning specification, the normal
2171 next argument is used. The argument to be converted will be the next
2172 argument after the field width argument unless the precision is also
2173 specified as `*' (see below).
2175 An optional period character and precision may be specified after any
2176 minimum field width. It specifies the minimum number of digits to
2177 appear in %d, %i, %o, %x, and %X conversions (the number is padded
2178 on the left with zeroes as necessary); the number of digits printed
2179 after the decimal point for %f, %e, and %E conversions; the number
2180 of significant digits printed in %g and %G conversions; and the
2181 maximum number of non-padding characters printed in %s and %S
2182 conversions. The default precision for floating-point conversions
2184 If the precision is specified as `*', the precision is assumed to have been
2185 specified as an argument. The argument used will be the next argument
2186 after the field width argument, if any. If the field width was not
2187 specified as an argument, any repositioning specification that would
2188 normally specify the argument to be converted will now specify where to
2189 find the precision argument. If there is no repositioning specification,
2190 the normal next argument is used.
2192 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2193 plus sign, respectively.
2194 The `#' flag means print numbers in an alternate, more verbose format:
2195 octal numbers begin with zero; hex numbers begin with a 0x or 0X;
2196 a decimal point is printed in %f, %e, and %E conversions even if no
2197 numbers are printed after it; and trailing zeroes are not omitted in
2198 %g and %G conversions.
2200 Use %% to put a single % into the output.
2202 (int nargs, Lisp_Object *args))
2204 /* It should not be necessary to GCPRO ARGS, because
2205 the caller in the interpreter should take care of that. */
2207 CHECK_STRING (args[0]);
2208 return emacs_doprnt_string_lisp (0, args[0], 0, nargs - 1, args + 1);
2212 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
2213 Return t if two characters match, optionally ignoring case.
2214 Both arguments must be characters (i.e. NOT integers).
2215 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2216 If BUFFER is nil, the current buffer is assumed.
2221 struct buffer *b = decode_buffer (buffer, 1);
2223 CHECK_CHAR_COERCE_INT (c1);
2224 CHECK_CHAR_COERCE_INT (c2);
2228 return (!NILP (b->case_fold_search)
2229 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
2234 DEFUN ("char=", Fchar_Equal, 2, 3, 0, /*
2235 Return t if two characters match, case is significant.
2236 Both arguments must be characters (i.e. NOT integers).
2237 The optional buffer argument is for symmetry and is ignored.
2241 CHECK_CHAR_COERCE_INT (c1);
2242 CHECK_CHAR_COERCE_INT (c2);
2244 return XCHAR(c1) == XCHAR(c2) ? Qt : Qnil;
2247 #if 0 /* Undebugged FSFmacs code */
2248 /* Transpose the markers in two regions of the current buffer, and
2249 adjust the ones between them if necessary (i.e.: if the regions
2252 Traverses the entire marker list of the buffer to do so, adding an
2253 appropriate amount to some, subtracting from some, and leaving the
2254 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2256 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2259 transpose_markers (Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2261 Charcount amt1, amt2, diff;
2263 struct buffer *buf = current_buffer;
2265 /* Update point as if it were a marker. */
2266 if (BUF_PT (buf) < start1)
2268 else if (BUF_PT (buf) < end1)
2269 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
2270 else if (BUF_PT (buf) < start2)
2271 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
2272 else if (BUF_PT (buf) < end2)
2273 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
2275 /* We used to adjust the endpoints here to account for the gap, but that
2276 isn't good enough. Even if we assume the caller has tried to move the
2277 gap out of our way, it might still be at start1 exactly, for example;
2278 and that places it `inside' the interval, for our purposes. The amount
2279 of adjustment is nontrivial if there's a `denormalized' marker whose
2280 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2281 the dirty work to Fmarker_position, below. */
2283 /* The difference between the region's lengths */
2284 diff = (end2 - start2) - (end1 - start1);
2286 /* For shifting each marker in a region by the length of the other
2287 * region plus the distance between the regions.
2289 amt1 = (end2 - start2) + (start2 - end1);
2290 amt2 = (end1 - start1) + (start2 - end1);
2292 for (marker = BUF_MARKERS (buf); !NILP (marker);
2293 marker = XMARKER (marker)->chain)
2295 Bufpos mpos = marker_position (marker);
2296 if (mpos >= start1 && mpos < end2)
2300 else if (mpos < start2)
2304 set_marker_position (marker, mpos);
2311 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2312 Transpose region START1 to END1 with START2 to END2.
2313 The regions may not be overlapping, because the size of the buffer is
2314 never changed in a transposition.
2316 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose
2317 any markers that happen to be located in the regions. (#### BUG: currently
2318 this function always acts as if LEAVE_MARKERS is non-nil.)
2320 Transposing beyond buffer boundaries is an error.
2322 (startr1, endr1, startr2, endr2, leave_markers))
2324 Bufpos start1, end1, start2, end2;
2325 Charcount len1, len2;
2326 Lisp_Object string1, string2;
2327 struct buffer *buf = current_buffer;
2329 get_buffer_range_char (buf, startr1, endr1, &start1, &end1, 0);
2330 get_buffer_range_char (buf, startr2, endr2, &start2, &end2, 0);
2332 len1 = end1 - start1;
2333 len2 = end2 - start2;
2336 error ("transposed regions not properly ordered");
2337 else if (start1 == end1 || start2 == end2)
2338 error ("transposed region may not be of length 0");
2340 string1 = make_string_from_buffer (buf, start1, len1);
2341 string2 = make_string_from_buffer (buf, start2, len2);
2342 buffer_delete_range (buf, start2, end2, 0);
2343 buffer_insert_lisp_string_1 (buf, start2, string1, 0);
2344 buffer_delete_range (buf, start1, end1, 0);
2345 buffer_insert_lisp_string_1 (buf, start1, string2, 0);
2347 /* In FSFmacs there is a whole bunch of really ugly code here
2348 to attempt to transpose the regions without using up any
2349 extra memory. Although the intent may be good, the result
2350 was highly bogus. */
2356 /************************************************************************/
2357 /* initialization */
2358 /************************************************************************/
2361 syms_of_editfns (void)
2363 defsymbol (&Qpoint, "point");
2364 defsymbol (&Qmark, "mark");
2365 defsymbol (&Qregion_beginning, "region-beginning");
2366 defsymbol (&Qregion_end, "region-end");
2367 defsymbol (&Qformat, "format");
2368 defsymbol (&Quser_files_and_directories, "user-files-and-directories");
2370 DEFSUBR (Fchar_equal);
2371 DEFSUBR (Fchar_Equal);
2372 DEFSUBR (Fgoto_char);
2373 DEFSUBR (Fstring_to_char);
2374 DEFSUBR (Fchar_to_string);
2375 DEFSUBR (Fbuffer_substring);
2376 DEFSUBR (Fbuffer_substring_no_properties);
2378 DEFSUBR (Fpoint_marker);
2379 DEFSUBR (Fmark_marker);
2381 DEFSUBR (Fregion_beginning);
2382 DEFSUBR (Fregion_end);
2383 DEFSUBR (Fsave_excursion);
2384 DEFSUBR (Fsave_current_buffer);
2386 DEFSUBR (Fbuffer_size);
2387 DEFSUBR (Fpoint_max);
2388 DEFSUBR (Fpoint_min);
2389 DEFSUBR (Fpoint_min_marker);
2390 DEFSUBR (Fpoint_max_marker);
2396 DEFSUBR (Ffollowing_char);
2397 DEFSUBR (Fpreceding_char);
2398 DEFSUBR (Fchar_after);
2399 DEFSUBR (Fchar_before);
2401 DEFSUBR (Finsert_string);
2402 DEFSUBR (Finsert_before_markers);
2403 DEFSUBR (Finsert_char);
2405 DEFSUBR (Ftemp_directory);
2406 DEFSUBR (Fuser_login_name);
2407 DEFSUBR (Fuser_real_login_name);
2408 DEFSUBR (Fuser_uid);
2409 DEFSUBR (Fuser_real_uid);
2410 DEFSUBR (Fuser_full_name);
2411 DEFSUBR (Fuser_home_directory);
2412 DEFSUBR (Femacs_pid);
2413 DEFSUBR (Fcurrent_time);
2414 DEFSUBR (Fcurrent_process_time);
2415 DEFSUBR (Fformat_time_string);
2416 DEFSUBR (Fdecode_time);
2417 DEFSUBR (Fencode_time);
2418 DEFSUBR (Fcurrent_time_string);
2419 DEFSUBR (Fcurrent_time_zone);
2420 DEFSUBR (Fset_time_zone_rule);
2421 DEFSUBR (Fsystem_name);
2424 DEFSUBR (Finsert_buffer_substring);
2425 DEFSUBR (Fcompare_buffer_substrings);
2426 DEFSUBR (Fsubst_char_in_region);
2427 DEFSUBR (Ftranslate_region);
2428 DEFSUBR (Fdelete_region);
2430 DEFSUBR (Fnarrow_to_region);
2431 DEFSUBR (Fsave_restriction);
2432 DEFSUBR (Ftranspose_regions);
2434 defsymbol (&Qzmacs_update_region, "zmacs-update-region");
2435 defsymbol (&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2436 defsymbol (&Qzmacs_region_buffer, "zmacs-region-buffer");
2440 vars_of_editfns (void)
2442 staticpro (&Vsystem_name);
2444 staticpro (&Vuser_name);
2445 staticpro (&Vuser_real_name);
2447 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
2448 *Whether LISPM-style active regions should be used.
2449 This means that commands which operate on the region (the area between the
2450 point and the mark) will only work while the region is in the ``active''
2451 state, which is indicated by highlighting. Executing most commands causes
2452 the region to not be in the active state, so (for example) \\[kill-region] will only
2453 work immediately after activating the region.
2457 - Commands which operate on the region only work if the region is active.
2458 - Only a very small set of commands cause the region to become active:
2459 Those commands whose semantics are to mark an area, like mark-defun.
2460 - The region is deactivated after each command that is executed, except that:
2461 - "Motion" commands do not change whether the region is active or not.
2463 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2464 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2465 between point and the recently-pushed mark to be highlighted. It will
2466 remain highlighted until some non-motion command is executed.
2468 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2469 region and execute a command that operates on it, you can reactivate the
2470 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2473 Generally, commands which push marks as a means of navigation (like
2474 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2475 region. But commands which push marks as a means of marking an area of
2476 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2477 do activate the region.
2479 The way the command loop actually works with regard to deactivating the
2480 region is as follows:
2482 - If the variable `zmacs-region-stays' has been set to t during the command
2483 just executed, the region is left alone (this is how the motion commands
2484 make the region stay around; see the `_' flag in the `interactive'
2485 specification). `zmacs-region-stays' is reset to nil before each command
2487 - If the function `zmacs-activate-region' has been called during the command
2488 just executed, the region is left alone. Very few functions should
2489 actually call this function.
2490 - Otherwise, if the region is active, the region is deactivated and
2491 the `zmacs-deactivate-region-hook' is called.
2493 /* Zmacs style active regions are now ON by default */
2496 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
2497 Do not alter this. It is for internal use only.
2499 zmacs_region_active_p = 0;
2501 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
2502 Whether the current command will deactivate the region.
2503 Commands which do not wish to affect whether the region is currently
2504 highlighted should set this to t. Normally, the region is turned off after
2505 executing each command that did not explicitly turn it on with the function
2506 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2507 See the variable `zmacs-regions'.
2509 The same effect can be achieved using the `_' interactive specification.
2511 zmacs_region_stays = 0;
2513 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2514 Do not use this -- it will be going away soon.
2515 Indicates if `goto-char' has just been run. This information is allegedly
2516 needed to get the desired behavior for atomic extents and unfortunately
2517 is not available by any other means.
2519 atomic_extent_goto_char_p = 0;
2520 #ifdef AMPERSAND_FULL_NAME
2521 Fprovide(intern("ampersand-full-name"));
2524 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
2525 *The name of the user.
2526 The function `user-full-name', which will return the value of this
2527 variable, when called without arguments.
2528 This is initialized to the value of the NAME environment variable.
2530 /* Initialized at run-time. */
2531 Vuser_full_name = Qnil;