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"
49 /* Some static data, and a function to initialize it for each run */
51 Lisp_Object Vsystem_name; /* #### - I don't see why this should be */
52 /* static, either... --Stig */
53 #if 0 /* XEmacs - this is now dynamic */
54 /* if at some point it's deemed desirable to
55 use lisp variables here, then they can be
56 initialized to nil and then set to their
57 real values upon the first call to the
58 functions that generate them. --stig */
59 Lisp_Object Vuser_real_login_name; /* login name of current user ID */
60 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */
63 /* It's useful to be able to set this as user customization, so we'll
65 Lisp_Object Vuser_full_name;
66 EXFUN (Fuser_full_name, 1);
68 char *get_system_name (void);
72 Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
74 Lisp_Object Quser_files_and_directories;
76 /* This holds the value of `environ' produced by the previous
77 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
78 has never been called. */
79 static char **environbuf;
84 /* Only used in removed code below. */
89 /* Set up system_name even when dumping. */
97 if ((p = getenv ("NAME")))
98 /* I don't think it's the right thing to do the ampersand
99 modification on NAME. Not that it matters anymore... -hniksic */
100 Vuser_full_name = build_ext_string (p, FORMAT_OS);
102 Vuser_full_name = Fuser_full_name (Qnil);
105 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
106 Convert arg CH to a one-character string containing that character.
111 Bufbyte str[MAX_EMCHAR_LEN];
115 Lisp_Object ch2 = Fevent_to_character (ch, Qt, Qnil, Qnil);
118 signal_simple_continuable_error
119 ("character has no ASCII equivalent:", Fcopy_event (ch, Qnil));
123 CHECK_CHAR_COERCE_INT (ch);
125 len = set_charptr_emchar (str, XCHAR (ch));
126 return make_string (str, len);
129 DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /*
130 Convert arg STRING to a character, the first character of that string.
131 An empty string will return the constant `nil'.
135 struct Lisp_String *p;
139 if (string_length (p) != 0)
140 return make_char (string_char (p, 0));
142 /* This used to return Qzero. That is broken, broken, broken. */
143 /* It might be kinder to signal an error directly. -slb */
149 buildmark (Bufpos val, Lisp_Object buffer)
151 Lisp_Object mark = Fmake_marker ();
152 Fset_marker (mark, make_int (val), buffer);
156 DEFUN ("point", Fpoint, 0, 1, 0, /*
157 Return value of point, as an integer.
158 Beginning of buffer is position (point-min).
159 If BUFFER is nil, the current buffer is assumed.
163 struct buffer *b = decode_buffer (buffer, 1);
164 return make_int (BUF_PT (b));
167 DEFUN ("point-marker", Fpoint_marker, 0, 2, 0, /*
168 Return value of point, as a marker object.
169 This marker is a copy; you may modify it with reckless abandon.
170 If optional argument DONT-COPY-P is non-nil, then it returns the real
171 point-marker; modifying the position of this marker will move point.
172 It is illegal to change the buffer of it, or make it point nowhere.
173 If BUFFER is nil, the current buffer is assumed.
175 (dont_copy_p, buffer))
177 struct buffer *b = decode_buffer (buffer, 1);
178 if (NILP (dont_copy_p))
179 return Fcopy_marker (b->point_marker, Qnil);
181 return b->point_marker;
184 /* The following two functions end up being identical but it's
185 cleaner to declare them separately. */
188 bufpos_clip_to_bounds (Bufpos lower, Bufpos num, Bufpos upper)
190 return (num < lower ? lower :
191 num > upper ? upper :
196 bytind_clip_to_bounds (Bytind lower, Bytind num, Bytind upper)
198 return (num < lower ? lower :
199 num > upper ? upper :
205 * There is no absolute way to determine if goto-char is the function
206 * being run. this-command doesn't work because it is often eval'd
207 * and this-command ends up set to eval-expression. So this flag gets
210 * Jamie thinks he's wrong, but we'll leave this in for now.
212 int atomic_extent_goto_char_p;
214 DEFUN ("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /*
215 Set point to POSITION, a number or marker.
216 Beginning of buffer is position (point-min), end is (point-max).
217 If BUFFER is nil, the current buffer is assumed.
218 Return value of POSITION, as an integer.
222 struct buffer *b = decode_buffer (buffer, 1);
223 Bufpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE);
225 atomic_extent_goto_char_p = 1;
230 region_limit (int beginningp, struct buffer *b)
235 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
236 && NILP (b->mark_active))
237 Fsignal (Qmark_inactive, Qnil);
239 m = Fmarker_position (b->mark);
240 if (NILP (m)) error ("There is no region now");
241 if (!!(BUF_PT (b) < XINT (m)) == !!beginningp)
242 return make_int (BUF_PT (b));
247 DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /*
248 Return position of beginning of region in BUFFER, as an integer.
249 If BUFFER is nil, the current buffer is assumed.
253 return region_limit (1, decode_buffer (buffer, 1));
256 DEFUN ("region-end", Fregion_end, 0, 1, 0, /*
257 Return position of end of region in BUFFER, as an integer.
258 If BUFFER is nil, the current buffer is assumed.
262 return region_limit (0, decode_buffer (buffer, 1));
265 /* Whether to use lispm-style active-regions */
268 /* Whether the zmacs region is active. This is not per-buffer because
269 there can be only one active region at a time. #### Now that the
270 zmacs region are not directly tied to the X selections this may not
271 necessarily have to be true. */
272 int zmacs_region_active_p;
274 int zmacs_region_stays;
276 Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region;
277 Lisp_Object Qzmacs_region_buffer;
280 zmacs_update_region (void)
282 /* This function can GC */
283 if (zmacs_region_active_p)
284 call0 (Qzmacs_update_region);
288 zmacs_deactivate_region (void)
290 /* This function can GC */
291 if (zmacs_region_active_p)
292 call0 (Qzmacs_deactivate_region);
296 zmacs_region_buffer (void)
298 if (zmacs_region_active_p)
299 return call0 (Qzmacs_region_buffer);
304 DEFUN ("mark-marker", Fmark_marker, 0, 2, 0, /*
305 Return this buffer's mark, as a marker object.
306 If `zmacs-regions' is true, then this returns nil unless the region is
307 currently in the active (highlighted) state. If optional argument FORCE
308 is t, this returns the mark (if there is one) regardless of the zmacs-region
309 state. You should *generally* not use the mark unless the region is active,
310 if the user has expressed a preference for the zmacs-region model.
311 Watch out! Moving this marker changes the mark position.
312 If you set the marker not to point anywhere, the buffer will have no mark.
313 If BUFFER is nil, the current buffer is assumed.
317 struct buffer *b = decode_buffer (buffer, 1);
318 if (! zmacs_regions || zmacs_region_active_p || !NILP (force))
324 /* The saved object is a cons:
326 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
328 We used to have another cons for a VISIBLE-P element, which was t
329 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
330 was unused for a long time, so I removed it. --hniksic */
332 save_excursion_save (void)
336 /* #### Huh? --hniksic */
337 /*if (preparing_for_armageddon) return Qnil;*/
339 #ifdef ERROR_CHECK_BUFPOS
340 assert (XINT (Fpoint (Qnil)) ==
341 XINT (Fmarker_position (Fpoint_marker (Qt, Qnil))));
346 return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil),
347 noseeum_copy_marker (b->mark, Qnil));
351 save_excursion_restore (Lisp_Object info)
353 Lisp_Object buffer = Fmarker_buffer (XCAR (info));
355 /* If buffer being returned to is now deleted, avoid error --
356 otherwise could get error here while unwinding to top level and
357 crash. In that case, Fmarker_buffer returns nil now. */
360 struct buffer *buf = XBUFFER (buffer);
363 set_buffer_internal (buf);
364 Fgoto_char (XCAR (info), buffer);
365 Fset_marker (buf->mark, XCDR (info), buffer);
367 #if 0 /* We used to make the current buffer visible in the selected window
368 if that was true previously. That avoids some anomalies.
369 But it creates others, and it wasn't documented, and it is simpler
370 and cleaner never to alter the window/buffer connections. */
371 /* I'm certain some code somewhere depends on this behavior. --jwz */
372 /* Even if it did, it certainly doesn't matter anymore, because
373 this has been the behavior for countless XEmacs releases
376 && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
377 switch_to_buffer (Fcurrent_buffer (), Qnil);
383 /* Free all the junk we allocated, so that a `save-excursion' comes
384 for free in terms of GC junk. */
385 free_marker (XMARKER (XCAR (info)));
386 free_marker (XMARKER (XCDR (info)));
387 free_cons (XCONS (info));
391 DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
392 Save point, mark, and current buffer; execute BODY; restore those things.
393 Executes BODY just like `progn'.
394 The values of point, mark and the current buffer are restored
395 even in case of abnormal exit (throw or error).
399 /* This function can GC */
400 int speccount = specpdl_depth ();
402 record_unwind_protect (save_excursion_restore, save_excursion_save ());
404 return unbind_to (speccount, Fprogn (args));
408 save_current_buffer_restore (Lisp_Object buffer)
410 struct buffer *buf = XBUFFER (buffer);
411 /* Avoid signaling an error if the buffer is no longer alive. This
412 is for consistency with save-excursion. */
413 if (BUFFER_LIVE_P (buf))
414 set_buffer_internal (buf);
418 DEFUN ("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /*
419 Save the current buffer; execute BODY; restore the current buffer.
420 Executes BODY just like `progn'.
424 /* This function can GC */
425 int speccount = specpdl_depth ();
427 record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ());
429 return unbind_to (speccount, Fprogn (args));
432 DEFUN ("buffer-size", Fbuffer_size, 0, 1, 0, /*
433 Return the number of characters in BUFFER.
434 If BUFFER is nil, the current buffer is assumed.
438 struct buffer *b = decode_buffer (buffer, 1);
439 return make_int (BUF_SIZE (b));
442 DEFUN ("point-min", Fpoint_min, 0, 1, 0, /*
443 Return the minimum permissible value of point in BUFFER.
444 This is 1, unless narrowing (a buffer restriction) is in effect.
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) is in effect.
456 If BUFFER is nil, the current buffer is assumed.
460 struct buffer *b = decode_buffer (buffer, 1);
461 return buildmark (BUF_BEGV (b), make_buffer (b));
464 DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
465 Return the maximum permissible value of point in BUFFER.
466 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
467 is in effect, in which case it is less.
468 If BUFFER is nil, the current buffer is assumed.
472 struct buffer *b = decode_buffer (buffer, 1);
473 return make_int (BUF_ZV (b));
476 DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
477 Return a marker to the maximum permissible value of point BUFFER.
478 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
479 is in effect, in which case it is less.
480 If BUFFER is nil, the current buffer is assumed.
484 struct buffer *b = decode_buffer (buffer, 1);
485 return buildmark (BUF_ZV (b), make_buffer (b));
488 DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /*
489 Return the character following point.
490 At the end of the buffer or accessible region, return 0.
491 If BUFFER is nil, the current buffer is assumed.
495 struct buffer *b = decode_buffer (buffer, 1);
496 if (BUF_PT (b) >= BUF_ZV (b))
497 return Qzero; /* #### Gag me! */
499 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b)));
502 DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /*
503 Return the character preceding point.
504 At the beginning of the buffer or accessible region, return 0.
505 If BUFFER is nil, the current buffer is assumed.
509 struct buffer *b = decode_buffer (buffer, 1);
510 if (BUF_PT (b) <= BUF_BEGV (b))
511 return Qzero; /* #### Gag me! */
513 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1));
516 DEFUN ("bobp", Fbobp, 0, 1, 0, /*
517 Return t if point is at the beginning of the buffer.
518 If the buffer is narrowed, this means the beginning of the narrowed part.
519 If BUFFER is nil, the current buffer is assumed.
523 struct buffer *b = decode_buffer (buffer, 1);
524 return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil;
527 DEFUN ("eobp", Feobp, 0, 1, 0, /*
528 Return t if point is at the end of the buffer.
529 If the buffer is narrowed, this means the end of the narrowed part.
530 If BUFFER is nil, the current buffer is assumed.
534 struct buffer *b = decode_buffer (buffer, 1);
535 return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil;
539 beginning_of_line_p (struct buffer *b, Bufpos pt)
541 return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n';
545 DEFUN ("bolp", Fbolp, 0, 1, 0, /*
546 Return t if point is at the beginning of a line.
547 If BUFFER is nil, the current buffer is assumed.
551 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
824 /* Returns the home directory, in external format */
826 get_home_directory (void)
828 int output_home_warning = 0;
830 if (cached_home_directory == NULL)
832 if ((cached_home_directory = getenv("HOME")) == NULL)
834 #if defined(WINDOWSNT) && !defined(__CYGWIN32__)
835 char *homedrive, *homepath;
837 if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
838 (homepath = getenv("HOMEPATH")) != NULL)
840 cached_home_directory =
841 (char *) xmalloc(strlen(homedrive) + strlen(homepath) + 1);
842 sprintf(cached_home_directory, "%s%s", homedrive, homepath);
848 * Use the current directory.
849 * This preserves the existing XEmacs behavior, but is different
852 if (initial_directory[0] != '\0')
854 cached_home_directory = initial_directory;
858 /* This will probably give the wrong value */
859 cached_home_directory = getcwd (NULL, 0);
863 * This is NT Emacs behavior
865 cached_home_directory = "C:\\";
866 output_home_warning = 1;
869 #else /* !WINDOWSNT */
872 * Using "/" isn't quite right, but what should we do?
873 * We probably should try to extract pw_dir from /etc/passwd,
874 * before falling back to this.
876 cached_home_directory = "/";
877 output_home_warning = 1;
878 #endif /* !WINDOWSNT */
880 if (initialized && output_home_warning)
882 warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
883 " XEmacs was unable to determine a good value for the user's $HOME\n"
884 " directory, and will be using the value:\n"
886 " This is probably incorrect.",
887 cached_home_directory
891 return cached_home_directory;
894 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
895 Return the user's home directory, as a string.
899 char *path = get_home_directory ();
901 return path == NULL ? Qnil :
902 Fexpand_file_name (Fsubstitute_in_file_name
903 (build_ext_string (path, FORMAT_FILENAME)),
907 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
908 Return the name of the machine you are running on, as a string.
912 return Fcopy_sequence (Vsystem_name);
915 /* For the benefit of callers who don't want to include lisp.h.
918 get_system_name (void)
920 return xstrdup ((char *) XSTRING_DATA (Vsystem_name));
923 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
924 Return the process ID of Emacs, as an integer.
928 return make_int (getpid ());
931 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
932 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
933 The time is returned as a list of three integers. The first has the
934 most significant 16 bits of the seconds, while the second has the
935 least significant 16 bits. The third integer gives the microsecond
938 The microsecond count is zero on systems that do not provide
939 resolution finer than a second.
946 return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
947 make_int ((EMACS_SECS (t) >> 0) & 0xffff),
948 make_int (EMACS_USECS (t)));
951 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
952 Return the amount of time used by this XEmacs process so far.
953 The return value is a list of three floating-point numbers, expressing
954 the user, system, and real times used by the process. The user time
955 measures the time actually spent by the CPU executing the code in this
956 process. The system time measures time spent by the CPU executing kernel
957 code on behalf of this process (e.g. I/O requests made by the process).
959 Note that the user and system times measure processor time, as opposed
960 to real time, and only accrue when the processor is actually doing
961 something: Time spent in an idle wait (waiting for user events to come
962 in or for I/O on a disk drive or other device to complete) does not
963 count. Thus, the user and system times will often be considerably
964 less than the real time.
966 Some systems do not allow the user and system times to be distinguished.
967 In this case, the user time will be the total processor time used by
968 the process, and the system time will be 0.
970 Some systems do not allow the real and processor times to be distinguished.
971 In this case, the user and real times will be the same and the system
976 double user, sys, real;
978 get_process_times (&user, &sys, &real);
979 return list3 (make_float (user), make_float (sys), make_float (real));
983 int lisp_to_time (Lisp_Object specified_time, time_t *result);
985 lisp_to_time (Lisp_Object specified_time, time_t *result)
987 Lisp_Object high, low;
989 if (NILP (specified_time))
990 return time (result) != -1;
992 CHECK_CONS (specified_time);
993 high = XCAR (specified_time);
994 low = XCDR (specified_time);
999 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
1000 return *result >> 16 == XINT (high);
1003 Lisp_Object time_to_lisp (time_t the_time);
1005 time_to_lisp (time_t the_time)
1007 unsigned int item = (unsigned int) the_time;
1008 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
1011 size_t emacs_strftime (char *string, size_t max, CONST char *format,
1012 CONST struct tm *tm);
1013 static long difftm (CONST struct tm *a, CONST struct tm *b);
1016 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
1017 Use FORMAT-STRING to format the time TIME.
1018 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1019 `current-time' and `file-attributes'. If TIME is not specified it
1020 defaults to the current time.
1021 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1022 %a is replaced by the abbreviated name of the day of week.
1023 %A is replaced by the full name of the day of week.
1024 %b is replaced by the abbreviated name of the month.
1025 %B is replaced by the full name of the month.
1026 %c is a synonym for "%x %X".
1027 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1028 %d is replaced by the day of month, zero-padded.
1029 %D is a synonym for "%m/%d/%y".
1030 %e is replaced by the day of month, blank-padded.
1031 %h is a synonym for "%b".
1032 %H is replaced by the hour (00-23).
1033 %I is replaced by the hour (00-12).
1034 %j is replaced by the day of the year (001-366).
1035 %k is replaced by the hour (0-23), blank padded.
1036 %l is replaced by the hour (1-12), blank padded.
1037 %m is replaced by the month (01-12).
1038 %M is replaced by the minute (00-59).
1039 %n is a synonym for "\\n".
1040 %p is replaced by AM or PM, as appropriate.
1041 %r is a synonym for "%I:%M:%S %p".
1042 %R is a synonym for "%H:%M".
1043 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1044 nonstandard extension)
1045 %S is replaced by the second (00-60).
1046 %t is a synonym for "\\t".
1047 %T is a synonym for "%H:%M:%S".
1048 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1049 %w is replaced by the day of week (0-6), Sunday is day 0.
1050 %W is replaced by the week of the year (00-53), first day of week is Monday.
1051 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1052 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1053 %y is replaced by the year without century (00-99).
1054 %Y is replaced by the year with century.
1055 %Z is replaced by the time zone abbreviation.
1057 The number of options reflects the `strftime' function.
1059 BUG: If the charset used by the current locale is not ISO 8859-1, the
1060 characters appearing in the day and month names may be incorrect.
1062 (format_string, time_))
1067 CHECK_STRING (format_string);
1069 if (! lisp_to_time (time_, &value))
1070 error ("Invalid time specification");
1072 /* This is probably enough. */
1073 size = XSTRING_LENGTH (format_string) * 6 + 50;
1077 char *buf = (char *) alloca (size);
1079 if (emacs_strftime (buf, size,
1080 (CONST char *) XSTRING_DATA (format_string),
1083 return build_ext_string (buf, FORMAT_BINARY);
1084 /* If buffer was too small, make it bigger. */
1089 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
1090 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1091 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1092 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1093 to use the current time. The list has the following nine members:
1094 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1095 only some operating systems support. MINUTE is an integer between 0 and 59.
1096 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
1097 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
1098 four-digit year. DOW is the day of week, an integer between 0 and 6, where
1099 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
1100 ZONE is an integer indicating the number of seconds east of Greenwich.
1101 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1107 struct tm *decoded_time;
1108 Lisp_Object list_args[9];
1110 if (! lisp_to_time (specified_time, &time_spec))
1111 error ("Invalid time specification");
1113 decoded_time = localtime (&time_spec);
1114 list_args[0] = make_int (decoded_time->tm_sec);
1115 list_args[1] = make_int (decoded_time->tm_min);
1116 list_args[2] = make_int (decoded_time->tm_hour);
1117 list_args[3] = make_int (decoded_time->tm_mday);
1118 list_args[4] = make_int (decoded_time->tm_mon + 1);
1119 list_args[5] = make_int (decoded_time->tm_year + 1900);
1120 list_args[6] = make_int (decoded_time->tm_wday);
1121 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
1123 /* Make a copy, in case gmtime modifies the struct. */
1124 save_tm = *decoded_time;
1125 decoded_time = gmtime (&time_spec);
1126 if (decoded_time == 0)
1127 list_args[8] = Qnil;
1129 list_args[8] = make_int (difftm (&save_tm, decoded_time));
1130 return Flist (9, list_args);
1133 static void set_time_zone_rule (char *tzstring);
1135 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
1136 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1137 This is the reverse operation of `decode-time', which see.
1138 ZONE defaults to the current time zone rule. This can
1139 be a string (as from `set-time-zone-rule'), or it can be a list
1140 \(as from `current-time-zone') or an integer (as from `decode-time')
1141 applied without consideration for daylight savings time.
1143 You can pass more than 7 arguments; then the first six arguments
1144 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1145 The intervening arguments are ignored.
1146 This feature lets (apply 'encode-time (decode-time ...)) work.
1148 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1149 for example, a DAY of 0 means the day preceding the given month.
1150 Year numbers less than 100 are treated just like other year numbers.
1151 If you want them to stand for years in this century, you must do that yourself.
1153 (int nargs, Lisp_Object *args))
1157 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1159 CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */
1160 CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */
1161 CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */
1162 CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */
1163 CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */
1164 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
1171 the_time = mktime (&tm);
1176 char **oldenv = environ, **newenv;
1179 tzstring = (char *) XSTRING_DATA (zone);
1180 else if (INTP (zone))
1182 int abszone = abs (XINT (zone));
1183 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
1184 abszone / (60*60), (abszone/60) % 60, abszone % 60);
1188 error ("Invalid time zone specification");
1190 /* Set TZ before calling mktime; merely adjusting mktime's returned
1191 value doesn't suffice, since that would mishandle leap seconds. */
1192 set_time_zone_rule (tzstring);
1194 the_time = mktime (&tm);
1196 /* Restore TZ to previous value. */
1200 #ifdef LOCALTIME_CACHE
1205 if (the_time == (time_t) -1)
1206 error ("Specified time is not representable");
1208 return wasteful_word_to_lisp (the_time);
1211 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1212 Return the current time, as a human-readable string.
1213 Programs can use this function to decode a time,
1214 since the number of columns in each field is fixed.
1215 The format is `Sun Sep 16 01:03:52 1973'.
1216 If an argument is given, it specifies a time to format
1217 instead of the current time. The argument should have the form:
1220 (HIGH LOW . IGNORED).
1221 Thus, you can use times obtained from `current-time'
1222 and from `file-attributes'.
1230 if (! lisp_to_time (specified_time, &value))
1232 tem = (char *) ctime (&value);
1234 strncpy (buf, tem, 24);
1237 return build_ext_string (buf, FORMAT_BINARY);
1240 #define TM_YEAR_ORIGIN 1900
1242 /* Yield A - B, measured in seconds. */
1244 difftm (CONST struct tm *a, CONST struct tm *b)
1246 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1247 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1248 /* Some compilers can't handle this as a single return statement. */
1250 /* difference in day of year */
1251 a->tm_yday - b->tm_yday
1252 /* + intervening leap days */
1253 + ((ay >> 2) - (by >> 2))
1255 + ((ay/100 >> 2) - (by/100 >> 2))
1256 /* + difference in years * 365 */
1257 + (long)(ay-by) * 365
1259 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
1260 + (a->tm_min - b->tm_min))
1261 + (a->tm_sec - b->tm_sec));
1264 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1265 Return the offset and name for the local time zone.
1266 This returns a list of the form (OFFSET NAME).
1267 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1268 A negative value means west of Greenwich.
1269 NAME is a string giving the name of the time zone.
1270 If an argument is given, it specifies when the time zone offset is determined
1271 instead of using the current time. The argument should have the form:
1274 (HIGH LOW . IGNORED).
1275 Thus, you can use times obtained from `current-time'
1276 and from `file-attributes'.
1278 Some operating systems cannot provide all this information to Emacs;
1279 in this case, `current-time-zone' returns a list containing nil for
1280 the data it can't find.
1285 struct tm *t = NULL;
1287 if (lisp_to_time (specified_time, &value)
1288 && (t = gmtime (&value)) != 0)
1290 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */
1294 t = localtime (&value);
1295 offset = difftm (t, &gmt);
1299 s = (char *)t->tm_zone;
1300 #else /* not HAVE_TM_ZONE */
1302 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1303 s = tzname[t->tm_isdst];
1305 #endif /* not HAVE_TM_ZONE */
1308 /* No local time zone name is available; use "+-NNNN" instead. */
1309 int am = (offset < 0 ? -offset : offset) / 60;
1310 sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
1313 return list2 (make_int (offset), build_string (s));
1316 return list2 (Qnil, Qnil);
1319 #ifdef LOCALTIME_CACHE
1321 /* These two values are known to load tz files in buggy implementations,
1322 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1323 Their values shouldn't matter in non-buggy implementations.
1324 We don't use string literals for these strings,
1325 since if a string in the environment is in readonly
1326 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1327 See Sun bugs 1113095 and 1114114, ``Timezone routines
1328 improperly modify environment''. */
1330 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1331 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1335 /* Set the local time zone rule to TZSTRING.
1336 This allocates memory into `environ', which it is the caller's
1337 responsibility to free. */
1339 set_time_zone_rule (char *tzstring)
1342 char **from, **to, **newenv;
1344 for (from = environ; *from; from++)
1346 envptrs = from - environ + 2;
1347 newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
1348 + (tzstring ? strlen (tzstring) + 4 : 0));
1351 char *t = (char *) (to + envptrs);
1353 strcat (t, tzstring);
1357 for (from = environ; *from; from++)
1358 if (strncmp (*from, "TZ=", 3) != 0)
1364 #ifdef LOCALTIME_CACHE
1366 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1367 "US/Pacific" that loads a tz file, then changes to a value like
1368 "XXX0" that does not load a tz file, and then changes back to
1369 its original value, the last change is (incorrectly) ignored.
1370 Also, if TZ changes twice in succession to values that do
1371 not load a tz file, tzset can dump core (see Sun bug#1225179).
1372 The following code works around these bugs. */
1376 /* Temporarily set TZ to a value that loads a tz file
1377 and that differs from tzstring. */
1379 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
1380 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
1386 /* The implied tzstring is unknown, so temporarily set TZ to
1387 two different values that each load a tz file. */
1388 *to = set_time_zone_rule_tz1;
1391 *to = set_time_zone_rule_tz2;
1396 /* Now TZ has the desired value, and tzset can be invoked safely. */
1403 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1404 Set the local time zone using TZ, a string specifying a time zone rule.
1405 If TZ is nil, use implementation-defined default time zone information.
1416 tzstring = (char *) XSTRING_DATA (tz);
1419 set_time_zone_rule (tzstring);
1422 environbuf = environ;
1429 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
1431 /* This function can GC */
1432 struct gcpro gcpro1;
1435 if (CHAR_OR_CHAR_INTP (arg))
1437 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
1439 else if (STRINGP (arg))
1441 buffer_insert_lisp_string (buf, arg);
1445 arg = wrong_type_argument (Qchar_or_string_p, arg);
1448 zmacs_region_stays = 0;
1453 /* Callers passing one argument to Finsert need not gcpro the
1454 argument "array", since the only element of the array will
1455 not be used after calling insert_emacs_char or insert_lisp_string,
1456 so we don't care if it gets trashed. */
1458 DEFUN ("insert", Finsert, 0, MANY, 0, /*
1459 Insert the arguments, either strings or characters, at point.
1460 Point moves forward so that it ends up after the inserted text.
1461 Any other markers at the point of insertion remain before the text.
1462 If a string has non-null string-extent-data, new extents will be created.
1464 (int nargs, Lisp_Object *args))
1466 /* This function can GC */
1467 REGISTER int argnum;
1469 for (argnum = 0; argnum < nargs; argnum++)
1471 buffer_insert1 (current_buffer, args[argnum]);
1477 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1478 Insert strings or characters at point, relocating markers after the text.
1479 Point moves forward so that it ends up after the inserted text.
1480 Any other markers at the point of insertion also end up after the text.
1482 (int nargs, Lisp_Object *args))
1484 /* This function can GC */
1485 REGISTER int argnum;
1486 REGISTER Lisp_Object tem;
1488 for (argnum = 0; argnum < nargs; argnum++)
1492 if (CHAR_OR_CHAR_INTP (tem))
1494 buffer_insert_emacs_char_1 (current_buffer, -1,
1495 XCHAR_OR_CHAR_INT (tem),
1496 INSDEL_BEFORE_MARKERS);
1498 else if (STRINGP (tem))
1500 buffer_insert_lisp_string_1 (current_buffer, -1, tem,
1501 INSDEL_BEFORE_MARKERS);
1505 tem = wrong_type_argument (Qchar_or_string_p, tem);
1509 zmacs_region_stays = 0;
1513 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
1514 Insert STRING into BUFFER at BUFFER's point.
1515 Point moves forward so that it ends up after the inserted text.
1516 Any other markers at the point of insertion remain before the text.
1517 If a string has non-null string-extent-data, new extents will be created.
1518 BUFFER defaults to the current buffer.
1522 struct buffer *b = decode_buffer (buffer, 1);
1523 CHECK_STRING (string);
1524 buffer_insert_lisp_string (b, string);
1525 zmacs_region_stays = 0;
1529 /* Third argument in FSF is INHERIT:
1531 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1532 from adjoining text, if those properties are sticky."
1534 Jamie thinks this is bogus. */
1537 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
1538 Insert COUNT (second arg) copies of CHR (first arg).
1539 Point and all markers are affected as in the function `insert'.
1540 COUNT defaults to 1 if omitted.
1541 The optional third arg IGNORED is INHERIT under FSF Emacs.
1542 This is highly bogus, however, and XEmacs always behaves as if
1543 `t' were passed to INHERIT.
1544 The optional fourth arg BUFFER specifies the buffer to insert the
1545 text into. If BUFFER is nil, the current buffer is assumed.
1547 (chr, count, ignored, buffer))
1549 /* This function can GC */
1550 REGISTER Bufbyte *string;
1553 REGISTER Bytecount n;
1554 REGISTER Bytecount charlen;
1555 Bufbyte str[MAX_EMCHAR_LEN];
1556 struct buffer *b = decode_buffer (buffer, 1);
1559 CHECK_CHAR_COERCE_INT (chr);
1568 charlen = set_charptr_emchar (str, XCHAR (chr));
1572 slen = min (n, 768);
1573 string = alloca_array (Bufbyte, slen);
1574 /* Write as many copies of the character into the temp string as will fit. */
1575 for (i = 0; i + charlen <= slen; i += charlen)
1576 for (j = 0; j < charlen; j++)
1577 string[i + j] = str[j];
1581 buffer_insert_raw_string (b, string, slen);
1585 #if 0 /* FSFmacs bogosity */
1587 if (!NILP (inherit))
1588 insert_and_inherit (string, n);
1593 buffer_insert_raw_string (b, string, n);
1596 zmacs_region_stays = 0;
1601 /* Making strings from buffer contents. */
1603 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1604 Return the contents of part of BUFFER as a string.
1605 The two arguments START and END are character positions;
1606 they can be in either order. If omitted, they default to the beginning
1607 and end of BUFFER, respectively.
1608 If there are duplicable extents in the region, the string remembers
1609 them in its extent data.
1610 If BUFFER is nil, the current buffer is assumed.
1612 (start, end, buffer))
1614 /* This function can GC */
1616 struct buffer *b = decode_buffer (buffer, 1);
1618 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1619 return make_string_from_buffer (b, begv, zv - begv);
1622 /* It might make more sense to name this
1623 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1624 and what the function does is probably good enough for what the
1625 user-code will typically want to use it for. */
1626 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1627 Return the text from BEG to END, as a string, without copying the extents.
1629 (start, end, buffer))
1631 /* This function can GC */
1633 struct buffer *b = decode_buffer (buffer, 1);
1635 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1636 return make_string_from_buffer_no_extents (b, begv, zv - begv);
1639 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1640 Insert before point a substring of the contents of buffer BUFFER.
1641 BUFFER may be a buffer or a buffer name.
1642 Arguments START and END are character numbers specifying the substring.
1643 They default to the beginning and the end of BUFFER.
1645 (buffer, start, end))
1647 /* This function can GC */
1651 bp = XBUFFER (get_buffer (buffer, 1));
1652 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
1655 buffer_insert_from_buffer (current_buffer, bp, b, e - b);
1660 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1661 Compare two substrings of two buffers; return result as number.
1662 the value is -N if first string is less after N-1 chars,
1663 +N if first string is greater after N-1 chars, or 0 if strings match.
1664 Each substring is represented as three arguments: BUFFER, START and END.
1665 That makes six args in all, three for each substring.
1667 The value of `case-fold-search' in the current buffer
1668 determines whether case is significant or ignored.
1670 (buffer1, start1, end1, buffer2, start2, end2))
1672 Bufpos begp1, endp1, begp2, endp2;
1673 REGISTER Charcount len1, len2, length, i;
1674 struct buffer *bp1, *bp2;
1675 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
1676 current_buffer->case_canon_table : Qnil);
1678 /* Find the first buffer and its substring. */
1680 bp1 = decode_buffer (buffer1, 1);
1681 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1683 /* Likewise for second substring. */
1685 bp2 = decode_buffer (buffer2, 1);
1686 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1688 len1 = endp1 - begp1;
1689 len2 = endp2 - begp2;
1694 for (i = 0; i < length; i++)
1696 Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
1697 Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
1700 c1 = TRT_TABLE_OF (trt, c1);
1701 c2 = TRT_TABLE_OF (trt, c2);
1704 return make_int (- 1 - i);
1706 return make_int (i + 1);
1709 /* The strings match as far as they go.
1710 If one is shorter, that one is less. */
1712 return make_int (length + 1);
1713 else if (length < len2)
1714 return make_int (- length - 1);
1716 /* Same length too => they are equal. */
1722 subst_char_in_region_unwind (Lisp_Object arg)
1724 XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
1729 subst_char_in_region_unwind_1 (Lisp_Object arg)
1731 XBUFFER (XCAR (arg))->filename = XCDR (arg);
1735 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1736 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1737 If optional arg NOUNDO is non-nil, don't record this change for undo
1738 and don't mark the buffer as really changed.
1740 (start, end, fromchar, tochar, noundo))
1742 /* This function can GC */
1746 struct buffer *buf = current_buffer;
1747 int count = specpdl_depth ();
1749 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1750 CHECK_CHAR_COERCE_INT (fromchar);
1751 CHECK_CHAR_COERCE_INT (tochar);
1753 fromc = XCHAR (fromchar);
1754 toc = XCHAR (tochar);
1756 /* If we don't want undo, turn off putting stuff on the list.
1757 That's faster than getting rid of things,
1758 and it prevents even the entry for a first change.
1759 Also inhibit locking the file. */
1762 record_unwind_protect (subst_char_in_region_unwind,
1763 Fcons (Fcurrent_buffer (), buf->undo_list));
1764 buf->undo_list = Qt;
1765 /* Don't do file-locking. */
1766 record_unwind_protect (subst_char_in_region_unwind_1,
1767 Fcons (Fcurrent_buffer (), buf->filename));
1768 buf->filename = Qnil;
1771 mc_count = begin_multiple_change (buf, pos, stop);
1774 if (BUF_FETCH_CHAR (buf, pos) == fromc)
1776 /* There used to be some code here that set the buffer to
1777 unmodified if NOUNDO was specified and there was only
1778 one change to the buffer since it was last saved.
1779 This is a crock of shit, so I'm not duplicating this
1780 behavior. I think this was left over from when
1781 prepare_to_modify_buffer() actually bumped MODIFF,
1782 so that code was supposed to undo this change. --ben */
1783 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
1785 /* If noundo is not nil then we don't mark the buffer as
1786 modified. In reality that needs to happen externally
1787 only. Internally redisplay needs to know that the actual
1788 contents it should be displaying have changed. */
1790 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
1794 end_multiple_change (buf, mc_count);
1796 unbind_to (count, Qnil);
1800 /* #### Shouldn't this also accept a BUFFER argument, in the good old
1801 XEmacs tradition? */
1802 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
1803 Translate characters from START to END according to TABLE.
1805 If TABLE is a string, the Nth character in it is the mapping for the
1806 character with code N.
1808 If TABLE is a vector, its Nth element is the mapping for character
1809 with code N. The values of elements may be characters, strings, or
1810 nil (nil meaning don't replace.)
1812 If TABLE is a char-table, its elements describe the mapping between
1813 characters and their replacements. The char-table should be of type
1814 `char' or `generic'.
1816 Returns the number of substitutions performed.
1818 (start, end, table))
1820 /* This function can GC */
1821 Bufpos pos, stop; /* Limits of the region. */
1822 int cnt = 0; /* Number of changes made. */
1824 struct buffer *buf = current_buffer;
1827 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1828 mc_count = begin_multiple_change (buf, pos, stop);
1829 if (STRINGP (table))
1831 struct Lisp_String *stable = XSTRING (table);
1832 Charcount size = string_char_length (stable);
1834 /* Under Mule, string_char(n) is O(n), so for large tables or
1835 large regions it makes sense to create an array of Emchars. */
1836 if (size * (stop - pos) > 65536)
1838 Emchar *etable = alloca_array (Emchar, size);
1839 convert_bufbyte_string_into_emchar_string
1840 (string_data (stable), string_length (stable), etable);
1841 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1845 Emchar nc = etable[oc];
1848 buffer_replace_char (buf, pos, nc, 0, 0);
1857 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1861 Emchar nc = string_char (stable, oc);
1864 buffer_replace_char (buf, pos, nc, 0, 0);
1871 else if (VECTORP (table))
1873 Charcount size = XVECTOR_LENGTH (table);
1874 Lisp_Object *vtable = XVECTOR_DATA (table);
1876 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1880 Lisp_Object replacement = vtable[oc];
1882 if (CHAR_OR_CHAR_INTP (replacement))
1884 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1887 buffer_replace_char (buf, pos, nc, 0, 0);
1891 else if (STRINGP (replacement))
1893 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1894 buffer_delete_range (buf, pos, pos + 1, 0);
1895 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1896 pos += incr, stop += incr;
1899 else if (!NILP (replacement))
1901 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1907 else if (CHAR_TABLEP (table)
1908 && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
1909 || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
1911 struct Lisp_Char_Table *ctable = XCHAR_TABLE (table);
1913 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1915 Lisp_Object replacement = get_char_table (oc, ctable);
1917 if (CHAR_OR_CHAR_INTP (replacement))
1919 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1922 buffer_replace_char (buf, pos, nc, 0, 0);
1926 else if (STRINGP (replacement))
1928 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1929 buffer_delete_range (buf, pos, pos + 1, 0);
1930 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1931 pos += incr, stop += incr;
1934 else if (!NILP (replacement))
1936 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1942 dead_wrong_type_argument (Qstringp, table);
1943 end_multiple_change (buf, mc_count);
1945 return make_int (cnt);
1948 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
1949 Delete the text between point and mark.
1950 When called from a program, expects two arguments,
1951 positions (integers or markers) specifying the stretch to be deleted.
1952 If BUFFER is nil, the current buffer is assumed.
1956 /* This function can GC */
1958 struct buffer *buf = decode_buffer (buffer, 1);
1960 get_buffer_range_char (buf, b, e, &start, &end, 0);
1961 buffer_delete_range (buf, start, end, 0);
1962 zmacs_region_stays = 0;
1967 widen_buffer (struct buffer *b, int no_clip)
1969 if (BUF_BEGV (b) != BUF_BEG (b))
1972 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b));
1974 if (BUF_ZV (b) != BUF_Z (b))
1977 SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b));
1983 /* Changing the buffer bounds invalidates any recorded current
1985 invalidate_current_column ();
1986 narrow_line_number_cache (b);
1990 DEFUN ("widen", Fwiden, 0, 1, "", /*
1991 Remove restrictions (narrowing) from BUFFER.
1992 This allows the buffer's full text to be seen and edited.
1993 If BUFFER is nil, the current buffer is assumed.
1997 struct buffer *b = decode_buffer (buffer, 1);
1998 widen_buffer (b, 0);
1999 zmacs_region_stays = 0;
2003 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2004 Restrict editing in BUFFER to the current region.
2005 The rest of the text becomes temporarily invisible and untouchable
2006 but is not deleted; if you save the buffer in a file, the invisible
2007 text is included in the file. \\[widen] makes all visible again.
2008 If BUFFER is nil, the current buffer is assumed.
2009 See also `save-restriction'.
2011 When calling from a program, pass two arguments; positions (integers
2012 or markers) bounding the text that should remain visible.
2017 struct buffer *buf = decode_buffer (buffer, 1);
2018 Bytind bi_start, bi_end;
2020 get_buffer_range_char (buf, b, e, &start, &end, GB_ALLOW_PAST_ACCESSIBLE);
2021 bi_start = bufpos_to_bytind (buf, start);
2022 bi_end = bufpos_to_bytind (buf, end);
2024 SET_BOTH_BUF_BEGV (buf, start, bi_start);
2025 SET_BOTH_BUF_ZV (buf, end, bi_end);
2026 if (BUF_PT (buf) < start)
2027 BUF_SET_PT (buf, start);
2028 if (BUF_PT (buf) > end)
2029 BUF_SET_PT (buf, end);
2031 /* Changing the buffer bounds invalidates any recorded current column. */
2032 invalidate_current_column ();
2033 narrow_line_number_cache (buf);
2034 zmacs_region_stays = 0;
2039 save_restriction_save (void)
2041 Lisp_Object bottom, top;
2042 /* Note: I tried using markers here, but it does not win
2043 because insertion at the end of the saved region
2044 does not advance mh and is considered "outside" the saved region. */
2045 bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer));
2046 top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer));
2048 return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top));
2052 save_restriction_restore (Lisp_Object data)
2055 Charcount newhead, newtail;
2057 int local_clip_changed = 0;
2059 buf = XBUFFER (XCAR (data));
2060 if (!BUFFER_LIVE_P (buf))
2062 /* someone could have killed the buffer in the meantime ... */
2063 free_cons (XCONS (XCDR (data)));
2064 free_cons (XCONS (data));
2068 newhead = XINT (XCAR (tem));
2069 newtail = XINT (XCDR (tem));
2071 free_cons (XCONS (XCDR (data)));
2072 free_cons (XCONS (data));
2074 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
2082 Bytind bi_start, bi_end;
2084 start = BUF_BEG (buf) + newhead;
2085 end = BUF_Z (buf) - newtail;
2087 bi_start = bufpos_to_bytind (buf, start);
2088 bi_end = bufpos_to_bytind (buf, end);
2090 if (BUF_BEGV (buf) != start)
2092 local_clip_changed = 1;
2093 SET_BOTH_BUF_BEGV (buf, start, bi_start);
2094 narrow_line_number_cache (buf);
2096 if (BUF_ZV (buf) != end)
2098 local_clip_changed = 1;
2099 SET_BOTH_BUF_ZV (buf, end, bi_end);
2102 if (local_clip_changed)
2105 /* If point is outside the new visible range, move it inside. */
2107 bufpos_clip_to_bounds (BUF_BEGV (buf),
2114 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2115 Execute BODY, saving and restoring current buffer's restrictions.
2116 The buffer's restrictions make parts of the beginning and end invisible.
2117 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2118 This special form, `save-restriction', saves the current buffer's restrictions
2119 when it is entered, and restores them when it is exited.
2120 So any `narrow-to-region' within BODY lasts only until the end of the form.
2121 The old restrictions settings are restored
2122 even in case of abnormal exit (throw or error).
2124 The value returned is the value of the last form in BODY.
2126 `save-restriction' can get confused if, within the BODY, you widen
2127 and then make changes outside the area within the saved restrictions.
2129 Note: if you are using both `save-excursion' and `save-restriction',
2130 use `save-excursion' outermost:
2131 (save-excursion (save-restriction ...))
2135 /* This function can GC */
2136 int speccount = specpdl_depth ();
2138 record_unwind_protect (save_restriction_restore, save_restriction_save ());
2140 return unbind_to (speccount, Fprogn (body));
2144 DEFUN ("format", Fformat, 1, MANY, 0, /*
2145 Format a string out of a control-string and arguments.
2146 The first argument is a control string.
2147 The other arguments are substituted into it to make the result, a string.
2148 It may contain %-sequences meaning to substitute the next argument.
2149 %s means print all objects as-is, using `princ'.
2150 %S means print all objects as s-expressions, using `prin1'.
2151 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
2153 %c means print as a single character.
2154 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2155 %e or %E means print as a floating-point number in scientific notation
2157 %g or %G means print as a floating-point number in "pretty format";
2158 depending on the number, either %f or %e/%E format will be used, and
2159 trailing zeroes are removed from the fractional part.
2160 The argument used for all but %s and %S must be a number. It will be
2161 converted to an integer or a floating-point number as necessary.
2163 %$ means reposition to read a specific numbered argument; for example,
2164 %3$s would apply the `%s' to the third argument after the control string,
2165 and the next format directive would use the fourth argument, the
2166 following one the fifth argument, etc. (There must be a positive integer
2167 between the % and the $).
2168 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2169 specified between the optional repositioning spec and the conversion
2170 character; see below.
2171 An optional minimum field width may be specified after any flag characters
2172 and before the conversion character; it specifies the minimum number of
2173 characters that the converted argument will take up. Padding will be
2174 added on the left (or on the right, if the `-' flag is specified), as
2175 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2177 If the field width is specified as `*', the field width is assumed to have
2178 been specified as an argument. Any repositioning specification that
2179 would normally specify the argument to be converted will now specify
2180 where to find this field width argument, not where to find the argument
2181 to be converted. If there is no repositioning specification, the normal
2182 next argument is used. The argument to be converted will be the next
2183 argument after the field width argument unless the precision is also
2184 specified as `*' (see below).
2186 An optional period character and precision may be specified after any
2187 minimum field width. It specifies the minimum number of digits to
2188 appear in %d, %i, %o, %x, and %X conversions (the number is padded
2189 on the left with zeroes as necessary); the number of digits printed
2190 after the decimal point for %f, %e, and %E conversions; the number
2191 of significant digits printed in %g and %G conversions; and the
2192 maximum number of non-padding characters printed in %s and %S
2193 conversions. The default precision for floating-point conversions
2195 If the precision is specified as `*', the precision is assumed to have been
2196 specified as an argument. The argument used will be the next argument
2197 after the field width argument, if any. If the field width was not
2198 specified as an argument, any repositioning specification that would
2199 normally specify the argument to be converted will now specify where to
2200 find the precision argument. If there is no repositioning specification,
2201 the normal next argument is used.
2203 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2204 plus sign, respectively.
2205 The `#' flag means print numbers in an alternate, more verbose format:
2206 octal numbers begin with zero; hex numbers begin with a 0x or 0X;
2207 a decimal point is printed in %f, %e, and %E conversions even if no
2208 numbers are printed after it; and trailing zeroes are not omitted in
2209 %g and %G conversions.
2211 Use %% to put a single % into the output.
2213 (int nargs, Lisp_Object *args))
2215 /* It should not be necessary to GCPRO ARGS, because
2216 the caller in the interpreter should take care of that. */
2218 CHECK_STRING (args[0]);
2219 return emacs_doprnt_string_lisp (0, args[0], 0, nargs - 1, args + 1);
2223 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
2224 Return t if two characters match, optionally ignoring case.
2225 Both arguments must be characters (i.e. NOT integers).
2226 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2227 If BUFFER is nil, the current buffer is assumed.
2232 struct buffer *b = decode_buffer (buffer, 1);
2234 CHECK_CHAR_COERCE_INT (c1);
2235 CHECK_CHAR_COERCE_INT (c2);
2239 return (!NILP (b->case_fold_search)
2240 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
2245 DEFUN ("char=", Fchar_Equal, 2, 3, 0, /*
2246 Return t if two characters match, case is significant.
2247 Both arguments must be characters (i.e. NOT integers).
2248 The optional buffer argument is for symmetry and is ignored.
2252 CHECK_CHAR_COERCE_INT (c1);
2253 CHECK_CHAR_COERCE_INT (c2);
2255 return XCHAR(c1) == XCHAR(c2) ? Qt : Qnil;
2258 #if 0 /* Undebugged FSFmacs code */
2259 /* Transpose the markers in two regions of the current buffer, and
2260 adjust the ones between them if necessary (i.e.: if the regions
2263 Traverses the entire marker list of the buffer to do so, adding an
2264 appropriate amount to some, subtracting from some, and leaving the
2265 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2267 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2270 transpose_markers (Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2272 Charcount amt1, amt2, diff;
2274 struct buffer *buf = current_buffer;
2276 /* Update point as if it were a marker. */
2277 if (BUF_PT (buf) < start1)
2279 else if (BUF_PT (buf) < end1)
2280 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
2281 else if (BUF_PT (buf) < start2)
2282 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
2283 else if (BUF_PT (buf) < end2)
2284 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
2286 /* We used to adjust the endpoints here to account for the gap, but that
2287 isn't good enough. Even if we assume the caller has tried to move the
2288 gap out of our way, it might still be at start1 exactly, for example;
2289 and that places it `inside' the interval, for our purposes. The amount
2290 of adjustment is nontrivial if there's a `denormalized' marker whose
2291 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2292 the dirty work to Fmarker_position, below. */
2294 /* The difference between the region's lengths */
2295 diff = (end2 - start2) - (end1 - start1);
2297 /* For shifting each marker in a region by the length of the other
2298 * region plus the distance between the regions.
2300 amt1 = (end2 - start2) + (start2 - end1);
2301 amt2 = (end1 - start1) + (start2 - end1);
2303 for (marker = BUF_MARKERS (buf); !NILP (marker);
2304 marker = XMARKER (marker)->chain)
2306 Bufpos mpos = marker_position (marker);
2307 if (mpos >= start1 && mpos < end2)
2311 else if (mpos < start2)
2315 set_marker_position (marker, mpos);
2322 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2323 Transpose region START1 to END1 with START2 to END2.
2324 The regions may not be overlapping, because the size of the buffer is
2325 never changed in a transposition.
2327 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose
2328 any markers that happen to be located in the regions. (#### BUG: currently
2329 this function always acts as if LEAVE_MARKERS is non-nil.)
2331 Transposing beyond buffer boundaries is an error.
2333 (startr1, endr1, startr2, endr2, leave_markers))
2335 Bufpos start1, end1, start2, end2;
2336 Charcount len1, len2;
2337 Lisp_Object string1, string2;
2338 struct buffer *buf = current_buffer;
2340 get_buffer_range_char (buf, startr1, endr1, &start1, &end1, 0);
2341 get_buffer_range_char (buf, startr2, endr2, &start2, &end2, 0);
2343 len1 = end1 - start1;
2344 len2 = end2 - start2;
2347 error ("transposed regions not properly ordered");
2348 else if (start1 == end1 || start2 == end2)
2349 error ("transposed region may not be of length 0");
2351 string1 = make_string_from_buffer (buf, start1, len1);
2352 string2 = make_string_from_buffer (buf, start2, len2);
2353 buffer_delete_range (buf, start2, end2, 0);
2354 buffer_insert_lisp_string_1 (buf, start2, string1, 0);
2355 buffer_delete_range (buf, start1, end1, 0);
2356 buffer_insert_lisp_string_1 (buf, start1, string2, 0);
2358 /* In FSFmacs there is a whole bunch of really ugly code here
2359 to attempt to transpose the regions without using up any
2360 extra memory. Although the intent may be good, the result
2361 was highly bogus. */
2367 /************************************************************************/
2368 /* initialization */
2369 /************************************************************************/
2372 syms_of_editfns (void)
2374 defsymbol (&Qpoint, "point");
2375 defsymbol (&Qmark, "mark");
2376 defsymbol (&Qregion_beginning, "region-beginning");
2377 defsymbol (&Qregion_end, "region-end");
2378 defsymbol (&Qformat, "format");
2379 defsymbol (&Quser_files_and_directories, "user-files-and-directories");
2381 DEFSUBR (Fchar_equal);
2382 DEFSUBR (Fchar_Equal);
2383 DEFSUBR (Fgoto_char);
2384 DEFSUBR (Fstring_to_char);
2385 DEFSUBR (Fchar_to_string);
2386 DEFSUBR (Fbuffer_substring);
2387 DEFSUBR (Fbuffer_substring_no_properties);
2389 DEFSUBR (Fpoint_marker);
2390 DEFSUBR (Fmark_marker);
2392 DEFSUBR (Fregion_beginning);
2393 DEFSUBR (Fregion_end);
2394 DEFSUBR (Fsave_excursion);
2395 DEFSUBR (Fsave_current_buffer);
2397 DEFSUBR (Fbuffer_size);
2398 DEFSUBR (Fpoint_max);
2399 DEFSUBR (Fpoint_min);
2400 DEFSUBR (Fpoint_min_marker);
2401 DEFSUBR (Fpoint_max_marker);
2407 DEFSUBR (Ffollowing_char);
2408 DEFSUBR (Fpreceding_char);
2409 DEFSUBR (Fchar_after);
2410 DEFSUBR (Fchar_before);
2412 DEFSUBR (Finsert_string);
2413 DEFSUBR (Finsert_before_markers);
2414 DEFSUBR (Finsert_char);
2416 DEFSUBR (Ftemp_directory);
2417 DEFSUBR (Fuser_login_name);
2418 DEFSUBR (Fuser_real_login_name);
2419 DEFSUBR (Fuser_uid);
2420 DEFSUBR (Fuser_real_uid);
2421 DEFSUBR (Fuser_full_name);
2422 DEFSUBR (Fuser_home_directory);
2423 DEFSUBR (Femacs_pid);
2424 DEFSUBR (Fcurrent_time);
2425 DEFSUBR (Fcurrent_process_time);
2426 DEFSUBR (Fformat_time_string);
2427 DEFSUBR (Fdecode_time);
2428 DEFSUBR (Fencode_time);
2429 DEFSUBR (Fcurrent_time_string);
2430 DEFSUBR (Fcurrent_time_zone);
2431 DEFSUBR (Fset_time_zone_rule);
2432 DEFSUBR (Fsystem_name);
2435 DEFSUBR (Finsert_buffer_substring);
2436 DEFSUBR (Fcompare_buffer_substrings);
2437 DEFSUBR (Fsubst_char_in_region);
2438 DEFSUBR (Ftranslate_region);
2439 DEFSUBR (Fdelete_region);
2441 DEFSUBR (Fnarrow_to_region);
2442 DEFSUBR (Fsave_restriction);
2443 DEFSUBR (Ftranspose_regions);
2445 defsymbol (&Qzmacs_update_region, "zmacs-update-region");
2446 defsymbol (&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2447 defsymbol (&Qzmacs_region_buffer, "zmacs-region-buffer");
2451 vars_of_editfns (void)
2453 staticpro (&Vsystem_name);
2455 staticpro (&Vuser_name);
2456 staticpro (&Vuser_real_name);
2458 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
2459 *Whether LISPM-style active regions should be used.
2460 This means that commands which operate on the region (the area between the
2461 point and the mark) will only work while the region is in the ``active''
2462 state, which is indicated by highlighting. Executing most commands causes
2463 the region to not be in the active state, so (for example) \\[kill-region] will only
2464 work immediately after activating the region.
2468 - Commands which operate on the region only work if the region is active.
2469 - Only a very small set of commands cause the region to become active:
2470 Those commands whose semantics are to mark an area, like mark-defun.
2471 - The region is deactivated after each command that is executed, except that:
2472 - "Motion" commands do not change whether the region is active or not.
2474 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2475 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2476 between point and the recently-pushed mark to be highlighted. It will
2477 remain highlighted until some non-motion command is executed.
2479 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2480 region and execute a command that operates on it, you can reactivate the
2481 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2484 Generally, commands which push marks as a means of navigation (like
2485 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2486 region. But commands which push marks as a means of marking an area of
2487 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2488 do activate the region.
2490 The way the command loop actually works with regard to deactivating the
2491 region is as follows:
2493 - If the variable `zmacs-region-stays' has been set to t during the command
2494 just executed, the region is left alone (this is how the motion commands
2495 make the region stay around; see the `_' flag in the `interactive'
2496 specification). `zmacs-region-stays' is reset to nil before each command
2498 - If the function `zmacs-activate-region' has been called during the command
2499 just executed, the region is left alone. Very few functions should
2500 actually call this function.
2501 - Otherwise, if the region is active, the region is deactivated and
2502 the `zmacs-deactivate-region-hook' is called.
2504 /* Zmacs style active regions are now ON by default */
2507 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
2508 Do not alter this. It is for internal use only.
2510 zmacs_region_active_p = 0;
2512 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
2513 Whether the current command will deactivate the region.
2514 Commands which do not wish to affect whether the region is currently
2515 highlighted should set this to t. Normally, the region is turned off after
2516 executing each command that did not explicitly turn it on with the function
2517 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2518 See the variable `zmacs-regions'.
2520 The same effect can be achieved using the `_' interactive specification.
2522 zmacs_region_stays = 0;
2524 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2525 Do not use this -- it will be going away soon.
2526 Indicates if `goto-char' has just been run. This information is allegedly
2527 needed to get the desired behavior for atomic extents and unfortunately
2528 is not available by any other means.
2530 atomic_extent_goto_char_p = 0;
2531 #ifdef AMPERSAND_FULL_NAME
2532 Fprovide(intern("ampersand-full-name"));
2535 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
2536 *The name of the user.
2537 The function `user-full-name', which will return the value of this
2538 variable, when called without arguments.
2539 This is initialized to the value of the NAME environment variable.
2541 /* Initialized at run-time. */
2542 Vuser_full_name = Qnil;