xemacs-beta: src/buffer.c comparison

comparison src/buffer.c @ 5495:1f0b15040456

Merge.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Sun, 01 May 2011 18:44:03 +0100
parents	4dee0387b9de
children	56144c8593a8

comparison

equal deleted inserted replaced

-:861f2601a38b
+:1f0b15040456
 /* Buffer manipulation primitives for XEmacs.
 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
 Copyright (C) 1995 Sun Microsystems, Inc.
-Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing.
+Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2010 Ben Wing.
 This file is part of XEmacs.
-XEmacs is free software; you can redistribute it and/or modify it
+XEmacs is free software: you can redistribute it and/or modify it
 under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
+Free Software Foundation, either version 3 of the License, or (at your
-later version.
+option) any later version.
 XEmacs is distributed in the hope that it will be useful, but WITHOUT
 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 for more details.
 You should have received a copy of the GNU General Public License
-along with XEmacs; see the file COPYING.  If not, write to
+along with XEmacs.  If not, see <http://www.gnu.org/licenses/>. */
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
 /* Synched up with: Mule 2.0, FSF 19.30. */
 /* Authorship:
 Some changes by Jamie Zawinski, c. 1991-1994 (e.g. separate buffer
 list per frame, buffer slots).
 A few changes for buffer-local vars by Richard Mlynarik for
 19.8 or 19.9, c. 1993.
 Many changes by Ben Wing: changes and cleanups for Mule, esp. the
-macros in buffer.h and the intial version of the coding-system
+macros in buffer.h and the initial version of the coding-system
 conversion macros (in buffer.h) and associated fns. (in this file),
 19.12 (c. 1995); synch. to FSF 19.30 c. 1994; memory usage stats
 c. 1996; generated-modeline-string c. 1996 for mousable modeline in
 19.14.
 Indirect buffer code by Hrvoje Niksic, c. 1997?
 { XD_LISP_OBJECT, offsetof (struct buffer_text, line_number_cache) },
 { XD_END }
 };
 #ifdef NEW_GC
-DEFINE_LRECORD_IMPLEMENTATION ("buffer-text", buffer_text,
+DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("buffer-text", buffer_text,
-			       1, /*dumpable-flag*/
+				      0, buffer_text_description_1,
-0, 0, 0, 0, 0,
+				      Lisp_Buffer_Text);
-			       buffer_text_description_1,
-			       Lisp_Buffer_Text);
 #endif /* NEW_GC */
 static const struct sized_memory_description buffer_text_description = {
 sizeof (struct buffer_text),
 buffer_text_description_1
 struct buffer *b = XBUFFER (obj);
 if (print_readably)
 {
 if (!BUFFER_LIVE_P (b))
-	printing_unreadable_object ("#<killed buffer>");
+	printing_unreadable_object_fmt ("#<killed buffer>");
 else
-	printing_unreadable_object ("#<buffer %s>", XSTRING_DATA (b->name));
+	printing_unreadable_object_fmt ("#<buffer %s>", XSTRING_DATA (b->name));
 }
 else if (!BUFFER_LIVE_P (b))
 write_ascstring (printcharfun, "#<killed buffer>");
 else if (escapeflag)
 write_fmt_string_lisp (printcharfun, "#<buffer %S>", 1, b->name);
 }
 /* We do not need a finalize method to handle a buffer's children list
 because all buffers have `kill-buffer' applied to them before
 they disappear, and the children removal happens then. */
-DEFINE_LRECORD_IMPLEMENTATION ("buffer", buffer,
+DEFINE_NODUMP_LISP_OBJECT ("buffer", buffer, mark_buffer,
-			       0, /*dumpable-flag*/
+			   print_buffer, 0, 0, 0,
-mark_buffer, print_buffer, 0, 0, 0,
+			   buffer_description,
-			       buffer_description,
+			   struct buffer);
-			       struct buffer);
 DEFUN ("bufferp", Fbufferp, 1, 1, 0, /*
 Return t if OBJECT is an editor buffer.
 */
 (object))
 }
 static struct buffer *
 allocate_buffer (void)
 {
-struct buffer *b = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer);
+Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (buffer);
-COPY_LCRECORD (b, XBUFFER (Vbuffer_defaults));
+copy_lisp_object (obj, Vbuffer_defaults);
-return b;
+return XBUFFER (obj);
 }
 static Lisp_Object
 finish_init_buffer (struct buffer *b, Lisp_Object name)
 {
 init_buffer_markers (b);
 init_buffer_syntax_cache (b);
 b->generated_modeline_string = Fmake_string (make_int (84), make_int (' '));
 b->modeline_extent_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK,
-						   HASH_TABLE_EQ);
+Qeq);
 return buf;
 }
 #ifdef MEMORY_USAGE_STATS
 struct buffer_stats
 {
-int text;
+struct usage_stats u;
-int markers;
+Bytecount text;
-int extents;
+/* Ancillary Lisp */
-int other;
+Bytecount markers;
+Bytecount extents;
 };
 static Bytecount
