xemacs-beta: src/window.c comparison

comparison src/window.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
 /* Window creation, deletion and examination for XEmacs.
 Copyright (C) 1985-1987, 1992-1995 Free Software Foundation, Inc.
 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
-Copyright (C) 1995, 1996, 2002 Ben Wing.
+Copyright (C) 1995, 1996, 2002, 2010 Ben Wing.
 Copyright (C) 1996 Chuck Thompson.
 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: FSF 19.30. */
 /* Beginning to diverge significantly. */
 /* Authorship:
 #include "elhash.h"
 #include "faces.h"
 #include "frame-impl.h"
 #include "glyphs.h"
 #include "gutter.h"
-#include "objects.h"
+#include "fontcolor.h"
 #include "redisplay.h"
 #include "window-impl.h"
 Lisp_Object Qwindowp, Qwindow_live_p;
 Lisp_Object Qdisplay_buffer;
 #ifdef MEMORY_USAGE_STATS
-Lisp_Object Qface_cache, Qglyph_cache, Qline_start_cache, Qother_redisplay;
+Lisp_Object Qface_cache, Qglyph_cache, Qline_start_cache, Qredisplay_structs;
 #ifdef HAVE_SCROLLBARS
 Lisp_Object Qscrollbar_instances;
 #endif
 #endif
 { XD_LISP_OBJECT, offsetof (face_cachel, background_pixmap) },
 { XD_END }
 };
 #ifdef NEW_GC
-DEFINE_LRECORD_IMPLEMENTATION ("face-cachel", face_cachel,
+DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("face-cachel", face_cachel,
-			       1, /*dumpable-flag*/
+				      0, face_cachel_description_1,
-0, 0, 0, 0, 0,
+				      Lisp_Face_Cachel);
-			       face_cachel_description_1,
-			       Lisp_Face_Cachel);
 #endif /* NEW_GC */
 static const struct sized_memory_description face_cachel_description = {
 sizeof (face_cachel),
 face_cachel_description_1
 #endif /* not NEW_GC */
 { XD_END }
 };
 #ifdef NEW_GC
-DEFINE_LRECORD_IMPLEMENTATION ("face-cachel-dynarr", face_cachel_dynarr,
+DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("face-cachel-dynarr", face_cachel_dynarr,
-			       1, /*dumpable-flag*/
+				      0, face_cachel_dynarr_description_1,
-0, 0, 0, 0, 0,
+				      face_cachel_dynarr);
-			       face_cachel_dynarr_description_1,
-			       face_cachel_dynarr);
 #else /* not NEW_GC */
 static const struct sized_memory_description face_cachel_dynarr_description = {
 sizeof (face_cachel_dynarr),
 face_cachel_dynarr_description_1
 };
 { XD_LISP_OBJECT, offsetof (glyph_cachel, glyph) },
 { XD_END }
 };
 #ifdef NEW_GC
-DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel", glyph_cachel,
+DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("glyph-cachel", glyph_cachel,
-			       1, /*dumpable-flag*/
+				      0, glyph_cachel_description_1,
-0, 0, 0, 0, 0,
+				      Lisp_Glyph_Cachel);
-			       glyph_cachel_description_1,
-			       Lisp_Glyph_Cachel);
 #endif /* NEW_GC */
 static const struct sized_memory_description glyph_cachel_description = {
 sizeof (glyph_cachel),
 glyph_cachel_description_1
 #endif /* not NEW_GC */
 { XD_END }
 };
 #ifdef NEW_GC
-DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel-dynarr", glyph_cachel_dynarr,
+DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("glyph-cachel-dynarr",
-			       1, /*dumpable-flag*/
+				      glyph_cachel_dynarr, 0,
-0, 0, 0, 0, 0,
+				      glyph_cachel_dynarr_description_1,
-			       glyph_cachel_dynarr_description_1,
+				      glyph_cachel_dynarr);
-			       glyph_cachel_dynarr);
 #else /* not NEW_GC */
 static const struct sized_memory_description glyph_cachel_dynarr_description = {
 sizeof (glyph_cachel_dynarr),
 glyph_cachel_dynarr_description_1
 };
 	      int UNUSED (escapeflag))
 {
 Lisp_Object buf;
 if (print_readably)
-printing_unreadable_lcrecord (obj, 0);
+printing_unreadable_lisp_object (obj, 0);
 write_ascstring (printcharfun, "#<window");
 buf = XWINDOW_BUFFER (obj);
 if (EQ (buf, Qt))
 write_ascstring (printcharfun, " during creation");
 {
 Lisp_Object name = XBUFFER (buf)->name;
 write_fmt_string_lisp (printcharfun, " on %S", 1, name);
 }
-write_fmt_string (printcharfun, " 0x%x>", XWINDOW (obj)->header.uid);
+write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
 }
 static void
-finalize_window (void *header, int UNUSED (for_disksave))
+finalize_window (Lisp_Object obj)
 {
-struct window *w = (struct window *) header;
+struct window *w = XWINDOW (obj);
 if (w->line_start_cache)
 {
 Dynarr_free (w->line_start_cache);
 w->line_start_cache = 0;
 remain around as long as the buffers do. */
 static Lisp_Object
 make_saved_buffer_point_cache (void)
 {
-return make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);
+return make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, Qeq);
 }
-DEFINE_LRECORD_IMPLEMENTATION ("window", window,
+DEFINE_NODUMP_LISP_OBJECT ("window", window,
-			       0, /*dumpable-flag*/
+			   mark_window, print_window, finalize_window,
-mark_window, print_window, finalize_window,
+			   0, 0, window_description, struct window);
-			       0, 0, window_description, struct window);
 #define INIT_DISP_VARIABLE(field, initialization)	\
 p->field[CURRENT_DISP] = initialization;		\
 p->field[DESIRED_DISP] = initialization;		\
 p->field[CMOTION_DISP] = initialization;
 here because the window must have its frame pointer set or
 reset_face_cachels will fail. */
 Lisp_Object
 allocate_window (void)
 {
-struct window *p = ALLOC_LCRECORD_TYPE (struct window, &lrecord_window);
+Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (window);
-Lisp_Object val = wrap_window (p);
+struct window *p = XWINDOW (obj);
 #define WINDOW_SLOT(slot) p->slot = Qnil;
 #include "winslots.h"
 INIT_DISP_VARIABLE (start, Fmake_marker ());
 p->line_cache_last_updated = Qzero;
 p->windows_changed = 1;
 p->shadow_thickness_changed = 1;
-return val;
+return obj;
 }
 #undef INIT_DISP_VARIABLE
 /************************************************************************/
 /*                        Window mirror structure                       */
 return wrap_window_mirror (mir->next);
 else
 return Qnil;
 }
