![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to buffer.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src|
Return to buffer.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 root 1: /* Buffer manipulation primitives for GNU Emacs.
2: Copyright (C) 1985 Richard M. Stallman.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is distributed in the hope that it will be useful,
7: but WITHOUT ANY WARRANTY. No author or distributor
8: accepts responsibility to anyone for the consequences of using it
9: or for whether it serves any particular purpose or works at all,
10: unless he says so in writing. Refer to the GNU Emacs General Public
11: License for full details.
12:
13: Everyone is granted permission to copy, modify and redistribute
14: GNU Emacs, but only under the conditions described in the
15: GNU Emacs General Public License. A copy of this license is
16: supposed to have been given to you along with GNU Emacs so you
17: can know your rights and responsibilities. It should be in a
18: file named COPYING. Among other things, the copyright notice
19: and this notice must be preserved on all copies. */
20:
21:
22: #include <sys/param.h>
23:
24: #ifndef MAXPATHLEN
25: /* in 4.1, param.h fails to define this. */
26: #define MAXPATHLEN 1024
27: #endif /* not MAXPATHLEN */
28:
29: #undef NULL
30: #include "config.h"
31: #include "lisp.h"
32: #include "window.h"
33: #include "commands.h"
34: #include "buffer.h"
35: #include "syntax.h"
36:
37: struct buffer *bf_cur; /* the current buffer */
38:
39: /* This structure contains data describing the text of the current buffer.
40: Switching buffers swaps their text data in and out of here */
41:
42: struct buffer_text bf_text;
43:
44: /* First buffer in chain of all buffers (in reverse order of creation).
45: Threaded through ->next. */
46:
47: struct buffer *all_buffers;
48:
49: Lisp_Object Fset_buffer ();
50:
51: /* Alist of all buffer names vs the buffers. */
52: /* This used to be a variable, but is no longer,
53: to prevent lossage due to user rplac'ing this alist or its elements. */
54: Lisp_Object Vbuffer_alist;
55:
56: /* Function to call to install major mode.
57: nil means use the major mode of the selected buffer. */
58:
59: Lisp_Object Vdefault_major_mode;
60:
61: Lisp_Object Qfundamental_mode;
62:
63: Lisp_Object QSFundamental; /* A string "Fundamental" */
64:
65: /* For debugging; temporary. See SetBfp. */
66: Lisp_Object Qlisp_mode, Vcheck_symbol;
67:
68: Lisp_Object Vdefault_mode_line_format;
69:
70: int default_case_fold_search;
71:
72: int default_tab_width;
73: int default_ctl_arrow;
74: int default_truncate_lines;
75:
76: int default_fill_column;
77: int default_left_margin;
78:
79: Lisp_Object Vdefault_abbrev_mode;
80:
81: nsberror (spec)
82: Lisp_Object spec;
83: {
84: if (XTYPE (spec) == Lisp_String)
85: error ("No buffer named %s", XSTRING (spec)->data);
86: error ("Invalid buffer argument");
87: }
88:
89: DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
90: "Return a list of all buffers.")
91: ()
92: {
93: return Fmapcar (Qcdr, Vbuffer_alist);
94: }
95:
96: DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
97: "Return the buffer named NAME (a string).\n\
98: It is found by looking up NAME in buffer-alist.\n\
99: If there is no buffer named NAME, nil is returned.\n\
100: NAME may also be a buffer; it is returned.")
101: (name)
102: Lisp_Object name;
103: {
104: if (XTYPE (name) == Lisp_Buffer)
105: return name;
106: CHECK_STRING (name, 0);
107:
108: return Fcdr (Fassoc (name, Vbuffer_alist));
109: }
110:
111: DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
112: "Return the buffer visiting file FILENAME (a string).\n\
113: If there is no such buffer, nil is returned.")
114: (filename)
115: Lisp_Object filename;
116: {
117: register Lisp_Object tail, buf, tem;
118: CHECK_STRING (filename, 0);
119: filename = Fexpand_file_name (filename, Qnil);
120:
121: for (tail = Vbuffer_alist; LISTP (tail); tail = XCONS (tail)->cdr)
122: {
123: buf = Fcdr (XCONS (tail)->car);
124: if (XTYPE (buf) != Lisp_Buffer) continue;
125: if (XTYPE (XBUFFER (buf)->filename) != Lisp_String) continue;
126: tem = Fstring_equal (XBUFFER (buf)->filename, filename);
127: if (!NULL (tem))
128: return buf;
129: }
130: return Qnil;
131: }
132:
133: /* Incremented for each buffer created, to assign the buffer number. */
134: int buffer_count;
135:
136: DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
137: "Like get-buffer but creates a buffer named NAME and returns it if none already exists.")
138: (name)
139: Lisp_Object name;
140: {
141: Lisp_Object buf, function;
142: int count = specpdl_ptr - specpdl;
143: register struct buffer *b;
144: struct buffer *bx;
145: unsigned char *data;
146:
147: buf = Fget_buffer (name);
148: if (!NULL (buf)) return buf;
149:
150: b = (struct buffer *) malloc (sizeof (struct buffer));
151: if (!b) memory_full ();
152:
153: data = (unsigned char *) malloc (b->text.gap = 20);
154: if (!data) memory_full ();
155: b->text.p1 = data - 1;
156: b->text.p2 = data - 1 + b->text.gap;
157: b->text.size1 = b->text.size2 = 0;
158: b->text.modified = 1;
159: b->text.pointloc = 1;
160: b->text.head_clip = 1;
161: b->text.tail_clip = 0;
162:
163: b->next = all_buffers;
164: all_buffers = b;
165:
166: b->save_length = make_number (0);
167: b->last_window_start = 1;
168: b->markers = Qnil;
169: b->mark = Qnil;
170: b->number = make_number (++buffer_count);
171: b->name = name;
172: if (XSTRING (name)->data[0] != ' ')
173: make_undo_records (b);
174: else
175: b->undodata = 0;
176:
177: reset_buffer (b);
178:
179: XSETTYPE (buf, Lisp_Buffer);
180: bx = b; /* Use of bx avoids compiler bug on Sun */
181: XSETBUFFER (buf, bx);
182: Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
183:
184: function = Vdefault_major_mode;
185: if (NULL (function))
186: function = bf_cur->major_mode;
187:
188: if (NULL (function) || EQ (function, Qfundamental_mode))
189: return buf;
190:
191: /* To select a nonfundamental mode,
192: select the buffer temporarily and then call the mode function. */
193:
194: record_unwind_protect (save_excursion_restore, save_excursion_save ());
195:
196: Fset_buffer (buf);
197: Fapply (function, Qnil);
198:
199: unbind_to (count);
200: return buf;
201: }
202:
203: void
204: reset_buffer (b)
205: register struct buffer *b;
206: {
207: b->filename = Qnil;
208: b->directory = (bf_cur) ? bf_cur->directory : Qnil;
209: b->modtime = 0;
210: b->save_modified = 1;
211: b->backed_up = *(int*) &Qnil;
212: b->auto_save_modified = 0;
213: b->auto_save_file_name = Qnil;
214: b->read_only = Qnil;
215: reset_buffer_local_variables(b);
216: }
217:
218: reset_buffer_local_variables(b)
219: register struct buffer *b;
220: {
221: b->keymap = Qnil;
222: b->abbrev_table = Vfundamental_mode_abbrev_table;
223: b->tab_width = make_number (default_tab_width);
224: b->fill_column = make_number (default_fill_column);
225: b->left_margin = make_number (default_left_margin);
226: b->case_fold_search = default_case_fold_search ? Qt : Qnil;
227:
228: b->syntax_table_v = XVECTOR (Vstandard_syntax_table);
229: b->mode_line_format = Vdefault_mode_line_format;
230: b->auto_fill_hook = Qnil;
231: b->local_var_alist = Qnil;
232: b->ctl_arrow = default_ctl_arrow ? Qt : Qnil;
233: b->truncate_lines = default_truncate_lines ? Qt : Qnil;
234: b->selective_display = Qnil;
235: b->overwrite_mode = Qnil;
236: b->abbrev_mode = Vdefault_abbrev_mode;
237:
238: b->major_mode = Qfundamental_mode;
239: b->mode_name = QSFundamental;
240: b->minor_modes = Qnil;
241: }
242:
243: /* create-file-buffer moved into lisp code in lisp/files.el */
244:
245: DEFUN ("generate-new-buffer", Fgenerate_new_buffer, Sgenerate_new_buffer,
246: 1, 1, 0,
247: "Creates and returns a buffer named NAME if one does not already exist,\n\
248: else tries adding successive suffixes to NAME until a new buffer-name is\n\
249: formed, then creates and returns a new buffer with that new name.")
250: (name)
251: Lisp_Object name;
252: {
253: Lisp_Object gentemp, tem;
254: int count;
255: char number[10];
256:
257: CHECK_STRING (name, 0);
258:
259: tem = Fget_buffer (name);
260: if (NULL (tem))
261: return Fget_buffer_create (name);
262:
263: count = 1;
264: while (1)
265: {
266: sprintf (number, "<%d>", ++count);
267: gentemp = concat2 (name, build_string (number));
268: tem = Fget_buffer (gentemp);
269: if (NULL (tem))
270: return Fget_buffer_create (gentemp);
271: }
272: }
273:
274:
275: DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
276: "Return the name of BUFFER, as a string.\n\
277: No arg means return name of current buffer.")
278: (buffer)
279: Lisp_Object buffer;
280: {
281: if (NULL (buffer))
282: return bf_cur->name;
283: CHECK_BUFFER (buffer, 0);
284: return XBUFFER (buffer)->name;
285: }
286:
287: DEFUN ("buffer-number", Fbuffer_number, Sbuffer_number, 0, 1, 0,
288: "Return the number of BUFFER.\n\
289: No arg means return number of current buffer.")
290: (buffer)
291: Lisp_Object buffer;
292: {
293: if (NULL (buffer))
294: return bf_cur->number;
295: CHECK_BUFFER (buffer, 0);
296: return XBUFFER (buffer)->number;
297: }
298:
299: DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
300: "Return name of file BUFFER is visiting, or NIL if none.\n\
301: No argument means use current buffer as BUFFER.")
302: (buffer)
303: Lisp_Object buffer;
304: {
305: if (NULL (buffer))
306: return bf_cur->filename;
307: CHECK_BUFFER (buffer, 0);
308: return XBUFFER (buffer)->filename;
309: }
310:
311: DEFUN ("buffer-local-variables", Fbuffer_local_variables,
312: Sbuffer_local_variables,
313: 0, 1, 0,
314: "Return alist of buffer-local variables of BUFFER.\n\
315: Each element looks like (SYMBOL . VALUE).\n\
316: No argument means use current buffer as BUFFER.")
317: (buffer)
318: Lisp_Object buffer;
319: {
320: if (NULL (buffer))
321: return bf_cur->local_var_alist;
322: CHECK_BUFFER (buffer, 0);
323: return XBUFFER (buffer)->local_var_alist;
324: }
325:
326: DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
327: 0, 1, 0,
328: "Return t if BUFFER is modified since file last read in or saved.\n\
329: No argument means use current buffer as BUFFER.")
330: (buffer)
331: Lisp_Object buffer;
332: {
333: register struct buffer *buf;
334: if (NULL (buffer))
335: buf = bf_cur;
336: else
337: {
338: CHECK_BUFFER (buffer, 0);
339: buf = XBUFFER (buffer);
340: }
341:
342: bf_cur->text.modified = bf_modified;
343: return buf->save_modified < buf->text.modified ? Qt : Qnil;
344: }
345:
346: DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
347: 1, 1, 0,
348: "Mark current buffer as modified or unmodified according to FLAG.")
349: (flag)
350: Lisp_Object flag;
351: {
352: register int already;
353: register Lisp_Object fn;
354:
355: #ifdef CLASH_DETECTION
356: /* If buffer becoming modified, lock the file.
357: If buffer becoming unmodified, unlock the file. */
358:
359: fn = bf_cur->filename;
360: if (!NULL (fn))
361: {
362: already = bf_cur->save_modified < bf_modified;
363: if (!already && !NULL (flag))
364: lock_file (fn);
365: else if (already && NULL (flag))
366: unlock_file (fn);
367: }
368: #endif /* CLASH_DETECTION */
369:
370: bf_cur->save_modified = NULL (flag) ? bf_modified : 0;
371: RedoModes++;
372: return flag;
373: }
374:
375: /* Return number of modified buffers that exist now. */
376:
377: int
378: ModExist ()
379: {
380: register Lisp_Object tail, buf;
381: register struct buffer *b;
382: register int modcount = 0;
383:
384: bf_cur->text.modified = bf_modified;
385:
386: for (tail = Vbuffer_alist; !NULL (tail); tail = Fcdr (tail))
387: {
388: buf = Fcdr (Fcar (tail));
389: b = XBUFFER (buf);
390: if (!NULL (b->filename) && b->save_modified < b->text.modified)
391: modcount++;
392: }
393:
394: return modcount;
395: }
396:
397: DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 1,
398: "sRename buffer (to new name): ",
399: "Change current buffer's name to NEWNAME (a string).")
400: (name)
401: Lisp_Object name;
402: {
403: register Lisp_Object tem, buf;
404:
405: CHECK_STRING (name, 0);
406: tem = Fget_buffer (name);
407: if (!NULL (tem))
408: error("Buffer \"%s\" already exists", XSTRING (name)->data);
409:
410: bf_cur->name = name;
411: XSET (buf, Lisp_Buffer, bf_cur);
412: return Fsetcar (Frassq (buf, Vbuffer_alist), name);
413: }
414:
415: DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 1, 0,
416: "Return most recently selected buffer other than BUFFER.\n\
417: Buffers not visible in windows are preferred to visible buffers.\n\
418: If no other exists, the buffer *scratch* is returned.\n\
419: If BUFFER is omitted or nil, some interesting buffer is returned.")
420: (buffer)
421: Lisp_Object buffer;
422: {
423: register Lisp_Object tail, buf, notsogood, tem;
424: notsogood = Qnil;
425:
426: for (tail = Vbuffer_alist; !NULL (tail); tail = Fcdr (tail))
427: {
428: buf = Fcdr (Fcar (tail));
429: if (EQ (buf, buffer))
430: continue;
431: if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
432: continue;
433: tem = Fget_buffer_window (buf);
434: if (NULL (tem))
435: return buf;
436: if (!NULL (notsogood))
437: notsogood = buf;
438: }
439: if (!NULL (notsogood))
440: return notsogood;
441: return Fget_buffer_create (build_string ("*scratch*"));
442: }
443:
444: DEFUN ("buffer-flush-undo", Fbuffer_flush_undo, Sbuffer_flush_undo, 1, 1, 0,
445: "Make BUFFER stop keeping undo information.")
446: (buf)
447: Lisp_Object buf;
448: {
449: CHECK_BUFFER (buf, 0);
450: if (XBUFFER (buf)->undodata)
451: free_undo_records (XBUFFER (buf));
452: XBUFFER (buf)->undodata = 0;
453: return Qnil;
454: }
455:
456: Lisp_Object
457: Fdelete_buffer_internal (buf)
458: Lisp_Object buf;
459: {
460: register struct buffer *b = XBUFFER (buf);
461: register Lisp_Object tem;
462: register struct Lisp_Marker *m;
463:
464: if (NULL (b->name))
465: return Qnil;
466:
467: #ifdef CLASH_DETECTION
468: /* Unlock this buffer's file, if it is locked. */
469: Funlock_buffer ();
470: #endif /* CLASH_DETECTION */
471:
472: /* make this buffer not be current */
473: if (b == bf_cur)
474: {
475: tem = Fother_buffer (buf);
476: if (NULL (tem))
477: tem = Fget_buffer_create (build_string ("*scratch*"));
478: Fset_buffer (tem);
479: }
480:
481: #ifdef subprocesses
482: kill_buffer_processes (buf);
483: #endif subprocesses
484:
485: Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
486: Freplace_buffer_in_windows (buf);
487:
488: /* Unchain all markers of this buffer
489: and leave them pointing nowhere. */
490: for (tem = b->markers; !EQ (tem, Qnil); )
491: {
492: m = XMARKER (tem);
493: m->buffer = 0;
494: tem = m->chain;
495: m->chain = Qnil;
496: }
497:
498: b->name = Qnil;
499: free (b->text.p1 + 1);
500: if (b->undodata)
501: free_undo_records (b);
502:
503: return Qnil;
504: }
505:
506: DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
507: "One arg, a string or a buffer. Get rid of the specified buffer.")
508: (bufname)
509: Lisp_Object bufname;
510: {
511: register Lisp_Object buf, answer;
512:
513: if (NULL (bufname))
514: buf = Fcurrent_buffer ();
515: else
516: buf = Fget_buffer (bufname);
517: if (NULL (buf))
518: nsberror (bufname);
519: bufname = XBUFFER (buf)->name;
520:
521: bf_cur->text.modified = bf_modified;
522:
523: if (INTERACTIVE && !NULL (XBUFFER (buf)->filename)
524: && XBUFFER (buf)->text.modified > XBUFFER (buf)->save_modified)
525: {
526: answer = Fyes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
527: XSTRING (bufname)->data));
528: if (NULL (answer))
529: return Qnil;
530: }
531: Fdelete_buffer_internal (buf);
532: return Qnil;
533: }
534:
535: /* Put the element for buffer `buf' at the front of buffer-alist.
536: This is done when a buffer is selected "visibly".
537: It keeps buffer-alist in the order of recency of selection
538: so that other_buffer will return something nice. */
539:
540: record_buffer (buf)
541: Lisp_Object buf;
542: {
543: register Lisp_Object aelt, link;
544: aelt = Frassq (buf, Vbuffer_alist);
545: link = Fmemq (aelt, Vbuffer_alist);
546: XCONS(link)->cdr = Fdelq (aelt, Vbuffer_alist);
547: Vbuffer_alist = link;
548: }
549:
550: DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
551: "One arg, a string or buffer. Select the specified buffer\n\
552: in the current window. Optional arg NORECORD non-nil means\n\
553: do not put this buffer at the front of the list of recently selected ones.")
554: (bufname, norecord)
555: Lisp_Object bufname, norecord;
556: {
557: register Lisp_Object buf;
558: if (NULL (bufname))
559: buf = Fother_buffer (Fcurrent_buffer ());
560: else
561: buf = Fget_buffer_create (bufname);
562: Fset_buffer (buf);
563: if (NULL (norecord))
564: record_buffer (buf);
565:
566: Fshow_buffer (EQ (selected_window, minibuf_window)
567: ? Fnext_window (minibuf_window, Qnil) : selected_window,
568: buf);
569:
570: return Qnil;
571: }
572:
573: DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
574: "Select buffer BUFFER in some window, preferably a different one.\n\
575: If pop-up-windows is non-nil, windows can be split to do this.\n\
576: If second arg OTHER-WINDOW is non-nil, insist on finding another\n\
577: window even if BUFFER is already visible in the selected window.")
578: (bufname, other)
579: Lisp_Object bufname, other;
580: {
581: register Lisp_Object buf;
582: if (NULL (bufname))
583: buf = Fother_buffer (Fcurrent_buffer ());
584: else
585: buf = Fget_buffer_create (bufname);
586: Fset_buffer (buf);
587: record_buffer (buf);
588: Fselect_window (Fdisplay_buffer (buf, other));
589: return Qnil;
590: }
591:
592: DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
593: "Return the current buffer as a Lisp buffer object.")
594: ()
595: {
596: register Lisp_Object buf;
597: XSET (buf, Lisp_Buffer, bf_cur);
598: return buf;
599: }
600:
601: DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
602: "Set the current buffer to the buffer or buffer name supplied as argument.\n\
603: That buffer will then be the default for editing operations and printing.\n\
604: This function's effect can't last past end of current command\n\
605: because returning to command level\n\
606: selects the chosen buffer of the current window,\n\
607: and this function has no effect on what buffer that is.\n\
608: Use switch-to-buffer or pop-to-buffer for interactive buffer selection.")
609: (bufname)
610: Lisp_Object bufname;
611: {
612: register Lisp_Object buffer;
613: buffer = Fget_buffer (bufname);
614: if (NULL (buffer))
615: nsberror (bufname);
616: SetBfp (XBUFFER (buffer));
617: return buffer;
618: }
619:
620: DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
621: Sbarf_if_buffer_read_only, 0, 0, 0,
622: "Signal a buffer-read-only error if the current buffer is read-only.")
623: ()
624: {
625: if (!NULL (bf_cur->read_only))
626: Fsignal (Qbuffer_read_only, Qnil);
627: return Qnil;
628: }
629:
630: DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 1, 1, 0,
631: "Put BUFFER at the end of the list of all buffers.\n\
632: There it is the least likely candidate for other-buffer to return;\n\
633: thus, the least likely buffer for \\[switch-to-buffer] to select by default.")
634: (buf)
635: Lisp_Object buf;
636: {
637: register Lisp_Object aelt, link;
638:
639: buf = Fget_buffer (buf);
640:
641: aelt = Frassq (buf, Vbuffer_alist);
642: link = Fmemq (aelt, Vbuffer_alist);
643: Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
644: XCONS (link)->cdr = Qnil;
645: Vbuffer_alist = nconc2 (Vbuffer_alist, link);
646: return Qnil;
647: }
648:
649: extern int last_known_column_point;
650:
651: /* set the current buffer to p */
652: SetBfp (p)
653: register struct buffer *p;
654: {
655: register struct buffer *c = bf_cur;
656: register struct window *w = XWINDOW (selected_window);
657: register struct buffer *swb;
658: Lisp_Object tail, valcontents;
659: enum Lisp_Type tem;
660:
661: if (c == p)
662: return;
663:
664: if (w)
665: swb = NULL (selected_window) ? 0 : XBUFFER (w->buffer);
666:
667: if (p && NULL (p->name))
668: error ("Selecting deleted buffer");
669: windows_or_buffers_changed = 1;
670:
671: if (c)
672: {
673: if (c == swb)
674: Fset_marker (w->pointm, make_number (point), w->buffer);
675:
676: if (point < FirstCharacter || point > NumCharacters + 1)
677: abort ();
678:
679: c->text = bf_text;
680: }
681: bf_cur = p;
682: bf_text = p->text;
683: if (p == swb)
684: {
685: SetPoint (marker_position (w->pointm));
686: if (point < FirstCharacter)
687: point = FirstCharacter;
688: if (point > NumCharacters + 1)
689: point = NumCharacters + 1;
690: }
691: last_known_column_point = -1; /* invalidate indentation cache */
692:
693: /* Vcheck_symbol is set up to the symbol paragraph-start
694: in order to check for the bug that clobbers it. */
695: if (c && EQ (c->major_mode, Qlisp_mode)
696: && XFASTINT (Vcheck_symbol) != 0
697: && !NULL (Vcheck_symbol))
698: {
699: valcontents = XSYMBOL (Vcheck_symbol)->value;
700: if (XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
701: abort ();
702: if (c == XBUFFER (XCONS (XCONS (valcontents)->cdr)->car)
703: && (XTYPE (XCONS (valcontents)->car) != Lisp_String
704: || XSTRING (XCONS (valcontents)->car)->size != 6))
705: abort ();
706: }
707:
708: /* Look down buffer's list of local Lisp variables
709: to find and update any that forward into C variables. */
710:
711: for (tail = p->local_var_alist; !NULL (tail); tail = XCONS (tail)->cdr)
712: {
713: valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
714: if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
715: || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
716: && (tem = XTYPE (XCONS (valcontents)->car),
717: (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
718: || tem == Lisp_Objfwd)))
719: /* Just reference the variable
720: to cause it to become set for this buffer. */
721: Fsymbol_value (XCONS (XCONS (tail)->car)->car);
722: }
723:
724: /* Do the same with any others that were local to the previous buffer */
725:
726: if (c)
727: for (tail = c->local_var_alist; !NULL (tail); tail = XCONS (tail)->cdr)
728: {
729: valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
730: if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
731: || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
732: && (tem = XTYPE (XCONS (valcontents)->car),
733: (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
734: || tem == Lisp_Objfwd)))
735: /* Just reference the variable
736: to cause it to become set for this buffer. */
737: Fsymbol_value (XCONS (XCONS (tail)->car)->car);
738: }
739: /* Vcheck_symbol is set up to the symbol paragraph-start
740: in order to check for the bug that clobbers it. */
741: if (EQ (p->major_mode, Qlisp_mode)
742: && Vcheck_symbol
743: && !NULL (Vcheck_symbol))
744: {
745: valcontents = XSYMBOL (Vcheck_symbol)->value;
746: if (XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
747: abort ();
748: if (p == XBUFFER (XCONS (XCONS (valcontents)->cdr)->car)
749: && (XTYPE (XCONS (valcontents)->car) != Lisp_String
750: || XSTRING (XCONS (valcontents)->car)->size != 6))
751: abort ();
752: Fsymbol_value (Vcheck_symbol);
753: valcontents = XSYMBOL (Vcheck_symbol)->value;
754: if (p != XBUFFER (XCONS (XCONS (valcontents)->cdr)->car)
755: || XTYPE (XCONS (valcontents)->car) != Lisp_String
756: || XSTRING (XCONS (valcontents)->car)->size != 6)
757: abort ();
758: }
759: }
760:
761: /* set the current buffer to p "just for redisplay" */
762: SetBfx (p)
763: register struct buffer *p;
764: {
765: if (bf_cur == p)
766: return;
767:
768: bf_cur->text = bf_text;
769: bf_cur = p;
770: bf_text = p->text;
771: }
772:
773: DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, 0,
774: "Delete the entire contents of the current buffer.")
775: ()
776: {
777: Fwiden ();
778: del_range (1, NumCharacters + 1);
779: bf_cur->last_window_start = 1;
780: return Qnil;
781: }
782:
783: validate_region (b, e)
784: register Lisp_Object *b, *e;
785: {
786: register int i;
787:
788: CHECK_NUMBER_COERCE_MARKER (*b, 0);
789: CHECK_NUMBER_COERCE_MARKER (*e, 1);
790:
791: if (XINT (*b) > XINT (*e))
792: {
793: i = XFASTINT (*b); /* This is legit even if *b is < 0 */
794: *b = *e;
795: XFASTINT (*e) = i; /* because this is all we do with i. */
796: }
797:
798: if (!(FirstCharacter <= XINT (*b) && XINT (*b) <= XINT (*e)
799: && XINT (*e) <= 1 + NumCharacters))
800: args_out_of_range (*b, *e);
801: }
802:
803: Lisp_Object
804: list_buffers_1 (files)
805: Lisp_Object files;
806: {
807: Lisp_Object tail, buf, col1, col2, col3, minspace, tem, mode;
808: register struct buffer *old = bf_cur, *b;
809: int desired_point = 0;
810:
811: bf_cur->text.modified = bf_modified;
812:
813: XFASTINT (col1) = 19;
814: XFASTINT (col2) = 25;
815: XFASTINT (col3) = 40;
816: XFASTINT (minspace) = 1;
817:
818: SetBfp (XBUFFER (Vstandard_output));
819:
820: mode = intern ("Buffer-menu-mode");
821: if (!EQ (mode, bf_cur->major_mode)
822: && (tem = Ffboundp (mode), !NULL (tem)))
823: Fapply (mode, Qnil);
824: Fbuffer_flush_undo (Vstandard_output);
825: bf_cur->read_only = Qnil;
826:
827: write_string ("\
828: MR Buffer Size Mode File\n\
829: -- ------ ---- ---- ----\n", -1);
830:
831: for (tail = Vbuffer_alist; !NULL (tail); tail = Fcdr (tail))
832: {
833: buf = Fcdr (Fcar (tail));
834: b = XBUFFER (buf);
835: /* Don't mention the minibuffers. */
836: if (XSTRING (b->name)->data[0] == ' ')
837: continue;
838: /* Optionally don't mention buffers that lack files. */
839: if (!NULL (files) && NULL (b->filename))
840: continue;
841: /* Identify the current buffer. */
842: if (b == old)
843: desired_point = point;
844: write_string (b == old ? "." : " ", -1);
845: /* Identify modified buffers */
846: write_string (b->text.modified > b->save_modified ? "*" : " ", -1);
847: write_string (NULL (b->read_only) ? " " : "% ", -1);
848: Fprinc (b->name, Qnil);
849: Findent_to (col1, make_number (2));
850: XFASTINT (tem) = b->text.size1 + b->text.size2;
851: Fprin1 (tem, Qnil);
852: Findent_to (col2, minspace);
853: Fprinc (b->mode_name, Qnil);
854: Findent_to (col3, minspace);
855: if (!NULL (b->filename))
856: Fprinc (b->filename, Qnil);
857: write_string ("\n", -1);
858: }
859:
860: bf_cur->read_only = Qt;
861: SetBfp (old);
862: /* Foo. This doesn't work since temp_output_buffer_show sets point to 1 */
863: if (desired_point)
864: XBUFFER (Vstandard_output)->text.pointloc = desired_point;
865: return Qnil;
866: }
867:
868: DEFUN ("list-buffers", Flist_buffers, Slist_buffers, 0, 1, "",
869: "Display a list of names of existing buffers.\n\
870: Inserts it in buffer *Buffer List* and displays that.\n\
871: Note that buffers with names starting with spaces are omitted.\n\
872: Non-null optional arg FILES-ONLY means mention only file buffers.")
873: (files)
874: Lisp_Object files;
875: {
876: internal_with_output_to_temp_buffer ("*Buffer List*",
877: list_buffers_1, files);
878: return Qnil;
879: }
880:
881: /* note: this leaves us in fundamental-mode, not default-major-mode
882: should anything be done about this?
883: */
884: DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
885: 0, 0, 0,
886: "Eliminate all the buffer-local variable values of the current buffer.\n\
887: This buffer will then see the default values of all variables.")
888: ()
889: {
890: register Lisp_Object alist, sym, tem;
891:
892: for (alist = bf_cur->local_var_alist; !NULL (alist); alist = XCONS (alist)->cdr)
893: {
894: sym = XCONS (XCONS (alist)->car)->car;
895:
896: /* Need not do anything if some other buffer's binding is now encached. */
897: tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car;
898: if (XBUFFER (tem) == bf_cur)
899: {
900: /* Symbol is set up for this buffer's old local value.
901: Set it up for the current buffer with the default value. */
902:
903: tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->cdr;
904: XCONS (tem)->car = tem;
905: XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Fcurrent_buffer ();
906: store_symval_forwarding (sym, XCONS (XSYMBOL (sym)->value)->car,
907: XCONS (tem)->cdr);
908: }
909: }
910:
911: reset_buffer_local_variables (bf_cur);
912: return Qnil;
913: }
914:
915: extern Lisp_Object Vprin1_to_string_buffer; /* in print.c */
916: init_buffer_once ()
917: {
918: register Lisp_Object tem;
919:
920: /* Must do these before making the first buffer! */
921:
922: Vdefault_mode_line_format
923: = build_string ("--%1*%1*-Emacs: %17b %M %[(%m)%]----%3p-%-");
924: Vdefault_abbrev_mode = Qnil;
925: default_case_fold_search = 1;
926:
927: default_tab_width = 8;
928: default_truncate_lines = 0;
929: default_ctl_arrow = 1;
930:
931: default_fill_column = 70;
932: default_left_margin = 0;
933:
934: Vbuffer_alist = Qnil;
935: bf_cur = 0;
936: all_buffers = 0;
937:
938: QSFundamental = build_string ("Fundamental");
939:
940: Qfundamental_mode = intern ("fundamental-mode");
941: Vdefault_major_mode = Qfundamental_mode;
942:
943: Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
944: /* super-magic invisible buffer */
945: Vbuffer_alist = Qnil;
946:
947: tem = Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
948: /* Want no undo records for *scratch*
949: until after Emacs is dumped */
950: Fbuffer_flush_undo (tem);
951: }
952:
953: init_buffer ()
954: {
955: char buf[MAXPATHLEN+1];
956:
957: Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
958: getwd (buf);
959: if (buf[strlen (buf) - 1] != '/')
960: strcat (buf, "/");
961: bf_cur->directory = build_string (buf);
962: if (NULL (Vpurify_flag))
963: make_undo_records (bf_cur);
964: }
965:
966: /* initialize the buffer routines */
967: syms_of_buffer ()
968: {
969: staticpro (&Qfundamental_mode);
970: staticpro (&QSFundamental);
971: staticpro (&Vbuffer_alist);
972:
973: staticpro (&Qlisp_mode);
974: Qlisp_mode = intern ("lisp-mode");
975:
976: DefLispVar ("default-mode-line-format", &Vdefault_mode_line_format,
977: "Default value of mode-line-format for new buffers.");
978:
979: DefBufferLispVar ("mode-line-format", &bf_cur->mode_line_format,
980: "Template string for displaying mode line for current buffer.\n\
981: Each buffer has its own value of this variable.\n\
982: The string is printed verbatim in the mode line\n\
983: except for %-constructs:\n\
984: %b -- print buffer name. %f -- print visited file name.\n\
985: %* -- print *, % or hyphen. %m -- print value of mode-name.\n\
986: %s -- print process status. %M -- print value of global-mode-string.\n\
987: %p -- print percent of buffer above top of window, or top, bot or all.\n\
988: %[ -- print one [ for each recursive editing level. %] similar.\n\
989: %% -- print %. %- -- print infinitely many dashes.\n\
990: Decimal digits after the % specify field width to pad or truncate to.");
991:
992: DefLispVar ("default-abbrev-mode", &Vdefault_abbrev_mode,
993: "Default value of abbrev-mode for new buffers.");
994:
995: DefBufferLispVar ("abbrev-mode", &bf_cur->abbrev_mode,
996: "*Non-nil turns on automatic expansion of abbrevs when inserted.");
997:
998: DefBoolVar ("default-case-fold-search", &default_case_fold_search,
999: "*Default value of case-fold-search for new buffers.");
1000: DefBufferLispVar ("case-fold-search", &bf_cur->case_fold_search,
1001: "*Non-nil if searches should ignore case.\n\
1002: Separate value in each buffer.");
1003:
1004: DefBufferLispVar ("mode-name", &bf_cur->mode_name,
1005: "Pretty name of current buffer's major mode (a string).");
1006:
1007: DefBufferLispVar ("minor-modes", &bf_cur->minor_modes,
1008: "List of minor modes enabled in current buffer.\n\
1009: Each element is (FUNCTION-SYMBOL . PRETTY-STRING).");
1010:
1011: DefIntVar ("default-fill-column", &default_fill_column,
1012: "*Default value of fill-column for new buffers.");
1013: DefBufferLispVar ("fill-column", &bf_cur->fill_column,
1014: "*Column beyond which automatic line-wrapping should happen.\n\
1015: Separate value in each buffer.");
1016:
1017: DefIntVar ("default-left-margin", &default_left_margin,
1018: "*Default value of left-margin for buffers that don't override it.");
1019: DefBufferLispVar ("left-margin", &bf_cur->left_margin,
1020: "*Column for the default indent-line-function to indent to.\n\
1021: Linefeed indents to this column in Fundamental mode.");
1022:
1023: DefIntVar ("default-tab-width", &default_tab_width,
1024: "*Default value of tab-width for new buffers.");
1025: DefBufferLispVar ("tab-width", &bf_cur->tab_width,
1026: "*Distance between tab stops (for display of tab characters), in columns.\n\
1027: Separate value in each buffer.");
1028:
1029: DefBoolVar ("default-ctl-arrow", &default_ctl_arrow,
1030: "*Default value of ctl-arrow for new buffers.");
1031: DefBufferLispVar ("ctl-arrow", &bf_cur->ctl_arrow,
1032: "*Non-nil means display control chars with uparrow.\n\
1033: Nil means use backslash and octal digits.\n\
1034: Separate value in each buffer.");
1035:
1036: DefBoolVar ("default-truncate-lines", &default_truncate_lines,
1037: "*Default value of truncate-lines for new buffers.");
1038: DefBufferLispVar ("truncate-lines", &bf_cur->truncate_lines,
1039: "*Non-nil means do not display continuation lines;\n\
1040: give each line of text one screen line.\n\
1041: Separate value in each buffer.");
1042:
1043: DefBufferLispVar ("default-directory", &bf_cur->directory,
1044: "*Name of default directory of current buffer. Should end with slash.");
1045:
1046: DefBufferLispVar ("auto-fill-hook", &bf_cur->auto_fill_hook,
1047: "Function called (if non-nil) after self-inserting a space at column beyond fill-column");
1048:
1049: DefBufferLispVar ("buffer-file-name", &bf_cur->filename,
1050: "Name of file visited in current buffer, or nil if not visiting a file.");
1051:
1052: DefBufferLispVar ("buffer-auto-save-file-name",
1053: &bf_cur->auto_save_file_name,
1054: "Name of file for auto-saving current buffer,\n\
1055: or nil if buffer should not be auto-saved.");
1056:
1057: DefBufferLispVar ("buffer-read-only", &bf_cur->read_only,
1058: "*Non-nil if this buffer is read-only.");
1059:
1060: /* LMCL: Second arg should really be a Lisp_Object but it needs this address.
1061: * A Lisp_Object had better take up only one word! */
1062: DefBufferLispVar ("buffer-backed-up", &bf_cur->backed_up,
1063: "Non-nil if this buffer's file has been backed up.\n\
1064: Backing up is done before the first time the file is saved.");
1065:
1066: DefBufferLispVar ("buffer-saved-size", &bf_cur->save_length,
1067: "Length of current buffer when last read in, saved or auto-saved.\n\
1068: 0 initially.");
1069:
1070: DefBufferLispVar ("selective-display", &bf_cur->selective_display,
1071: "t enables selective display:\n\
1072: after a ^M, all the rest of the line is invisible.\n\
1073: ^M's in the file are written into files as newlines.\n\
1074: Integer n as value means display only lines\n\
1075: that start with less than n columns of space.");
1076:
1077: DefBufferLispVar ("overwrite-mode", &bf_cur->overwrite_mode,
1078: "*Non-nil if self-insertion should replace existing text.");
1079:
1080: DefLispVar ("default-major-mode", &Vdefault_major_mode,
1081: "*Major mode for new buffers. Defaults to fundamental-mode.\n\
1082: nil here means use current buffer's major mode.");
1083:
1084: DefBufferLispVar ("major-mode", &bf_cur->major_mode,
1085: "Symbol for buffer's major mode.");
1086:
1087: DefLispVar ("debug-check-symbol", &Vcheck_symbol,
1088: "Don't ask.");
1089:
1090: defsubr (&Sbuffer_list);
1091: defsubr (&Sget_buffer);
1092: defsubr (&Sget_file_buffer);
1093: defsubr (&Sget_buffer_create);
1094: defsubr (&Sgenerate_new_buffer);
1095: defsubr (&Sbuffer_name);
1096: defsubr (&Sbuffer_number);
1097: defsubr (&Sbuffer_file_name);
1098: defsubr (&Sbuffer_local_variables);
1099: defsubr (&Sbuffer_modified_p);
1100: defsubr (&Sset_buffer_modified_p);
1101: defsubr (&Srename_buffer);
1102: defsubr (&Sother_buffer);
1103: defsubr (&Sbuffer_flush_undo);
1104: defsubr (&Skill_buffer);
1105: defsubr (&Serase_buffer);
1106: defsubr (&Sswitch_to_buffer);
1107: defsubr (&Spop_to_buffer);
1108: defsubr (&Scurrent_buffer);
1109: defsubr (&Sset_buffer);
1110: defsubr (&Sbarf_if_buffer_read_only);
1111: defsubr (&Sbury_buffer);
1112: defsubr (&Slist_buffers);
1113: defsubr (&Skill_all_local_variables);
1114: }
1115:
1116: keys_of_buffer ()
1117: {
1118: defkey (CtlXmap, 'b', "switch-to-buffer");
1119: defkey (CtlXmap, 'k', "kill-buffer");
1120: defkey (CtlXmap, Ctl ('B'), "list-buffers");
1121: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.