1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985, 1986, 1987, 1989, 1992 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 #define min(a, b) ((a) < (b) ? (a) : (b))
36 #define max(a, b) ((a) > (b) ? (a) : (b))
38 /* Some static data, and a function to initialize it for each run */
40 Lisp_Object Vsystem_name
;
41 Lisp_Object Vuser_real_name
; /* login name of current user ID */
42 Lisp_Object Vuser_full_name
; /* full name of current user */
43 Lisp_Object Vuser_name
; /* user name from USER or LOGNAME. */
49 register unsigned char *p
, *q
, *r
;
50 struct passwd
*pw
; /* password entry for the current user */
51 extern char *index ();
54 /* Set up system_name even when dumping. */
56 Vsystem_name
= build_string (get_system_name ());
57 p
= XSTRING (Vsystem_name
)->data
;
60 if (*p
== ' ' || *p
== '\t')
66 /* Don't bother with this on initial start when just dumping out */
69 #endif /* not CANNOT_DUMP */
71 pw
= (struct passwd
*) getpwuid (getuid ());
72 Vuser_real_name
= build_string (pw
? pw
->pw_name
: "unknown");
74 /* Get the effective user name, by consulting environment variables,
75 or the effective uid if those are unset. */
76 user_name
= (char *) getenv ("USER");
78 user_name
= (char *) getenv ("LOGNAME");
81 pw
= (struct passwd
*) getpwuid (geteuid ());
82 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
84 Vuser_name
= build_string (user_name
);
86 /* If the user name claimed in the environment vars differs from
87 the real uid, use the claimed name to find the full name. */
88 tem
= Fstring_equal (Vuser_name
, Vuser_real_name
);
90 pw
= (struct passwd
*) getpwnam (XSTRING (Vuser_name
)->data
);
92 p
= (unsigned char *) (pw
? USER_FULL_NAME
: "unknown");
93 q
= (unsigned char *) index (p
, ',');
94 Vuser_full_name
= make_string (p
, q
? q
- p
: strlen (p
));
96 #ifdef AMPERSAND_FULL_NAME
97 p
= XSTRING (Vuser_full_name
)->data
;
98 q
= (char *) index (p
, '&');
99 /* Substitute the login name for the &, upcasing the first character. */
102 r
= (char *) alloca (strlen (p
) + XSTRING (Vuser_name
)->size
+ 1);
105 strcat (r
, XSTRING (Vuser_name
)->data
);
106 r
[q
- p
] = UPCASE (r
[q
- p
]);
108 Vuser_full_name
= build_string (r
);
110 #endif /* AMPERSAND_FULL_NAME */
113 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
114 "Convert arg CHAR to a one-character string containing that character.")
122 return make_string (&c
, 1);
125 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
126 "Convert arg STRING to a character, the first character of that string.")
128 register Lisp_Object str
;
130 register Lisp_Object val
;
131 register struct Lisp_String
*p
;
132 CHECK_STRING (str
, 0);
136 XFASTINT (val
) = ((unsigned char *) p
->data
)[0];
146 register Lisp_Object mark
;
147 mark
= Fmake_marker ();
148 Fset_marker (mark
, make_number (val
), Qnil
);
152 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
153 "Return value of point, as an integer.\n\
154 Beginning of buffer is position (point-min)")
158 XFASTINT (temp
) = point
;
162 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
163 "Return value of point, as a marker object.")
166 return buildmark (point
);
170 clip_to_bounds (lower
, num
, upper
)
171 int lower
, num
, upper
;
175 else if (num
> upper
)
181 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
182 "Set point to POSITION, a number or marker.\n\
183 Beginning of buffer is position (point-min), end is (point-max).")
185 register Lisp_Object n
;
187 CHECK_NUMBER_COERCE_MARKER (n
, 0);
189 SET_PT (clip_to_bounds (BEGV
, XINT (n
), ZV
));
194 region_limit (beginningp
)
197 register Lisp_Object m
;
198 m
= Fmarker_position (current_buffer
->mark
);
199 if (NILP (m
)) error ("There is no region now");
200 if ((point
< XFASTINT (m
)) == beginningp
)
201 return (make_number (point
));
206 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
207 "Return position of beginning of region, as an integer.")
210 return (region_limit (1));
213 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
214 "Return position of end of region, as an integer.")
217 return (region_limit (0));
220 #if 0 /* now in lisp code */
221 DEFUN ("mark", Fmark
, Smark
, 0, 0, 0,
222 "Return this buffer's mark value as integer, or nil if no mark.\n\
223 If you are using this in an editing command, you are most likely making\n\
224 a mistake; see the documentation of `set-mark'.")
227 return Fmarker_position (current_buffer
->mark
);
229 #endif /* commented out code */
231 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
232 "Return this buffer's mark, as a marker object.\n\
233 Watch out! Moving this marker changes the mark position.\n\
234 If you set the marker not to point anywhere, the buffer will have no mark.")
237 return current_buffer
->mark
;
240 #if 0 /* this is now in lisp code */
241 DEFUN ("set-mark", Fset_mark
, Sset_mark
, 1, 1, 0,
242 "Set this buffer's mark to POS. Don't use this function!\n\
243 That is to say, don't use this function unless you want\n\
244 the user to see that the mark has moved, and you want the previous\n\
245 mark position to be lost.\n\
247 Normally, when a new mark is set, the old one should go on the stack.\n\
248 This is why most applications should use push-mark, not set-mark.\n\
250 Novice programmers often try to use the mark for the wrong purposes.\n\
251 The mark saves a location for the user's convenience.\n\
252 Most editing commands should not alter the mark.\n\
253 To remember a location for internal use in the Lisp program,\n\
254 store it in a Lisp variable. Example:\n\
256 (let ((beg (point))) (forward-line 1) (delete-region beg (point))).")
262 current_buffer
->mark
= Qnil
;
265 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
267 if (NILP (current_buffer
->mark
))
268 current_buffer
->mark
= Fmake_marker ();
270 Fset_marker (current_buffer
->mark
, pos
, Qnil
);
273 #endif /* commented-out code */
276 save_excursion_save ()
278 register int visible
= XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
;
280 return Fcons (Fpoint_marker (),
281 Fcons (Fcopy_marker (current_buffer
->mark
), visible
? Qt
: Qnil
));
285 save_excursion_restore (info
)
286 register Lisp_Object info
;
288 register Lisp_Object tem
;
290 tem
= Fmarker_buffer (Fcar (info
));
291 /* If buffer being returned to is now deleted, avoid error */
292 /* Otherwise could get error here while unwinding to top level
294 /* In that case, Fmarker_buffer returns nil now. */
300 unchain_marker (tem
);
301 tem
= Fcar (Fcdr (info
));
302 Fset_marker (current_buffer
->mark
, tem
, Fcurrent_buffer ());
303 unchain_marker (tem
);
304 tem
= Fcdr (Fcdr (info
));
305 if (!NILP (tem
) && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
306 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
310 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
311 "Save point, mark, and current buffer; execute BODY; restore those things.\n\
312 Executes BODY just like `progn'.\n\
313 The values of point, mark and the current buffer are restored\n\
314 even in case of abnormal exit (throw or error).")
318 register Lisp_Object val
;
319 int count
= specpdl_ptr
- specpdl
;
321 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
324 return unbind_to (count
, val
);
327 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 0, 0,
328 "Return the number of characters in the current buffer.")
332 XFASTINT (temp
) = Z
- BEG
;
336 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
337 "Return the minimum permissible value of point in the current buffer.\n\
338 This is 1, unless a clipping restriction is in effect.")
342 XFASTINT (temp
) = BEGV
;
346 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
347 "Return a marker to the minimum permissible value of point in this buffer.\n\
348 This is the beginning, unless a clipping restriction is in effect.")
351 return buildmark (BEGV
);
354 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
355 "Return the maximum permissible value of point in the current buffer.\n\
356 This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
357 in which case it is less.")
361 XFASTINT (temp
) = ZV
;
365 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
366 "Return a marker to the maximum permissible value of point in this buffer.\n\
367 This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
368 in which case it is less.")
371 return buildmark (ZV
);
374 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
375 "Return the character following point, as a number.\n\
376 At the end of the buffer or accessible region, return 0.")
383 XFASTINT (temp
) = FETCH_CHAR (point
);
387 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
388 "Return the character preceding point, as a number.\n\
389 At the beginning of the buffer or accessible region, return 0.")
396 XFASTINT (temp
) = FETCH_CHAR (point
- 1);
400 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
401 "Return T if point is at the beginning of the buffer.\n\
402 If the buffer is narrowed, this means the beginning of the narrowed part.")
410 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
411 "Return T if point is at the end of the buffer.\n\
412 If the buffer is narrowed, this means the end of the narrowed part.")
420 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
421 "Return T if point is at the beginning of a line.")
424 if (point
== BEGV
|| FETCH_CHAR (point
- 1) == '\n')
429 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
430 "Return T if point is at the end of a line.\n\
431 `End of a line' includes point being at the end of the buffer.")
434 if (point
== ZV
|| FETCH_CHAR (point
) == '\n')
439 DEFUN ("char-after", Fchar_after
, Schar_after
, 1, 1, 0,
440 "Return character in current buffer at position POS.\n\
441 POS is an integer or a buffer pointer.\n\
442 If POS is out of range, the value is nil.")
446 register Lisp_Object val
;
449 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
452 if (n
< BEGV
|| n
>= ZV
) return Qnil
;
454 XFASTINT (val
) = FETCH_CHAR (n
);
458 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 0, 0,
459 "Return the name under which the user logged in, as a string.\n\
460 This is based on the effective uid, not the real uid.\n\
461 Also, if the environment variable USER or LOGNAME is set,\n\
462 that determines the value of this function.")
468 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
470 "Return the name of the user's real uid, as a string.\n\
471 Differs from `user-login-name' when running under `su'.")
474 return Vuser_real_name
;
477 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
478 "Return the effective uid of Emacs, as an integer.")
481 return make_number (geteuid ());
484 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
485 "Return the real uid of Emacs, as an integer.")
488 return make_number (getuid ());
491 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 0, 0,
492 "Return the full name of the user logged in, as a string.")
495 return Vuser_full_name
;
498 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
499 "Return the name of the machine you are running on, as a string.")
505 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
506 "Return the current time, as the number of seconds since 12:00 AM January 1970.\n\
507 The time is returned as a list of three integers. The first has the\n\
508 most significant 16 bits of the seconds, while the second has the\n\
509 least significant 16 bits. The third integer gives the microsecond\n\
512 The microsecond count is zero on systems that do not provide\n\
513 resolution finer than a second.")
517 Lisp_Object result
[3];
520 XSET (result
[0], Lisp_Int
, (EMACS_SECS (t
) >> 16) & 0xffff);
521 XSET (result
[1], Lisp_Int
, (EMACS_SECS (t
) >> 0) & 0xffff);
522 XSET (result
[2], Lisp_Int
, EMACS_USECS (t
));
524 return Flist (3, result
);
528 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 0, 0,
529 "Return the current time, as a human-readable string.\n\
530 Programs can use it too, since the number of columns in each field is fixed.\n\
531 The format is `Sun Sep 16 01:03:52 1973'.\n\
532 In a future Emacs version, the time zone may be added at the end,\n\
533 if we can figure out a reasonably easy way to get that information.")
536 long current_time
= time ((long *) 0);
538 register char *tem
= (char *) ctime (¤t_time
);
540 strncpy (buf
, tem
, 24);
543 return build_string (buf
);
546 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 0, 0,
547 "Return the offset, savings state, and names for the current time zone.\n\
548 This returns a list of the form (OFFSET SAVINGS-FLAG STANDARD SAVINGS).\n\
549 OFFSET is an integer specifying how many minutes east of Greenwich the\n\
550 current time zone is located. A negative value means west of\n\
551 Greenwich. Note that this describes the standard time; If daylight\n\
552 savings time is in effect, it does not affect this value.\n\
553 SAVINGS-FLAG is non-nil iff daylight savings time or some other sort\n\
554 of seasonal time adjustment is in effect.\n\
555 STANDARD is a string giving the name of the time zone when no seasonal\n\
556 time adjustment is in effect.\n\
557 SAVINGS is a string giving the name of the time zone when there is a\n\
558 seasonal time adjustment in effect.\n\
559 If the local area does not use a seasonal time adjustment,\n\
560 SAVINGS-FLAG will always be nil, and STANDARD and SAVINGS will be the\n\
564 #ifdef EMACS_CURRENT_TIME_ZONE
565 int offset
, savings_flag
;
569 EMACS_CURRENT_TIME_ZONE (&offset
, &savings_flag
, standard
, savings
);
571 return Fcons (make_number (offset
),
572 Fcons ((savings_flag
? Qt
: Qnil
),
573 Fcons (build_string (standard
),
574 Fcons (build_string (savings
),
578 ("current-time-zone has not been implemented on this operating system.");
591 /* Callers passing one argument to Finsert need not gcpro the
592 argument "array", since the only element of the array will
593 not be used after calling insert or insert_from_string, so
594 we don't care if it gets trashed. */
596 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
597 "Insert the arguments, either strings or characters, at point.\n\
598 Point moves forward so that it ends up after the inserted text.\n\
599 Any other markers at the point of insertion remain before the text.")
602 register Lisp_Object
*args
;
605 register Lisp_Object tem
;
608 for (argnum
= 0; argnum
< nargs
; argnum
++)
612 if (XTYPE (tem
) == Lisp_Int
)
617 else if (XTYPE (tem
) == Lisp_String
)
619 insert_from_string (tem
, 0, XSTRING (tem
)->size
);
623 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
631 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
632 "Insert strings or characters at point, relocating markers after the text.\n\
633 Point moves forward so that it ends up after the inserted text.\n\
634 Any other markers at the point of insertion also end up after the text.")
637 register Lisp_Object
*args
;
640 register Lisp_Object tem
;
643 for (argnum
= 0; argnum
< nargs
; argnum
++)
647 if (XTYPE (tem
) == Lisp_Int
)
650 insert_before_markers (str
, 1);
652 else if (XTYPE (tem
) == Lisp_String
)
654 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
);
658 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
666 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 2, 0,
667 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
668 Point and all markers are affected as in the function `insert'.\n\
669 Both arguments are required.")
671 Lisp_Object chr
, count
;
673 register unsigned char *string
;
677 CHECK_NUMBER (chr
, 0);
678 CHECK_NUMBER (count
, 1);
683 strlen
= min (n
, 256);
684 string
= (unsigned char *) alloca (strlen
);
685 for (i
= 0; i
< strlen
; i
++)
686 string
[i
] = XFASTINT (chr
);
689 insert (string
, strlen
);
698 /* Making strings from buffer contents. */
700 /* Return a Lisp_String containing the text of the current buffer from
703 We don't want to use plain old make_string here, because it calls
704 make_uninit_string, which can cause the buffer arena to be
705 compacted. make_string has no way of knowing that the data has
706 been moved, and thus copies the wrong data into the string. This
707 doesn't effect most of the other users of make_string, so it should
708 be left as is. But we should use this function when conjuring
709 buffer substrings. */
711 make_buffer_string (start
, end
)
716 if (start
< GPT
&& GPT
< end
)
719 result
= make_uninit_string (end
- start
);
720 bcopy (&FETCH_CHAR (start
), XSTRING (result
)->data
, end
- start
);
725 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
726 "Return the contents of part of the current buffer as a string.\n\
727 The two arguments START and END are character positions;\n\
728 they can be in either order.")
732 register int beg
, end
;
734 validate_region (&b
, &e
);
738 return make_buffer_string (beg
, end
);
741 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
742 "Return the contents of the current buffer as a string.")
745 return make_buffer_string (BEGV
, ZV
);
748 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
750 "Insert before point a substring of the contents buffer BUFFER.\n\
751 BUFFER may be a buffer or a buffer name.\n\
752 Arguments START and END are character numbers specifying the substring.\n\
753 They default to the beginning and the end of BUFFER.")
755 Lisp_Object buf
, b
, e
;
757 register int beg
, end
, exch
;
758 register struct buffer
*bp
;
760 buf
= Fget_buffer (buf
);
767 CHECK_NUMBER_COERCE_MARKER (b
, 0);
774 CHECK_NUMBER_COERCE_MARKER (e
, 1);
779 exch
= beg
, beg
= end
, end
= exch
;
781 /* Move the gap or create enough gap in the current buffer. */
785 if (GAP_SIZE
< end
- beg
)
786 make_gap (end
- beg
- GAP_SIZE
);
788 if (!(BUF_BEGV (bp
) <= beg
790 && end
<= BUF_ZV (bp
)))
791 args_out_of_range (b
, e
);
793 /* Now the actual insertion will not do any gap motion,
794 so it matters not if BUF is the current buffer. */
795 if (beg
< BUF_GPT (bp
))
797 insert (BUF_CHAR_ADDRESS (bp
, beg
), min (end
, BUF_GPT (bp
)) - beg
);
798 beg
= min (end
, BUF_GPT (bp
));
801 insert (BUF_CHAR_ADDRESS (bp
, beg
), end
- beg
);
806 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
807 Ssubst_char_in_region
, 4, 5, 0,
808 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
809 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
810 and don't mark the buffer as really changed.")
811 (start
, end
, fromchar
, tochar
, noundo
)
812 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
814 register int pos
, stop
, look
;
816 validate_region (&start
, &end
);
817 CHECK_NUMBER (fromchar
, 2);
818 CHECK_NUMBER (tochar
, 3);
822 look
= XINT (fromchar
);
824 modify_region (pos
, stop
);
827 if (MODIFF
- 1 == current_buffer
->save_modified
)
828 current_buffer
->save_modified
++;
829 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
830 current_buffer
->auto_save_modified
++;
835 if (FETCH_CHAR (pos
) == look
)
838 record_change (pos
, 1);
839 FETCH_CHAR (pos
) = XINT (tochar
);
841 signal_after_change (pos
, 1, 1);
849 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
850 "From START to END, translate characters according to TABLE.\n\
851 TABLE is a string; the Nth character in it is the mapping\n\
852 for the character with code N. Returns the number of characters changed.")
856 register Lisp_Object table
;
858 register int pos
, stop
; /* Limits of the region. */
859 register unsigned char *tt
; /* Trans table. */
860 register int oc
; /* Old character. */
861 register int nc
; /* New character. */
862 int cnt
; /* Number of changes made. */
863 Lisp_Object z
; /* Return. */
864 int size
; /* Size of translate table. */
866 validate_region (&start
, &end
);
867 CHECK_STRING (table
, 2);
869 size
= XSTRING (table
)->size
;
870 tt
= XSTRING (table
)->data
;
874 modify_region (pos
, stop
);
877 for (; pos
< stop
; ++pos
)
879 oc
= FETCH_CHAR (pos
);
885 record_change (pos
, 1);
886 FETCH_CHAR (pos
) = nc
;
887 signal_after_change (pos
, 1, 1);
897 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
898 "Delete the text between point and mark.\n\
899 When called from a program, expects two arguments,\n\
900 positions (integers or markers) specifying the stretch to be deleted.")
904 validate_region (&b
, &e
);
905 del_range (XINT (b
), XINT (e
));
909 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
910 "Remove restrictions (narrowing) from current buffer.\n\
911 This allows the buffer's full text to be seen and edited.")
915 SET_BUF_ZV (current_buffer
, Z
);
917 /* Changing the buffer bounds invalidates any recorded current column. */
918 invalidate_current_column ();
922 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
923 "Restrict editing in this buffer to the current region.\n\
924 The rest of the text becomes temporarily invisible and untouchable\n\
925 but is not deleted; if you save the buffer in a file, the invisible\n\
926 text is included in the file. \\[widen] makes all visible again.\n\
927 See also `save-restriction'.\n\
929 When calling from a program, pass two arguments; positions (integers\n\
930 or markers) bounding the text that should remain visible.")
932 register Lisp_Object b
, e
;
936 CHECK_NUMBER_COERCE_MARKER (b
, 0);
937 CHECK_NUMBER_COERCE_MARKER (e
, 1);
939 if (XINT (b
) > XINT (e
))
946 if (!(BEG
<= XINT (b
) && XINT (b
) <= XINT (e
) && XINT (e
) <= Z
))
947 args_out_of_range (b
, e
);
950 SET_BUF_ZV (current_buffer
, XFASTINT (e
));
951 if (point
< XFASTINT (b
))
952 SET_PT (XFASTINT (b
));
953 if (point
> XFASTINT (e
))
954 SET_PT (XFASTINT (e
));
956 /* Changing the buffer bounds invalidates any recorded current column. */
957 invalidate_current_column ();
962 save_restriction_save ()
964 register Lisp_Object bottom
, top
;
965 /* Note: I tried using markers here, but it does not win
966 because insertion at the end of the saved region
967 does not advance mh and is considered "outside" the saved region. */
968 XFASTINT (bottom
) = BEGV
- BEG
;
969 XFASTINT (top
) = Z
- ZV
;
971 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
975 save_restriction_restore (data
)
978 register struct buffer
*buf
;
979 register int newhead
, newtail
;
980 register Lisp_Object tem
;
982 buf
= XBUFFER (XCONS (data
)->car
);
984 data
= XCONS (data
)->cdr
;
986 tem
= XCONS (data
)->car
;
987 newhead
= XINT (tem
);
988 tem
= XCONS (data
)->cdr
;
989 newtail
= XINT (tem
);
990 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
995 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
996 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
999 /* If point is outside the new visible range, move it inside. */
1001 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
1006 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
1007 "Execute BODY, saving and restoring current buffer's restrictions.\n\
1008 The buffer's restrictions make parts of the beginning and end invisible.\n\
1009 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
1010 This special form, `save-restriction', saves the current buffer's restrictions\n\
1011 when it is entered, and restores them when it is exited.\n\
1012 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
1013 The old restrictions settings are restored\n\
1014 even in case of abnormal exit (throw or error).\n\
1016 The value returned is the value of the last form in BODY.\n\
1018 `save-restriction' can get confused if, within the BODY, you widen\n\
1019 and then make changes outside the area within the saved restrictions.\n\
1021 Note: if you are using both `save-excursion' and `save-restriction',\n\
1022 use `save-excursion' outermost:\n\
1023 (save-excursion (save-restriction ...))")
1027 register Lisp_Object val
;
1028 int count
= specpdl_ptr
- specpdl
;
1030 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1031 val
= Fprogn (body
);
1032 return unbind_to (count
, val
);
1035 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
1036 "Print a one-line message at the bottom of the screen.\n\
1037 The first argument is a control string.\n\
1038 It may contain %s or %d or %c to print successive following arguments.\n\
1039 %s means print an argument as a string, %d means print as number in decimal,\n\
1040 %c means print a number as a single character.\n\
1041 The argument used by %s must be a string or a symbol;\n\
1042 the argument used by %d or %c must be a number.")
1047 register Lisp_Object val
;
1049 val
= Fformat (nargs
, args
);
1050 message ("%s", XSTRING (val
)->data
);
1054 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1055 "Format a string out of a control-string and arguments.\n\
1056 The first argument is a control string.\n\
1057 The other arguments are substituted into it to make the result, a string.\n\
1058 It may contain %-sequences meaning to substitute the next argument.\n\
1059 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1060 %d means print as number in decimal (%o octal, %x hex).\n\
1061 %c means print a number as a single character.\n\
1062 %S means print any object as an s-expression (using prin1).\n\
1063 The argument used for %d, %o, %x or %c must be a number.\n\
1064 Use %% to put a single % into the output.")
1067 register Lisp_Object
*args
;
1069 register int n
; /* The number of the next arg to substitute */
1070 register int total
= 5; /* An estimate of the final length */
1072 register unsigned char *format
, *end
;
1074 extern char *index ();
1075 /* It should not be necessary to GCPRO ARGS, because
1076 the caller in the interpreter should take care of that. */
1078 CHECK_STRING (args
[0], 0);
1079 format
= XSTRING (args
[0])->data
;
1080 end
= format
+ XSTRING (args
[0])->size
;
1083 while (format
!= end
)
1084 if (*format
++ == '%')
1088 /* Process a numeric arg and skip it. */
1089 minlen
= atoi (format
);
1094 while ((*format
>= '0' && *format
<= '9')
1095 || *format
== '-' || *format
== ' ' || *format
== '.')
1100 else if (++n
>= nargs
)
1102 else if (*format
== 'S')
1104 /* For `S', prin1 the argument and then treat like a string. */
1105 register Lisp_Object tem
;
1106 tem
= Fprin1_to_string (args
[n
], Qnil
);
1110 else if (XTYPE (args
[n
]) == Lisp_Symbol
)
1112 XSET (args
[n
], Lisp_String
, XSYMBOL (args
[n
])->name
);
1115 else if (XTYPE (args
[n
]) == Lisp_String
)
1118 total
+= XSTRING (args
[n
])->size
;
1120 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1121 else if (XTYPE (args
[n
]) == Lisp_Int
&& *format
!= 's')
1123 #ifdef LISP_FLOAT_TYPE
1124 /* The following loop issumes the Lisp type indicates
1125 the proper way to pass the argument.
1126 So make sure we have a flonum if the argument should
1128 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1129 args
[n
] = Ffloat (args
[n
]);
1133 #ifdef LISP_FLOAT_TYPE
1134 else if (XTYPE (args
[n
]) == Lisp_Float
&& *format
!= 's')
1136 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1137 args
[n
] = Ftruncate (args
[n
]);
1143 /* Anything but a string, convert to a string using princ. */
1144 register Lisp_Object tem
;
1145 tem
= Fprin1_to_string (args
[n
], Qt
);
1152 register int nstrings
= n
+ 1;
1153 register unsigned char **strings
1154 = (unsigned char **) alloca (nstrings
* sizeof (unsigned char *));
1156 for (n
= 0; n
< nstrings
; n
++)
1159 strings
[n
] = (unsigned char *) "";
1160 else if (XTYPE (args
[n
]) == Lisp_Int
)
1161 /* We checked above that the corresponding format effector
1162 isn't %s, which would cause MPV. */
1163 strings
[n
] = (unsigned char *) XINT (args
[n
]);
1164 #ifdef LISP_FLOAT_TYPE
1165 else if (XTYPE (args
[n
]) == Lisp_Float
)
1167 union { double d
; int half
[2]; } u
;
1169 u
.d
= XFLOAT (args
[n
])->data
;
1170 strings
[n
++] = (unsigned char *) u
.half
[0];
1171 strings
[n
] = (unsigned char *) u
.half
[1];
1175 strings
[n
] = XSTRING (args
[n
])->data
;
1178 /* Format it in bigger and bigger buf's until it all fits. */
1181 buf
= (char *) alloca (total
+ 1);
1184 length
= doprnt (buf
, total
+ 1, strings
[0], end
, nargs
, strings
+ 1);
1185 if (buf
[total
- 1] == 0)
1193 return make_string (buf
, length
);
1199 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1200 int arg0
, arg1
, arg2
, arg3
, arg4
;
1214 doprnt (buf
, sizeof buf
, string1
, 0, 5, args
);
1216 doprnt (buf
, sizeof buf
, string1
, 0, 5, &string1
+ 1);
1218 return build_string (buf
);
1221 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1222 "Return t if two characters match, optionally ignoring case.\n\
1223 Both arguments must be characters (i.e. integers).\n\
1224 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1226 register Lisp_Object c1
, c2
;
1228 unsigned char *downcase
= DOWNCASE_TABLE
;
1229 CHECK_NUMBER (c1
, 0);
1230 CHECK_NUMBER (c2
, 1);
1232 if (!NILP (current_buffer
->case_fold_search
)
1233 ? downcase
[0xff & XFASTINT (c1
)] == downcase
[0xff & XFASTINT (c2
)]
1234 : XINT (c1
) == XINT (c2
))
1243 DEFVAR_LISP ("system-name", &Vsystem_name
,
1244 "The name of the machine Emacs is running on.");
1246 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
1247 "The full name of the user logged in.");
1249 DEFVAR_LISP ("user-name", &Vuser_name
,
1250 "The user's name, based on the effective uid.");
1252 DEFVAR_LISP ("user-real-name", &Vuser_real_name
,
1253 "The user's name, base upon the real uid.");
1255 defsubr (&Schar_equal
);
1256 defsubr (&Sgoto_char
);
1257 defsubr (&Sstring_to_char
);
1258 defsubr (&Schar_to_string
);
1259 defsubr (&Sbuffer_substring
);
1260 defsubr (&Sbuffer_string
);
1262 defsubr (&Spoint_marker
);
1263 defsubr (&Smark_marker
);
1265 defsubr (&Sregion_beginning
);
1266 defsubr (&Sregion_end
);
1267 /* defsubr (&Smark); */
1268 /* defsubr (&Sset_mark); */
1269 defsubr (&Ssave_excursion
);
1271 defsubr (&Sbufsize
);
1272 defsubr (&Spoint_max
);
1273 defsubr (&Spoint_min
);
1274 defsubr (&Spoint_min_marker
);
1275 defsubr (&Spoint_max_marker
);
1281 defsubr (&Sfollowing_char
);
1282 defsubr (&Sprevious_char
);
1283 defsubr (&Schar_after
);
1285 defsubr (&Sinsert_before_markers
);
1286 defsubr (&Sinsert_char
);
1288 defsubr (&Suser_login_name
);
1289 defsubr (&Suser_real_login_name
);
1290 defsubr (&Suser_uid
);
1291 defsubr (&Suser_real_uid
);
1292 defsubr (&Suser_full_name
);
1293 defsubr (&Scurrent_time
);
1294 defsubr (&Scurrent_time_string
);
1295 defsubr (&Scurrent_time_zone
);
1296 defsubr (&Ssystem_name
);
1297 defsubr (&Smessage
);
1300 defsubr (&Sinsert_buffer_substring
);
1301 defsubr (&Ssubst_char_in_region
);
1302 defsubr (&Stranslate_region
);
1303 defsubr (&Sdelete_region
);
1305 defsubr (&Snarrow_to_region
);
1306 defsubr (&Ssave_restriction
);