update.
[chise/xemacs-chise.git-] / src / editfns.c
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.
5
6 This file is part of XEmacs.
7
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
11 later version.
12
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
16 for more details.
17
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.  */
22
23 /* Synched up with: Mule 2.0, FSF 19.30. */
24
25 /* This file has been Mule-ized. */
26
27 /* Hacked on for Mule by Ben Wing, December 1994. */
28
29 #include <config.h>
30 #include "lisp.h"
31
32 #include "buffer.h"
33 #include "commands.h"
34 #include "events.h"             /* for EVENTP */
35 #include "extents.h"
36 #include "frame.h"
37 #include "insdel.h"
38 #include "window.h"
39 #include "casetab.h"
40 #include "chartab.h"
41 #include "line-number.h"
42
43 #include "systime.h"
44 #include "sysdep.h"
45 #include "syspwd.h"
46 #include "sysfile.h"                    /* for getcwd */
47
48 /* Some static data, and a function to initialize it for each run */
49
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.  */
60 #endif
61
62 /* It's useful to be able to set this as user customization, so we'll
63    keep it. */
64 Lisp_Object Vuser_full_name;
65 EXFUN (Fuser_full_name, 1);
66
67 Lisp_Object Qformat;
68
69 Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
70
71 Lisp_Object Quser_files_and_directories;
72
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;
77
78 void
79 init_editfns (void)
80 {
81 /* Only used in removed code below. */
82   char *p;
83
84   environbuf = 0;
85
86   /* Set up system_name even when dumping.  */
87   init_system_name ();
88
89 #ifndef CANNOT_DUMP
90   if (!initialized)
91     return;
92 #endif
93
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);
98   else
99     Vuser_full_name = Fuser_full_name (Qnil);
100 }
101 \f
102 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
103 Convert CHARACTER to a one-character string containing that character.
104 */
105        (character))
106 {
107   Bytecount len;
108   Bufbyte str[MAX_EMCHAR_LEN];
109
110   if (EVENTP (character))
111     {
112       Lisp_Object ch2 = Fevent_to_character (character, Qt, Qnil, Qnil);
113       if (NILP (ch2))
114         return
115           signal_simple_continuable_error
116             ("character has no ASCII equivalent:", Fcopy_event (character, Qnil));
117       character = ch2;
118     }
119
120   CHECK_CHAR_COERCE_INT (character);
121
122   len = set_charptr_emchar (str, XCHAR (character));
123   return make_string (str, len);
124 }
125
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'.
129 */
130        (string))
131 {
132   Lisp_String *p;
133   CHECK_STRING (string);
134
135   p = XSTRING (string);
136   if (string_length (p) != 0)
137     return make_char (string_char (p, 0));
138   else
139     /* This used to return Qzero.  That is broken, broken, broken. */
140     /* It might be kinder to signal an error directly. -slb */
141     return Qnil;
142 }
143
144 \f
145 static Lisp_Object
146 buildmark (Bufpos val, Lisp_Object buffer)
147 {
148   Lisp_Object mark = Fmake_marker ();
149   Fset_marker (mark, make_int (val), buffer);
150   return mark;
151 }
152
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.
157 */
158        (buffer))
159 {
160   struct buffer *b = decode_buffer (buffer, 1);
161   return make_int (BUF_PT (b));
162 }
163
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.
171 */
172        (dont_copy_p, buffer))
173 {
174   struct buffer *b = decode_buffer (buffer, 1);
175   if (NILP (dont_copy_p))
176     return Fcopy_marker (b->point_marker, Qnil);
177   else
178     return b->point_marker;
179 }
180
181 /* The following two functions end up being identical but it's
182    cleaner to declare them separately. */
183
184 Bufpos
185 bufpos_clip_to_bounds (Bufpos lower, Bufpos num, Bufpos upper)
186 {
187   return (num < lower ? lower :
188           num > upper ? upper :
189           num);
190 }
191
192 Bytind
193 bytind_clip_to_bounds (Bytind lower, Bytind num, Bytind upper)
194 {
195   return (num < lower ? lower :
196           num > upper ? upper :
197           num);
198 }
199
200 /*
201  * Chuck says:
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
205  * added for now.
206  *
207  * Jamie thinks he's wrong, but we'll leave this in for now.
208  */
209 int atomic_extent_goto_char_p;
210
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.
216 */
217        (position, buffer))
218 {
219   struct buffer *b = decode_buffer (buffer, 1);
220   Bufpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE);
221   BUF_SET_PT (b, n);
222   atomic_extent_goto_char_p = 1;
223   return make_int (n);
224 }
225
226 static Lisp_Object
227 region_limit (int beginningp, struct buffer *b)
228 {
229   Lisp_Object m;
230
231 #if 0 /* FSFmacs */
232   if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
233       && NILP (b->mark_active))
234     Fsignal (Qmark_inactive, Qnil);
235 #endif
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));
240   else
241     return m;
242 }
243
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.
247 */
248        (buffer))
249 {
250   return region_limit (1, decode_buffer (buffer, 1));
251 }
252
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.
256 */
257        (buffer))
258 {
259   return region_limit (0, decode_buffer (buffer, 1));
260 }
261
262 /* Whether to use lispm-style active-regions */
263 int zmacs_regions;
264
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;
270
271 int zmacs_region_stays;
272
273 Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region;
274 Lisp_Object Qzmacs_region_buffer;
275
276 void
277 zmacs_update_region (void)
278 {
279   /* This function can GC */
280   if (zmacs_region_active_p)
281     call0 (Qzmacs_update_region);
282 }
283
284 void
285 zmacs_deactivate_region (void)
286 {
287   /* This function can GC */
288   if (zmacs_region_active_p)
289     call0 (Qzmacs_deactivate_region);
290 }
291
292 Lisp_Object
293 zmacs_region_buffer (void)
294 {
295   if (zmacs_region_active_p)
296     return call0 (Qzmacs_region_buffer);
297   else
298     return Qnil;
299 }
300
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.
311 */
312        (force, buffer))
313 {
314   struct buffer *b = decode_buffer (buffer, 1);
315   if (! zmacs_regions || zmacs_region_active_p || !NILP (force))
316     return b->mark;
317   return Qnil;
318 }
319
320 \f
321 /* The saved object is a cons:
322
323    (COPY-OF-POINT-MARKER . COPY-OF-MARK)
324
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 */
328 Lisp_Object
329 save_excursion_save (void)
330 {
331   struct buffer *b;
332
333   /* #### Huh?  --hniksic */
334   /*if (preparing_for_armageddon) return Qnil;*/
335
336 #ifdef ERROR_CHECK_BUFPOS
337   assert (XINT (Fpoint (Qnil)) ==
338           XINT (Fmarker_position (Fpoint_marker (Qt, Qnil))));
339 #endif
340
341   b = current_buffer;
342
343   return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil),
344                        noseeum_copy_marker (b->mark, Qnil));
345 }
346
347 Lisp_Object
348 save_excursion_restore (Lisp_Object info)
349 {
350   Lisp_Object buffer = Fmarker_buffer (XCAR (info));
351
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.  */
355   if (!NILP (buffer))
356     {
357       struct buffer *buf = XBUFFER (buffer);
358       struct gcpro gcpro1;
359       GCPRO1 (info);
360       set_buffer_internal (buf);
361       Fgoto_char (XCAR (info), buffer);
362       Fset_marker (buf->mark, XCDR (info), buffer);
363
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
371          now.  --hniksic */
372       if (visible
373           && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
374         switch_to_buffer (Fcurrent_buffer (), Qnil);
375 #endif
376
377       UNGCPRO;
378     }
379
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));
385   return Qnil;
386 }
387
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).
393 */
394        (args))
395 {
396   /* This function can GC */
397   int speccount = specpdl_depth ();
398
399   record_unwind_protect (save_excursion_restore, save_excursion_save ());
400
401   return unbind_to (speccount, Fprogn (args));
402 }
403
404 Lisp_Object
405 save_current_buffer_restore (Lisp_Object buffer)
406 {
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);
412   return Qnil;
413 }
414
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'.
418 */
419        (args))
420 {
421   /* This function can GC */
422   int speccount = specpdl_depth ();
423
424   record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ());
425
426   return unbind_to (speccount, Fprogn (args));
427 }
428 \f
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.
432 */
433        (buffer))
434 {
435   struct buffer *b = decode_buffer (buffer, 1);
436   return make_int (BUF_SIZE (b));
437 }
438
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.
444 */
445        (buffer))
446 {
447   struct buffer *b = decode_buffer (buffer, 1);
448   return make_int (BUF_BEGV (b));
449 }
450
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.
456 */
457        (buffer))
458 {
459   struct buffer *b = decode_buffer (buffer, 1);
460   return buildmark (BUF_BEGV (b), make_buffer (b));
461 }
462
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.
468 */
469        (buffer))
470 {
471   struct buffer *b = decode_buffer (buffer, 1);
472   return make_int (BUF_ZV (b));
473 }
474
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.
480 */
481        (buffer))
482 {
483   struct buffer *b = decode_buffer (buffer, 1);
484   return buildmark (BUF_ZV (b), make_buffer (b));
485 }
486
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.
491 */
492        (buffer))
493 {
494   struct buffer *b = decode_buffer (buffer, 1);
495   if (BUF_PT (b) >= BUF_ZV (b))
496     return Qzero;             /* #### Gag me! */
497   else
498     return make_char (BUF_FETCH_CHAR (b, BUF_PT (b)));
499 }
500
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.
505 */
506        (buffer))
507 {
508   struct buffer *b = decode_buffer (buffer, 1);
509   if (BUF_PT (b) <= BUF_BEGV (b))
510     return Qzero;             /* #### Gag me! */
511   else
512     return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1));
513 }
514
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.
519 */
520        (buffer))
521 {
522   struct buffer *b = decode_buffer (buffer, 1);
523   return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil;
524 }
525
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.
530 */
531        (buffer))
532 {
533   struct buffer *b = decode_buffer (buffer, 1);
534   return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil;
535 }
536
537 int
538 beginning_of_line_p (struct buffer *b, Bufpos pt)
539 {
540   return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n';
541 }
542
543
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.
547 */
548        (buffer))
549 {
550   struct buffer *b = decode_buffer (buffer, 1);
551   return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
552 }
553
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.
558 */
559        (buffer))
560 {
561   struct buffer *b = decode_buffer (buffer, 1);
562   return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n')
563     ? Qt : Qnil;
564 }
565
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.
572 */
573        (pos, buffer))
574 {
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));
578
579   if (n < 0 || n == BUF_ZV (b))
580     return Qnil;
581   return make_char (BUF_FETCH_CHAR (b, n));
582 }
583
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.
590 */
591        (pos, buffer))
592 {
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));
596
597   n--;
598
599   if (n < BUF_BEGV (b))
600     return Qnil;
601   return make_char (BUF_FETCH_CHAR (b, n));
602 }
603
604 #if !defined(WINDOWSNT) && !defined(MSDOS)
605 #include <sys/stat.h>
606 #include <fcntl.h>
607 #include <errno.h>
608 #include <limits.h>
609 #endif
610 \f
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.
616 */
617        ())
618 {
619   char *tmpdir;
620 #if defined(WIN32_NATIVE)
621   tmpdir = getenv ("TEMP");
622   if (!tmpdir)
623     tmpdir = getenv ("TMP");
624   if (!tmpdir)
625     tmpdir = "/";
626 #else /* WIN32_NATIVE */
627  tmpdir = getenv ("TMPDIR");
628  if (!tmpdir)
629     {
630       struct stat st;
631       int myuid = getuid();
632       static char path[5 /* strlen ("/tmp/") */ + 1 + _POSIX_PATH_MAX];
633
634       strcpy (path, "/tmp/");
635       strncat (path, user_login_name (NULL), _POSIX_PATH_MAX);
636       if (lstat(path, &st) < 0 && errno == ENOENT)
637         {
638           mkdir(path, 0700);    /* ignore retval -- checked next anyway. */
639         }
640       if (lstat(path, &st) == 0 && st.st_uid == (uid_t) myuid &&
641           S_ISDIR(st.st_mode))
642         {
643           tmpdir = path;
644         }
645       else
646         {
647           strcpy(path, getenv("HOME")); strncat(path, "/tmp/", _POSIX_PATH_MAX);
648           if (stat(path, &st) < 0 && errno == ENOENT)
649             {
650               int fd;
651               char warnpath[1+_POSIX_PATH_MAX];
652               mkdir(path, 0700);        /* ignore retvals */
653               strcpy(warnpath, path);
654               strncat(warnpath, ".created_by_xemacs", _POSIX_PATH_MAX);
655               if ((fd = open(warnpath, O_WRONLY|O_CREAT, 0644)) > 0)
656                 {
657                   write(fd, "XEmacs created this directory because /tmp/<yourname> was unavailable -- \nPlease check !\n", 89);
658                   close(fd);
659                 }
660             }
661           if (stat(path, &st) == 0 && S_ISDIR(st.st_mode))
662             {
663               tmpdir = path;
664             }
665           else
666             {
667    tmpdir = "/tmp";
668             }
669         }
670     }
671 #endif
672
673   return build_ext_string (tmpdir, Qfile_name);
674 }
675
676 DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
677 Return the name under which the user logged in, as a string.
678 This is based on the effective uid, not the real uid.
679 Also, if the environment variable LOGNAME or USER is set,
680 that determines the value of this function.
681 If the optional argument UID is present, then environment variables are
682 ignored and this function returns the login name for that UID, or nil.
683 */
684        (uid))
685 {
686   char *returned_name;
687   uid_t local_uid;
688
689   if (!NILP (uid))
690     {
691       CHECK_INT (uid);
692       local_uid = XINT (uid);
693       returned_name = user_login_name (&local_uid);
694     }
695   else
696     {
697       returned_name = user_login_name (NULL);
698     }
699   /* #### - I believe this should return nil instead of "unknown" when pw==0
700      pw=0 is indicated by a null return from user_login_name
701   */
702   return returned_name ? build_string (returned_name) : Qnil;
703 }
704
705 /* This function may be called from other C routines when a
706    character string representation of the user_login_name is
707    needed but a Lisp Object is not.  The UID is passed by
708    reference.  If UID == NULL, then the USER name
709    for the user running XEmacs will be returned.  This
710    corresponds to a nil argument to Fuser_login_name.
711 */
712 char*
713 user_login_name (uid_t *uid)
714 {
715   /* uid == NULL to return name of this user */
716   if (uid != NULL)
717     {
718       struct passwd *pw = getpwuid (*uid);
719       return pw ? pw->pw_name : NULL;
720     }
721   else
722     {
723       /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
724          old environment (I site observed behavior on sunos and linux), so the
725          environment variables should be disregarded in that case.  --Stig */
726       char *user_name = getenv ("LOGNAME");
727       if (!user_name)
728         user_name = getenv (
729 #ifdef WIN32_NATIVE
730                             "USERNAME" /* it's USERNAME on NT */
731 #else
732                             "USER"
733 #endif
734                             );
735       if (user_name)
736         return (user_name);
737       else
738         {
739           struct passwd *pw = getpwuid (geteuid ());
740 #ifdef CYGWIN
741           /* Since the Cygwin environment may not have an /etc/passwd,
742              return "unknown" instead of the null if the username
743              cannot be determined.
744           */
745           return pw ? pw->pw_name : "unknown";
746 #else
747           /* For all but Cygwin return NULL (nil) */
748           return pw ? pw->pw_name : NULL;
749 #endif
750         }
751     }
752 }
753
754 DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
755 Return the name of the user's real uid, as a string.
756 This ignores the environment variables LOGNAME and USER, so it differs from
757 `user-login-name' when running under `su'.
758 */
759        ())
760 {
761   struct passwd *pw = getpwuid (getuid ());
762   /* #### - I believe this should return nil instead of "unknown" when pw==0 */
763
764   Lisp_Object tem = build_string (pw ? pw->pw_name : "unknown");/* no gettext */
765   return tem;
766 }
767
768 DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /*
769 Return the effective uid of Emacs, as an integer.
770 */
771        ())
772 {
773   return make_int (geteuid ());
774 }
775
776 DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
777 Return the real uid of Emacs, as an integer.
778 */
779        ())
780 {
781   return make_int (getuid ());
782 }
783
784 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
785 Return the full name of the user logged in, as a string.
786 If the optional argument USER is given, then the full name for that
787 user is returned, or nil.  USER may be either a login name or a uid.
788
789 If USER is nil, and `user-full-name' contains a string, the
790 value of `user-full-name' is returned.
791 */
792        (user))
793 {
794   Lisp_Object user_name;
795   struct passwd *pw = NULL;
796   Lisp_Object tem;
797   const char *p, *q;
798
799   if (NILP (user) && STRINGP (Vuser_full_name))
800     return Vuser_full_name;
801
802   user_name = (STRINGP (user) ? user : Fuser_login_name (user));
803   if (!NILP (user_name))        /* nil when nonexistent UID passed as arg */
804     {
805       const char *user_name_ext;
806
807       /* Fuck me.  getpwnam() can call select() and (under IRIX at least)
808          things get wedged if a SIGIO arrives during this time. */
809       TO_EXTERNAL_FORMAT (LISP_STRING, user_name,
810                           C_STRING_ALLOCA, user_name_ext,
811                           Qnative);
812       slow_down_interrupts ();
813       pw = (struct passwd *) getpwnam (user_name_ext);
814       speed_up_interrupts ();
815     }
816
817   /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
818   /* Ben sez: bad idea because it's likely to break something */
819 #ifndef AMPERSAND_FULL_NAME
820   p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
821   q = strchr (p, ',');
822 #else
823   p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
824   q = strchr (p, ',');
825 #endif
826   tem = ((!NILP (user) && !pw)
827          ? Qnil
828          : make_ext_string ((Extbyte *) p, (q ? q - p : (int) strlen (p)),
829                             Qnative));
830
831 #ifdef AMPERSAND_FULL_NAME
832   if (!NILP (tem))
833     {
834       p = (char *) XSTRING_DATA (tem);
835       q = strchr (p, '&');
836       /* Substitute the login name for the &, upcasing the first character.  */
837       if (q)
838         {
839           char *r = (char *) alloca (strlen (p) + XSTRING_LENGTH (user_name) + 1);
840           memcpy (r, p, q - p);
841           r[q - p] = 0;
842           strcat (r, (char *) XSTRING_DATA (user_name));
843           /* #### current_buffer dependency! */
844           r[q - p] = UPCASE (current_buffer, r[q - p]);
845           strcat (r, q + 1);
846           tem = build_string (r);
847         }
848     }
849 #endif /* AMPERSAND_FULL_NAME */
850
851   return tem;
852 }
853
854 static Extbyte *cached_home_directory;
855
856 void
857 uncache_home_directory (void)
858 {
859   cached_home_directory = NULL; /* in some cases, this may cause the leaking
860                                    of a few bytes */
861 }
862
863 /* !!#### not Mule correct. */
864
865 /* Returns the home directory, in external format */
866 Extbyte *
867 get_home_directory (void)
868 {
869   /* !!#### this is hopelessly bogus.  Rule #1: Do not make any assumptions
870      about what format an external string is in.  Could be Unicode, for all
871      we know, and then all the operations below are totally bogus.
872      Instead, convert all data to internal format *right* at the juncture
873      between XEmacs and the outside world, the very moment we first get
874      the data.  --ben */
875   int output_home_warning = 0;
876
877   if (cached_home_directory == NULL)
878     {
879       if ((cached_home_directory = (Extbyte *) getenv("HOME")) == NULL)
880         {
881 #if defined(WIN32_NATIVE)
882           char *homedrive, *homepath;
883
884           if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
885               (homepath = getenv("HOMEPATH")) != NULL)
886             {
887               cached_home_directory =
888                 (Extbyte *) xmalloc (strlen (homedrive) +
889                                      strlen (homepath) + 1);
890               sprintf((char *) cached_home_directory, "%s%s",
891                       homedrive,
892                       homepath);
893             }
894           else
895             {
896 # if 0 /* changed by ben.  This behavior absolutely stinks, and the
897           possibility being addressed here occurs quite commonly.
898           Using the current directory makes absolutely no sense. */
899               /*
900                * Use the current directory.
901                * This preserves the existing XEmacs behavior, but is different
902                * from NT Emacs.
903                */
904               if (initial_directory[0] != '\0')
905                 {
906                   cached_home_directory = (Extbyte*) initial_directory;
907                 }
908               else
909                 {
910                   /* This will probably give the wrong value */
911                   cached_home_directory = (Extbyte*) getcwd (NULL, 0);
912                 }
913 # else
914               /*
915                * This is NT Emacs behavior
916                */
917               cached_home_directory = (Extbyte *) "C:\\";
918               output_home_warning = 1;
919 # endif
920             }
921 #else   /* !WIN32_NATIVE */
922           /*
923            * Unix, typically.
924            * Using "/" isn't quite right, but what should we do?
925            * We probably should try to extract pw_dir from /etc/passwd,
926            * before falling back to this.
927            */
928           cached_home_directory = (Extbyte *) "/";
929           output_home_warning = 1;
930 #endif  /* !WIN32_NATIVE */
931         }
932       if (initialized && output_home_warning)
933         {
934           warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
935 "       XEmacs was unable to determine a good value for the user's $HOME\n"
936 "       directory, and will be using the value:\n"
937 "               %s\n"
938 "       This is probably incorrect.",
939                           cached_home_directory
940                           );
941         }
942     }
943   return cached_home_directory;
944 }
945
946 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
947 Return the user's home directory, as a string.
948 */
949        ())
950 {
951   Extbyte *path = get_home_directory ();
952
953   return path == NULL ? Qnil :
954     Fexpand_file_name (Fsubstitute_in_file_name
955                        (build_ext_string ((char *) path, Qfile_name)),
956                        Qnil);
957 }
958
959 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
960 Return the name of the machine you are running on, as a string.
961 */
962        ())
963 {
964     return Fcopy_sequence (Vsystem_name);
965 }
966
967 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
968 Return the process ID of Emacs, as an integer.
969 */
970        ())
971 {
972   return make_int (getpid ());
973 }
974
975 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
976 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
977 The time is returned as a list of three integers.  The first has the
978 most significant 16 bits of the seconds, while the second has the
979 least significant 16 bits.  The third integer gives the microsecond
980 count.
981
982 The microsecond count is zero on systems that do not provide
983 resolution finer than a second.
984 */
985        ())
986 {
987   EMACS_TIME t;
988
989   EMACS_GET_TIME (t);
990   return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
991                 make_int ((EMACS_SECS (t) >> 0)  & 0xffff),
992                 make_int (EMACS_USECS (t)));
993 }
994
995 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
996 Return the amount of time used by this XEmacs process so far.
997 The return value is a list of three floating-point numbers, expressing
998 the user, system, and real times used by the process.  The user time
999 measures the time actually spent by the CPU executing the code in this
1000 process.  The system time measures time spent by the CPU executing kernel
1001 code on behalf of this process (e.g. I/O requests made by the process).
1002
1003 Note that the user and system times measure processor time, as opposed
1004 to real time, and only accrue when the processor is actually doing
1005 something: Time spent in an idle wait (waiting for user events to come
1006 in or for I/O on a disk drive or other device to complete) does not
1007 count.  Thus, the user and system times will often be considerably
1008 less than the real time.
1009
1010 Some systems do not allow the user and system times to be distinguished.
1011 In this case, the user time will be the total processor time used by
1012 the process, and the system time will be 0.
1013
1014 Some systems do not allow the real and processor times to be distinguished.
1015 In this case, the user and real times will be the same and the system
1016 time will be 0.
1017 */
1018        ())
1019 {
1020   double user, sys, real;
1021
1022   get_process_times (&user, &sys, &real);
1023   return list3 (make_float (user), make_float (sys), make_float (real));
1024 }
1025
1026 \f
1027 int lisp_to_time (Lisp_Object specified_time, time_t *result);
1028 int
1029 lisp_to_time (Lisp_Object specified_time, time_t *result)
1030 {
1031   Lisp_Object high, low;
1032
1033   if (NILP (specified_time))
1034     return time (result) != -1;
1035
1036   CHECK_CONS (specified_time);
1037   high = XCAR (specified_time);
1038   low  = XCDR (specified_time);
1039   if (CONSP (low))
1040     low = XCAR (low);
1041   CHECK_INT (high);
1042   CHECK_INT (low);
1043   *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
1044   return *result >> 16 == XINT (high);
1045 }
1046
1047 Lisp_Object time_to_lisp (time_t the_time);
1048 Lisp_Object
1049 time_to_lisp (time_t the_time)
1050 {
1051   unsigned int item = (unsigned int) the_time;
1052   return Fcons (make_int (item >> 16), make_int (item & 0xffff));
1053 }
1054
1055 size_t emacs_strftime (char *string, size_t max, const char *format,
1056                        const struct tm *tm);
1057 static long difftm (const struct tm *a, const struct tm *b);
1058
1059
1060 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
1061 Use FORMAT-STRING to format the time TIME.
1062 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
1063 `current-time' and `file-attributes'.  If TIME is not specified it
1064 defaults to the current time.
1065 FORMAT-STRING may contain %-sequences to substitute parts of the time.
1066 %a is replaced by the abbreviated name of the day of week.
1067 %A is replaced by the full name of the day of week.
1068 %b is replaced by the abbreviated name of the month.
1069 %B is replaced by the full name of the month.
1070 %c is a synonym for "%x %X".
1071 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
1072 %d is replaced by the day of month, zero-padded.
1073 %D is a synonym for "%m/%d/%y".
1074 %e is replaced by the day of month, blank-padded.
1075 %h is a synonym for "%b".
1076 %H is replaced by the hour (00-23).
1077 %I is replaced by the hour (00-12).
1078 %j is replaced by the day of the year (001-366).
1079 %k is replaced by the hour (0-23), blank padded.
1080 %l is replaced by the hour (1-12), blank padded.
1081 %m is replaced by the month (01-12).
1082 %M is replaced by the minute (00-59).
1083 %n is a synonym for "\\n".
1084 %p is replaced by AM or PM, as appropriate.
1085 %r is a synonym for "%I:%M:%S %p".
1086 %R is a synonym for "%H:%M".
1087 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
1088       nonstandard extension)
1089 %S is replaced by the second (00-60).
1090 %t is a synonym for "\\t".
1091 %T is a synonym for "%H:%M:%S".
1092 %U is replaced by the week of the year (00-53), first day of week is Sunday.
1093 %w is replaced by the day of week (0-6), Sunday is day 0.
1094 %W is replaced by the week of the year (00-53), first day of week is Monday.
1095 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
1096 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
1097 %y is replaced by the year without century (00-99).
1098 %Y is replaced by the year with century.
1099 %Z is replaced by the time zone abbreviation.
1100
1101 The number of options reflects the `strftime' function.
1102
1103 BUG: If the charset used by the current locale is not ISO 8859-1, the
1104 characters appearing in the day and month names may be incorrect.
1105 */
1106        (format_string, time_))
1107 {
1108   time_t value;
1109   size_t size;
1110   struct tm * tm;
1111
1112   CHECK_STRING (format_string);
1113
1114   if (! lisp_to_time (time_, &value) || ! (tm = localtime (&value)))
1115     error ("Invalid time specification");
1116
1117   /* This is probably enough.  */
1118   size = XSTRING_LENGTH (format_string) * 6 + 50;
1119
1120   while (1)
1121     {
1122       char *buf = (char *) alloca (size);
1123       *buf = 1;
1124       if (emacs_strftime (buf, size,
1125                           (const char *) XSTRING_DATA (format_string),
1126                           tm)
1127           || !*buf)
1128         return build_ext_string (buf, Qbinary);
1129       /* If buffer was too small, make it bigger.  */
1130       size *= 2;
1131     }
1132 }
1133
1134 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
1135 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
1136 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
1137 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
1138 to use the current time.  The list has the following nine members:
1139 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
1140 only some operating systems support.  MINUTE is an integer between 0 and 59.
1141 HOUR is an integer between 0 and 23.  DAY is an integer between 1 and 31.
1142 MONTH is an integer between 1 and 12.  YEAR is an integer indicating the
1143 four-digit year.  DOW is the day of week, an integer between 0 and 6, where
1144 0 is Sunday.  DST is t if daylight savings time is effect, otherwise nil.
1145 ZONE is an integer indicating the number of seconds east of Greenwich.
1146 \(Note that Common Lisp has different meanings for DOW and ZONE.)
1147 */
1148        (specified_time))
1149 {
1150   time_t time_spec;
1151   struct tm save_tm;
1152   struct tm *decoded_time;
1153   Lisp_Object list_args[9];
1154
1155   if (! lisp_to_time (specified_time, &time_spec)
1156       || ! (decoded_time = localtime (&time_spec)))
1157     error ("Invalid time specification");
1158
1159   list_args[0] = make_int (decoded_time->tm_sec);
1160   list_args[1] = make_int (decoded_time->tm_min);
1161   list_args[2] = make_int (decoded_time->tm_hour);
1162   list_args[3] = make_int (decoded_time->tm_mday);
1163   list_args[4] = make_int (decoded_time->tm_mon + 1);
1164   list_args[5] = make_int (decoded_time->tm_year + 1900);
1165   list_args[6] = make_int (decoded_time->tm_wday);
1166   list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
1167
1168   /* Make a copy, in case gmtime modifies the struct.  */
1169   save_tm = *decoded_time;
1170   decoded_time = gmtime (&time_spec);
1171   if (decoded_time == 0)
1172     list_args[8] = Qnil;
1173   else
1174     list_args[8] = make_int (difftm (&save_tm, decoded_time));
1175   return Flist (9, list_args);
1176 }
1177
1178 static void set_time_zone_rule (char *tzstring);
1179
1180 /* from GNU Emacs 21, per Simon Josefsson, modified by stephen
1181    The slight inefficiency is justified since negative times are weird. */
1182 Lisp_Object
1183 make_time (time_t tval)
1184 {
1185   return list2 (make_int (tval < 0 ? tval / 0x10000 : tval >> 16),
1186                 make_int (tval & 0xFFFF));
1187 }
1188
1189 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
1190   Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
1191 This is the reverse operation of `decode-time', which see.
1192 ZONE defaults to the current time zone rule.  This can
1193 be a string (as from `set-time-zone-rule'), or it can be a list
1194 \(as from `current-time-zone') or an integer (as from `decode-time')
1195 applied without consideration for daylight savings time.
1196
1197 You can pass more than 7 arguments; then the first six arguments
1198 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
1199 The intervening arguments are ignored.
1200 This feature lets (apply 'encode-time (decode-time ...)) work.
1201
1202 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
1203 for example, a DAY of 0 means the day preceding the given month.
1204 Year numbers less than 100 are treated just like other year numbers.
1205 If you want them to stand for years in this century, you must do that yourself.
1206 */
1207        (int nargs, Lisp_Object *args))
1208 {
1209   time_t the_time;
1210   struct tm tm;
1211   Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
1212
1213   CHECK_INT (*args); tm.tm_sec  = XINT (*args++);       /* second */
1214   CHECK_INT (*args); tm.tm_min  = XINT (*args++);       /* minute */
1215   CHECK_INT (*args); tm.tm_hour = XINT (*args++);       /* hour */
1216   CHECK_INT (*args); tm.tm_mday = XINT (*args++);       /* day */
1217   CHECK_INT (*args); tm.tm_mon  = XINT (*args++) - 1;   /* month */
1218   CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
1219
1220   tm.tm_isdst = -1;
1221
1222   if (CONSP (zone))
1223     zone = XCAR (zone);
1224   if (NILP (zone))
1225     the_time = mktime (&tm);
1226   else
1227     {
1228       char tzbuf[100];
1229       char *tzstring;
1230       char **oldenv = environ, **newenv;
1231
1232       if (STRINGP (zone))
1233         tzstring = (char *) XSTRING_DATA (zone);
1234       else if (INTP (zone))
1235         {
1236           int abszone = abs (XINT (zone));
1237           sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
1238                    abszone / (60*60), (abszone/60) % 60, abszone % 60);
1239           tzstring = tzbuf;
1240         }
1241       else
1242         error ("Invalid time zone specification");
1243
1244       /* Set TZ before calling mktime; merely adjusting mktime's returned
1245          value doesn't suffice, since that would mishandle leap seconds.  */
1246       set_time_zone_rule (tzstring);
1247
1248       the_time = mktime (&tm);
1249
1250       /* Restore TZ to previous value.  */
1251       newenv = environ;
1252       environ = oldenv;
1253       free (newenv);
1254 #ifdef LOCALTIME_CACHE
1255       tzset ();
1256 #endif
1257     }
1258
1259   if (the_time == (time_t) -1)
1260     error ("Specified time is not representable");
1261
1262   return make_time (the_time);
1263 }
1264
1265 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
1266 Return the current time, as a human-readable string.
1267 Programs can use this function to decode a time,
1268 since the number of columns in each field is fixed.
1269 The format is `Sun Sep 16 01:03:52 1973'.
1270 If an argument is given, it specifies a time to format
1271 instead of the current time.  The argument should have the form:
1272   (HIGH . LOW)
1273 or the form:
1274   (HIGH LOW . IGNORED).
1275 Thus, you can use times obtained from `current-time'
1276 and from `file-attributes'.
1277 */
1278        (specified_time))
1279 {
1280   time_t value;
1281   char *the_ctime;
1282   size_t len;
1283
1284   if (! lisp_to_time (specified_time, &value))
1285     value = -1;
1286   the_ctime = ctime (&value);
1287
1288   /* ctime is documented as always returning a "\n\0"-terminated
1289      26-byte American time string, but let's be careful anyways. */
1290   for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++)
1291     ;
1292
1293   return make_ext_string ((Extbyte *) the_ctime, len, Qbinary);
1294 }
1295
1296 #define TM_YEAR_ORIGIN 1900
1297
1298 /* Yield A - B, measured in seconds.  */
1299 static long
1300 difftm (const struct tm *a, const struct tm *b)
1301 {
1302   int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
1303   int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
1304   /* Some compilers can't handle this as a single return statement.  */
1305   long days = (
1306               /* difference in day of year */
1307               a->tm_yday - b->tm_yday
1308               /* + intervening leap days */
1309               +  ((ay >> 2) - (by >> 2))
1310               -  (ay/100 - by/100)
1311               +  ((ay/100 >> 2) - (by/100 >> 2))
1312               /* + difference in years * 365 */
1313               +  (long)(ay-by) * 365
1314               );
1315   return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
1316               + (a->tm_min - b->tm_min))
1317           + (a->tm_sec - b->tm_sec));
1318 }
1319
1320 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
1321 Return the offset and name for the local time zone.
1322 This returns a list of the form (OFFSET NAME).
1323 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
1324     A negative value means west of Greenwich.
1325 NAME is a string giving the name of the time zone.
1326 If an argument is given, it specifies when the time zone offset is determined
1327 instead of using the current time.  The argument should have the form:
1328   (HIGH . LOW)
1329 or the form:
1330   (HIGH LOW . IGNORED).
1331 Thus, you can use times obtained from `current-time'
1332 and from `file-attributes'.
1333
1334 Some operating systems cannot provide all this information to Emacs;
1335 in this case, `current-time-zone' returns a list containing nil for
1336 the data it can't find.
1337 */
1338        (specified_time))
1339 {
1340   time_t value;
1341   struct tm *t = NULL;
1342
1343   if (lisp_to_time (specified_time, &value)
1344       && (t = gmtime (&value)) != 0)
1345     {
1346       struct tm gmt = *t;       /* Make a copy, in case localtime modifies *t.  */
1347       long offset;
1348       char *s, buf[6];
1349
1350       t = localtime (&value);
1351       offset = difftm (t, &gmt);
1352       s = 0;
1353 #ifdef HAVE_TM_ZONE
1354       if (t->tm_zone)
1355         s = (char *)t->tm_zone;
1356 #else /* not HAVE_TM_ZONE */
1357 #ifdef HAVE_TZNAME
1358       if (t->tm_isdst == 0 || t->tm_isdst == 1)
1359         s = tzname[t->tm_isdst];
1360 #endif
1361 #endif /* not HAVE_TM_ZONE */
1362       if (!s)
1363         {
1364           /* No local time zone name is available; use "+-NNNN" instead.  */
1365           int am = (offset < 0 ? -offset : offset) / 60;
1366           sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
1367           s = buf;
1368         }
1369       return list2 (make_int (offset), build_string (s));
1370     }
1371   else
1372     return list2 (Qnil, Qnil);
1373 }
1374
1375 #ifdef LOCALTIME_CACHE
1376
1377 /* These two values are known to load tz files in buggy implementations,
1378    i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
1379    Their values shouldn't matter in non-buggy implementations.
1380    We don't use string literals for these strings,
1381    since if a string in the environment is in readonly
1382    storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
1383    See Sun bugs 1113095 and 1114114, ``Timezone routines
1384    improperly modify environment''.  */
1385
1386 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
1387 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
1388
1389 #endif
1390
1391 /* Set the local time zone rule to TZSTRING.
1392    This allocates memory into `environ', which it is the caller's
1393    responsibility to free.  */
1394 static void
1395 set_time_zone_rule (char *tzstring)
1396 {
1397   int envptrs;
1398   char **from, **to, **newenv;
1399
1400   for (from = environ; *from; from++)
1401     continue;
1402   envptrs = from - environ + 2;
1403   newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
1404                                    + (tzstring ? strlen (tzstring) + 4 : 0));
1405   if (tzstring)
1406     {
1407       char *t = (char *) (to + envptrs);
1408       strcpy (t, "TZ=");
1409       strcat (t, tzstring);
1410       *to++ = t;
1411     }
1412
1413   for (from = environ; *from; from++)
1414     if (strncmp (*from, "TZ=", 3) != 0)
1415       *to++ = *from;
1416   *to = 0;
1417
1418   environ = newenv;
1419
1420 #ifdef LOCALTIME_CACHE
1421   {
1422     /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
1423        "US/Pacific" that loads a tz file, then changes to a value like
1424        "XXX0" that does not load a tz file, and then changes back to
1425        its original value, the last change is (incorrectly) ignored.
1426        Also, if TZ changes twice in succession to values that do
1427        not load a tz file, tzset can dump core (see Sun bug#1225179).
1428        The following code works around these bugs.  */
1429
1430     if (tzstring)
1431       {
1432         /* Temporarily set TZ to a value that loads a tz file
1433            and that differs from tzstring.  */
1434         char *tz = *newenv;
1435         *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
1436                    ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
1437         tzset ();
1438         *newenv = tz;
1439       }
1440     else
1441       {
1442         /* The implied tzstring is unknown, so temporarily set TZ to
1443            two different values that each load a tz file.  */
1444         *to = set_time_zone_rule_tz1;
1445         to[1] = 0;
1446         tzset ();
1447         *to = set_time_zone_rule_tz2;
1448         tzset ();
1449         *to = 0;
1450       }
1451
1452     /* Now TZ has the desired value, and tzset can be invoked safely.  */
1453   }
1454
1455   tzset ();
1456 #endif
1457 }
1458
1459 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
1460 Set the local time zone using TZ, a string specifying a time zone rule.
1461 If TZ is nil, use implementation-defined default time zone information.
1462 */
1463        (tz))
1464 {
1465   char *tzstring;
1466
1467   if (NILP (tz))
1468     tzstring = 0;
1469   else
1470     {
1471       CHECK_STRING (tz);
1472       tzstring = (char *) XSTRING_DATA (tz);
1473     }
1474
1475   set_time_zone_rule (tzstring);
1476   if (environbuf)
1477     xfree (environbuf);
1478   environbuf = environ;
1479
1480   return Qnil;
1481 }
1482
1483 \f
1484 void
1485 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
1486 {
1487   /* This function can GC */
1488   struct gcpro gcpro1;
1489   GCPRO1 (arg);
1490  retry:
1491   if (CHAR_OR_CHAR_INTP (arg))
1492     {
1493       buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
1494     }
1495   else if (STRINGP (arg))
1496     {
1497       buffer_insert_lisp_string (buf, arg);
1498     }
1499   else
1500     {
1501       arg = wrong_type_argument (Qchar_or_string_p, arg);
1502       goto retry;
1503     }
1504   UNGCPRO;
1505 }
1506
1507
1508 /* Callers passing one argument to Finsert need not gcpro the
1509    argument "array", since the only element of the array will
1510    not be used after calling insert_emacs_char or insert_lisp_string,
1511    so we don't care if it gets trashed.  */
1512
1513 DEFUN ("insert", Finsert, 0, MANY, 0, /*
1514 Insert the arguments, either strings or characters, at point.
1515 Point moves forward so that it ends up after the inserted text.
1516 Any other markers at the point of insertion remain before the text.
1517 If a string has non-null string-extent-data, new extents will be created.
1518 */
1519        (int nargs, Lisp_Object *args))
1520 {
1521   /* This function can GC */
1522   REGISTER int argnum;
1523
1524   for (argnum = 0; argnum < nargs; argnum++)
1525     {
1526       buffer_insert1 (current_buffer, args[argnum]);
1527     }
1528
1529   return Qnil;
1530 }
1531
1532 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
1533 Insert strings or characters at point, relocating markers after the text.
1534 Point moves forward so that it ends up after the inserted text.
1535 Any other markers at the point of insertion also end up after the text.
1536 */
1537        (int nargs, Lisp_Object *args))
1538 {
1539   /* This function can GC */
1540   REGISTER int argnum;
1541   REGISTER Lisp_Object tem;
1542
1543   for (argnum = 0; argnum < nargs; argnum++)
1544     {
1545       tem = args[argnum];
1546     retry:
1547       if (CHAR_OR_CHAR_INTP (tem))
1548         {
1549           buffer_insert_emacs_char_1 (current_buffer, -1,
1550                                       XCHAR_OR_CHAR_INT (tem),
1551                                       INSDEL_BEFORE_MARKERS);
1552         }
1553       else if (STRINGP (tem))
1554         {
1555           buffer_insert_lisp_string_1 (current_buffer, -1, tem,
1556                                        INSDEL_BEFORE_MARKERS);
1557         }
1558       else
1559         {
1560           tem = wrong_type_argument (Qchar_or_string_p, tem);
1561           goto retry;
1562         }
1563     }
1564   return Qnil;
1565 }
1566
1567 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
1568 Insert STRING into BUFFER at BUFFER's point.
1569 Point moves forward so that it ends up after the inserted text.
1570 Any other markers at the point of insertion remain before the text.
1571 If a string has non-null string-extent-data, new extents will be created.
1572 BUFFER defaults to the current buffer.
1573 */
1574        (string, buffer))
1575 {
1576   struct buffer *b = decode_buffer (buffer, 1);
1577   CHECK_STRING (string);
1578   buffer_insert_lisp_string (b, string);
1579   return Qnil;
1580 }
1581
1582 /* Third argument in FSF is INHERIT:
1583
1584 "The optional third arg INHERIT, if non-nil, says to inherit text properties
1585 from adjoining text, if those properties are sticky."
1586
1587 Jamie thinks this is bogus. */
1588
1589 \f
1590 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
1591 Insert COUNT copies of CHARACTER into BUFFER.
1592 Point and all markers are affected as in the function `insert'.
1593 COUNT defaults to 1 if omitted.
1594 The optional third arg IGNORED is INHERIT under FSF Emacs.
1595 This is highly bogus, however, and XEmacs always behaves as if
1596 `t' were passed to INHERIT.
1597 The optional fourth arg BUFFER specifies the buffer to insert the
1598 text into.  If BUFFER is nil, the current buffer is assumed.
1599 */
1600        (character, count, ignored, buffer))
1601 {
1602   /* This function can GC */
1603   REGISTER Bufbyte *string;
1604   REGISTER int slen;
1605   REGISTER int i, j;
1606   REGISTER Bytecount n;
1607   REGISTER Bytecount charlen;
1608   Bufbyte str[MAX_EMCHAR_LEN];
1609   struct buffer *b = decode_buffer (buffer, 1);
1610   int cou;
1611
1612   CHECK_CHAR_COERCE_INT (character);
1613   if (NILP (count))
1614     cou = 1;
1615   else
1616     {
1617       CHECK_INT (count);
1618       cou = XINT (count);
1619     }
1620
1621   charlen = set_charptr_emchar (str, XCHAR (character));
1622   n = cou * charlen;
1623   if (n <= 0)
1624     return Qnil;
1625   slen = min (n, 768);
1626   string = alloca_array (Bufbyte, slen);
1627   /* Write as many copies of the character into the temp string as will fit. */
1628   for (i = 0; i + charlen <= slen; i += charlen)
1629     for (j = 0; j < charlen; j++)
1630       string[i + j] = str[j];
1631   slen = i;
1632   while (n >= slen)
1633     {
1634       buffer_insert_raw_string (b, string, slen);
1635       n -= slen;
1636     }
1637   if (n > 0)
1638 #if 0 /* FSFmacs bogosity */
1639     {
1640       if (!NILP (inherit))
1641         insert_and_inherit (string, n);
1642       else
1643         insert (string, n);
1644     }
1645 #else
1646     buffer_insert_raw_string (b, string, n);
1647 #endif
1648
1649   return Qnil;
1650 }
1651
1652 \f
1653 /* Making strings from buffer contents.  */
1654
1655 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
1656 Return the contents of part of BUFFER as a string.
1657 The two arguments START and END are character positions;
1658 they can be in either order.  If omitted, they default to the beginning
1659 and end of BUFFER, respectively.
1660 If there are duplicable extents in the region, the string remembers
1661 them in its extent data.
1662 If BUFFER is nil, the current buffer is assumed.
1663 */
1664        (start, end, buffer))
1665 {
1666   /* This function can GC */
1667   Bufpos begv, zv;
1668   struct buffer *b = decode_buffer (buffer, 1);
1669
1670   get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1671   return make_string_from_buffer (b, begv, zv - begv);
1672 }
1673
1674 /* It might make more sense to name this
1675    `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1676    and what the function does is probably good enough for what the
1677    user-code will typically want to use it for. */
1678 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1679 Return the text from START to END as a string, without copying the extents.
1680 */
1681        (start, end, buffer))
1682 {
1683   /* This function can GC */
1684   Bufpos begv, zv;
1685   struct buffer *b = decode_buffer (buffer, 1);
1686
1687   get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
1688   return make_string_from_buffer_no_extents (b, begv, zv - begv);
1689 }
1690
1691 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
1692 Insert before point a substring of the contents of buffer BUFFER.
1693 BUFFER may be a buffer or a buffer name.
1694 Arguments START and END are character numbers specifying the substring.
1695 They default to the beginning and the end of BUFFER.
1696 */
1697        (buffer, start, end))
1698 {
1699   /* This function can GC */
1700   Bufpos b, e;
1701   struct buffer *bp;
1702
1703   bp = XBUFFER (get_buffer (buffer, 1));
1704   get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
1705
1706   if (b < e)
1707     buffer_insert_from_buffer (current_buffer, bp, b, e - b);
1708
1709   return Qnil;
1710 }
1711 \f
1712 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
1713 Compare two substrings of two buffers; return result as number.
1714 the value is -N if first string is less after N-1 chars,
1715 +N if first string is greater after N-1 chars, or 0 if strings match.
1716 Each substring is represented as three arguments: BUFFER, START and END.
1717 That makes six args in all, three for each substring.
1718
1719 The value of `case-fold-search' in the current buffer
1720 determines whether case is significant or ignored.
1721 */
1722        (buffer1, start1, end1, buffer2, start2, end2))
1723 {
1724   Bufpos begp1, endp1, begp2, endp2;
1725   REGISTER Charcount len1, len2, length, i;
1726   struct buffer *bp1, *bp2;
1727   Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
1728                      XCASE_TABLE_CANON (current_buffer->case_table) : Qnil);
1729
1730   /* Find the first buffer and its substring.  */
1731
1732   bp1 = decode_buffer (buffer1, 1);
1733   get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
1734
1735   /* Likewise for second substring.  */
1736
1737   bp2 = decode_buffer (buffer2, 1);
1738   get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
1739
1740   len1 = endp1 - begp1;
1741   len2 = endp2 - begp2;
1742   length = len1;
1743   if (len2 < length)
1744     length = len2;
1745
1746   for (i = 0; i < length; i++)
1747     {
1748       Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
1749       Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
1750       if (!NILP (trt))
1751         {
1752           c1 = TRT_TABLE_OF (trt, c1);
1753           c2 = TRT_TABLE_OF (trt, c2);
1754         }
1755       if (c1 < c2)
1756         return make_int (- 1 - i);
1757       if (c1 > c2)
1758         return make_int (i + 1);
1759     }
1760
1761   /* The strings match as far as they go.
1762      If one is shorter, that one is less.  */
1763   if (length < len1)
1764     return make_int (length + 1);
1765   else if (length < len2)
1766     return make_int (- length - 1);
1767
1768   /* Same length too => they are equal.  */
1769   return Qzero;
1770 }
1771
1772 \f
1773 static Lisp_Object
1774 subst_char_in_region_unwind (Lisp_Object arg)
1775 {
1776   XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
1777   return Qnil;
1778 }
1779
1780 static Lisp_Object
1781 subst_char_in_region_unwind_1 (Lisp_Object arg)
1782 {
1783   XBUFFER (XCAR (arg))->filename = XCDR (arg);
1784   return Qnil;
1785 }
1786
1787 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
1788 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
1789 If optional arg NOUNDO is non-nil, don't record this change for undo
1790 and don't mark the buffer as really changed.
1791 */
1792   (start, end, fromchar, tochar, noundo))
1793 {
1794   /* This function can GC */
1795   Bufpos pos, stop;
1796   Emchar fromc, toc;
1797   int mc_count;
1798   struct buffer *buf = current_buffer;
1799   int count = specpdl_depth ();
1800
1801   get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1802   CHECK_CHAR_COERCE_INT (fromchar);
1803   CHECK_CHAR_COERCE_INT (tochar);
1804
1805   fromc = XCHAR (fromchar);
1806   toc = XCHAR (tochar);
1807
1808   /* If we don't want undo, turn off putting stuff on the list.
1809      That's faster than getting rid of things,
1810      and it prevents even the entry for a first change.
1811      Also inhibit locking the file.  */
1812   if (!NILP (noundo))
1813     {
1814       record_unwind_protect (subst_char_in_region_unwind,
1815                              Fcons (Fcurrent_buffer (), buf->undo_list));
1816       buf->undo_list = Qt;
1817       /* Don't do file-locking.  */
1818       record_unwind_protect (subst_char_in_region_unwind_1,
1819                              Fcons (Fcurrent_buffer (), buf->filename));
1820       buf->filename = Qnil;
1821     }
1822
1823   mc_count = begin_multiple_change (buf, pos, stop);
1824   while (pos < stop)
1825     {
1826       if (BUF_FETCH_CHAR (buf, pos) == fromc)
1827         {
1828           /* There used to be some code here that set the buffer to
1829              unmodified if NOUNDO was specified and there was only
1830              one change to the buffer since it was last saved.
1831              This is a crock of shit, so I'm not duplicating this
1832              behavior.  I think this was left over from when
1833              prepare_to_modify_buffer() actually bumped MODIFF,
1834              so that code was supposed to undo this change. --ben */
1835           buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
1836
1837           /* If noundo is not nil then we don't mark the buffer as
1838              modified.  In reality that needs to happen externally
1839              only.  Internally redisplay needs to know that the actual
1840              contents it should be displaying have changed. */
1841           if (!NILP (noundo))
1842             Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
1843         }
1844       pos++;
1845     }
1846   end_multiple_change (buf, mc_count);
1847
1848   unbind_to (count, Qnil);
1849   return Qnil;
1850 }
1851
1852 /* #### Shouldn't this also accept a BUFFER argument, in the good old
1853    XEmacs tradition?  */
1854 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
1855 Translate characters from START to END according to TABLE.
1856
1857 If TABLE is a string, the Nth character in it is the mapping for the
1858 character with code N.
1859
1860 If TABLE is a vector, its Nth element is the mapping for character
1861 with code N.  The values of elements may be characters, strings, or
1862 nil (nil meaning don't replace.)
1863
1864 If TABLE is a char-table, its elements describe the mapping between
1865 characters and their replacements.  The char-table should be of type
1866 `char' or `generic'.
1867
1868 Returns the number of substitutions performed.
1869 */
1870        (start, end, table))
1871 {
1872   /* This function can GC */
1873   Bufpos pos, stop;     /* Limits of the region. */
1874   int cnt = 0;          /* Number of changes made. */
1875   int mc_count;
1876   struct buffer *buf = current_buffer;
1877   Emchar oc;
1878
1879   get_buffer_range_char (buf, start, end, &pos, &stop, 0);
1880   mc_count = begin_multiple_change (buf, pos, stop);
1881   if (STRINGP (table))
1882     {
1883       Lisp_String *stable = XSTRING (table);
1884       Charcount size = string_char_length (stable);
1885 #ifdef MULE
1886       /* Under Mule, string_char(n) is O(n), so for large tables or
1887          large regions it makes sense to create an array of Emchars.  */
1888       if (size * (stop - pos) > 65536)
1889         {
1890           Emchar *etable = alloca_array (Emchar, size);
1891           convert_bufbyte_string_into_emchar_string
1892             (string_data (stable), string_length (stable), etable);
1893           for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1894             {
1895               if (oc < size)
1896                 {
1897                   Emchar nc = etable[oc];
1898                   if (nc != oc)
1899                     {
1900                       buffer_replace_char (buf, pos, nc, 0, 0);
1901                       ++cnt;
1902                     }
1903                 }
1904             }
1905         }
1906       else
1907 #endif /* MULE */
1908         {
1909           for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1910             {
1911               if (oc < size)
1912                 {
1913                   Emchar nc = string_char (stable, oc);
1914                   if (nc != oc)
1915                     {
1916                       buffer_replace_char (buf, pos, nc, 0, 0);
1917                       ++cnt;
1918                     }
1919                 }
1920             }
1921         }
1922     }
1923   else if (VECTORP (table))
1924     {
1925       Charcount size = XVECTOR_LENGTH (table);
1926       Lisp_Object *vtable = XVECTOR_DATA (table);
1927
1928       for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1929         {
1930           if (oc < size)
1931             {
1932               Lisp_Object replacement = vtable[oc];
1933             retry:
1934               if (CHAR_OR_CHAR_INTP (replacement))
1935                 {
1936                   Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1937                   if (nc != oc)
1938                     {
1939                       buffer_replace_char (buf, pos, nc, 0, 0);
1940                       ++cnt;
1941                     }
1942                 }
1943               else if (STRINGP (replacement))
1944                 {
1945                   Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1946                   buffer_delete_range (buf, pos, pos + 1, 0);
1947                   buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1948                   pos += incr, stop += incr;
1949                   ++cnt;
1950                 }
1951               else if (!NILP (replacement))
1952                 {
1953                   replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1954                   goto retry;
1955                 }
1956             }
1957         }
1958     }
1959   else if (CHAR_TABLEP (table)
1960            && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
1961                || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
1962     {
1963       Lisp_Char_Table *ctable = XCHAR_TABLE (table);
1964
1965       for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
1966         {
1967           Lisp_Object replacement = get_char_table (oc, ctable);
1968         retry2:
1969           if (CHAR_OR_CHAR_INTP (replacement))
1970             {
1971               Emchar nc = XCHAR_OR_CHAR_INT (replacement);
1972               if (nc != oc)
1973                 {
1974                   buffer_replace_char (buf, pos, nc, 0, 0);
1975                   ++cnt;
1976                 }
1977             }
1978           else if (STRINGP (replacement))
1979             {
1980               Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
1981               buffer_delete_range (buf, pos, pos + 1, 0);
1982               buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
1983               pos += incr, stop += incr;
1984               ++cnt;
1985             }
1986           else if (!NILP (replacement))
1987             {
1988               replacement = wrong_type_argument (Qchar_or_string_p, replacement);
1989               goto retry2;
1990             }
1991         }
1992     }
1993   else
1994     dead_wrong_type_argument (Qstringp, table);
1995   end_multiple_change (buf, mc_count);
1996
1997   return make_int (cnt);
1998 }
1999
2000 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
2001 Delete the text between point and mark.
2002 When called from a program, expects two arguments START and END
2003 \(integers or markers) specifying the stretch to be deleted.
2004 If optional third arg BUFFER is nil, the current buffer is assumed.
2005 */
2006        (start, end, buffer))
2007 {
2008   /* This function can GC */
2009   Bufpos bp_start, bp_end;
2010   struct buffer *buf = decode_buffer (buffer, 1);
2011
2012   get_buffer_range_char (buf, start, end, &bp_start, &bp_end, 0);
2013   buffer_delete_range (buf, bp_start, bp_end, 0);
2014   return Qnil;
2015 }
2016 \f
2017 void
2018 widen_buffer (struct buffer *b, int no_clip)
2019 {
2020   if (BUF_BEGV (b) != BUF_BEG (b))
2021     {
2022       clip_changed = 1;
2023       SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b));
2024     }
2025   if (BUF_ZV (b) != BUF_Z (b))
2026     {
2027       clip_changed = 1;
2028       SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b));
2029     }
2030   if (clip_changed)
2031     {
2032       if (!no_clip)
2033         MARK_CLIP_CHANGED;
2034       /* Changing the buffer bounds invalidates any recorded current
2035          column.  */
2036       invalidate_current_column ();
2037       narrow_line_number_cache (b);
2038     }
2039 }
2040
2041 DEFUN ("widen", Fwiden, 0, 1, "", /*
2042 Remove restrictions (narrowing) from BUFFER.
2043 This allows the buffer's full text to be seen and edited.
2044 If BUFFER is nil, the current buffer is assumed.
2045 */
2046        (buffer))
2047 {
2048   struct buffer *b = decode_buffer (buffer, 1);
2049   widen_buffer (b, 0);
2050   return Qnil;
2051 }
2052
2053 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
2054 Restrict editing in BUFFER to the current region.
2055 The rest of the text becomes temporarily invisible and untouchable
2056 but is not deleted; if you save the buffer in a file, the invisible
2057 text is included in the file.  \\[widen] makes all visible again.
2058 If BUFFER is nil, the current buffer is assumed.
2059 See also `save-restriction'.
2060
2061 When calling from a program, pass two arguments; positions (integers
2062 or markers) bounding the text that should remain visible.
2063 */
2064        (start, end, buffer))
2065 {
2066   Bufpos bp_start, bp_end;
2067   struct buffer *buf = decode_buffer (buffer, 1);
2068   Bytind bi_start, bi_end;
2069
2070   get_buffer_range_char (buf, start, end, &bp_start, &bp_end,
2071                          GB_ALLOW_PAST_ACCESSIBLE);
2072   bi_start = bufpos_to_bytind (buf, bp_start);
2073   bi_end = bufpos_to_bytind (buf, bp_end);
2074
2075   SET_BOTH_BUF_BEGV (buf, bp_start, bi_start);
2076   SET_BOTH_BUF_ZV (buf, bp_end, bi_end);
2077   if (BUF_PT (buf) < bp_start)
2078     BUF_SET_PT (buf, bp_start);
2079   if (BUF_PT (buf) > bp_end)
2080     BUF_SET_PT (buf, bp_end);
2081   MARK_CLIP_CHANGED;
2082   /* Changing the buffer bounds invalidates any recorded current column.  */
2083   invalidate_current_column ();
2084   narrow_line_number_cache (buf);
2085   return Qnil;
2086 }
2087
2088 Lisp_Object
2089 save_restriction_save (void)
2090 {
2091   Lisp_Object bottom, top;
2092   /* Note: I tried using markers here, but it does not win
2093      because insertion at the end of the saved region
2094      does not advance mh and is considered "outside" the saved region. */
2095   bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer));
2096   top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer));
2097
2098   return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top));
2099 }
2100
2101 Lisp_Object
2102 save_restriction_restore (Lisp_Object data)
2103 {
2104   struct buffer *buf;
2105   Charcount newhead, newtail;
2106   Lisp_Object tem;
2107   int local_clip_changed = 0;
2108
2109   buf = XBUFFER (XCAR (data));
2110   if (!BUFFER_LIVE_P (buf))
2111     {
2112       /* someone could have killed the buffer in the meantime ... */
2113       free_cons (XCONS (XCDR (data)));
2114       free_cons (XCONS (data));
2115       return Qnil;
2116     }
2117   tem = XCDR (data);
2118   newhead = XINT (XCAR (tem));
2119   newtail = XINT (XCDR (tem));
2120
2121   free_cons (XCONS (XCDR (data)));
2122   free_cons (XCONS (data));
2123
2124   if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
2125     {
2126       newhead = 0;
2127       newtail = 0;
2128     }
2129
2130   {
2131     Bufpos start, end;
2132     Bytind bi_start, bi_end;
2133
2134     start = BUF_BEG (buf) + newhead;
2135     end = BUF_Z (buf) - newtail;
2136
2137     bi_start = bufpos_to_bytind (buf, start);
2138     bi_end = bufpos_to_bytind (buf, end);
2139
2140     if (BUF_BEGV (buf) != start)
2141       {
2142         local_clip_changed = 1;
2143         SET_BOTH_BUF_BEGV (buf, start, bi_start);
2144         narrow_line_number_cache (buf);
2145       }
2146     if (BUF_ZV (buf) != end)
2147       {
2148         local_clip_changed = 1;
2149         SET_BOTH_BUF_ZV (buf, end, bi_end);
2150       }
2151   }
2152   if (local_clip_changed)
2153     MARK_CLIP_CHANGED;
2154
2155   /* If point is outside the new visible range, move it inside. */
2156   BUF_SET_PT (buf,
2157               bufpos_clip_to_bounds (BUF_BEGV (buf),
2158                                      BUF_PT (buf),
2159                                      BUF_ZV (buf)));
2160
2161   return Qnil;
2162 }
2163
2164 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
2165 Execute BODY, saving and restoring current buffer's restrictions.
2166 The buffer's restrictions make parts of the beginning and end invisible.
2167 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
2168 This special form, `save-restriction', saves the current buffer's restrictions
2169 when it is entered, and restores them when it is exited.
2170 So any `narrow-to-region' within BODY lasts only until the end of the form.
2171 The old restrictions settings are restored
2172 even in case of abnormal exit (throw or error).
2173
2174 The value returned is the value of the last form in BODY.
2175
2176 `save-restriction' can get confused if, within the BODY, you widen
2177 and then make changes outside the area within the saved restrictions.
2178
2179 Note: if you are using both `save-excursion' and `save-restriction',
2180 use `save-excursion' outermost:
2181     (save-excursion (save-restriction ...))
2182 */
2183        (body))
2184 {
2185   /* This function can GC */
2186   int speccount = specpdl_depth ();
2187
2188   record_unwind_protect (save_restriction_restore, save_restriction_save ());
2189
2190   return unbind_to (speccount, Fprogn (body));
2191 }
2192
2193 \f
2194 DEFUN ("format", Fformat, 1, MANY, 0, /*
2195 Format a string out of a control-string and arguments.
2196 The first argument is a control string.
2197 The other arguments are substituted into it to make the result, a string.
2198 It may contain %-sequences meaning to substitute the next argument.
2199 %s means print all objects as-is, using `princ'.
2200 %S means print all objects as s-expressions, using `prin1'.
2201 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
2202   %X uppercase hex).
2203 %c means print as a single character.
2204 %f means print as a floating-point number in fixed notation (e.g. 785.200).
2205 %e or %E means print as a floating-point number in scientific notation
2206   (e.g. 7.85200e+03).
2207 %g or %G means print as a floating-point number in "pretty format";
2208   depending on the number, either %f or %e/%E format will be used, and
2209   trailing zeroes are removed from the fractional part.
2210 The argument used for all but %s and %S must be a number.  It will be
2211   converted to an integer or a floating-point number as necessary.
2212
2213 %$ means reposition to read a specific numbered argument; for example,
2214   %3$s would apply the `%s' to the third argument after the control string,
2215   and the next format directive would use the fourth argument, the
2216   following one the fifth argument, etc. (There must be a positive integer
2217   between the % and the $).
2218 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
2219   specified between the optional repositioning spec and the conversion
2220   character; see below.
2221 An optional minimum field width may be specified after any flag characters
2222   and before the conversion character; it specifies the minimum number of
2223   characters that the converted argument will take up.  Padding will be
2224   added on the left (or on the right, if the `-' flag is specified), as
2225   necessary.  Padding is done with spaces, or with zeroes if the `0' flag
2226   is specified.
2227 If the field width is specified as `*', the field width is assumed to have
2228   been specified as an argument.  Any repositioning specification that
2229   would normally specify the argument to be converted will now specify
2230   where to find this field width argument, not where to find the argument
2231   to be converted.  If there is no repositioning specification, the normal
2232   next argument is used.  The argument to be converted will be the next
2233   argument after the field width argument unless the precision is also
2234   specified as `*' (see below).
2235
2236 An optional period character and precision may be specified after any
2237   minimum field width.  It specifies the minimum number of digits to
2238   appear in %d, %i, %o, %x, and %X conversions (the number is padded
2239   on the left with zeroes as necessary); the number of digits printed
2240   after the decimal point for %f, %e, and %E conversions; the number
2241   of significant digits printed in %g and %G conversions; and the
2242   maximum number of non-padding characters printed in %s and %S
2243   conversions.  The default precision for floating-point conversions
2244   is six.
2245 If the precision is specified as `*', the precision is assumed to have been
2246   specified as an argument.  The argument used will be the next argument
2247   after the field width argument, if any.  If the field width was not
2248   specified as an argument, any repositioning specification that would
2249   normally specify the argument to be converted will now specify where to
2250   find the precision argument.  If there is no repositioning specification,
2251   the normal next argument is used.
2252
2253 The ` ' and `+' flags mean prefix non-negative numbers with a space or
2254   plus sign, respectively.
2255 The `#' flag means print numbers in an alternate, more verbose format:
2256   octal numbers begin with zero; hex numbers begin with a 0x or 0X;
2257   a decimal point is printed in %f, %e, and %E conversions even if no
2258   numbers are printed after it; and trailing zeroes are not omitted in
2259    %g and %G conversions.
2260
2261 Use %% to put a single % into the output.
2262 */
2263        (int nargs, Lisp_Object *args))
2264 {
2265   /* It should not be necessary to GCPRO ARGS, because
2266      the caller in the interpreter should take care of that.  */
2267
2268   CHECK_STRING (args[0]);
2269   return emacs_doprnt_string_lisp (0, args[0], 0, nargs - 1, args + 1);
2270 }
2271
2272 \f
2273 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
2274 Return t if two characters match, optionally ignoring case.
2275 Both arguments must be characters (i.e. NOT integers).
2276 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2277 If BUFFER is nil, the current buffer is assumed.
2278 */
2279        (character1, character2, buffer))
2280 {
2281   Emchar x1, x2;
2282   struct buffer *b = decode_buffer (buffer, 1);
2283
2284   CHECK_CHAR_COERCE_INT (character1);
2285   CHECK_CHAR_COERCE_INT (character2);
2286   x1 = XCHAR (character1);
2287   x2 = XCHAR (character2);
2288
2289   return (!NILP (b->case_fold_search)
2290           ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
2291           : x1 == x2)
2292     ? Qt : Qnil;
2293 }
2294
2295 DEFUN ("char=", Fchar_Equal, 2, 2, 0, /*
2296 Return t if two characters match, case is significant.
2297 Both arguments must be characters (i.e. NOT integers).
2298 */
2299        (character1, character2))
2300 {
2301   CHECK_CHAR_COERCE_INT (character1);
2302   CHECK_CHAR_COERCE_INT (character2);
2303
2304   return EQ (character1, character2) ? Qt : Qnil;
2305 }
2306 \f
2307 #if 0 /* Undebugged FSFmacs code */
2308 /* Transpose the markers in two regions of the current buffer, and
2309    adjust the ones between them if necessary (i.e.: if the regions
2310    differ in size).
2311
2312    Traverses the entire marker list of the buffer to do so, adding an
2313    appropriate amount to some, subtracting from some, and leaving the
2314    rest untouched.  Most of this is copied from adjust_markers in insdel.c.
2315
2316    It's the caller's job to see that (start1 <= end1 <= start2 <= end2).  */
2317
2318 void
2319 transpose_markers (Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2)
2320 {
2321   Charcount amt1, amt2, diff;
2322   Lisp_Object marker;
2323   struct buffer *buf = current_buffer;
2324
2325   /* Update point as if it were a marker.  */
2326   if (BUF_PT (buf) < start1)
2327     ;
2328   else if (BUF_PT (buf) < end1)
2329     BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
2330   else if (BUF_PT (buf) < start2)
2331     BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
2332   else if (BUF_PT (buf) < end2)
2333     BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
2334
2335   /* We used to adjust the endpoints here to account for the gap, but that
2336      isn't good enough.  Even if we assume the caller has tried to move the
2337      gap out of our way, it might still be at start1 exactly, for example;
2338      and that places it `inside' the interval, for our purposes.  The amount
2339      of adjustment is nontrivial if there's a `denormalized' marker whose
2340      position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
2341      the dirty work to Fmarker_position, below.  */
2342
2343   /* The difference between the region's lengths */
2344   diff = (end2 - start2) - (end1 - start1);
2345
2346   /* For shifting each marker in a region by the length of the other
2347    * region plus the distance between the regions.
2348    */
2349   amt1 = (end2 - start2) + (start2 - end1);
2350   amt2 = (end1 - start1) + (start2 - end1);
2351
2352   for (marker = BUF_MARKERS (buf); !NILP (marker);
2353        marker = XMARKER (marker)->chain)
2354     {
2355       Bufpos mpos = marker_position (marker);
2356       if (mpos >= start1 && mpos < end2)
2357         {
2358           if (mpos < end1)
2359             mpos += amt1;
2360           else if (mpos < start2)
2361             mpos += diff;
2362           else
2363             mpos -= amt2;
2364           set_marker_position (marker, mpos);
2365         }
2366     }
2367 }
2368
2369 #endif /* 0 */
2370
2371 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2372 Transpose region START1 to END1 with START2 to END2.
2373 The regions may not be overlapping, because the size of the buffer is
2374 never changed in a transposition.
2375
2376 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
2377 any markers that happen to be located in the regions. (#### BUG: currently
2378 this function always acts as if LEAVE-MARKERS is non-nil.)
2379
2380 Transposing beyond buffer boundaries is an error.
2381 */
2382   (start1, end1, start2, end2, leave_markers))
2383 {
2384   Bufpos startr1, endr1, startr2, endr2;
2385   Charcount len1, len2;
2386   Lisp_Object string1, string2;
2387   struct buffer *buf = current_buffer;
2388
2389   get_buffer_range_char (buf, start1, end1, &startr1, &endr1, 0);
2390   get_buffer_range_char (buf, start2, end2, &startr2, &endr2, 0);
2391
2392   len1 = endr1 - startr1;
2393   len2 = endr2 - startr2;
2394
2395   if (startr2 < endr1)
2396     error ("transposed regions not properly ordered");
2397   else if (startr1 == endr1 || startr2 == endr2)
2398     error ("transposed region may not be of length 0");
2399
2400   string1 = make_string_from_buffer (buf, startr1, len1);
2401   string2 = make_string_from_buffer (buf, startr2, len2);
2402   buffer_delete_range (buf, startr2, endr2, 0);
2403   buffer_insert_lisp_string_1 (buf, startr2, string1, 0);
2404   buffer_delete_range (buf, startr1, endr1, 0);
2405   buffer_insert_lisp_string_1 (buf, startr1, string2, 0);
2406
2407   /* In FSFmacs there is a whole bunch of really ugly code here
2408      to attempt to transpose the regions without using up any
2409      extra memory.  Although the intent may be good, the result
2410      was highly bogus. */
2411
2412   return Qnil;
2413 }
2414
2415 \f
2416 /************************************************************************/
2417 /*                            initialization                            */
2418 /************************************************************************/
2419
2420 void
2421 syms_of_editfns (void)
2422 {
2423   defsymbol (&Qpoint, "point");
2424   defsymbol (&Qmark, "mark");
2425   defsymbol (&Qregion_beginning, "region-beginning");
2426   defsymbol (&Qregion_end, "region-end");
2427   defsymbol (&Qformat, "format");
2428   defsymbol (&Quser_files_and_directories, "user-files-and-directories");
2429
2430   DEFSUBR (Fchar_equal);
2431   DEFSUBR (Fchar_Equal);
2432   DEFSUBR (Fgoto_char);
2433   DEFSUBR (Fstring_to_char);
2434   DEFSUBR (Fchar_to_string);
2435   DEFSUBR (Fbuffer_substring);
2436   DEFSUBR (Fbuffer_substring_no_properties);
2437
2438   DEFSUBR (Fpoint_marker);
2439   DEFSUBR (Fmark_marker);
2440   DEFSUBR (Fpoint);
2441   DEFSUBR (Fregion_beginning);
2442   DEFSUBR (Fregion_end);
2443   DEFSUBR (Fsave_excursion);
2444   DEFSUBR (Fsave_current_buffer);
2445
2446   DEFSUBR (Fbuffer_size);
2447   DEFSUBR (Fpoint_max);
2448   DEFSUBR (Fpoint_min);
2449   DEFSUBR (Fpoint_min_marker);
2450   DEFSUBR (Fpoint_max_marker);
2451
2452   DEFSUBR (Fbobp);
2453   DEFSUBR (Feobp);
2454   DEFSUBR (Fbolp);
2455   DEFSUBR (Feolp);
2456   DEFSUBR (Ffollowing_char);
2457   DEFSUBR (Fpreceding_char);
2458   DEFSUBR (Fchar_after);
2459   DEFSUBR (Fchar_before);
2460   DEFSUBR (Finsert);
2461   DEFSUBR (Finsert_string);
2462   DEFSUBR (Finsert_before_markers);
2463   DEFSUBR (Finsert_char);
2464
2465   DEFSUBR (Ftemp_directory);
2466   DEFSUBR (Fuser_login_name);
2467   DEFSUBR (Fuser_real_login_name);
2468   DEFSUBR (Fuser_uid);
2469   DEFSUBR (Fuser_real_uid);
2470   DEFSUBR (Fuser_full_name);
2471   DEFSUBR (Fuser_home_directory);
2472   DEFSUBR (Femacs_pid);
2473   DEFSUBR (Fcurrent_time);
2474   DEFSUBR (Fcurrent_process_time);
2475   DEFSUBR (Fformat_time_string);
2476   DEFSUBR (Fdecode_time);
2477   DEFSUBR (Fencode_time);
2478   DEFSUBR (Fcurrent_time_string);
2479   DEFSUBR (Fcurrent_time_zone);
2480   DEFSUBR (Fset_time_zone_rule);
2481   DEFSUBR (Fsystem_name);
2482   DEFSUBR (Fformat);
2483
2484   DEFSUBR (Finsert_buffer_substring);
2485   DEFSUBR (Fcompare_buffer_substrings);
2486   DEFSUBR (Fsubst_char_in_region);
2487   DEFSUBR (Ftranslate_region);
2488   DEFSUBR (Fdelete_region);
2489   DEFSUBR (Fwiden);
2490   DEFSUBR (Fnarrow_to_region);
2491   DEFSUBR (Fsave_restriction);
2492   DEFSUBR (Ftranspose_regions);
2493
2494   defsymbol (&Qzmacs_update_region, "zmacs-update-region");
2495   defsymbol (&Qzmacs_deactivate_region, "zmacs-deactivate-region");
2496   defsymbol (&Qzmacs_region_buffer, "zmacs-region-buffer");
2497 }
2498
2499 void
2500 vars_of_editfns (void)
2501 {
2502   staticpro (&Vsystem_name);
2503 #if 0
2504   staticpro (&Vuser_name);
2505   staticpro (&Vuser_real_name);
2506 #endif
2507   DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
2508 *Whether LISPM-style active regions should be used.
2509 This means that commands which operate on the region (the area between the
2510 point and the mark) will only work while the region is in the ``active''
2511 state, which is indicated by highlighting.  Executing most commands causes
2512 the region to not be in the active state, so (for example) \\[kill-region] will only
2513 work immediately after activating the region.
2514
2515 More specifically:
2516
2517  - Commands which operate on the region only work if the region is active.
2518  - Only a very small set of commands cause the region to become active:
2519    Those commands whose semantics are to mark an area, like `mark-defun'.
2520  - The region is deactivated after each command that is executed, except that:
2521  - "Motion" commands do not change whether the region is active or not.
2522
2523 set-mark-command (C-SPC) pushes a mark and activates the region.  Moving the
2524 cursor with normal motion commands (C-n, C-p, etc) will cause the region
2525 between point and the recently-pushed mark to be highlighted.  It will
2526 remain highlighted until some non-motion command is executed.
2527
2528 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region.  So if you mark a
2529 region and execute a command that operates on it, you can reactivate the
2530 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
2531 again.
2532
2533 Generally, commands which push marks as a means of navigation (like
2534 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
2535 region.  But commands which push marks as a means of marking an area of
2536 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
2537 do activate the region.
2538
2539 The way the command loop actually works with regard to deactivating the
2540 region is as follows:
2541
2542 - If the variable `zmacs-region-stays' has been set to t during the command
2543   just executed, the region is left alone (this is how the motion commands
2544   make the region stay around; see the `_' flag in the `interactive'
2545   specification).  `zmacs-region-stays' is reset to nil before each command
2546   is executed.
2547 - If the function `zmacs-activate-region' has been called during the command
2548   just executed, the region is left alone.  Very few functions should
2549   actually call this function.
2550 - Otherwise, if the region is active, the region is deactivated and
2551   the `zmacs-deactivate-region-hook' is called.
2552 */ );
2553   /* Zmacs style active regions are now ON by default */
2554   zmacs_regions = 1;
2555
2556   DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
2557 Do not alter this.  It is for internal use only.
2558 */ );
2559   zmacs_region_active_p = 0;
2560
2561   DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
2562 Whether the current command will deactivate the region.
2563 Commands which do not wish to affect whether the region is currently
2564 highlighted should set this to t.  Normally, the region is turned off after
2565 executing each command that did not explicitly turn it on with the function
2566 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2567 See the variable `zmacs-regions'.
2568
2569 The same effect can be achieved using the `_' interactive specification.
2570
2571 `zmacs-region-stays' is reset to nil before each command is executed.
2572 */ );
2573   zmacs_region_stays = 0;
2574
2575   DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2576 Do not use this -- it will be going away soon.
2577 Indicates if `goto-char' has just been run.  This information is allegedly
2578 needed to get the desired behavior for atomic extents and unfortunately
2579 is not available by any other means.
2580 */ );
2581   atomic_extent_goto_char_p = 0;
2582 #ifdef AMPERSAND_FULL_NAME
2583   Fprovide(intern("ampersand-full-name"));
2584 #endif
2585
2586   DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
2587 *The name of the user.
2588 The function `user-full-name', which will return the value of this
2589  variable, when called without arguments.
2590 This is initialized to the value of the NAME environment variable.
2591 */ );
2592   /* Initialized at run-time. */
2593   Vuser_full_name = Qnil;
2594 }