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 */
42 #include "line-number.h"
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);
67 char *get_system_name (void);
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 behaviour 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);
552 return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
555 DEFUN ("eolp", Feolp, 0, 1, 0, /*
556 Return t if point is at the end of a line.
557 `End of a line' includes point being at the end of the buffer.
558 If BUFFER is nil, the current buffer is assumed.
562 struct buffer *b = decode_buffer (buffer, 1);
563 return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n')
567 DEFUN ("char-after", Fchar_after, 0, 2, 0, /*
568 Return character in BUFFER at position POS.
569 POS is an integer or a buffer pointer.
570 If POS is out of range, the value is nil.
571 If BUFFER is nil, the current buffer is assumed.
572 if POS is nil, the value of point 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));
580 if (n < 0 || n == BUF_ZV (b))
582 return make_char (BUF_FETCH_CHAR (b, n));
585 DEFUN ("char-before", Fchar_before, 0, 2, 0, /*
586 Return character in BUFFER before position POS.
587 POS is an integer or a buffer pointer.
588 If POS is out of range, the value is nil.
589 If BUFFER is nil, the current buffer is assumed.
590 if POS is nil, the value of point is assumed.
594 struct buffer *b = decode_buffer (buffer, 1);
595 Bufpos n = ((NILP (pos) ? BUF_PT (b) :
596 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD)));
600 if (n < BUF_BEGV (b))
602 return make_char (BUF_FETCH_CHAR (b, n));
606 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
607 Return the pathname to the directory to use for temporary files.
608 On NT/MSDOS, this is obtained from the TEMP or TMP environment variables,
609 defaulting to / if they are both undefined.
610 On Unix it is obtained from TMPDIR, with /tmp as the default
615 #if defined(WINDOWSNT) || defined(MSDOS)
616 tmpdir = getenv ("TEMP");
618 tmpdir = getenv ("TMP");
621 #else /* WINDOWSNT || MSDOS */
622 tmpdir = getenv ("TMPDIR");
627 return build_ext_string (tmpdir, FORMAT_FILENAME);
630 DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
631 Return the name under which the user logged in, as a string.
632 This is based on the effective uid, not the real uid.
633 Also, if the environment variable LOGNAME or USER is set,
634 that determines the value of this function.
635 If the optional argument UID is present, then environment variables are
636 ignored and this function returns the login name for that UID, or nil.
646 local_uid = XINT(uid);
647 returned_name = user_login_name(&local_uid);
651 returned_name = user_login_name(NULL);
653 /* #### - I believe this should return nil instead of "unknown" when pw==0
654 pw=0 is indicated by a null return from user_login_name
656 return returned_name ? build_string (returned_name) : Qnil;
659 /* This function may be called from other C routines when a
660 character string representation of the user_login_name is
661 needed but a Lisp Object is not. The UID is passed by
662 reference. If UID == NULL, then the USER name
663 for the user running XEmacs will be returned. This
664 corresponds to a nil argument to Fuser_login_name.
667 user_login_name (int *uid)
669 struct passwd *pw = NULL;
671 /* uid == NULL to return name of this user */
674 pw = getpwuid (*uid);
675 return pw ? pw->pw_name : NULL;
679 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
680 old environment (I site observed behavior on sunos and linux), so the
681 environment variables should be disregarded in that case. --Stig */
682 char *user_name = getenv ("LOGNAME");
686 "USERNAME" /* it's USERNAME on NT */
695 pw = getpwuid (geteuid ());
697 /* Since the Cygwin environment may not have an /etc/passwd,
698 return "unknown" instead of the null if the username
699 cannot be determined.
701 return pw ? pw->pw_name : "unknown";
703 /* For all but Cygwin return NULL (nil) */
704 return pw ? pw->pw_name : NULL;
710 DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
711 Return the name of the user's real uid, as a string.
712 This ignores the environment variables LOGNAME and USER, so it differs from
713 `user-login-name' when running under `su'.
717 struct passwd *pw = getpwuid (getuid ());
718 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
721 /* We let the real user name default to "root" because that's quite
722 accurate on MSDOG and because it lets Emacs find the init file.
723 (The DVX libraries override the Djgpp libraries here.) */
724 Lisp_Object tem = build_string (pw ? pw->pw_name : "root");/* no gettext */
726 Lisp_Object tem = build_string (pw ? pw->pw_name : "unknown");/* no gettext */
731 DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /*
732 Return the effective uid of Emacs, as an integer.
736 return make_int (geteuid ());
739 DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
740 Return the real uid of Emacs, as an integer.
744 return make_int (getuid ());
747 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
748 Return the full name of the user logged in, as a string.
749 If the optional argument USER is given, then the full name for that
750 user is returned, or nil. USER may be either a login name or a uid.
752 If USER is nil, and `user-full-name' contains a string, the
753 value of `user-full-name' is returned.
757 Lisp_Object user_name;
758 struct passwd *pw = NULL;
762 if (NILP (user) && STRINGP (Vuser_full_name))
763 return Vuser_full_name;
765 user_name = (STRINGP (user) ? user : Fuser_login_name (user));
766 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
768 CONST char *user_name_ext;
770 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
771 things get wedged if a SIGIO arrives during this time. */
772 GET_C_STRING_OS_DATA_ALLOCA (user_name, user_name_ext);
773 slow_down_interrupts ();
774 pw = (struct passwd *) getpwnam (user_name_ext);
775 speed_up_interrupts ();
778 /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
779 /* Ben sez: bad idea because it's likely to break something */
780 #ifndef AMPERSAND_FULL_NAME
781 p = ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext */
784 p = ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext */
787 tem = ((!NILP (user) && !pw)
789 : make_ext_string ((Extbyte *) p, (q ? q - p : strlen (p)),
792 #ifdef AMPERSAND_FULL_NAME
795 p = (char *) XSTRING_DATA (tem);
797 /* Substitute the login name for the &, upcasing the first character. */
800 char *r = (char *) alloca (strlen (p) + XSTRING_LENGTH (user_name) + 1);
801 memcpy (r, p, q - p);
803 strcat (r, (char *) XSTRING_DATA (user_name));
804 /* #### current_buffer dependency! */
805 r[q - p] = UPCASE (current_buffer, r[q - p]);
807 tem = build_string (r);
810 #endif /* AMPERSAND_FULL_NAME */
815 static char *cached_home_directory;
818 uncache_home_directory (void)
820 cached_home_directory = NULL; /* in some cases, this may cause the leaking
825 get_home_directory (void)
827 int output_home_warning = 0;
829 if (cached_home_directory == NULL)
831 if ((cached_home_directory = getenv("HOME")) == NULL)
833 #if defined(WINDOWSNT) && !defined(__CYGWIN32__)
834 char *homedrive, *homepath;
836 if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
837 (homepath = getenv("HOMEPATH")) != NULL)
839 cached_home_directory =
840 (char *) xmalloc(strlen(homedrive) + strlen(homepath) + 1);
841 sprintf(cached_home_directory, "%s%s", homedrive, homepath);
847 * Use the current directory.
848 * This preserves the existing XEmacs behavior, but is different
851 if (initial_directory[0] != '\0')
853 cached_home_directory = initial_directory;
857 /* This will probably give the wrong value */
858 cached_home_directory = getcwd (NULL, 0);
862 * This is NT Emacs behavior
864 cached_home_directory = "C:\\";
865 output_home_warning = 1;
868 #else /* !WINDOWSNT */
871 * Using "/" isn't quite right, but what should we do?
872 * We probably should try to extract pw_dir from /etc/passwd,
873 * before falling back to this.
875 cached_home_directory = "/";
876 output_home_warning = 1;
877 #endif /* !WINDOWSNT */
879 if (initialized && output_home_warning)
881 warn_when_safe(Quser_files_and_directories, Qwarning, "\n"
882 " XEmacs was unable to determine a good value for the user's $HOME\n"
883 " directory, and will be using the value:\n"
885 " This is probably incorrect.",
886 cached_home_directory
890 return (cached_home_directory);
893 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
894 Return the user's home directory, as a string.
898 Lisp_Object directory;
902 path = get_home_directory ();
906 Fexpand_file_name (Fsubstitute_in_file_name (build_string (path)),
912 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
913 Return the name of the machine you are running on, as a string.
917 return Fcopy_sequence (Vsystem_name);
920 /* For the benefit of callers who don't want to include lisp.h.
923 get_system_name (void)
925 return xstrdup ((char *) XSTRING_DATA (Vsystem_name));
928 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
929 Return the process ID of Emacs, as an integer.
933 return make_int (getpid ());
936 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
937 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
938 The time is returned as a list of three integers. The first has the
939 most significant 16 bits of the seconds, while the second has the
940 least significant 16 bits. The third integer gives the microsecond
943 The microsecond count is zero on systems that do not provide
944 resolution finer than a second.
951 return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
952 make_int ((EMACS_SECS (t) >> 0) & 0xffff),
953 make_int (EMACS_USECS (t)));
956 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
957 Return the amount of time used by this XEmacs process so far.
958 The return value is a list of three floating-point numbers, expressing
959 the user, system, and real times used by the process. The user time
960 measures the time actually spent by the CPU executing the code in this
961 process. The system time measures time spent by the CPU executing kernel
962 code on behalf of this process (e.g. I/O requests made by the process).
964 Note that the user and system times measure processor time, as opposed
965 to real time, and only accrue when the processor is actually doing
966 something: Time spent in an idle wait (waiting for user events to come
967 in or for I/O on a disk drive or other device to complete) does not
968 count. Thus, the user and system times will often be considerably
969 less than the real time.
971 Some systems do not allow the user and system times to be distinguished.
972 In this case, the user time will be the total processor time used by
973 the process, and the system time will be 0.
975 Some systems do not allow the real and processor times to be distinguished.
976 In this case, the user and real times will be the same and the system
981 double user, sys, real;
983 get_process_times (&user, &sys, &real);
984 return list3 (make_float (user), make_float (sys), make_float (real));
988 int lisp_to_time (Lisp_Object specified_time, time_t *result);
990 lisp_to_time (Lisp_Object specified_time, time_t *result)
992 Lisp_Object high, low;
994 if (NILP (specified_time))
995 return time (result) != -1;
997 CHECK_CONS (specified_time);
998 high = XCAR (specified_time);
999 low = XCDR (specified_time);
1004 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
1005 return *result >> 16 == XINT (high);
1008 Lisp_Object time_to_lisp (time_t the_time);
1010 time_to_lisp (time_t the_time)
1012 unsigned int item = (unsigned int) the_time;
1013 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
1016 size_t emacs_strftime (char *string, size_t max, CONST char *format,
1017 CONST struct tm *tm);
1018 static long difftm (CONST struct tm *a, CONST struct tm *b);
1021 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
1022 Use FORMAT-STRING to format the time TIME.
1023 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1024 `current-time' and `file-attributes'. If TIME is not specified it
1025 defaults to the current time.
1026 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1027 %a is replaced by the abbreviated name of the day of week.
1028 %A is replaced by the full name of the day of week.
1029 %b is replaced by the abbreviated name of the month.
1030 %B is replaced by the full name of the month.
1031 %c is a synonym for "%x %X".
1032 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1033 %d is replaced by the day of month, zero-padded.
1034 %D is a synonym for "%m/%d/%y".
1035 %e is replaced by the day of month, blank-padded.
1036 %h is a synonym for "%b".
1037 %H is replaced by the hour (00-23).
1038 %I is replaced by the hour (00-12).
1039 %j is replaced by the day of the year (001-366).
1040 %k is replaced by the hour (0-23), blank padded.
1041 %l is replaced by the hour (1-12), blank padded.
1042 %m is replaced by the month (01-12).
1043 %M is replaced by the minute (00-59).
1044 %n is a synonym for "\\n".
1045 %p is replaced by AM or PM, as appropriate.
1046 %r is a synonym for "%I:%M:%S %p".
1047 %R is a synonym for "%H:%M".
1048 %S is replaced by the second (00-60).
1049 %t is a synonym for "\\t".
1050 %T is a synonym for "%H:%M:%S".
1051 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1052 %w is replaced by the day of week (0-6), Sunday is day 0.
1053 %W is replaced by the week of the year (00-53), first day of week is Monday.
1054 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1055 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1056 %y is replaced by the year without century (00-99).
1057 %Y is replaced by the year with century.
1058 %Z is replaced by the time zone abbreviation.
1060 The number of options reflects the `strftime' function.
1062 BUG: If the charset used by the current locale is not ISO 8859-1, the
1063 characters appearing in the day and month names may be incorrect.
1065 (format_string, _time))
1070 CHECK_STRING (format_string);
1072 if (! lisp_to_time (_time, &value))
1073 error ("Invalid time specification");
1075 /* This is probably enough. */
1076 size = XSTRING_LENGTH (format_string) * 6 + 50;
1080 char *buf = (char *) alloca (size);
1082 if (emacs_strftime (buf, size,
1083 (CONST char *) XSTRING_DATA (format_string),
1086 return build_ext_string (buf, FORMAT_BINARY);
1087 /* If buffer was too small, make it bigger. */
1092 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
1093 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1094 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1095 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1096 to use the current time. The list has the following nine members:
1097 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1098 only some operating systems support. MINUTE is an integer between 0 and 59.
1099 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
1100 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
1101 four-digit year. DOW is the day of week, an integer between 0 and 6, where
1102 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
1103 ZONE is an integer indicating the number of seconds east of Greenwich.
1104 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1110 struct tm *decoded_time;
1111 Lisp_Object list_args[9];
1113 if (! lisp_to_time (specified_time, &time_spec))
1114 error ("Invalid time specification");
1116 decoded_time = localtime (&time_spec);
1117 XSETINT (list_args[0], decoded_time->tm_sec);
1118 XSETINT (list_args[1], decoded_time->tm_min);
1119 XSETINT (list_args[2], decoded_time->tm_hour);
1120 XSETINT (list_args[3], decoded_time->tm_mday);
1121 XSETINT (list_args[4], decoded_time->tm_mon + 1);
1122 XSETINT (list_args[5], decoded_time->tm_year + 1900);
1123 XSETINT (list_args[6], decoded_time->tm_wday);
1124 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
1126 /* Make a copy, in case gmtime modifies the struct. */
1127 save_tm = *decoded_time;
1128 decoded_time = gmtime (&time_spec);
1129 if (decoded_time == 0)
1130 list_args[8] = Qnil;
1132 XSETINT (list_args[8], difftm (&save_tm, decoded_time));
1133 return Flist (9, list_args);
1136 static void set_time_zone_rule (char *tzstring);
1138 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
1139 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1140 This is the reverse operation of `decode-time', which see.
1141 ZONE defaults to the current time zone rule. This can
1142 be a string (as from `set-time-zone-rule'), or it can be a list
1143 \(as from `current-time-zone') or an integer (as from `decode-time')
1144 applied without consideration for daylight savings time.
1146 You can pass more than 7 arguments; then the first six arguments
1147 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1148 The intervening arguments are ignored.
1149 This feature lets (apply 'encode-time (decode-time ...)) work.
1151 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1152 for example, a DAY of 0 means the day preceding the given month.
1153 Year numbers less than 100 are treated just like other year numbers.
1154 If you want them to stand for years in this century, you must do that yourself.
1156 (int nargs, Lisp_Object *args))
1160 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1162 CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */
1163 CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */
1164 CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */
1165 CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */
1166 CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */
1167 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
1174 _time = mktime (&tm);
1179 char **oldenv = environ, **newenv;
1182 tzstring = (char *) XSTRING_DATA (zone);
1183 else if (INTP (zone))
1185 int abszone = abs (XINT (zone));
1186 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
1187 abszone / (60*60), (abszone/60) % 60, abszone % 60);
1191 error ("Invalid time zone specification");
1193 /* Set TZ before calling mktime; merely adjusting mktime's returned
1194 value doesn't suffice, since that would mishandle leap seconds. */
1195 set_time_zone_rule (tzstring);
1197 _time = mktime (&tm);
1199 /* Restore TZ to previous value. */
1203 #ifdef LOCALTIME_CACHE
1208 if (_time == (time_t) -1)
1209 error ("Specified time is not representable");
1211 return wasteful_word_to_lisp (_time);
1214 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1215 Return the current time, as a human-readable string.
1216 Programs can use this function to decode a time,
1217 since the number of columns in each field is fixed.
1218 The format is `Sun Sep 16 01:03:52 1973'.
1219 If an argument is given, it specifies a time to format
1220 instead of the current time. The argument should have the form:
1223 (HIGH LOW . IGNORED).
1224 Thus, you can use times obtained from `current-time'
1225 and from `file-attributes'.
1233 if (! lisp_to_time (specified_time, &value))
1235 tem = (char *) ctime (&value);
1237 strncpy (buf, tem, 24);
1240 return build_ext_string (buf, FORMAT_BINARY);
1243 #define TM_YEAR_ORIGIN 1900
1245 /* Yield A - B, measured in seconds. */
1247 difftm (CONST struct tm *a, CONST struct tm *b)
1249 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1250 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1251 /* Some compilers can't handle this as a single return statement. */
1253 /* difference in day of year */
1254 a->tm_yday - b->tm_yday
1255 /* + intervening leap days */
1256 + ((ay >> 2) - (by >> 2))
1258 + ((ay/100 >> 2) - (by/100 >> 2))
1259 /* + difference in years * 365 */
1260 + (long)(ay-by) * 365
1262 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
1263 + (a->tm_min - b->tm_min))
1264 + (a->tm_sec - b->tm_sec));
1267 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1268 Return the offset and name for the local time zone.
1269 This returns a list of the form (OFFSET NAME).
1270 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1271 A negative value means west of Greenwich.
1272 NAME is a string giving the name of the time zone.
1273 If an argument is given, it specifies when the time zone offset is determined
1274 instead of using the current time. The argument should have the form:
1277 (HIGH LOW . IGNORED).
1278 Thus, you can use times obtained from `current-time'
1279 and from `file-attributes'.
1281 Some operating systems cannot provide all this information to Emacs;
1282 in this case, `current-time-zone' returns a list containing nil for
1283 the data it can't find.
1288 struct tm *t = NULL;
1290 if (lisp_to_time (specified_time, &value)
1291 && (t = gmtime (&value)) != 0)
1293 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */
1297 t = localtime (&value);
1298 offset = difftm (t, &gmt);
1302 s = (char *)t->tm_zone;
1303 #else /* not HAVE_TM_ZONE */
1305 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1306 s = tzname[t->tm_isdst];
1308 #endif /* not HAVE_TM_ZONE */
1311 /* No local time zone name is available; use "+-NNNN" instead. */
1312 int am = (offset < 0 ? -offset : offset) / 60;
1313 sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
1316 return list2 (make_int (offset), build_string (s));
1319 return list2 (Qnil, Qnil);
1322 #ifdef LOCALTIME_CACHE
1324 /* These two values are known to load tz files in buggy implementations,
1325 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1326 Their values shouldn't matter in non-buggy implementations.
1327 We don't use string literals for these strings,
1328 since if a string in the environment is in readonly
1329 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1330 See Sun bugs 1113095 and 1114114, ``Timezone routines
1331 improperly modify environment''. */
1333 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1334 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1338 /* Set the local time zone rule to TZSTRING.
1339 This allocates memory into `environ', which it is the caller's
1340 responsibility to free. */
1342 set_time_zone_rule (char *tzstring)
1345 char **from, **to, **newenv;
1347 for (from = environ; *from; from++)
1349 envptrs = from - environ + 2;
1350 newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
1351 + (tzstring ? strlen (tzstring) + 4 : 0));
1354 char *t = (char *) (to + envptrs);
1356 strcat (t, tzstring);
1360 for (from = environ; *from; from++)
1361 if (strncmp (*from, "TZ=", 3) != 0)
1367 #ifdef LOCALTIME_CACHE
1369 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1370 "US/Pacific" that loads a tz file, then changes to a value like
1371 "XXX0" that does not load a tz file, and then changes back to
1372 its original value, the last change is (incorrectly) ignored.
1373 Also, if TZ changes twice in succession to values that do
1374 not load a tz file, tzset can dump core (see Sun bug#1225179).
1375 The following code works around these bugs. */
1379 /* Temporarily set TZ to a value that loads a tz file
1380 and that differs from tzstring. */
1382 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
1383 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
1389 /* The implied tzstring is unknown, so temporarily set TZ to
1390 two different values that each load a tz file. */
1391 *to = set_time_zone_rule_tz1;
1394 *to = set_time_zone_rule_tz2;
1399 /* Now TZ has the desired value, and tzset can be invoked safely. */
1406 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1407 Set the local time zone using TZ, a string specifying a time zone rule.
1408 If TZ is nil, use implementation-defined default time zone information.
1419 tzstring = (char *) XSTRING_DATA (tz);
1422 set_time_zone_rule (tzstring);
1425 environbuf = environ;
1432 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
1434 /* This function can GC */
1435 struct gcpro gcpro1;
1438 if (CHAR_OR_CHAR_INTP (arg))
1440 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
1442 else if (STRINGP (arg))
1444 buffer_insert_lisp_string (buf, arg);
1448 arg = wrong_type_argument (Qchar_or_string_p, arg);
1451 zmacs_region_stays = 0;
1456 /* Callers passing one argument to Finsert need not gcpro the
1457 argument "array", since the only element of the array will
1458 not be used after calling insert_emacs_char or insert_lisp_string,
1459 so we don't care if it gets trashed. */
1461 DEFUN ("insert", Finsert, 0, MANY, 0, /*
1462 Insert the arguments, either strings or characters, at point.
1463 Point moves forward so that it ends up after the inserted text.
1464 Any other markers at the point of insertion remain before the text.
1465 If a string has non-null string-extent-data, new extents will be created.
1467 (int nargs, Lisp_Object *args))
1469 /* This function can GC */
1470 REGISTER int argnum;
1472 for (argnum = 0; argnum < nargs; argnum++)
1474 buffer_insert1 (current_buffer, args[argnum]);
1480 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1481 Insert strings or characters at point, relocating markers after the text.
1482 Point moves forward so that it ends up after the inserted text.
1483 Any other markers at the point of insertion also end up after the text.
1485 (int nargs, Lisp_Object *args))
1487 /* This function can GC */
1488 REGISTER int argnum;
1489 REGISTER Lisp_Object tem;
1491 for (argnum = 0; argnum < nargs; argnum++)
1495 if (CHAR_OR_CHAR_INTP (tem))
1497 buffer_insert_emacs_char_1 (current_buffer, -1,
1498 XCHAR_OR_CHAR_INT (tem),
1499 INSDEL_BEFORE_MARKERS);
1501 else if (STRINGP (tem))
1503 buffer_insert_lisp_string_1 (current_buffer, -1, tem,
1504 INSDEL_BEFORE_MARKERS);
1508 tem = wrong_type_argument (Qchar_or_string_p, tem);
1512 zmacs_region_stays = 0;
1516 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
1517 Insert STRING into BUFFER at BUFFER's point.
1518 Point moves forward so that it ends up after the inserted text.
1519 Any other markers at the point of insertion remain before the text.
1520 If a string has non-null string-extent-data, new extents will be created.
1521 BUFFER defaults to the current buffer.
1525 struct buffer *b = decode_buffer (buffer, 1);
1526 CHECK_STRING (string);
1527 buffer_insert_lisp_string (b, string);
1528 zmacs_region_stays = 0;
1532 /* Third argument in FSF is INHERIT:
1534 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1535 from adjoining text, if those properties are sticky."
1537 Jamie thinks this is bogus. */
1540 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
1541 Insert COUNT (second arg) copies of CHR (first arg).
1542 Point and all markers are affected as in the function `insert'.
1543 COUNT defaults to 1 if omitted.
1544 The optional third arg IGNORED is INHERIT under FSF Emacs.
1545 This is highly bogus, however, and XEmacs always behaves as if
1546 `t' were passed to INHERIT.
1547 The optional fourth arg BUFFER specifies the buffer to insert the
1548 text into. If BUFFER is nil, the current buffer is assumed.
1550 (chr, count, ignored, buffer))
1552 /* This function can GC */
1553 REGISTER Bufbyte *string;
1556 REGISTER Bytecount n;
1557 REGISTER Bytecount charlen;
1558 Bufbyte str[MAX_EMCHAR_LEN];
1559 struct buffer *b = decode_buffer (buffer, 1);
1562 CHECK_CHAR_COERCE_INT (chr);
1571 charlen = set_charptr_emchar (str, XCHAR (chr));
1575 slen = min (n, 768);
1576 string = alloca_array (Bufbyte, slen);
1577 /* Write as many copies of the character into the temp string as will fit. */
1578 for (i = 0; i + charlen <= slen; i += charlen)
1579 for (j = 0; j < charlen; j++)
1580 string[i + j] = str[j];
1584 buffer_insert_raw_string (b, string, slen);
1588 #if 0 /* FSFmacs bogosity */
1590 if (!NILP (inherit))
1591 insert_and_inherit (string, n);
1596 buffer_insert_raw_string (b, string, n);
1599 zmacs_region_stays = 0;
1604 /* Making strings from buffer contents. */
1606 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1607 Return the contents of part of BUFFER as a string.
1608 The two arguments START and END are character positions;
1609 they can be in either order. If omitted, they default to the beginning
1610 and end of BUFFER, respectively.
1611 If there are duplicable extents in the region, the string remembers
1612 them in its extent data.
1613 If BUFFER is nil, the current buffer is assumed.
1615 (start, end, buffer))
1617 /* This function can GC */
1619 struct buffer *b = decode_buffer (buffer, 1);
1621 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1622 return make_string_from_buffer (b, begv, zv - begv);
1625 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1626 Insert before point a substring of the contents of buffer BUFFER.
1627 BUFFER may be a buffer or a buffer name.
1628 Arguments START and END are character numbers specifying the substring.
1629 They default to the beginning and the end of BUFFER.
1631 (buffer, start, end))
1633 /* This function can GC */
1637 bp = XBUFFER (get_buffer (buffer, 1));
1638 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
1641 buffer_insert_from_buffer (current_buffer, bp, b, e - b);
1646 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1647 Compare two substrings of two buffers; return result as number.
1648 the value is -N if first string is less after N-1 chars,
1649 +N if first string is greater after N-1 chars, or 0 if strings match.
1650 Each substring is represented as three arguments: BUFFER, START and END.
1651 That makes six args in all, three for each substring.
1653 The value of `case-fold-search' in the current buffer
1654 determines whether case is significant or ignored.
1656 (buffer1, start1, end1, buffer2, start2, end2))
1658 Bufpos begp1, endp1, begp2, endp2;
1659 REGISTER Charcount len1, len2, length, i;
1660 struct buffer *bp1, *bp2;
1661 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
1662 current_buffer->case_canon_table : Qnil);
1664 /* Find the first buffer and its substring. */
1666 bp1 = decode_buffer (buffer1, 1);
1667 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1669 /* Likewise for second substring. */
1671 bp2 = decode_buffer (buffer2, 1);
1672 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1674 len1 = endp1 - begp1;
1675 len2 = endp2 - begp2;
1680 for (i = 0; i < length; i++)
1682 Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
1683 Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
1686 c1 = TRT_TABLE_OF (trt, c1);
1687 c2 = TRT_TABLE_OF (trt, c2);
1690 return make_int (- 1 - i);
1692 return make_int (i + 1);
1695 /* The strings match as far as they go.
1696 If one is shorter, that one is less. */
1698 return make_int (length + 1);
1699 else if (length < len2)
1700 return make_int (- length - 1);
1702 /* Same length too => they are equal. */
1708 subst_char_in_region_unwind (Lisp_Object arg)
1710 XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
1715 subst_char_in_region_unwind_1 (Lisp_Object arg)
1717 XBUFFER (XCAR (arg))->filename = XCDR (arg);
1721 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1722 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1723 If optional arg NOUNDO is non-nil, don't record this change for undo
1724 and don't mark the buffer as really changed.
1726 (start, end, fromchar, tochar, noundo))
1728 /* This function can GC */
1732 struct buffer *buf = current_buffer;
1733 int count = specpdl_depth ();
1735 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1736 CHECK_CHAR_COERCE_INT (fromchar);
1737 CHECK_CHAR_COERCE_INT (tochar);
1739 fromc = XCHAR (fromchar);
1740 toc = XCHAR (tochar);
1742 /* If we don't want undo, turn off putting stuff on the list.
1743 That's faster than getting rid of things,
1744 and it prevents even the entry for a first change.
1745 Also inhibit locking the file. */
1748 record_unwind_protect (subst_char_in_region_unwind,
1749 Fcons (Fcurrent_buffer (), buf->undo_list));
1750 buf->undo_list = Qt;
1751 /* Don't do file-locking. */
1752 record_unwind_protect (subst_char_in_region_unwind_1,
1753 Fcons (Fcurrent_buffer (), buf->filename));
1754 buf->filename = Qnil;
1757 mc_count = begin_multiple_change (buf, pos, stop);
1760 if (BUF_FETCH_CHAR (buf, pos) == fromc)
1762 /* There used to be some code here that set the buffer to
1763 unmodified if NOUNDO was specified and there was only
1764 one change to the buffer since it was last saved.
1765 This is a crock of shit, so I'm not duplicating this
1766 behavior. I think this was left over from when
1767 prepare_to_modify_buffer() actually bumped MODIFF,
1768 so that code was supposed to undo this change. --ben */
1769 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
1771 /* If noundo is not nil then we don't mark the buffer as
1772 modified. In reality that needs to happen externally
1773 only. Internally redisplay needs to know that the actual
1774 contents it should be displaying have changed. */
1776 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
1780 end_multiple_change (buf, mc_count);
1782 unbind_to (count, Qnil);
1786 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
1787 From START to END, translate characters according to TABLE.
1788 TABLE is a string; the Nth character in it is the mapping
1789 for the character with code N. Returns the number of characters changed.
1791 (start, end, table))
1793 /* This function can GC */
1794 Bufpos pos, stop; /* Limits of the region. */
1795 REGISTER Emchar oc; /* Old character. */
1796 REGISTER Emchar nc; /* New character. */
1797 int cnt; /* Number of changes made. */
1798 Charcount size; /* Size of translate table. */
1800 struct buffer *buf = current_buffer;
1802 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1803 CHECK_STRING (table);
1805 size = XSTRING_CHAR_LENGTH (table);
1808 mc_count = begin_multiple_change (buf, pos, stop);
1809 for (; pos < stop; pos++)
1811 oc = BUF_FETCH_CHAR (buf, pos);
1812 if (oc >= 0 && oc < size)
1814 nc = string_char (XSTRING (table), oc);
1817 buffer_replace_char (buf, pos, nc, 0, 0);
1822 end_multiple_change (buf, mc_count);
1824 return make_int (cnt);
1827 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
1828 Delete the text between point and mark.
1829 When called from a program, expects two arguments,
1830 positions (integers or markers) specifying the stretch to be deleted.
1831 If BUFFER is nil, the current buffer is assumed.
1835 /* This function can GC */
1837 struct buffer *buf = decode_buffer (buffer, 1);
1839 get_buffer_range_char (buf, b, e, &start, &end, 0);
1840 buffer_delete_range (buf, start, end, 0);
1841 zmacs_region_stays = 0;
1846 widen_buffer (struct buffer *b, int no_clip)
1848 if (BUF_BEGV (b) != BUF_BEG (b))
1851 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b));
1853 if (BUF_ZV (b) != BUF_Z (b))
1856 SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b));
1862 /* Changing the buffer bounds invalidates any recorded current
1864 invalidate_current_column ();
1865 narrow_line_number_cache (b);
1869 DEFUN ("widen", Fwiden, 0, 1, "", /*
1870 Remove restrictions (narrowing) from BUFFER.
1871 This allows the buffer's full text to be seen and edited.
1872 If BUFFER is nil, the current buffer is assumed.
1876 struct buffer *b = decode_buffer (buffer, 1);
1877 widen_buffer (b, 0);
1878 zmacs_region_stays = 0;
1882 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
1883 Restrict editing in BUFFER to the current region.
1884 The rest of the text becomes temporarily invisible and untouchable
1885 but is not deleted; if you save the buffer in a file, the invisible
1886 text is included in the file. \\[widen] makes all visible again.
1887 If BUFFER is nil, the current buffer is assumed.
1888 See also `save-restriction'.
1890 When calling from a program, pass two arguments; positions (integers
1891 or markers) bounding the text that should remain visible.
1896 struct buffer *buf = decode_buffer (buffer, 1);
1897 Bytind bi_start, bi_end;
1899 get_buffer_range_char (buf, b, e, &start, &end, GB_ALLOW_PAST_ACCESSIBLE);
1900 bi_start = bufpos_to_bytind (buf, start);
1901 bi_end = bufpos_to_bytind (buf, end);
1903 SET_BOTH_BUF_BEGV (buf, start, bi_start);
1904 SET_BOTH_BUF_ZV (buf, end, bi_end);
1905 if (BUF_PT (buf) < start)
1906 BUF_SET_PT (buf, start);
1907 if (BUF_PT (buf) > end)
1908 BUF_SET_PT (buf, end);
1910 /* Changing the buffer bounds invalidates any recorded current column. */
1911 invalidate_current_column ();
1912 narrow_line_number_cache (buf);
1913 zmacs_region_stays = 0;
1918 save_restriction_save (void)
1920 Lisp_Object bottom, top;
1921 /* Note: I tried using markers here, but it does not win
1922 because insertion at the end of the saved region
1923 does not advance mh and is considered "outside" the saved region. */
1924 bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer));
1925 top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer));
1927 return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top));
1931 save_restriction_restore (Lisp_Object data)
1934 Charcount newhead, newtail;
1936 int local_clip_changed = 0;
1938 buf = XBUFFER (XCAR (data));
1939 if (!BUFFER_LIVE_P (buf))
1941 /* someone could have killed the buffer in the meantime ... */
1942 free_cons (XCONS (XCDR (data)));
1943 free_cons (XCONS (data));
1947 newhead = XINT (XCAR (tem));
1948 newtail = XINT (XCDR (tem));
1950 free_cons (XCONS (XCDR (data)));
1951 free_cons (XCONS (data));
1953 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
1961 Bytind bi_start, bi_end;
1963 start = BUF_BEG (buf) + newhead;
1964 end = BUF_Z (buf) - newtail;
1966 bi_start = bufpos_to_bytind (buf, start);
1967 bi_end = bufpos_to_bytind (buf, end);
1969 if (BUF_BEGV (buf) != start)
1971 local_clip_changed = 1;
1972 SET_BOTH_BUF_BEGV (buf, start, bi_start);
1973 narrow_line_number_cache (buf);
1975 if (BUF_ZV (buf) != end)
1977 local_clip_changed = 1;
1978 SET_BOTH_BUF_ZV (buf, end, bi_end);
1981 if (local_clip_changed)
1984 /* If point is outside the new visible range, move it inside. */
1986 bufpos_clip_to_bounds (BUF_BEGV (buf),
1993 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
1994 Execute BODY, saving and restoring current buffer's restrictions.
1995 The buffer's restrictions make parts of the beginning and end invisible.
1996 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
1997 This special form, `save-restriction', saves the current buffer's restrictions
1998 when it is entered, and restores them when it is exited.
1999 So any `narrow-to-region' within BODY lasts only until the end of the form.
2000 The old restrictions settings are restored
2001 even in case of abnormal exit (throw or error).
2003 The value returned is the value of the last form in BODY.
2005 `save-restriction' can get confused if, within the BODY, you widen
2006 and then make changes outside the area within the saved restrictions.
2008 Note: if you are using both `save-excursion' and `save-restriction',
2009 use `save-excursion' outermost:
2010 (save-excursion (save-restriction ...))
2014 /* This function can GC */
2015 int speccount = specpdl_depth ();
2017 record_unwind_protect (save_restriction_restore, save_restriction_save ());
2019 return unbind_to (speccount, Fprogn (body));
2023 DEFUN ("format", Fformat, 1, MANY, 0, /*
2024 Format a string out of a control-string and arguments.
2025 The first argument is a control string.
2026 The other arguments are substituted into it to make the result, a string.
2027 It may contain %-sequences meaning to substitute the next argument.
2028 %s means print all objects as-is, using `princ'.
2029 %S means print all objects as s-expressions, using `prin1'.
2030 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
2032 %c means print as a single character.
2033 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2034 %e or %E means print as a floating-point number in scientific notation
2036 %g or %G means print as a floating-point number in "pretty format";
2037 depending on the number, either %f or %e/%E format will be used, and
2038 trailing zeroes are removed from the fractional part.
2039 The argument used for all but %s and %S must be a number. It will be
2040 converted to an integer or a floating-point number as necessary.
2042 %$ means reposition to read a specific numbered argument; for example,
2043 %3$s would apply the `%s' to the third argument after the control string,
2044 and the next format directive would use the fourth argument, the
2045 following one the fifth argument, etc. (There must be a positive integer
2046 between the % and the $).
2047 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2048 specified between the optional repositioning spec and the conversion
2049 character; see below.
2050 An optional minimum field width may be specified after any flag characters
2051 and before the conversion character; it specifies the minimum number of
2052 characters that the converted argument will take up. Padding will be
2053 added on the left (or on the right, if the `-' flag is specified), as
2054 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2056 If the field width is specified as `*', the field width is assumed to have
2057 been specified as an argument. Any repositioning specification that
2058 would normally specify the argument to be converted will now specify
2059 where to find this field width argument, not where to find the argument
2060 to be converted. If there is no repositioning specification, the normal
2061 next argument is used. The argument to be converted will be the next
2062 argument after the field width argument unless the precision is also
2063 specified as `*' (see below).
2065 An optional period character and precision may be specified after any
2066 minimum field width. It specifies the minimum number of digits to
2067 appear in %d, %i, %o, %x, and %X conversions (the number is padded
2068 on the left with zeroes as necessary); the number of digits printed
2069 after the decimal point for %f, %e, and %E conversions; the number
2070 of significant digits printed in %g and %G conversions; and the
2071 maximum number of non-padding characters printed in %s and %S
2072 conversions. The default precision for floating-point conversions
2074 If the precision is specified as `*', the precision is assumed to have been
2075 specified as an argument. The argument used will be the next argument
2076 after the field width argument, if any. If the field width was not
2077 specified as an argument, any repositioning specification that would
2078 normally specify the argument to be converted will now specify where to
2079 find the precision argument. If there is no repositioning specification,
2080 the normal next argument is used.
2082 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2083 plus sign, respectively.
2084 The `#' flag means print numbers in an alternate, more verbose format:
2085 octal numbers begin with zero; hex numbers begin with a 0x or 0X;
2086 a decimal point is printed in %f, %e, and %E conversions even if no
2087 numbers are printed after it; and trailing zeroes are not omitted in
2088 %g and %G conversions.
2090 Use %% to put a single % into the output.
2092 (int nargs, Lisp_Object *args))
2094 /* It should not be necessary to GCPRO ARGS, because
2095 the caller in the interpreter should take care of that. */
2097 CHECK_STRING (args[0]);
2098 return emacs_doprnt_string_lisp (0, args[0], 0, nargs - 1, args + 1);
2102 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
2103 Return t if two characters match, optionally ignoring case.
2104 Both arguments must be characters (i.e. NOT integers).
2105 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2106 If BUFFER is nil, the current buffer is assumed.
2111 struct buffer *b = decode_buffer (buffer, 1);
2113 CHECK_CHAR_COERCE_INT (c1);
2114 CHECK_CHAR_COERCE_INT (c2);
2118 return (!NILP (b->case_fold_search)
2119 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
2124 DEFUN ("char=", Fchar_Equal, 2, 3, 0, /*
2125 Return t if two characters match, case is significant.
2126 Both arguments must be characters (i.e. NOT integers).
2127 The optional buffer argument is for symmetry and is ignored.
2131 CHECK_CHAR_COERCE_INT (c1);
2132 CHECK_CHAR_COERCE_INT (c2);
2134 return XCHAR(c1) == XCHAR(c2) ? Qt : Qnil;
2137 #if 0 /* Undebugged FSFmacs code */
2138 /* Transpose the markers in two regions of the current buffer, and
2139 adjust the ones between them if necessary (i.e.: if the regions
2142 Traverses the entire marker list of the buffer to do so, adding an
2143 appropriate amount to some, subtracting from some, and leaving the
2144 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2146 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2149 transpose_markers (Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2151 Charcount amt1, amt2, diff;
2153 struct buffer *buf = current_buffer;
2155 /* Update point as if it were a marker. */
2156 if (BUF_PT (buf) < start1)
2158 else if (BUF_PT (buf) < end1)
2159 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
2160 else if (BUF_PT (buf) < start2)
2161 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
2162 else if (BUF_PT (buf) < end2)
2163 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
2165 /* We used to adjust the endpoints here to account for the gap, but that
2166 isn't good enough. Even if we assume the caller has tried to move the
2167 gap out of our way, it might still be at start1 exactly, for example;
2168 and that places it `inside' the interval, for our purposes. The amount
2169 of adjustment is nontrivial if there's a `denormalized' marker whose
2170 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2171 the dirty work to Fmarker_position, below. */
2173 /* The difference between the region's lengths */
2174 diff = (end2 - start2) - (end1 - start1);
2176 /* For shifting each marker in a region by the length of the other
2177 * region plus the distance between the regions.
2179 amt1 = (end2 - start2) + (start2 - end1);
2180 amt2 = (end1 - start1) + (start2 - end1);
2182 for (marker = BUF_MARKERS (buf); !NILP (marker);
2183 marker = XMARKER (marker)->chain)
2185 Bufpos mpos = marker_position (marker);
2186 if (mpos >= start1 && mpos < end2)
2190 else if (mpos < start2)
2194 set_marker_position (marker, mpos);
2201 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2202 Transpose region START1 to END1 with START2 to END2.
2203 The regions may not be overlapping, because the size of the buffer is
2204 never changed in a transposition.
2206 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose
2207 any markers that happen to be located in the regions. (#### BUG: currently
2208 this function always acts as if LEAVE_MARKERS is non-nil.)
2210 Transposing beyond buffer boundaries is an error.
2212 (startr1, endr1, startr2, endr2, leave_markers))
2214 Bufpos start1, end1, start2, end2;
2215 Charcount len1, len2;
2216 Lisp_Object string1, string2;
2217 struct buffer *buf = current_buffer;
2219 get_buffer_range_char (buf, startr1, endr1, &start1, &end1, 0);
2220 get_buffer_range_char (buf, startr2, endr2, &start2, &end2, 0);
2222 len1 = end1 - start1;
2223 len2 = end2 - start2;
2226 error ("transposed regions not properly ordered");
2227 else if (start1 == end1 || start2 == end2)
2228 error ("transposed region may not be of length 0");
2230 string1 = make_string_from_buffer (buf, start1, len1);
2231 string2 = make_string_from_buffer (buf, start2, len2);
2232 buffer_delete_range (buf, start2, end2, 0);
2233 buffer_insert_lisp_string_1 (buf, start2, string1, 0);
2234 buffer_delete_range (buf, start1, end1, 0);
2235 buffer_insert_lisp_string_1 (buf, start1, string2, 0);
2237 /* In FSFmacs there is a whole bunch of really ugly code here
2238 to attempt to transpose the regions without using up any
2239 extra memory. Although the intent may be good, the result
2240 was highly bogus. */
2246 /************************************************************************/
2247 /* initialization */
2248 /************************************************************************/
2251 syms_of_editfns (void)
2253 defsymbol (&Qpoint, "point");
2254 defsymbol (&Qmark, "mark");
2255 defsymbol (&Qregion_beginning, "region-beginning");
2256 defsymbol (&Qregion_end, "region-end");
2257 defsymbol (&Qformat, "format");
2258 defsymbol (&Quser_files_and_directories, "user-files-and-directories");
2260 DEFSUBR (Fchar_equal);
2261 DEFSUBR (Fchar_Equal);
2262 DEFSUBR (Fgoto_char);
2263 DEFSUBR (Fstring_to_char);
2264 DEFSUBR (Fchar_to_string);
2265 DEFSUBR (Fbuffer_substring);
2267 DEFSUBR (Fpoint_marker);
2268 DEFSUBR (Fmark_marker);
2270 DEFSUBR (Fregion_beginning);
2271 DEFSUBR (Fregion_end);
2272 DEFSUBR (Fsave_excursion);
2273 DEFSUBR (Fsave_current_buffer);
2275 DEFSUBR (Fbuffer_size);
2276 DEFSUBR (Fpoint_max);
2277 DEFSUBR (Fpoint_min);
2278 DEFSUBR (Fpoint_min_marker);
2279 DEFSUBR (Fpoint_max_marker);
2285 DEFSUBR (Ffollowing_char);
2286 DEFSUBR (Fpreceding_char);
2287 DEFSUBR (Fchar_after);
2288 DEFSUBR (Fchar_before);
2290 DEFSUBR (Finsert_string);
2291 DEFSUBR (Finsert_before_markers);
2292 DEFSUBR (Finsert_char);
2294 DEFSUBR (Ftemp_directory);
2295 DEFSUBR (Fuser_login_name);
2296 DEFSUBR (Fuser_real_login_name);
2297 DEFSUBR (Fuser_uid);
2298 DEFSUBR (Fuser_real_uid);
2299 DEFSUBR (Fuser_full_name);
2300 DEFSUBR (Fuser_home_directory);
2301 DEFSUBR (Femacs_pid);
2302 DEFSUBR (Fcurrent_time);
2303 DEFSUBR (Fcurrent_process_time);
2304 DEFSUBR (Fformat_time_string);
2305 DEFSUBR (Fdecode_time);
2306 DEFSUBR (Fencode_time);
2307 DEFSUBR (Fcurrent_time_string);
2308 DEFSUBR (Fcurrent_time_zone);
2309 DEFSUBR (Fset_time_zone_rule);
2310 DEFSUBR (Fsystem_name);
2313 DEFSUBR (Finsert_buffer_substring);
2314 DEFSUBR (Fcompare_buffer_substrings);
2315 DEFSUBR (Fsubst_char_in_region);
2316 DEFSUBR (Ftranslate_region);
2317 DEFSUBR (Fdelete_region);
2319 DEFSUBR (Fnarrow_to_region);
2320 DEFSUBR (Fsave_restriction);
2321 DEFSUBR (Ftranspose_regions);
2323 defsymbol (&Qzmacs_update_region, "zmacs-update-region");
2324 defsymbol (&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2325 defsymbol (&Qzmacs_region_buffer, "zmacs-region-buffer");
2329 vars_of_editfns (void)
2331 staticpro (&Vsystem_name);
2333 staticpro (&Vuser_name);
2334 staticpro (&Vuser_real_name);
2336 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
2337 *Whether LISPM-style active regions should be used.
2338 This means that commands which operate on the region (the area between the
2339 point and the mark) will only work while the region is in the ``active''
2340 state, which is indicated by highlighting. Executing most commands causes
2341 the region to not be in the active state, so (for example) \\[kill-region] will only
2342 work immediately after activating the region.
2346 - Commands which operate on the region only work if the region is active.
2347 - Only a very small set of commands cause the region to become active:
2348 Those commands whose semantics are to mark an area, like mark-defun.
2349 - The region is deactivated after each command that is executed, except that:
2350 - "Motion" commands do not change whether the region is active or not.
2352 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2353 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2354 between point and the recently-pushed mark to be highlighted. It will
2355 remain highlighted until some non-motion command is executed.
2357 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2358 region and execute a command that operates on it, you can reactivate the
2359 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2362 Generally, commands which push marks as a means of navigation (like
2363 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2364 region. But commands which push marks as a means of marking an area of
2365 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2366 do activate the region.
2368 The way the command loop actually works with regard to deactivating the
2369 region is as follows:
2371 - If the variable `zmacs-region-stays' has been set to t during the command
2372 just executed, the region is left alone (this is how the motion commands
2373 make the region stay around; see the `_' flag in the `interactive'
2374 specification). `zmacs-region-stays' is reset to nil before each command
2376 - If the function `zmacs-activate-region' has been called during the command
2377 just executed, the region is left alone. Very few functions should
2378 actually call this function.
2379 - Otherwise, if the region is active, the region is deactivated and
2380 the `zmacs-deactivate-region-hook' is called.
2382 /* Zmacs style active regions are now ON by default */
2385 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
2386 Do not alter this. It is for internal use only.
2388 zmacs_region_active_p = 0;
2390 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
2391 Whether the current command will deactivate the region.
2392 Commands which do not wish to affect whether the region is currently
2393 highlighted should set this to t. Normally, the region is turned off after
2394 executing each command that did not explicitly turn it on with the function
2395 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2396 See the variable `zmacs-regions'.
2398 The same effect can be achieved using the `_' interactive specification.
2400 zmacs_region_stays = 0;
2402 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2403 Do not use this -- it will be going away soon.
2404 Indicates if `goto-char' has just been run. This information is allegedly
2405 needed to get the desired behavior for atomic extents and unfortunately
2406 is not available by any other means.
2408 atomic_extent_goto_char_p = 0;
2409 #ifdef AMPERSAND_FULL_NAME
2410 Fprovide(intern("ampersand-full-name"));
2413 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
2414 *The name of the user.
2415 The function `user-full-name', which will return the value of this
2416 variable, when called without arguments.
2417 This is initialized to the value of the NAME environment variable.
2419 /* Initialized at run-time. */
2420 Vuser_full_name = Qnil;