xemacs-beta: src/frame.c comparison

comparison src/frame.c @ 272:c5d627a313b1 r21-0b34

Import from CVS: tag r21-0b34

author	cvs
date	Mon, 13 Aug 2007 10:28:48 +0200
parents	b2472a1930f2
children	7df0dd720c89

comparison

equal deleted inserted replaced

-:c7b7086b0a39
+:c5d627a313b1
 Lisp_Object Vframe_being_created;
 Lisp_Object Qframe_being_created;
 static void store_minibuf_frame_prop (struct frame *f, Lisp_Object val);
-MAC_DEFINE (struct frame *, MTframe_data)
+EXFUN (Fset_frame_properties, 2);
-static Lisp_Object mark_frame (Lisp_Object, void (*) (Lisp_Object));
-static void print_frame (Lisp_Object, Lisp_Object, int);
-DEFINE_LRECORD_IMPLEMENTATION ("frame", frame,
-mark_frame, print_frame, 0, 0, 0,
-			       struct frame);
 static Lisp_Object
 mark_frame (Lisp_Object obj, void (*markobj) (Lisp_Object))
 {
 struct frame *f = XFRAME (obj);
 print_internal (frm->name, printcharfun, 1);
 sprintf (buf, " 0x%x>", frm->header.uid);
 write_c_string (buf, printcharfun);
 }
+DEFINE_LRECORD_IMPLEMENTATION ("frame", frame,
+mark_frame, print_frame, 0, 0, 0,
+			       struct frame);
 static void
 nuke_all_frame_slots (struct frame *f)
 {
 #define MARKED_SLOT(x)	f->x = Qnil;
 static struct frame *
 allocate_frame_core (Lisp_Object device)
 {
 /* This function can GC */
-Lisp_Object frame = Qnil;
+Lisp_Object frame;
 Lisp_Object root_window;
 struct frame *f = alloc_lcrecord_type (struct frame, lrecord_frame);
 zero_lcrecord (f);
 nuke_all_frame_slots (f);
 return foolist;
 }
 DEFUN ("make-frame", Fmake_frame, 0, 2, "", /*
-Create a new frame, displaying the current buffer.
+Create and return a new frame, displaying the current buffer.
 Runs the functions listed in `create-frame-hook' after frame creation.
 Optional argument PROPS is a property list (a list of alternating
 keyword-value specifications) of properties for the new frame.
 \(An alist is accepted for backward compatibility but should not
 }
 Lisp_Object
 make_frame (struct frame *f)
 {
-Lisp_Object frame = Qnil;
+Lisp_Object frame;
 XSETFRAME (frame, f);
 return frame;
 }
 Return the root-window of FRAME.
 If omitted, FRAME defaults to the currently selected frame.
 */
 (frame))
 {
-return FRAME_ROOT_WINDOW (decode_frame (frame));
+struct frame *f = decode_frame (frame);
+return FRAME_ROOT_WINDOW (f);
 }
 DEFUN ("frame-selected-window", Fframe_selected_window, 0, 1, 0, /*
 Return the selected window of frame object FRAME.
 If omitted, FRAME defaults to the currently selected frame.
 */
 (frame))
 {
-return FRAME_SELECTED_WINDOW (decode_frame (frame));
+struct frame *f = decode_frame (frame);
+return FRAME_SELECTED_WINDOW (f);
 }
 void
 set_frame_selected_window (struct frame *f, Lisp_Object window)
 {
 return Qnil;
 }
-extern void free_window_mirror (struct window_mirror *mir);
+/* extern void free_line_insertion_deletion_costs (struct frame *f); */
-extern void free_line_insertion_deletion_costs (struct frame *f);
 /* Return 1 if it is ok to delete frame F;
 0 if all frames aside from F are invisible.
 (Exception: if F is a stream frame, it's OK to delete if
 any other frames exist.) */
 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
 {
 	Lisp_Object this = XCAR (frmcons);
-	if (! EQ (this, frame)
+	if (! EQ (this, frame))
-	    && EQ (frame, DEVMETH_OR_GIVEN(XDEVICE(XCAR(devcons)),
-					   get_frame_parent,
-					   (XFRAME(this)),
-					   Qnil)))
 	  {
-	    /* We've found a popup frame whose parent is this frame. */
+	    struct device *devcons_d = XDEVICE (XCAR (devcons));
-	    signal_simple_error
+	    if (EQ (frame, DEVMETH_OR_GIVEN (devcons_d, get_frame_parent,
-	      ("Attempt to delete a frame with live popups", frame);
+					     (XFRAME (this)),
+					     Qnil)))
+	      /* We've found a popup frame whose parent is this frame. */
+	      signal_simple_error
+		("Attempt to delete a frame with live popups", frame);
 	  }
 }
 }
 /* Before here, we haven't made any dangerous changes (just checked for
 }
 /* Return mouse position in character cell units.  */
