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. */
34 #include "events.h" /* for EVENTP */
40 #include "line-number.h"
45 #include "sysfile.h" /* for getcwd */
47 /* Some static data, and a function to initialize it for each run */
49 Lisp_Object Vsystem_name; /* #### - I don't see why this should be */
50 /* static, either... --Stig */
51 #if 0 /* XEmacs - this is now dynamic */
52 /* if at some point it's deemed desirable to
53 use lisp variables here, then they can be
54 initialized to nil and then set to their
55 real values upon the first call to the
56 functions that generate them. --stig */
57 Lisp_Object Vuser_real_login_name; /* login name of current user ID */
58 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */
61 /* It's useful to be able to set this as user customization, so we'll
63 Lisp_Object Vuser_full_name;
64 EXFUN (Fuser_full_name, 1);
68 Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
70 Lisp_Object Quser_files_and_directories;
72 /* This holds the value of `environ' produced by the previous
73 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
74 has never been called. */
75 static char **environbuf;
80 /* Only used in removed code below. */
85 /* Set up system_name even when dumping. */
93 if ((p = getenv ("NAME")))
94 /* I don't think it's the right thing to do the ampersand
95 modification on NAME. Not that it matters anymore... -hniksic */
96 Vuser_full_name = build_ext_string (p, Qnative);
98 Vuser_full_name = Fuser_full_name (Qnil);
101 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
102 Convert arg CH to a one-character string containing that character.
107 Bufbyte str[MAX_EMCHAR_LEN];
111 Lisp_Object ch2 = Fevent_to_character (ch, Qt, Qnil, Qnil);
114 signal_simple_continuable_error
115 ("character has no ASCII equivalent:", Fcopy_event (ch, Qnil));
119 CHECK_CHAR_COERCE_INT (ch);
121 len = set_charptr_emchar (str, XCHAR (ch));
122 return make_string (str, len);
125 DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /*
126 Convert arg STRING to a character, the first character of that string.
127 An empty string will return the constant `nil'.
135 if (string_length (p) != 0)
136 return make_char (string_char (p, 0));
138 /* This used to return Qzero. That is broken, broken, broken. */
139 /* It might be kinder to signal an error directly. -slb */
145 buildmark (Bufpos val, Lisp_Object buffer)
147 Lisp_Object mark = Fmake_marker ();
148 Fset_marker (mark, make_int (val), buffer);
152 DEFUN ("point", Fpoint, 0, 1, 0, /*
153 Return value of point, as an integer.
154 Beginning of buffer is position (point-min).
155 If BUFFER is nil, the current buffer is assumed.
159 struct buffer *b = decode_buffer (buffer, 1);
160 return make_int (BUF_PT (b));
163 DEFUN ("point-marker", Fpoint_marker, 0, 2, 0, /*
164 Return value of point, as a marker object.
165 This marker is a copy; you may modify it with reckless abandon.
166 If optional argument DONT-COPY-P is non-nil, then it returns the real
167 point-marker; modifying the position of this marker will move point.
168 It is illegal to change the buffer of it, or make it point nowhere.
169 If BUFFER is nil, the current buffer is assumed.
171 (dont_copy_p, buffer))
173 struct buffer *b = decode_buffer (buffer, 1);
174 if (NILP (dont_copy_p))
175 return Fcopy_marker (b->point_marker, Qnil);
177 return b->point_marker;
180 /* The following two functions end up being identical but it's
181 cleaner to declare them separately. */
184 bufpos_clip_to_bounds (Bufpos lower, Bufpos num, Bufpos upper)
186 return (num < lower ? lower :
187 num > upper ? upper :
192 bytind_clip_to_bounds (Bytind lower, Bytind num, Bytind upper)
194 return (num < lower ? lower :
195 num > upper ? upper :
201 * There is no absolute way to determine if goto-char is the function
202 * being run. this-command doesn't work because it is often eval'd
203 * and this-command ends up set to eval-expression. So this flag gets
206 * Jamie thinks he's wrong, but we'll leave this in for now.
208 int atomic_extent_goto_char_p;
210 DEFUN ("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /*
211 Set point to POSITION, a number or marker.
212 Beginning of buffer is position (point-min), end is (point-max).
213 If BUFFER is nil, the current buffer is assumed.
214 Return value of POSITION, as an integer.
218 struct buffer *b = decode_buffer (buffer, 1);
219 Bufpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE);
221 atomic_extent_goto_char_p = 1;
226 region_limit (int beginningp, struct buffer *b)
231 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
232 && NILP (b->mark_active))
233 Fsignal (Qmark_inactive, Qnil);
235 m = Fmarker_position (b->mark);
236 if (NILP (m)) error ("There is no region now");
237 if (!!(BUF_PT (b) < XINT (m)) == !!beginningp)
238 return make_int (BUF_PT (b));
243 DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /*
244 Return position of beginning of region in BUFFER, as an integer.
245 If BUFFER is nil, the current buffer is assumed.
249 return region_limit (1, decode_buffer (buffer, 1));
252 DEFUN ("region-end", Fregion_end, 0, 1, 0, /*
253 Return position of end of region in BUFFER, as an integer.
254 If BUFFER is nil, the current buffer is assumed.
258 return region_limit (0, decode_buffer (buffer, 1));
261 /* Whether to use lispm-style active-regions */
264 /* Whether the zmacs region is active. This is not per-buffer because
265 there can be only one active region at a time. #### Now that the
266 zmacs region are not directly tied to the X selections this may not
267 necessarily have to be true. */
268 int zmacs_region_active_p;
270 int zmacs_region_stays;
272 Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region;
273 Lisp_Object Qzmacs_region_buffer;
276 zmacs_update_region (void)
278 /* This function can GC */
279 if (zmacs_region_active_p)
280 call0 (Qzmacs_update_region);
284 zmacs_deactivate_region (void)
286 /* This function can GC */
287 if (zmacs_region_active_p)
288 call0 (Qzmacs_deactivate_region);
292 zmacs_region_buffer (void)
294 if (zmacs_region_active_p)
295 return call0 (Qzmacs_region_buffer);
300 DEFUN ("mark-marker", Fmark_marker, 0, 2, 0, /*
301 Return this buffer's mark, as a marker object.
302 If `zmacs-regions' is true, then this returns nil unless the region is
303 currently in the active (highlighted) state. If optional argument FORCE
304 is t, this returns the mark (if there is one) regardless of the zmacs-region
305 state. You should *generally* not use the mark unless the region is active,
306 if the user has expressed a preference for the zmacs-region model.
307 Watch out! Moving this marker changes the mark position.
308 If you set the marker not to point anywhere, the buffer will have no mark.
309 If BUFFER is nil, the current buffer is assumed.
313 struct buffer *b = decode_buffer (buffer, 1);
314 if (! zmacs_regions || zmacs_region_active_p || !NILP (force))
320 /* The saved object is a cons:
322 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
324 We used to have another cons for a VISIBLE-P element, which was t
325 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
326 was unused for a long time, so I removed it. --hniksic */
328 save_excursion_save (void)
332 /* #### Huh? --hniksic */
333 /*if (preparing_for_armageddon) return Qnil;*/
335 #ifdef ERROR_CHECK_BUFPOS
336 assert (XINT (Fpoint (Qnil)) ==
337 XINT (Fmarker_position (Fpoint_marker (Qt, Qnil))));
342 return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil),
343 noseeum_copy_marker (b->mark, Qnil));
347 save_excursion_restore (Lisp_Object info)
349 Lisp_Object buffer = Fmarker_buffer (XCAR (info));
351 /* If buffer being returned to is now deleted, avoid error --
352 otherwise could get error here while unwinding to top level and
353 crash. In that case, Fmarker_buffer returns nil now. */
356 struct buffer *buf = XBUFFER (buffer);
359 set_buffer_internal (buf);
360 Fgoto_char (XCAR (info), buffer);
361 Fset_marker (buf->mark, XCDR (info), buffer);
363 #if 0 /* We used to make the current buffer visible in the selected window
364 if that was true previously. That avoids some anomalies.
365 But it creates others, and it wasn't documented, and it is simpler
366 and cleaner never to alter the window/buffer connections. */
367 /* I'm certain some code somewhere depends on this behavior. --jwz */
368 /* Even if it did, it certainly doesn't matter anymore, because
369 this has been the behavior for countless XEmacs releases
372 && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
373 switch_to_buffer (Fcurrent_buffer (), Qnil);
379 /* Free all the junk we allocated, so that a `save-excursion' comes
380 for free in terms of GC junk. */
381 free_marker (XMARKER (XCAR (info)));
382 free_marker (XMARKER (XCDR (info)));
383 free_cons (XCONS (info));
387 DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
388 Save point, mark, and current buffer; execute BODY; restore those things.
389 Executes BODY just like `progn'.
390 The values of point, mark and the current buffer are restored
391 even in case of abnormal exit (throw or error).
395 /* This function can GC */
396 int speccount = specpdl_depth ();
398 record_unwind_protect (save_excursion_restore, save_excursion_save ());
400 return unbind_to (speccount, Fprogn (args));
404 save_current_buffer_restore (Lisp_Object buffer)
406 struct buffer *buf = XBUFFER (buffer);
407 /* Avoid signaling an error if the buffer is no longer alive. This
408 is for consistency with save-excursion. */
409 if (BUFFER_LIVE_P (buf))
410 set_buffer_internal (buf);
414 DEFUN ("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /*
415 Save the current buffer; execute BODY; restore the current buffer.
416 Executes BODY just like `progn'.
420 /* This function can GC */
421 int speccount = specpdl_depth ();
423 record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ());
425 return unbind_to (speccount, Fprogn (args));
428 DEFUN ("buffer-size", Fbuffer_size, 0, 1, 0, /*
429 Return the number of characters in BUFFER.
430 If BUFFER is nil, the current buffer is assumed.
434 struct buffer *b = decode_buffer (buffer, 1);
435 return make_int (BUF_SIZE (b));
438 DEFUN ("point-min", Fpoint_min, 0, 1, 0, /*
439 Return the minimum permissible value of point in BUFFER.
440 This is 1, unless narrowing (a buffer restriction)
441 is in effect, in which case it may be greater.
442 If BUFFER is nil, the current buffer is assumed.
446 struct buffer *b = decode_buffer (buffer, 1);
447 return make_int (BUF_BEGV (b));
450 DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
451 Return a marker to the minimum permissible value of point in BUFFER.
452 This is the beginning, unless narrowing (a buffer restriction)
453 is in effect, in which case it may be greater.
454 If BUFFER is nil, the current buffer is assumed.
458 struct buffer *b = decode_buffer (buffer, 1);
459 return buildmark (BUF_BEGV (b), make_buffer (b));
462 DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
463 Return the maximum permissible value of point in BUFFER.
464 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
465 is in effect, in which case it may be less.
466 If BUFFER is nil, the current buffer is assumed.
470 struct buffer *b = decode_buffer (buffer, 1);
471 return make_int (BUF_ZV (b));
474 DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
475 Return a marker to the maximum permissible value of point in BUFFER.
476 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
477 is in effect, in which case it may be less.
478 If BUFFER is nil, the current buffer is assumed.
482 struct buffer *b = decode_buffer (buffer, 1);
483 return buildmark (BUF_ZV (b), make_buffer (b));
486 DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /*
487 Return the character following point.
488 At the end of the buffer or accessible region, return 0.
489 If BUFFER is nil, the current buffer is assumed.
493 struct buffer *b = decode_buffer (buffer, 1);
494 if (BUF_PT (b) >= BUF_ZV (b))
495 return Qzero; /* #### Gag me! */
497 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b)));
500 DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /*
501 Return the character preceding point.
502 At the beginning of the buffer or accessible region, return 0.
503 If BUFFER is nil, the current buffer is assumed.
507 struct buffer *b = decode_buffer (buffer, 1);
508 if (BUF_PT (b) <= BUF_BEGV (b))
509 return Qzero; /* #### Gag me! */
511 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1));
514 DEFUN ("bobp", Fbobp, 0, 1, 0, /*
515 Return t if point is at the beginning of the buffer.
516 If the buffer is narrowed, this means the beginning of the narrowed part.
517 If BUFFER is nil, the current buffer is assumed.
521 struct buffer *b = decode_buffer (buffer, 1);
522 return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil;
525 DEFUN ("eobp", Feobp, 0, 1, 0, /*
526 Return t if point is at the end of the buffer.
527 If the buffer is narrowed, this means the end of the narrowed part.
528 If BUFFER is nil, the current buffer is assumed.
532 struct buffer *b = decode_buffer (buffer, 1);
533 return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil;
537 beginning_of_line_p (struct buffer *b, Bufpos pt)
539 return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n';
543 DEFUN ("bolp", Fbolp, 0, 1, 0, /*
544 Return t if point is at the beginning of a line.
545 If BUFFER is nil, the current buffer is assumed.
549 struct buffer *b = decode_buffer (buffer, 1);
550 return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
553 DEFUN ("eolp", Feolp, 0, 1, 0, /*
554 Return t if point is at the end of a line.
555 `End of a line' includes point being at the end of the buffer.
556 If BUFFER is nil, the current buffer is assumed.
560 struct buffer *b = decode_buffer (buffer, 1);
561 return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n')
565 DEFUN ("char-after", Fchar_after, 0, 2, 0, /*
566 Return the character at position POS in BUFFER.
567 POS is an integer or a marker.
568 If POS is out of range, the value is nil.
569 if POS is nil, the value of point is assumed.
570 If BUFFER is nil, the current buffer is assumed.
574 struct buffer *b = decode_buffer (buffer, 1);
575 Bufpos n = (NILP (pos) ? BUF_PT (b) :
576 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
578 if (n < 0 || n == BUF_ZV (b))
580 return make_char (BUF_FETCH_CHAR (b, n));
583 DEFUN ("char-before", Fchar_before, 0, 2, 0, /*
584 Return the character preceding position POS in BUFFER.
585 POS is an integer or a marker.
586 If POS is out of range, the value is nil.
587 if POS is nil, the value of point is assumed.
588 If BUFFER is nil, the current buffer is assumed.
592 struct buffer *b = decode_buffer (buffer, 1);
593 Bufpos n = (NILP (pos) ? BUF_PT (b) :
594 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
598 if (n < BUF_BEGV (b))
600 return make_char (BUF_FETCH_CHAR (b, n));
603 #if !defined(WINDOWSNT) && !defined(MSDOS)
604 #include <sys/stat.h>
610 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
611 Return the pathname to the directory to use for temporary files.
612 On MS Windows, this is obtained from the TEMP or TMP environment variables,
613 defaulting to / if they are both undefined.
614 On Unix it is obtained from TMPDIR, with /tmp as the default
619 #if defined(WIN32_NATIVE)
620 tmpdir = getenv ("TEMP");
622 tmpdir = getenv ("TMP");
625 #else /* WIN32_NATIVE */
626 tmpdir = getenv ("TMPDIR");
630 int myuid = getuid();
631 static char path[5 /* strlen ("/tmp/") */ + 1 + _POSIX_PATH_MAX];
633 strcpy (path, "/tmp/");
634 strncat (path, user_login_name (NULL), _POSIX_PATH_MAX);
635 if (lstat(path, &st) < 0 && errno == ENOENT)
637 mkdir(path, 0700); /* ignore retval -- checked next anyway. */
639 if (lstat(path, &st) == 0 && st.st_uid == myuid && S_ISDIR(st.st_mode))
645 strcpy(path, getenv("HOME")); strncat(path, "/tmp/", _POSIX_PATH_MAX);
646 if (stat(path, &st) < 0 && errno == ENOENT)
649 char warnpath[1+_POSIX_PATH_MAX];
650 mkdir(path, 0700); /* ignore retvals */
651 strcpy(warnpath, path);
652 strncat(warnpath, ".created_by_xemacs", _POSIX_PATH_MAX);
653 if ((fd = open(warnpath, O_WRONLY|O_CREAT, 0644)) > 0)
655 write(fd, "XEmacs created this directory because /tmp/<yourname> was unavailable -- \nPlease check !\n", 89);
659 if (stat(path, &st) == 0 && S_ISDIR(st.st_mode))
671 return build_ext_string (tmpdir, Qfile_name);
674 DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
675 Return the name under which the user logged in, as a string.
676 This is based on the effective uid, not the real uid.
677 Also, if the environment variable LOGNAME or USER is set,
678 that determines the value of this function.
679 If the optional argument UID is present, then environment variables are
680 ignored and this function returns the login name for that UID, or nil.
690 local_uid = XINT (uid);
691 returned_name = user_login_name (&local_uid);
695 returned_name = user_login_name (NULL);
697 /* #### - I believe this should return nil instead of "unknown" when pw==0
698 pw=0 is indicated by a null return from user_login_name
700 return returned_name ? build_string (returned_name) : Qnil;
703 /* This function may be called from other C routines when a
704 character string representation of the user_login_name is
705 needed but a Lisp Object is not. The UID is passed by
706 reference. If UID == NULL, then the USER name
707 for the user running XEmacs will be returned. This
708 corresponds to a nil argument to Fuser_login_name.
711 user_login_name (uid_t *uid)
713 /* uid == NULL to return name of this user */
716 struct passwd *pw = getpwuid (*uid);
717 return pw ? pw->pw_name : NULL;
721 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
722 old environment (I site observed behavior on sunos and linux), so the
723 environment variables should be disregarded in that case. --Stig */
724 char *user_name = getenv ("LOGNAME");
728 "USERNAME" /* it's USERNAME on NT */
737 struct passwd *pw = getpwuid (geteuid ());
739 /* Since the Cygwin environment may not have an /etc/passwd,
740 return "unknown" instead of the null if the username
741 cannot be determined.
743 return pw ? pw->pw_name : "unknown";
745 /* For all but Cygwin return NULL (nil) */
746 return pw ? pw->pw_name : NULL;
752 DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
753 Return the name of the user's real uid, as a string.
754 This ignores the environment variables LOGNAME and USER, so it differs from
755 `user-login-name' when running under `su'.
759 struct passwd *pw = getpwuid (getuid ());
760 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
762 Lisp_Object tem = build_string (pw ? pw->pw_name : "unknown");/* no gettext */
766 DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /*
767 Return the effective uid of Emacs, as an integer.
771 return make_int (geteuid ());
774 DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
775 Return the real uid of Emacs, as an integer.
779 return make_int (getuid ());
782 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
783 Return the full name of the user logged in, as a string.
784 If the optional argument USER is given, then the full name for that
785 user is returned, or nil. USER may be either a login name or a uid.
787 If USER is nil, and `user-full-name' contains a string, the
788 value of `user-full-name' is returned.
792 Lisp_Object user_name;
793 struct passwd *pw = NULL;
797 if (NILP (user) && STRINGP (Vuser_full_name))
798 return Vuser_full_name;
800 user_name = (STRINGP (user) ? user : Fuser_login_name (user));
801 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
803 const char *user_name_ext;
805 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
806 things get wedged if a SIGIO arrives during this time. */
807 TO_EXTERNAL_FORMAT (LISP_STRING, user_name,
808 C_STRING_ALLOCA, user_name_ext,
810 slow_down_interrupts ();
811 pw = (struct passwd *) getpwnam (user_name_ext);
812 speed_up_interrupts ();
815 /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
816 /* Ben sez: bad idea because it's likely to break something */
817 #ifndef AMPERSAND_FULL_NAME
818 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
821 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
824 tem = ((!NILP (user) && !pw)
826 : make_ext_string ((Extbyte *) p, (q ? q - p : strlen (p)),
829 #ifdef AMPERSAND_FULL_NAME
832 p = (char *) XSTRING_DATA (tem);
834 /* Substitute the login name for the &, upcasing the first character. */
837 char *r = (char *) alloca (strlen (p) + XSTRING_LENGTH (user_name) + 1);
838 memcpy (r, p, q - p);
840 strcat (r, (char *) XSTRING_DATA (user_name));
841 /* #### current_buffer dependency! */
842 r[q - p] = UPCASE (current_buffer, r[q - p]);
844 tem = build_string (r);
847 #endif /* AMPERSAND_FULL_NAME */
852 static Extbyte *cached_home_directory;
855 uncache_home_directory (void)
857 cached_home_directory = NULL; /* in some cases, this may cause the leaking
861 /* !!#### not Mule correct. */
863 /* Returns the home directory, in external format */
865 get_home_directory (void)
867 /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
868 about what format an external string is in. Could be Unicode, for all
869 we know, and then all the operations below are totally bogus.
870 Instead, convert all data to internal format *right* at the juncture
871 between XEmacs and the outside world, the very moment we first get
873 int output_home_warning = 0;
875 if (cached_home_directory == NULL)
877 if ((cached_home_directory = (Extbyte *) getenv("HOME")) == NULL)
879 #if defined(WIN32_NATIVE)
880 char *homedrive, *homepath;
882 if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
883 (homepath = getenv("HOMEPATH")) != NULL)
885 cached_home_directory =
886 (Extbyte *) xmalloc (strlen (homedrive) +
887 strlen (homepath) + 1);
888 sprintf((char *) cached_home_directory, "%s%s",
894 # if 0 /* changed by ben. This behavior absolutely stinks, and the
895 possibility being addressed here occurs quite commonly.
896 Using the current directory makes absolutely no sense. */
898 * Use the current directory.
899 * This preserves the existing XEmacs behavior, but is different
902 if (initial_directory[0] != '\0')
904 cached_home_directory = (Extbyte*) initial_directory;
908 /* This will probably give the wrong value */
909 cached_home_directory = (Extbyte*) getcwd (NULL, 0);
913 * This is NT Emacs behavior
915 cached_home_directory = (Extbyte *) "C:\\";
916 output_home_warning = 1;
919 #else /* !WIN32_NATIVE */
922 * Using "/" isn't quite right, but what should we do?
923 * We probably should try to extract pw_dir from /etc/passwd,
924 * before falling back to this.
926 cached_home_directory = (Extbyte *) "/";
927 output_home_warning = 1;
928 #endif /* !WIN32_NATIVE */
930 if (initialized && output_home_warning)
932 warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
933 " XEmacs was unable to determine a good value for the user's $HOME\n"
934 " directory, and will be using the value:\n"
936 " This is probably incorrect.",
937 cached_home_directory
941 return cached_home_directory;
944 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
945 Return the user's home directory, as a string.
949 Extbyte *path = get_home_directory ();
951 return path == NULL ? Qnil :
952 Fexpand_file_name (Fsubstitute_in_file_name
953 (build_ext_string ((char *) path, Qfile_name)),
957 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
958 Return the name of the machine you are running on, as a string.
962 return Fcopy_sequence (Vsystem_name);
965 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
966 Return the process ID of Emacs, as an integer.
970 return make_int (getpid ());
973 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
974 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
975 The time is returned as a list of three integers. The first has the
976 most significant 16 bits of the seconds, while the second has the
977 least significant 16 bits. The third integer gives the microsecond
980 The microsecond count is zero on systems that do not provide
981 resolution finer than a second.
988 return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
989 make_int ((EMACS_SECS (t) >> 0) & 0xffff),
990 make_int (EMACS_USECS (t)));
993 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
994 Return the amount of time used by this XEmacs process so far.
995 The return value is a list of three floating-point numbers, expressing
996 the user, system, and real times used by the process. The user time
997 measures the time actually spent by the CPU executing the code in this
998 process. The system time measures time spent by the CPU executing kernel
999 code on behalf of this process (e.g. I/O requests made by the process).
1001 Note that the user and system times measure processor time, as opposed
1002 to real time, and only accrue when the processor is actually doing
1003 something: Time spent in an idle wait (waiting for user events to come
1004 in or for I/O on a disk drive or other device to complete) does not
1005 count. Thus, the user and system times will often be considerably
1006 less than the real time.
1008 Some systems do not allow the user and system times to be distinguished.
1009 In this case, the user time will be the total processor time used by
1010 the process, and the system time will be 0.
1012 Some systems do not allow the real and processor times to be distinguished.
1013 In this case, the user and real times will be the same and the system
1018 double user, sys, real;
1020 get_process_times (&user, &sys, &real);
1021 return list3 (make_float (user), make_float (sys), make_float (real));
1025 int lisp_to_time (Lisp_Object specified_time, time_t *result);
1027 lisp_to_time (Lisp_Object specified_time, time_t *result)
1029 Lisp_Object high, low;
1031 if (NILP (specified_time))
1032 return time (result) != -1;
1034 CHECK_CONS (specified_time);
1035 high = XCAR (specified_time);
1036 low = XCDR (specified_time);
1041 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
1042 return *result >> 16 == XINT (high);
1045 Lisp_Object time_to_lisp (time_t the_time);
1047 time_to_lisp (time_t the_time)
1049 unsigned int item = (unsigned int) the_time;
1050 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
1053 size_t emacs_strftime (char *string, size_t max, const char *format,
1054 const struct tm *tm);
1055 static long difftm (const struct tm *a, const struct tm *b);
1058 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
1059 Use FORMAT-STRING to format the time TIME.
1060 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1061 `current-time' and `file-attributes'. If TIME is not specified it
1062 defaults to the current time.
1063 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1064 %a is replaced by the abbreviated name of the day of week.
1065 %A is replaced by the full name of the day of week.
1066 %b is replaced by the abbreviated name of the month.
1067 %B is replaced by the full name of the month.
1068 %c is a synonym for "%x %X".
1069 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1070 %d is replaced by the day of month, zero-padded.
1071 %D is a synonym for "%m/%d/%y".
1072 %e is replaced by the day of month, blank-padded.
1073 %h is a synonym for "%b".
1074 %H is replaced by the hour (00-23).
1075 %I is replaced by the hour (00-12).
1076 %j is replaced by the day of the year (001-366).
1077 %k is replaced by the hour (0-23), blank padded.
1078 %l is replaced by the hour (1-12), blank padded.
1079 %m is replaced by the month (01-12).
1080 %M is replaced by the minute (00-59).
1081 %n is a synonym for "\\n".
1082 %p is replaced by AM or PM, as appropriate.
1083 %r is a synonym for "%I:%M:%S %p".
1084 %R is a synonym for "%H:%M".
1085 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1086 nonstandard extension)
1087 %S is replaced by the second (00-60).
1088 %t is a synonym for "\\t".
1089 %T is a synonym for "%H:%M:%S".
1090 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1091 %w is replaced by the day of week (0-6), Sunday is day 0.
1092 %W is replaced by the week of the year (00-53), first day of week is Monday.
1093 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1094 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1095 %y is replaced by the year without century (00-99).
1096 %Y is replaced by the year with century.
1097 %Z is replaced by the time zone abbreviation.
1099 The number of options reflects the `strftime' function.
1101 BUG: If the charset used by the current locale is not ISO 8859-1, the
1102 characters appearing in the day and month names may be incorrect.
1104 (format_string, time_))
1109 CHECK_STRING (format_string);
1111 if (! lisp_to_time (time_, &value))
1112 error ("Invalid time specification");
1114 /* This is probably enough. */
1115 size = XSTRING_LENGTH (format_string) * 6 + 50;
1119 char *buf = (char *) alloca (size);
1121 if (emacs_strftime (buf, size,
1122 (const char *) XSTRING_DATA (format_string),
1125 return build_ext_string (buf, Qbinary);
1126 /* If buffer was too small, make it bigger. */
1131 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
1132 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1133 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1134 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1135 to use the current time. The list has the following nine members:
1136 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1137 only some operating systems support. MINUTE is an integer between 0 and 59.
1138 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
1139 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
1140 four-digit year. DOW is the day of week, an integer between 0 and 6, where
1141 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
1142 ZONE is an integer indicating the number of seconds east of Greenwich.
1143 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1149 struct tm *decoded_time;
1150 Lisp_Object list_args[9];
1152 if (! lisp_to_time (specified_time, &time_spec))
1153 error ("Invalid time specification");
1155 decoded_time = localtime (&time_spec);
1156 list_args[0] = make_int (decoded_time->tm_sec);
1157 list_args[1] = make_int (decoded_time->tm_min);
1158 list_args[2] = make_int (decoded_time->tm_hour);
1159 list_args[3] = make_int (decoded_time->tm_mday);
1160 list_args[4] = make_int (decoded_time->tm_mon + 1);
1161 list_args[5] = make_int (decoded_time->tm_year + 1900);
1162 list_args[6] = make_int (decoded_time->tm_wday);
1163 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
1165 /* Make a copy, in case gmtime modifies the struct. */
1166 save_tm = *decoded_time;
1167 decoded_time = gmtime (&time_spec);
1168 if (decoded_time == 0)
1169 list_args[8] = Qnil;
1171 list_args[8] = make_int (difftm (&save_tm, decoded_time));
1172 return Flist (9, list_args);
1175 static void set_time_zone_rule (char *tzstring);
1177 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
1178 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1179 This is the reverse operation of `decode-time', which see.
1180 ZONE defaults to the current time zone rule. This can
1181 be a string (as from `set-time-zone-rule'), or it can be a list
1182 \(as from `current-time-zone') or an integer (as from `decode-time')
1183 applied without consideration for daylight savings time.
1185 You can pass more than 7 arguments; then the first six arguments
1186 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1187 The intervening arguments are ignored.
1188 This feature lets (apply 'encode-time (decode-time ...)) work.
1190 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1191 for example, a DAY of 0 means the day preceding the given month.
1192 Year numbers less than 100 are treated just like other year numbers.
1193 If you want them to stand for years in this century, you must do that yourself.
1195 (int nargs, Lisp_Object *args))
1199 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1201 CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */
1202 CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */
1203 CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */
1204 CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */
1205 CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */
1206 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
1213 the_time = mktime (&tm);
1218 char **oldenv = environ, **newenv;
1221 tzstring = (char *) XSTRING_DATA (zone);
1222 else if (INTP (zone))
1224 int abszone = abs (XINT (zone));
1225 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
1226 abszone / (60*60), (abszone/60) % 60, abszone % 60);
1230 error ("Invalid time zone specification");
1232 /* Set TZ before calling mktime; merely adjusting mktime's returned
1233 value doesn't suffice, since that would mishandle leap seconds. */
1234 set_time_zone_rule (tzstring);
1236 the_time = mktime (&tm);
1238 /* Restore TZ to previous value. */
1242 #ifdef LOCALTIME_CACHE
1247 if (the_time == (time_t) -1)
1248 error ("Specified time is not representable");
1250 return wasteful_word_to_lisp (the_time);
1253 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1254 Return the current time, as a human-readable string.
1255 Programs can use this function to decode a time,
1256 since the number of columns in each field is fixed.
1257 The format is `Sun Sep 16 01:03:52 1973'.
1258 If an argument is given, it specifies a time to format
1259 instead of the current time. The argument should have the form:
1262 (HIGH LOW . IGNORED).
1263 Thus, you can use times obtained from `current-time'
1264 and from `file-attributes'.
1272 if (! lisp_to_time (specified_time, &value))
1274 the_ctime = ctime (&value);
1276 /* ctime is documented as always returning a "\n\0"-terminated
1277 26-byte American time string, but let's be careful anyways. */
1278 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++)
1281 return make_ext_string ((Extbyte *) the_ctime, len, Qbinary);
1284 #define TM_YEAR_ORIGIN 1900
1286 /* Yield A - B, measured in seconds. */
1288 difftm (const struct tm *a, const struct tm *b)
1290 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1291 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1292 /* Some compilers can't handle this as a single return statement. */
1294 /* difference in day of year */
1295 a->tm_yday - b->tm_yday
1296 /* + intervening leap days */
1297 + ((ay >> 2) - (by >> 2))
1299 + ((ay/100 >> 2) - (by/100 >> 2))
1300 /* + difference in years * 365 */
1301 + (long)(ay-by) * 365
1303 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
1304 + (a->tm_min - b->tm_min))
1305 + (a->tm_sec - b->tm_sec));
1308 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1309 Return the offset and name for the local time zone.
1310 This returns a list of the form (OFFSET NAME).
1311 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1312 A negative value means west of Greenwich.
1313 NAME is a string giving the name of the time zone.
1314 If an argument is given, it specifies when the time zone offset is determined
1315 instead of using the current time. The argument should have the form:
1318 (HIGH LOW . IGNORED).
1319 Thus, you can use times obtained from `current-time'
1320 and from `file-attributes'.
1322 Some operating systems cannot provide all this information to Emacs;
1323 in this case, `current-time-zone' returns a list containing nil for
1324 the data it can't find.
1329 struct tm *t = NULL;
1331 if (lisp_to_time (specified_time, &value)
1332 && (t = gmtime (&value)) != 0)
1334 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */
1338 t = localtime (&value);
1339 offset = difftm (t, &gmt);
1343 s = (char *)t->tm_zone;
1344 #else /* not HAVE_TM_ZONE */
1346 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1347 s = tzname[t->tm_isdst];
1349 #endif /* not HAVE_TM_ZONE */
1352 /* No local time zone name is available; use "+-NNNN" instead. */
1353 int am = (offset < 0 ? -offset : offset) / 60;
1354 sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
1357 return list2 (make_int (offset), build_string (s));
1360 return list2 (Qnil, Qnil);
1363 #ifdef LOCALTIME_CACHE
1365 /* These two values are known to load tz files in buggy implementations,
1366 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1367 Their values shouldn't matter in non-buggy implementations.
1368 We don't use string literals for these strings,
1369 since if a string in the environment is in readonly
1370 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1371 See Sun bugs 1113095 and 1114114, ``Timezone routines
1372 improperly modify environment''. */
1374 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1375 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1379 /* Set the local time zone rule to TZSTRING.
1380 This allocates memory into `environ', which it is the caller's
1381 responsibility to free. */
1383 set_time_zone_rule (char *tzstring)
1386 char **from, **to, **newenv;
1388 for (from = environ; *from; from++)
1390 envptrs = from - environ + 2;
1391 newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
1392 + (tzstring ? strlen (tzstring) + 4 : 0));
1395 char *t = (char *) (to + envptrs);
1397 strcat (t, tzstring);
1401 for (from = environ; *from; from++)
1402 if (strncmp (*from, "TZ=", 3) != 0)
1408 #ifdef LOCALTIME_CACHE
1410 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1411 "US/Pacific" that loads a tz file, then changes to a value like
1412 "XXX0" that does not load a tz file, and then changes back to
1413 its original value, the last change is (incorrectly) ignored.
1414 Also, if TZ changes twice in succession to values that do
1415 not load a tz file, tzset can dump core (see Sun bug#1225179).
1416 The following code works around these bugs. */
1420 /* Temporarily set TZ to a value that loads a tz file
1421 and that differs from tzstring. */
1423 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
1424 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
1430 /* The implied tzstring is unknown, so temporarily set TZ to
1431 two different values that each load a tz file. */
1432 *to = set_time_zone_rule_tz1;
1435 *to = set_time_zone_rule_tz2;
1440 /* Now TZ has the desired value, and tzset can be invoked safely. */
1447 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1448 Set the local time zone using TZ, a string specifying a time zone rule.
1449 If TZ is nil, use implementation-defined default time zone information.
1460 tzstring = (char *) XSTRING_DATA (tz);
1463 set_time_zone_rule (tzstring);
1466 environbuf = environ;
1473 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
1475 /* This function can GC */
1476 struct gcpro gcpro1;
1479 if (CHAR_OR_CHAR_INTP (arg))
1481 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
1483 else if (STRINGP (arg))
1485 buffer_insert_lisp_string (buf, arg);
1489 arg = wrong_type_argument (Qchar_or_string_p, arg);
1492 zmacs_region_stays = 0;
1497 /* Callers passing one argument to Finsert need not gcpro the
1498 argument "array", since the only element of the array will
1499 not be used after calling insert_emacs_char or insert_lisp_string,
1500 so we don't care if it gets trashed. */
1502 DEFUN ("insert", Finsert, 0, MANY, 0, /*
1503 Insert the arguments, either strings or characters, at point.
1504 Point moves forward so that it ends up after the inserted text.
1505 Any other markers at the point of insertion remain before the text.
1506 If a string has non-null string-extent-data, new extents will be created.
1508 (int nargs, Lisp_Object *args))
1510 /* This function can GC */
1511 REGISTER int argnum;
1513 for (argnum = 0; argnum < nargs; argnum++)
1515 buffer_insert1 (current_buffer, args[argnum]);
1521 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1522 Insert strings or characters at point, relocating markers after the text.
1523 Point moves forward so that it ends up after the inserted text.
1524 Any other markers at the point of insertion also end up after the text.
1526 (int nargs, Lisp_Object *args))
1528 /* This function can GC */
1529 REGISTER int argnum;
1530 REGISTER Lisp_Object tem;
1532 for (argnum = 0; argnum < nargs; argnum++)
1536 if (CHAR_OR_CHAR_INTP (tem))
1538 buffer_insert_emacs_char_1 (current_buffer, -1,
1539 XCHAR_OR_CHAR_INT (tem),
1540 INSDEL_BEFORE_MARKERS);
1542 else if (STRINGP (tem))
1544 buffer_insert_lisp_string_1 (current_buffer, -1, tem,
1545 INSDEL_BEFORE_MARKERS);
1549 tem = wrong_type_argument (Qchar_or_string_p, tem);
1553 zmacs_region_stays = 0;
1557 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
1558 Insert STRING into BUFFER at BUFFER's point.
1559 Point moves forward so that it ends up after the inserted text.
1560 Any other markers at the point of insertion remain before the text.
1561 If a string has non-null string-extent-data, new extents will be created.
1562 BUFFER defaults to the current buffer.
1566 struct buffer *b = decode_buffer (buffer, 1);
1567 CHECK_STRING (string);
1568 buffer_insert_lisp_string (b, string);
1569 zmacs_region_stays = 0;
1573 /* Third argument in FSF is INHERIT:
1575 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1576 from adjoining text, if those properties are sticky."
1578 Jamie thinks this is bogus. */
1581 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
1582 Insert COUNT (second arg) copies of CHR (first arg).
1583 Point and all markers are affected as in the function `insert'.
1584 COUNT defaults to 1 if omitted.
1585 The optional third arg IGNORED is INHERIT under FSF Emacs.
1586 This is highly bogus, however, and XEmacs always behaves as if
1587 `t' were passed to INHERIT.
1588 The optional fourth arg BUFFER specifies the buffer to insert the
1589 text into. If BUFFER is nil, the current buffer is assumed.
1591 (chr, count, ignored, buffer))
1593 /* This function can GC */
1594 REGISTER Bufbyte *string;
1597 REGISTER Bytecount n;
1598 REGISTER Bytecount charlen;
1599 Bufbyte str[MAX_EMCHAR_LEN];
1600 struct buffer *b = decode_buffer (buffer, 1);
1603 CHECK_CHAR_COERCE_INT (chr);
1612 charlen = set_charptr_emchar (str, XCHAR (chr));
1616 slen = min (n, 768);
1617 string = alloca_array (Bufbyte, slen);
1618 /* Write as many copies of the character into the temp string as will fit. */
1619 for (i = 0; i + charlen <= slen; i += charlen)
1620 for (j = 0; j < charlen; j++)
1621 string[i + j] = str[j];
1625 buffer_insert_raw_string (b, string, slen);
1629 #if 0 /* FSFmacs bogosity */
1631 if (!NILP (inherit))
1632 insert_and_inherit (string, n);
1637 buffer_insert_raw_string (b, string, n);
1640 zmacs_region_stays = 0;
1645 /* Making strings from buffer contents. */
1647 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1648 Return the contents of part of BUFFER as a string.
1649 The two arguments START and END are character positions;
1650 they can be in either order. If omitted, they default to the beginning
1651 and end of BUFFER, respectively.
1652 If there are duplicable extents in the region, the string remembers
1653 them in its extent data.
1654 If BUFFER is nil, the current buffer is assumed.
1656 (start, end, buffer))
1658 /* This function can GC */
1660 struct buffer *b = decode_buffer (buffer, 1);
1662 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1663 return make_string_from_buffer (b, begv, zv - begv);
1666 /* It might make more sense to name this
1667 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1668 and what the function does is probably good enough for what the
1669 user-code will typically want to use it for. */
1670 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1671 Return the text from BEG to END, as a string, without copying the extents.
1673 (start, end, buffer))
1675 /* This function can GC */
1677 struct buffer *b = decode_buffer (buffer, 1);
1679 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1680 return make_string_from_buffer_no_extents (b, begv, zv - begv);
1683 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1684 Insert before point a substring of the contents of buffer BUFFER.
1685 BUFFER may be a buffer or a buffer name.
1686 Arguments START and END are character numbers specifying the substring.
1687 They default to the beginning and the end of BUFFER.
1689 (buffer, start, end))
1691 /* This function can GC */
1695 bp = XBUFFER (get_buffer (buffer, 1));
1696 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
1699 buffer_insert_from_buffer (current_buffer, bp, b, e - b);
1704 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1705 Compare two substrings of two buffers; return result as number.
1706 the value is -N if first string is less after N-1 chars,
1707 +N if first string is greater after N-1 chars, or 0 if strings match.
1708 Each substring is represented as three arguments: BUFFER, START and END.
1709 That makes six args in all, three for each substring.
1711 The value of `case-fold-search' in the current buffer
1712 determines whether case is significant or ignored.
1714 (buffer1, start1, end1, buffer2, start2, end2))
1716 Bufpos begp1, endp1, begp2, endp2;
1717 REGISTER Charcount len1, len2, length, i;
1718 struct buffer *bp1, *bp2;
1719 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
1720 current_buffer->case_canon_table : Qnil);
1722 /* Find the first buffer and its substring. */
1724 bp1 = decode_buffer (buffer1, 1);
1725 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1727 /* Likewise for second substring. */
1729 bp2 = decode_buffer (buffer2, 1);
1730 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1732 len1 = endp1 - begp1;
1733 len2 = endp2 - begp2;
1738 for (i = 0; i < length; i++)
1740 Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
1741 Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
1744 c1 = TRT_TABLE_OF (trt, c1);
1745 c2 = TRT_TABLE_OF (trt, c2);
1748 return make_int (- 1 - i);
1750 return make_int (i + 1);
1753 /* The strings match as far as they go.
1754 If one is shorter, that one is less. */
1756 return make_int (length + 1);
1757 else if (length < len2)
1758 return make_int (- length - 1);
1760 /* Same length too => they are equal. */
1766 subst_char_in_region_unwind (Lisp_Object arg)
1768 XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
1773 subst_char_in_region_unwind_1 (Lisp_Object arg)
1775 XBUFFER (XCAR (arg))->filename = XCDR (arg);
1779 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1780 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1781 If optional arg NOUNDO is non-nil, don't record this change for undo
1782 and don't mark the buffer as really changed.
1784 (start, end, fromchar, tochar, noundo))
1786 /* This function can GC */
1790 struct buffer *buf = current_buffer;
1791 int count = specpdl_depth ();
1793 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1794 CHECK_CHAR_COERCE_INT (fromchar);
1795 CHECK_CHAR_COERCE_INT (tochar);
1797 fromc = XCHAR (fromchar);
1798 toc = XCHAR (tochar);
1800 /* If we don't want undo, turn off putting stuff on the list.
1801 That's faster than getting rid of things,
1802 and it prevents even the entry for a first change.
1803 Also inhibit locking the file. */
1806 record_unwind_protect (subst_char_in_region_unwind,
1807 Fcons (Fcurrent_buffer (), buf->undo_list));
1808 buf->undo_list = Qt;
1809 /* Don't do file-locking. */
1810 record_unwind_protect (subst_char_in_region_unwind_1,
1811 Fcons (Fcurrent_buffer (), buf->filename));
1812 buf->filename = Qnil;
1815 mc_count = begin_multiple_change (buf, pos, stop);
1818 if (BUF_FETCH_CHAR (buf, pos) == fromc)
1820 /* There used to be some code here that set the buffer to
1821 unmodified if NOUNDO was specified and there was only
1822 one change to the buffer since it was last saved.
1823 This is a crock of shit, so I'm not duplicating this
1824 behavior. I think this was left over from when
1825 prepare_to_modify_buffer() actually bumped MODIFF,
1826 so that code was supposed to undo this change. --ben */
1827 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
1829 /* If noundo is not nil then we don't mark the buffer as
1830 modified. In reality that needs to happen externally
1831 only. Internally redisplay needs to know that the actual
1832 contents it should be displaying have changed. */
1834 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
1838 end_multiple_change (buf, mc_count);
1840 unbind_to (count, Qnil);
1844 /* #### Shouldn't this also accept a BUFFER argument, in the good old
1845 XEmacs tradition? */
1846 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
1847 Translate characters from START to END according to TABLE.
1849 If TABLE is a string, the Nth character in it is the mapping for the
1850 character with code N.
1852 If TABLE is a vector, its Nth element is the mapping for character
1853 with code N. The values of elements may be characters, strings, or
1854 nil (nil meaning don't replace.)
1856 If TABLE is a char-table, its elements describe the mapping between
1857 characters and their replacements. The char-table should be of type
1858 `char' or `generic'.
1860 Returns the number of substitutions performed.
1862 (start, end, table))
1864 /* This function can GC */
1865 Bufpos pos, stop; /* Limits of the region. */
1866 int cnt = 0; /* Number of changes made. */
1868 struct buffer *buf = current_buffer;
1871 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1872 mc_count = begin_multiple_change (buf, pos, stop);
1873 if (STRINGP (table))
1875 Lisp_String *stable = XSTRING (table);
1876 Charcount size = string_char_length (stable);
1878 /* Under Mule, string_char(n) is O(n), so for large tables or
1879 large regions it makes sense to create an array of Emchars. */
1880 if (size * (stop - pos) > 65536)
1882 Emchar *etable = alloca_array (Emchar, size);
1883 convert_bufbyte_string_into_emchar_string
1884 (string_data (stable), string_length (stable), etable);
1885 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1889 Emchar nc = etable[oc];
1892 buffer_replace_char (buf, pos, nc, 0, 0);
1901 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1905 Emchar nc = string_char (stable, oc);
1908 buffer_replace_char (buf, pos, nc, 0, 0);
1915 else if (VECTORP (table))
1917 Charcount size = XVECTOR_LENGTH (table);
1918 Lisp_Object *vtable = XVECTOR_DATA (table);
1920 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1924 Lisp_Object replacement = vtable[oc];
1926 if (CHAR_OR_CHAR_INTP (replacement))
1928 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1931 buffer_replace_char (buf, pos, nc, 0, 0);
1935 else if (STRINGP (replacement))
1937 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1938 buffer_delete_range (buf, pos, pos + 1, 0);
1939 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1940 pos += incr, stop += incr;
1943 else if (!NILP (replacement))
1945 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1951 else if (CHAR_TABLEP (table)
1952 && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
1953 || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
1955 Lisp_Char_Table *ctable = XCHAR_TABLE (table);
1957 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1959 Lisp_Object replacement = get_char_table (oc, ctable);
1961 if (CHAR_OR_CHAR_INTP (replacement))
1963 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1966 buffer_replace_char (buf, pos, nc, 0, 0);
1970 else if (STRINGP (replacement))
1972 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1973 buffer_delete_range (buf, pos, pos + 1, 0);
1974 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1975 pos += incr, stop += incr;
1978 else if (!NILP (replacement))
1980 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1986 dead_wrong_type_argument (Qstringp, table);
1987 end_multiple_change (buf, mc_count);
1989 return make_int (cnt);
1992 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
1993 Delete the text between point and mark.
1994 When called from a program, expects two arguments,
1995 positions (integers or markers) specifying the stretch to be deleted.
1996 If BUFFER is nil, the current buffer is assumed.
2000 /* This function can GC */
2002 struct buffer *buf = decode_buffer (buffer, 1);
2004 get_buffer_range_char (buf, b, e, &start, &end, 0);
2005 buffer_delete_range (buf, start, end, 0);
2006 zmacs_region_stays = 0;
2011 widen_buffer (struct buffer *b, int no_clip)
2013 if (BUF_BEGV (b) != BUF_BEG (b))
2016 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b));
2018 if (BUF_ZV (b) != BUF_Z (b))
2021 SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b));
2027 /* Changing the buffer bounds invalidates any recorded current
2029 invalidate_current_column ();
2030 narrow_line_number_cache (b);
2034 DEFUN ("widen", Fwiden, 0, 1, "", /*
2035 Remove restrictions (narrowing) from BUFFER.
2036 This allows the buffer's full text to be seen and edited.
2037 If BUFFER is nil, the current buffer is assumed.
2041 struct buffer *b = decode_buffer (buffer, 1);
2042 widen_buffer (b, 0);
2043 zmacs_region_stays = 0;
2047 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2048 Restrict editing in BUFFER to the current region.
2049 The rest of the text becomes temporarily invisible and untouchable
2050 but is not deleted; if you save the buffer in a file, the invisible
2051 text is included in the file. \\[widen] makes all visible again.
2052 If BUFFER is nil, the current buffer is assumed.
2053 See also `save-restriction'.
2055 When calling from a program, pass two arguments; positions (integers
2056 or markers) bounding the text that should remain visible.
2061 struct buffer *buf = decode_buffer (buffer, 1);
2062 Bytind bi_start, bi_end;
2064 get_buffer_range_char (buf, b, e, &start, &end, GB_ALLOW_PAST_ACCESSIBLE);
2065 bi_start = bufpos_to_bytind (buf, start);
2066 bi_end = bufpos_to_bytind (buf, end);
2068 SET_BOTH_BUF_BEGV (buf, start, bi_start);
2069 SET_BOTH_BUF_ZV (buf, end, bi_end);
2070 if (BUF_PT (buf) < start)
2071 BUF_SET_PT (buf, start);
2072 if (BUF_PT (buf) > end)
2073 BUF_SET_PT (buf, end);
2075 /* Changing the buffer bounds invalidates any recorded current column. */
2076 invalidate_current_column ();
2077 narrow_line_number_cache (buf);
2078 zmacs_region_stays = 0;
2083 save_restriction_save (void)
2085 Lisp_Object bottom, top;
2086 /* Note: I tried using markers here, but it does not win
2087 because insertion at the end of the saved region
2088 does not advance mh and is considered "outside" the saved region. */
2089 bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer));
2090 top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer));
2092 return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top));
2096 save_restriction_restore (Lisp_Object data)
2099 Charcount newhead, newtail;
2101 int local_clip_changed = 0;
2103 buf = XBUFFER (XCAR (data));
2104 if (!BUFFER_LIVE_P (buf))
2106 /* someone could have killed the buffer in the meantime ... */
2107 free_cons (XCONS (XCDR (data)));
2108 free_cons (XCONS (data));
2112 newhead = XINT (XCAR (tem));
2113 newtail = XINT (XCDR (tem));
2115 free_cons (XCONS (XCDR (data)));
2116 free_cons (XCONS (data));
2118 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
2126 Bytind bi_start, bi_end;
2128 start = BUF_BEG (buf) + newhead;
2129 end = BUF_Z (buf) - newtail;
2131 bi_start = bufpos_to_bytind (buf, start);
2132 bi_end = bufpos_to_bytind (buf, end);
2134 if (BUF_BEGV (buf) != start)
2136 local_clip_changed = 1;
2137 SET_BOTH_BUF_BEGV (buf, start, bi_start);
2138 narrow_line_number_cache (buf);
2140 if (BUF_ZV (buf) != end)
2142 local_clip_changed = 1;
2143 SET_BOTH_BUF_ZV (buf, end, bi_end);
2146 if (local_clip_changed)
2149 /* If point is outside the new visible range, move it inside. */
2151 bufpos_clip_to_bounds (BUF_BEGV (buf),
2158 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2159 Execute BODY, saving and restoring current buffer's restrictions.
2160 The buffer's restrictions make parts of the beginning and end invisible.
2161 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2162 This special form, `save-restriction', saves the current buffer's restrictions
2163 when it is entered, and restores them when it is exited.
2164 So any `narrow-to-region' within BODY lasts only until the end of the form.
2165 The old restrictions settings are restored
2166 even in case of abnormal exit (throw or error).
2168 The value returned is the value of the last form in BODY.
2170 `save-restriction' can get confused if, within the BODY, you widen
2171 and then make changes outside the area within the saved restrictions.
2173 Note: if you are using both `save-excursion' and `save-restriction',
2174 use `save-excursion' outermost:
2175 (save-excursion (save-restriction ...))
2179 /* This function can GC */
2180 int speccount = specpdl_depth ();
2182 record_unwind_protect (save_restriction_restore, save_restriction_save ());
2184 return unbind_to (speccount, Fprogn (body));
2188 DEFUN ("format", Fformat, 1, MANY, 0, /*
2189 Format a string out of a control-string and arguments.
2190 The first argument is a control string.
2191 The other arguments are substituted into it to make the result, a string.
2192 It may contain %-sequences meaning to substitute the next argument.
2193 %s means print all objects as-is, using `princ'.
2194 %S means print all objects as s-expressions, using `prin1'.
2195 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
2197 %c means print as a single character.
2198 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2199 %e or %E means print as a floating-point number in scientific notation
2201 %g or %G means print as a floating-point number in "pretty format";
2202 depending on the number, either %f or %e/%E format will be used, and
2203 trailing zeroes are removed from the fractional part.
2204 The argument used for all but %s and %S must be a number. It will be
2205 converted to an integer or a floating-point number as necessary.
2207 %$ means reposition to read a specific numbered argument; for example,
2208 %3$s would apply the `%s' to the third argument after the control string,
2209 and the next format directive would use the fourth argument, the
2210 following one the fifth argument, etc. (There must be a positive integer
2211 between the % and the $).
2212 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2213 specified between the optional repositioning spec and the conversion
2214 character; see below.
2215 An optional minimum field width may be specified after any flag characters
2216 and before the conversion character; it specifies the minimum number of
2217 characters that the converted argument will take up. Padding will be
2218 added on the left (or on the right, if the `-' flag is specified), as
2219 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2221 If the field width is specified as `*', the field width is assumed to have
2222 been specified as an argument. Any repositioning specification that
2223 would normally specify the argument to be converted will now specify
2224 where to find this field width argument, not where to find the argument
2225 to be converted. If there is no repositioning specification, the normal
2226 next argument is used. The argument to be converted will be the next
2227 argument after the field width argument unless the precision is also
2228 specified as `*' (see below).
2230 An optional period character and precision may be specified after any
2231 minimum field width. It specifies the minimum number of digits to
2232 appear in %d, %i, %o, %x, and %X conversions (the number is padded
2233 on the left with zeroes as necessary); the number of digits printed
2234 after the decimal point for %f, %e, and %E conversions; the number
2235 of significant digits printed in %g and %G conversions; and the
2236 maximum number of non-padding characters printed in %s and %S
2237 conversions. The default precision for floating-point conversions
2239 If the precision is specified as `*', the precision is assumed to have been
2240 specified as an argument. The argument used will be the next argument
2241 after the field width argument, if any. If the field width was not
2242 specified as an argument, any repositioning specification that would
2243 normally specify the argument to be converted will now specify where to
2244 find the precision argument. If there is no repositioning specification,
2245 the normal next argument is used.
2247 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2248 plus sign, respectively.
2249 The `#' flag means print numbers in an alternate, more verbose format:
2250 octal numbers begin with zero; hex numbers begin with a 0x or 0X;
2251 a decimal point is printed in %f, %e, and %E conversions even if no
2252 numbers are printed after it; and trailing zeroes are not omitted in
2253 %g and %G conversions.
2255 Use %% to put a single % into the output.
2257 (int nargs, Lisp_Object *args))
2259 /* It should not be necessary to GCPRO ARGS, because
2260 the caller in the interpreter should take care of that. */
2262 CHECK_STRING (args[0]);
2263 return emacs_doprnt_string_lisp (0, args[0], 0, nargs - 1, args + 1);
2267 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
2268 Return t if two characters match, optionally ignoring case.
2269 Both arguments must be characters (i.e. NOT integers).
2270 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2271 If BUFFER is nil, the current buffer is assumed.
2276 struct buffer *b = decode_buffer (buffer, 1);
2278 CHECK_CHAR_COERCE_INT (c1);
2279 CHECK_CHAR_COERCE_INT (c2);
2283 return (!NILP (b->case_fold_search)
2284 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
2289 DEFUN ("char=", Fchar_Equal, 2, 2, 0, /*
2290 Return t if two characters match, case is significant.
2291 Both arguments must be characters (i.e. NOT integers).
2295 CHECK_CHAR_COERCE_INT (c1);
2296 CHECK_CHAR_COERCE_INT (c2);
2298 return EQ (c1, c2) ? Qt : Qnil;
2301 #if 0 /* Undebugged FSFmacs code */
2302 /* Transpose the markers in two regions of the current buffer, and
2303 adjust the ones between them if necessary (i.e.: if the regions
2306 Traverses the entire marker list of the buffer to do so, adding an
2307 appropriate amount to some, subtracting from some, and leaving the
2308 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2310 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2313 transpose_markers (Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2315 Charcount amt1, amt2, diff;
2317 struct buffer *buf = current_buffer;
2319 /* Update point as if it were a marker. */
2320 if (BUF_PT (buf) < start1)
2322 else if (BUF_PT (buf) < end1)
2323 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
2324 else if (BUF_PT (buf) < start2)
2325 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
2326 else if (BUF_PT (buf) < end2)
2327 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
2329 /* We used to adjust the endpoints here to account for the gap, but that
2330 isn't good enough. Even if we assume the caller has tried to move the
2331 gap out of our way, it might still be at start1 exactly, for example;
2332 and that places it `inside' the interval, for our purposes. The amount
2333 of adjustment is nontrivial if there's a `denormalized' marker whose
2334 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2335 the dirty work to Fmarker_position, below. */
2337 /* The difference between the region's lengths */
2338 diff = (end2 - start2) - (end1 - start1);
2340 /* For shifting each marker in a region by the length of the other
2341 * region plus the distance between the regions.
2343 amt1 = (end2 - start2) + (start2 - end1);
2344 amt2 = (end1 - start1) + (start2 - end1);
2346 for (marker = BUF_MARKERS (buf); !NILP (marker);
2347 marker = XMARKER (marker)->chain)
2349 Bufpos mpos = marker_position (marker);
2350 if (mpos >= start1 && mpos < end2)
2354 else if (mpos < start2)
2358 set_marker_position (marker, mpos);
2365 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2366 Transpose region START1 to END1 with START2 to END2.
2367 The regions may not be overlapping, because the size of the buffer is
2368 never changed in a transposition.
2370 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose
2371 any markers that happen to be located in the regions. (#### BUG: currently
2372 this function always acts as if LEAVE_MARKERS is non-nil.)
2374 Transposing beyond buffer boundaries is an error.
2376 (startr1, endr1, startr2, endr2, leave_markers))
2378 Bufpos start1, end1, start2, end2;
2379 Charcount len1, len2;
2380 Lisp_Object string1, string2;
2381 struct buffer *buf = current_buffer;
2383 get_buffer_range_char (buf, startr1, endr1, &start1, &end1, 0);
2384 get_buffer_range_char (buf, startr2, endr2, &start2, &end2, 0);
2386 len1 = end1 - start1;
2387 len2 = end2 - start2;
2390 error ("transposed regions not properly ordered");
2391 else if (start1 == end1 || start2 == end2)
2392 error ("transposed region may not be of length 0");
2394 string1 = make_string_from_buffer (buf, start1, len1);
2395 string2 = make_string_from_buffer (buf, start2, len2);
2396 buffer_delete_range (buf, start2, end2, 0);
2397 buffer_insert_lisp_string_1 (buf, start2, string1, 0);
2398 buffer_delete_range (buf, start1, end1, 0);
2399 buffer_insert_lisp_string_1 (buf, start1, string2, 0);
2401 /* In FSFmacs there is a whole bunch of really ugly code here
2402 to attempt to transpose the regions without using up any
2403 extra memory. Although the intent may be good, the result
2404 was highly bogus. */
2410 /************************************************************************/
2411 /* initialization */
2412 /************************************************************************/
2415 syms_of_editfns (void)
2417 defsymbol (&Qpoint, "point");
2418 defsymbol (&Qmark, "mark");
2419 defsymbol (&Qregion_beginning, "region-beginning");
2420 defsymbol (&Qregion_end, "region-end");
2421 defsymbol (&Qformat, "format");
2422 defsymbol (&Quser_files_and_directories, "user-files-and-directories");
2424 DEFSUBR (Fchar_equal);
2425 DEFSUBR (Fchar_Equal);
2426 DEFSUBR (Fgoto_char);
2427 DEFSUBR (Fstring_to_char);
2428 DEFSUBR (Fchar_to_string);
2429 DEFSUBR (Fbuffer_substring);
2430 DEFSUBR (Fbuffer_substring_no_properties);
2432 DEFSUBR (Fpoint_marker);
2433 DEFSUBR (Fmark_marker);
2435 DEFSUBR (Fregion_beginning);
2436 DEFSUBR (Fregion_end);
2437 DEFSUBR (Fsave_excursion);
2438 DEFSUBR (Fsave_current_buffer);
2440 DEFSUBR (Fbuffer_size);
2441 DEFSUBR (Fpoint_max);
2442 DEFSUBR (Fpoint_min);
2443 DEFSUBR (Fpoint_min_marker);
2444 DEFSUBR (Fpoint_max_marker);
2450 DEFSUBR (Ffollowing_char);
2451 DEFSUBR (Fpreceding_char);
2452 DEFSUBR (Fchar_after);
2453 DEFSUBR (Fchar_before);
2455 DEFSUBR (Finsert_string);
2456 DEFSUBR (Finsert_before_markers);
2457 DEFSUBR (Finsert_char);
2459 DEFSUBR (Ftemp_directory);
2460 DEFSUBR (Fuser_login_name);
2461 DEFSUBR (Fuser_real_login_name);
2462 DEFSUBR (Fuser_uid);
2463 DEFSUBR (Fuser_real_uid);
2464 DEFSUBR (Fuser_full_name);
2465 DEFSUBR (Fuser_home_directory);
2466 DEFSUBR (Femacs_pid);
2467 DEFSUBR (Fcurrent_time);
2468 DEFSUBR (Fcurrent_process_time);
2469 DEFSUBR (Fformat_time_string);
2470 DEFSUBR (Fdecode_time);
2471 DEFSUBR (Fencode_time);
2472 DEFSUBR (Fcurrent_time_string);
2473 DEFSUBR (Fcurrent_time_zone);
2474 DEFSUBR (Fset_time_zone_rule);
2475 DEFSUBR (Fsystem_name);
2478 DEFSUBR (Finsert_buffer_substring);
2479 DEFSUBR (Fcompare_buffer_substrings);
2480 DEFSUBR (Fsubst_char_in_region);
2481 DEFSUBR (Ftranslate_region);
2482 DEFSUBR (Fdelete_region);
2484 DEFSUBR (Fnarrow_to_region);
2485 DEFSUBR (Fsave_restriction);
2486 DEFSUBR (Ftranspose_regions);
2488 defsymbol (&Qzmacs_update_region, "zmacs-update-region");
2489 defsymbol (&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2490 defsymbol (&Qzmacs_region_buffer, "zmacs-region-buffer");
2494 vars_of_editfns (void)
2496 staticpro (&Vsystem_name);
2498 staticpro (&Vuser_name);
2499 staticpro (&Vuser_real_name);
2501 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
2502 *Whether LISPM-style active regions should be used.
2503 This means that commands which operate on the region (the area between the
2504 point and the mark) will only work while the region is in the ``active''
2505 state, which is indicated by highlighting. Executing most commands causes
2506 the region to not be in the active state, so (for example) \\[kill-region] will only
2507 work immediately after activating the region.
2511 - Commands which operate on the region only work if the region is active.
2512 - Only a very small set of commands cause the region to become active:
2513 Those commands whose semantics are to mark an area, like mark-defun.
2514 - The region is deactivated after each command that is executed, except that:
2515 - "Motion" commands do not change whether the region is active or not.
2517 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2518 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2519 between point and the recently-pushed mark to be highlighted. It will
2520 remain highlighted until some non-motion command is executed.
2522 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2523 region and execute a command that operates on it, you can reactivate the
2524 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2527 Generally, commands which push marks as a means of navigation (like
2528 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2529 region. But commands which push marks as a means of marking an area of
2530 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2531 do activate the region.
2533 The way the command loop actually works with regard to deactivating the
2534 region is as follows:
2536 - If the variable `zmacs-region-stays' has been set to t during the command
2537 just executed, the region is left alone (this is how the motion commands
2538 make the region stay around; see the `_' flag in the `interactive'
2539 specification). `zmacs-region-stays' is reset to nil before each command
2541 - If the function `zmacs-activate-region' has been called during the command
2542 just executed, the region is left alone. Very few functions should
2543 actually call this function.
2544 - Otherwise, if the region is active, the region is deactivated and
2545 the `zmacs-deactivate-region-hook' is called.
2547 /* Zmacs style active regions are now ON by default */
2550 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
2551 Do not alter this. It is for internal use only.
2553 zmacs_region_active_p = 0;
2555 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
2556 Whether the current command will deactivate the region.
2557 Commands which do not wish to affect whether the region is currently
2558 highlighted should set this to t. Normally, the region is turned off after
2559 executing each command that did not explicitly turn it on with the function
2560 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2561 See the variable `zmacs-regions'.
2563 The same effect can be achieved using the `_' interactive specification.
2565 `zmacs-region-stays' is reset to nil before each command is executed.
2567 zmacs_region_stays = 0;
2569 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2570 Do not use this -- it will be going away soon.
2571 Indicates if `goto-char' has just been run. This information is allegedly
2572 needed to get the desired behavior for atomic extents and unfortunately
2573 is not available by any other means.
2575 atomic_extent_goto_char_p = 0;
2576 #ifdef AMPERSAND_FULL_NAME
2577 Fprovide(intern("ampersand-full-name"));
2580 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
2581 *The name of the user.
2582 The function `user-full-name', which will return the value of this
2583 variable, when called without arguments.
2584 This is initialized to the value of the NAME environment variable.
2586 /* Initialized at run-time. */
2587 Vuser_full_name = Qnil;