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