XEmacs 21.2.29 "Hestia".
[chise/xemacs-chise.git.1] / src / frame.c
index 5caeece..3c10854 100644 (file)
@@ -86,7 +86,6 @@ Lisp_Object Qborder_color;
 Lisp_Object Qborder_width;
 
 Lisp_Object Qframep, Qframe_live_p;
-Lisp_Object Qframe_x_p, Qframe_tty_p;
 Lisp_Object Qdelete_frame;
 
 Lisp_Object Qframe_title_format, Vframe_title_format;
@@ -117,22 +116,24 @@ Lisp_Object Vframe_being_created;
 Lisp_Object Qframe_being_created;
 
 static void store_minibuf_frame_prop (struct frame *f, Lisp_Object val);
-
-EXFUN (Fset_frame_properties, 2);
+static struct display_line title_string_display_line;
+/* Used by generate_title_string. Global because they get used so much that
+   the dynamic allocation time adds up. */
+static Emchar_dynarr *title_string_emchar_dynarr;
 
 \f
 static Lisp_Object
-mark_frame (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_frame (Lisp_Object obj)
 {
   struct frame *f = XFRAME (obj);
 
-#define MARKED_SLOT(x) ((void) (markobj (f->x)));
+#define MARKED_SLOT(x) mark_object (f->x)
 #include "frameslots.h"
 
-  mark_subwindow_cachels (f->subwindow_cachels, markobj);
+  mark_subwindow_cachels (f->subwindow_cachels);
 
   if (FRAME_LIVE_P (f)) /* device is nil for a dead frame */
-    MAYBE_FRAMEMETH (f, mark_frame, (f, markobj));
+    MAYBE_FRAMEMETH (f, mark_frame, (f));
 
   return Qnil;
 }
@@ -162,7 +163,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("frame", frame,
 static void
 nuke_all_frame_slots (struct frame *f)
 {
-#define MARKED_SLOT(x) f->x = Qnil;
+#define MARKED_SLOT(x) f->x = Qnil
 #include "frameslots.h"
 }
 
@@ -209,6 +210,12 @@ allocate_frame_core (Lisp_Object device)
   /* cache of subwindows visible on frame */
   f->subwindow_cachels    = Dynarr_new (subwindow_cachel);
 
+  /* associated exposure ignore list */
+  f->subwindow_exposures = 0;
+  f->subwindow_exposures_tail = 0;
+
+  FRAME_SET_PAGENUMBER (f, 1);
+
   /* Choose a buffer for the frame's root window.  */
   XWINDOW (root_window)->buffer = Qt;
   {
@@ -219,7 +226,7 @@ allocate_frame_core (Lisp_Object device)
        a space), try to find another one.  */
     if (string_char (XSTRING (Fbuffer_name (buf)), 0) == ' ')
       buf = Fother_buffer (buf, Qnil, Qnil);
-    Fset_window_buffer (root_window, buf);
+    Fset_window_buffer (root_window, buf, Qnil);
   }
 
   return f;
@@ -242,7 +249,7 @@ setup_normal_frame (struct frame *f)
   f->has_minibuffer = 1;
 
   XWINDOW (mini_window)->buffer = Qt;
-  Fset_window_buffer (mini_window, Vminibuffer_zero);
+  Fset_window_buffer (mini_window, Vminibuffer_zero, Qt);
 }
 
 /* Make a frame using a separate minibuffer window on another frame.
@@ -279,7 +286,7 @@ setup_frame_without_minibuffer (struct frame *f, Lisp_Object mini_window)
 
   /* Install the chosen minibuffer window, with proper buffer.  */
   store_minibuf_frame_prop (f, mini_window);
-  Fset_window_buffer (mini_window, Vminibuffer_zero);
+  Fset_window_buffer (mini_window, Vminibuffer_zero, Qt);
 }
 
 /* Make a frame containing only a minibuffer window.  */