+static int
+mouse_pixel_position_1 (struct device *d, Lisp_Object *frame,
+			int *x, int *y)
+{
+switch (DEVMETH_OR_GIVEN (d, get_mouse_position, (d, frame, x, y), -1))
+{
+case 1:
+return 1;
+case 0:
+*frame = Qnil;
+break;
+case -1:
+*frame = DEVICE_SELECTED_FRAME (d);
+break;
+default:
+abort (); /* method is incorrectly written */
+}
+return 0;
+}
+DEFUN ("mouse-pixel-position", Fmouse_pixel_position, 0, 1, 0, /*
+Return a list (WINDOW X . Y) giving the current mouse window and position.
+The position is given in pixel units, where (0, 0) is the
+upper-left corner.
+DEVICE specifies the device on which to read the mouse position, and
+defaults to the selected device.  If the device is a mouseless terminal
+or Emacs hasn't been programmed to read its mouse position, it returns
+the device's selected window for WINDOW and nil for X and Y.
+*/
+(device))
+{
+struct device *d = decode_device (device);
+Lisp_Object frame;
+Lisp_Object window;
+Lisp_Object x = Qnil;
+Lisp_Object y = Qnil;
+int intx, inty;
+if (mouse_pixel_position_1 (d, &frame, &intx, &inty))
+{
+struct window *w =
+	find_window_by_pixel_pos (intx, inty, XFRAME (frame)->root_window);
+if (!w)
+	window = Qnil;
+else
+	{
+	  XSETWINDOW (window, w);
+	  /* Adjust the position to be relative to the window. */
+	  intx -= w->pixel_left;
+	  inty -= w->pixel_top;
+	  XSETINT (x, intx);
+	  XSETINT (y, inty);
+	}
+}
+else
+{
+if (FRAMEP (frame))
+	window = FRAME_SELECTED_WINDOW (XFRAME (frame));
+else
+	window = Qnil;
+}
+return Fcons (window, Fcons (x, y));
+}
 DEFUN ("mouse-position", Fmouse_position, 0, 1, 0, /*
 Return a list (WINDOW X . Y) giving the current mouse window and position.
 The position is given in character cells, where (0, 0) is the
 upper-left corner of the window.
 }
 return val;
 }
-static int
-mouse_pixel_position_1 (struct device *d, Lisp_Object *frame,
-			int *x, int *y)
-{
-switch (DEVMETH_OR_GIVEN (d, get_mouse_position, (d, frame, x, y), -1))
-{
-case 1:
-return 1;
-case 0:
-*frame = Qnil;
-break;
-case -1:
-*frame = DEVICE_SELECTED_FRAME (d);
-break;
-default:
-abort (); /* method is incorrectly written */
-}
-return 0;
-}
-DEFUN ("mouse-pixel-position", Fmouse_pixel_position, 0, 1, 0, /*
-Return a list (WINDOW X . Y) giving the current mouse window and position.
-The position is given in pixel units, where (0, 0) is the
-upper-left corner.
-DEVICE specifies the device on which to read the mouse position, and
-defaults to the selected device.  If the device is a mouseless terminal
-or Emacs hasn't been programmed to read its mouse position, it returns
-the device's selected window for WINDOW and nil for X and Y.
-*/
-(device))
-{
-struct device *d = decode_device (device);
-Lisp_Object frame;
-Lisp_Object window;
-Lisp_Object x, y;
-int intx, inty;
-x = y = Qnil;
-if (mouse_pixel_position_1 (d, &frame, &intx, &inty))
-{
-struct window *w =
-	find_window_by_pixel_pos (intx, inty, XFRAME (frame)->root_window);
-if (!w)
-	window = Qnil;
-else
-	{
-	  XSETWINDOW (window, w);
-	  /* Adjust the position to be relative to the window. */
-	  intx -= w->pixel_left;
-	  inty -= w->pixel_top;
-	  XSETINT (x, intx);
-	  XSETINT (y, inty);
-	}
-}
-else
-{
-if (FRAMEP (frame))
-	window = FRAME_SELECTED_WINDOW (XFRAME (frame));
-else
-	window = Qnil;
-}
-return Fcons (window, Fcons (x, y));
-}
 DEFUN ("mouse-position-as-motion-event", Fmouse_position_as_motion_event, 0, 1, 0, /*
 Return the current mouse position as a motion event.
 This allows you to call the standard event functions such as
 `event-over-toolbar-p' to determine where the mouse is.
 DEVICE specifies the device on which to read the mouse position, and
 defaults to the selected device.  If the mouse position can't be determined
-(e.g. DEVICE is a TTY device), nil is returned instead of an event.
+\(e.g. DEVICE is a TTY device), nil is returned instead of an event.
 */
 (device))
 {
 struct device *d = decode_device (device);
 Lisp_Object frame;
 int visible = FRAMEMETH_OR_GIVEN (f, frame_visible_p, (f), f->visible);
 return visible ? ( visible > 0 ? Qt : Qhidden ) : Qnil;
 }
 DEFUN ("frame-totally-visible-p", Fframe_totally_visible_p, 0, 1, 0, /*
-Return T if frame is not obscured by any other X windows, NIL otherwise.
+Return t if frame is not obscured by any other window system windows.
 Always returns t for tty frames.
 */
 (frame))
 {
 struct frame *f = decode_frame (frame);
 Frame properties can be retrieved using `frame-property' or `frame-properties'.
 The following symbols etc. have predefined meanings:
-name		Name of the frame, used with X resources.
+name		Name of the frame.  Used with X resources.
 		Unchangeable after creation.
 height		Height of the frame, in lines.
 width		Width of the frame, in characters.
 See `set-frame-properties' for the built-in property names.
 */
 (frame, property, default_))
 {
 struct frame *f = decode_frame (frame);
-int width, height;
+Lisp_Object value;
 XSETFRAME (frame, f);
 property = get_property_alias (property);
-#define FROB(propprop, value) 	\
+if (EQ (Qname, property)) return f->name;
-do {				\
-if (EQ (property, propprop))	\
+if (EQ (Qheight, property) || EQ (Qwidth, property))
-return value;		\
+{
-} while (0)
+if (window_system_pixelated_geometry (frame))
+	{
-FROB (Qname, f->name);
+	  int width, height;
+	  pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
-if (window_system_pixelated_geometry (frame))
+				   &width, &height);
-{
+	  return make_int (EQ (Qheight, property) ? height: width);
-pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
+	}
-			       &width, &height);
+else
-}
+	return make_int (EQ (Qheight, property) ?
-else
+			 FRAME_HEIGHT (f) :
-{
+			 FRAME_WIDTH  (f));
-height = FRAME_HEIGHT (f);
+}
-width = FRAME_WIDTH (f);
-}
-FROB (Qheight, make_int (height));
-FROB (Qwidth,  make_int (width));
 /* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P.
 This is over-the-top bogosity, because it's inconsistent with
 the semantics of `minibuffer' when passed to `make-frame'.
 Returning Qt makes things consistent. */
-FROB (Qminibuffer, (FRAME_MINIBUF_ONLY_P (f) ? Qonly :
+if (EQ (Qminibuffer, property))
-		      FRAME_HAS_MINIBUF_P  (f) ? Qt    :
+return (FRAME_MINIBUF_ONLY_P (f) ? Qonly :
-		      FRAME_MINIBUF_WINDOW (f)));
+	    FRAME_HAS_MINIBUF_P  (f) ? Qt    :
-FROB (Qunsplittable, FRAME_NO_SPLIT_P (f) ? Qt : Qnil);
+	    FRAME_MINIBUF_WINDOW (f));
-FROB (Qbuffer_predicate, f->buffer_predicate);
+if (EQ (Qunsplittable, property))
+return FRAME_NO_SPLIT_P (f) ? Qt : Qnil;
-#undef FROB
+if (EQ (Qbuffer_predicate, property))
+return f->buffer_predicate;
-if (SYMBOLP (property) && EQ (Fbuilt_in_variable_type (property),
-				Qconst_specifier))
+if (SYMBOLP (property))
-return Fspecifier_instance (Fsymbol_value (property), frame, default_, Qnil);
+{
-if (SYMBOLP (property) && !NILP (Fget (property, Qconst_glyph_variable,
+if (EQ (Fbuilt_in_variable_type (property), Qconst_specifier))
-					 Qnil)))
+	return Fspecifier_instance (Fsymbol_value (property),
-{
+				    frame, default_, Qnil);
-Lisp_Object glyph = Fsymbol_value (property);
+if (!NILP (Fget (property, Qconst_glyph_variable, Qnil)))
-CHECK_GLYPH (glyph);
+	{
-return Fspecifier_instance (XGLYPH_IMAGE (glyph), frame, default_, Qnil);
+	  Lisp_Object glyph = Fsymbol_value (property);
-}
+	  CHECK_GLYPH (glyph);
+	  return Fspecifier_instance (XGLYPH_IMAGE (glyph),
+				      frame, default_, Qnil);
+	}
+}
 if (VECTORP (property) && XVECTOR_LENGTH (property) == 2)
 {
 Lisp_Object face_prop = XVECTOR_DATA (property)[1];
 CHECK_SYMBOL (face_prop);
 return call3 (Qface_property_instance,
 		    Fget_face (XVECTOR_DATA (property)[0]),
 		    face_prop, frame);
 }
-{
+if (HAS_FRAMEMETH_P (f, frame_property))
-Lisp_Object value;
+if (!UNBOUNDP (value = FRAMEMETH (f, frame_property, (f, property))))
-value = FRAMEMETH_OR_GIVEN (f, frame_property, (f, property), Qunbound);
-if (!UNBOUNDP (value))
 return value;
-value = external_plist_get (&f->plist, property, 1, ERROR_ME);
+if (!UNBOUNDP (value = external_plist_get (&f->plist, property, 1, ERROR_ME)))
-if (!UNBOUNDP (value))
+return value;
-return value;
 return default_;
-}
 }
 DEFUN ("frame-properties", Fframe_properties, 0, 1, 0, /*
 Return a property list of the properties of FRAME.
 Do not modify this list; use `set-frame-property' instead.
 (frame))
 {
 struct frame *f = decode_frame (frame);
 Lisp_Object result = Qnil;
 struct gcpro gcpro1;
-int width, height;
 GCPRO1 (result);
 XSETFRAME (frame, f);
-#define FROB(propprop, value)				\
+/* #### for the moment (since old code uses `frame-parameters'),
-do {							\
+we call `copy-sequence' on f->plist.  That allows frame-parameters
-Lisp_Object temtem = (value);				\
+to destructively convert the plist into an alist, which is more
-if (!NILP (temtem))					\
+efficient than doing it non-destructively.  At some point we
-/* backwards order; we reverse it below */		\
+should remove the call to copy-sequence. */
-result = Fcons (temtem, Fcons (propprop, result));	\
+result = Fcopy_sequence (f->plist);
-} while (0)
+/* #### should we be adding all the specifiers and glyphs?
-FROB (Qname, f->name);
+That would entail having a list of them all. */
+if (HAS_FRAMEMETH_P (f, frame_properties))
-if (window_system_pixelated_geometry (frame))
+result = nconc2 (FRAMEMETH (f, frame_properties, (f)), result);
-{
-pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
+if (!NILP (f->buffer_predicate))
-			       &width, &height);
+result = cons3 (Qbuffer_predicate, f->buffer_predicate, result);
-}
-else
+if (FRAME_NO_SPLIT_P (f))
-{
+result = cons3 (Qunsplittable, Qt, result);
-height = FRAME_HEIGHT (f);
-width = FRAME_WIDTH (f);
+/* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P.
-}
-FROB (Qheight, make_int (height));
-FROB (Qwidth,  make_int (width));
-/* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P.
 This is over-the-top bogosity, because it's inconsistent with
 the semantics of `minibuffer' when passed to `make-frame'.
 Returning Qt makes things consistent. */
-FROB (Qminibuffer, (FRAME_MINIBUF_ONLY_P (f) ? Qonly :
+result = cons3 (Qminibuffer,
-		      FRAME_HAS_MINIBUF_P  (f) ? Qt    :
+		  (FRAME_MINIBUF_ONLY_P (f) ? Qonly :
-		      FRAME_MINIBUF_WINDOW (f)));
+		   FRAME_HAS_MINIBUF_P  (f) ? Qt    :
-FROB (Qunsplittable, FRAME_NO_SPLIT_P (f) ? Qt : Qnil);
+		   FRAME_MINIBUF_WINDOW (f)),
-FROB (Qbuffer_predicate, f->buffer_predicate);
+		  result);
-#undef FROB
-/* #### should we be adding all the specifiers and glyphs?
-That would entail having a list of them all. */
 {
-Lisp_Object value;
+int width, height;
-value = FRAMEMETH_OR_GIVEN (f, frame_properties, (f), Qnil);
+if (window_system_pixelated_geometry (frame))
-result = nconc2 (value, result);
+{
-/* #### for the moment (since old code uses `frame-parameters'),
+	pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
-we call `copy-sequence' on f->plist.  That allows frame-parameters
+				 &width, &height);
-to destructively convert the plist into an alist, which is more
+}
-efficient than doing it non-destructively.  At some point we
+else
-should remove the call to copy-sequence. */
+{
-result = nconc2 (Fnreverse (result), Fcopy_sequence (f->plist));
+	height = FRAME_HEIGHT (f);
-RETURN_UNGCPRO (result);
+	width = FRAME_WIDTH (f);
+}
+result = cons3 (Qwidth , make_int (width),  result);
+result = cons3 (Qheight, make_int (height), result);
 }
+result = cons3 (Qname, f->name, result);
+UNGCPRO;
+return result;
 }
 DEFUN ("frame-pixel-height", Fframe_pixel_height, 0, 1, 0, /*
 Return the height in pixels of FRAME.
 */
 (frame))
 {
-struct frame *f = decode_frame (frame);
+return make_int (decode_frame (frame)->pixheight);
-return make_int (f->pixheight);
 }
 DEFUN ("frame-pixel-width", Fframe_pixel_width, 0, 1, 0, /*
 Return the width in pixels of FRAME.
 */
 (frame))
 {
-struct frame *f = decode_frame (frame);
+return make_int (decode_frame (frame)->pixwidth);
-return make_int (f->pixwidth);
 }
 DEFUN ("frame-name", Fframe_name, 0, 1, 0, /*
 Return the name of FRAME (defaulting to the selected frame).
 This is not the same as the `title' of the frame.
 internal_set_frame_size (f, width, height, !NILP (pretend));
 return frame;
 }
 DEFUN ("set-frame-size", Fset_frame_size, 3, 4, 0, /*
-Sets size of FRAME to COLS by ROWS.
+Set the size of FRAME to COLS by ROWS.
 Optional fourth arg non-nil means that redisplay should use COLS by ROWS
 but that the idea of the actual size of the frame should not be changed.
 */
 (frame, cols, rows, pretend))
 {
 internal_set_frame_size (f, width, height, !NILP (pretend));
 return frame;
 }
 DEFUN ("set-frame-position", Fset_frame_position, 3, 3, 0, /*
-Sets position of FRAME in pixels to XOFFSET by YOFFSET.
+Set position of FRAME in pixels to XOFFSET by YOFFSET.
 This is actually the position of the upper left corner of the frame.
 Negative values for XOFFSET or YOFFSET are interpreted relative to
 the rightmost or bottommost possible position (that stays within the screen).
 */
 (frame, xoffset, yoffset))
 void
 update_frame_icon (struct frame *f)
 {
 if (f->icon_changed || f->windows_changed)
 {
-Lisp_Object frame = Qnil;
+Lisp_Object frame;
 Lisp_Object new_icon;
 XSETFRAME (frame, f);
 new_icon = glyph_image_instance (Vframe_icon_glyph, frame,
 				       ERROR_ME_WARN, 0);
 DEFVAR_LISP ("default-frame-name", &Vdefault_frame_name /*
 The default name to assign to newly-created frames.
 This can be overridden by arguments to `make-frame'.
 This must be a string.
 */ );
+#ifndef INFODOCK
 Vdefault_frame_name = Fpurecopy (build_string ("emacs"));
+#else
+Vdefault_frame_name = Fpurecopy (build_string ("InfoDock"));
+#endif
 DEFVAR_LISP ("default-frame-plist", &Vdefault_frame_plist /*
 Plist of default values for frame creation, other than the first one.
 These may be set in your init file, like this:

Mercurial > hg > xemacs-beta

comparison src/frame.c @ 272:c5d627a313b1 r21-0b34