1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985, 1986, 1987, 1989 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
35 #else /* not NEED_TIME_H */
38 #endif /* HAVE_TIMEVAL */
39 #endif /* not NEED_TIME_H */
41 #define min(a, b) ((a) < (b) ? (a) : (b))
42 #define max(a, b) ((a) > (b) ? (a) : (b))
44 /* Some static data, and a function to initialize it for each run */
46 Lisp_Object Vsystem_name
;
47 Lisp_Object Vuser_real_name
; /* login name of current user ID */
48 Lisp_Object Vuser_full_name
; /* full name of current user */
49 Lisp_Object Vuser_name
; /* user name from USER or LOGNAME. */
55 register unsigned char *p
, *q
, *r
;
56 struct passwd
*pw
; /* password entry for the current user */
57 extern char *index ();
60 /* Set up system_name even when dumping. */
62 Vsystem_name
= build_string (get_system_name ());
63 p
= XSTRING (Vsystem_name
)->data
;
66 if (*p
== ' ' || *p
== '\t')
72 /* Don't bother with this on initial start when just dumping out */
75 #endif /* not CANNOT_DUMP */
77 pw
= (struct passwd
*) getpwuid (getuid ());
78 Vuser_real_name
= build_string (pw
? pw
->pw_name
: "unknown");
80 /* Get the effective user name, by consulting environment variables,
81 or the effective uid if those are unset. */
82 user_name
= (char *) getenv ("USER");
84 user_name
= (char *) getenv ("LOGNAME");
87 pw
= (struct passwd
*) getpwuid (geteuid ());
88 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
90 Vuser_name
= build_string (user_name
);
92 /* If the user name claimed in the environment vars differs from
93 the real uid, use the claimed name to find the full name. */
94 tem
= Fstring_equal (Vuser_name
, Vuser_real_name
);
96 pw
= (struct passwd
*) getpwnam (XSTRING (Vuser_name
)->data
);
98 p
= (unsigned char *) (pw
? USER_FULL_NAME
: "unknown");
99 q
= (unsigned char *) index (p
, ',');
100 Vuser_full_name
= make_string (p
, q
? q
- p
: strlen (p
));
102 #ifdef AMPERSAND_FULL_NAME
103 p
= XSTRING (Vuser_full_name
)->data
;
104 q
= (char *) index (p
, '&');
105 /* Substitute the login name for the &, upcasing the first character. */
108 r
= (char *) alloca (strlen (p
) + XSTRING (Vuser_name
)->size
+ 1);
111 strcat (r
, XSTRING (Vuser_name
)->data
);
112 r
[q
- p
] = UPCASE (r
[q
- p
]);
114 Vuser_full_name
= build_string (r
);
116 #endif /* AMPERSAND_FULL_NAME */
119 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
120 "Convert arg CHAR to a one-character string containing that character.")
128 return make_string (&c
, 1);
131 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
132 "Convert arg STRING to a character, the first character of that string.")
134 register Lisp_Object str
;
136 register Lisp_Object val
;
137 register struct Lisp_String
*p
;
138 CHECK_STRING (str
, 0);
142 XFASTINT (val
) = ((unsigned char *) p
->data
)[0];
152 register Lisp_Object mark
;
153 mark
= Fmake_marker ();
154 Fset_marker (mark
, make_number (val
), Qnil
);
158 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
159 "Return value of point, as an integer.\n\
160 Beginning of buffer is position (point-min)")
164 XFASTINT (temp
) = point
;
168 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
169 "Return value of point, as a marker object.")
172 return buildmark (point
);
176 clip_to_bounds (lower
, num
, upper
)
177 int lower
, num
, upper
;
181 else if (num
> upper
)
187 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
188 "Set point to POSITION, a number or marker.\n\
189 Beginning of buffer is position (point-min), end is (point-max).")
191 register Lisp_Object n
;
193 CHECK_NUMBER_COERCE_MARKER (n
, 0);
195 SET_PT (clip_to_bounds (BEGV
, XINT (n
), ZV
));
200 region_limit (beginningp
)
203 register Lisp_Object m
;
204 m
= Fmarker_position (current_buffer
->mark
);
205 if (NULL (m
)) error ("There is no region now");
206 if ((point
< XFASTINT (m
)) == beginningp
)
207 return (make_number (point
));
212 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
213 "Return position of beginning of region, as an integer.")
216 return (region_limit (1));
219 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
220 "Return position of end of region, as an integer.")
223 return (region_limit (0));
226 #if 0 /* now in lisp code */
227 DEFUN ("mark", Fmark
, Smark
, 0, 0, 0,
228 "Return this buffer's mark value as integer, or nil if no mark.\n\
229 If you are using this in an editing command, you are most likely making\n\
230 a mistake; see the documentation of `set-mark'.")
233 return Fmarker_position (current_buffer
->mark
);
235 #endif /* commented out code */
237 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
238 "Return this buffer's mark, as a marker object.\n\
239 Watch out! Moving this marker changes the mark position.\n\
240 If you set the marker not to point anywhere, the buffer will have no mark.")
243 return current_buffer
->mark
;
246 #if 0 /* this is now in lisp code */
247 DEFUN ("set-mark", Fset_mark
, Sset_mark
, 1, 1, 0,
248 "Set this buffer's mark to POS. Don't use this function!\n\
249 That is to say, don't use this function unless you want\n\
250 the user to see that the mark has moved, and you want the previous\n\
251 mark position to be lost.\n\
253 Normally, when a new mark is set, the old one should go on the stack.\n\
254 This is why most applications should use push-mark, not set-mark.\n\
256 Novice programmers often try to use the mark for the wrong purposes.\n\
257 The mark saves a location for the user's convenience.\n\
258 Most editing commands should not alter the mark.\n\
259 To remember a location for internal use in the Lisp program,\n\
260 store it in a Lisp variable. Example:\n\
262 (let ((beg (point))) (forward-line 1) (delete-region beg (point))).")
268 current_buffer
->mark
= Qnil
;
271 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
273 if (NULL (current_buffer
->mark
))
274 current_buffer
->mark
= Fmake_marker ();
276 Fset_marker (current_buffer
->mark
, pos
, Qnil
);
279 #endif /* commented-out code */
282 save_excursion_save ()
284 register int visible
= XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
;
286 return Fcons (Fpoint_marker (),
287 Fcons (Fcopy_marker (current_buffer
->mark
), visible
? Qt
: Qnil
));
291 save_excursion_restore (info
)
292 register Lisp_Object info
;
294 register Lisp_Object tem
;
296 tem
= Fmarker_buffer (Fcar (info
));
297 /* If buffer being returned to is now deleted, avoid error */
298 /* Otherwise could get error here while unwinding to top level
300 /* In that case, Fmarker_buffer returns nil now. */
306 unchain_marker (tem
);
307 tem
= Fcar (Fcdr (info
));
308 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
309 unchain_marker (tem
);
310 tem
= Fcdr (Fcdr (info
));
311 if (!NULL (tem
) && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
312 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
316 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
317 "Save point, mark, and current buffer; execute BODY; restore those things.\n\
318 Executes BODY just like `progn'.\n\
319 The values of point, mark and the current buffer are restored\n\
320 even in case of abnormal exit (throw or error).")
324 register Lisp_Object val
;
325 int count
= specpdl_ptr
- specpdl
;
327 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
330 return unbind_to (count
, val
);
333 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 0, 0,
334 "Return the number of characters in the current buffer.")
338 XFASTINT (temp
) = Z
- BEG
;
342 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
343 "Return the minimum permissible value of point in the current buffer.\n\
344 This is 1, unless a clipping restriction is in effect.")
348 XFASTINT (temp
) = BEGV
;
352 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
353 "Return a marker to the minimum permissible value of point in this buffer.\n\
354 This is the beginning, unless a clipping restriction is in effect.")
357 return buildmark (BEGV
);
360 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
361 "Return the maximum permissible value of point in the current buffer.\n\
362 This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
363 in which case it is less.")
367 XFASTINT (temp
) = ZV
;
371 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
372 "Return a marker to the maximum permissible value of point in this buffer.\n\
373 This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
374 in which case it is less.")
377 return buildmark (ZV
);
380 DEFUN ("following-char", Ffollchar
, Sfollchar
, 0, 0, 0,
381 "Return the character following point, as a number.")
385 XFASTINT (temp
) = FETCH_CHAR (point
);
389 DEFUN ("preceding-char", Fprevchar
, Sprevchar
, 0, 0, 0,
390 "Return the character preceding point, as a number.")
397 XFASTINT (temp
) = FETCH_CHAR (point
- 1);
401 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
402 "Return T if point is at the beginning of the buffer.\n\
403 If the buffer is narrowed, this means the beginning of the narrowed part.")
411 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
412 "Return T if point is at the end of the buffer.\n\
413 If the buffer is narrowed, this means the end of the narrowed part.")
421 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
422 "Return T if point is at the beginning of a line.")
425 if (point
== BEGV
|| FETCH_CHAR (point
- 1) == '\n')
430 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
431 "Return T if point is at the end of a line.\n\
432 `End of a line' includes point being at the end of the buffer.")
435 if (point
== ZV
|| FETCH_CHAR (point
) == '\n')
440 DEFUN ("char-after", Fchar_after
, Schar_after
, 1, 1, 0,
441 "Return character in current buffer at position POS.\n\
442 POS is an integer or a buffer pointer.\n\
443 If POS is out of range, the value is nil.")
447 register Lisp_Object val
;
450 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
453 if (n
< BEGV
|| n
>= ZV
) return Qnil
;
455 XFASTINT (val
) = FETCH_CHAR (n
);
459 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 0, 0,
460 "Return the name under which the user logged in, as a string.\n\
461 This is based on the effective uid, not the real uid.\n\
462 Also, if the environment variable USER or LOGNAME is set,\n\
463 that determines the value of this function.")
469 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
471 "Return the name of the user's real uid, as a string.\n\
472 Differs from `user-login-name' when running under `su'.")
475 return Vuser_real_name
;
478 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
479 "Return the effective uid of Emacs, as an integer.")
482 return make_number (geteuid ());
485 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
486 "Return the real uid of Emacs, as an integer.")
489 return make_number (getuid ());
492 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 0, 0,
493 "Return the full name of the user logged in, as a string.")
496 return Vuser_full_name
;
499 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
500 "Return the name of the machine you are running on, as a string.")
506 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 0, 0,
507 "Return the current time, as a human-readable string.\n\
508 Programs can use it too, since the number of columns in each field is fixed.\n\
509 The format is `Sun Sep 16 01:03:52 1973'.\n\
510 In a future Emacs version, the time zone may be added at the end,\n\
511 if we can figure out a reasonably easy way to get that information.")
514 long current_time
= time ((long *) 0);
516 register char *tem
= (char *) ctime (¤t_time
);
518 strncpy (buf
, tem
, 24);
521 return build_string (buf
);
526 DEFUN ("set-default-file-mode", Fset_default_file_mode
, Sset_default_file_mode
, 1, 1, "p",
527 "Set Unix `umask' value to ARGUMENT, and return old value.\n\
528 The `umask' value is the default protection mode for new files.")
532 CHECK_NUMBER (nmask
, 0);
533 return make_number (umask (XINT (nmask
)));
536 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
537 "Tell Unix to finish all pending disk updates.")
554 /* Callers passing one argument to Finsert need not gcpro the
555 argument "array", since the only element of the array will
556 not be used after calling insert or insert_from_string, so
557 we don't care if it gets trashed. */
559 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
560 "Insert the arguments, either strings or characters, at point.\n\
561 Point moves forward so that it ends up after the inserted text.\n\
562 Any other markers at the point of insertion remain before the text.")
565 register Lisp_Object
*args
;
568 register Lisp_Object tem
;
571 for (argnum
= 0; argnum
< nargs
; argnum
++)
575 if (XTYPE (tem
) == Lisp_Int
)
580 else if (XTYPE (tem
) == Lisp_String
)
582 insert_from_string (tem
, 0, XSTRING (tem
)->size
);
586 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
594 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
595 "Insert strings or characters at point, relocating markers after the text.\n\
596 Point moves forward so that it ends up after the inserted text.\n\
597 Any other markers at the point of insertion also end up after the text.")
600 register Lisp_Object
*args
;
603 register Lisp_Object tem
;
606 for (argnum
= 0; argnum
< nargs
; argnum
++)
610 if (XTYPE (tem
) == Lisp_Int
)
613 insert_before_markers (str
, 1);
615 else if (XTYPE (tem
) == Lisp_String
)
617 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
);
621 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
629 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 2, 0,
630 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
631 Point and all markers are affected as in the function `insert'.\n\
632 Both arguments are required.")
634 Lisp_Object chr
, count
;
636 register unsigned char *string
;
640 CHECK_NUMBER (chr
, 0);
641 CHECK_NUMBER (count
, 1);
646 strlen
= min (n
, 256);
647 string
= (unsigned char *) alloca (strlen
);
648 for (i
= 0; i
< strlen
; i
++)
649 string
[i
] = XFASTINT (chr
);
652 insert (string
, strlen
);
661 /* Return a string with the contents of the current region */
663 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
664 "Return the contents of part of the current buffer as a string.\n\
665 The two arguments START and END are character positions;\n\
666 they can be in either order.")
670 register int beg
, end
;
673 validate_region (&b
, &e
);
677 if (beg
< GPT
&& end
> GPT
)
680 /* Plain old make_string calls make_uninit_string, which can cause
681 the buffer arena to be compacted. make_string has no way of
682 knowing that the data has been moved, and thus copies the wrong
683 data into the string. This doesn't effect most of the other
684 users of make_string, so it should be left as is. */
685 result
= make_uninit_string (end
- beg
);
686 bcopy (&FETCH_CHAR (beg
), XSTRING (result
)->data
, end
- beg
);
691 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
692 "Return the contents of the current buffer as a string.")
695 if (BEGV
< GPT
&& ZV
> GPT
)
697 return make_string (BEGV_ADDR
, ZV
- BEGV
);
700 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
702 "Insert before point a substring of the contents buffer BUFFER.\n\
703 BUFFER may be a buffer or a buffer name.\n\
704 Arguments START and END are character numbers specifying the substring.\n\
705 They default to the beginning and the end of BUFFER.")
707 Lisp_Object buf
, b
, e
;
709 register int beg
, end
, exch
;
710 register struct buffer
*bp
;
712 buf
= Fget_buffer (buf
);
719 CHECK_NUMBER_COERCE_MARKER (b
, 0);
726 CHECK_NUMBER_COERCE_MARKER (e
, 1);
731 exch
= beg
, beg
= end
, end
= exch
;
733 /* Move the gap or create enough gap in the current buffer. */
737 if (GAP_SIZE
< end
- beg
)
738 make_gap (end
- beg
- GAP_SIZE
);
740 if (!(BUF_BEGV (bp
) <= beg
742 && end
<= BUF_ZV (bp
)))
743 args_out_of_range (b
, e
);
745 /* Now the actual insertion will not do any gap motion,
746 so it matters not if BUF is the current buffer. */
747 if (beg
< BUF_GPT (bp
))
749 insert (BUF_CHAR_ADDRESS (bp
, beg
), min (end
, BUF_GPT (bp
)) - beg
);
750 beg
= min (end
, BUF_GPT (bp
));
753 insert (BUF_CHAR_ADDRESS (bp
, beg
), end
- beg
);
758 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
759 Ssubst_char_in_region
, 4, 5, 0,
760 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
761 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
762 and don't mark the buffer as really changed.")
763 (start
, end
, fromchar
, tochar
, noundo
)
764 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
766 register int pos
, stop
, look
;
768 validate_region (&start
, &end
);
769 CHECK_NUMBER (fromchar
, 2);
770 CHECK_NUMBER (tochar
, 3);
774 look
= XINT (fromchar
);
776 modify_region (pos
, stop
);
779 if (MODIFF
- 1 == current_buffer
->save_modified
)
780 current_buffer
->save_modified
++;
781 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
782 current_buffer
->auto_save_modified
++;
787 if (FETCH_CHAR (pos
) == look
)
790 record_change (pos
, 1);
791 FETCH_CHAR (pos
) = XINT (tochar
);
793 signal_after_change (pos
, 1, 1);
801 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
802 "From START to END, translate characters according to TABLE.\n\
803 TABLE is a string; the Nth character in it is the mapping\n\
804 for the character with code N. Returns the number of characters changed.")
808 register Lisp_Object table
;
810 register int pos
, stop
; /* Limits of the region. */
811 register unsigned char *tt
; /* Trans table. */
812 register int oc
; /* Old character. */
813 register int nc
; /* New character. */
814 int cnt
; /* Number of changes made. */
815 Lisp_Object z
; /* Return. */
816 int size
; /* Size of translate table. */
818 validate_region (&start
, &end
);
819 CHECK_STRING (table
, 2);
821 size
= XSTRING (table
)->size
;
822 tt
= XSTRING (table
)->data
;
826 modify_region (pos
, stop
);
829 for (; pos
< stop
; ++pos
)
831 oc
= FETCH_CHAR (pos
);
837 record_change (pos
, 1);
838 FETCH_CHAR (pos
) = nc
;
839 signal_after_change (pos
, 1, 1);
849 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
850 "Delete the text between point and mark.\n\
851 When called from a program, expects two arguments,\n\
852 positions (integers or markers) specifying the stretch to be deleted.")
856 validate_region (&b
, &e
);
857 del_range (XINT (b
), XINT (e
));
861 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
862 "Remove restrictions (narrowing) from current buffer.\n\
863 This allows the buffer's full text to be seen and edited.")
867 SET_BUF_ZV (current_buffer
, Z
);
869 /* Changing the buffer bounds invalidates any recorded current column. */
870 invalidate_current_column ();
874 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
875 "Restrict editing in this buffer to the current region.\n\
876 The rest of the text becomes temporarily invisible and untouchable\n\
877 but is not deleted; if you save the buffer in a file, the invisible\n\
878 text is included in the file. \\[widen] makes all visible again.\n\
879 See also `save-restriction'.\n\
881 When calling from a program, pass two arguments; positions (integers\n\
882 or markers) bounding the text that should remain visible.")
884 register Lisp_Object b
, e
;
888 CHECK_NUMBER_COERCE_MARKER (b
, 0);
889 CHECK_NUMBER_COERCE_MARKER (e
, 1);
891 if (XINT (b
) > XINT (e
))
898 if (!(BEG
<= XINT (b
) && XINT (b
) <= XINT (e
) && XINT (e
) <= Z
))
899 args_out_of_range (b
, e
);
902 SET_BUF_ZV (current_buffer
, XFASTINT (e
));
903 if (point
< XFASTINT (b
))
904 SET_PT (XFASTINT (b
));
905 if (point
> XFASTINT (e
))
906 SET_PT (XFASTINT (e
));
908 /* Changing the buffer bounds invalidates any recorded current column. */
909 invalidate_current_column ();
914 save_restriction_save ()
916 register Lisp_Object bottom
, top
;
917 /* Note: I tried using markers here, but it does not win
918 because insertion at the end of the saved region
919 does not advance mh and is considered "outside" the saved region. */
920 XFASTINT (bottom
) = BEGV
- BEG
;
921 XFASTINT (top
) = Z
- ZV
;
923 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
927 save_restriction_restore (data
)
930 register struct buffer
*buf
;
931 register int newhead
, newtail
;
932 register Lisp_Object tem
;
934 buf
= XBUFFER (XCONS (data
)->car
);
936 data
= XCONS (data
)->cdr
;
938 tem
= XCONS (data
)->car
;
939 newhead
= XINT (tem
);
940 tem
= XCONS (data
)->cdr
;
941 newtail
= XINT (tem
);
942 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
947 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
948 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
951 /* If point is outside the new visible range, move it inside. */
953 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
958 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
959 "Execute BODY, saving and restoring current buffer's restrictions.\n\
960 The buffer's restrictions make parts of the beginning and end invisible.\n\
961 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
962 This special form, `save-restriction', saves the current buffer's restrictions\n\
963 when it is entered, and restores them when it is exited.\n\
964 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
965 The old restrictions settings are restored\n\
966 even in case of abnormal exit (throw or error).\n\
968 The value returned is the value of the last form in BODY.\n\
970 `save-restriction' can get confused if, within the BODY, you widen\n\
971 and then make changes outside the area within the saved restrictions.\n\
973 Note: if you are using both `save-excursion' and `save-restriction',\n\
974 use `save-excursion' outermost:\n\
975 (save-excursion (save-restriction ...))")
979 register Lisp_Object val
;
980 int count
= specpdl_ptr
- specpdl
;
982 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
984 return unbind_to (count
, val
);
987 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
988 "Print a one-line message at the bottom of the screen.\n\
989 The first argument is a control string.\n\
990 It may contain %s or %d or %c to print successive following arguments.\n\
991 %s means print an argument as a string, %d means print as number in decimal,\n\
992 %c means print a number as a single character.\n\
993 The argument used by %s must be a string or a symbol;\n\
994 the argument used by %d or %c must be a number.")
999 register Lisp_Object val
;
1002 extern Lisp_Object Vglobal_minibuffer_screen
;
1004 if (XTYPE (Vglobal_minibuffer_screen
) == Lisp_Screen
)
1005 Fmake_screen_visible (Vglobal_minibuffer_screen
);
1008 val
= Fformat (nargs
, args
);
1009 message ("%s", XSTRING (val
)->data
);
1013 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1014 "Format a string out of a control-string and arguments.\n\
1015 The first argument is a control string.\n\
1016 The other arguments are substituted into it to make the result, a string.\n\
1017 It may contain %-sequences meaning to substitute the next argument.\n\
1018 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1019 %d means print as number in decimal (%o octal, %x hex).\n\
1020 %c means print a number as a single character.\n\
1021 %S means print any object as an s-expression (using prin1).\n\
1022 The argument used for %d, %o, %x or %c must be a number.\n\
1023 Use %% to put a single % into the output.")
1026 register Lisp_Object
*args
;
1028 register int n
; /* The number of the next arg to substitute */
1029 register int total
= 5; /* An estimate of the final length */
1031 register unsigned char *format
, *end
;
1033 extern char *index ();
1034 /* It should not be necessary to GCPRO ARGS, because
1035 the caller in the interpreter should take care of that. */
1037 CHECK_STRING (args
[0], 0);
1038 format
= XSTRING (args
[0])->data
;
1039 end
= format
+ XSTRING (args
[0])->size
;
1042 while (format
!= end
)
1043 if (*format
++ == '%')
1047 /* Process a numeric arg and skip it. */
1048 minlen
= atoi (format
);
1053 while ((*format
>= '0' && *format
<= '9')
1054 || *format
== '-' || *format
== ' ' || *format
== '.')
1059 else if (++n
>= nargs
)
1061 else if (*format
== 'S')
1063 /* For `S', prin1 the argument and then treat like a string. */
1064 register Lisp_Object tem
;
1065 tem
= Fprin1_to_string (args
[n
], Qnil
);
1069 else if (XTYPE (args
[n
]) == Lisp_Symbol
)
1071 XSET (args
[n
], Lisp_String
, XSYMBOL (args
[n
])->name
);
1074 else if (XTYPE (args
[n
]) == Lisp_String
)
1077 total
+= XSTRING (args
[n
])->size
;
1079 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1080 else if (XTYPE (args
[n
]) == Lisp_Int
&& *format
!= 's')
1082 /* The following loop issumes the Lisp type indicates
1083 the proper way to pass the argument.
1084 So make sure we have a flonum if the argument should
1086 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1087 args
[n
] = Ffloat (args
[n
]);
1090 else if (XTYPE (args
[n
]) == Lisp_Float
&& *format
!= 's')
1092 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1093 args
[n
] = Ftruncate (args
[n
]);
1098 /* Anything but a string, convert to a string using princ. */
1099 register Lisp_Object tem
;
1100 tem
= Fprin1_to_string (args
[n
], Qt
);
1107 register int nstrings
= n
+ 1;
1108 register unsigned char **strings
1109 = (unsigned char **) alloca (nstrings
* sizeof (unsigned char *));
1111 for (n
= 0; n
< nstrings
; n
++)
1114 strings
[n
] = (unsigned char *) "";
1115 else if (XTYPE (args
[n
]) == Lisp_Int
)
1116 /* We checked above that the corresponding format effector
1117 isn't %s, which would cause MPV. */
1118 strings
[n
] = (unsigned char *) XINT (args
[n
]);
1119 else if (XTYPE (args
[n
]) == Lisp_Float
)
1121 union { double d
; int half
[2]; } u
;
1123 u
.d
= XFLOAT (args
[n
])->data
;
1124 strings
[n
++] = (unsigned char *) u
.half
[0];
1125 strings
[n
] = (unsigned char *) u
.half
[1];
1128 strings
[n
] = XSTRING (args
[n
])->data
;
1131 /* Format it in bigger and bigger buf's until it all fits. */
1134 buf
= (char *) alloca (total
+ 1);
1137 length
= doprnt (buf
, total
+ 1, strings
[0], end
, nargs
, strings
+ 1);
1138 if (buf
[total
- 1] == 0)
1146 return make_string (buf
, length
);
1152 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1153 int arg0
, arg1
, arg2
, arg3
, arg4
;
1167 doprnt (buf
, sizeof buf
, string1
, 0, 5, args
);
1169 doprnt (buf
, sizeof buf
, string1
, 0, 5, &string1
+ 1);
1171 return build_string (buf
);
1174 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1175 "Return t if two characters match, optionally ignoring case.\n\
1176 Both arguments must be characters (i.e. integers).\n\
1177 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1179 register Lisp_Object c1
, c2
;
1181 unsigned char *downcase
= DOWNCASE_TABLE
;
1182 CHECK_NUMBER (c1
, 0);
1183 CHECK_NUMBER (c2
, 1);
1185 if (!NULL (current_buffer
->case_fold_search
)
1186 ? downcase
[0xff & XFASTINT (c1
)] == downcase
[0xff & XFASTINT (c2
)]
1187 : XINT (c1
) == XINT (c2
))
1192 #ifndef MAINTAIN_ENVIRONMENT /* it is done in environ.c in that case */
1193 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 2, 0,
1194 "Return the value of environment variable VAR, as a string.\n\
1195 VAR should be a string. Value is nil if VAR is undefined in the environment.")
1200 CHECK_STRING (str
, 0);
1201 val
= (char *) egetenv (XSTRING (str
)->data
);
1204 return build_string (val
);
1206 #endif /* MAINTAIN_ENVIRONMENT */
1211 DEFVAR_LISP ("system-name", &Vsystem_name
,
1212 "The name of the machine Emacs is running on.");
1214 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
1215 "The full name of the user logged in.");
1217 DEFVAR_LISP ("user-name", &Vuser_name
,
1218 "The user's name, based on the effective uid.");
1220 DEFVAR_LISP ("user-real-name", &Vuser_real_name
,
1221 "The user's name, base upon the real uid.");
1223 defsubr (&Schar_equal
);
1224 defsubr (&Sgoto_char
);
1225 defsubr (&Sstring_to_char
);
1226 defsubr (&Schar_to_string
);
1227 defsubr (&Sbuffer_substring
);
1228 defsubr (&Sbuffer_string
);
1230 defsubr (&Spoint_marker
);
1231 defsubr (&Smark_marker
);
1233 defsubr (&Sregion_beginning
);
1234 defsubr (&Sregion_end
);
1235 /* defsubr (&Smark); */
1236 /* defsubr (&Sset_mark); */
1237 defsubr (&Ssave_excursion
);
1239 defsubr (&Sbufsize
);
1240 defsubr (&Spoint_max
);
1241 defsubr (&Spoint_min
);
1242 defsubr (&Spoint_min_marker
);
1243 defsubr (&Spoint_max_marker
);
1249 defsubr (&Sfollchar
);
1250 defsubr (&Sprevchar
);
1251 defsubr (&Schar_after
);
1253 defsubr (&Sinsert_before_markers
);
1254 defsubr (&Sinsert_char
);
1256 defsubr (&Suser_login_name
);
1257 defsubr (&Suser_real_login_name
);
1258 defsubr (&Suser_uid
);
1259 defsubr (&Suser_real_uid
);
1260 defsubr (&Suser_full_name
);
1261 defsubr (&Scurrent_time_string
);
1262 defsubr (&Ssystem_name
);
1263 defsubr (&Sset_default_file_mode
);
1264 defsubr (&Sunix_sync
);
1265 defsubr (&Smessage
);
1267 #ifndef MAINTAIN_ENVIRONMENT /* in environ.c */
1271 defsubr (&Sinsert_buffer_substring
);
1272 defsubr (&Ssubst_char_in_region
);
1273 defsubr (&Stranslate_region
);
1274 defsubr (&Sdelete_region
);
1276 defsubr (&Snarrow_to_region
);
1277 defsubr (&Ssave_restriction
);