@@ -309,7 +316,7 @@ setup_minibuffer_frame (struct frame *f)
 
   /* Put the proper buffer in that window.  */
 
-  Fset_window_buffer (mini_window, Vminibuffer_zero);
+  Fset_window_buffer (mini_window, Vminibuffer_zero, Qt);
 }
 
 static Lisp_Object
@@ -373,7 +380,7 @@ See `set-frame-properties', `default-x-frame-plist', and
   else
     name = build_string ("emacs");
 
-  if (!NILP (Fstring_match (make_string ((CONST Bufbyte *) "\\.", 2), name,
+  if (!NILP (Fstring_match (make_string ((const Bufbyte *) "\\.", 2), name,
                            Qnil, Qnil)))
     signal_simple_error (". not allowed in frame names", name);
 
@@ -410,7 +417,7 @@ See `set-frame-properties', `default-x-frame-plist', and
 
   update_frame_window_mirror (f);
 
-  if (initialized)
+  if (initialized && !DEVICE_STREAM_P (d))
     {
       if (!NILP (f->minibuffer_window))
         reset_face_cachels (XWINDOW (f->minibuffer_window));
@@ -1315,7 +1322,9 @@ delete_frame_internal (struct frame *f, int force,
   console = DEVICE_CONSOLE (d);
   con = XCONSOLE (console);
 
-  if (!called_from_delete_device)
+  if (!called_from_delete_device &&
+      !(MAYBE_INT_DEVMETH (d, device_implementation_flags, ())
+       & XDEVIMPF_FRAMELESS_OK))
     {
       /* If we're deleting the only non-minibuffer frame on the
         device, delete the device. */
@@ -1501,7 +1510,7 @@ delete_frame_internal (struct frame *f, int force,
                    next_frame_internal (frame, Qt, device,
                                         called_from_delete_device);
                if (NILP (next_f) || EQ (next_f, frame))
-                 ;
+                 set_device_selected_frame (d, Qnil);
                else
                  set_device_selected_frame (d, next_f);
            }
@@ -1516,7 +1525,7 @@ delete_frame_internal (struct frame *f, int force,
     {
       struct frame *sel_frame = selected_frame ();
       Fset_window_buffer (sel_frame->minibuffer_window,
-                         XWINDOW (minibuf_window)->buffer);
+                         XWINDOW (minibuf_window)->buffer, Qt);
       minibuf_window = sel_frame->minibuffer_window;
 
       /* If the dying minibuffer window was selected,
@@ -1922,7 +1931,7 @@ you may do so.
   if (EQ (f->minibuffer_window, minibuf_window))
     {
       Fset_window_buffer (sel_frame->minibuffer_window,
-                         XWINDOW (minibuf_window)->buffer);
+                         XWINDOW (minibuf_window)->buffer, Qt);
       minibuf_window = sel_frame->minibuffer_window;
     }
 
@@ -1948,7 +1957,7 @@ If omitted, FRAME defaults to the currently selected frame.
   if (EQ (f->minibuffer_window, minibuf_window))
     {
       Fset_window_buffer (sel_frame->minibuffer_window,
-                         XWINDOW (minibuf_window)->buffer);
+                         XWINDOW (minibuf_window)->buffer, Qt);
       minibuf_window = sel_frame->minibuffer_window;
     }
 
@@ -2080,6 +2089,31 @@ doesn't support multiple overlapping frames, this function does nothing.
 
 /* Ben thinks there is no need for `redirect-frame-focus' or `frame-focus',
    crockish FSFmacs functions.  See summary on focus in event-stream.c. */
+\f
+DEFUN ("print-job-page-number", Fprint_job_page_number, 1, 1, 0, /*
+Return current page number for the print job FRAME.
+*/
+       (frame))
+{
+  CHECK_PRINTER_FRAME (frame);
+  return make_int (FRAME_PAGENUMBER (XFRAME (frame)));
+}
+
+DEFUN ("print-job-eject-page", Fprint_job_eject_page, 1, 1, 0, /*
+Eject page in the print job FRAME.
+*/
+       (frame))
+{
+  struct frame *f;
+
+  CHECK_PRINTER_FRAME (frame);
+  f = XFRAME (frame);
+  FRAMEMETH (f, eject_page, (f));
+  FRAME_SET_PAGENUMBER (f, 1 + FRAME_PAGENUMBER (f));
+  f->clear = 1;
+
+  return Qnil;
+}
 
 \f
 /***************************************************************************/
@@ -2135,7 +2169,7 @@ dissect_as_face_setting (Lisp_Object sym, Lisp_Object *face_out,
                         Lisp_Object *face_prop_out)
 {
   Lisp_Object list = Vbuilt_in_face_specifiers;
-  struct Lisp_String *s;
+  Lisp_String *s;
 
   if (!SYMBOLP (sym))
     return 0;
@@ -2145,7 +2179,7 @@ dissect_as_face_setting (Lisp_Object sym, Lisp_Object *face_out,
   while (!NILP (list))
     {
       Lisp_Object prop = Fcar (list);
-      struct Lisp_String *prop_name;
+      Lisp_String *prop_name;
 
       if (!SYMBOLP (prop))
        continue;
@@ -2671,8 +2705,8 @@ frame_conversion_internal (struct frame *f, int pixel_to_char,
 
   window = FRAME_SELECTED_WINDOW (f);
 
-  egw = max (glyph_width (Vcontinuation_glyph, Vdefault_face, 0, window),
-            glyph_width (Vtruncation_glyph, Vdefault_face, 0, window));
+  egw = max (glyph_width (Vcontinuation_glyph, window),
+            glyph_width (Vtruncation_glyph, window));
   egw = max (egw, cpw);
   bdr = 2 * f->internal_border_width;
   obw = FRAME_SCROLLBAR_WIDTH (f) + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f) +
@@ -2847,9 +2881,9 @@ change_frame_size_1 (struct frame *f, int newheight, int newwidth)
   {
     int adjustment, trunc_width, cont_width;
 
-    trunc_width = glyph_width (Vtruncation_glyph, Vdefault_face, 0,
+    trunc_width = glyph_width (Vtruncation_glyph,
                               FRAME_SELECTED_WINDOW (f));
-    cont_width = glyph_width (Vcontinuation_glyph, Vdefault_face, 0,
+    cont_width = glyph_width (Vcontinuation_glyph,
                              FRAME_SELECTED_WINDOW (f));
     adjustment = max (trunc_width, cont_width);
     adjustment = max (adjustment, font_width);
@@ -2964,6 +2998,37 @@ change_frame_size (struct frame *f, int newheight, int newwidth, int delay)
 }
 
 \f
+/* The caller is responsible for freeing the returned string. */
+static Bufbyte *
+generate_title_string (struct window *w, Lisp_Object format_str,
+                      face_index findex, int type)
+{
+  struct display_line *dl;
+  struct display_block *db;
+  int elt = 0;
+
+  dl = &title_string_display_line;
+  db = get_display_block_from_line (dl, TEXT);
+  Dynarr_reset (db->runes);
+
+  generate_formatted_string_db (format_str, Qnil, w, dl, db, findex, 0,
+                                -1, type);
+
+  Dynarr_reset (title_string_emchar_dynarr);
+  while (elt < Dynarr_length (db->runes))
+    {
+      if (Dynarr_atp (db->runes, elt)->type == RUNE_CHAR)
+       Dynarr_add (title_string_emchar_dynarr,
+                   Dynarr_atp (db->runes, elt)->object.chr.ch);
+      elt++;
+    }
+
+  return
+    convert_emchar_string_into_malloced_string
+    (Dynarr_atp (title_string_emchar_dynarr, 0),
+     Dynarr_length (title_string_emchar_dynarr), 0);
+}
+
 void
 update_frame_title (struct frame *f)
 {
@@ -2987,8 +3052,8 @@ update_frame_title (struct frame *f)
 
   if (HAS_FRAMEMETH_P (f, set_title_from_bufbyte))
     {
-      title = generate_formatted_string (w, title_format, Qnil,
-                                         DEFAULT_INDEX, CURRENT_DISP);
+      title = generate_title_string (w, title_format,
+                                    DEFAULT_INDEX, CURRENT_DISP);
       FRAMEMETH (f, set_title_from_bufbyte, (f, title));
     }
 
@@ -2999,8 +3064,8 @@ update_frame_title (struct frame *f)
          if (title)
            xfree (title);
 
-         title = generate_formatted_string (w, icon_format, Qnil,
-                                             DEFAULT_INDEX, CURRENT_DISP);
+         title = generate_title_string (w, icon_format,
+                                        DEFAULT_INDEX, CURRENT_DISP);
        }
       FRAMEMETH (f, set_icon_name_from_bufbyte, (f, title));
     }
@@ -3059,6 +3124,24 @@ icon_glyph_changed (Lisp_Object glyph, Lisp_Object property,
 }
 
 \f
+/***************************************************************************/
+/*                                                                        */
+/*                              initialization                             */
+/*                                                                        */
+/***************************************************************************/
+
+void
+init_frame (void)
+{
+#ifndef PDUMP
+  if (!initialized)
+#endif
+    {
+      title_string_emchar_dynarr = Dynarr_new (Emchar);
+      xzero (title_string_display_line);
+    }
+}
+
 void
 syms_of_frame (void)
 {
@@ -3074,8 +3157,6 @@ syms_of_frame (void)
 
   defsymbol (&Qframep, "framep");
   defsymbol (&Qframe_live_p, "frame-live-p");
-  defsymbol (&Qframe_x_p, "frame-x-p");
-  defsymbol (&Qframe_tty_p, "frame-tty-p");
   defsymbol (&Qdelete_frame, "delete-frame");
   defsymbol (&Qsynchronize_minibuffers, "synchronize-minibuffers");
   defsymbol (&Qbuffer_predicate, "buffer-predicate");
@@ -3174,6 +3255,8 @@ syms_of_frame (void)
   DEFSUBR (Fset_frame_size);
   DEFSUBR (Fset_frame_position);
   DEFSUBR (Fset_frame_pointer);
+  DEFSUBR (Fprint_job_page_number);
+  DEFSUBR (Fprint_job_eject_page);
 }
 
 void
@@ -3291,13 +3374,13 @@ Controls the title of the X window corresponding to the selected frame.
 This is the same format as `modeline-format' with the exception that
 %- is ignored.
 */ );
-  Vframe_title_format = Fpurecopy (build_string ("%S: %b"));
+  Vframe_title_format = build_string ("%S: %b");
 
   DEFVAR_LISP ("frame-icon-title-format", &Vframe_icon_title_format /*
 Controls the title of the icon corresponding to the selected frame.
 See also the variable `frame-title-format'.
 */ );
-  Vframe_icon_title_format = Fpurecopy (build_string ("%b"));
+  Vframe_icon_title_format = build_string ("%b");
 
   DEFVAR_LISP ("default-frame-name", &Vdefault_frame_name /*
 The default name to assign to newly-created frames.
@@ -3305,9 +3388,9 @@ This can be overridden by arguments to `make-frame'.
 This must be a string.
 */ );
 #ifndef INFODOCK
-  Vdefault_frame_name = Fpurecopy (build_string ("emacs"));
+  Vdefault_frame_name = build_string ("emacs");
 #else
-  Vdefault_frame_name = Fpurecopy (build_string ("InfoDock"));
+  Vdefault_frame_name = build_string ("InfoDock");
 #endif
 
   DEFVAR_LISP ("default-frame-plist", &Vdefault_frame_plist /*