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 (NILP (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 (NILP (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 (!NILP (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", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
381 "Return the character following point, as a number.\n\
382 At the end of the buffer or accessible region, return 0.")
389 XFASTINT (temp
) = FETCH_CHAR (point
);
393 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
394 "Return the character preceding point, as a number.\n\
395 At the beginning of the buffer or accessible region, return 0.")
402 XFASTINT (temp
) = FETCH_CHAR (point
- 1);
406 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
407 "Return T if point is at the beginning of the buffer.\n\
408 If the buffer is narrowed, this means the beginning of the narrowed part.")
416 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
417 "Return T if point is at the end of the buffer.\n\
418 If the buffer is narrowed, this means the end of the narrowed part.")
426 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
427 "Return T if point is at the beginning of a line.")
430 if (point
== BEGV
|| FETCH_CHAR (point
- 1) == '\n')
435 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
436 "Return T if point is at the end of a line.\n\
437 `End of a line' includes point being at the end of the buffer.")
440 if (point
== ZV
|| FETCH_CHAR (point
) == '\n')
445 DEFUN ("char-after", Fchar_after
, Schar_after
, 1, 1, 0,
446 "Return character in current buffer at position POS.\n\
447 POS is an integer or a buffer pointer.\n\
448 If POS is out of range, the value is nil.")
452 register Lisp_Object val
;
455 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
458 if (n
< BEGV
|| n
>= ZV
) return Qnil
;
460 XFASTINT (val
) = FETCH_CHAR (n
);
464 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 0, 0,
465 "Return the name under which the user logged in, as a string.\n\
466 This is based on the effective uid, not the real uid.\n\
467 Also, if the environment variable USER or LOGNAME is set,\n\
468 that determines the value of this function.")
474 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
476 "Return the name of the user's real uid, as a string.\n\
477 Differs from `user-login-name' when running under `su'.")
480 return Vuser_real_name
;
483 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
484 "Return the effective uid of Emacs, as an integer.")
487 return make_number (geteuid ());
490 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
491 "Return the real uid of Emacs, as an integer.")
494 return make_number (getuid ());
497 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 0, 0,
498 "Return the full name of the user logged in, as a string.")
501 return Vuser_full_name
;
504 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
505 "Return the name of the machine you are running on, as a string.")
511 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
512 "Return the current time, as an integer.")
515 return make_number (time(0));
519 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 0, 0,
520 "Return the current time, as a human-readable string.\n\
521 Programs can use it too, since the number of columns in each field is fixed.\n\
522 The format is `Sun Sep 16 01:03:52 1973'.\n\
523 In a future Emacs version, the time zone may be added at the end,\n\
524 if we can figure out a reasonably easy way to get that information.")
527 long current_time
= time ((long *) 0);
529 register char *tem
= (char *) ctime (¤t_time
);
531 strncpy (buf
, tem
, 24);
534 return build_string (buf
);
539 DEFUN ("set-default-file-mode", Fset_default_file_mode
, Sset_default_file_mode
, 1, 1, "p",
540 "Set Unix `umask' value to ARGUMENT, and return old value.\n\
541 The `umask' value is the default protection mode for new files.")
545 CHECK_NUMBER (nmask
, 0);
546 return make_number (umask (XINT (nmask
)));
549 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
550 "Tell Unix to finish all pending disk updates.")
567 /* Callers passing one argument to Finsert need not gcpro the
568 argument "array", since the only element of the array will
569 not be used after calling insert or insert_from_string, so
570 we don't care if it gets trashed. */
572 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
573 "Insert the arguments, either strings or characters, at point.\n\
574 Point moves forward so that it ends up after the inserted text.\n\
575 Any other markers at the point of insertion remain before the text.")
578 register Lisp_Object
*args
;
581 register Lisp_Object tem
;
584 for (argnum
= 0; argnum
< nargs
; argnum
++)
588 if (XTYPE (tem
) == Lisp_Int
)
593 else if (XTYPE (tem
) == Lisp_String
)
595 insert_from_string (tem
, 0, XSTRING (tem
)->size
);
599 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
607 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
608 "Insert strings or characters at point, relocating markers after the text.\n\
609 Point moves forward so that it ends up after the inserted text.\n\
610 Any other markers at the point of insertion also end up after the text.")
613 register Lisp_Object
*args
;
616 register Lisp_Object tem
;
619 for (argnum
= 0; argnum
< nargs
; argnum
++)
623 if (XTYPE (tem
) == Lisp_Int
)
626 insert_before_markers (str
, 1);
628 else if (XTYPE (tem
) == Lisp_String
)
630 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
);
634 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
642 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 2, 0,
643 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
644 Point and all markers are affected as in the function `insert'.\n\
645 Both arguments are required.")
647 Lisp_Object chr
, count
;
649 register unsigned char *string
;
653 CHECK_NUMBER (chr
, 0);
654 CHECK_NUMBER (count
, 1);
659 strlen
= min (n
, 256);
660 string
= (unsigned char *) alloca (strlen
);
661 for (i
= 0; i
< strlen
; i
++)
662 string
[i
] = XFASTINT (chr
);
665 insert (string
, strlen
);
674 /* Return a string with the contents of the current region */
676 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
677 "Return the contents of part of the current buffer as a string.\n\
678 The two arguments START and END are character positions;\n\
679 they can be in either order.")
683 register int beg
, end
;
686 validate_region (&b
, &e
);
690 if (beg
< GPT
&& end
> GPT
)
693 /* Plain old make_string calls make_uninit_string, which can cause
694 the buffer arena to be compacted. make_string has no way of
695 knowing that the data has been moved, and thus copies the wrong
696 data into the string. This doesn't effect most of the other
697 users of make_string, so it should be left as is. */
698 result
= make_uninit_string (end
- beg
);
699 bcopy (&FETCH_CHAR (beg
), XSTRING (result
)->data
, end
- beg
);
704 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
705 "Return the contents of the current buffer as a string.")
708 if (BEGV
< GPT
&& ZV
> GPT
)
710 return make_string (BEGV_ADDR
, ZV
- BEGV
);
713 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
715 "Insert before point a substring of the contents buffer BUFFER.\n\
716 BUFFER may be a buffer or a buffer name.\n\
717 Arguments START and END are character numbers specifying the substring.\n\
718 They default to the beginning and the end of BUFFER.")
720 Lisp_Object buf
, b
, e
;
722 register int beg
, end
, exch
;
723 register struct buffer
*bp
;
725 buf
= Fget_buffer (buf
);
732 CHECK_NUMBER_COERCE_MARKER (b
, 0);
739 CHECK_NUMBER_COERCE_MARKER (e
, 1);
744 exch
= beg
, beg
= end
, end
= exch
;
746 /* Move the gap or create enough gap in the current buffer. */
750 if (GAP_SIZE
< end
- beg
)
751 make_gap (end
- beg
- GAP_SIZE
);
753 if (!(BUF_BEGV (bp
) <= beg
755 && end
<= BUF_ZV (bp
)))
756 args_out_of_range (b
, e
);
758 /* Now the actual insertion will not do any gap motion,
759 so it matters not if BUF is the current buffer. */
760 if (beg
< BUF_GPT (bp
))
762 insert (BUF_CHAR_ADDRESS (bp
, beg
), min (end
, BUF_GPT (bp
)) - beg
);
763 beg
= min (end
, BUF_GPT (bp
));
766 insert (BUF_CHAR_ADDRESS (bp
, beg
), end
- beg
);
771 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
772 Ssubst_char_in_region
, 4, 5, 0,
773 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
774 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
775 and don't mark the buffer as really changed.")
776 (start
, end
, fromchar
, tochar
, noundo
)
777 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
779 register int pos
, stop
, look
;
781 validate_region (&start
, &end
);
782 CHECK_NUMBER (fromchar
, 2);
783 CHECK_NUMBER (tochar
, 3);
787 look
= XINT (fromchar
);
789 modify_region (pos
, stop
);
792 if (MODIFF
- 1 == current_buffer
->save_modified
)
793 current_buffer
->save_modified
++;
794 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
795 current_buffer
->auto_save_modified
++;
800 if (FETCH_CHAR (pos
) == look
)
803 record_change (pos
, 1);
804 FETCH_CHAR (pos
) = XINT (tochar
);
806 signal_after_change (pos
, 1, 1);
814 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
815 "From START to END, translate characters according to TABLE.\n\
816 TABLE is a string; the Nth character in it is the mapping\n\
817 for the character with code N. Returns the number of characters changed.")
821 register Lisp_Object table
;
823 register int pos
, stop
; /* Limits of the region. */
824 register unsigned char *tt
; /* Trans table. */
825 register int oc
; /* Old character. */
826 register int nc
; /* New character. */
827 int cnt
; /* Number of changes made. */
828 Lisp_Object z
; /* Return. */
829 int size
; /* Size of translate table. */
831 validate_region (&start
, &end
);
832 CHECK_STRING (table
, 2);
834 size
= XSTRING (table
)->size
;
835 tt
= XSTRING (table
)->data
;
839 modify_region (pos
, stop
);
842 for (; pos
< stop
; ++pos
)
844 oc
= FETCH_CHAR (pos
);
850 record_change (pos
, 1);
851 FETCH_CHAR (pos
) = nc
;
852 signal_after_change (pos
, 1, 1);
862 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
863 "Delete the text between point and mark.\n\
864 When called from a program, expects two arguments,\n\
865 positions (integers or markers) specifying the stretch to be deleted.")
869 validate_region (&b
, &e
);
870 del_range (XINT (b
), XINT (e
));
874 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
875 "Remove restrictions (narrowing) from current buffer.\n\
876 This allows the buffer's full text to be seen and edited.")
880 SET_BUF_ZV (current_buffer
, Z
);
882 /* Changing the buffer bounds invalidates any recorded current column. */
883 invalidate_current_column ();
887 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
888 "Restrict editing in this buffer to the current region.\n\
889 The rest of the text becomes temporarily invisible and untouchable\n\
890 but is not deleted; if you save the buffer in a file, the invisible\n\
891 text is included in the file. \\[widen] makes all visible again.\n\
892 See also `save-restriction'.\n\
894 When calling from a program, pass two arguments; positions (integers\n\
895 or markers) bounding the text that should remain visible.")
897 register Lisp_Object b
, e
;
901 CHECK_NUMBER_COERCE_MARKER (b
, 0);
902 CHECK_NUMBER_COERCE_MARKER (e
, 1);
904 if (XINT (b
) > XINT (e
))
911 if (!(BEG
<= XINT (b
) && XINT (b
) <= XINT (e
) && XINT (e
) <= Z
))
912 args_out_of_range (b
, e
);
915 SET_BUF_ZV (current_buffer
, XFASTINT (e
));
916 if (point
< XFASTINT (b
))
917 SET_PT (XFASTINT (b
));
918 if (point
> XFASTINT (e
))
919 SET_PT (XFASTINT (e
));
921 /* Changing the buffer bounds invalidates any recorded current column. */
922 invalidate_current_column ();
927 save_restriction_save ()
929 register Lisp_Object bottom
, top
;
930 /* Note: I tried using markers here, but it does not win
931 because insertion at the end of the saved region
932 does not advance mh and is considered "outside" the saved region. */
933 XFASTINT (bottom
) = BEGV
- BEG
;
934 XFASTINT (top
) = Z
- ZV
;
936 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
940 save_restriction_restore (data
)
943 register struct buffer
*buf
;
944 register int newhead
, newtail
;
945 register Lisp_Object tem
;
947 buf
= XBUFFER (XCONS (data
)->car
);
949 data
= XCONS (data
)->cdr
;
951 tem
= XCONS (data
)->car
;
952 newhead
= XINT (tem
);
953 tem
= XCONS (data
)->cdr
;
954 newtail
= XINT (tem
);
955 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
960 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
961 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
964 /* If point is outside the new visible range, move it inside. */
966 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
971 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
972 "Execute BODY, saving and restoring current buffer's restrictions.\n\
973 The buffer's restrictions make parts of the beginning and end invisible.\n\
974 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
975 This special form, `save-restriction', saves the current buffer's restrictions\n\
976 when it is entered, and restores them when it is exited.\n\
977 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
978 The old restrictions settings are restored\n\
979 even in case of abnormal exit (throw or error).\n\
981 The value returned is the value of the last form in BODY.\n\
983 `save-restriction' can get confused if, within the BODY, you widen\n\
984 and then make changes outside the area within the saved restrictions.\n\
986 Note: if you are using both `save-excursion' and `save-restriction',\n\
987 use `save-excursion' outermost:\n\
988 (save-excursion (save-restriction ...))")
992 register Lisp_Object val
;
993 int count
= specpdl_ptr
- specpdl
;
995 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
997 return unbind_to (count
, val
);
1000 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
1001 "Print a one-line message at the bottom of the screen.\n\
1002 The first argument is a control string.\n\
1003 It may contain %s or %d or %c to print successive following arguments.\n\
1004 %s means print an argument as a string, %d means print as number in decimal,\n\
1005 %c means print a number as a single character.\n\
1006 The argument used by %s must be a string or a symbol;\n\
1007 the argument used by %d or %c must be a number.")
1012 register Lisp_Object val
;
1014 val
= Fformat (nargs
, args
);
1015 message ("%s", XSTRING (val
)->data
);
1019 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1020 "Format a string out of a control-string and arguments.\n\
1021 The first argument is a control string.\n\
1022 The other arguments are substituted into it to make the result, a string.\n\
1023 It may contain %-sequences meaning to substitute the next argument.\n\
1024 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1025 %d means print as number in decimal (%o octal, %x hex).\n\
1026 %c means print a number as a single character.\n\
1027 %S means print any object as an s-expression (using prin1).\n\
1028 The argument used for %d, %o, %x or %c must be a number.\n\
1029 Use %% to put a single % into the output.")
1032 register Lisp_Object
*args
;
1034 register int n
; /* The number of the next arg to substitute */
1035 register int total
= 5; /* An estimate of the final length */
1037 register unsigned char *format
, *end
;
1039 extern char *index ();
1040 /* It should not be necessary to GCPRO ARGS, because
1041 the caller in the interpreter should take care of that. */
1043 CHECK_STRING (args
[0], 0);
1044 format
= XSTRING (args
[0])->data
;
1045 end
= format
+ XSTRING (args
[0])->size
;
1048 while (format
!= end
)
1049 if (*format
++ == '%')
1053 /* Process a numeric arg and skip it. */
1054 minlen
= atoi (format
);
1059 while ((*format
>= '0' && *format
<= '9')
1060 || *format
== '-' || *format
== ' ' || *format
== '.')
1065 else if (++n
>= nargs
)
1067 else if (*format
== 'S')
1069 /* For `S', prin1 the argument and then treat like a string. */
1070 register Lisp_Object tem
;
1071 tem
= Fprin1_to_string (args
[n
], Qnil
);
1075 else if (XTYPE (args
[n
]) == Lisp_Symbol
)
1077 XSET (args
[n
], Lisp_String
, XSYMBOL (args
[n
])->name
);
1080 else if (XTYPE (args
[n
]) == Lisp_String
)
1083 total
+= XSTRING (args
[n
])->size
;
1085 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1086 else if (XTYPE (args
[n
]) == Lisp_Int
&& *format
!= 's')
1088 /* The following loop issumes the Lisp type indicates
1089 the proper way to pass the argument.
1090 So make sure we have a flonum if the argument should
1092 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1093 args
[n
] = Ffloat (args
[n
]);
1096 else if (XTYPE (args
[n
]) == Lisp_Float
&& *format
!= 's')
1098 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1099 args
[n
] = Ftruncate (args
[n
]);
1104 /* Anything but a string, convert to a string using princ. */
1105 register Lisp_Object tem
;
1106 tem
= Fprin1_to_string (args
[n
], Qt
);
1113 register int nstrings
= n
+ 1;
1114 register unsigned char **strings
1115 = (unsigned char **) alloca (nstrings
* sizeof (unsigned char *));
1117 for (n
= 0; n
< nstrings
; n
++)
1120 strings
[n
] = (unsigned char *) "";
1121 else if (XTYPE (args
[n
]) == Lisp_Int
)
1122 /* We checked above that the corresponding format effector
1123 isn't %s, which would cause MPV. */
1124 strings
[n
] = (unsigned char *) XINT (args
[n
]);
1125 else if (XTYPE (args
[n
]) == Lisp_Float
)
1127 union { double d
; int half
[2]; } u
;
1129 u
.d
= XFLOAT (args
[n
])->data
;
1130 strings
[n
++] = (unsigned char *) u
.half
[0];
1131 strings
[n
] = (unsigned char *) u
.half
[1];
1134 strings
[n
] = XSTRING (args
[n
])->data
;
1137 /* Format it in bigger and bigger buf's until it all fits. */
1140 buf
= (char *) alloca (total
+ 1);
1143 length
= doprnt (buf
, total
+ 1, strings
[0], end
, nargs
, strings
+ 1);
1144 if (buf
[total
- 1] == 0)
1152 return make_string (buf
, length
);
1158 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1159 int arg0
, arg1
, arg2
, arg3
, arg4
;
1173 doprnt (buf
, sizeof buf
, string1
, 0, 5, args
);
1175 doprnt (buf
, sizeof buf
, string1
, 0, 5, &string1
+ 1);
1177 return build_string (buf
);
1180 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1181 "Return t if two characters match, optionally ignoring case.\n\
1182 Both arguments must be characters (i.e. integers).\n\
1183 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1185 register Lisp_Object c1
, c2
;
1187 unsigned char *downcase
= DOWNCASE_TABLE
;
1188 CHECK_NUMBER (c1
, 0);
1189 CHECK_NUMBER (c2
, 1);
1191 if (!NILP (current_buffer
->case_fold_search
)
1192 ? downcase
[0xff & XFASTINT (c1
)] == downcase
[0xff & XFASTINT (c2
)]
1193 : XINT (c1
) == XINT (c2
))
1202 DEFVAR_LISP ("system-name", &Vsystem_name
,
1203 "The name of the machine Emacs is running on.");
1205 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
1206 "The full name of the user logged in.");
1208 DEFVAR_LISP ("user-name", &Vuser_name
,
1209 "The user's name, based on the effective uid.");
1211 DEFVAR_LISP ("user-real-name", &Vuser_real_name
,
1212 "The user's name, base upon the real uid.");
1214 defsubr (&Schar_equal
);
1215 defsubr (&Sgoto_char
);
1216 defsubr (&Sstring_to_char
);
1217 defsubr (&Schar_to_string
);
1218 defsubr (&Sbuffer_substring
);
1219 defsubr (&Sbuffer_string
);
1221 defsubr (&Spoint_marker
);
1222 defsubr (&Smark_marker
);
1224 defsubr (&Sregion_beginning
);
1225 defsubr (&Sregion_end
);
1226 /* defsubr (&Smark); */
1227 /* defsubr (&Sset_mark); */
1228 defsubr (&Ssave_excursion
);
1230 defsubr (&Sbufsize
);
1231 defsubr (&Spoint_max
);
1232 defsubr (&Spoint_min
);
1233 defsubr (&Spoint_min_marker
);
1234 defsubr (&Spoint_max_marker
);
1240 defsubr (&Sfollowing_char
);
1241 defsubr (&Sprevious_char
);
1242 defsubr (&Schar_after
);
1244 defsubr (&Sinsert_before_markers
);
1245 defsubr (&Sinsert_char
);
1247 defsubr (&Suser_login_name
);
1248 defsubr (&Suser_real_login_name
);
1249 defsubr (&Suser_uid
);
1250 defsubr (&Suser_real_uid
);
1251 defsubr (&Suser_full_name
);
1252 defsubr (&Scurrent_time
);
1253 defsubr (&Scurrent_time_string
);
1254 defsubr (&Ssystem_name
);
1255 defsubr (&Sset_default_file_mode
);
1256 defsubr (&Sunix_sync
);
1257 defsubr (&Smessage
);
1260 defsubr (&Sinsert_buffer_substring
);
1261 defsubr (&Ssubst_char_in_region
);
1262 defsubr (&Stranslate_region
);
1263 defsubr (&Sdelete_region
);
1265 defsubr (&Snarrow_to_region
);
1266 defsubr (&Ssave_restriction
);