305
|
1 /* Lisp functions pertaining to editing.
|
577
|
2 Copyright (C) 1985, 1986, 1987, 1989, 1992 Free Software Foundation, Inc.
|
305
|
3
|
|
4 This file is part of GNU Emacs.
|
|
5
|
|
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)
|
|
9 any later version.
|
|
10
|
|
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.
|
|
15
|
|
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. */
|
|
19
|
|
20
|
|
21 #include "config.h"
|
372
|
22
|
|
23 #ifdef VMS
|
577
|
24 #include "vms-pwd.h"
|
372
|
25 #else
|
305
|
26 #include <pwd.h>
|
372
|
27 #endif
|
|
28
|
305
|
29 #include "lisp.h"
|
|
30 #include "buffer.h"
|
|
31 #include "window.h"
|
|
32
|
577
|
33 #include "systime.h"
|
305
|
34
|
|
35 #define min(a, b) ((a) < (b) ? (a) : (b))
|
|
36 #define max(a, b) ((a) > (b) ? (a) : (b))
|
|
37
|
|
38 /* Some static data, and a function to initialize it for each run */
|
|
39
|
|
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. */
|
|
44
|
|
45 void
|
|
46 init_editfns ()
|
|
47 {
|
330
|
48 char *user_name;
|
305
|
49 register unsigned char *p, *q, *r;
|
|
50 struct passwd *pw; /* password entry for the current user */
|
|
51 extern char *index ();
|
|
52 Lisp_Object tem;
|
|
53
|
|
54 /* Set up system_name even when dumping. */
|
|
55
|
|
56 Vsystem_name = build_string (get_system_name ());
|
|
57 p = XSTRING (Vsystem_name)->data;
|
|
58 while (*p)
|
|
59 {
|
|
60 if (*p == ' ' || *p == '\t')
|
|
61 *p = '-';
|
|
62 p++;
|
|
63 }
|
|
64
|
|
65 #ifndef CANNOT_DUMP
|
|
66 /* Don't bother with this on initial start when just dumping out */
|
|
67 if (!initialized)
|
|
68 return;
|
|
69 #endif /* not CANNOT_DUMP */
|
|
70
|
|
71 pw = (struct passwd *) getpwuid (getuid ());
|
|
72 Vuser_real_name = build_string (pw ? pw->pw_name : "unknown");
|
|
73
|
330
|
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");
|
|
77 if (!user_name)
|
|
78 user_name = (char *) getenv ("LOGNAME");
|
305
|
79 if (!user_name)
|
330
|
80 {
|
|
81 pw = (struct passwd *) getpwuid (geteuid ());
|
|
82 user_name = (char *) (pw ? pw->pw_name : "unknown");
|
|
83 }
|
|
84 Vuser_name = build_string (user_name);
|
305
|
85
|
330
|
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. */
|
305
|
88 tem = Fstring_equal (Vuser_name, Vuser_real_name);
|
488
|
89 if (NILP (tem))
|
330
|
90 pw = (struct passwd *) getpwnam (XSTRING (Vuser_name)->data);
|
305
|
91
|
|
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));
|
|
95
|
|
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. */
|
|
100 if (q)
|
|
101 {
|
|
102 r = (char *) alloca (strlen (p) + XSTRING (Vuser_name)->size + 1);
|
|
103 bcopy (p, r, q - p);
|
|
104 r[q - p] = 0;
|
330
|
105 strcat (r, XSTRING (Vuser_name)->data);
|
305
|
106 r[q - p] = UPCASE (r[q - p]);
|
|
107 strcat (r, q + 1);
|
|
108 Vuser_full_name = build_string (r);
|
|
109 }
|
|
110 #endif /* AMPERSAND_FULL_NAME */
|
|
111 }
|
|
112
|
|
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.")
|
|
115 (n)
|
|
116 Lisp_Object n;
|
|
117 {
|
|
118 char c;
|
|
119 CHECK_NUMBER (n, 0);
|
|
120
|
|
121 c = XINT (n);
|
|
122 return make_string (&c, 1);
|
|
123 }
|
|
124
|
|
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.")
|
|
127 (str)
|
|
128 register Lisp_Object str;
|
|
129 {
|
|
130 register Lisp_Object val;
|
|
131 register struct Lisp_String *p;
|
|
132 CHECK_STRING (str, 0);
|
|
133
|
|
134 p = XSTRING (str);
|
|
135 if (p->size)
|
|
136 XFASTINT (val) = ((unsigned char *) p->data)[0];
|
|
137 else
|
|
138 XFASTINT (val) = 0;
|
|
139 return val;
|
|
140 }
|
|
141
|
|
142 static Lisp_Object
|
|
143 buildmark (val)
|
|
144 int val;
|
|
145 {
|
|
146 register Lisp_Object mark;
|
|
147 mark = Fmake_marker ();
|
|
148 Fset_marker (mark, make_number (val), Qnil);
|
|
149 return mark;
|
|
150 }
|
|
151
|
|
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)")
|
|
155 ()
|
|
156 {
|
|
157 Lisp_Object temp;
|
|
158 XFASTINT (temp) = point;
|
|
159 return temp;
|
|
160 }
|
|
161
|
|
162 DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
|
|
163 "Return value of point, as a marker object.")
|
|
164 ()
|
|
165 {
|
|
166 return buildmark (point);
|
|
167 }
|
|
168
|
|
169 int
|
|
170 clip_to_bounds (lower, num, upper)
|
|
171 int lower, num, upper;
|
|
172 {
|
|
173 if (num < lower)
|
|
174 return lower;
|
|
175 else if (num > upper)
|
|
176 return upper;
|
|
177 else
|
|
178 return num;
|
|
179 }
|
|
180
|
|
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).")
|
|
184 (n)
|
|
185 register Lisp_Object n;
|
|
186 {
|
|
187 CHECK_NUMBER_COERCE_MARKER (n, 0);
|
|
188
|
|
189 SET_PT (clip_to_bounds (BEGV, XINT (n), ZV));
|
|
190 return n;
|
|
191 }
|
|
192
|
|
193 static Lisp_Object
|
|
194 region_limit (beginningp)
|
|
195 int beginningp;
|
|
196 {
|
|
197 register Lisp_Object m;
|
|
198 m = Fmarker_position (current_buffer->mark);
|
488
|
199 if (NILP (m)) error ("There is no region now");
|
305
|
200 if ((point < XFASTINT (m)) == beginningp)
|
|
201 return (make_number (point));
|
|
202 else
|
|
203 return (m);
|
|
204 }
|
|
205
|
|
206 DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,
|
|
207 "Return position of beginning of region, as an integer.")
|
|
208 ()
|
|
209 {
|
|
210 return (region_limit (1));
|
|
211 }
|
|
212
|
|
213 DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0,
|
|
214 "Return position of end of region, as an integer.")
|
|
215 ()
|
|
216 {
|
|
217 return (region_limit (0));
|
|
218 }
|
|
219
|
|
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'.")
|
|
225 ()
|
|
226 {
|
|
227 return Fmarker_position (current_buffer->mark);
|
|
228 }
|
|
229 #endif /* commented out code */
|
|
230
|
|
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.")
|
|
235 ()
|
|
236 {
|
|
237 return current_buffer->mark;
|
|
238 }
|
|
239
|
|
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\
|
|
246 \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\
|
|
249 \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\
|
|
255 \n\
|
|
256 (let ((beg (point))) (forward-line 1) (delete-region beg (point))).")
|
|
257 (pos)
|
|
258 Lisp_Object pos;
|
|
259 {
|
488
|
260 if (NILP (pos))
|
305
|
261 {
|
|
262 current_buffer->mark = Qnil;
|
|
263 return Qnil;
|
|
264 }
|
|
265 CHECK_NUMBER_COERCE_MARKER (pos, 0);
|
|
266
|
488
|
267 if (NILP (current_buffer->mark))
|
305
|
268 current_buffer->mark = Fmake_marker ();
|
|
269
|
|
270 Fset_marker (current_buffer->mark, pos, Qnil);
|
|
271 return pos;
|
|
272 }
|
|
273 #endif /* commented-out code */
|
|
274
|
|
275 Lisp_Object
|
|
276 save_excursion_save ()
|
|
277 {
|
|
278 register int visible = XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer;
|
|
279
|
|
280 return Fcons (Fpoint_marker (),
|
|
281 Fcons (Fcopy_marker (current_buffer->mark), visible ? Qt : Qnil));
|
|
282 }
|
|
283
|
|
284 Lisp_Object
|
|
285 save_excursion_restore (info)
|
|
286 register Lisp_Object info;
|
|
287 {
|
|
288 register Lisp_Object tem;
|
|
289
|
|
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
|
|
293 and crash */
|
|
294 /* In that case, Fmarker_buffer returns nil now. */
|
488
|
295 if (NILP (tem))
|
305
|
296 return Qnil;
|
|
297 Fset_buffer (tem);
|
|
298 tem = Fcar (info);
|
|
299 Fgoto_char (tem);
|
|
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));
|
488
|
305 if (!NILP (tem) && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
|
305
|
306 Fswitch_to_buffer (Fcurrent_buffer (), Qnil);
|
|
307 return Qnil;
|
|
308 }
|
|
309
|
|
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).")
|
|
315 (args)
|
|
316 Lisp_Object args;
|
|
317 {
|
|
318 register Lisp_Object val;
|
|
319 int count = specpdl_ptr - specpdl;
|
|
320
|
|
321 record_unwind_protect (save_excursion_restore, save_excursion_save ());
|
|
322
|
|
323 val = Fprogn (args);
|
|
324 return unbind_to (count, val);
|
|
325 }
|
|
326
|
|
327 DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 0, 0,
|
|
328 "Return the number of characters in the current buffer.")
|
|
329 ()
|
|
330 {
|
|
331 Lisp_Object temp;
|
|
332 XFASTINT (temp) = Z - BEG;
|
|
333 return temp;
|
|
334 }
|
|
335
|
|
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.")
|
|
339 ()
|
|
340 {
|
|
341 Lisp_Object temp;
|
|
342 XFASTINT (temp) = BEGV;
|
|
343 return temp;
|
|
344 }
|
|
345
|
|
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.")
|
|
349 ()
|
|
350 {
|
|
351 return buildmark (BEGV);
|
|
352 }
|
|
353
|
|
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.")
|
|
358 ()
|
|
359 {
|
|
360 Lisp_Object temp;
|
|
361 XFASTINT (temp) = ZV;
|
|
362 return temp;
|
|
363 }
|
|
364
|
|
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.")
|
|
369 ()
|
|
370 {
|
|
371 return buildmark (ZV);
|
|
372 }
|
|
373
|
512
|
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.")
|
305
|
377 ()
|
|
378 {
|
|
379 Lisp_Object temp;
|
512
|
380 if (point >= ZV)
|
|
381 XFASTINT (temp) = 0;
|
|
382 else
|
|
383 XFASTINT (temp) = FETCH_CHAR (point);
|
305
|
384 return temp;
|
|
385 }
|
|
386
|
512
|
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.")
|
305
|
390 ()
|
|
391 {
|
|
392 Lisp_Object temp;
|
|
393 if (point <= BEGV)
|
|
394 XFASTINT (temp) = 0;
|
|
395 else
|
|
396 XFASTINT (temp) = FETCH_CHAR (point - 1);
|
|
397 return temp;
|
|
398 }
|
|
399
|
|
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.")
|
|
403 ()
|
|
404 {
|
|
405 if (point == BEGV)
|
|
406 return Qt;
|
|
407 return Qnil;
|
|
408 }
|
|
409
|
|
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.")
|
|
413 ()
|
|
414 {
|
|
415 if (point == ZV)
|
|
416 return Qt;
|
|
417 return Qnil;
|
|
418 }
|
|
419
|
|
420 DEFUN ("bolp", Fbolp, Sbolp, 0, 0, 0,
|
|
421 "Return T if point is at the beginning of a line.")
|
|
422 ()
|
|
423 {
|
|
424 if (point == BEGV || FETCH_CHAR (point - 1) == '\n')
|
|
425 return Qt;
|
|
426 return Qnil;
|
|
427 }
|
|
428
|
|
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.")
|
|
432 ()
|
|
433 {
|
|
434 if (point == ZV || FETCH_CHAR (point) == '\n')
|
|
435 return Qt;
|
|
436 return Qnil;
|
|
437 }
|
|
438
|
|
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.")
|
|
443 (pos)
|
|
444 Lisp_Object pos;
|
|
445 {
|
|
446 register Lisp_Object val;
|
|
447 register int n;
|
|
448
|
|
449 CHECK_NUMBER_COERCE_MARKER (pos, 0);
|
|
450
|
|
451 n = XINT (pos);
|
|
452 if (n < BEGV || n >= ZV) return Qnil;
|
|
453
|
|
454 XFASTINT (val) = FETCH_CHAR (n);
|
|
455 return val;
|
|
456 }
|
|
457
|
|
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.")
|
|
463 ()
|
|
464 {
|
|
465 return Vuser_name;
|
|
466 }
|
|
467
|
|
468 DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name,
|
|
469 0, 0, 0,
|
|
470 "Return the name of the user's real uid, as a string.\n\
|
|
471 Differs from `user-login-name' when running under `su'.")
|
|
472 ()
|
|
473 {
|
|
474 return Vuser_real_name;
|
|
475 }
|
|
476
|
|
477 DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0,
|
|
478 "Return the effective uid of Emacs, as an integer.")
|
|
479 ()
|
|
480 {
|
|
481 return make_number (geteuid ());
|
|
482 }
|
|
483
|
|
484 DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0,
|
|
485 "Return the real uid of Emacs, as an integer.")
|
|
486 ()
|
|
487 {
|
|
488 return make_number (getuid ());
|
|
489 }
|
|
490
|
|
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.")
|
|
493 ()
|
|
494 {
|
|
495 return Vuser_full_name;
|
|
496 }
|
|
497
|
|
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.")
|
|
500 ()
|
|
501 {
|
|
502 return Vsystem_name;
|
|
503 }
|
|
504
|
448
|
505 DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
|
577
|
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\
|
|
510 count.\n\
|
|
511 \n\
|
|
512 The microsecond count is zero on systems that do not provide\n\
|
|
513 resolution finer than a second.")
|
448
|
514 ()
|
|
515 {
|
577
|
516 EMACS_TIME t;
|
|
517 Lisp_Object result[3];
|
|
518
|
|
519 EMACS_GET_TIME (t);
|
|
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));
|
|
523
|
|
524 return Flist (3, result);
|
448
|
525 }
|
|
526
|
|
527
|
305
|
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.")
|
|
534 ()
|
|
535 {
|
|
536 long current_time = time ((long *) 0);
|
|
537 char buf[30];
|
|
538 register char *tem = (char *) ctime (¤t_time);
|
|
539
|
|
540 strncpy (buf, tem, 24);
|
|
541 buf[24] = 0;
|
|
542
|
|
543 return build_string (buf);
|
|
544 }
|
|
545
|
|
546 #ifdef unix
|
|
547
|
|
548 DEFUN ("set-default-file-mode", Fset_default_file_mode, Sset_default_file_mode, 1, 1, "p",
|
|
549 "Set Unix `umask' value to ARGUMENT, and return old value.\n\
|
|
550 The `umask' value is the default protection mode for new files.")
|
|
551 (nmask)
|
|
552 Lisp_Object nmask;
|
|
553 {
|
|
554 CHECK_NUMBER (nmask, 0);
|
|
555 return make_number (umask (XINT (nmask)));
|
|
556 }
|
|
557
|
|
558 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
|
|
559 "Tell Unix to finish all pending disk updates.")
|
|
560 ()
|
|
561 {
|
|
562 sync ();
|
|
563 return Qnil;
|
|
564 }
|
|
565
|
|
566 #endif /* unix */
|
|
567
|
|
568 void
|
|
569 insert1 (arg)
|
|
570 Lisp_Object arg;
|
|
571 {
|
|
572 Finsert (1, &arg);
|
|
573 }
|
|
574
|
330
|
575
|
|
576 /* Callers passing one argument to Finsert need not gcpro the
|
|
577 argument "array", since the only element of the array will
|
|
578 not be used after calling insert or insert_from_string, so
|
|
579 we don't care if it gets trashed. */
|
|
580
|
305
|
581 DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
|
|
582 "Insert the arguments, either strings or characters, at point.\n\
|
|
583 Point moves forward so that it ends up after the inserted text.\n\
|
|
584 Any other markers at the point of insertion remain before the text.")
|
|
585 (nargs, args)
|
|
586 int nargs;
|
|
587 register Lisp_Object *args;
|
|
588 {
|
|
589 register int argnum;
|
|
590 register Lisp_Object tem;
|
|
591 char str[1];
|
|
592
|
|
593 for (argnum = 0; argnum < nargs; argnum++)
|
|
594 {
|
|
595 tem = args[argnum];
|
|
596 retry:
|
|
597 if (XTYPE (tem) == Lisp_Int)
|
|
598 {
|
|
599 str[0] = XINT (tem);
|
|
600 insert (str, 1);
|
|
601 }
|
|
602 else if (XTYPE (tem) == Lisp_String)
|
|
603 {
|
|
604 insert_from_string (tem, 0, XSTRING (tem)->size);
|
|
605 }
|
|
606 else
|
|
607 {
|
|
608 tem = wrong_type_argument (Qchar_or_string_p, tem);
|
|
609 goto retry;
|
|
610 }
|
|
611 }
|
|
612
|
|
613 return Qnil;
|
|
614 }
|
|
615
|
|
616 DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0,
|
|
617 "Insert strings or characters at point, relocating markers after the text.\n\
|
|
618 Point moves forward so that it ends up after the inserted text.\n\
|
|
619 Any other markers at the point of insertion also end up after the text.")
|
|
620 (nargs, args)
|
|
621 int nargs;
|
|
622 register Lisp_Object *args;
|
|
623 {
|
|
624 register int argnum;
|
|
625 register Lisp_Object tem;
|
|
626 char str[1];
|
|
627
|
|
628 for (argnum = 0; argnum < nargs; argnum++)
|
|
629 {
|
|
630 tem = args[argnum];
|
|
631 retry:
|
|
632 if (XTYPE (tem) == Lisp_Int)
|
|
633 {
|
|
634 str[0] = XINT (tem);
|
|
635 insert_before_markers (str, 1);
|
|
636 }
|
|
637 else if (XTYPE (tem) == Lisp_String)
|
|
638 {
|
|
639 insert_from_string_before_markers (tem, 0, XSTRING (tem)->size);
|
|
640 }
|
|
641 else
|
|
642 {
|
|
643 tem = wrong_type_argument (Qchar_or_string_p, tem);
|
|
644 goto retry;
|
|
645 }
|
|
646 }
|
|
647
|
|
648 return Qnil;
|
|
649 }
|
|
650
|
|
651 DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 2, 0,
|
|
652 "Insert COUNT (second arg) copies of CHAR (first arg).\n\
|
|
653 Point and all markers are affected as in the function `insert'.\n\
|
|
654 Both arguments are required.")
|
|
655 (chr, count)
|
|
656 Lisp_Object chr, count;
|
|
657 {
|
|
658 register unsigned char *string;
|
|
659 register int strlen;
|
|
660 register int i, n;
|
|
661
|
|
662 CHECK_NUMBER (chr, 0);
|
|
663 CHECK_NUMBER (count, 1);
|
|
664
|
|
665 n = XINT (count);
|
|
666 if (n <= 0)
|
|
667 return Qnil;
|
|
668 strlen = min (n, 256);
|
|
669 string = (unsigned char *) alloca (strlen);
|
|
670 for (i = 0; i < strlen; i++)
|
|
671 string[i] = XFASTINT (chr);
|
|
672 while (n >= strlen)
|
|
673 {
|
|
674 insert (string, strlen);
|
|
675 n -= strlen;
|
|
676 }
|
|
677 if (n > 0)
|
|
678 insert (string, n);
|
|
679 return Qnil;
|
|
680 }
|
|
681
|
|
682
|
|
683 /* Return a string with the contents of the current region */
|
|
684
|
|
685 DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
|
|
686 "Return the contents of part of the current buffer as a string.\n\
|
|
687 The two arguments START and END are character positions;\n\
|
|
688 they can be in either order.")
|
|
689 (b, e)
|
|
690 Lisp_Object b, e;
|
|
691 {
|
|
692 register int beg, end;
|
|
693 Lisp_Object result;
|
|
694
|
|
695 validate_region (&b, &e);
|
|
696 beg = XINT (b);
|
|
697 end = XINT (e);
|
|
698
|
|
699 if (beg < GPT && end > GPT)
|
|
700 move_gap (beg);
|
|
701
|
|
702 /* Plain old make_string calls make_uninit_string, which can cause
|
|
703 the buffer arena to be compacted. make_string has no way of
|
|
704 knowing that the data has been moved, and thus copies the wrong
|
|
705 data into the string. This doesn't effect most of the other
|
|
706 users of make_string, so it should be left as is. */
|
|
707 result = make_uninit_string (end - beg);
|
|
708 bcopy (&FETCH_CHAR (beg), XSTRING (result)->data, end - beg);
|
|
709
|
|
710 return result;
|
|
711 }
|
|
712
|
|
713 DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
|
|
714 "Return the contents of the current buffer as a string.")
|
|
715 ()
|
|
716 {
|
|
717 if (BEGV < GPT && ZV > GPT)
|
|
718 move_gap (BEGV);
|
|
719 return make_string (BEGV_ADDR, ZV - BEGV);
|
|
720 }
|
|
721
|
|
722 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring,
|
|
723 1, 3, 0,
|
|
724 "Insert before point a substring of the contents buffer BUFFER.\n\
|
|
725 BUFFER may be a buffer or a buffer name.\n\
|
|
726 Arguments START and END are character numbers specifying the substring.\n\
|
|
727 They default to the beginning and the end of BUFFER.")
|
|
728 (buf, b, e)
|
|
729 Lisp_Object buf, b, e;
|
|
730 {
|
|
731 register int beg, end, exch;
|
|
732 register struct buffer *bp;
|
|
733
|
|
734 buf = Fget_buffer (buf);
|
|
735 bp = XBUFFER (buf);
|
|
736
|
488
|
737 if (NILP (b))
|
305
|
738 beg = BUF_BEGV (bp);
|
|
739 else
|
|
740 {
|
|
741 CHECK_NUMBER_COERCE_MARKER (b, 0);
|
|
742 beg = XINT (b);
|
|
743 }
|
488
|
744 if (NILP (e))
|
305
|
745 end = BUF_ZV (bp);
|
|
746 else
|
|
747 {
|
|
748 CHECK_NUMBER_COERCE_MARKER (e, 1);
|
|
749 end = XINT (e);
|
|
750 }
|
|
751
|
|
752 if (beg > end)
|
|
753 exch = beg, beg = end, end = exch;
|
|
754
|
|
755 /* Move the gap or create enough gap in the current buffer. */
|
|
756
|
|
757 if (point != GPT)
|
|
758 move_gap (point);
|
|
759 if (GAP_SIZE < end - beg)
|
|
760 make_gap (end - beg - GAP_SIZE);
|
|
761
|
|
762 if (!(BUF_BEGV (bp) <= beg
|
|
763 && beg <= end
|
|
764 && end <= BUF_ZV (bp)))
|
|
765 args_out_of_range (b, e);
|
|
766
|
|
767 /* Now the actual insertion will not do any gap motion,
|
|
768 so it matters not if BUF is the current buffer. */
|
|
769 if (beg < BUF_GPT (bp))
|
|
770 {
|
|
771 insert (BUF_CHAR_ADDRESS (bp, beg), min (end, BUF_GPT (bp)) - beg);
|
|
772 beg = min (end, BUF_GPT (bp));
|
|
773 }
|
|
774 if (beg < end)
|
|
775 insert (BUF_CHAR_ADDRESS (bp, beg), end - beg);
|
|
776
|
|
777 return Qnil;
|
|
778 }
|
|
779
|
|
780 DEFUN ("subst-char-in-region", Fsubst_char_in_region,
|
|
781 Ssubst_char_in_region, 4, 5, 0,
|
|
782 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
|
|
783 If optional arg NOUNDO is non-nil, don't record this change for undo\n\
|
|
784 and don't mark the buffer as really changed.")
|
|
785 (start, end, fromchar, tochar, noundo)
|
|
786 Lisp_Object start, end, fromchar, tochar, noundo;
|
|
787 {
|
|
788 register int pos, stop, look;
|
|
789
|
|
790 validate_region (&start, &end);
|
|
791 CHECK_NUMBER (fromchar, 2);
|
|
792 CHECK_NUMBER (tochar, 3);
|
|
793
|
|
794 pos = XINT (start);
|
|
795 stop = XINT (end);
|
|
796 look = XINT (fromchar);
|
|
797
|
|
798 modify_region (pos, stop);
|
488
|
799 if (! NILP (noundo))
|
305
|
800 {
|
|
801 if (MODIFF - 1 == current_buffer->save_modified)
|
|
802 current_buffer->save_modified++;
|
|
803 if (MODIFF - 1 == current_buffer->auto_save_modified)
|
|
804 current_buffer->auto_save_modified++;
|
|
805 }
|
|
806
|
|
807 while (pos < stop)
|
|
808 {
|
|
809 if (FETCH_CHAR (pos) == look)
|
|
810 {
|
488
|
811 if (NILP (noundo))
|
305
|
812 record_change (pos, 1);
|
|
813 FETCH_CHAR (pos) = XINT (tochar);
|
488
|
814 if (NILP (noundo))
|
305
|
815 signal_after_change (pos, 1, 1);
|
|
816 }
|
|
817 pos++;
|
|
818 }
|
|
819
|
|
820 return Qnil;
|
|
821 }
|
|
822
|
|
823 DEFUN ("translate-region", Ftranslate_region, Stranslate_region, 3, 3, 0,
|
|
824 "From START to END, translate characters according to TABLE.\n\
|
|
825 TABLE is a string; the Nth character in it is the mapping\n\
|
|
826 for the character with code N. Returns the number of characters changed.")
|
|
827 (start, end, table)
|
|
828 Lisp_Object start;
|
|
829 Lisp_Object end;
|
|
830 register Lisp_Object table;
|
|
831 {
|
|
832 register int pos, stop; /* Limits of the region. */
|
|
833 register unsigned char *tt; /* Trans table. */
|
|
834 register int oc; /* Old character. */
|
|
835 register int nc; /* New character. */
|
|
836 int cnt; /* Number of changes made. */
|
|
837 Lisp_Object z; /* Return. */
|
|
838 int size; /* Size of translate table. */
|
|
839
|
|
840 validate_region (&start, &end);
|
|
841 CHECK_STRING (table, 2);
|
|
842
|
|
843 size = XSTRING (table)->size;
|
|
844 tt = XSTRING (table)->data;
|
|
845
|
|
846 pos = XINT (start);
|
|
847 stop = XINT (end);
|
|
848 modify_region (pos, stop);
|
|
849
|
|
850 cnt = 0;
|
|
851 for (; pos < stop; ++pos)
|
|
852 {
|
|
853 oc = FETCH_CHAR (pos);
|
|
854 if (oc < size)
|
|
855 {
|
|
856 nc = tt[oc];
|
|
857 if (nc != oc)
|
|
858 {
|
|
859 record_change (pos, 1);
|
|
860 FETCH_CHAR (pos) = nc;
|
|
861 signal_after_change (pos, 1, 1);
|
|
862 ++cnt;
|
|
863 }
|
|
864 }
|
|
865 }
|
|
866
|
|
867 XFASTINT (z) = cnt;
|
|
868 return (z);
|
|
869 }
|
|
870
|
|
871 DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r",
|
|
872 "Delete the text between point and mark.\n\
|
|
873 When called from a program, expects two arguments,\n\
|
|
874 positions (integers or markers) specifying the stretch to be deleted.")
|
|
875 (b, e)
|
|
876 Lisp_Object b, e;
|
|
877 {
|
|
878 validate_region (&b, &e);
|
|
879 del_range (XINT (b), XINT (e));
|
|
880 return Qnil;
|
|
881 }
|
|
882
|
|
883 DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
|
|
884 "Remove restrictions (narrowing) from current buffer.\n\
|
|
885 This allows the buffer's full text to be seen and edited.")
|
|
886 ()
|
|
887 {
|
|
888 BEGV = BEG;
|
|
889 SET_BUF_ZV (current_buffer, Z);
|
|
890 clip_changed = 1;
|
330
|
891 /* Changing the buffer bounds invalidates any recorded current column. */
|
|
892 invalidate_current_column ();
|
305
|
893 return Qnil;
|
|
894 }
|
|
895
|
|
896 DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r",
|
|
897 "Restrict editing in this buffer to the current region.\n\
|
|
898 The rest of the text becomes temporarily invisible and untouchable\n\
|
|
899 but is not deleted; if you save the buffer in a file, the invisible\n\
|
|
900 text is included in the file. \\[widen] makes all visible again.\n\
|
|
901 See also `save-restriction'.\n\
|
|
902 \n\
|
|
903 When calling from a program, pass two arguments; positions (integers\n\
|
|
904 or markers) bounding the text that should remain visible.")
|
|
905 (b, e)
|
|
906 register Lisp_Object b, e;
|
|
907 {
|
|
908 register int i;
|
|
909
|
|
910 CHECK_NUMBER_COERCE_MARKER (b, 0);
|
|
911 CHECK_NUMBER_COERCE_MARKER (e, 1);
|
|
912
|
|
913 if (XINT (b) > XINT (e))
|
|
914 {
|
|
915 i = XFASTINT (b);
|
|
916 b = e;
|
|
917 XFASTINT (e) = i;
|
|
918 }
|
|
919
|
|
920 if (!(BEG <= XINT (b) && XINT (b) <= XINT (e) && XINT (e) <= Z))
|
|
921 args_out_of_range (b, e);
|
|
922
|
|
923 BEGV = XFASTINT (b);
|
|
924 SET_BUF_ZV (current_buffer, XFASTINT (e));
|
|
925 if (point < XFASTINT (b))
|
|
926 SET_PT (XFASTINT (b));
|
|
927 if (point > XFASTINT (e))
|
|
928 SET_PT (XFASTINT (e));
|
|
929 clip_changed = 1;
|
330
|
930 /* Changing the buffer bounds invalidates any recorded current column. */
|
|
931 invalidate_current_column ();
|
305
|
932 return Qnil;
|
|
933 }
|
|
934
|
|
935 Lisp_Object
|
|
936 save_restriction_save ()
|
|
937 {
|
|
938 register Lisp_Object bottom, top;
|
|
939 /* Note: I tried using markers here, but it does not win
|
|
940 because insertion at the end of the saved region
|
|
941 does not advance mh and is considered "outside" the saved region. */
|
|
942 XFASTINT (bottom) = BEGV - BEG;
|
|
943 XFASTINT (top) = Z - ZV;
|
|
944
|
|
945 return Fcons (Fcurrent_buffer (), Fcons (bottom, top));
|
|
946 }
|
|
947
|
|
948 Lisp_Object
|
|
949 save_restriction_restore (data)
|
|
950 Lisp_Object data;
|
|
951 {
|
|
952 register struct buffer *buf;
|
|
953 register int newhead, newtail;
|
|
954 register Lisp_Object tem;
|
|
955
|
|
956 buf = XBUFFER (XCONS (data)->car);
|
|
957
|
|
958 data = XCONS (data)->cdr;
|
|
959
|
|
960 tem = XCONS (data)->car;
|
|
961 newhead = XINT (tem);
|
|
962 tem = XCONS (data)->cdr;
|
|
963 newtail = XINT (tem);
|
|
964 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
|
|
965 {
|
|
966 newhead = 0;
|
|
967 newtail = 0;
|
|
968 }
|
|
969 BUF_BEGV (buf) = BUF_BEG (buf) + newhead;
|
|
970 SET_BUF_ZV (buf, BUF_Z (buf) - newtail);
|
|
971 clip_changed = 1;
|
|
972
|
|
973 /* If point is outside the new visible range, move it inside. */
|
|
974 SET_BUF_PT (buf,
|
|
975 clip_to_bounds (BUF_BEGV (buf), BUF_PT (buf), BUF_ZV (buf)));
|
|
976
|
|
977 return Qnil;
|
|
978 }
|
|
979
|
|
980 DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0,
|
|
981 "Execute BODY, saving and restoring current buffer's restrictions.\n\
|
|
982 The buffer's restrictions make parts of the beginning and end invisible.\n\
|
|
983 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\
|
|
984 This special form, `save-restriction', saves the current buffer's restrictions\n\
|
|
985 when it is entered, and restores them when it is exited.\n\
|
|
986 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\
|
|
987 The old restrictions settings are restored\n\
|
|
988 even in case of abnormal exit (throw or error).\n\
|
|
989 \n\
|
|
990 The value returned is the value of the last form in BODY.\n\
|
|
991 \n\
|
|
992 `save-restriction' can get confused if, within the BODY, you widen\n\
|
|
993 and then make changes outside the area within the saved restrictions.\n\
|
|
994 \n\
|
|
995 Note: if you are using both `save-excursion' and `save-restriction',\n\
|
|
996 use `save-excursion' outermost:\n\
|
|
997 (save-excursion (save-restriction ...))")
|
|
998 (body)
|
|
999 Lisp_Object body;
|
|
1000 {
|
|
1001 register Lisp_Object val;
|
|
1002 int count = specpdl_ptr - specpdl;
|
|
1003
|
|
1004 record_unwind_protect (save_restriction_restore, save_restriction_save ());
|
|
1005 val = Fprogn (body);
|
|
1006 return unbind_to (count, val);
|
|
1007 }
|
|
1008
|
|
1009 DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
|
|
1010 "Print a one-line message at the bottom of the screen.\n\
|
|
1011 The first argument is a control string.\n\
|
|
1012 It may contain %s or %d or %c to print successive following arguments.\n\
|
|
1013 %s means print an argument as a string, %d means print as number in decimal,\n\
|
|
1014 %c means print a number as a single character.\n\
|
|
1015 The argument used by %s must be a string or a symbol;\n\
|
|
1016 the argument used by %d or %c must be a number.")
|
|
1017 (nargs, args)
|
|
1018 int nargs;
|
|
1019 Lisp_Object *args;
|
|
1020 {
|
|
1021 register Lisp_Object val;
|
|
1022
|
|
1023 val = Fformat (nargs, args);
|
|
1024 message ("%s", XSTRING (val)->data);
|
|
1025 return val;
|
|
1026 }
|
|
1027
|
|
1028 DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
|
|
1029 "Format a string out of a control-string and arguments.\n\
|
|
1030 The first argument is a control string.\n\
|
|
1031 The other arguments are substituted into it to make the result, a string.\n\
|
|
1032 It may contain %-sequences meaning to substitute the next argument.\n\
|
|
1033 %s means print a string argument. Actually, prints any object, with `princ'.\n\
|
|
1034 %d means print as number in decimal (%o octal, %x hex).\n\
|
|
1035 %c means print a number as a single character.\n\
|
|
1036 %S means print any object as an s-expression (using prin1).\n\
|
330
|
1037 The argument used for %d, %o, %x or %c must be a number.\n\
|
|
1038 Use %% to put a single % into the output.")
|
305
|
1039 (nargs, args)
|
|
1040 int nargs;
|
|
1041 register Lisp_Object *args;
|
|
1042 {
|
|
1043 register int n; /* The number of the next arg to substitute */
|
|
1044 register int total = 5; /* An estimate of the final length */
|
|
1045 char *buf;
|
|
1046 register unsigned char *format, *end;
|
|
1047 int length;
|
|
1048 extern char *index ();
|
|
1049 /* It should not be necessary to GCPRO ARGS, because
|
|
1050 the caller in the interpreter should take care of that. */
|
|
1051
|
|
1052 CHECK_STRING (args[0], 0);
|
|
1053 format = XSTRING (args[0])->data;
|
|
1054 end = format + XSTRING (args[0])->size;
|
|
1055
|
|
1056 n = 0;
|
|
1057 while (format != end)
|
|
1058 if (*format++ == '%')
|
|
1059 {
|
|
1060 int minlen;
|
|
1061
|
|
1062 /* Process a numeric arg and skip it. */
|
|
1063 minlen = atoi (format);
|
|
1064 if (minlen > 0)
|
|
1065 total += minlen;
|
|
1066 else
|
|
1067 total -= minlen;
|
|
1068 while ((*format >= '0' && *format <= '9')
|
|
1069 || *format == '-' || *format == ' ' || *format == '.')
|
|
1070 format++;
|
|
1071
|
|
1072 if (*format == '%')
|
|
1073 format++;
|
|
1074 else if (++n >= nargs)
|
|
1075 ;
|
|
1076 else if (*format == 'S')
|
|
1077 {
|
|
1078 /* For `S', prin1 the argument and then treat like a string. */
|
|
1079 register Lisp_Object tem;
|
|
1080 tem = Fprin1_to_string (args[n], Qnil);
|
|
1081 args[n] = tem;
|
|
1082 goto string;
|
|
1083 }
|
|
1084 else if (XTYPE (args[n]) == Lisp_Symbol)
|
|
1085 {
|
|
1086 XSET (args[n], Lisp_String, XSYMBOL (args[n])->name);
|
|
1087 goto string;
|
|
1088 }
|
|
1089 else if (XTYPE (args[n]) == Lisp_String)
|
|
1090 {
|
|
1091 string:
|
|
1092 total += XSTRING (args[n])->size;
|
|
1093 }
|
|
1094 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
|
|
1095 else if (XTYPE (args[n]) == Lisp_Int && *format != 's')
|
|
1096 {
|
|
1097 /* The following loop issumes the Lisp type indicates
|
|
1098 the proper way to pass the argument.
|
|
1099 So make sure we have a flonum if the argument should
|
|
1100 be a double. */
|
|
1101 if (*format == 'e' || *format == 'f' || *format == 'g')
|
|
1102 args[n] = Ffloat (args[n]);
|
|
1103 total += 10;
|
|
1104 }
|
|
1105 else if (XTYPE (args[n]) == Lisp_Float && *format != 's')
|
|
1106 {
|
|
1107 if (! (*format == 'e' || *format == 'f' || *format == 'g'))
|
|
1108 args[n] = Ftruncate (args[n]);
|
|
1109 total += 20;
|
|
1110 }
|
|
1111 else
|
|
1112 {
|
|
1113 /* Anything but a string, convert to a string using princ. */
|
|
1114 register Lisp_Object tem;
|
|
1115 tem = Fprin1_to_string (args[n], Qt);
|
|
1116 args[n] = tem;
|
|
1117 goto string;
|
|
1118 }
|
|
1119 }
|
|
1120
|
|
1121 {
|
|
1122 register int nstrings = n + 1;
|
|
1123 register unsigned char **strings
|
|
1124 = (unsigned char **) alloca (nstrings * sizeof (unsigned char *));
|
|
1125
|
|
1126 for (n = 0; n < nstrings; n++)
|
|
1127 {
|
|
1128 if (n >= nargs)
|
|
1129 strings[n] = (unsigned char *) "";
|
|
1130 else if (XTYPE (args[n]) == Lisp_Int)
|
|
1131 /* We checked above that the corresponding format effector
|
|
1132 isn't %s, which would cause MPV. */
|
|
1133 strings[n] = (unsigned char *) XINT (args[n]);
|
|
1134 else if (XTYPE (args[n]) == Lisp_Float)
|
|
1135 {
|
|
1136 union { double d; int half[2]; } u;
|
|
1137
|
|
1138 u.d = XFLOAT (args[n])->data;
|
|
1139 strings[n++] = (unsigned char *) u.half[0];
|
|
1140 strings[n] = (unsigned char *) u.half[1];
|
|
1141 }
|
|
1142 else
|
|
1143 strings[n] = XSTRING (args[n])->data;
|
|
1144 }
|
|
1145
|
|
1146 /* Format it in bigger and bigger buf's until it all fits. */
|
|
1147 while (1)
|
|
1148 {
|
|
1149 buf = (char *) alloca (total + 1);
|
|
1150 buf[total - 1] = 0;
|
|
1151
|
|
1152 length = doprnt (buf, total + 1, strings[0], end, nargs, strings + 1);
|
|
1153 if (buf[total - 1] == 0)
|
|
1154 break;
|
|
1155
|
|
1156 total *= 2;
|
|
1157 }
|
|
1158 }
|
|
1159
|
|
1160 /* UNGCPRO; */
|
|
1161 return make_string (buf, length);
|
|
1162 }
|
|
1163
|
|
1164 /* VARARGS 1 */
|
|
1165 Lisp_Object
|
|
1166 #ifdef NO_ARG_ARRAY
|
|
1167 format1 (string1, arg0, arg1, arg2, arg3, arg4)
|
|
1168 int arg0, arg1, arg2, arg3, arg4;
|
|
1169 #else
|
|
1170 format1 (string1)
|
|
1171 #endif
|
|
1172 char *string1;
|
|
1173 {
|
|
1174 char buf[100];
|
|
1175 #ifdef NO_ARG_ARRAY
|
|
1176 int args[5];
|
|
1177 args[0] = arg0;
|
|
1178 args[1] = arg1;
|
|
1179 args[2] = arg2;
|
|
1180 args[3] = arg3;
|
|
1181 args[4] = arg4;
|
|
1182 doprnt (buf, sizeof buf, string1, 0, 5, args);
|
|
1183 #else
|
|
1184 doprnt (buf, sizeof buf, string1, 0, 5, &string1 + 1);
|
|
1185 #endif
|
|
1186 return build_string (buf);
|
|
1187 }
|
|
1188
|
|
1189 DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0,
|
|
1190 "Return t if two characters match, optionally ignoring case.\n\
|
|
1191 Both arguments must be characters (i.e. integers).\n\
|
|
1192 Case is ignored if `case-fold-search' is non-nil in the current buffer.")
|
|
1193 (c1, c2)
|
|
1194 register Lisp_Object c1, c2;
|
|
1195 {
|
|
1196 unsigned char *downcase = DOWNCASE_TABLE;
|
|
1197 CHECK_NUMBER (c1, 0);
|
|
1198 CHECK_NUMBER (c2, 1);
|
|
1199
|
488
|
1200 if (!NILP (current_buffer->case_fold_search)
|
305
|
1201 ? downcase[0xff & XFASTINT (c1)] == downcase[0xff & XFASTINT (c2)]
|
|
1202 : XINT (c1) == XINT (c2))
|
|
1203 return Qt;
|
|
1204 return Qnil;
|
|
1205 }
|
|
1206
|
|
1207
|
|
1208 void
|
|
1209 syms_of_editfns ()
|
|
1210 {
|
|
1211 DEFVAR_LISP ("system-name", &Vsystem_name,
|
|
1212 "The name of the machine Emacs is running on.");
|
|
1213
|
|
1214 DEFVAR_LISP ("user-full-name", &Vuser_full_name,
|
|
1215 "The full name of the user logged in.");
|
|
1216
|
|
1217 DEFVAR_LISP ("user-name", &Vuser_name,
|
|
1218 "The user's name, based on the effective uid.");
|
|
1219
|
|
1220 DEFVAR_LISP ("user-real-name", &Vuser_real_name,
|
|
1221 "The user's name, base upon the real uid.");
|
|
1222
|
|
1223 defsubr (&Schar_equal);
|
|
1224 defsubr (&Sgoto_char);
|
|
1225 defsubr (&Sstring_to_char);
|
|
1226 defsubr (&Schar_to_string);
|
|
1227 defsubr (&Sbuffer_substring);
|
|
1228 defsubr (&Sbuffer_string);
|
|
1229
|
|
1230 defsubr (&Spoint_marker);
|
|
1231 defsubr (&Smark_marker);
|
|
1232 defsubr (&Spoint);
|
|
1233 defsubr (&Sregion_beginning);
|
|
1234 defsubr (&Sregion_end);
|
|
1235 /* defsubr (&Smark); */
|
|
1236 /* defsubr (&Sset_mark); */
|
|
1237 defsubr (&Ssave_excursion);
|
|
1238
|
|
1239 defsubr (&Sbufsize);
|
|
1240 defsubr (&Spoint_max);
|
|
1241 defsubr (&Spoint_min);
|
|
1242 defsubr (&Spoint_min_marker);
|
|
1243 defsubr (&Spoint_max_marker);
|
|
1244
|
|
1245 defsubr (&Sbobp);
|
|
1246 defsubr (&Seobp);
|
|
1247 defsubr (&Sbolp);
|
|
1248 defsubr (&Seolp);
|
512
|
1249 defsubr (&Sfollowing_char);
|
|
1250 defsubr (&Sprevious_char);
|
305
|
1251 defsubr (&Schar_after);
|
|
1252 defsubr (&Sinsert);
|
|
1253 defsubr (&Sinsert_before_markers);
|
|
1254 defsubr (&Sinsert_char);
|
|
1255
|
|
1256 defsubr (&Suser_login_name);
|
|
1257 defsubr (&Suser_real_login_name);
|
|
1258 defsubr (&Suser_uid);
|
|
1259 defsubr (&Suser_real_uid);
|
|
1260 defsubr (&Suser_full_name);
|
448
|
1261 defsubr (&Scurrent_time);
|
305
|
1262 defsubr (&Scurrent_time_string);
|
|
1263 defsubr (&Ssystem_name);
|
|
1264 defsubr (&Sset_default_file_mode);
|
|
1265 defsubr (&Sunix_sync);
|
|
1266 defsubr (&Smessage);
|
|
1267 defsubr (&Sformat);
|
|
1268
|
|
1269 defsubr (&Sinsert_buffer_substring);
|
|
1270 defsubr (&Ssubst_char_in_region);
|
|
1271 defsubr (&Stranslate_region);
|
|
1272 defsubr (&Sdelete_region);
|
|
1273 defsubr (&Swiden);
|
|
1274 defsubr (&Snarrow_to_region);
|
|
1275 defsubr (&Ssave_restriction);
|
|
1276 }
|