1 /* Lisp functions pertaining to editing.
2 Copyright (C) 1985, 1986, 1987, 1989, 1993 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. */
30 #include "intervals.h"
36 #define min(a, b) ((a) < (b) ? (a) : (b))
37 #define max(a, b) ((a) > (b) ? (a) : (b))
39 /* Some static data, and a function to initialize it for each run */
41 Lisp_Object Vsystem_name
;
42 Lisp_Object Vuser_real_name
; /* login name of current user ID */
43 Lisp_Object Vuser_full_name
; /* full name of current user */
44 Lisp_Object Vuser_name
; /* user name from USER or LOGNAME. */
50 register unsigned char *p
, *q
, *r
;
51 struct passwd
*pw
; /* password entry for the current user */
52 extern char *index ();
55 /* Set up system_name even when dumping. */
57 Vsystem_name
= build_string (get_system_name ());
58 p
= XSTRING (Vsystem_name
)->data
;
61 if (*p
== ' ' || *p
== '\t')
67 /* Don't bother with this on initial start when just dumping out */
70 #endif /* not CANNOT_DUMP */
72 pw
= (struct passwd
*) getpwuid (getuid ());
73 Vuser_real_name
= build_string (pw
? pw
->pw_name
: "unknown");
75 /* Get the effective user name, by consulting environment variables,
76 or the effective uid if those are unset. */
77 user_name
= (char *) getenv ("USER");
79 user_name
= (char *) getenv ("LOGNAME");
82 pw
= (struct passwd
*) getpwuid (geteuid ());
83 user_name
= (char *) (pw
? pw
->pw_name
: "unknown");
85 Vuser_name
= build_string (user_name
);
87 /* If the user name claimed in the environment vars differs from
88 the real uid, use the claimed name to find the full name. */
89 tem
= Fstring_equal (Vuser_name
, Vuser_real_name
);
91 pw
= (struct passwd
*) getpwnam (XSTRING (Vuser_name
)->data
);
93 p
= (unsigned char *) (pw
? USER_FULL_NAME
: "unknown");
94 q
= (unsigned char *) index (p
, ',');
95 Vuser_full_name
= make_string (p
, q
? q
- p
: strlen (p
));
97 #ifdef AMPERSAND_FULL_NAME
98 p
= XSTRING (Vuser_full_name
)->data
;
99 q
= (char *) index (p
, '&');
100 /* Substitute the login name for the &, upcasing the first character. */
103 r
= (char *) alloca (strlen (p
) + XSTRING (Vuser_name
)->size
+ 1);
106 strcat (r
, XSTRING (Vuser_name
)->data
);
107 r
[q
- p
] = UPCASE (r
[q
- p
]);
109 Vuser_full_name
= build_string (r
);
111 #endif /* AMPERSAND_FULL_NAME */
114 DEFUN ("char-to-string", Fchar_to_string
, Schar_to_string
, 1, 1, 0,
115 "Convert arg CHAR to a one-character string containing that character.")
123 return make_string (&c
, 1);
126 DEFUN ("string-to-char", Fstring_to_char
, Sstring_to_char
, 1, 1, 0,
127 "Convert arg STRING to a character, the first character of that string.")
129 register Lisp_Object str
;
131 register Lisp_Object val
;
132 register struct Lisp_String
*p
;
133 CHECK_STRING (str
, 0);
137 XFASTINT (val
) = ((unsigned char *) p
->data
)[0];
147 register Lisp_Object mark
;
148 mark
= Fmake_marker ();
149 Fset_marker (mark
, make_number (val
), Qnil
);
153 DEFUN ("point", Fpoint
, Spoint
, 0, 0, 0,
154 "Return value of point, as an integer.\n\
155 Beginning of buffer is position (point-min)")
159 XFASTINT (temp
) = point
;
163 DEFUN ("point-marker", Fpoint_marker
, Spoint_marker
, 0, 0, 0,
164 "Return value of point, as a marker object.")
167 return buildmark (point
);
171 clip_to_bounds (lower
, num
, upper
)
172 int lower
, num
, upper
;
176 else if (num
> upper
)
182 DEFUN ("goto-char", Fgoto_char
, Sgoto_char
, 1, 1, "NGoto char: ",
183 "Set point to POSITION, a number or marker.\n\
184 Beginning of buffer is position (point-min), end is (point-max).")
186 register Lisp_Object n
;
188 CHECK_NUMBER_COERCE_MARKER (n
, 0);
190 SET_PT (clip_to_bounds (BEGV
, XINT (n
), ZV
));
195 region_limit (beginningp
)
198 register Lisp_Object m
;
199 if (!NILP (Vtransient_mark_mode
) && NILP (current_buffer
->mark_active
))
200 error ("There is no region now");
201 m
= Fmarker_position (current_buffer
->mark
);
202 if (NILP (m
)) error ("There is no region now");
203 if ((point
< XFASTINT (m
)) == beginningp
)
204 return (make_number (point
));
209 DEFUN ("region-beginning", Fregion_beginning
, Sregion_beginning
, 0, 0, 0,
210 "Return position of beginning of region, as an integer.")
213 return (region_limit (1));
216 DEFUN ("region-end", Fregion_end
, Sregion_end
, 0, 0, 0,
217 "Return position of end of region, as an integer.")
220 return (region_limit (0));
223 #if 0 /* now in lisp code */
224 DEFUN ("mark", Fmark
, Smark
, 0, 0, 0,
225 "Return this buffer's mark value as integer, or nil if no mark.\n\
226 If you are using this in an editing command, you are most likely making\n\
227 a mistake; see the documentation of `set-mark'.")
230 return Fmarker_position (current_buffer
->mark
);
232 #endif /* commented out code */
234 DEFUN ("mark-marker", Fmark_marker
, Smark_marker
, 0, 0, 0,
235 "Return this buffer's mark, as a marker object.\n\
236 Watch out! Moving this marker changes the mark position.\n\
237 If you set the marker not to point anywhere, the buffer will have no mark.")
240 return current_buffer
->mark
;
243 #if 0 /* this is now in lisp code */
244 DEFUN ("set-mark", Fset_mark
, Sset_mark
, 1, 1, 0,
245 "Set this buffer's mark to POS. Don't use this function!\n\
246 That is to say, don't use this function unless you want\n\
247 the user to see that the mark has moved, and you want the previous\n\
248 mark position to be lost.\n\
250 Normally, when a new mark is set, the old one should go on the stack.\n\
251 This is why most applications should use push-mark, not set-mark.\n\
253 Novice programmers often try to use the mark for the wrong purposes.\n\
254 The mark saves a location for the user's convenience.\n\
255 Most editing commands should not alter the mark.\n\
256 To remember a location for internal use in the Lisp program,\n\
257 store it in a Lisp variable. Example:\n\
259 (let ((beg (point))) (forward-line 1) (delete-region beg (point))).")
265 current_buffer
->mark
= Qnil
;
268 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
270 if (NILP (current_buffer
->mark
))
271 current_buffer
->mark
= Fmake_marker ();
273 Fset_marker (current_buffer
->mark
, pos
, Qnil
);
276 #endif /* commented-out code */
279 save_excursion_save ()
281 register int visible
= (XBUFFER (XWINDOW (selected_window
)->buffer
)
284 return Fcons (Fpoint_marker (),
285 Fcons (Fcopy_marker (current_buffer
->mark
),
286 Fcons (visible
? Qt
: Qnil
,
287 current_buffer
->mark_active
)));
291 save_excursion_restore (info
)
292 register Lisp_Object info
;
294 register Lisp_Object tem
, tem1
;
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
));
313 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
314 Fswitch_to_buffer (Fcurrent_buffer (), Qnil
);
316 tem1
= current_buffer
->mark_active
;
317 current_buffer
->mark_active
= Fcdr (tem
);
318 if (! NILP (current_buffer
->mark_active
))
319 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
320 else if (! NILP (tem1
))
321 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
325 DEFUN ("save-excursion", Fsave_excursion
, Ssave_excursion
, 0, UNEVALLED
, 0,
326 "Save point, mark, and current buffer; execute BODY; restore those things.\n\
327 Executes BODY just like `progn'.\n\
328 The values of point, mark and the current buffer are restored\n\
329 even in case of abnormal exit (throw or error).\n\
330 The state of activation of the mark is also restored.")
334 register Lisp_Object val
;
335 int count
= specpdl_ptr
- specpdl
;
337 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
340 return unbind_to (count
, val
);
343 DEFUN ("buffer-size", Fbufsize
, Sbufsize
, 0, 0, 0,
344 "Return the number of characters in the current buffer.")
348 XFASTINT (temp
) = Z
- BEG
;
352 DEFUN ("point-min", Fpoint_min
, Spoint_min
, 0, 0, 0,
353 "Return the minimum permissible value of point in the current buffer.\n\
354 This is 1, unless a clipping restriction is in effect.")
358 XFASTINT (temp
) = BEGV
;
362 DEFUN ("point-min-marker", Fpoint_min_marker
, Spoint_min_marker
, 0, 0, 0,
363 "Return a marker to the minimum permissible value of point in this buffer.\n\
364 This is the beginning, unless a clipping restriction is in effect.")
367 return buildmark (BEGV
);
370 DEFUN ("point-max", Fpoint_max
, Spoint_max
, 0, 0, 0,
371 "Return the maximum permissible value of point in the current buffer.\n\
372 This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
373 in which case it is less.")
377 XFASTINT (temp
) = ZV
;
381 DEFUN ("point-max-marker", Fpoint_max_marker
, Spoint_max_marker
, 0, 0, 0,
382 "Return a marker to the maximum permissible value of point in this buffer.\n\
383 This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
384 in which case it is less.")
387 return buildmark (ZV
);
390 DEFUN ("following-char", Ffollowing_char
, Sfollowing_char
, 0, 0, 0,
391 "Return the character following point, as a number.\n\
392 At the end of the buffer or accessible region, return 0.")
399 XFASTINT (temp
) = FETCH_CHAR (point
);
403 DEFUN ("preceding-char", Fprevious_char
, Sprevious_char
, 0, 0, 0,
404 "Return the character preceding point, as a number.\n\
405 At the beginning of the buffer or accessible region, return 0.")
412 XFASTINT (temp
) = FETCH_CHAR (point
- 1);
416 DEFUN ("bobp", Fbobp
, Sbobp
, 0, 0, 0,
417 "Return T if point is at the beginning of the buffer.\n\
418 If the buffer is narrowed, this means the beginning of the narrowed part.")
426 DEFUN ("eobp", Feobp
, Seobp
, 0, 0, 0,
427 "Return T if point is at the end of the buffer.\n\
428 If the buffer is narrowed, this means the end of the narrowed part.")
436 DEFUN ("bolp", Fbolp
, Sbolp
, 0, 0, 0,
437 "Return T if point is at the beginning of a line.")
440 if (point
== BEGV
|| FETCH_CHAR (point
- 1) == '\n')
445 DEFUN ("eolp", Feolp
, Seolp
, 0, 0, 0,
446 "Return T if point is at the end of a line.\n\
447 `End of a line' includes point being at the end of the buffer.")
450 if (point
== ZV
|| FETCH_CHAR (point
) == '\n')
455 DEFUN ("char-after", Fchar_after
, Schar_after
, 1, 1, 0,
456 "Return character in current buffer at position POS.\n\
457 POS is an integer or a buffer pointer.\n\
458 If POS is out of range, the value is nil.")
462 register Lisp_Object val
;
465 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
468 if (n
< BEGV
|| n
>= ZV
) return Qnil
;
470 XFASTINT (val
) = FETCH_CHAR (n
);
474 DEFUN ("user-login-name", Fuser_login_name
, Suser_login_name
, 0, 0, 0,
475 "Return the name under which the user logged in, as a string.\n\
476 This is based on the effective uid, not the real uid.\n\
477 Also, if the environment variable USER or LOGNAME is set,\n\
478 that determines the value of this function.")
484 DEFUN ("user-real-login-name", Fuser_real_login_name
, Suser_real_login_name
,
486 "Return the name of the user's real uid, as a string.\n\
487 Differs from `user-login-name' when running under `su'.")
490 return Vuser_real_name
;
493 DEFUN ("user-uid", Fuser_uid
, Suser_uid
, 0, 0, 0,
494 "Return the effective uid of Emacs, as an integer.")
497 return make_number (geteuid ());
500 DEFUN ("user-real-uid", Fuser_real_uid
, Suser_real_uid
, 0, 0, 0,
501 "Return the real uid of Emacs, as an integer.")
504 return make_number (getuid ());
507 DEFUN ("user-full-name", Fuser_full_name
, Suser_full_name
, 0, 0, 0,
508 "Return the full name of the user logged in, as a string.")
511 return Vuser_full_name
;
514 DEFUN ("system-name", Fsystem_name
, Ssystem_name
, 0, 0, 0,
515 "Return the name of the machine you are running on, as a string.")
521 DEFUN ("current-time", Fcurrent_time
, Scurrent_time
, 0, 0, 0,
522 "Return the current time, as the number of seconds since 12:00 AM January 1970.\n\
523 The time is returned as a list of three integers. The first has the\n\
524 most significant 16 bits of the seconds, while the second has the\n\
525 least significant 16 bits. The third integer gives the microsecond\n\
528 The microsecond count is zero on systems that do not provide\n\
529 resolution finer than a second.")
533 Lisp_Object result
[3];
536 XSET (result
[0], Lisp_Int
, (EMACS_SECS (t
) >> 16) & 0xffff);
537 XSET (result
[1], Lisp_Int
, (EMACS_SECS (t
) >> 0) & 0xffff);
538 XSET (result
[2], Lisp_Int
, EMACS_USECS (t
));
540 return Flist (3, result
);
544 DEFUN ("current-time-string", Fcurrent_time_string
, Scurrent_time_string
, 0, 1, 0,
545 "Return the current time, as a human-readable string.\n\
546 Programs can use this function to decode a time,\n\
547 since the number of columns in each field is fixed.\n\
548 The format is `Sun Sep 16 01:03:52 1973'.\n\
549 If an argument is given, it specifies a time to format\n\
550 instead of the current time. The argument should have the form:\n\
553 (HIGH LOW . IGNORED).\n\
554 Thus, you can use times obtained from `current-time'\n\
555 and from `file-attributes'.")
557 Lisp_Object specified_time
;
563 if (NILP (specified_time
))
564 value
= time ((long *) 0);
567 Lisp_Object high
, low
;
568 high
= Fcar (specified_time
);
569 CHECK_NUMBER (high
, 0);
570 low
= Fcdr (specified_time
);
571 if (XTYPE (low
) == Lisp_Cons
)
573 CHECK_NUMBER (low
, 0);
574 value
= ((XINT (high
) << 16) + (XINT (low
) & 0xffff));
577 tem
= (char *) ctime (&value
);
579 strncpy (buf
, tem
, 24);
582 return build_string (buf
);
585 DEFUN ("current-time-zone", Fcurrent_time_zone
, Scurrent_time_zone
, 0, 0, 0,
586 "Return the offset, savings state, and names for the current time zone.\n\
587 This returns a list of the form (OFFSET SAVINGS-FLAG STANDARD SAVINGS).\n\
588 OFFSET is an integer specifying how many minutes east of Greenwich the\n\
589 current time zone is located. A negative value means west of\n\
590 Greenwich. Note that this describes the standard time; if daylight\n\
591 savings time is in effect, it does not affect this value.\n\
592 SAVINGS-FLAG is non-nil iff daylight savings time or some other sort\n\
593 of seasonal time adjustment is in effect.\n\
594 STANDARD is a string giving the name of the time zone when no seasonal\n\
595 time adjustment is in effect.\n\
596 SAVINGS is a string giving the name of the time zone when there is a\n\
597 seasonal time adjustment in effect.\n\
598 If the local area does not use a seasonal time adjustment,\n\
599 SAVINGS-FLAG is always nil, and STANDARD and SAVINGS are equal.\n\
601 Some operating systems cannot provide all this information to Emacs;\n\
602 in this case, current-time-zone will return a list containing nil for\n\
603 the data it can't find.")
606 #ifdef EMACS_CURRENT_TIME_ZONE
607 int offset
, savings_flag
;
611 EMACS_CURRENT_TIME_ZONE (&offset
, &savings_flag
, standard
, savings
);
613 return Fcons (make_number (offset
),
614 Fcons ((savings_flag
? Qt
: Qnil
),
615 Fcons (build_string (standard
),
616 Fcons (build_string (savings
),
619 return Fmake_list (4, Qnil
);
632 /* Callers passing one argument to Finsert need not gcpro the
633 argument "array", since the only element of the array will
634 not be used after calling insert or insert_from_string, so
635 we don't care if it gets trashed. */
637 DEFUN ("insert", Finsert
, Sinsert
, 0, MANY
, 0,
638 "Insert the arguments, either strings or characters, at point.\n\
639 Point moves forward so that it ends up after the inserted text.\n\
640 Any other markers at the point of insertion remain before the text.")
643 register Lisp_Object
*args
;
646 register Lisp_Object tem
;
649 for (argnum
= 0; argnum
< nargs
; argnum
++)
653 if (XTYPE (tem
) == Lisp_Int
)
658 else if (XTYPE (tem
) == Lisp_String
)
660 insert_from_string (tem
, 0, XSTRING (tem
)->size
);
664 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
672 DEFUN ("insert-before-markers", Finsert_before_markers
, Sinsert_before_markers
, 0, MANY
, 0,
673 "Insert strings or characters at point, relocating markers after the text.\n\
674 Point moves forward so that it ends up after the inserted text.\n\
675 Any other markers at the point of insertion also end up after the text.")
678 register Lisp_Object
*args
;
681 register Lisp_Object tem
;
684 for (argnum
= 0; argnum
< nargs
; argnum
++)
688 if (XTYPE (tem
) == Lisp_Int
)
691 insert_before_markers (str
, 1);
693 else if (XTYPE (tem
) == Lisp_String
)
695 insert_from_string_before_markers (tem
, 0, XSTRING (tem
)->size
);
699 tem
= wrong_type_argument (Qchar_or_string_p
, tem
);
707 DEFUN ("insert-char", Finsert_char
, Sinsert_char
, 2, 2, 0,
708 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
709 Point and all markers are affected as in the function `insert'.\n\
710 Both arguments are required.")
712 Lisp_Object chr
, count
;
714 register unsigned char *string
;
718 CHECK_NUMBER (chr
, 0);
719 CHECK_NUMBER (count
, 1);
724 strlen
= min (n
, 256);
725 string
= (unsigned char *) alloca (strlen
);
726 for (i
= 0; i
< strlen
; i
++)
727 string
[i
] = XFASTINT (chr
);
730 insert (string
, strlen
);
739 /* Making strings from buffer contents. */
741 /* Return a Lisp_String containing the text of the current buffer from
742 START to END. If text properties are in use and the current buffer
743 has properties in the range specifed, the resulting string will also
746 We don't want to use plain old make_string here, because it calls
747 make_uninit_string, which can cause the buffer arena to be
748 compacted. make_string has no way of knowing that the data has
749 been moved, and thus copies the wrong data into the string. This
750 doesn't effect most of the other users of make_string, so it should
751 be left as is. But we should use this function when conjuring
752 buffer substrings. */
755 make_buffer_string (start
, end
)
760 if (start
< GPT
&& GPT
< end
)
763 result
= make_uninit_string (end
- start
);
764 bcopy (&FETCH_CHAR (start
), XSTRING (result
)->data
, end
- start
);
766 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
767 copy_intervals_to_string (result
, current_buffer
, start
, end
- start
);
772 DEFUN ("buffer-substring", Fbuffer_substring
, Sbuffer_substring
, 2, 2, 0,
773 "Return the contents of part of the current buffer as a string.\n\
774 The two arguments START and END are character positions;\n\
775 they can be in either order.")
779 register int beg
, end
;
781 validate_region (&b
, &e
);
785 return make_buffer_string (beg
, end
);
788 DEFUN ("buffer-string", Fbuffer_string
, Sbuffer_string
, 0, 0, 0,
789 "Return the contents of the current buffer as a string.")
792 return make_buffer_string (BEGV
, ZV
);
795 DEFUN ("insert-buffer-substring", Finsert_buffer_substring
, Sinsert_buffer_substring
,
797 "Insert before point a substring of the contents buffer BUFFER.\n\
798 BUFFER may be a buffer or a buffer name.\n\
799 Arguments START and END are character numbers specifying the substring.\n\
800 They default to the beginning and the end of BUFFER.")
802 Lisp_Object buf
, b
, e
;
804 register int beg
, end
, temp
, len
, opoint
, start
;
805 register struct buffer
*bp
;
808 buffer
= Fget_buffer (buf
);
811 bp
= XBUFFER (buffer
);
817 CHECK_NUMBER_COERCE_MARKER (b
, 0);
824 CHECK_NUMBER_COERCE_MARKER (e
, 1);
829 temp
= beg
, beg
= end
, end
= temp
;
831 /* Move the gap or create enough gap in the current buffer. */
835 if (GAP_SIZE
< end
- beg
)
836 make_gap (end
- beg
- GAP_SIZE
);
842 if (!(BUF_BEGV (bp
) <= beg
844 && end
<= BUF_ZV (bp
)))
845 args_out_of_range (b
, e
);
847 /* Now the actual insertion will not do any gap motion,
848 so it matters not if BUF is the current buffer. */
849 if (beg
< BUF_GPT (bp
))
851 insert (BUF_CHAR_ADDRESS (bp
, beg
), min (end
, BUF_GPT (bp
)) - beg
);
852 beg
= min (end
, BUF_GPT (bp
));
855 insert (BUF_CHAR_ADDRESS (bp
, beg
), end
- beg
);
857 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
858 graft_intervals_into_buffer (copy_intervals (bp
->intervals
, start
, len
),
864 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings
, Scompare_buffer_substrings
,
866 "Compare two substrings of two buffers; return result as number.\n\
867 the value is -N if first string is less after N-1 chars,\n\
868 +N if first string is greater after N-1 chars, or 0 if strings match.\n\
869 Each substring is represented as three arguments: BUFFER, START and END.\n\
870 That makes six args in all, three for each substring.\n\n\
871 The value of `case-fold-search' in the current buffer\n\
872 determines whether case is significant or ignored.")
873 (buffer1
, start1
, end1
, buffer2
, start2
, end2
)
874 Lisp_Object buffer1
, start1
, end1
, buffer2
, start2
, end2
;
876 register int begp1
, endp1
, begp2
, endp2
, temp
, len1
, len2
, length
, i
;
877 register struct buffer
*bp1
, *bp2
;
878 register unsigned char *trt
879 = (!NILP (current_buffer
->case_fold_search
)
880 ? XSTRING (current_buffer
->case_canon_table
)->data
: 0);
882 /* Find the first buffer and its substring. */
885 bp1
= current_buffer
;
889 buf1
= Fget_buffer (buffer1
);
892 bp1
= XBUFFER (buf1
);
896 begp1
= BUF_BEGV (bp1
);
899 CHECK_NUMBER_COERCE_MARKER (start1
, 1);
900 begp1
= XINT (start1
);
903 endp1
= BUF_ZV (bp1
);
906 CHECK_NUMBER_COERCE_MARKER (end1
, 2);
911 temp
= begp1
, begp1
= endp1
, endp1
= temp
;
913 if (!(BUF_BEGV (bp1
) <= begp1
915 && endp1
<= BUF_ZV (bp1
)))
916 args_out_of_range (start1
, end1
);
918 /* Likewise for second substring. */
921 bp2
= current_buffer
;
925 buf2
= Fget_buffer (buffer2
);
928 bp2
= XBUFFER (buffer2
);
932 begp2
= BUF_BEGV (bp2
);
935 CHECK_NUMBER_COERCE_MARKER (start2
, 4);
936 begp2
= XINT (start2
);
939 endp2
= BUF_ZV (bp2
);
942 CHECK_NUMBER_COERCE_MARKER (end2
, 5);
947 temp
= begp2
, begp2
= endp2
, endp2
= temp
;
949 if (!(BUF_BEGV (bp2
) <= begp2
951 && endp2
<= BUF_ZV (bp2
)))
952 args_out_of_range (start2
, end2
);
954 len1
= endp1
- begp1
;
955 len2
= endp2
- begp2
;
960 for (i
= 0; i
< length
; i
++)
962 int c1
= *BUF_CHAR_ADDRESS (bp1
, begp1
+ i
);
963 int c2
= *BUF_CHAR_ADDRESS (bp2
, begp2
+ i
);
970 return make_number (- 1 - i
);
972 return make_number (i
+ 1);
975 /* The strings match as far as they go.
976 If one is shorter, that one is less. */
978 return make_number (length
+ 1);
979 else if (length
< len2
)
980 return make_number (- length
- 1);
982 /* Same length too => they are equal. */
983 return make_number (0);
986 DEFUN ("subst-char-in-region", Fsubst_char_in_region
,
987 Ssubst_char_in_region
, 4, 5, 0,
988 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
989 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
990 and don't mark the buffer as really changed.")
991 (start
, end
, fromchar
, tochar
, noundo
)
992 Lisp_Object start
, end
, fromchar
, tochar
, noundo
;
994 register int pos
, stop
, look
;
996 validate_region (&start
, &end
);
997 CHECK_NUMBER (fromchar
, 2);
998 CHECK_NUMBER (tochar
, 3);
1002 look
= XINT (fromchar
);
1004 modify_region (pos
, stop
);
1005 if (! NILP (noundo
))
1007 if (MODIFF
- 1 == current_buffer
->save_modified
)
1008 current_buffer
->save_modified
++;
1009 if (MODIFF
- 1 == current_buffer
->auto_save_modified
)
1010 current_buffer
->auto_save_modified
++;
1015 if (FETCH_CHAR (pos
) == look
)
1018 record_change (pos
, 1);
1019 FETCH_CHAR (pos
) = XINT (tochar
);
1021 signal_after_change (pos
, 1, 1);
1029 DEFUN ("translate-region", Ftranslate_region
, Stranslate_region
, 3, 3, 0,
1030 "From START to END, translate characters according to TABLE.\n\
1031 TABLE is a string; the Nth character in it is the mapping\n\
1032 for the character with code N. Returns the number of characters changed.")
1036 register Lisp_Object table
;
1038 register int pos
, stop
; /* Limits of the region. */
1039 register unsigned char *tt
; /* Trans table. */
1040 register int oc
; /* Old character. */
1041 register int nc
; /* New character. */
1042 int cnt
; /* Number of changes made. */
1043 Lisp_Object z
; /* Return. */
1044 int size
; /* Size of translate table. */
1046 validate_region (&start
, &end
);
1047 CHECK_STRING (table
, 2);
1049 size
= XSTRING (table
)->size
;
1050 tt
= XSTRING (table
)->data
;
1054 modify_region (pos
, stop
);
1057 for (; pos
< stop
; ++pos
)
1059 oc
= FETCH_CHAR (pos
);
1065 record_change (pos
, 1);
1066 FETCH_CHAR (pos
) = nc
;
1067 signal_after_change (pos
, 1, 1);
1077 DEFUN ("delete-region", Fdelete_region
, Sdelete_region
, 2, 2, "r",
1078 "Delete the text between point and mark.\n\
1079 When called from a program, expects two arguments,\n\
1080 positions (integers or markers) specifying the stretch to be deleted.")
1084 validate_region (&b
, &e
);
1085 del_range (XINT (b
), XINT (e
));
1089 DEFUN ("widen", Fwiden
, Swiden
, 0, 0, "",
1090 "Remove restrictions (narrowing) from current buffer.\n\
1091 This allows the buffer's full text to be seen and edited.")
1095 SET_BUF_ZV (current_buffer
, Z
);
1097 /* Changing the buffer bounds invalidates any recorded current column. */
1098 invalidate_current_column ();
1102 DEFUN ("narrow-to-region", Fnarrow_to_region
, Snarrow_to_region
, 2, 2, "r",
1103 "Restrict editing in this buffer to the current region.\n\
1104 The rest of the text becomes temporarily invisible and untouchable\n\
1105 but is not deleted; if you save the buffer in a file, the invisible\n\
1106 text is included in the file. \\[widen] makes all visible again.\n\
1107 See also `save-restriction'.\n\
1109 When calling from a program, pass two arguments; positions (integers\n\
1110 or markers) bounding the text that should remain visible.")
1112 register Lisp_Object b
, e
;
1116 CHECK_NUMBER_COERCE_MARKER (b
, 0);
1117 CHECK_NUMBER_COERCE_MARKER (e
, 1);
1119 if (XINT (b
) > XINT (e
))
1126 if (!(BEG
<= XINT (b
) && XINT (b
) <= XINT (e
) && XINT (e
) <= Z
))
1127 args_out_of_range (b
, e
);
1129 BEGV
= XFASTINT (b
);
1130 SET_BUF_ZV (current_buffer
, XFASTINT (e
));
1131 if (point
< XFASTINT (b
))
1132 SET_PT (XFASTINT (b
));
1133 if (point
> XFASTINT (e
))
1134 SET_PT (XFASTINT (e
));
1136 /* Changing the buffer bounds invalidates any recorded current column. */
1137 invalidate_current_column ();
1142 save_restriction_save ()
1144 register Lisp_Object bottom
, top
;
1145 /* Note: I tried using markers here, but it does not win
1146 because insertion at the end of the saved region
1147 does not advance mh and is considered "outside" the saved region. */
1148 XFASTINT (bottom
) = BEGV
- BEG
;
1149 XFASTINT (top
) = Z
- ZV
;
1151 return Fcons (Fcurrent_buffer (), Fcons (bottom
, top
));
1155 save_restriction_restore (data
)
1158 register struct buffer
*buf
;
1159 register int newhead
, newtail
;
1160 register Lisp_Object tem
;
1162 buf
= XBUFFER (XCONS (data
)->car
);
1164 data
= XCONS (data
)->cdr
;
1166 tem
= XCONS (data
)->car
;
1167 newhead
= XINT (tem
);
1168 tem
= XCONS (data
)->cdr
;
1169 newtail
= XINT (tem
);
1170 if (newhead
+ newtail
> BUF_Z (buf
) - BUF_BEG (buf
))
1175 BUF_BEGV (buf
) = BUF_BEG (buf
) + newhead
;
1176 SET_BUF_ZV (buf
, BUF_Z (buf
) - newtail
);
1179 /* If point is outside the new visible range, move it inside. */
1181 clip_to_bounds (BUF_BEGV (buf
), BUF_PT (buf
), BUF_ZV (buf
)));
1186 DEFUN ("save-restriction", Fsave_restriction
, Ssave_restriction
, 0, UNEVALLED
, 0,
1187 "Execute BODY, saving and restoring current buffer's restrictions.\n\
1188 The buffer's restrictions make parts of the beginning and end invisible.\n\
1189 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
1190 This special form, `save-restriction', saves the current buffer's restrictions\n\
1191 when it is entered, and restores them when it is exited.\n\
1192 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
1193 The old restrictions settings are restored\n\
1194 even in case of abnormal exit (throw or error).\n\
1196 The value returned is the value of the last form in BODY.\n\
1198 `save-restriction' can get confused if, within the BODY, you widen\n\
1199 and then make changes outside the area within the saved restrictions.\n\
1201 Note: if you are using both `save-excursion' and `save-restriction',\n\
1202 use `save-excursion' outermost:\n\
1203 (save-excursion (save-restriction ...))")
1207 register Lisp_Object val
;
1208 int count
= specpdl_ptr
- specpdl
;
1210 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1211 val
= Fprogn (body
);
1212 return unbind_to (count
, val
);
1215 DEFUN ("message", Fmessage
, Smessage
, 1, MANY
, 0,
1216 "Print a one-line message at the bottom of the screen.\n\
1217 The first argument is a control string.\n\
1218 It may contain %s or %d or %c to print successive following arguments.\n\
1219 %s means print an argument as a string, %d means print as number in decimal,\n\
1220 %c means print a number as a single character.\n\
1221 The argument used by %s must be a string or a symbol;\n\
1222 the argument used by %d or %c must be a number.\n\
1223 If the first argument is nil, clear any existing message; let the\n\
1224 minibuffer contents show.")
1236 register Lisp_Object val
;
1237 val
= Fformat (nargs
, args
);
1238 message ("%s", XSTRING (val
)->data
);
1243 DEFUN ("format", Fformat
, Sformat
, 1, MANY
, 0,
1244 "Format a string out of a control-string and arguments.\n\
1245 The first argument is a control string.\n\
1246 The other arguments are substituted into it to make the result, a string.\n\
1247 It may contain %-sequences meaning to substitute the next argument.\n\
1248 %s means print a string argument. Actually, prints any object, with `princ'.\n\
1249 %d means print as number in decimal (%o octal, %x hex).\n\
1250 %c means print a number as a single character.\n\
1251 %S means print any object as an s-expression (using prin1).\n\
1252 The argument used for %d, %o, %x or %c must be a number.\n\
1253 Use %% to put a single % into the output.")
1256 register Lisp_Object
*args
;
1258 register int n
; /* The number of the next arg to substitute */
1259 register int total
= 5; /* An estimate of the final length */
1261 register unsigned char *format
, *end
;
1263 extern char *index ();
1264 /* It should not be necessary to GCPRO ARGS, because
1265 the caller in the interpreter should take care of that. */
1267 CHECK_STRING (args
[0], 0);
1268 format
= XSTRING (args
[0])->data
;
1269 end
= format
+ XSTRING (args
[0])->size
;
1272 while (format
!= end
)
1273 if (*format
++ == '%')
1277 /* Process a numeric arg and skip it. */
1278 minlen
= atoi (format
);
1283 while ((*format
>= '0' && *format
<= '9')
1284 || *format
== '-' || *format
== ' ' || *format
== '.')
1289 else if (++n
>= nargs
)
1291 else if (*format
== 'S')
1293 /* For `S', prin1 the argument and then treat like a string. */
1294 register Lisp_Object tem
;
1295 tem
= Fprin1_to_string (args
[n
], Qnil
);
1299 else if (XTYPE (args
[n
]) == Lisp_Symbol
)
1301 XSET (args
[n
], Lisp_String
, XSYMBOL (args
[n
])->name
);
1304 else if (XTYPE (args
[n
]) == Lisp_String
)
1307 total
+= XSTRING (args
[n
])->size
;
1309 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
1310 else if (XTYPE (args
[n
]) == Lisp_Int
&& *format
!= 's')
1312 #ifdef LISP_FLOAT_TYPE
1313 /* The following loop issumes the Lisp type indicates
1314 the proper way to pass the argument.
1315 So make sure we have a flonum if the argument should
1317 if (*format
== 'e' || *format
== 'f' || *format
== 'g')
1318 args
[n
] = Ffloat (args
[n
]);
1322 #ifdef LISP_FLOAT_TYPE
1323 else if (XTYPE (args
[n
]) == Lisp_Float
&& *format
!= 's')
1325 if (! (*format
== 'e' || *format
== 'f' || *format
== 'g'))
1326 args
[n
] = Ftruncate (args
[n
]);
1332 /* Anything but a string, convert to a string using princ. */
1333 register Lisp_Object tem
;
1334 tem
= Fprin1_to_string (args
[n
], Qt
);
1341 register int nstrings
= n
+ 1;
1342 register unsigned char **strings
1343 = (unsigned char **) alloca (nstrings
* sizeof (unsigned char *));
1345 for (n
= 0; n
< nstrings
; n
++)
1348 strings
[n
] = (unsigned char *) "";
1349 else if (XTYPE (args
[n
]) == Lisp_Int
)
1350 /* We checked above that the corresponding format effector
1351 isn't %s, which would cause MPV. */
1352 strings
[n
] = (unsigned char *) XINT (args
[n
]);
1353 #ifdef LISP_FLOAT_TYPE
1354 else if (XTYPE (args
[n
]) == Lisp_Float
)
1356 union { double d
; int half
[2]; } u
;
1358 u
.d
= XFLOAT (args
[n
])->data
;
1359 strings
[n
++] = (unsigned char *) u
.half
[0];
1360 strings
[n
] = (unsigned char *) u
.half
[1];
1364 strings
[n
] = XSTRING (args
[n
])->data
;
1367 /* Format it in bigger and bigger buf's until it all fits. */
1370 buf
= (char *) alloca (total
+ 1);
1373 length
= doprnt (buf
, total
+ 1, strings
[0], end
, nargs
, strings
+ 1);
1374 if (buf
[total
- 1] == 0)
1382 return make_string (buf
, length
);
1388 format1 (string1
, arg0
, arg1
, arg2
, arg3
, arg4
)
1389 int arg0
, arg1
, arg2
, arg3
, arg4
;
1403 doprnt (buf
, sizeof buf
, string1
, 0, 5, args
);
1405 doprnt (buf
, sizeof buf
, string1
, 0, 5, &string1
+ 1);
1407 return build_string (buf
);
1410 DEFUN ("char-equal", Fchar_equal
, Schar_equal
, 2, 2, 0,
1411 "Return t if two characters match, optionally ignoring case.\n\
1412 Both arguments must be characters (i.e. integers).\n\
1413 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
1415 register Lisp_Object c1
, c2
;
1417 unsigned char *downcase
= DOWNCASE_TABLE
;
1418 CHECK_NUMBER (c1
, 0);
1419 CHECK_NUMBER (c2
, 1);
1421 if (!NILP (current_buffer
->case_fold_search
)
1422 ? (downcase
[0xff & XFASTINT (c1
)] == downcase
[0xff & XFASTINT (c2
)]
1423 && (XFASTINT (c1
) & ~0xff) == (XFASTINT (c2
) & ~0xff))
1424 : XINT (c1
) == XINT (c2
))
1433 DEFVAR_LISP ("system-name", &Vsystem_name
,
1434 "The name of the machine Emacs is running on.");
1436 DEFVAR_LISP ("user-full-name", &Vuser_full_name
,
1437 "The full name of the user logged in.");
1439 DEFVAR_LISP ("user-name", &Vuser_name
,
1440 "The user's name, based on the effective uid.");
1442 DEFVAR_LISP ("user-real-name", &Vuser_real_name
,
1443 "The user's name, base upon the real uid.");
1445 defsubr (&Schar_equal
);
1446 defsubr (&Sgoto_char
);
1447 defsubr (&Sstring_to_char
);
1448 defsubr (&Schar_to_string
);
1449 defsubr (&Sbuffer_substring
);
1450 defsubr (&Sbuffer_string
);
1452 defsubr (&Spoint_marker
);
1453 defsubr (&Smark_marker
);
1455 defsubr (&Sregion_beginning
);
1456 defsubr (&Sregion_end
);
1457 /* defsubr (&Smark); */
1458 /* defsubr (&Sset_mark); */
1459 defsubr (&Ssave_excursion
);
1461 defsubr (&Sbufsize
);
1462 defsubr (&Spoint_max
);
1463 defsubr (&Spoint_min
);
1464 defsubr (&Spoint_min_marker
);
1465 defsubr (&Spoint_max_marker
);
1471 defsubr (&Sfollowing_char
);
1472 defsubr (&Sprevious_char
);
1473 defsubr (&Schar_after
);
1475 defsubr (&Sinsert_before_markers
);
1476 defsubr (&Sinsert_char
);
1478 defsubr (&Suser_login_name
);
1479 defsubr (&Suser_real_login_name
);
1480 defsubr (&Suser_uid
);
1481 defsubr (&Suser_real_uid
);
1482 defsubr (&Suser_full_name
);
1483 defsubr (&Scurrent_time
);
1484 defsubr (&Scurrent_time_string
);
1485 defsubr (&Scurrent_time_zone
);
1486 defsubr (&Ssystem_name
);
1487 defsubr (&Smessage
);
1490 defsubr (&Sinsert_buffer_substring
);
1491 defsubr (&Scompare_buffer_substrings
);
1492 defsubr (&Ssubst_char_in_region
);
1493 defsubr (&Stranslate_region
);
1494 defsubr (&Sdelete_region
);
1496 defsubr (&Snarrow_to_region
);
1497 defsubr (&Ssave_restriction
);