-DEFINE_LRECORD_IMPLEMENTATION ("window-mirror", window_mirror,
+DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("window-mirror", window_mirror,
-			       0, /*dumpable-flag*/
+				    mark_window_mirror,
-mark_window_mirror, internal_object_printer,
+				    window_mirror_description,
-			       0, 0, 0, window_mirror_description,
+				    struct window_mirror);
-			       struct window_mirror);
 /* Create a new window mirror structure and associated redisplay
 structs. */
 static struct window_mirror *
 new_window_mirror (struct frame *f)
 {
-struct window_mirror *t =
+Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (window_mirror);
-ALLOC_LCRECORD_TYPE (struct window_mirror, &lrecord_window_mirror);
+struct window_mirror *t = XWINDOW_MIRROR (obj);
 t->frame = f;
 t->current_display_lines = Dynarr_new (display_line);
 t->desired_display_lines = Dynarr_new (display_line);
 redisplay structures. */
 static struct window_mirror *
 find_window_mirror_internal (Lisp_Object win, struct window_mirror *rmir,
 			    struct window *w)
 {
-for (; !NILP (win); win = XWINDOW (win)->next, rmir = rmir->next)
+for (; !NILP (win) && rmir; win = XWINDOW (win)->next, rmir = rmir->next)
 {
 if (w == XWINDOW (win))
 	return rmir;
 if (!NILP (XWINDOW (win)->vchild))
 #ifdef HAVE_SCROLLBARS
 release_window_mirror_scrollbars (mir);
 #endif
 free_display_structs (mir);
 mir = mir->next;
-/* not worth calling free_managed_lcrecord() -- window mirrors
+/* not worth calling free_normal_lisp_object() -- window mirrors
 	 are not created that frequently and it's dangerous.  we don't
 	 know for sure that there aren't other pointers around -- e.g.
 	 in a scrollbar instance. */
 }
 }
 real_window (struct window_mirror *mir, int no_abort)
 {
 Lisp_Object retval =
 real_window_internal (mir->frame->root_window,
 			  XWINDOW_MIRROR (mir->frame->root_mirror), mir);
-if (NILP (retval) && !no_abort)
+assert (!NILP (retval) || no_abort);
-ABORT ();
 return retval;
 }
 /* Given a real window, return its mirror structure.  Calls
 find_window_mirror (struct window *w)
 {
 struct frame *f = XFRAME (w->frame);
 if (f->mirror_dirty)
 update_frame_window_mirror (f);
+return find_window_mirror_internal (f->root_window,
+				      XWINDOW_MIRROR (f->root_mirror), w);
+}
+/* Given a real window, return its mirror structure, if it exists.
+Don't do any updating. */
+static struct window_mirror *
+find_window_mirror_maybe (struct window *w)
+{
+struct frame *f = XFRAME (w->frame);
+if (!WINDOW_MIRRORP (f->root_mirror))
+return 0;
 return find_window_mirror_internal (f->root_window,
 				      XWINDOW_MIRROR (f->root_mirror), w);
 }
 /*****************************************************************************
 display_line_dynarr *
 window_display_lines (struct window *w, int which)
 {
 struct window_mirror *t;
-if (XFRAME (w->frame)->mirror_dirty)
-update_frame_window_mirror (XFRAME (w->frame));
 t = find_window_mirror (w);
-if (!t)
+assert (t);
-ABORT ();
 if (which == CURRENT_DISP)
 return t->current_display_lines;
 else if (which == DESIRED_DISP)
 return t->desired_display_lines;
 struct buffer *
 window_display_buffer (struct window *w)
 {
 struct window_mirror *t;
-if (XFRAME (w->frame)->mirror_dirty)
-update_frame_window_mirror (XFRAME (w->frame));
 t = find_window_mirror (w);
-if (!t)
+assert (t);
-ABORT ();
 return t->buffer;
 }
 void
 set_window_display_buffer (struct window *w, struct buffer *b)
 {
 struct window_mirror *t;
-if (XFRAME (w->frame)->mirror_dirty)
-update_frame_window_mirror (XFRAME (w->frame));
 t = find_window_mirror (w);
-if (!t)
+assert (t);
-ABORT ();
 t->buffer = b;
 }
 window = wrap_window (w);
 margin_cwidth = (left_margin ? XINT (w->left_margin_width) :
 		   XINT (w->right_margin_width));
-default_face_height_and_width (window, 0, &font_width);
+default_face_width_and_height (window, &font_width, 0);
 /* The left margin takes precedence over the right margin so we
 subtract its width from the space available for the right
 margin. */
 if (!left_margin)
 start  = marker_position (w->start[CURRENT_DISP]);
 hlimit = WINDOW_TEXT_HEIGHT (w);
 eobuf  = BUF_ZV (XBUFFER (w->buffer));
-default_face_height_and_width (window, &defheight, NULL);
+default_face_width_and_height (window, NULL, &defheight);
 /* guess lines needed in line start cache + a few extra */
 needed = (hlimit + defheight-1) / defheight + 3;
 while (1) {
 (window))
 {
 struct window *w = decode_window (window);
 struct frame *f = XFRAME (w->frame);
-int left =
+int left = w->pixel_left - FRAME_PANED_LEFT_EDGE (f);
-w->pixel_left - FRAME_LEFT_BORDER_END (f) - FRAME_LEFT_GUTTER_BOUNDS (f);
+int top = w->pixel_top - FRAME_PANED_TOP_EDGE (f);
-int top =
-w->pixel_top - FRAME_TOP_BORDER_END (f) - FRAME_TOP_GUTTER_BOUNDS (f);
 return list4 (make_int (left),
 		make_int (top),
 		make_int (left + w->pixel_width),
 		make_int (top + w->pixel_height));
 unshow_buffer (struct window *w)
 {
 Lisp_Object buf = w->buffer;
 struct buffer *b = XBUFFER (buf);
-if (b != XMARKER (w->pointm[CURRENT_DISP])->buffer)
+assert (b == XMARKER (w->pointm[CURRENT_DISP])->buffer);
-ABORT ();
 /* FSF disables this check, so I'll do it too.  I hope it won't
 break things.  --ben */
 #if 0
 if (w == XWINDOW (Fselected_window (Qnil))
 window_unmap_subwindows (w);
 /* Free the extra data structures attached to windows immediately so
 they don't sit around consuming excess space.  They will be
 reinitialized by the window-configuration code as necessary. */
-finalize_window ((void *) w, 0);
+finalize_window (wrap_window (w));
 /* Nobody should be accessing anything in this object any more,
 and making them Qnil allows for better GC'ing in case a pointer
 to the dead window continues to hang around.  Zero all other
 structs in case someone tries to access something through them.
 /* If none of them, then all windows, dedicated or not. */
 w = window_loop (GET_LRU_WINDOW, Qnil, 0, which_frames, 1, which_devices);
 /* At this point we damn well better have found something. */
-if (NILP (w)) ABORT ();
+assert (!NILP (w));
 #endif
 return w;
 }
 	  : 2 * MIN_SAFE_WINDOW_HEIGHT - 1);
 }
 /* Return non-zero if both frame sizes are less than or equal to
 minimal allowed values. ROWS and COLS are in characters */
-int
+static int
-frame_size_valid_p (struct frame *frame, int rows, int cols)
+frame_size_valid_p (struct frame *frame, int cols, int rows)
 {
 return (rows >= frame_min_height (frame)
 	  && cols >= MIN_SAFE_WINDOW_WIDTH);
 }
 minimal allowed values. WIDTH and HEIGHT are in pixels */
 int
 frame_pixsize_valid_p (struct frame *frame, int width, int height)
 {
 int rows, cols;
-pixel_to_real_char_size (frame, width, height, &cols, &rows);
+pixel_to_char_size (frame, width, height, &cols, &rows);
-return frame_size_valid_p (frame, rows, cols);
+return frame_size_valid_p (frame, cols, rows);
 }
 /* If *ROWS or *COLS are too small a size for FRAME, set them to the
 minimum allowable size.  */
 void
-check_frame_size (struct frame *frame, int *rows, int *cols)
+check_frame_size (struct frame *frame, int *cols, int *rows)
 {
 int min_height = frame_min_height (frame);
+int min_pixwidth, min_pixheight;
-if (*rows < min_height)
+int min_geomwidth, min_geomheight;
-*rows = min_height;
-if (*cols  < MIN_SAFE_WINDOW_WIDTH)
+/* There is no char_to_frame_unit_size().  This can be done with
-*cols = MIN_SAFE_WINDOW_WIDTH;
+frame_conversion_internal(), but that's currently static, and we can
+do it fine with two steps, as follows. */
+char_to_pixel_size (frame, MIN_SAFE_WINDOW_WIDTH, min_height,
+		      &min_pixwidth, &min_pixheight);
+pixel_to_frame_unit_size (frame, min_pixwidth, min_pixheight,
+			   &min_geomwidth, &min_geomheight);
+if (*rows < min_geomheight)
+*rows = min_geomheight;
+if (*cols  < min_geomwidth)
+*cols = min_geomwidth;
 }
 /* Normally the window is deleted if it gets too small.
 nodelete nonzero means do not do this.
 (The caller should check later and do so if appropriate)  */
 Lisp_Object child, minor_kid, major_kid;
 int minsize;
 int line_size;
 int defheight, defwidth;
-default_face_height_and_width (window, &defheight, &defwidth);
+default_face_width_and_height (window, &defwidth, &defheight);
 line_size = (set_height ? defheight : defwidth);
 check_min_window_sizes ();
 minsize = (set_height ? window_min_height : window_min_width);
 if (NILP (norecord))
 	Frecord_buffer (buffer);
 Fset_buffer (buffer);
 }