-compute_buffer_text_usage (struct buffer *b, struct overhead_stats *ovstats)
+compute_buffer_text_usage (struct buffer *b, struct usage_stats *ustats)
 {
-int was_requested = b->text->z - 1;
+Bytecount was_requested, gap, malloc_use;
-Bytecount gap = b->text->gap_size + b->text->end_gap_size;
-Bytecount malloc_use = malloced_storage_size (b->text->beg, was_requested + gap, 0);
+/* Killed buffer? */
+if (!b->text)
-ovstats->gap_overhead    += gap;
+return 0;
-ovstats->was_requested   += was_requested;
-ovstats->malloc_overhead += malloc_use - (was_requested + gap);
+/* Indirect buffer shares its text with someone else, so don't double-
+count the text */
+if (b->base_buffer)
+return 0;
+was_requested = b->text->z - 1;
+gap = b->text->gap_size + b->text->end_gap_size;
+malloc_use = malloced_storage_size (b->text->beg, was_requested + gap, 0);
+ustats->gap_overhead    += gap;
+ustats->was_requested   += was_requested;
+ustats->malloc_overhead += malloc_use - (was_requested + gap);
 return malloc_use;
 }
 static void
 compute_buffer_usage (struct buffer *b, struct buffer_stats *stats,
-		      struct overhead_stats *ovstats)
+		      struct usage_stats *ustats)
 {
-xzero (*stats);
+stats->text    += compute_buffer_text_usage   (b, ustats);
-stats->other   += LISPOBJ_STORAGE_SIZE (b, sizeof (*b), ovstats);
+stats->markers += compute_buffer_marker_usage (b);
-stats->text    += compute_buffer_text_usage   (b, ovstats);
+stats->extents += compute_buffer_extent_usage (b);
-stats->markers += compute_buffer_marker_usage (b, ovstats);
+}
-stats->extents += compute_buffer_extent_usage (b, ovstats);
-}
+static void
+buffer_memory_usage (Lisp_Object buffer, struct generic_usage_stats *gustats)
-DEFUN ("buffer-memory-usage", Fbuffer_memory_usage, 1, 1, 0, /*
+{
-Return stats about the memory usage of buffer BUFFER.
+struct buffer_stats *stats = (struct buffer_stats *) gustats;
-The values returned are in the form of an alist of usage types and byte
-counts.  The byte counts attempt to encompass all the memory used
+compute_buffer_usage (XBUFFER (buffer), stats, &stats->u);
-by the buffer (separate from the memory logically associated with a
-buffer or frame), including internal structures and any malloc()
-overhead associated with them.  In practice, the byte counts are
-underestimated because certain memory usage is very hard to determine
-\(e.g. the amount of memory used inside the Xt library or inside the
-X server) and because there is other stuff that might logically
-be associated with a window, buffer, or frame (e.g. window configurations,
-glyphs) but should not obviously be included in the usage counts.
-Multiple slices of the total memory usage may be returned, separated
-by a nil.  Each slice represents a particular view of the memory, a
-particular way of partitioning it into groups.  Within a slice, there
-is no overlap between the groups of memory, and each slice collectively
-represents all the memory concerned.
-*/
-(buffer))
-{
-struct buffer_stats stats;
-struct overhead_stats ovstats;
-Lisp_Object val = Qnil;
-CHECK_BUFFER (buffer); /* dead buffers should be allowed, no? */
-xzero (ovstats);
-compute_buffer_usage (XBUFFER (buffer), &stats, &ovstats);
-val = acons (Qtext,    make_int (stats.text),    val);
-val = acons (Qmarkers, make_int (stats.markers), val);
-val = acons (Qextents, make_int (stats.extents), val);
-val = acons (Qother,   make_int (stats.other),   val);
-val = Fcons (Qnil, val);
-val = acons (Qactually_requested, make_int (ovstats.was_requested),   val);
-val = acons (Qmalloc_overhead,    make_int (ovstats.malloc_overhead), val);
-val = acons (Qgap_overhead,       make_int (ovstats.gap_overhead),    val);
-val = acons (Qdynarr_overhead,    make_int (ovstats.dynarr_overhead), val);
-return Fnreverse (val);
 }
 #endif /* MEMORY_USAGE_STATS */
 #if defined (DEBUG_XEMACS) && defined (MULE)
 CHECK_BUFFER (buffer); /* dead buffers should be allowed, no? */
 b = XBUFFER (buffer);
 #define ADD_INT(field) \
 plist = cons3 (make_int (b->text->field), \
-		 intern_converting_underscores_to_dashes (#field), plist)
+		 intern_massaging_name (#field), plist)
 #define ADD_BOOL(field) \
 plist = cons3 (b->text->field ? Qt : Qnil, \
-		 intern_converting_underscores_to_dashes (#field), plist)
+		 intern_massaging_name (#field), plist)
 ADD_INT (bufz);
 ADD_INT (z);
 #ifdef OLD_BYTE_CHAR
 ADD_INT (mule_bufmin);
 ADD_INT (mule_bufmax);
 #endif /* defined (DEBUG_XEMACS) && defined (MULE) */
 void
+buffer_objects_create (void)
+{
+#ifdef MEMORY_USAGE_STATS
+OBJECT_HAS_METHOD (buffer, memory_usage);
+#endif
+}
+void
 syms_of_buffer (void)
 {
-INIT_LRECORD_IMPLEMENTATION (buffer);
+INIT_LISP_OBJECT (buffer);
 #ifdef NEW_GC
-INIT_LRECORD_IMPLEMENTATION (buffer_text);
+INIT_LISP_OBJECT (buffer_text);
 #endif /* NEW_GC */
 DEFSYMBOL (Qbuffer_live_p);
 DEFSYMBOL (Qbuffer_or_string_p);
 DEFSYMBOL (Qmode_class);
 DEFSUBR (Fcurrent_buffer);
 DEFSUBR (Fset_buffer);
 DEFSUBR (Fbarf_if_buffer_read_only);
 DEFSUBR (Fbury_buffer);
 DEFSUBR (Fkill_all_local_variables);
-#ifdef MEMORY_USAGE_STATS
-DEFSUBR (Fbuffer_memory_usage);
-#endif
 #if defined (DEBUG_XEMACS) && defined (MULE)
 DEFSUBR (Fbuffer_char_byte_converion_info);
 DEFSUBR (Fstring_char_byte_converion_info);
 #endif
 /* initialize the buffer routines */
 void
 vars_of_buffer (void)
 {
 /* This function can GC */
+#ifdef MEMORY_USAGE_STATS
+OBJECT_HAS_PROPERTY
+(buffer, memusage_stats_list, list4 (Qtext, Qt, Qmarkers, Qextents));
+#endif /* MEMORY_USAGE_STATS */
 staticpro (&QSFundamental);
 staticpro (&QSscratch);
 QSFundamental = build_ascstring ("Fundamental");
 QSscratch = build_ascstring ("*scratch*");
 #ifdef NEW_GC
 #define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magic_fun) \
 do									  \
 {									  \
 struct symbol_value_forward *I_hate_C =				  \
-alloc_lrecord_type (struct symbol_value_forward,			  \
+XSYMBOL_VALUE_FORWARD (ALLOC_NORMAL_LISP_OBJECT (symbol_value_forward));	  \
-			&lrecord_symbol_value_forward);			  \
+/*mcpro ((Lisp_Object) I_hate_C);*/					  \
-/*mcpro ((Lisp_Object) I_hate_C);*/					\
 									  \
 I_hate_C->magic.value = &(buffer_local_flags.field_name);		  \
 I_hate_C->magic.type = forward_type;					  \
 I_hate_C->magicfun = magic_fun;					  \
 									  \
 	  1, /* mark bit */						 \
 	  1, /* c_readonly bit */					 \
 	  1  /* lisp_readonly bit */					 \
 	},								 \
 	0, /* next */							 \
-	0, /* uid  */							 \
-	0  /* free */							 \
 },								 \
 &(buffer_local_flags.field_name),					 \
 forward_type							 \
 },									 \
 magicfun								 \
 	DEFVAR_BUFFER_DEFAULTS_MAGIC (lname, field_name, 0)
 static void
 nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap)
 {
-ZERO_LCRECORD (b);
+zero_nonsized_lisp_object (wrap_buffer (b));
 b->extent_info = Qnil;
 b->indirect_children = Qnil;
 b->own_text.line_number_cache = Qnil;
 static void
 common_init_complex_vars_of_buffer (void)
 {
 /* Make sure all markable slots in buffer_defaults
 are initialized reasonably, so mark_buffer won't choke. */
-struct buffer *defs = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer);
+Lisp_Object defobj = ALLOC_NORMAL_LISP_OBJECT (buffer);
-struct buffer *syms = ALLOC_LCRECORD_TYPE (struct buffer, &lrecord_buffer);
+struct buffer *defs = XBUFFER (defobj);
+Lisp_Object symobj = ALLOC_NORMAL_LISP_OBJECT (buffer);
+struct buffer *syms = XBUFFER (symobj);
 staticpro_nodump (&Vbuffer_defaults);
 staticpro_nodump (&Vbuffer_local_symbols);
-Vbuffer_defaults = wrap_buffer (defs);
+Vbuffer_defaults = defobj;
-Vbuffer_local_symbols = wrap_buffer (syms);
+Vbuffer_local_symbols = symobj;
 nuke_all_buffer_slots (syms, Qnil);
 nuke_all_buffer_slots (defs, Qnil);
 defs->text = &defs->own_text;
 syms->text = &syms->own_text;
 The local flag is a bit that is used in the buffer
 to say that it has its own local value for the slot.
 The local flag bits are in the local_var_flags slot of the
 buffer.  */
+set_lheader_implementation ((struct lrecord_header *)
+				&buffer_local_flags, &lrecord_buffer);
 nuke_all_buffer_slots (&buffer_local_flags, make_int (-2));
 buffer_local_flags.filename		   = always_local_no_default;
 buffer_local_flags.directory	   = always_local_no_default;
 buffer_local_flags.backed_up	   = always_local_no_default;
 buffer_local_flags.saved_size	   = always_local_no_default;
 buffer_local_flags.case_table	= resettable;
 buffer_local_flags.syntax_table	= resettable;
 #ifdef MULE
 buffer_local_flags.category_table	= resettable;
 #endif
+buffer_local_flags.display_time     = always_local_no_default;
+buffer_local_flags.display_count    = make_int (0);
 buffer_local_flags.modeline_format		  = make_int (1<<0);
 buffer_local_flags.abbrev_mode		  = make_int (1<<1);
 buffer_local_flags.overwrite_mode		  = make_int (1<<2);
 buffer_local_flags.case_fold_search		  = make_int (1<<3);
 List of formats to use when saving this buffer.
 Formats are defined by `format-alist'.  This variable is
 set when a file is visited.  Automatically local in all buffers.
 */ );
+DEFVAR_BUFFER_LOCAL ("buffer-display-count", display_count /*
+A number incremented each time this buffer is displayed in a window.
+The function `set-window-buffer' updates it.
+*/ );
+DEFVAR_BUFFER_LOCAL ("buffer-display-time", display_time /*
+Time stamp updated each time this buffer is displayed in a window.
+The function `set-window-buffer' updates this variable
+to the value obtained by calling `current-time'.
+If the buffer has never been shown in a window, the value is nil.
+*/);
 DEFVAR_BUFFER_LOCAL_MAGIC ("buffer-invisibility-spec", invisibility_spec /*
 Invisibility spec of this buffer.
 The default is t, which means that text is invisible
 if it has (or is covered by an extent with) a non-nil `invisible' property.
 If the value is a list, a text character is invisible if its `invisible'
 /* Check for DEFVAR_BUFFER_LOCAL without initializing the corresponding
 slot of buffer_local_flags and vice-versa.  Must be done after all
 DEFVAR_BUFFER_LOCAL() calls. */
 #define MARKED_SLOT(slot)					\
-if ((XINT (buffer_local_flags.slot) != -2 &&			\
+assert ((XINT (buffer_local_flags.slot) != -2 &&		\
-XINT (buffer_local_flags.slot) != -3)			\
+XINT (buffer_local_flags.slot) != -3)		\
-!= !(NILP (XBUFFER (Vbuffer_local_symbols)->slot)))	\
+	  == !(NILP (XBUFFER (Vbuffer_local_symbols)->slot)));
-ABORT ();
 #include "bufslots.h"
 {
 Lisp_Object scratch = Fget_buffer_create (QSscratch);
 Fset_buffer (scratch);

Mercurial > hg > xemacs-beta

comparison src/buffer.c @ 5495:1f0b15040456