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, Qnative);
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'.
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)
444 is in effect, in which case it may be greater.
445 If BUFFER is nil, the current buffer is assumed.
449 struct buffer *b = decode_buffer (buffer, 1);
450 return make_int (BUF_BEGV (b));
453 DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
454 Return a marker to the minimum permissible value of point in BUFFER.
455 This is the beginning, unless narrowing (a buffer restriction)
456 is in effect, in which case it may be greater.
457 If BUFFER is nil, the current buffer is assumed.
461 struct buffer *b = decode_buffer (buffer, 1);
462 return buildmark (BUF_BEGV (b), make_buffer (b));
465 DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
466 Return the maximum permissible value of point in BUFFER.
467 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
468 is in effect, in which case it may be less.
469 If BUFFER is nil, the current buffer is assumed.
473 struct buffer *b = decode_buffer (buffer, 1);
474 return make_int (BUF_ZV (b));
477 DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
478 Return a marker to the maximum permissible value of point in BUFFER.
479 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
480 is in effect, in which case it may be less.
481 If BUFFER is nil, the current buffer is assumed.
485 struct buffer *b = decode_buffer (buffer, 1);
486 return buildmark (BUF_ZV (b), make_buffer (b));
489 DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /*
490 Return the character following point.
491 At the end of the buffer or accessible region, return 0.
492 If BUFFER is nil, the current buffer is assumed.
496 struct buffer *b = decode_buffer (buffer, 1);
497 if (BUF_PT (b) >= BUF_ZV (b))
498 return Qzero; /* #### Gag me! */
500 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b)));
503 DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /*
504 Return the character preceding point.
505 At the beginning of the buffer or accessible region, return 0.
506 If BUFFER is nil, the current buffer is assumed.
510 struct buffer *b = decode_buffer (buffer, 1);
511 if (BUF_PT (b) <= BUF_BEGV (b))
512 return Qzero; /* #### Gag me! */
514 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1));
517 DEFUN ("bobp", Fbobp, 0, 1, 0, /*
518 Return t if point is at the beginning of the buffer.
519 If the buffer is narrowed, this means the beginning of the narrowed part.
520 If BUFFER is nil, the current buffer is assumed.
524 struct buffer *b = decode_buffer (buffer, 1);
525 return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil;
528 DEFUN ("eobp", Feobp, 0, 1, 0, /*
529 Return t if point is at the end of the buffer.
530 If the buffer is narrowed, this means the end of the narrowed part.
531 If BUFFER is nil, the current buffer is assumed.
535 struct buffer *b = decode_buffer (buffer, 1);
536 return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil;
540 beginning_of_line_p (struct buffer *b, Bufpos pt)
542 return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n';
546 DEFUN ("bolp", Fbolp, 0, 1, 0, /*
547 Return t if point is at the beginning of a line.
548 If BUFFER is nil, the current buffer is assumed.
552 struct buffer *b = decode_buffer (buffer, 1);
553 return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
556 DEFUN ("eolp", Feolp, 0, 1, 0, /*
557 Return t if point is at the end of a line.
558 `End of a line' includes point being at the end of the buffer.
559 If BUFFER is nil, the current buffer is assumed.
563 struct buffer *b = decode_buffer (buffer, 1);
564 return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n')
568 DEFUN ("char-after", Fchar_after, 0, 2, 0, /*
569 Return the character at position POS in BUFFER.
570 POS is an integer or a marker.
571 If POS is out of range, the value is nil.
572 if POS is nil, the value of point is assumed.
573 If BUFFER is nil, the current buffer is assumed.
577 struct buffer *b = decode_buffer (buffer, 1);
578 Bufpos n = (NILP (pos) ? BUF_PT (b) :
579 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
581 if (n < 0 || n == BUF_ZV (b))
583 return make_char (BUF_FETCH_CHAR (b, n));
586 DEFUN ("char-before", Fchar_before, 0, 2, 0, /*
587 Return the character preceding position POS in BUFFER.
588 POS is an integer or a marker.
589 If POS is out of range, the value is nil.
590 if POS is nil, the value of point is assumed.
591 If BUFFER is nil, the current buffer is assumed.
595 struct buffer *b = decode_buffer (buffer, 1);
596 Bufpos n = (NILP (pos) ? BUF_PT (b) :
597 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
601 if (n < BUF_BEGV (b))
603 return make_char (BUF_FETCH_CHAR (b, n));
607 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
608 Return the pathname to the directory to use for temporary files.
609 On NT/MSDOS, this is obtained from the TEMP or TMP environment variables,
610 defaulting to / if they are both undefined.
611 On Unix it is obtained from TMPDIR, with /tmp as the default
616 #if defined(WINDOWSNT) || defined(MSDOS)
617 tmpdir = getenv ("TEMP");
619 tmpdir = getenv ("TMP");
622 #else /* WINDOWSNT || MSDOS */
623 tmpdir = getenv ("TMPDIR");
628 return build_ext_string (tmpdir, Qfile_name);
631 DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
632 Return the name under which the user logged in, as a string.
633 This is based on the effective uid, not the real uid.
634 Also, if the environment variable LOGNAME or USER is set,
635 that determines the value of this function.
636 If the optional argument UID is present, then environment variables are
637 ignored and this function returns the login name for that UID, or nil.
647 local_uid = XINT (uid);
648 returned_name = user_login_name (&local_uid);
652 returned_name = user_login_name (NULL);
654 /* #### - I believe this should return nil instead of "unknown" when pw==0
655 pw=0 is indicated by a null return from user_login_name
657 return returned_name ? build_string (returned_name) : Qnil;
660 /* This function may be called from other C routines when a
661 character string representation of the user_login_name is
662 needed but a Lisp Object is not. The UID is passed by
663 reference. If UID == NULL, then the USER name
664 for the user running XEmacs will be returned. This
665 corresponds to a nil argument to Fuser_login_name.
668 user_login_name (uid_t *uid)
670 /* uid == NULL to return name of this user */
673 struct passwd *pw = getpwuid (*uid);
674 return pw ? pw->pw_name : NULL;
678 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
679 old environment (I site observed behavior on sunos and linux), so the
680 environment variables should be disregarded in that case. --Stig */
681 char *user_name = getenv ("LOGNAME");
685 "USERNAME" /* it's USERNAME on NT */
694 struct passwd *pw = getpwuid (geteuid ());
696 /* Since the Cygwin environment may not have an /etc/passwd,
697 return "unknown" instead of the null if the username
698 cannot be determined.
700 return pw ? pw->pw_name : "unknown";
702 /* For all but Cygwin return NULL (nil) */
703 return pw ? pw->pw_name : NULL;
709 DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
710 Return the name of the user's real uid, as a string.
711 This ignores the environment variables LOGNAME and USER, so it differs from
712 `user-login-name' when running under `su'.
716 struct passwd *pw = getpwuid (getuid ());
717 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
720 /* We let the real user name default to "root" because that's quite
721 accurate on MSDOG and because it lets Emacs find the init file.
722 (The DVX libraries override the Djgpp libraries here.) */
723 Lisp_Object tem = build_string (pw ? pw->pw_name : "root");/* no gettext */
725 Lisp_Object tem = build_string (pw ? pw->pw_name : "unknown");/* no gettext */
730 DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /*
731 Return the effective uid of Emacs, as an integer.
735 return make_int (geteuid ());
738 DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
739 Return the real uid of Emacs, as an integer.
743 return make_int (getuid ());
746 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
747 Return the full name of the user logged in, as a string.
748 If the optional argument USER is given, then the full name for that
749 user is returned, or nil. USER may be either a login name or a uid.
751 If USER is nil, and `user-full-name' contains a string, the
752 value of `user-full-name' is returned.
756 Lisp_Object user_name;
757 struct passwd *pw = NULL;
761 if (NILP (user) && STRINGP (Vuser_full_name))
762 return Vuser_full_name;
764 user_name = (STRINGP (user) ? user : Fuser_login_name (user));
765 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
767 const char *user_name_ext;
769 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
770 things get wedged if a SIGIO arrives during this time. */
771 TO_EXTERNAL_FORMAT (LISP_STRING, user_name,
772 C_STRING_ALLOCA, user_name_ext,
774 slow_down_interrupts ();
775 pw = (struct passwd *) getpwnam (user_name_ext);
776 speed_up_interrupts ();
779 /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
780 /* Ben sez: bad idea because it's likely to break something */
781 #ifndef AMPERSAND_FULL_NAME
782 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
785 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
788 tem = ((!NILP (user) && !pw)
790 : make_ext_string ((Extbyte *) p, (q ? q - p : strlen (p)),
793 #ifdef AMPERSAND_FULL_NAME
796 p = (char *) XSTRING_DATA (tem);
798 /* Substitute the login name for the &, upcasing the first character. */
801 char *r = (char *) alloca (strlen (p) + XSTRING_LENGTH (user_name) + 1);
802 memcpy (r, p, q - p);
804 strcat (r, (char *) XSTRING_DATA (user_name));
805 /* #### current_buffer dependency! */
806 r[q - p] = UPCASE (current_buffer, r[q - p]);
808 tem = build_string (r);
811 #endif /* AMPERSAND_FULL_NAME */
816 static Extbyte *cached_home_directory;
819 uncache_home_directory (void)
821 cached_home_directory = NULL; /* in some cases, this may cause the leaking
825 /* !!#### not Mule correct. */
827 /* Returns the home directory, in external format */
829 get_home_directory (void)
831 /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
832 about what format an external string is in. Could be Unicode, for all
833 we know, and then all the operations below are totally bogus.
834 Instead, convert all data to internal format *right* at the juncture
835 between XEmacs and the outside world, the very moment we first get
837 int output_home_warning = 0;
839 if (cached_home_directory == NULL)
841 if ((cached_home_directory = (Extbyte *) getenv("HOME")) == NULL)
843 #if defined(WINDOWSNT) && !defined(__CYGWIN32__)
844 char *homedrive, *homepath;
846 if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
847 (homepath = getenv("HOMEPATH")) != NULL)
849 cached_home_directory =
850 (Extbyte *) xmalloc (strlen (homedrive) +
851 strlen (homepath) + 1);
852 sprintf((char *) cached_home_directory, "%s%s",
858 # if 0 /* changed by ben. This behavior absolutely stinks, and the
859 possibility being addressed here occurs quite commonly.
860 Using the current directory makes absolutely no sense. */
862 * Use the current directory.
863 * This preserves the existing XEmacs behavior, but is different
866 if (initial_directory[0] != '\0')
868 cached_home_directory = (Extbyte*) initial_directory;
872 /* This will probably give the wrong value */
873 cached_home_directory = (Extbyte*) getcwd (NULL, 0);
877 * This is NT Emacs behavior
879 cached_home_directory = (Extbyte *) "C:\\";
880 output_home_warning = 1;
883 #else /* !WINDOWSNT */
886 * Using "/" isn't quite right, but what should we do?
887 * We probably should try to extract pw_dir from /etc/passwd,
888 * before falling back to this.
890 cached_home_directory = (Extbyte *) "/";
891 output_home_warning = 1;
892 #endif /* !WINDOWSNT */
894 if (initialized && output_home_warning)
896 warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
897 " XEmacs was unable to determine a good value for the user's $HOME\n"
898 " directory, and will be using the value:\n"
900 " This is probably incorrect.",
901 cached_home_directory
905 return cached_home_directory;
908 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
909 Return the user's home directory, as a string.
913 Extbyte *path = get_home_directory ();
915 return path == NULL ? Qnil :
916 Fexpand_file_name (Fsubstitute_in_file_name
917 (build_ext_string ((char *) path, Qfile_name)),
921 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
922 Return the name of the machine you are running on, as a string.
926 return Fcopy_sequence (Vsystem_name);
929 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
930 Return the process ID of Emacs, as an integer.
934 return make_int (getpid ());
937 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
938 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
939 The time is returned as a list of three integers. The first has the
940 most significant 16 bits of the seconds, while the second has the
941 least significant 16 bits. The third integer gives the microsecond
944 The microsecond count is zero on systems that do not provide
945 resolution finer than a second.
952 return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
953 make_int ((EMACS_SECS (t) >> 0) & 0xffff),
954 make_int (EMACS_USECS (t)));
957 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
958 Return the amount of time used by this XEmacs process so far.
959 The return value is a list of three floating-point numbers, expressing
960 the user, system, and real times used by the process. The user time
961 measures the time actually spent by the CPU executing the code in this
962 process. The system time measures time spent by the CPU executing kernel
963 code on behalf of this process (e.g. I/O requests made by the process).
965 Note that the user and system times measure processor time, as opposed
966 to real time, and only accrue when the processor is actually doing
967 something: Time spent in an idle wait (waiting for user events to come
968 in or for I/O on a disk drive or other device to complete) does not
969 count. Thus, the user and system times will often be considerably
970 less than the real time.
972 Some systems do not allow the user and system times to be distinguished.
973 In this case, the user time will be the total processor time used by
974 the process, and the system time will be 0.
976 Some systems do not allow the real and processor times to be distinguished.
977 In this case, the user and real times will be the same and the system
982 double user, sys, real;
984 get_process_times (&user, &sys, &real);
985 return list3 (make_float (user), make_float (sys), make_float (real));
989 int lisp_to_time (Lisp_Object specified_time, time_t *result);
991 lisp_to_time (Lisp_Object specified_time, time_t *result)
993 Lisp_Object high, low;
995 if (NILP (specified_time))
996 return time (result) != -1;
998 CHECK_CONS (specified_time);
999 high = XCAR (specified_time);
1000 low = XCDR (specified_time);
1005 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
1006 return *result >> 16 == XINT (high);
1009 Lisp_Object time_to_lisp (time_t the_time);
1011 time_to_lisp (time_t the_time)
1013 unsigned int item = (unsigned int) the_time;
1014 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
1017 size_t emacs_strftime (char *string, size_t max, const char *format,
1018 const struct tm *tm);
1019 static long difftm (const struct tm *a, const struct tm *b);
1022 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
1023 Use FORMAT-STRING to format the time TIME.
1024 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1025 `current-time' and `file-attributes'. If TIME is not specified it
1026 defaults to the current time.
1027 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1028 %a is replaced by the abbreviated name of the day of week.
1029 %A is replaced by the full name of the day of week.
1030 %b is replaced by the abbreviated name of the month.
1031 %B is replaced by the full name of the month.
1032 %c is a synonym for "%x %X".
1033 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1034 %d is replaced by the day of month, zero-padded.
1035 %D is a synonym for "%m/%d/%y".
1036 %e is replaced by the day of month, blank-padded.
1037 %h is a synonym for "%b".
1038 %H is replaced by the hour (00-23).
1039 %I is replaced by the hour (00-12).
1040 %j is replaced by the day of the year (001-366).
1041 %k is replaced by the hour (0-23), blank padded.
1042 %l is replaced by the hour (1-12), blank padded.
1043 %m is replaced by the month (01-12).
1044 %M is replaced by the minute (00-59).
1045 %n is a synonym for "\\n".
1046 %p is replaced by AM or PM, as appropriate.
1047 %r is a synonym for "%I:%M:%S %p".
1048 %R is a synonym for "%H:%M".
1049 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1050 nonstandard extension)
1051 %S is replaced by the second (00-60).
1052 %t is a synonym for "\\t".
1053 %T is a synonym for "%H:%M:%S".
1054 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1055 %w is replaced by the day of week (0-6), Sunday is day 0.
1056 %W is replaced by the week of the year (00-53), first day of week is Monday.
1057 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1058 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1059 %y is replaced by the year without century (00-99).
1060 %Y is replaced by the year with century.
1061 %Z is replaced by the time zone abbreviation.
1063 The number of options reflects the `strftime' function.
1065 BUG: If the charset used by the current locale is not ISO 8859-1, the
1066 characters appearing in the day and month names may be incorrect.
1068 (format_string, time_))
1073 CHECK_STRING (format_string);
1075 if (! lisp_to_time (time_, &value))
1076 error ("Invalid time specification");
1078 /* This is probably enough. */
1079 size = XSTRING_LENGTH (format_string) * 6 + 50;
1083 char *buf = (char *) alloca (size);
1085 if (emacs_strftime (buf, size,
1086 (const char *) XSTRING_DATA (format_string),
1089 return build_ext_string (buf, Qbinary);
1090 /* If buffer was too small, make it bigger. */
1095 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
1096 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1097 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1098 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1099 to use the current time. The list has the following nine members:
1100 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1101 only some operating systems support. MINUTE is an integer between 0 and 59.
1102 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
1103 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
1104 four-digit year. DOW is the day of week, an integer between 0 and 6, where
1105 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
1106 ZONE is an integer indicating the number of seconds east of Greenwich.
1107 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1113 struct tm *decoded_time;
1114 Lisp_Object list_args[9];
1116 if (! lisp_to_time (specified_time, &time_spec))
1117 error ("Invalid time specification");
1119 decoded_time = localtime (&time_spec);
1120 list_args[0] = make_int (decoded_time->tm_sec);
1121 list_args[1] = make_int (decoded_time->tm_min);
1122 list_args[2] = make_int (decoded_time->tm_hour);
1123 list_args[3] = make_int (decoded_time->tm_mday);
1124 list_args[4] = make_int (decoded_time->tm_mon + 1);
1125 list_args[5] = make_int (decoded_time->tm_year + 1900);
1126 list_args[6] = make_int (decoded_time->tm_wday);
1127 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
1129 /* Make a copy, in case gmtime modifies the struct. */
1130 save_tm = *decoded_time;
1131 decoded_time = gmtime (&time_spec);
1132 if (decoded_time == 0)
1133 list_args[8] = Qnil;
1135 list_args[8] = make_int (difftm (&save_tm, decoded_time));
1136 return Flist (9, list_args);
1139 static void set_time_zone_rule (char *tzstring);
1141 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
1142 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1143 This is the reverse operation of `decode-time', which see.
1144 ZONE defaults to the current time zone rule. This can
1145 be a string (as from `set-time-zone-rule'), or it can be a list
1146 \(as from `current-time-zone') or an integer (as from `decode-time')
1147 applied without consideration for daylight savings time.
1149 You can pass more than 7 arguments; then the first six arguments
1150 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1151 The intervening arguments are ignored.
1152 This feature lets (apply 'encode-time (decode-time ...)) work.
1154 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1155 for example, a DAY of 0 means the day preceding the given month.
1156 Year numbers less than 100 are treated just like other year numbers.
1157 If you want them to stand for years in this century, you must do that yourself.
1159 (int nargs, Lisp_Object *args))
1163 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1165 CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */
1166 CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */
1167 CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */
1168 CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */
1169 CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */
1170 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
1177 the_time = mktime (&tm);
1182 char **oldenv = environ, **newenv;
1185 tzstring = (char *) XSTRING_DATA (zone);
1186 else if (INTP (zone))
1188 int abszone = abs (XINT (zone));
1189 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
1190 abszone / (60*60), (abszone/60) % 60, abszone % 60);
1194 error ("Invalid time zone specification");
1196 /* Set TZ before calling mktime; merely adjusting mktime's returned
1197 value doesn't suffice, since that would mishandle leap seconds. */
1198 set_time_zone_rule (tzstring);
1200 the_time = mktime (&tm);
1202 /* Restore TZ to previous value. */
1206 #ifdef LOCALTIME_CACHE
1211 if (the_time == (time_t) -1)
1212 error ("Specified time is not representable");
1214 return wasteful_word_to_lisp (the_time);
1217 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1218 Return the current time, as a human-readable string.
1219 Programs can use this function to decode a time,
1220 since the number of columns in each field is fixed.
1221 The format is `Sun Sep 16 01:03:52 1973'.
1222 If an argument is given, it specifies a time to format
1223 instead of the current time. The argument should have the form:
1226 (HIGH LOW . IGNORED).
1227 Thus, you can use times obtained from `current-time'
1228 and from `file-attributes'.
1236 if (! lisp_to_time (specified_time, &value))
1238 tem = (char *) ctime (&value);
1240 strncpy (buf, tem, 24);
1243 return build_ext_string (buf, Qbinary);
1246 #define TM_YEAR_ORIGIN 1900
1248 /* Yield A - B, measured in seconds. */
1250 difftm (const struct tm *a, const struct tm *b)
1252 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1253 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1254 /* Some compilers can't handle this as a single return statement. */
1256 /* difference in day of year */
1257 a->tm_yday - b->tm_yday
1258 /* + intervening leap days */
1259 + ((ay >> 2) - (by >> 2))
1261 + ((ay/100 >> 2) - (by/100 >> 2))
1262 /* + difference in years * 365 */
1263 + (long)(ay-by) * 365
1265 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
1266 + (a->tm_min - b->tm_min))
1267 + (a->tm_sec - b->tm_sec));
1270 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1271 Return the offset and name for the local time zone.
1272 This returns a list of the form (OFFSET NAME).
1273 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1274 A negative value means west of Greenwich.
1275 NAME is a string giving the name of the time zone.
1276 If an argument is given, it specifies when the time zone offset is determined
1277 instead of using the current time. The argument should have the form:
1280 (HIGH LOW . IGNORED).
1281 Thus, you can use times obtained from `current-time'
1282 and from `file-attributes'.
1284 Some operating systems cannot provide all this information to Emacs;
1285 in this case, `current-time-zone' returns a list containing nil for
1286 the data it can't find.
1291 struct tm *t = NULL;
1293 if (lisp_to_time (specified_time, &value)
1294 && (t = gmtime (&value)) != 0)
1296 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */
1300 t = localtime (&value);
1301 offset = difftm (t, &gmt);
1305 s = (char *)t->tm_zone;
1306 #else /* not HAVE_TM_ZONE */
1308 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1309 s = tzname[t->tm_isdst];
1311 #endif /* not HAVE_TM_ZONE */
1314 /* No local time zone name is available; use "+-NNNN" instead. */
1315 int am = (offset < 0 ? -offset : offset) / 60;
1316 sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
1319 return list2 (make_int (offset), build_string (s));
1322 return list2 (Qnil, Qnil);
1325 #ifdef LOCALTIME_CACHE
1327 /* These two values are known to load tz files in buggy implementations,
1328 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1329 Their values shouldn't matter in non-buggy implementations.
1330 We don't use string literals for these strings,
1331 since if a string in the environment is in readonly
1332 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1333 See Sun bugs 1113095 and 1114114, ``Timezone routines
1334 improperly modify environment''. */
1336 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1337 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1341 /* Set the local time zone rule to TZSTRING.
1342 This allocates memory into `environ', which it is the caller's
1343 responsibility to free. */
1345 set_time_zone_rule (char *tzstring)
1348 char **from, **to, **newenv;
1350 for (from = environ; *from; from++)
1352 envptrs = from - environ + 2;
1353 newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
1354 + (tzstring ? strlen (tzstring) + 4 : 0));
1357 char *t = (char *) (to + envptrs);
1359 strcat (t, tzstring);
1363 for (from = environ; *from; from++)
1364 if (strncmp (*from, "TZ=", 3) != 0)
1370 #ifdef LOCALTIME_CACHE
1372 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1373 "US/Pacific" that loads a tz file, then changes to a value like
1374 "XXX0" that does not load a tz file, and then changes back to
1375 its original value, the last change is (incorrectly) ignored.
1376 Also, if TZ changes twice in succession to values that do
1377 not load a tz file, tzset can dump core (see Sun bug#1225179).
1378 The following code works around these bugs. */
1382 /* Temporarily set TZ to a value that loads a tz file
1383 and that differs from tzstring. */
1385 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
1386 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
1392 /* The implied tzstring is unknown, so temporarily set TZ to
1393 two different values that each load a tz file. */
1394 *to = set_time_zone_rule_tz1;
1397 *to = set_time_zone_rule_tz2;
1402 /* Now TZ has the desired value, and tzset can be invoked safely. */
1409 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1410 Set the local time zone using TZ, a string specifying a time zone rule.
1411 If TZ is nil, use implementation-defined default time zone information.
1422 tzstring = (char *) XSTRING_DATA (tz);
1425 set_time_zone_rule (tzstring);
1428 environbuf = environ;
1435 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
1437 /* This function can GC */
1438 struct gcpro gcpro1;
1441 if (CHAR_OR_CHAR_INTP (arg))
1443 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
1445 else if (STRINGP (arg))
1447 buffer_insert_lisp_string (buf, arg);
1451 arg = wrong_type_argument (Qchar_or_string_p, arg);
1454 zmacs_region_stays = 0;
1459 /* Callers passing one argument to Finsert need not gcpro the
1460 argument "array", since the only element of the array will
1461 not be used after calling insert_emacs_char or insert_lisp_string,
1462 so we don't care if it gets trashed. */
1464 DEFUN ("insert", Finsert, 0, MANY, 0, /*
1465 Insert the arguments, either strings or characters, at point.
1466 Point moves forward so that it ends up after the inserted text.
1467 Any other markers at the point of insertion remain before the text.
1468 If a string has non-null string-extent-data, new extents will be created.
1470 (int nargs, Lisp_Object *args))
1472 /* This function can GC */
1473 REGISTER int argnum;
1475 for (argnum = 0; argnum < nargs; argnum++)
1477 buffer_insert1 (current_buffer, args[argnum]);
1483 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1484 Insert strings or characters at point, relocating markers after the text.
1485 Point moves forward so that it ends up after the inserted text.
1486 Any other markers at the point of insertion also end up after the text.
1488 (int nargs, Lisp_Object *args))
1490 /* This function can GC */
1491 REGISTER int argnum;
1492 REGISTER Lisp_Object tem;
1494 for (argnum = 0; argnum < nargs; argnum++)
1498 if (CHAR_OR_CHAR_INTP (tem))
1500 buffer_insert_emacs_char_1 (current_buffer, -1,
1501 XCHAR_OR_CHAR_INT (tem),
1502 INSDEL_BEFORE_MARKERS);
1504 else if (STRINGP (tem))
1506 buffer_insert_lisp_string_1 (current_buffer, -1, tem,
1507 INSDEL_BEFORE_MARKERS);
1511 tem = wrong_type_argument (Qchar_or_string_p, tem);
1515 zmacs_region_stays = 0;
1519 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
1520 Insert STRING into BUFFER at BUFFER's point.
1521 Point moves forward so that it ends up after the inserted text.
1522 Any other markers at the point of insertion remain before the text.
1523 If a string has non-null string-extent-data, new extents will be created.
1524 BUFFER defaults to the current buffer.
1528 struct buffer *b = decode_buffer (buffer, 1);
1529 CHECK_STRING (string);
1530 buffer_insert_lisp_string (b, string);
1531 zmacs_region_stays = 0;
1535 /* Third argument in FSF is INHERIT:
1537 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1538 from adjoining text, if those properties are sticky."
1540 Jamie thinks this is bogus. */
1543 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
1544 Insert COUNT (second arg) copies of CHR (first arg).
1545 Point and all markers are affected as in the function `insert'.
1546 COUNT defaults to 1 if omitted.
1547 The optional third arg IGNORED is INHERIT under FSF Emacs.
1548 This is highly bogus, however, and XEmacs always behaves as if
1549 `t' were passed to INHERIT.
1550 The optional fourth arg BUFFER specifies the buffer to insert the
1551 text into. If BUFFER is nil, the current buffer is assumed.
1553 (chr, count, ignored, buffer))
1555 /* This function can GC */
1556 REGISTER Bufbyte *string;
1559 REGISTER Bytecount n;
1560 REGISTER Bytecount charlen;
1561 Bufbyte str[MAX_EMCHAR_LEN];
1562 struct buffer *b = decode_buffer (buffer, 1);
1565 CHECK_CHAR_COERCE_INT (chr);
1574 charlen = set_charptr_emchar (str, XCHAR (chr));
1578 slen = min (n, 768);
1579 string = alloca_array (Bufbyte, slen);
1580 /* Write as many copies of the character into the temp string as will fit. */
1581 for (i = 0; i + charlen <= slen; i += charlen)
1582 for (j = 0; j < charlen; j++)
1583 string[i + j] = str[j];
1587 buffer_insert_raw_string (b, string, slen);
1591 #if 0 /* FSFmacs bogosity */
1593 if (!NILP (inherit))
1594 insert_and_inherit (string, n);
1599 buffer_insert_raw_string (b, string, n);
1602 zmacs_region_stays = 0;
1607 /* Making strings from buffer contents. */
1609 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1610 Return the contents of part of BUFFER as a string.
1611 The two arguments START and END are character positions;
1612 they can be in either order. If omitted, they default to the beginning
1613 and end of BUFFER, respectively.
1614 If there are duplicable extents in the region, the string remembers
1615 them in its extent data.
1616 If BUFFER is nil, the current buffer is assumed.
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 (b, begv, zv - begv);
1628 /* It might make more sense to name this
1629 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1630 and what the function does is probably good enough for what the
1631 user-code will typically want to use it for. */
1632 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1633 Return the text from BEG to END, as a string, without copying the extents.
1635 (start, end, buffer))
1637 /* This function can GC */
1639 struct buffer *b = decode_buffer (buffer, 1);
1641 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1642 return make_string_from_buffer_no_extents (b, begv, zv - begv);
1645 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1646 Insert before point a substring of the contents of buffer BUFFER.
1647 BUFFER may be a buffer or a buffer name.
1648 Arguments START and END are character numbers specifying the substring.
1649 They default to the beginning and the end of BUFFER.
1651 (buffer, start, end))
1653 /* This function can GC */
1657 bp = XBUFFER (get_buffer (buffer, 1));
1658 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
1661 buffer_insert_from_buffer (current_buffer, bp, b, e - b);
1666 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1667 Compare two substrings of two buffers; return result as number.
1668 the value is -N if first string is less after N-1 chars,
1669 +N if first string is greater after N-1 chars, or 0 if strings match.
1670 Each substring is represented as three arguments: BUFFER, START and END.
1671 That makes six args in all, three for each substring.
1673 The value of `case-fold-search' in the current buffer
1674 determines whether case is significant or ignored.
1676 (buffer1, start1, end1, buffer2, start2, end2))
1678 Bufpos begp1, endp1, begp2, endp2;
1679 REGISTER Charcount len1, len2, length, i;
1680 struct buffer *bp1, *bp2;
1681 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
1682 current_buffer->case_canon_table : Qnil);
1684 /* Find the first buffer and its substring. */
1686 bp1 = decode_buffer (buffer1, 1);
1687 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1689 /* Likewise for second substring. */
1691 bp2 = decode_buffer (buffer2, 1);
1692 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1694 len1 = endp1 - begp1;
1695 len2 = endp2 - begp2;
1700 for (i = 0; i < length; i++)
1702 Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
1703 Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
1706 c1 = TRT_TABLE_OF (trt, c1);
1707 c2 = TRT_TABLE_OF (trt, c2);
1710 return make_int (- 1 - i);
1712 return make_int (i + 1);
1715 /* The strings match as far as they go.
1716 If one is shorter, that one is less. */
1718 return make_int (length + 1);
1719 else if (length < len2)
1720 return make_int (- length - 1);
1722 /* Same length too => they are equal. */
1728 subst_char_in_region_unwind (Lisp_Object arg)
1730 XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
1735 subst_char_in_region_unwind_1 (Lisp_Object arg)
1737 XBUFFER (XCAR (arg))->filename = XCDR (arg);
1741 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1742 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1743 If optional arg NOUNDO is non-nil, don't record this change for undo
1744 and don't mark the buffer as really changed.
1746 (start, end, fromchar, tochar, noundo))
1748 /* This function can GC */
1752 struct buffer *buf = current_buffer;
1753 int count = specpdl_depth ();
1755 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1756 CHECK_CHAR_COERCE_INT (fromchar);
1757 CHECK_CHAR_COERCE_INT (tochar);
1759 fromc = XCHAR (fromchar);
1760 toc = XCHAR (tochar);
1762 /* If we don't want undo, turn off putting stuff on the list.
1763 That's faster than getting rid of things,
1764 and it prevents even the entry for a first change.
1765 Also inhibit locking the file. */
1768 record_unwind_protect (subst_char_in_region_unwind,
1769 Fcons (Fcurrent_buffer (), buf->undo_list));
1770 buf->undo_list = Qt;
1771 /* Don't do file-locking. */
1772 record_unwind_protect (subst_char_in_region_unwind_1,
1773 Fcons (Fcurrent_buffer (), buf->filename));
1774 buf->filename = Qnil;
1777 mc_count = begin_multiple_change (buf, pos, stop);
1780 if (BUF_FETCH_CHAR (buf, pos) == fromc)
1782 /* There used to be some code here that set the buffer to
1783 unmodified if NOUNDO was specified and there was only
1784 one change to the buffer since it was last saved.
1785 This is a crock of shit, so I'm not duplicating this
1786 behavior. I think this was left over from when
1787 prepare_to_modify_buffer() actually bumped MODIFF,
1788 so that code was supposed to undo this change. --ben */
1789 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
1791 /* If noundo is not nil then we don't mark the buffer as
1792 modified. In reality that needs to happen externally
1793 only. Internally redisplay needs to know that the actual
1794 contents it should be displaying have changed. */
1796 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
1800 end_multiple_change (buf, mc_count);
1802 unbind_to (count, Qnil);
1806 /* #### Shouldn't this also accept a BUFFER argument, in the good old
1807 XEmacs tradition? */
1808 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
1809 Translate characters from START to END according to TABLE.
1811 If TABLE is a string, the Nth character in it is the mapping for the
1812 character with code N.
1814 If TABLE is a vector, its Nth element is the mapping for character
1815 with code N. The values of elements may be characters, strings, or
1816 nil (nil meaning don't replace.)
1818 If TABLE is a char-table, its elements describe the mapping between
1819 characters and their replacements. The char-table should be of type
1820 `char' or `generic'.
1822 Returns the number of substitutions performed.
1824 (start, end, table))
1826 /* This function can GC */
1827 Bufpos pos, stop; /* Limits of the region. */
1828 int cnt = 0; /* Number of changes made. */
1830 struct buffer *buf = current_buffer;
1833 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1834 mc_count = begin_multiple_change (buf, pos, stop);
1835 if (STRINGP (table))
1837 Lisp_String *stable = XSTRING (table);
1838 Charcount size = string_char_length (stable);
1840 /* Under Mule, string_char(n) is O(n), so for large tables or
1841 large regions it makes sense to create an array of Emchars. */
1842 if (size * (stop - pos) > 65536)
1844 Emchar *etable = alloca_array (Emchar, size);
1845 convert_bufbyte_string_into_emchar_string
1846 (string_data (stable), string_length (stable), etable);
1847 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1851 Emchar nc = etable[oc];
1854 buffer_replace_char (buf, pos, nc, 0, 0);
1863 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1867 Emchar nc = string_char (stable, oc);
1870 buffer_replace_char (buf, pos, nc, 0, 0);
1877 else if (VECTORP (table))
1879 Charcount size = XVECTOR_LENGTH (table);
1880 Lisp_Object *vtable = XVECTOR_DATA (table);
1882 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1886 Lisp_Object replacement = vtable[oc];
1888 if (CHAR_OR_CHAR_INTP (replacement))
1890 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1893 buffer_replace_char (buf, pos, nc, 0, 0);
1897 else if (STRINGP (replacement))
1899 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1900 buffer_delete_range (buf, pos, pos + 1, 0);
1901 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1902 pos += incr, stop += incr;
1905 else if (!NILP (replacement))
1907 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1913 else if (CHAR_TABLEP (table)
1914 && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
1915 || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
1917 Lisp_Char_Table *ctable = XCHAR_TABLE (table);
1919 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1921 Lisp_Object replacement = get_char_table (oc, ctable);
1923 if (CHAR_OR_CHAR_INTP (replacement))
1925 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1928 buffer_replace_char (buf, pos, nc, 0, 0);
1932 else if (STRINGP (replacement))
1934 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1935 buffer_delete_range (buf, pos, pos + 1, 0);
1936 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1937 pos += incr, stop += incr;
1940 else if (!NILP (replacement))
1942 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1948 dead_wrong_type_argument (Qstringp, table);
1949 end_multiple_change (buf, mc_count);
1951 return make_int (cnt);
1954 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
1955 Delete the text between point and mark.
1956 When called from a program, expects two arguments,
1957 positions (integers or markers) specifying the stretch to be deleted.
1958 If BUFFER is nil, the current buffer is assumed.
1962 /* This function can GC */
1964 struct buffer *buf = decode_buffer (buffer, 1);
1966 get_buffer_range_char (buf, b, e, &start, &end, 0);
1967 buffer_delete_range (buf, start, end, 0);
1968 zmacs_region_stays = 0;
1973 widen_buffer (struct buffer *b, int no_clip)
1975 if (BUF_BEGV (b) != BUF_BEG (b))
1978 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b));
1980 if (BUF_ZV (b) != BUF_Z (b))
1983 SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b));
1989 /* Changing the buffer bounds invalidates any recorded current
1991 invalidate_current_column ();
1992 narrow_line_number_cache (b);
1996 DEFUN ("widen", Fwiden, 0, 1, "", /*
1997 Remove restrictions (narrowing) from BUFFER.
1998 This allows the buffer's full text to be seen and edited.
1999 If BUFFER is nil, the current buffer is assumed.
2003 struct buffer *b = decode_buffer (buffer, 1);
2004 widen_buffer (b, 0);
2005 zmacs_region_stays = 0;
2009 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2010 Restrict editing in BUFFER to the current region.
2011 The rest of the text becomes temporarily invisible and untouchable
2012 but is not deleted; if you save the buffer in a file, the invisible
2013 text is included in the file. \\[widen] makes all visible again.
2014 If BUFFER is nil, the current buffer is assumed.
2015 See also `save-restriction'.
2017 When calling from a program, pass two arguments; positions (integers
2018 or markers) bounding the text that should remain visible.
2023 struct buffer *buf = decode_buffer (buffer, 1);
2024 Bytind bi_start, bi_end;
2026 get_buffer_range_char (buf, b, e, &start, &end, GB_ALLOW_PAST_ACCESSIBLE);
2027 bi_start = bufpos_to_bytind (buf, start);
2028 bi_end = bufpos_to_bytind (buf, end);
2030 SET_BOTH_BUF_BEGV (buf, start, bi_start);
2031 SET_BOTH_BUF_ZV (buf, end, bi_end);
2032 if (BUF_PT (buf) < start)
2033 BUF_SET_PT (buf, start);
2034 if (BUF_PT (buf) > end)
2035 BUF_SET_PT (buf, end);
2037 /* Changing the buffer bounds invalidates any recorded current column. */
2038 invalidate_current_column ();
2039 narrow_line_number_cache (buf);
2040 zmacs_region_stays = 0;
2045 save_restriction_save (void)
2047 Lisp_Object bottom, top;
2048 /* Note: I tried using markers here, but it does not win
2049 because insertion at the end of the saved region
2050 does not advance mh and is considered "outside" the saved region. */
2051 bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer));
2052 top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer));
2054 return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top));
2058 save_restriction_restore (Lisp_Object data)
2061 Charcount newhead, newtail;
2063 int local_clip_changed = 0;
2065 buf = XBUFFER (XCAR (data));
2066 if (!BUFFER_LIVE_P (buf))
2068 /* someone could have killed the buffer in the meantime ... */
2069 free_cons (XCONS (XCDR (data)));
2070 free_cons (XCONS (data));
2074 newhead = XINT (XCAR (tem));
2075 newtail = XINT (XCDR (tem));
2077 free_cons (XCONS (XCDR (data)));
2078 free_cons (XCONS (data));
2080 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
2088 Bytind bi_start, bi_end;
2090 start = BUF_BEG (buf) + newhead;
2091 end = BUF_Z (buf) - newtail;
2093 bi_start = bufpos_to_bytind (buf, start);
2094 bi_end = bufpos_to_bytind (buf, end);
2096 if (BUF_BEGV (buf) != start)
2098 local_clip_changed = 1;
2099 SET_BOTH_BUF_BEGV (buf, start, bi_start);
2100 narrow_line_number_cache (buf);
2102 if (BUF_ZV (buf) != end)
2104 local_clip_changed = 1;
2105 SET_BOTH_BUF_ZV (buf, end, bi_end);
2108 if (local_clip_changed)
2111 /* If point is outside the new visible range, move it inside. */
2113 bufpos_clip_to_bounds (BUF_BEGV (buf),
2120 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2121 Execute BODY, saving and restoring current buffer's restrictions.
2122 The buffer's restrictions make parts of the beginning and end invisible.
2123 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2124 This special form, `save-restriction', saves the current buffer's restrictions
2125 when it is entered, and restores them when it is exited.
2126 So any `narrow-to-region' within BODY lasts only until the end of the form.
2127 The old restrictions settings are restored
2128 even in case of abnormal exit (throw or error).
2130 The value returned is the value of the last form in BODY.
2132 `save-restriction' can get confused if, within the BODY, you widen
2133 and then make changes outside the area within the saved restrictions.
2135 Note: if you are using both `save-excursion' and `save-restriction',
2136 use `save-excursion' outermost:
2137 (save-excursion (save-restriction ...))
2141 /* This function can GC */
2142 int speccount = specpdl_depth ();
2144 record_unwind_protect (save_restriction_restore, save_restriction_save ());
2146 return unbind_to (speccount, Fprogn (body));
2150 DEFUN ("format", Fformat, 1, MANY, 0, /*
2151 Format a string out of a control-string and arguments.
2152 The first argument is a control string.
2153 The other arguments are substituted into it to make the result, a string.
2154 It may contain %-sequences meaning to substitute the next argument.
2155 %s means print all objects as-is, using `princ'.
2156 %S means print all objects as s-expressions, using `prin1'.
2157 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
2159 %c means print as a single character.
2160 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2161 %e or %E means print as a floating-point number in scientific notation
2163 %g or %G means print as a floating-point number in "pretty format";
2164 depending on the number, either %f or %e/%E format will be used, and
2165 trailing zeroes are removed from the fractional part.
2166 The argument used for all but %s and %S must be a number. It will be
2167 converted to an integer or a floating-point number as necessary.
2169 %$ means reposition to read a specific numbered argument; for example,
2170 %3$s would apply the `%s' to the third argument after the control string,
2171 and the next format directive would use the fourth argument, the
2172 following one the fifth argument, etc. (There must be a positive integer
2173 between the % and the $).
2174 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2175 specified between the optional repositioning spec and the conversion
2176 character; see below.
2177 An optional minimum field width may be specified after any flag characters
2178 and before the conversion character; it specifies the minimum number of
2179 characters that the converted argument will take up. Padding will be
2180 added on the left (or on the right, if the `-' flag is specified), as
2181 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2183 If the field width is specified as `*', the field width is assumed to have
2184 been specified as an argument. Any repositioning specification that
2185 would normally specify the argument to be converted will now specify
2186 where to find this field width argument, not where to find the argument
2187 to be converted. If there is no repositioning specification, the normal
2188 next argument is used. The argument to be converted will be the next
2189 argument after the field width argument unless the precision is also
2190 specified as `*' (see below).
2192 An optional period character and precision may be specified after any
2193 minimum field width. It specifies the minimum number of digits to
2194 appear in %d, %i, %o, %x, and %X conversions (the number is padded
2195 on the left with zeroes as necessary); the number of digits printed
2196 after the decimal point for %f, %e, and %E conversions; the number
2197 of significant digits printed in %g and %G conversions; and the
2198 maximum number of non-padding characters printed in %s and %S
2199 conversions. The default precision for floating-point conversions
2201 If the precision is specified as `*', the precision is assumed to have been
2202 specified as an argument. The argument used will be the next argument
2203 after the field width argument, if any. If the field width was not
2204 specified as an argument, any repositioning specification that would
2205 normally specify the argument to be converted will now specify where to
2206 find the precision argument. If there is no repositioning specification,
2207 the normal next argument is used.
2209 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2210 plus sign, respectively.
2211 The `#' flag means print numbers in an alternate, more verbose format:
2212 octal numbers begin with zero; hex numbers begin with a 0x or 0X;
2213 a decimal point is printed in %f, %e, and %E conversions even if no
2214 numbers are printed after it; and trailing zeroes are not omitted in
2215 %g and %G conversions.
2217 Use %% to put a single % into the output.
2219 (int nargs, Lisp_Object *args))
2221 /* It should not be necessary to GCPRO ARGS, because
2222 the caller in the interpreter should take care of that. */
2224 CHECK_STRING (args[0]);
2225 return emacs_doprnt_string_lisp (0, args[0], 0, nargs - 1, args + 1);
2229 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
2230 Return t if two characters match, optionally ignoring case.
2231 Both arguments must be characters (i.e. NOT integers).
2232 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2233 If BUFFER is nil, the current buffer is assumed.
2238 struct buffer *b = decode_buffer (buffer, 1);
2240 CHECK_CHAR_COERCE_INT (c1);
2241 CHECK_CHAR_COERCE_INT (c2);
2245 return (!NILP (b->case_fold_search)
2246 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
2251 DEFUN ("char=", Fchar_Equal, 2, 2, 0, /*
2252 Return t if two characters match, case is significant.
2253 Both arguments must be characters (i.e. NOT integers).
2257 CHECK_CHAR_COERCE_INT (c1);
2258 CHECK_CHAR_COERCE_INT (c2);
2260 return EQ (c1, c2) ? Qt : Qnil;
2263 #if 0 /* Undebugged FSFmacs code */
2264 /* Transpose the markers in two regions of the current buffer, and
2265 adjust the ones between them if necessary (i.e.: if the regions
2268 Traverses the entire marker list of the buffer to do so, adding an
2269 appropriate amount to some, subtracting from some, and leaving the
2270 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2272 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2275 transpose_markers (Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2277 Charcount amt1, amt2, diff;
2279 struct buffer *buf = current_buffer;
2281 /* Update point as if it were a marker. */
2282 if (BUF_PT (buf) < start1)
2284 else if (BUF_PT (buf) < end1)
2285 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
2286 else if (BUF_PT (buf) < start2)
2287 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
2288 else if (BUF_PT (buf) < end2)
2289 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
2291 /* We used to adjust the endpoints here to account for the gap, but that
2292 isn't good enough. Even if we assume the caller has tried to move the
2293 gap out of our way, it might still be at start1 exactly, for example;
2294 and that places it `inside' the interval, for our purposes. The amount
2295 of adjustment is nontrivial if there's a `denormalized' marker whose
2296 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2297 the dirty work to Fmarker_position, below. */
2299 /* The difference between the region's lengths */
2300 diff = (end2 - start2) - (end1 - start1);
2302 /* For shifting each marker in a region by the length of the other
2303 * region plus the distance between the regions.
2305 amt1 = (end2 - start2) + (start2 - end1);
2306 amt2 = (end1 - start1) + (start2 - end1);
2308 for (marker = BUF_MARKERS (buf); !NILP (marker);
2309 marker = XMARKER (marker)->chain)
2311 Bufpos mpos = marker_position (marker);
2312 if (mpos >= start1 && mpos < end2)
2316 else if (mpos < start2)
2320 set_marker_position (marker, mpos);
2327 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2328 Transpose region START1 to END1 with START2 to END2.
2329 The regions may not be overlapping, because the size of the buffer is
2330 never changed in a transposition.
2332 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose
2333 any markers that happen to be located in the regions. (#### BUG: currently
2334 this function always acts as if LEAVE_MARKERS is non-nil.)
2336 Transposing beyond buffer boundaries is an error.
2338 (startr1, endr1, startr2, endr2, leave_markers))
2340 Bufpos start1, end1, start2, end2;
2341 Charcount len1, len2;
2342 Lisp_Object string1, string2;
2343 struct buffer *buf = current_buffer;
2345 get_buffer_range_char (buf, startr1, endr1, &start1, &end1, 0);
2346 get_buffer_range_char (buf, startr2, endr2, &start2, &end2, 0);
2348 len1 = end1 - start1;
2349 len2 = end2 - start2;
2352 error ("transposed regions not properly ordered");
2353 else if (start1 == end1 || start2 == end2)
2354 error ("transposed region may not be of length 0");
2356 string1 = make_string_from_buffer (buf, start1, len1);
2357 string2 = make_string_from_buffer (buf, start2, len2);
2358 buffer_delete_range (buf, start2, end2, 0);
2359 buffer_insert_lisp_string_1 (buf, start2, string1, 0);
2360 buffer_delete_range (buf, start1, end1, 0);
2361 buffer_insert_lisp_string_1 (buf, start1, string2, 0);
2363 /* In FSFmacs there is a whole bunch of really ugly code here
2364 to attempt to transpose the regions without using up any
2365 extra memory. Although the intent may be good, the result
2366 was highly bogus. */
2372 /************************************************************************/
2373 /* initialization */
2374 /************************************************************************/
2377 syms_of_editfns (void)
2379 defsymbol (&Qpoint, "point");
2380 defsymbol (&Qmark, "mark");
2381 defsymbol (&Qregion_beginning, "region-beginning");
2382 defsymbol (&Qregion_end, "region-end");
2383 defsymbol (&Qformat, "format");
2384 defsymbol (&Quser_files_and_directories, "user-files-and-directories");
2386 DEFSUBR (Fchar_equal);
2387 DEFSUBR (Fchar_Equal);
2388 DEFSUBR (Fgoto_char);
2389 DEFSUBR (Fstring_to_char);
2390 DEFSUBR (Fchar_to_string);
2391 DEFSUBR (Fbuffer_substring);
2392 DEFSUBR (Fbuffer_substring_no_properties);
2394 DEFSUBR (Fpoint_marker);
2395 DEFSUBR (Fmark_marker);
2397 DEFSUBR (Fregion_beginning);
2398 DEFSUBR (Fregion_end);
2399 DEFSUBR (Fsave_excursion);
2400 DEFSUBR (Fsave_current_buffer);
2402 DEFSUBR (Fbuffer_size);
2403 DEFSUBR (Fpoint_max);
2404 DEFSUBR (Fpoint_min);
2405 DEFSUBR (Fpoint_min_marker);
2406 DEFSUBR (Fpoint_max_marker);
2412 DEFSUBR (Ffollowing_char);
2413 DEFSUBR (Fpreceding_char);
2414 DEFSUBR (Fchar_after);
2415 DEFSUBR (Fchar_before);
2417 DEFSUBR (Finsert_string);
2418 DEFSUBR (Finsert_before_markers);
2419 DEFSUBR (Finsert_char);
2421 DEFSUBR (Ftemp_directory);
2422 DEFSUBR (Fuser_login_name);
2423 DEFSUBR (Fuser_real_login_name);
2424 DEFSUBR (Fuser_uid);
2425 DEFSUBR (Fuser_real_uid);
2426 DEFSUBR (Fuser_full_name);
2427 DEFSUBR (Fuser_home_directory);
2428 DEFSUBR (Femacs_pid);
2429 DEFSUBR (Fcurrent_time);
2430 DEFSUBR (Fcurrent_process_time);
2431 DEFSUBR (Fformat_time_string);
2432 DEFSUBR (Fdecode_time);
2433 DEFSUBR (Fencode_time);
2434 DEFSUBR (Fcurrent_time_string);
2435 DEFSUBR (Fcurrent_time_zone);
2436 DEFSUBR (Fset_time_zone_rule);
2437 DEFSUBR (Fsystem_name);
2440 DEFSUBR (Finsert_buffer_substring);
2441 DEFSUBR (Fcompare_buffer_substrings);
2442 DEFSUBR (Fsubst_char_in_region);
2443 DEFSUBR (Ftranslate_region);
2444 DEFSUBR (Fdelete_region);
2446 DEFSUBR (Fnarrow_to_region);
2447 DEFSUBR (Fsave_restriction);
2448 DEFSUBR (Ftranspose_regions);
2450 defsymbol (&Qzmacs_update_region, "zmacs-update-region");
2451 defsymbol (&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2452 defsymbol (&Qzmacs_region_buffer, "zmacs-region-buffer");
2456 vars_of_editfns (void)
2458 staticpro (&Vsystem_name);
2460 staticpro (&Vuser_name);
2461 staticpro (&Vuser_real_name);
2463 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
2464 *Whether LISPM-style active regions should be used.
2465 This means that commands which operate on the region (the area between the
2466 point and the mark) will only work while the region is in the ``active''
2467 state, which is indicated by highlighting. Executing most commands causes
2468 the region to not be in the active state, so (for example) \\[kill-region] will only
2469 work immediately after activating the region.
2473 - Commands which operate on the region only work if the region is active.
2474 - Only a very small set of commands cause the region to become active:
2475 Those commands whose semantics are to mark an area, like mark-defun.
2476 - The region is deactivated after each command that is executed, except that:
2477 - "Motion" commands do not change whether the region is active or not.
2479 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2480 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2481 between point and the recently-pushed mark to be highlighted. It will
2482 remain highlighted until some non-motion command is executed.
2484 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2485 region and execute a command that operates on it, you can reactivate the
2486 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2489 Generally, commands which push marks as a means of navigation (like
2490 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2491 region. But commands which push marks as a means of marking an area of
2492 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2493 do activate the region.
2495 The way the command loop actually works with regard to deactivating the
2496 region is as follows:
2498 - If the variable `zmacs-region-stays' has been set to t during the command
2499 just executed, the region is left alone (this is how the motion commands
2500 make the region stay around; see the `_' flag in the `interactive'
2501 specification). `zmacs-region-stays' is reset to nil before each command
2503 - If the function `zmacs-activate-region' has been called during the command
2504 just executed, the region is left alone. Very few functions should
2505 actually call this function.
2506 - Otherwise, if the region is active, the region is deactivated and
2507 the `zmacs-deactivate-region-hook' is called.
2509 /* Zmacs style active regions are now ON by default */
2512 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
2513 Do not alter this. It is for internal use only.
2515 zmacs_region_active_p = 0;
2517 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
2518 Whether the current command will deactivate the region.
2519 Commands which do not wish to affect whether the region is currently
2520 highlighted should set this to t. Normally, the region is turned off after
2521 executing each command that did not explicitly turn it on with the function
2522 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2523 See the variable `zmacs-regions'.
2525 The same effect can be achieved using the `_' interactive specification.
2527 zmacs_region_stays = 0;
2529 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2530 Do not use this -- it will be going away soon.
2531 Indicates if `goto-char' has just been run. This information is allegedly
2532 needed to get the desired behavior for atomic extents and unfortunately
2533 is not available by any other means.
2535 atomic_extent_goto_char_p = 0;
2536 #ifdef AMPERSAND_FULL_NAME
2537 Fprovide(intern("ampersand-full-name"));
2540 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
2541 *The name of the user.
2542 The function `user-full-name', which will return the value of this
2543 variable, when called without arguments.
2544 This is initialized to the value of the NAME environment variable.
2546 /* Initialized at run-time. */
2547 Vuser_full_name = Qnil;