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", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
507 "Return the current time, as an integer.")
510 return make_number (time(0));
514 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 0, 0,
515 "Return the current time, as a human-readable string.\n\
516 Programs can use it too, since the number of columns in each field is fixed.\n\
517 The format is `Sun Sep 16 01:03:52 1973'.\n\
518 In a future Emacs version, the time zone may be added at the end,\n\
519 if we can figure out a reasonably easy way to get that information.")
522 long current_time
= time ((long *) 0);
524 register char *tem
= (char *) ctime (¤t_time
);
526 strncpy (buf
, tem
, 24);
529 return build_string (buf
);
534 DEFUN ("set-default-file-mode", Fset_default_file_mode
, Sset_default_file_mode
, 1, 1, "p",
535 "Set Unix `umask' value to ARGUMENT, and return old value.\n\
536 The `umask' value is the default protection mode for new files.")
540 CHECK_NUMBER (nmask
, 0);
541 return make_number (umask (XINT (nmask
)));
544 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
545 "Tell Unix to finish all pending disk updates.")
562 /* Callers passing one argument to Finsert need not gcpro the
563 argument "array", since the only element of the array will
564 not be used after calling insert or insert_from_string, so
565 we don't care if it gets trashed. */
567 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
568 "Insert the arguments, either strings or characters, at point.\n\
569 Point moves forward so that it ends up after the inserted text.\n\
570 Any other markers at the point of insertion remain before the text.")
573 register Lisp_Object
*args
;
576 register Lisp_Object tem
;
579 for (argnum
= 0; argnum
< nargs
; argnum
++)
583 if (XTYPE (tem
) == Lisp_Int
)
588 else if (XTYPE (tem
) == Lisp_String
)
590 insert_from_string (tem
, 0, XSTRING (tem
)->size
);
594 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
602 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
603 "Insert strings or characters at point, relocating markers after the text.\n\
604 Point moves forward so that it ends up after the inserted text.\n\
605 Any other markers at the point of insertion also end up after the text.")
608 register Lisp_Object
*args
;
611 register Lisp_Object tem
;
614 for (argnum
= 0; argnum
< nargs
; argnum
++)
618 if (XTYPE (tem
) == Lisp_Int
)
621 insert_before_markers (str
, 1);
623 else if (XTYPE (tem
) == Lisp_String
)
625 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
);
629 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
637 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 2, 0,
638 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
639 Point and all markers are affected as in the function `insert'.\n\
640 Both arguments are required.")
642 Lisp_Object chr
, count
;
644 register unsigned char *string
;
648 CHECK_NUMBER (chr
, 0);
649 CHECK_NUMBER (count
, 1);
654 strlen
= min (n
, 256);
655 string
= (unsigned char *) alloca (strlen
);
656 for (i
= 0; i
< strlen
; i
++)
657 string
[i
] = XFASTINT (chr
);
660 insert (string
, strlen
);
669 /* Return a string with the contents of the current region */
671 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
672 "Return the contents of part of the current buffer as a string.\n\
673 The two arguments START and END are character positions;\n\
674 they can be in either order.")
678 register int beg
, end
;
681 validate_region (&b
, &e
);
685 if (beg
< GPT
&& end
> GPT
)
688 /* Plain old make_string calls make_uninit_string, which can cause
689 the buffer arena to be compacted. make_string has no way of
690 knowing that the data has been moved, and thus copies the wrong
691 data into the string. This doesn't effect most of the other
692 users of make_string, so it should be left as is. */
693 result
= make_uninit_string (end
- beg
);
694 bcopy (&FETCH_CHAR (beg
), XSTRING (result
)->data
, end
- beg
);
699 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
700 "Return the contents of the current buffer as a string.")
703 if (BEGV
< GPT
&& ZV
> GPT
)
705 return make_string (BEGV_ADDR
, ZV
- BEGV
);
708 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
710 "Insert before point a substring of the contents buffer BUFFER.\n\
711 BUFFER may be a buffer or a buffer name.\n\
712 Arguments START and END are character numbers specifying the substring.\n\
713 They default to the beginning and the end of BUFFER.")
715 Lisp_Object buf
, b
, e
;
717 register int beg
, end
, exch
;
718 register struct buffer
*bp
;
720 buf
= Fget_buffer (buf
);
727 CHECK_NUMBER_COERCE_MARKER (b
, 0);
734 CHECK_NUMBER_COERCE_MARKER (e
, 1);
739 exch
= beg
, beg
= end
, end
= exch
;
741 /* Move the gap or create enough gap in the current buffer. */
745 if (GAP_SIZE
< end
- beg
)
746 make_gap (end
- beg
- GAP_SIZE
);
748 if (!(BUF_BEGV (bp
) <= beg
750 && end
<= BUF_ZV (bp
)))
751 args_out_of_range (b
, e
);
753 /* Now the actual insertion will not do any gap motion,
754 so it matters not if BUF is the current buffer. */
755 if (beg
< BUF_GPT (bp
))
757 insert (BUF_CHAR_ADDRESS (bp
, beg
), min (end
, BUF_GPT (bp
)) - beg
);
758 beg
= min (end
, BUF_GPT (bp
));
761 insert (BUF_CHAR_ADDRESS (bp
, beg
), end
- beg
);
766 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
767 Ssubst_char_in_region
, 4, 5, 0,
768 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
769 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
770 and don't mark the buffer as really changed.")
771 (start
, end
, fromchar
, tochar
, noundo
)
772 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
774 register int pos
, stop
, look
;
776 validate_region (&start
, &end
);
777 CHECK_NUMBER (fromchar
, 2);
778 CHECK_NUMBER (tochar
, 3);
782 look
= XINT (fromchar
);
784 modify_region (pos
, stop
);
787 if (MODIFF
- 1 == current_buffer
->save_modified
)
788 current_buffer
->save_modified
++;
789 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
790 current_buffer
->auto_save_modified
++;
795 if (FETCH_CHAR (pos
) == look
)
798 record_change (pos
, 1);
799 FETCH_CHAR (pos
) = XINT (tochar
);
801 signal_after_change (pos
, 1, 1);
809 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
810 "From START to END, translate characters according to TABLE.\n\
811 TABLE is a string; the Nth character in it is the mapping\n\
812 for the character with code N. Returns the number of characters changed.")
816 register Lisp_Object table
;
818 register int pos
, stop
; /* Limits of the region. */
819 register unsigned char *tt
; /* Trans table. */
820 register int oc
; /* Old character. */
821 register int nc
; /* New character. */
822 int cnt
; /* Number of changes made. */
823 Lisp_Object z
; /* Return. */
824 int size
; /* Size of translate table. */
826 validate_region (&start
, &end
);
827 CHECK_STRING (table
, 2);
829 size
= XSTRING (table
)->size
;
830 tt
= XSTRING (table
)->data
;
834 modify_region (pos
, stop
);
837 for (; pos
< stop
; ++pos
)
839 oc
= FETCH_CHAR (pos
);
845 record_change (pos
, 1);
846 FETCH_CHAR (pos
) = nc
;
847 signal_after_change (pos
, 1, 1);
857 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
858 "Delete the text between point and mark.\n\
859 When called from a program, expects two arguments,\n\
860 positions (integers or markers) specifying the stretch to be deleted.")
864 validate_region (&b
, &e
);
865 del_range (XINT (b
), XINT (e
));
869 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
870 "Remove restrictions (narrowing) from current buffer.\n\
871 This allows the buffer's full text to be seen and edited.")
875 SET_BUF_ZV (current_buffer
, Z
);
877 /* Changing the buffer bounds invalidates any recorded current column. */
878 invalidate_current_column ();
882 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
883 "Restrict editing in this buffer to the current region.\n\
884 The rest of the text becomes temporarily invisible and untouchable\n\
885 but is not deleted; if you save the buffer in a file, the invisible\n\
886 text is included in the file. \\[widen] makes all visible again.\n\
887 See also `save-restriction'.\n\
889 When calling from a program, pass two arguments; positions (integers\n\
890 or markers) bounding the text that should remain visible.")
892 register Lisp_Object b
, e
;
896 CHECK_NUMBER_COERCE_MARKER (b
, 0);
897 CHECK_NUMBER_COERCE_MARKER (e
, 1);
899 if (XINT (b
) > XINT (e
))
906 if (!(BEG
<= XINT (b
) && XINT (b
) <= XINT (e
) && XINT (e
) <= Z
))
907 args_out_of_range (b
, e
);
910 SET_BUF_ZV (current_buffer
, XFASTINT (e
));
911 if (point
< XFASTINT (b
))
912 SET_PT (XFASTINT (b
));
913 if (point
> XFASTINT (e
))
914 SET_PT (XFASTINT (e
));
916 /* Changing the buffer bounds invalidates any recorded current column. */
917 invalidate_current_column ();
922 save_restriction_save ()
924 register Lisp_Object bottom
, top
;
925 /* Note: I tried using markers here, but it does not win
926 because insertion at the end of the saved region
927 does not advance mh and is considered "outside" the saved region. */
928 XFASTINT (bottom
) = BEGV
- BEG
;
929 XFASTINT (top
) = Z
- ZV
;
931 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
935 save_restriction_restore (data
)
938 register struct buffer
*buf
;
939 register int newhead
, newtail
;
940 register Lisp_Object tem
;
942 buf
= XBUFFER (XCONS (data
)->car
);
944 data
= XCONS (data
)->cdr
;
946 tem
= XCONS (data
)->car
;
947 newhead
= XINT (tem
);
948 tem
= XCONS (data
)->cdr
;
949 newtail
= XINT (tem
);
950 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
955 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
956 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
959 /* If point is outside the new visible range, move it inside. */
961 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
966 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
967 "Execute BODY, saving and restoring current buffer's restrictions.\n\
968 The buffer's restrictions make parts of the beginning and end invisible.\n\
969 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
970 This special form, `save-restriction', saves the current buffer's restrictions\n\
971 when it is entered, and restores them when it is exited.\n\
972 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
973 The old restrictions settings are restored\n\
974 even in case of abnormal exit (throw or error).\n\
976 The value returned is the value of the last form in BODY.\n\
978 `save-restriction' can get confused if, within the BODY, you widen\n\
979 and then make changes outside the area within the saved restrictions.\n\
981 Note: if you are using both `save-excursion' and `save-restriction',\n\
982 use `save-excursion' outermost:\n\
983 (save-excursion (save-restriction ...))")
987 register Lisp_Object val
;
988 int count
= specpdl_ptr
- specpdl
;
990 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
992 return unbind_to (count
, val
);
995 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
996 "Print a one-line message at the bottom of the screen.\n\
997 The first argument is a control string.\n\
998 It may contain %s or %d or %c to print successive following arguments.\n\
999 %s means print an argument as a string, %d means print as number in decimal,\n\
1000 %c means print a number as a single character.\n\
1001 The argument used by %s must be a string or a symbol;\n\
1002 the argument used by %d or %c must be a number.")
1007 register Lisp_Object val
;
1009 val
= Fformat (nargs
, args
);
1010 message ("%s", XSTRING (val
)->data
);
1014 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1015 "Format a string out of a control-string and arguments.\n\
1016 The first argument is a control string.\n\
1017 The other arguments are substituted into it to make the result, a string.\n\
1018 It may contain %-sequences meaning to substitute the next argument.\n\
1019 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1020 %d means print as number in decimal (%o octal, %x hex).\n\
1021 %c means print a number as a single character.\n\
1022 %S means print any object as an s-expression (using prin1).\n\
1023 The argument used for %d, %o, %x or %c must be a number.\n\
1024 Use %% to put a single % into the output.")
1027 register Lisp_Object
*args
;
1029 register int n
; /* The number of the next arg to substitute */
1030 register int total
= 5; /* An estimate of the final length */
1032 register unsigned char *format
, *end
;
1034 extern char *index ();
1035 /* It should not be necessary to GCPRO ARGS, because
1036 the caller in the interpreter should take care of that. */
1038 CHECK_STRING (args
[0], 0);
1039 format
= XSTRING (args
[0])->data
;
1040 end
= format
+ XSTRING (args
[0])->size
;
1043 while (format
!= end
)
1044 if (*format
++ == '%')
1048 /* Process a numeric arg and skip it. */
1049 minlen
= atoi (format
);
1054 while ((*format
>= '0' && *format
<= '9')
1055 || *format
== '-' || *format
== ' ' || *format
== '.')
1060 else if (++n
>= nargs
)
1062 else if (*format
== 'S')
1064 /* For `S', prin1 the argument and then treat like a string. */
1065 register Lisp_Object tem
;
1066 tem
= Fprin1_to_string (args
[n
], Qnil
);
1070 else if (XTYPE (args
[n
]) == Lisp_Symbol
)
1072 XSET (args
[n
], Lisp_String
, XSYMBOL (args
[n
])->name
);
1075 else if (XTYPE (args
[n
]) == Lisp_String
)
1078 total
+= XSTRING (args
[n
])->size
;
1080 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1081 else if (XTYPE (args
[n
]) == Lisp_Int
&& *format
!= 's')
1083 /* The following loop issumes the Lisp type indicates
1084 the proper way to pass the argument.
1085 So make sure we have a flonum if the argument should
1087 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1088 args
[n
] = Ffloat (args
[n
]);
1091 else if (XTYPE (args
[n
]) == Lisp_Float
&& *format
!= 's')
1093 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1094 args
[n
] = Ftruncate (args
[n
]);
1099 /* Anything but a string, convert to a string using princ. */
1100 register Lisp_Object tem
;
1101 tem
= Fprin1_to_string (args
[n
], Qt
);
1108 register int nstrings
= n
+ 1;
1109 register unsigned char **strings
1110 = (unsigned char **) alloca (nstrings
* sizeof (unsigned char *));
1112 for (n
= 0; n
< nstrings
; n
++)
1115 strings
[n
] = (unsigned char *) "";
1116 else if (XTYPE (args
[n
]) == Lisp_Int
)
1117 /* We checked above that the corresponding format effector
1118 isn't %s, which would cause MPV. */
1119 strings
[n
] = (unsigned char *) XINT (args
[n
]);
1120 else if (XTYPE (args
[n
]) == Lisp_Float
)
1122 union { double d
; int half
[2]; } u
;
1124 u
.d
= XFLOAT (args
[n
])->data
;
1125 strings
[n
++] = (unsigned char *) u
.half
[0];
1126 strings
[n
] = (unsigned char *) u
.half
[1];
1129 strings
[n
] = XSTRING (args
[n
])->data
;
1132 /* Format it in bigger and bigger buf's until it all fits. */
1135 buf
= (char *) alloca (total
+ 1);
1138 length
= doprnt (buf
, total
+ 1, strings
[0], end
, nargs
, strings
+ 1);
1139 if (buf
[total
- 1] == 0)
1147 return make_string (buf
, length
);
1153 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1154 int arg0
, arg1
, arg2
, arg3
, arg4
;
1168 doprnt (buf
, sizeof buf
, string1
, 0, 5, args
);
1170 doprnt (buf
, sizeof buf
, string1
, 0, 5, &string1
+ 1);
1172 return build_string (buf
);
1175 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1176 "Return t if two characters match, optionally ignoring case.\n\
1177 Both arguments must be characters (i.e. integers).\n\
1178 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1180 register Lisp_Object c1
, c2
;
1182 unsigned char *downcase
= DOWNCASE_TABLE
;
1183 CHECK_NUMBER (c1
, 0);
1184 CHECK_NUMBER (c2
, 1);
1186 if (!NULL (current_buffer
->case_fold_search
)
1187 ? downcase
[0xff & XFASTINT (c1
)] == downcase
[0xff & XFASTINT (c2
)]
1188 : XINT (c1
) == XINT (c2
))
1193 #ifndef MAINTAIN_ENVIRONMENT /* it is done in environ.c in that case */
1194 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 2, 0,
1195 "Return the value of environment variable VAR, as a string.\n\
1196 VAR should be a string. Value is nil if VAR is undefined in the environment.")
1201 CHECK_STRING (str
, 0);
1202 val
= (char *) egetenv (XSTRING (str
)->data
);
1205 return build_string (val
);
1207 #endif /* MAINTAIN_ENVIRONMENT */
1212 DEFVAR_LISP ("system-name", &Vsystem_name
,
1213 "The name of the machine Emacs is running on.");
1215 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
1216 "The full name of the user logged in.");
1218 DEFVAR_LISP ("user-name", &Vuser_name
,
1219 "The user's name, based on the effective uid.");
1221 DEFVAR_LISP ("user-real-name", &Vuser_real_name
,
1222 "The user's name, base upon the real uid.");
1224 defsubr (&Schar_equal
);
1225 defsubr (&Sgoto_char
);
1226 defsubr (&Sstring_to_char
);
1227 defsubr (&Schar_to_string
);
1228 defsubr (&Sbuffer_substring
);
1229 defsubr (&Sbuffer_string
);
1231 defsubr (&Spoint_marker
);
1232 defsubr (&Smark_marker
);
1234 defsubr (&Sregion_beginning
);
1235 defsubr (&Sregion_end
);
1236 /* defsubr (&Smark); */
1237 /* defsubr (&Sset_mark); */
1238 defsubr (&Ssave_excursion
);
1240 defsubr (&Sbufsize
);
1241 defsubr (&Spoint_max
);
1242 defsubr (&Spoint_min
);
1243 defsubr (&Spoint_min_marker
);
1244 defsubr (&Spoint_max_marker
);
1250 defsubr (&Sfollchar
);
1251 defsubr (&Sprevchar
);
1252 defsubr (&Schar_after
);
1254 defsubr (&Sinsert_before_markers
);
1255 defsubr (&Sinsert_char
);
1257 defsubr (&Suser_login_name
);
1258 defsubr (&Suser_real_login_name
);
1259 defsubr (&Suser_uid
);
1260 defsubr (&Suser_real_uid
);
1261 defsubr (&Suser_full_name
);
1262 defsubr (&Scurrent_time
);
1263 defsubr (&Scurrent_time_string
);
1264 defsubr (&Ssystem_name
);
1265 defsubr (&Sset_default_file_mode
);
1266 defsubr (&Sunix_sync
);
1267 defsubr (&Smessage
);
1269 #ifndef MAINTAIN_ENVIRONMENT /* in environ.c */
1273 defsubr (&Sinsert_buffer_substring
);
1274 defsubr (&Ssubst_char_in_region
);
1275 defsubr (&Stranslate_region
);
1276 defsubr (&Sdelete_region
);
1278 defsubr (&Snarrow_to_region
);
1279 defsubr (&Ssave_restriction
);