+if (NILP (XBUFFER (buffer)->display_count))
+XBUFFER (buffer)->display_count = make_int (1);
+else
+XBUFFER (buffer)->display_count = make_int (1 + XINT (XBUFFER (buffer)->display_count));
+XBUFFER (buffer)->display_time = Fcurrent_time();
 return Qnil;
 }
 DEFUN ("select-window", Fselect_window, 1, 2, 0, /*
 Select WINDOW.  Most editing will apply to WINDOW's buffer.
 }
 static void
 make_dummy_parent (Lisp_Object window)
 {
-Lisp_Object new_;
 struct window *o = XWINDOW (window);
-struct window *p = ALLOC_LCRECORD_TYPE (struct window, &lrecord_window);
+Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (window);
+struct window *p = XWINDOW (obj);
-new_ = wrap_window (p);
-COPY_LCRECORD (p, o);
+copy_lisp_object (obj, window);
 /* Don't copy the pointers to the line start cache or the face
 instances. */
 p->line_start_cache = Dynarr_new (line_start_cache);
 #ifdef NEW_GC
 #endif /* not NEW_GC */
 p->subwindow_instance_cache =
 make_image_instance_cache_hash_table ();
 /* Put new into window structure in place of window */
-replace_window (window, new_);
+replace_window (window, obj);
 o->next = Qnil;
 o->prev = Qnil;
 o->vchild = Qnil;
 o->hchild = Qnil;
-o->parent = new_;
+o->parent = obj;
 p->start[CURRENT_DISP] = Qnil;
 p->start[DESIRED_DISP] = Qnil;
 p->start[CMOTION_DISP] = Qnil;
 p->pointm[CURRENT_DISP] = Qnil;
 avail_height = (pixel_height -
 		  (include_gutters_p ? 0 :
 		   window_top_window_gutter_height (w) +
 		   window_bottom_window_gutter_height (w)));
-default_face_height_and_width (window, &defheight, &defwidth);
+default_face_width_and_height (window, &defwidth, &defheight);
 if (defheight)
 char_height = avail_height / defheight;
 /* It's the calling function's responsibility to check these values
 int pixel_height;
 Lisp_Object window = wrap_window (w);
-default_face_height_and_width (window, &defheight, &defwidth);
+default_face_width_and_height (window, &defwidth, &defheight);
 avail_height = char_height * defheight;
 pixel_height = (avail_height +
 		  (include_gutters_p ? 0 :
 		   window_top_window_gutter_height (w) +
 		return num_lines - 1;
 	      ypos1 = dl->ypos + dl->descent - dl->clip;
 	    }
 	}
-default_face_height_and_width (window, &defheight, &defwidth);
+default_face_width_and_height (window, &defwidth, &defheight);
 /* #### This probably needs to know about the clipping area once a
 final definition is decided on. */
 if (defheight)
 num_lines += ((ypos2 - ypos1) / defheight);
 }
 		 window_left_gutter_width (w, 0) -
 		 window_right_gutter_width (w, 0) -
 		 (include_margins_p ? 0 : window_left_margin_width (w)) -
 		 (include_margins_p ? 0 : window_right_margin_width (w)));
