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 */
41 #include "line-number.h"
46 #include "sysfile.h" /* for getcwd */
48 /* Some static data, and a function to initialize it for each run */
50 Lisp_Object Vsystem_name; /* #### - I don't see why this should be */
51 /* static, either... --Stig */
52 #if 0 /* XEmacs - this is now dynamic */
53 /* if at some point it's deemed desirable to
54 use lisp variables here, then they can be
55 initialized to nil and then set to their
56 real values upon the first call to the
57 functions that generate them. --stig */
58 Lisp_Object Vuser_real_login_name; /* login name of current user ID */
59 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */
62 /* It's useful to be able to set this as user customization, so we'll
64 Lisp_Object Vuser_full_name;
65 EXFUN (Fuser_full_name, 1);
69 Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
71 Lisp_Object Quser_files_and_directories;
73 /* This holds the value of `environ' produced by the previous
74 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
75 has never been called. */
76 static char **environbuf;
81 /* Only used in removed code below. */
86 /* Set up system_name even when dumping. */
94 if ((p = getenv ("NAME")))
95 /* I don't think it's the right thing to do the ampersand
96 modification on NAME. Not that it matters anymore... -hniksic */
97 Vuser_full_name = build_ext_string (p, Qnative);
99 Vuser_full_name = Fuser_full_name (Qnil);
102 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
103 Convert CHARACTER to a one-character string containing that character.
108 Bufbyte str[MAX_EMCHAR_LEN];
110 if (EVENTP (character))
112 Lisp_Object ch2 = Fevent_to_character (character, Qt, Qnil, Qnil);
115 signal_simple_continuable_error
116 ("character has no ASCII equivalent:", Fcopy_event (character, Qnil));
120 CHECK_CHAR_COERCE_INT (character);
122 len = set_charptr_emchar (str, XCHAR (character));
123 return make_string (str, len);
126 DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /*
127 Convert arg STRING to a character, the first character of that string.
128 An empty string will return the constant `nil'.
133 CHECK_STRING (string);
135 p = XSTRING (string);
136 if (string_length (p) != 0)
137 return make_char (string_char (p, 0));
139 /* This used to return Qzero. That is broken, broken, broken. */
140 /* It might be kinder to signal an error directly. -slb */
146 buildmark (Bufpos val, Lisp_Object buffer)
148 Lisp_Object mark = Fmake_marker ();
149 Fset_marker (mark, make_int (val), buffer);
153 DEFUN ("point", Fpoint, 0, 1, 0, /*
154 Return value of point, as an integer.
155 Beginning of buffer is position (point-min).
156 If BUFFER is nil, the current buffer is assumed.
160 struct buffer *b = decode_buffer (buffer, 1);
161 return make_int (BUF_PT (b));
164 DEFUN ("point-marker", Fpoint_marker, 0, 2, 0, /*
165 Return value of point, as a marker object.
166 This marker is a copy; you may modify it with reckless abandon.
167 If optional argument DONT-COPY-P is non-nil, then it returns the real
168 point-marker; modifying the position of this marker will move point.
169 It is illegal to change the buffer of it, or make it point nowhere.
170 If BUFFER is nil, the current buffer is assumed.
172 (dont_copy_p, buffer))
174 struct buffer *b = decode_buffer (buffer, 1);
175 if (NILP (dont_copy_p))
176 return Fcopy_marker (b->point_marker, Qnil);
178 return b->point_marker;
181 /* The following two functions end up being identical but it's
182 cleaner to declare them separately. */
185 bufpos_clip_to_bounds (Bufpos lower, Bufpos num, Bufpos upper)
187 return (num < lower ? lower :
188 num > upper ? upper :
193 bytind_clip_to_bounds (Bytind lower, Bytind num, Bytind upper)
195 return (num < lower ? lower :
196 num > upper ? upper :
202 * There is no absolute way to determine if goto-char is the function
203 * being run. this-command doesn't work because it is often eval'd
204 * and this-command ends up set to eval-expression. So this flag gets
207 * Jamie thinks he's wrong, but we'll leave this in for now.
209 int atomic_extent_goto_char_p;
211 DEFUN ("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /*
212 Set point to POSITION, a number or marker.
213 Beginning of buffer is position (point-min), end is (point-max).
214 If BUFFER is nil, the current buffer is assumed.
215 Return value of POSITION, as an integer.
219 struct buffer *b = decode_buffer (buffer, 1);
220 Bufpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE);
222 atomic_extent_goto_char_p = 1;
227 region_limit (int beginningp, struct buffer *b)
232 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
233 && NILP (b->mark_active))
234 Fsignal (Qmark_inactive, Qnil);
236 m = Fmarker_position (b->mark);
237 if (NILP (m)) error ("There is no region now");
238 if (!!(BUF_PT (b) < XINT (m)) == !!beginningp)
239 return make_int (BUF_PT (b));
244 DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /*
245 Return position of beginning of region in BUFFER, as an integer.
246 If BUFFER is nil, the current buffer is assumed.
250 return region_limit (1, decode_buffer (buffer, 1));
253 DEFUN ("region-end", Fregion_end, 0, 1, 0, /*
254 Return position of end of region in BUFFER, as an integer.
255 If BUFFER is nil, the current buffer is assumed.
259 return region_limit (0, decode_buffer (buffer, 1));
262 /* Whether to use lispm-style active-regions */
265 /* Whether the zmacs region is active. This is not per-buffer because
266 there can be only one active region at a time. #### Now that the
267 zmacs region are not directly tied to the X selections this may not
268 necessarily have to be true. */
269 int zmacs_region_active_p;
271 int zmacs_region_stays;
273 Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region;
274 Lisp_Object Qzmacs_region_buffer;
277 zmacs_update_region (void)
279 /* This function can GC */
280 if (zmacs_region_active_p)
281 call0 (Qzmacs_update_region);
285 zmacs_deactivate_region (void)
287 /* This function can GC */
288 if (zmacs_region_active_p)
289 call0 (Qzmacs_deactivate_region);
293 zmacs_region_buffer (void)
295 if (zmacs_region_active_p)
296 return call0 (Qzmacs_region_buffer);
301 DEFUN ("mark-marker", Fmark_marker, 0, 2, 0, /*
302 Return this buffer's mark, as a marker object.
303 If `zmacs-regions' is true, then this returns nil unless the region is
304 currently in the active (highlighted) state. If optional argument FORCE
305 is t, this returns the mark (if there is one) regardless of the zmacs-region
306 state. You should *generally* not use the mark unless the region is active,
307 if the user has expressed a preference for the zmacs-region model.
308 Watch out! Moving this marker changes the mark position.
309 If you set the marker not to point anywhere, the buffer will have no mark.
310 If BUFFER is nil, the current buffer is assumed.
314 struct buffer *b = decode_buffer (buffer, 1);
315 if (! zmacs_regions || zmacs_region_active_p || !NILP (force))
321 /* The saved object is a cons:
323 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
325 We used to have another cons for a VISIBLE-P element, which was t
326 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
327 was unused for a long time, so I removed it. --hniksic */
329 save_excursion_save (void)
333 /* #### Huh? --hniksic */
334 /*if (preparing_for_armageddon) return Qnil;*/
336 #ifdef ERROR_CHECK_BUFPOS
337 assert (XINT (Fpoint (Qnil)) ==
338 XINT (Fmarker_position (Fpoint_marker (Qt, Qnil))));
343 return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil),
344 noseeum_copy_marker (b->mark, Qnil));
348 save_excursion_restore (Lisp_Object info)
350 Lisp_Object buffer = Fmarker_buffer (XCAR (info));
352 /* If buffer being returned to is now deleted, avoid error --
353 otherwise could get error here while unwinding to top level and
354 crash. In that case, Fmarker_buffer returns nil now. */
357 struct buffer *buf = XBUFFER (buffer);
360 set_buffer_internal (buf);
361 Fgoto_char (XCAR (info), buffer);
362 Fset_marker (buf->mark, XCDR (info), buffer);
364 #if 0 /* We used to make the current buffer visible in the selected window
365 if that was true previously. That avoids some anomalies.
366 But it creates others, and it wasn't documented, and it is simpler
367 and cleaner never to alter the window/buffer connections. */
368 /* I'm certain some code somewhere depends on this behavior. --jwz */
369 /* Even if it did, it certainly doesn't matter anymore, because
370 this has been the behavior for countless XEmacs releases
373 && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
374 switch_to_buffer (Fcurrent_buffer (), Qnil);
380 /* Free all the junk we allocated, so that a `save-excursion' comes
381 for free in terms of GC junk. */
382 free_marker (XMARKER (XCAR (info)));
383 free_marker (XMARKER (XCDR (info)));
384 free_cons (XCONS (info));
388 DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
389 Save point, mark, and current buffer; execute BODY; restore those things.
390 Executes BODY just like `progn'.
391 The values of point, mark and the current buffer are restored
392 even in case of abnormal exit (throw or error).
396 /* This function can GC */
397 int speccount = specpdl_depth ();
399 record_unwind_protect (save_excursion_restore, save_excursion_save ());
401 return unbind_to (speccount, Fprogn (args));
405 save_current_buffer_restore (Lisp_Object buffer)
407 struct buffer *buf = XBUFFER (buffer);
408 /* Avoid signaling an error if the buffer is no longer alive. This
409 is for consistency with save-excursion. */
410 if (BUFFER_LIVE_P (buf))
411 set_buffer_internal (buf);
415 DEFUN ("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /*
416 Save the current buffer; execute BODY; restore the current buffer.
417 Executes BODY just like `progn'.
421 /* This function can GC */
422 int speccount = specpdl_depth ();
424 record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ());
426 return unbind_to (speccount, Fprogn (args));
429 DEFUN ("buffer-size", Fbuffer_size, 0, 1, 0, /*
430 Return the number of characters in BUFFER.
431 If BUFFER is nil, the current buffer is assumed.
435 struct buffer *b = decode_buffer (buffer, 1);
436 return make_int (BUF_SIZE (b));
439 DEFUN ("point-min", Fpoint_min, 0, 1, 0, /*
440 Return the minimum permissible value of point in BUFFER.
441 This is 1, unless narrowing (a buffer restriction)
442 is in effect, in which case it may be greater.
443 If BUFFER is nil, the current buffer is assumed.
447 struct buffer *b = decode_buffer (buffer, 1);
448 return make_int (BUF_BEGV (b));
451 DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
452 Return a marker to the minimum permissible value of point in BUFFER.
453 This is the beginning, unless narrowing (a buffer restriction)
454 is in effect, in which case it may be greater.
455 If BUFFER is nil, the current buffer is assumed.
459 struct buffer *b = decode_buffer (buffer, 1);
460 return buildmark (BUF_BEGV (b), make_buffer (b));
463 DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
464 Return the maximum permissible value of point in BUFFER.
465 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
466 is in effect, in which case it may be less.
467 If BUFFER is nil, the current buffer is assumed.
471 struct buffer *b = decode_buffer (buffer, 1);
472 return make_int (BUF_ZV (b));
475 DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
476 Return a marker to the maximum permissible value of point in BUFFER.
477 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
478 is in effect, in which case it may be less.
479 If BUFFER is nil, the current buffer is assumed.
483 struct buffer *b = decode_buffer (buffer, 1);
484 return buildmark (BUF_ZV (b), make_buffer (b));
487 DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /*
488 Return the character following point.
489 At the end of the buffer or accessible region, return 0.
490 If BUFFER is nil, the current buffer is assumed.
494 struct buffer *b = decode_buffer (buffer, 1);
495 if (BUF_PT (b) >= BUF_ZV (b))
496 return Qzero; /* #### Gag me! */
498 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b)));
501 DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /*
502 Return the character preceding point.
503 At the beginning of the buffer or accessible region, return 0.
504 If BUFFER is nil, the current buffer is assumed.
508 struct buffer *b = decode_buffer (buffer, 1);
509 if (BUF_PT (b) <= BUF_BEGV (b))
510 return Qzero; /* #### Gag me! */
512 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1));
515 DEFUN ("bobp", Fbobp, 0, 1, 0, /*
516 Return t if point is at the beginning of the buffer.
517 If the buffer is narrowed, this means the beginning of the narrowed part.
518 If BUFFER is nil, the current buffer is assumed.
522 struct buffer *b = decode_buffer (buffer, 1);
523 return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil;
526 DEFUN ("eobp", Feobp, 0, 1, 0, /*
527 Return t if point is at the end of the buffer.
528 If the buffer is narrowed, this means the end of the narrowed part.
529 If BUFFER is nil, the current buffer is assumed.
533 struct buffer *b = decode_buffer (buffer, 1);
534 return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil;
538 beginning_of_line_p (struct buffer *b, Bufpos pt)
540 return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n';
544 DEFUN ("bolp", Fbolp, 0, 1, 0, /*
545 Return t if point is at the beginning of a line.
546 If BUFFER is nil, the current buffer is assumed.
550 struct buffer *b = decode_buffer (buffer, 1);
551 return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
554 DEFUN ("eolp", Feolp, 0, 1, 0, /*
555 Return t if point is at the end of a line.
556 `End of a line' includes point being at the end of the buffer.
557 If BUFFER is nil, the current buffer is assumed.
561 struct buffer *b = decode_buffer (buffer, 1);
562 return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n')
566 DEFUN ("char-after", Fchar_after, 0, 2, 0, /*
567 Return the character at position POS in BUFFER.
568 POS is an integer or a marker.
569 If POS is out of range, the value is nil.
570 if POS is nil, the value of point is assumed.
571 If BUFFER is nil, the current buffer is assumed.
575 struct buffer *b = decode_buffer (buffer, 1);
576 Bufpos n = (NILP (pos) ? BUF_PT (b) :
577 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
579 if (n < 0 || n == BUF_ZV (b))
581 return make_char (BUF_FETCH_CHAR (b, n));
584 DEFUN ("char-before", Fchar_before, 0, 2, 0, /*
585 Return the character preceding position POS in BUFFER.
586 POS is an integer or a marker.
587 If POS is out of range, the value is nil.
588 if POS is nil, the value of point is assumed.
589 If BUFFER is nil, the current buffer is assumed.
593 struct buffer *b = decode_buffer (buffer, 1);
594 Bufpos n = (NILP (pos) ? BUF_PT (b) :
595 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
599 if (n < BUF_BEGV (b))
601 return make_char (BUF_FETCH_CHAR (b, n));
604 #if !defined(WINDOWSNT) && !defined(MSDOS)
605 #include <sys/stat.h>
611 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
612 Return the pathname to the directory to use for temporary files.
613 On MS Windows, this is obtained from the TEMP or TMP environment variables,
614 defaulting to / if they are both undefined.
615 On Unix it is obtained from TMPDIR, with /tmp as the default.
620 #if defined(WIN32_NATIVE)
621 tmpdir = getenv ("TEMP");
623 tmpdir = getenv ("TMP");
626 #else /* WIN32_NATIVE */
627 tmpdir = getenv ("TMPDIR");
631 int myuid = getuid();
632 static char path[5 /* strlen ("/tmp/") */ + 1 + _POSIX_PATH_MAX];
634 strcpy (path, "/tmp/");
635 strncat (path, user_login_name (NULL), _POSIX_PATH_MAX);
636 if (lstat(path, &st) < 0 && errno == ENOENT)
638 mkdir(path, 0700); /* ignore retval -- checked next anyway. */
640 if (lstat(path, &st) == 0 && st.st_uid == (uid_t) myuid &&
647 path[5 + _POSIX_PATH_MAX] = '\0';
648 strncpy(path, getenv("HOME"), 5 + _POSIX_PATH_MAX);
649 strncat(path, "/tmp/", 5 + _POSIX_PATH_MAX);
650 if (stat(path, &st) < 0 && errno == ENOENT)
653 char warnpath[6+_POSIX_PATH_MAX];
654 mkdir(path, 0700); /* ignore retvals */
655 warnpath[_POSIX_PATH_MAX] = '\0';
656 strncpy(warnpath, path, 5 + _POSIX_PATH_MAX);
657 strncat(warnpath, ".created_by_xemacs", 5 + _POSIX_PATH_MAX);
658 if ((fd = open(warnpath, O_WRONLY|O_CREAT, 0644)) > 0)
660 write(fd, "XEmacs created this directory because /tmp/<yourname> was unavailable -- \nPlease check !\n", 89);
664 if (stat(path, &st) == 0 && S_ISDIR(st.st_mode))
676 return build_ext_string (tmpdir, Qfile_name);
679 DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
680 Return the name under which the user logged in, as a string.
681 This is based on the effective uid, not the real uid.
682 Also, if the environment variable LOGNAME or USER is set,
683 that determines the value of this function.
684 If the optional argument UID is present, then environment variables are
685 ignored and this function returns the login name for that UID, or nil.
695 local_uid = XINT (uid);
696 returned_name = user_login_name (&local_uid);
700 returned_name = user_login_name (NULL);
702 /* #### - I believe this should return nil instead of "unknown" when pw==0
703 pw=0 is indicated by a null return from user_login_name
705 return returned_name ? build_string (returned_name) : Qnil;
708 /* This function may be called from other C routines when a
709 character string representation of the user_login_name is
710 needed but a Lisp Object is not. The UID is passed by
711 reference. If UID == NULL, then the USER name
712 for the user running XEmacs will be returned. This
713 corresponds to a nil argument to Fuser_login_name.
716 user_login_name (uid_t *uid)
718 /* uid == NULL to return name of this user */
721 struct passwd *pw = getpwuid (*uid);
722 return pw ? pw->pw_name : NULL;
726 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
727 old environment (I site observed behavior on sunos and linux), so the
728 environment variables should be disregarded in that case. --Stig */
729 char *user_name = getenv ("LOGNAME");
733 "USERNAME" /* it's USERNAME on NT */
742 struct passwd *pw = getpwuid (geteuid ());
744 /* Since the Cygwin environment may not have an /etc/passwd,
745 return "unknown" instead of the null if the username
746 cannot be determined.
748 return pw ? pw->pw_name : "unknown";
750 /* For all but Cygwin return NULL (nil) */
751 return pw ? pw->pw_name : NULL;
757 DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
758 Return the name of the user's real uid, as a string.
759 This ignores the environment variables LOGNAME and USER, so it differs from
760 `user-login-name' when running under `su'.
764 struct passwd *pw = getpwuid (getuid ());
765 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
767 Lisp_Object tem = build_string (pw ? pw->pw_name : "unknown");/* no gettext */
771 DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /*
772 Return the effective uid of Emacs, as an integer.
776 return make_int (geteuid ());
779 DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
780 Return the real uid of Emacs, as an integer.
784 return make_int (getuid ());
787 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
788 Return the full name of the user logged in, as a string.
789 If the optional argument USER is given, then the full name for that
790 user is returned, or nil. USER may be either a login name or a uid.
792 If USER is nil, and `user-full-name' contains a string, the
793 value of `user-full-name' is returned.
797 Lisp_Object user_name;
798 struct passwd *pw = NULL;
802 if (NILP (user) && STRINGP (Vuser_full_name))
803 return Vuser_full_name;
805 user_name = (STRINGP (user) ? user : Fuser_login_name (user));
806 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
808 const char *user_name_ext;
810 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
811 things get wedged if a SIGIO arrives during this time. */
812 TO_EXTERNAL_FORMAT (LISP_STRING, user_name,
813 C_STRING_ALLOCA, user_name_ext,
815 slow_down_interrupts ();
816 pw = (struct passwd *) getpwnam (user_name_ext);
817 speed_up_interrupts ();
820 /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
821 /* Ben sez: bad idea because it's likely to break something */
822 #ifndef AMPERSAND_FULL_NAME
823 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
826 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
829 tem = ((!NILP (user) && !pw)
831 : make_ext_string ((Extbyte *) p, (q ? q - p : (int) strlen (p)),
834 #ifdef AMPERSAND_FULL_NAME
837 p = (char *) XSTRING_DATA (tem);
839 /* Substitute the login name for the &, upcasing the first character. */
842 char *r = (char *) alloca (strlen (p) + XSTRING_LENGTH (user_name) + 1);
843 memcpy (r, p, q - p);
845 strcat (r, (char *) XSTRING_DATA (user_name));
846 /* #### current_buffer dependency! */
847 r[q - p] = UPCASE (current_buffer, r[q - p]);
849 tem = build_string (r);
852 #endif /* AMPERSAND_FULL_NAME */
857 static Extbyte *cached_home_directory;
860 uncache_home_directory (void)
862 cached_home_directory = NULL; /* in some cases, this may cause the leaking
866 /* !!#### not Mule correct. */
868 /* Returns the home directory, in external format */
870 get_home_directory (void)
872 /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
873 about what format an external string is in. Could be Unicode, for all
874 we know, and then all the operations below are totally bogus.
875 Instead, convert all data to internal format *right* at the juncture
876 between XEmacs and the outside world, the very moment we first get
878 int output_home_warning = 0;
880 if (cached_home_directory == NULL)
882 if ((cached_home_directory = (Extbyte *) getenv("HOME")) == NULL)
884 #if defined(WIN32_NATIVE)
885 char *homedrive, *homepath;
887 if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
888 (homepath = getenv("HOMEPATH")) != NULL)
890 cached_home_directory =
891 (Extbyte *) xmalloc (strlen (homedrive) +
892 strlen (homepath) + 1);
893 sprintf((char *) cached_home_directory, "%s%s",
899 # if 0 /* changed by ben. This behavior absolutely stinks, and the
900 possibility being addressed here occurs quite commonly.
901 Using the current directory makes absolutely no sense. */
903 * Use the current directory.
904 * This preserves the existing XEmacs behavior, but is different
907 if (initial_directory[0] != '\0')
909 cached_home_directory = (Extbyte*) initial_directory;
913 /* This will probably give the wrong value */
914 cached_home_directory = (Extbyte*) getcwd (NULL, 0);
918 * This is NT Emacs behavior
920 cached_home_directory = (Extbyte *) "C:\\";
921 output_home_warning = 1;
924 #else /* !WIN32_NATIVE */
927 * Using "/" isn't quite right, but what should we do?
928 * We probably should try to extract pw_dir from /etc/passwd,
929 * before falling back to this.
931 cached_home_directory = (Extbyte *) "/";
932 output_home_warning = 1;
933 #endif /* !WIN32_NATIVE */
935 if (initialized && output_home_warning)
937 warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
938 " XEmacs was unable to determine a good value for the user's $HOME\n"
939 " directory, and will be using the value:\n"
941 " This is probably incorrect.",
942 cached_home_directory
946 return cached_home_directory;
949 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
950 Return the user's home directory, as a string.
954 Extbyte *path = get_home_directory ();
956 return path == NULL ? Qnil :
957 Fexpand_file_name (Fsubstitute_in_file_name
958 (build_ext_string ((char *) path, Qfile_name)),
962 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
963 Return the name of the machine you are running on, as a string.
967 return Fcopy_sequence (Vsystem_name);
970 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
971 Return the process ID of Emacs, as an integer.
975 return make_int (getpid ());
978 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
979 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
980 The time is returned as a list of three integers. The first has the
981 most significant 16 bits of the seconds, while the second has the
982 least significant 16 bits. The third integer gives the microsecond
985 The microsecond count is zero on systems that do not provide
986 resolution finer than a second.
993 return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
994 make_int ((EMACS_SECS (t) >> 0) & 0xffff),
995 make_int (EMACS_USECS (t)));
998 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
999 Return the amount of time used by this XEmacs process so far.
1000 The return value is a list of three floating-point numbers, expressing
1001 the user, system, and real times used by the process. The user time
1002 measures the time actually spent by the CPU executing the code in this
1003 process. The system time measures time spent by the CPU executing kernel
1004 code on behalf of this process (e.g. I/O requests made by the process).
1006 Note that the user and system times measure processor time, as opposed
1007 to real time, and only accrue when the processor is actually doing
1008 something: Time spent in an idle wait (waiting for user events to come
1009 in or for I/O on a disk drive or other device to complete) does not
1010 count. Thus, the user and system times will often be considerably
1011 less than the real time.
1013 Some systems do not allow the user and system times to be distinguished.
1014 In this case, the user time will be the total processor time used by
1015 the process, and the system time will be 0.
1017 Some systems do not allow the real and processor times to be distinguished.
1018 In this case, the user and real times will be the same and the system
1023 double user, sys, real;
1025 get_process_times (&user, &sys, &real);
1026 return list3 (make_float (user), make_float (sys), make_float (real));
1030 int lisp_to_time (Lisp_Object specified_time, time_t *result);
1032 lisp_to_time (Lisp_Object specified_time, time_t *result)
1034 Lisp_Object high, low;
1036 if (NILP (specified_time))
1037 return time (result) != -1;
1039 CHECK_CONS (specified_time);
1040 high = XCAR (specified_time);
1041 low = XCDR (specified_time);
1046 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
1047 return *result >> 16 == XINT (high);
1050 Lisp_Object time_to_lisp (time_t the_time);
1052 time_to_lisp (time_t the_time)
1054 unsigned int item = (unsigned int) the_time;
1055 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
1058 size_t emacs_strftime (char *string, size_t max, const char *format,
1059 const struct tm *tm);
1060 static long difftm (const struct tm *a, const struct tm *b);
1063 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
1064 Use FORMAT-STRING to format the time TIME.
1065 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1066 `current-time' and `file-attributes'. If TIME is not specified it
1067 defaults to the current time.
1068 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1069 %a is replaced by the abbreviated name of the day of week.
1070 %A is replaced by the full name of the day of week.
1071 %b is replaced by the abbreviated name of the month.
1072 %B is replaced by the full name of the month.
1073 %c is a synonym for "%x %X".
1074 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1075 %d is replaced by the day of month, zero-padded.
1076 %D is a synonym for "%m/%d/%y".
1077 %e is replaced by the day of month, blank-padded.
1078 %h is a synonym for "%b".
1079 %H is replaced by the hour (00-23).
1080 %I is replaced by the hour (00-12).
1081 %j is replaced by the day of the year (001-366).
1082 %k is replaced by the hour (0-23), blank padded.
1083 %l is replaced by the hour (1-12), blank padded.
1084 %m is replaced by the month (01-12).
1085 %M is replaced by the minute (00-59).
1086 %n is a synonym for "\\n".
1087 %p is replaced by AM or PM, as appropriate.
1088 %r is a synonym for "%I:%M:%S %p".
1089 %R is a synonym for "%H:%M".
1090 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1091 nonstandard extension)
1092 %S is replaced by the second (00-60).
1093 %t is a synonym for "\\t".
1094 %T is a synonym for "%H:%M:%S".
1095 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1096 %w is replaced by the day of week (0-6), Sunday is day 0.
1097 %W is replaced by the week of the year (00-53), first day of week is Monday.
1098 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1099 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1100 %y is replaced by the year without century (00-99).
1101 %Y is replaced by the year with century.
1102 %Z is replaced by the time zone abbreviation.
1104 The number of options reflects the `strftime' function.
1106 BUG: If the charset used by the current locale is not ISO 8859-1, the
1107 characters appearing in the day and month names may be incorrect.
1109 (format_string, time_))
1115 CHECK_STRING (format_string);
1117 if (! lisp_to_time (time_, &value) || ! (tm = localtime (&value)))
1118 error ("Invalid time specification");
1120 /* This is probably enough. */
1121 size = XSTRING_LENGTH (format_string) * 6 + 50;
1125 char *buf = (char *) alloca (size);
1127 if (emacs_strftime (buf, size,
1128 (const char *) XSTRING_DATA (format_string),
1131 return build_ext_string (buf, Qbinary);
1132 /* If buffer was too small, make it bigger. */
1137 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
1138 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1139 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1140 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1141 to use the current time. The list has the following nine members:
1142 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1143 only some operating systems support. MINUTE is an integer between 0 and 59.
1144 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
1145 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
1146 four-digit year. DOW is the day of week, an integer between 0 and 6, where
1147 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
1148 ZONE is an integer indicating the number of seconds east of Greenwich.
1149 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1155 struct tm *decoded_time;
1156 Lisp_Object list_args[9];
1158 if (! lisp_to_time (specified_time, &time_spec)
1159 || ! (decoded_time = localtime (&time_spec)))
1160 error ("Invalid time specification");
1162 list_args[0] = make_int (decoded_time->tm_sec);
1163 list_args[1] = make_int (decoded_time->tm_min);
1164 list_args[2] = make_int (decoded_time->tm_hour);
1165 list_args[3] = make_int (decoded_time->tm_mday);
1166 list_args[4] = make_int (decoded_time->tm_mon + 1);
1167 list_args[5] = make_int (decoded_time->tm_year + 1900);
1168 list_args[6] = make_int (decoded_time->tm_wday);
1169 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
1171 /* Make a copy, in case gmtime modifies the struct. */
1172 save_tm = *decoded_time;
1173 decoded_time = gmtime (&time_spec);
1174 if (decoded_time == 0)
1175 list_args[8] = Qnil;
1177 list_args[8] = make_int (difftm (&save_tm, decoded_time));
1178 return Flist (9, list_args);
1181 static void set_time_zone_rule (char *tzstring);
1183 /* from GNU Emacs 21, per Simon Josefsson, modified by stephen
1184 The slight inefficiency is justified since negative times are weird. */
1186 make_time (time_t tval)
1188 return list2 (make_int (tval < 0 ? tval / 0x10000 : tval >> 16),
1189 make_int (tval & 0xFFFF));
1192 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
1193 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1194 This is the reverse operation of `decode-time', which see.
1195 ZONE defaults to the current time zone rule. This can
1196 be a string (as from `set-time-zone-rule'), or it can be a list
1197 \(as from `current-time-zone') or an integer (as from `decode-time')
1198 applied without consideration for daylight savings time.
1200 You can pass more than 7 arguments; then the first six arguments
1201 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1202 The intervening arguments are ignored.
1203 This feature lets (apply 'encode-time (decode-time ...)) work.
1205 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1206 for example, a DAY of 0 means the day preceding the given month.
1207 Year numbers less than 100 are treated just like other year numbers.
1208 If you want them to stand for years in this century, you must do that yourself.
1210 (int nargs, Lisp_Object *args))
1214 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1216 CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */
1217 CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */
1218 CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */
1219 CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */
1220 CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */
1221 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
1228 the_time = mktime (&tm);
1233 char **oldenv = environ, **newenv;
1236 tzstring = (char *) XSTRING_DATA (zone);
1237 else if (INTP (zone))
1239 int abszone = abs (XINT (zone));
1240 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
1241 abszone / (60*60), (abszone/60) % 60, abszone % 60);
1245 error ("Invalid time zone specification");
1247 /* Set TZ before calling mktime; merely adjusting mktime's returned
1248 value doesn't suffice, since that would mishandle leap seconds. */
1249 set_time_zone_rule (tzstring);
1251 the_time = mktime (&tm);
1253 /* Restore TZ to previous value. */
1257 #ifdef LOCALTIME_CACHE
1262 if (the_time == (time_t) -1)
1263 error ("Specified time is not representable");
1265 return make_time (the_time);
1268 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1269 Return the current time, as a human-readable string.
1270 Programs can use this function to decode a time,
1271 since the number of columns in each field is fixed.
1272 The format is `Sun Sep 16 01:03:52 1973'.
1273 If an argument is given, it specifies a time to format
1274 instead of the current time. The argument should have the form:
1277 (HIGH LOW . IGNORED).
1278 Thus, you can use times obtained from `current-time'
1279 and from `file-attributes'.
1287 if (! lisp_to_time (specified_time, &value))
1289 the_ctime = ctime (&value);
1291 /* ctime is documented as always returning a "\n\0"-terminated
1292 26-byte American time string, but let's be careful anyways. */
1293 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++)
1296 return make_ext_string ((Extbyte *) the_ctime, len, Qbinary);
1299 #define TM_YEAR_ORIGIN 1900
1301 /* Yield A - B, measured in seconds. */
1303 difftm (const struct tm *a, const struct tm *b)
1305 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1306 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1307 /* Some compilers can't handle this as a single return statement. */
1309 /* difference in day of year */
1310 a->tm_yday - b->tm_yday
1311 /* + intervening leap days */
1312 + ((ay >> 2) - (by >> 2))
1314 + ((ay/100 >> 2) - (by/100 >> 2))
1315 /* + difference in years * 365 */
1316 + (long)(ay-by) * 365
1318 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
1319 + (a->tm_min - b->tm_min))
1320 + (a->tm_sec - b->tm_sec));
1323 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1324 Return the offset and name for the local time zone.
1325 This returns a list of the form (OFFSET NAME).
1326 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1327 A negative value means west of Greenwich.
1328 NAME is a string giving the name of the time zone.
1329 If an argument is given, it specifies when the time zone offset is determined
1330 instead of using the current time. The argument should have the form:
1333 (HIGH LOW . IGNORED).
1334 Thus, you can use times obtained from `current-time'
1335 and from `file-attributes'.
1337 Some operating systems cannot provide all this information to Emacs;
1338 in this case, `current-time-zone' returns a list containing nil for
1339 the data it can't find.
1344 struct tm *t = NULL;
1346 if (lisp_to_time (specified_time, &value)
1347 && (t = gmtime (&value)) != 0)
1349 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */
1353 t = localtime (&value);
1354 offset = difftm (t, &gmt);
1358 s = (char *)t->tm_zone;
1359 #else /* not HAVE_TM_ZONE */
1361 if (t->tm_isdst == 0 || t->tm_isdst == 1)
1362 s = tzname[t->tm_isdst];
1364 #endif /* not HAVE_TM_ZONE */
1367 /* No local time zone name is available; use "+-NNNN" instead. */
1368 int am = (offset < 0 ? -offset : offset) / 60;
1369 sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
1372 return list2 (make_int (offset), build_string (s));
1375 return list2 (Qnil, Qnil);
1378 #ifdef LOCALTIME_CACHE
1380 /* These two values are known to load tz files in buggy implementations,
1381 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1382 Their values shouldn't matter in non-buggy implementations.
1383 We don't use string literals for these strings,
1384 since if a string in the environment is in readonly
1385 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1386 See Sun bugs 1113095 and 1114114, ``Timezone routines
1387 improperly modify environment''. */
1389 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1390 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1394 /* Set the local time zone rule to TZSTRING.
1395 This allocates memory into `environ', which it is the caller's
1396 responsibility to free. */
1398 set_time_zone_rule (char *tzstring)
1401 char **from, **to, **newenv;
1403 for (from = environ; *from; from++)
1405 envptrs = from - environ + 2;
1406 newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
1407 + (tzstring ? strlen (tzstring) + 4 : 0));
1410 char *t = (char *) (to + envptrs);
1412 strcat (t, tzstring);
1416 for (from = environ; *from; from++)
1417 if (strncmp (*from, "TZ=", 3) != 0)
1423 #ifdef LOCALTIME_CACHE
1425 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1426 "US/Pacific" that loads a tz file, then changes to a value like
1427 "XXX0" that does not load a tz file, and then changes back to
1428 its original value, the last change is (incorrectly) ignored.
1429 Also, if TZ changes twice in succession to values that do
1430 not load a tz file, tzset can dump core (see Sun bug#1225179).
1431 The following code works around these bugs. */
1435 /* Temporarily set TZ to a value that loads a tz file
1436 and that differs from tzstring. */
1438 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
1439 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
1445 /* The implied tzstring is unknown, so temporarily set TZ to
1446 two different values that each load a tz file. */
1447 *to = set_time_zone_rule_tz1;
1450 *to = set_time_zone_rule_tz2;
1455 /* Now TZ has the desired value, and tzset can be invoked safely. */
1462 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1463 Set the local time zone using TZ, a string specifying a time zone rule.
1464 If TZ is nil, use implementation-defined default time zone information.
1475 tzstring = (char *) XSTRING_DATA (tz);
1478 set_time_zone_rule (tzstring);
1481 environbuf = environ;
1488 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
1490 /* This function can GC */
1491 struct gcpro gcpro1;
1494 if (CHAR_OR_CHAR_INTP (arg))
1496 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
1498 else if (STRINGP (arg))
1500 buffer_insert_lisp_string (buf, arg);
1504 arg = wrong_type_argument (Qchar_or_string_p, arg);
1511 /* Callers passing one argument to Finsert need not gcpro the
1512 argument "array", since the only element of the array will
1513 not be used after calling insert_emacs_char or insert_lisp_string,
1514 so we don't care if it gets trashed. */
1516 DEFUN ("insert", Finsert, 0, MANY, 0, /*
1517 Insert the arguments, either strings or characters, at point.
1518 Point moves forward so that it ends up after the inserted text.
1519 Any other markers at the point of insertion remain before the text.
1520 If a string has non-null string-extent-data, new extents will be created.
1522 (int nargs, Lisp_Object *args))
1524 /* This function can GC */
1525 REGISTER int argnum;
1527 for (argnum = 0; argnum < nargs; argnum++)
1529 buffer_insert1 (current_buffer, args[argnum]);
1535 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1536 Insert strings or characters at point, relocating markers after the text.
1537 Point moves forward so that it ends up after the inserted text.
1538 Any other markers at the point of insertion also end up after the text.
1540 (int nargs, Lisp_Object *args))
1542 /* This function can GC */
1543 REGISTER int argnum;
1544 REGISTER Lisp_Object tem;
1546 for (argnum = 0; argnum < nargs; argnum++)
1550 if (CHAR_OR_CHAR_INTP (tem))
1552 buffer_insert_emacs_char_1 (current_buffer, -1,
1553 XCHAR_OR_CHAR_INT (tem),
1554 INSDEL_BEFORE_MARKERS);
1556 else if (STRINGP (tem))
1558 buffer_insert_lisp_string_1 (current_buffer, -1, tem,
1559 INSDEL_BEFORE_MARKERS);
1563 tem = wrong_type_argument (Qchar_or_string_p, tem);
1570 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
1571 Insert STRING into BUFFER at BUFFER's point.
1572 Point moves forward so that it ends up after the inserted text.
1573 Any other markers at the point of insertion remain before the text.
1574 If a string has non-null string-extent-data, new extents will be created.
1575 BUFFER defaults to the current buffer.
1579 struct buffer *b = decode_buffer (buffer, 1);
1580 CHECK_STRING (string);
1581 buffer_insert_lisp_string (b, string);
1585 /* Third argument in FSF is INHERIT:
1587 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1588 from adjoining text, if those properties are sticky."
1590 Jamie thinks this is bogus. */
1593 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
1594 Insert COUNT copies of CHARACTER into BUFFER.
1595 Point and all markers are affected as in the function `insert'.
1596 COUNT defaults to 1 if omitted.
1597 The optional third arg IGNORED is INHERIT under FSF Emacs.
1598 This is highly bogus, however, and XEmacs always behaves as if
1599 `t' were passed to INHERIT.
1600 The optional fourth arg BUFFER specifies the buffer to insert the
1601 text into. If BUFFER is nil, the current buffer is assumed.
1603 (character, count, ignored, buffer))
1605 /* This function can GC */
1606 REGISTER Bufbyte *string;
1609 REGISTER Bytecount n;
1610 REGISTER Bytecount charlen;
1611 Bufbyte str[MAX_EMCHAR_LEN];
1612 struct buffer *b = decode_buffer (buffer, 1);
1615 CHECK_CHAR_COERCE_INT (character);
1624 charlen = set_charptr_emchar (str, XCHAR (character));
1628 slen = min (n, 768);
1629 string = alloca_array (Bufbyte, slen);
1630 /* Write as many copies of the character into the temp string as will fit. */
1631 for (i = 0; i + charlen <= slen; i += charlen)
1632 for (j = 0; j < charlen; j++)
1633 string[i + j] = str[j];
1637 buffer_insert_raw_string (b, string, slen);
1641 #if 0 /* FSFmacs bogosity */
1643 if (!NILP (inherit))
1644 insert_and_inherit (string, n);
1649 buffer_insert_raw_string (b, string, n);
1656 /* Making strings from buffer contents. */
1658 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1659 Return the contents of part of BUFFER as a string.
1660 The two arguments START and END are character positions;
1661 they can be in either order. If omitted, they default to the beginning
1662 and end of BUFFER, respectively.
1663 If there are duplicable extents in the region, the string remembers
1664 them in its extent data.
1665 If BUFFER is nil, the current buffer is assumed.
1667 (start, end, buffer))
1669 /* This function can GC */
1671 struct buffer *b = decode_buffer (buffer, 1);
1673 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1674 return make_string_from_buffer (b, begv, zv - begv);
1677 /* It might make more sense to name this
1678 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1679 and what the function does is probably good enough for what the
1680 user-code will typically want to use it for. */
1681 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1682 Return the text from START to END as a string, without copying the extents.
1684 (start, end, buffer))
1686 /* This function can GC */
1688 struct buffer *b = decode_buffer (buffer, 1);
1690 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1691 return make_string_from_buffer_no_extents (b, begv, zv - begv);
1694 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1695 Insert before point a substring of the contents of buffer BUFFER.
1696 BUFFER may be a buffer or a buffer name.
1697 Arguments START and END are character numbers specifying the substring.
1698 They default to the beginning and the end of BUFFER.
1700 (buffer, start, end))
1702 /* This function can GC */
1706 bp = XBUFFER (get_buffer (buffer, 1));
1707 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
1710 buffer_insert_from_buffer (current_buffer, bp, b, e - b);
1715 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1716 Compare two substrings of two buffers; return result as number.
1717 the value is -N if first string is less after N-1 chars,
1718 +N if first string is greater after N-1 chars, or 0 if strings match.
1719 Each substring is represented as three arguments: BUFFER, START and END.
1720 That makes six args in all, three for each substring.
1722 The value of `case-fold-search' in the current buffer
1723 determines whether case is significant or ignored.
1725 (buffer1, start1, end1, buffer2, start2, end2))
1727 Bufpos begp1, endp1, begp2, endp2;
1728 REGISTER Charcount len1, len2, length, i;
1729 struct buffer *bp1, *bp2;
1730 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
1731 XCASE_TABLE_CANON (current_buffer->case_table) : Qnil);
1733 /* Find the first buffer and its substring. */
1735 bp1 = decode_buffer (buffer1, 1);
1736 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1738 /* Likewise for second substring. */
1740 bp2 = decode_buffer (buffer2, 1);
1741 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1743 len1 = endp1 - begp1;
1744 len2 = endp2 - begp2;
1749 for (i = 0; i < length; i++)
1751 Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
1752 Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
1755 c1 = TRT_TABLE_OF (trt, c1);
1756 c2 = TRT_TABLE_OF (trt, c2);
1759 return make_int (- 1 - i);
1761 return make_int (i + 1);
1764 /* The strings match as far as they go.
1765 If one is shorter, that one is less. */
1767 return make_int (length + 1);
1768 else if (length < len2)
1769 return make_int (- length - 1);
1771 /* Same length too => they are equal. */
1777 subst_char_in_region_unwind (Lisp_Object arg)
1779 XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
1784 subst_char_in_region_unwind_1 (Lisp_Object arg)
1786 XBUFFER (XCAR (arg))->filename = XCDR (arg);
1790 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1791 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1792 If optional arg NOUNDO is non-nil, don't record this change for undo
1793 and don't mark the buffer as really changed.
1795 (start, end, fromchar, tochar, noundo))
1797 /* This function can GC */
1801 struct buffer *buf = current_buffer;
1802 int count = specpdl_depth ();
1804 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1805 CHECK_CHAR_COERCE_INT (fromchar);
1806 CHECK_CHAR_COERCE_INT (tochar);
1808 fromc = XCHAR (fromchar);
1809 toc = XCHAR (tochar);
1811 /* If we don't want undo, turn off putting stuff on the list.
1812 That's faster than getting rid of things,
1813 and it prevents even the entry for a first change.
1814 Also inhibit locking the file. */
1817 record_unwind_protect (subst_char_in_region_unwind,
1818 Fcons (Fcurrent_buffer (), buf->undo_list));
1819 buf->undo_list = Qt;
1820 /* Don't do file-locking. */
1821 record_unwind_protect (subst_char_in_region_unwind_1,
1822 Fcons (Fcurrent_buffer (), buf->filename));
1823 buf->filename = Qnil;
1826 mc_count = begin_multiple_change (buf, pos, stop);
1829 if (BUF_FETCH_CHAR (buf, pos) == fromc)
1831 /* There used to be some code here that set the buffer to
1832 unmodified if NOUNDO was specified and there was only
1833 one change to the buffer since it was last saved.
1834 This is a crock of shit, so I'm not duplicating this
1835 behavior. I think this was left over from when
1836 prepare_to_modify_buffer() actually bumped MODIFF,
1837 so that code was supposed to undo this change. --ben */
1838 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
1840 /* If noundo is not nil then we don't mark the buffer as
1841 modified. In reality that needs to happen externally
1842 only. Internally redisplay needs to know that the actual
1843 contents it should be displaying have changed. */
1845 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
1849 end_multiple_change (buf, mc_count);
1851 unbind_to (count, Qnil);
1855 /* #### Shouldn't this also accept a BUFFER argument, in the good old
1856 XEmacs tradition? */
1857 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
1858 Translate characters from START to END according to TABLE.
1860 If TABLE is a string, the Nth character in it is the mapping for the
1861 character with code N.
1863 If TABLE is a vector, its Nth element is the mapping for character
1864 with code N. The values of elements may be characters, strings, or
1865 nil (nil meaning don't replace.)
1867 If TABLE is a char-table, its elements describe the mapping between
1868 characters and their replacements. The char-table should be of type
1869 `char' or `generic'.
1871 Returns the number of substitutions performed.
1873 (start, end, table))
1875 /* This function can GC */
1876 Bufpos pos, stop; /* Limits of the region. */
1877 int cnt = 0; /* Number of changes made. */
1879 struct buffer *buf = current_buffer;
1882 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1883 mc_count = begin_multiple_change (buf, pos, stop);
1884 if (STRINGP (table))
1886 Lisp_String *stable = XSTRING (table);
1887 Charcount size = string_char_length (stable);
1889 /* Under Mule, string_char(n) is O(n), so for large tables or
1890 large regions it makes sense to create an array of Emchars. */
1891 if (size * (stop - pos) > 65536)
1893 Emchar *etable = alloca_array (Emchar, size);
1894 convert_bufbyte_string_into_emchar_string
1895 (string_data (stable), string_length (stable), etable);
1896 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1900 Emchar nc = etable[oc];
1903 buffer_replace_char (buf, pos, nc, 0, 0);
1912 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1916 Emchar nc = string_char (stable, oc);
1919 buffer_replace_char (buf, pos, nc, 0, 0);
1926 else if (VECTORP (table))
1928 Charcount size = XVECTOR_LENGTH (table);
1929 Lisp_Object *vtable = XVECTOR_DATA (table);
1931 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1935 Lisp_Object replacement = vtable[oc];
1937 if (CHAR_OR_CHAR_INTP (replacement))
1939 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1942 buffer_replace_char (buf, pos, nc, 0, 0);
1946 else if (STRINGP (replacement))
1948 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1949 buffer_delete_range (buf, pos, pos + 1, 0);
1950 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1951 pos += incr, stop += incr;
1954 else if (!NILP (replacement))
1956 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1962 else if (CHAR_TABLEP (table)
1963 && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
1964 || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
1966 Lisp_Char_Table *ctable = XCHAR_TABLE (table);
1968 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1970 Lisp_Object replacement = get_char_table (oc, ctable);
1972 if (CHAR_OR_CHAR_INTP (replacement))
1974 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1977 buffer_replace_char (buf, pos, nc, 0, 0);
1981 else if (STRINGP (replacement))
1983 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1984 buffer_delete_range (buf, pos, pos + 1, 0);
1985 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1986 pos += incr, stop += incr;
1989 else if (!NILP (replacement))
1991 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1997 dead_wrong_type_argument (Qstringp, table);
1998 end_multiple_change (buf, mc_count);
2000 return make_int (cnt);
2003 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
2004 Delete the text between point and mark.
2005 When called from a program, expects two arguments START and END
2006 \(integers or markers) specifying the stretch to be deleted.
2007 If optional third arg BUFFER is nil, the current buffer is assumed.
2009 (start, end, buffer))
2011 /* This function can GC */
2012 Bufpos bp_start, bp_end;
2013 struct buffer *buf = decode_buffer (buffer, 1);
2015 get_buffer_range_char (buf, start, end, &bp_start, &bp_end, 0);
2016 buffer_delete_range (buf, bp_start, bp_end, 0);
2021 widen_buffer (struct buffer *b, int no_clip)
2023 if (BUF_BEGV (b) != BUF_BEG (b))
2026 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b));
2028 if (BUF_ZV (b) != BUF_Z (b))
2031 SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b));
2037 /* Changing the buffer bounds invalidates any recorded current
2039 invalidate_current_column ();
2040 narrow_line_number_cache (b);
2044 DEFUN ("widen", Fwiden, 0, 1, "", /*
2045 Remove restrictions (narrowing) from BUFFER.
2046 This allows the buffer's full text to be seen and edited.
2047 If BUFFER is nil, the current buffer is assumed.
2051 struct buffer *b = decode_buffer (buffer, 1);
2052 widen_buffer (b, 0);
2056 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2057 Restrict editing in BUFFER to the current region.
2058 The rest of the text becomes temporarily invisible and untouchable
2059 but is not deleted; if you save the buffer in a file, the invisible
2060 text is included in the file. \\[widen] makes all visible again.
2061 If BUFFER is nil, the current buffer is assumed.
2062 See also `save-restriction'.
2064 When calling from a program, pass two arguments; positions (integers
2065 or markers) bounding the text that should remain visible.
2067 (start, end, buffer))
2069 Bufpos bp_start, bp_end;
2070 struct buffer *buf = decode_buffer (buffer, 1);
2071 Bytind bi_start, bi_end;
2073 get_buffer_range_char (buf, start, end, &bp_start, &bp_end,
2074 GB_ALLOW_PAST_ACCESSIBLE);
2075 bi_start = bufpos_to_bytind (buf, bp_start);
2076 bi_end = bufpos_to_bytind (buf, bp_end);
2078 SET_BOTH_BUF_BEGV (buf, bp_start, bi_start);
2079 SET_BOTH_BUF_ZV (buf, bp_end, bi_end);
2080 if (BUF_PT (buf) < bp_start)
2081 BUF_SET_PT (buf, bp_start);
2082 if (BUF_PT (buf) > bp_end)
2083 BUF_SET_PT (buf, bp_end);
2085 /* Changing the buffer bounds invalidates any recorded current column. */
2086 invalidate_current_column ();
2087 narrow_line_number_cache (buf);
2092 save_restriction_save (void)
2094 Lisp_Object bottom, top;
2095 /* Note: I tried using markers here, but it does not win
2096 because insertion at the end of the saved region
2097 does not advance mh and is considered "outside" the saved region. */
2098 bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer));
2099 top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer));
2101 return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top));
2105 save_restriction_restore (Lisp_Object data)
2108 Charcount newhead, newtail;
2110 int local_clip_changed = 0;
2112 buf = XBUFFER (XCAR (data));
2113 if (!BUFFER_LIVE_P (buf))
2115 /* someone could have killed the buffer in the meantime ... */
2116 free_cons (XCONS (XCDR (data)));
2117 free_cons (XCONS (data));
2121 newhead = XINT (XCAR (tem));
2122 newtail = XINT (XCDR (tem));
2124 free_cons (XCONS (XCDR (data)));
2125 free_cons (XCONS (data));
2127 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
2135 Bytind bi_start, bi_end;
2137 start = BUF_BEG (buf) + newhead;
2138 end = BUF_Z (buf) - newtail;
2140 bi_start = bufpos_to_bytind (buf, start);
2141 bi_end = bufpos_to_bytind (buf, end);
2143 if (BUF_BEGV (buf) != start)
2145 local_clip_changed = 1;
2146 SET_BOTH_BUF_BEGV (buf, start, bi_start);
2147 narrow_line_number_cache (buf);
2149 if (BUF_ZV (buf) != end)
2151 local_clip_changed = 1;
2152 SET_BOTH_BUF_ZV (buf, end, bi_end);
2155 if (local_clip_changed)
2158 /* If point is outside the new visible range, move it inside. */
2160 bufpos_clip_to_bounds (BUF_BEGV (buf),
2167 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2168 Execute BODY, saving and restoring current buffer's restrictions.
2169 The buffer's restrictions make parts of the beginning and end invisible.
2170 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2171 This special form, `save-restriction', saves the current buffer's restrictions
2172 when it is entered, and restores them when it is exited.
2173 So any `narrow-to-region' within BODY lasts only until the end of the form.
2174 The old restrictions settings are restored
2175 even in case of abnormal exit (throw or error).
2177 The value returned is the value of the last form in BODY.
2179 `save-restriction' can get confused if, within the BODY, you widen
2180 and then make changes outside the area within the saved restrictions.
2182 Note: if you are using both `save-excursion' and `save-restriction',
2183 use `save-excursion' outermost:
2184 (save-excursion (save-restriction ...))
2188 /* This function can GC */
2189 int speccount = specpdl_depth ();
2191 record_unwind_protect (save_restriction_restore, save_restriction_save ());
2193 return unbind_to (speccount, Fprogn (body));
2197 DEFUN ("format", Fformat, 1, MANY, 0, /*
2198 Format a string out of a control-string and arguments.
2199 The first argument is a control string.
2200 The other arguments are substituted into it to make the result, a string.
2201 It may contain %-sequences meaning to substitute the next argument.
2202 %s means print all objects as-is, using `princ'.
2203 %S means print all objects as s-expressions, using `prin1'.
2204 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
2206 %c means print as a single character.
2207 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2208 %e or %E means print as a floating-point number in scientific notation
2210 %g or %G means print as a floating-point number in "pretty format";
2211 depending on the number, either %f or %e/%E format will be used, and
2212 trailing zeroes are removed from the fractional part.
2213 The argument used for all but %s and %S must be a number. It will be
2214 converted to an integer or a floating-point number as necessary.
2216 %$ means reposition to read a specific numbered argument; for example,
2217 %3$s would apply the `%s' to the third argument after the control string,
2218 and the next format directive would use the fourth argument, the
2219 following one the fifth argument, etc. (There must be a positive integer
2220 between the % and the $).
2221 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2222 specified between the optional repositioning spec and the conversion
2223 character; see below.
2224 An optional minimum field width may be specified after any flag characters
2225 and before the conversion character; it specifies the minimum number of
2226 characters that the converted argument will take up. Padding will be
2227 added on the left (or on the right, if the `-' flag is specified), as
2228 necessary. Padding is done with spaces, or with zeroes if the `0' flag
2230 If the field width is specified as `*', the field width is assumed to have
2231 been specified as an argument. Any repositioning specification that
2232 would normally specify the argument to be converted will now specify
2233 where to find this field width argument, not where to find the argument
2234 to be converted. If there is no repositioning specification, the normal
2235 next argument is used. The argument to be converted will be the next
2236 argument after the field width argument unless the precision is also
2237 specified as `*' (see below).
2239 An optional period character and precision may be specified after any
2240 minimum field width. It specifies the minimum number of digits to
2241 appear in %d, %i, %o, %x, and %X conversions (the number is padded
2242 on the left with zeroes as necessary); the number of digits printed
2243 after the decimal point for %f, %e, and %E conversions; the number
2244 of significant digits printed in %g and %G conversions; and the
2245 maximum number of non-padding characters printed in %s and %S
2246 conversions. The default precision for floating-point conversions
2248 If the precision is specified as `*', the precision is assumed to have been
2249 specified as an argument. The argument used will be the next argument
2250 after the field width argument, if any. If the field width was not
2251 specified as an argument, any repositioning specification that would
2252 normally specify the argument to be converted will now specify where to
2253 find the precision argument. If there is no repositioning specification,
2254 the normal next argument is used.
2256 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2257 plus sign, respectively.
2258 The `#' flag means print numbers in an alternate, more verbose format:
2259 octal numbers begin with zero; hex numbers begin with a 0x or 0X;
2260 a decimal point is printed in %f, %e, and %E conversions even if no
2261 numbers are printed after it; and trailing zeroes are not omitted in
2262 %g and %G conversions.
2264 Use %% to put a single % into the output.
2266 (int nargs, Lisp_Object *args))
2268 /* It should not be necessary to GCPRO ARGS, because
2269 the caller in the interpreter should take care of that. */
2271 CHECK_STRING (args[0]);
2272 return emacs_doprnt_string_lisp (0, args[0], 0, nargs - 1, args + 1);
2276 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
2277 Return t if two characters match, optionally ignoring case.
2278 Both arguments must be characters (i.e. NOT integers).
2279 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2280 If BUFFER is nil, the current buffer is assumed.
2282 (character1, character2, buffer))
2285 struct buffer *b = decode_buffer (buffer, 1);
2287 CHECK_CHAR_COERCE_INT (character1);
2288 CHECK_CHAR_COERCE_INT (character2);
2289 x1 = XCHAR (character1);
2290 x2 = XCHAR (character2);
2292 return (!NILP (b->case_fold_search)
2293 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
2298 DEFUN ("char=", Fchar_Equal, 2, 2, 0, /*
2299 Return t if two characters match, case is significant.
2300 Both arguments must be characters (i.e. NOT integers).
2302 (character1, character2))
2304 CHECK_CHAR_COERCE_INT (character1);
2305 CHECK_CHAR_COERCE_INT (character2);
2307 return EQ (character1, character2) ? Qt : Qnil;
2310 #if 0 /* Undebugged FSFmacs code */
2311 /* Transpose the markers in two regions of the current buffer, and
2312 adjust the ones between them if necessary (i.e.: if the regions
2315 Traverses the entire marker list of the buffer to do so, adding an
2316 appropriate amount to some, subtracting from some, and leaving the
2317 rest untouched. Most of this is copied from adjust_markers in insdel.c.
2319 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
2322 transpose_markers (Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2324 Charcount amt1, amt2, diff;
2326 struct buffer *buf = current_buffer;
2328 /* Update point as if it were a marker. */
2329 if (BUF_PT (buf) < start1)
2331 else if (BUF_PT (buf) < end1)
2332 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
2333 else if (BUF_PT (buf) < start2)
2334 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
2335 else if (BUF_PT (buf) < end2)
2336 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
2338 /* We used to adjust the endpoints here to account for the gap, but that
2339 isn't good enough. Even if we assume the caller has tried to move the
2340 gap out of our way, it might still be at start1 exactly, for example;
2341 and that places it `inside' the interval, for our purposes. The amount
2342 of adjustment is nontrivial if there's a `denormalized' marker whose
2343 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2344 the dirty work to Fmarker_position, below. */
2346 /* The difference between the region's lengths */
2347 diff = (end2 - start2) - (end1 - start1);
2349 /* For shifting each marker in a region by the length of the other
2350 * region plus the distance between the regions.
2352 amt1 = (end2 - start2) + (start2 - end1);
2353 amt2 = (end1 - start1) + (start2 - end1);
2355 for (marker = BUF_MARKERS (buf); !NILP (marker);
2356 marker = XMARKER (marker)->chain)
2358 Bufpos mpos = marker_position (marker);
2359 if (mpos >= start1 && mpos < end2)
2363 else if (mpos < start2)
2367 set_marker_position (marker, mpos);
2374 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2375 Transpose region START1 to END1 with START2 to END2.
2376 The regions may not be overlapping, because the size of the buffer is
2377 never changed in a transposition.
2379 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
2380 any markers that happen to be located in the regions. (#### BUG: currently
2381 this function always acts as if LEAVE-MARKERS is non-nil.)
2383 Transposing beyond buffer boundaries is an error.
2385 (start1, end1, start2, end2, leave_markers))
2387 Bufpos startr1, endr1, startr2, endr2;
2388 Charcount len1, len2;
2389 Lisp_Object string1, string2;
2390 struct buffer *buf = current_buffer;
2392 get_buffer_range_char (buf, start1, end1, &startr1, &endr1, 0);
2393 get_buffer_range_char (buf, start2, end2, &startr2, &endr2, 0);
2395 len1 = endr1 - startr1;
2396 len2 = endr2 - startr2;
2398 if (startr2 < endr1)
2399 error ("transposed regions not properly ordered");
2400 else if (startr1 == endr1 || startr2 == endr2)
2401 error ("transposed region may not be of length 0");
2403 string1 = make_string_from_buffer (buf, startr1, len1);
2404 string2 = make_string_from_buffer (buf, startr2, len2);
2405 buffer_delete_range (buf, startr2, endr2, 0);
2406 buffer_insert_lisp_string_1 (buf, startr2, string1, 0);
2407 buffer_delete_range (buf, startr1, endr1, 0);
2408 buffer_insert_lisp_string_1 (buf, startr1, string2, 0);
2410 /* In FSFmacs there is a whole bunch of really ugly code here
2411 to attempt to transpose the regions without using up any
2412 extra memory. Although the intent may be good, the result
2413 was highly bogus. */
2419 /************************************************************************/
2420 /* initialization */
2421 /************************************************************************/
2424 syms_of_editfns (void)
2426 defsymbol (&Qpoint, "point");
2427 defsymbol (&Qmark, "mark");
2428 defsymbol (&Qregion_beginning, "region-beginning");
2429 defsymbol (&Qregion_end, "region-end");
2430 defsymbol (&Qformat, "format");
2431 defsymbol (&Quser_files_and_directories, "user-files-and-directories");
2433 DEFSUBR (Fchar_equal);
2434 DEFSUBR (Fchar_Equal);
2435 DEFSUBR (Fgoto_char);
2436 DEFSUBR (Fstring_to_char);
2437 DEFSUBR (Fchar_to_string);
2438 DEFSUBR (Fbuffer_substring);
2439 DEFSUBR (Fbuffer_substring_no_properties);
2441 DEFSUBR (Fpoint_marker);
2442 DEFSUBR (Fmark_marker);
2444 DEFSUBR (Fregion_beginning);
2445 DEFSUBR (Fregion_end);
2446 DEFSUBR (Fsave_excursion);
2447 DEFSUBR (Fsave_current_buffer);
2449 DEFSUBR (Fbuffer_size);
2450 DEFSUBR (Fpoint_max);
2451 DEFSUBR (Fpoint_min);
2452 DEFSUBR (Fpoint_min_marker);
2453 DEFSUBR (Fpoint_max_marker);
2459 DEFSUBR (Ffollowing_char);
2460 DEFSUBR (Fpreceding_char);
2461 DEFSUBR (Fchar_after);
2462 DEFSUBR (Fchar_before);
2464 DEFSUBR (Finsert_string);
2465 DEFSUBR (Finsert_before_markers);
2466 DEFSUBR (Finsert_char);
2468 DEFSUBR (Ftemp_directory);
2469 DEFSUBR (Fuser_login_name);
2470 DEFSUBR (Fuser_real_login_name);
2471 DEFSUBR (Fuser_uid);
2472 DEFSUBR (Fuser_real_uid);
2473 DEFSUBR (Fuser_full_name);
2474 DEFSUBR (Fuser_home_directory);
2475 DEFSUBR (Femacs_pid);
2476 DEFSUBR (Fcurrent_time);
2477 DEFSUBR (Fcurrent_process_time);
2478 DEFSUBR (Fformat_time_string);
2479 DEFSUBR (Fdecode_time);
2480 DEFSUBR (Fencode_time);
2481 DEFSUBR (Fcurrent_time_string);
2482 DEFSUBR (Fcurrent_time_zone);
2483 DEFSUBR (Fset_time_zone_rule);
2484 DEFSUBR (Fsystem_name);
2487 DEFSUBR (Finsert_buffer_substring);
2488 DEFSUBR (Fcompare_buffer_substrings);
2489 DEFSUBR (Fsubst_char_in_region);
2490 DEFSUBR (Ftranslate_region);
2491 DEFSUBR (Fdelete_region);
2493 DEFSUBR (Fnarrow_to_region);
2494 DEFSUBR (Fsave_restriction);
2495 DEFSUBR (Ftranspose_regions);
2497 defsymbol (&Qzmacs_update_region, "zmacs-update-region");
2498 defsymbol (&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2499 defsymbol (&Qzmacs_region_buffer, "zmacs-region-buffer");
2503 vars_of_editfns (void)
2505 staticpro (&Vsystem_name);
2507 staticpro (&Vuser_name);
2508 staticpro (&Vuser_real_name);
2510 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
2511 *Whether LISPM-style active regions should be used.
2512 This means that commands which operate on the region (the area between the
2513 point and the mark) will only work while the region is in the ``active''
2514 state, which is indicated by highlighting. Executing most commands causes
2515 the region to not be in the active state, so (for example) \\[kill-region] will only
2516 work immediately after activating the region.
2520 - Commands which operate on the region only work if the region is active.
2521 - Only a very small set of commands cause the region to become active:
2522 Those commands whose semantics are to mark an area, like `mark-defun'.
2523 - The region is deactivated after each command that is executed, except that:
2524 - "Motion" commands do not change whether the region is active or not.
2526 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2527 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2528 between point and the recently-pushed mark to be highlighted. It will
2529 remain highlighted until some non-motion command is executed.
2531 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
2532 region and execute a command that operates on it, you can reactivate the
2533 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2536 Generally, commands which push marks as a means of navigation (like
2537 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2538 region. But commands which push marks as a means of marking an area of
2539 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2540 do activate the region.
2542 The way the command loop actually works with regard to deactivating the
2543 region is as follows:
2545 - If the variable `zmacs-region-stays' has been set to t during the command
2546 just executed, the region is left alone (this is how the motion commands
2547 make the region stay around; see the `_' flag in the `interactive'
2548 specification). `zmacs-region-stays' is reset to nil before each command
2550 - If the function `zmacs-activate-region' has been called during the command
2551 just executed, the region is left alone. Very few functions should
2552 actually call this function.
2553 - Otherwise, if the region is active, the region is deactivated and
2554 the `zmacs-deactivate-region-hook' is called.
2556 /* Zmacs style active regions are now ON by default */
2559 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
2560 Do not alter this. It is for internal use only.
2562 zmacs_region_active_p = 0;
2564 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
2565 Whether the current command will deactivate the region.
2566 Commands which do not wish to affect whether the region is currently
2567 highlighted should set this to t. Normally, the region is turned off after
2568 executing each command that did not explicitly turn it on with the function
2569 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2570 See the variable `zmacs-regions'.
2572 The same effect can be achieved using the `_' interactive specification.
2574 `zmacs-region-stays' is reset to nil before each command is executed.
2576 zmacs_region_stays = 0;
2578 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2579 Do not use this -- it will be going away soon.
2580 Indicates if `goto-char' has just been run. This information is allegedly
2581 needed to get the desired behavior for atomic extents and unfortunately
2582 is not available by any other means.
2584 atomic_extent_goto_char_p = 0;
2585 #ifdef AMPERSAND_FULL_NAME
2586 Fprovide(intern("ampersand-full-name"));
2589 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
2590 *The name of the user.
2591 The function `user-full-name', which will return the value of this
2592 variable, when called without arguments.
2593 This is initialized to the value of the NAME environment variable.
2595 /* Initialized at run-time. */
2596 Vuser_full_name = Qnil;