-default_face_height_and_width (window, &defheight, &defwidth);
+default_face_width_and_height (window, &defwidth, &defheight);
 if (defwidth)
 char_width = (avail_width / defwidth);
 /* It's the calling function's responsibility to check these values
 int pixel_width;
 int defheight, defwidth;
 Lisp_Object window = wrap_window (w);
-default_face_height_and_width (window, &defheight, &defwidth);
+default_face_width_and_height (window, &defwidth, &defheight);
 avail_width = char_width * defwidth;
 pixel_width = (avail_width +
 		 window_left_window_gutter_width (w, 0) +
 		 window_right_window_gutter_width (w, 0) +
 window = wrap_window (win);
 f = XFRAME (win->frame);
 if (EQ (window, FRAME_ROOT_WINDOW (f)))
 invalid_operation ("Won't change only window", Qunbound);
-default_face_height_and_width (window, &defheight, &defwidth);
+default_face_width_and_height (window, &defwidth, &defheight);
 while (1)
 {
 w = XWINDOW (window);
 parent = w->parent;
 dla = window_display_lines (w, CURRENT_DISP);
 if (INTP (Vwindow_pixel_scroll_increment))
 fheight = XINT (Vwindow_pixel_scroll_increment);
 else if (!NILP (Vwindow_pixel_scroll_increment))
-default_face_height_and_width (window, &fheight, &fwidth);
+default_face_width_and_height (window, &fwidth, &fheight);
 if (Dynarr_length (dla) >= 1)
 modeline = Dynarr_begin (dla)->modeline;
 dl = Dynarr_atp (dla, modeline);
 MARK_WINDOWS_CHANGED (w);
 }
 #ifdef MEMORY_USAGE_STATS
+struct window_mirror_stats
+{
+struct usage_stats u;
+/* Ancillary non-lisp */
+Bytecount redisplay_structs;
+#ifdef HAVE_SCROLLBARS
+/* Ancillary Lisp */
+Bytecount scrollbar;
+#endif
+};
 struct window_stats
 {
-int face;
+struct usage_stats u;
-int glyph;
+/* Ancillary non-Lisp */
+Bytecount line_start;
+/* The next two: ancillary non-Lisp under old-GC, ancillary Lisp under
+NEW_GC */
+Bytecount face;
+Bytecount glyph;
+/* The next two are copied out of the window mirror, which is an ancillary
+Lisp structure; the first is non-Lisp, the second Lisp, but from our
+perspective, they are both counted as Lisp */
+Bytecount redisplay_structs;
 #ifdef HAVE_SCROLLBARS
-int scrollbar;
+Bytecount scrollbar;
 #endif
-int line_start;
+/* Remaining memory associated with window mirror (ancillary Lisp) */
-int other_redisplay;
+Bytecount window_mirror;
-int other;
 };
 static void
 compute_window_mirror_usage (struct window_mirror *mir,
-			     struct window_stats *stats,
+			     struct window_mirror_stats *stats)
-			     struct overhead_stats *ovstats)
+{
-{
+stats->redisplay_structs =
-if (!mir)
+compute_display_line_dynarr_usage (mir->current_display_lines, &stats->u)
-return;
++
-stats->other += LISPOBJ_STORAGE_SIZE (mir, sizeof (*mir), ovstats);
+compute_display_line_dynarr_usage (mir->desired_display_lines, &stats->u);
 #ifdef HAVE_SCROLLBARS
-{
+stats->scrollbar =
-struct device *d = XDEVICE (FRAME_DEVICE (mir->frame));
+compute_all_scrollbar_instance_usage (mir->scrollbar_vertical_instance) +
+compute_all_scrollbar_instance_usage (mir->scrollbar_horizontal_instance);
-stats->scrollbar +=
-compute_scrollbar_instance_usage (d, mir->scrollbar_vertical_instance,
-					ovstats);
-stats->scrollbar +=
-compute_scrollbar_instance_usage (d, mir->scrollbar_horizontal_instance,
-					ovstats);
-}
 #endif /* HAVE_SCROLLBARS */
-stats->other_redisplay +=
+}
-compute_display_line_dynarr_usage (mir->current_display_lines, ovstats);
-stats->other_redisplay +=
-compute_display_line_dynarr_usage (mir->desired_display_lines, ovstats);
+static void
+window_mirror_memory_usage (Lisp_Object window_mirror,
+			    struct generic_usage_stats *gustats)
+{
+struct window_mirror_stats *stats = (struct window_mirror_stats *) gustats;
+compute_window_mirror_usage (XWINDOW_MIRROR (window_mirror), stats);
 }
 static void
 compute_window_usage (struct window *w, struct window_stats *stats,
-		      struct overhead_stats *ovstats)
+		      struct usage_stats *ustats)
 {
-xzero (*stats);
+stats->line_start =
-stats->other += LISPOBJ_STORAGE_SIZE (w, sizeof (*w), ovstats);
+compute_line_start_cache_dynarr_usage (w->line_start_cache, ustats);
-stats->face += compute_face_cachel_usage (w->face_cachels, ovstats);
+stats->face = compute_face_cachel_usage (w->face_cachels,
-stats->glyph += compute_glyph_cachel_usage (w->glyph_cachels, ovstats);
+					   ustats);
-stats->line_start +=
+stats->glyph = compute_glyph_cachel_usage (w->glyph_cachels,
-compute_line_start_cache_dynarr_usage (w->line_start_cache, ovstats);
+					     ustats);
-compute_window_mirror_usage (find_window_mirror (w), stats, ovstats);
+{
-}
+struct window_mirror *wm;
-DEFUN ("window-memory-usage", Fwindow_memory_usage, 1, 1, 0, /*
+wm = find_window_mirror_maybe (w);
-Return stats about the memory usage of window WINDOW.
+if (wm)
-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
+	struct generic_usage_stats gustats;
-by the window (separate from the memory logically associated with a
+	struct window_mirror_stats *wmstats;
-buffer or frame), including internal structures and any malloc()
+	Bytecount total;
-overhead associated with them.  In practice, the byte counts are
+	total = lisp_object_memory_usage_full (wrap_window_mirror (wm),
-underestimated because certain memory usage is very hard to determine
+					       NULL, NULL, NULL, &gustats);
-\(e.g. the amount of memory used inside the Xt library or inside the
+	wmstats = (struct window_mirror_stats *) &gustats;
-X server) and because there is other stuff that might logically
+	stats->redisplay_structs = wmstats->redisplay_structs;
-be associated with a window, buffer, or frame (e.g. window configurations,
+	total -= stats->redisplay_structs;
-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.
-*/
-(window))
-{
-struct window_stats stats;
-struct overhead_stats ovstats;
-Lisp_Object val = Qnil;
-CHECK_WINDOW (window); /* dead windows should be allowed, no? */
-xzero (ovstats);
-compute_window_usage (XWINDOW (window), &stats, &ovstats);
-val = acons (Qface_cache,          make_int (stats.face),              val);
-val = acons (Qglyph_cache,         make_int (stats.glyph),             val);
 #ifdef HAVE_SCROLLBARS
-val = acons (Qscrollbar_instances, make_int (stats.scrollbar),         val);
+	stats->scrollbar = wmstats->scrollbar;
+	total -= stats->scrollbar;
 #endif
-val = acons (Qline_start_cache,    make_int (stats.line_start),        val);
+	stats->window_mirror = total;
-val = acons (Qother_redisplay,     make_int (stats.other_redisplay),   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);
+static void
-val = acons (Qdynarr_overhead,     make_int (ovstats.dynarr_overhead), val);
+window_memory_usage (Lisp_Object window, struct generic_usage_stats *gustats)
+{
-return Fnreverse (val);
+struct window_stats *stats = (struct window_stats *) gustats;
+compute_window_usage (XWINDOW (window), stats, &stats->u);
 }
 #endif /* MEMORY_USAGE_STATS */
 /* Mark all subwindows of a window as deleted.  The argument
 W is actually the subwindow tree of the window in question. */
 void
 {
 Lisp_Object buffer = XWINDOW (window)->buffer;
 if (!NILP (buffer) && BUFFERP (buffer))
 stderr_out (" on %s", XSTRING_DATA (XBUFFER (buffer)->name));
 }
-stderr_out (" 0x%x>", XWINDOW (window)->header.uid);
+stderr_out (" 0x%x>", LISP_OBJECT_UID (window));
 while (!NILP (child))
 {
 debug_print_window (child, level + 1);
 child = Fwindow_next_child (child);
 /************************************************************************/
 /*                            initialization                            */
 /************************************************************************/
 void
+window_objects_create (void)
+{
+#ifdef MEMORY_USAGE_STATS
+OBJECT_HAS_METHOD (window, memory_usage);
+OBJECT_HAS_METHOD (window_mirror, memory_usage);
+#endif
+}
+void
 syms_of_window (void)
 {
-INIT_LRECORD_IMPLEMENTATION (window);
+INIT_LISP_OBJECT (window);
-INIT_LRECORD_IMPLEMENTATION (window_mirror);
+INIT_LISP_OBJECT (window_mirror);
 #ifdef NEW_GC
-INIT_LRECORD_IMPLEMENTATION (face_cachel);
+INIT_LISP_OBJECT (face_cachel);
-INIT_LRECORD_IMPLEMENTATION (face_cachel_dynarr);
+INIT_LISP_OBJECT (face_cachel_dynarr);
-INIT_LRECORD_IMPLEMENTATION (glyph_cachel);
+INIT_LISP_OBJECT (glyph_cachel);
-INIT_LRECORD_IMPLEMENTATION (glyph_cachel_dynarr);
+INIT_LISP_OBJECT (glyph_cachel_dynarr);
 #endif /* NEW_GC */
 DEFSYMBOL (Qwindowp);
 DEFSYMBOL (Qwindow_live_p);
 DEFSYMBOL (Qdisplay_buffer);
 DEFSYMBOL (Qglyph_cache);
 DEFSYMBOL (Qline_start_cache);
 #ifdef HAVE_SCROLLBARS
 DEFSYMBOL (Qscrollbar_instances);
 #endif
-DEFSYMBOL (Qother_redisplay);
+DEFSYMBOL (Qredisplay_structs);
-/* Qother in general.c */
 #endif
 DEFSYMBOL (Qtruncate_partial_width_windows);
 DEFSYMBOL (Qcurrent_window_configuration);
 DEFSYMBOL (Qset_window_configuration);
 DEFSUBR (Fscroll_right);
 DEFSUBR (Fother_window_for_scrolling);
 DEFSUBR (Fscroll_other_window);
 DEFSUBR (Fcenter_to_window_line);
 DEFSUBR (Fmove_to_window_line);
-#ifdef MEMORY_USAGE_STATS
-DEFSUBR (Fwindow_memory_usage);
-#endif
 DEFSUBR (Fcurrent_pixel_column);
 DEFSUBR (Fcurrent_pixel_row);
 }
 void
 }
 void
 vars_of_window (void)
 {
+#ifdef MEMORY_USAGE_STATS
+Lisp_Object l;
+l = listu (Qline_start_cache,
+#ifdef NEW_GC
+	     Qt,
+#endif
+	     Qface_cache, Qglyph_cache,
+#ifndef NEW_GC
+	     Qt,
+#endif
+	     Qredisplay_structs,
+#ifdef HAVE_SCROLLBARS
+	     Qscrollbar_instances,
+#endif
+	     intern ("window-mirror"),
+	     Qunbound);
+OBJECT_HAS_PROPERTY (window, memusage_stats_list, l);
+l = listu (Qredisplay_structs,
+#ifdef HAVE_SCROLLBARS
+	     Qt, Qscrollbar_instances,
+#endif
+	     Qunbound);
+OBJECT_HAS_PROPERTY (window_mirror, memusage_stats_list, l);
+#endif /* MEMORY_USAGE_STATS */
 DEFVAR_BOOL ("scroll-on-clipped-lines", &scroll_on_clipped_lines /*
 *Non-nil means to scroll if point lands on a line which is clipped.
 */ );
 scroll_on_clipped_lines = 1;

Mercurial > hg > xemacs-beta

comparison src/window.c @ 5495:1f0b15040456