Make "xfree (NULL)" a no-op; remove useless if-before-xfree.
[bpt/emacs.git] / src / frame.c
index 30c5e5e..84a4e54 100644 (file)
@@ -4,10 +4,10 @@
 
 This file is part of GNU Emacs.
 
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs 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 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -15,9 +15,7 @@ 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 GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
+along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 
@@ -38,14 +36,15 @@ Boston, MA 02110-1301, USA.  */
 #include "commands.h"
 #include "keyboard.h"
 #include "frame.h"
-#ifdef HAVE_WINDOW_SYSTEM
-#include "fontset.h"
-#endif
 #include "blockinput.h"
 #include "termchar.h"
 #include "termhooks.h"
 #include "dispextern.h"
 #include "window.h"
+#ifdef HAVE_WINDOW_SYSTEM
+#include "font.h"
+#include "fontset.h"
+#endif
 #ifdef MSDOS
 #include "msdos.h"
 #include "dosfns.h"
@@ -54,10 +53,6 @@ Boston, MA 02110-1301, USA.  */
 
 #ifdef HAVE_WINDOW_SYSTEM
 
-#ifdef USE_FONT_BACKEND
-#include "font.h"
-#endif /* USE_FONT_BACKEND */
-
 /* The name we're using in resource queries.  Most often "emacs".  */
 
 Lisp_Object Vx_resource_name;
@@ -67,6 +62,10 @@ Lisp_Object Vx_resource_name;
 
 Lisp_Object Vx_resource_class;
 
+/* Lower limit value of the frame opacity (alpha transparency).  */
+
+Lisp_Object Vframe_alpha_lower_limit;
+
 #endif
 
 Lisp_Object Qframep, Qframe_live_p;
@@ -76,6 +75,7 @@ Lisp_Object Qx, Qw32, Qmac, Qpc;
 Lisp_Object Qvisible;
 Lisp_Object Qdisplay_type;
 Lisp_Object Qbackground_mode;
+Lisp_Object Qnoelisp;
 
 Lisp_Object Qx_frame_parameter;
 Lisp_Object Qx_resource_name;
@@ -116,9 +116,8 @@ Lisp_Object Qtty_color_mode;
 Lisp_Object Qtty, Qtty_type;
 
 Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
-#ifdef USE_FONT_BACKEND
 Lisp_Object Qfont_backend;
-#endif /* USE_FONT_BACKEND */
+Lisp_Object Qalpha;
 
 Lisp_Object Qinhibit_face_set_after_frame_default;
 Lisp_Object Qface_set_after_frame_default;
@@ -128,7 +127,7 @@ Lisp_Object Vdefault_frame_alist;
 Lisp_Object Vdefault_frame_scroll_bars;
 Lisp_Object Vmouse_position_function;
 Lisp_Object Vmouse_highlight;
-Lisp_Object Vdelete_frame_functions;
+static Lisp_Object Vdelete_frame_functions, Qdelete_frame_functions;
 
 int focus_follows_mouse;
 \f
@@ -333,10 +332,8 @@ make_frame (mini_p)
 #endif
   f->size_hint_flags = 0;
   f->win_gravity = 0;
-#ifdef USE_FONT_BACKEND
   f->font_driver_list = NULL;
   f->font_data_list = NULL;
-#endif /* USE_FONT_BACKEND */
 
   root_window = make_window ();
   if (mini_p)
@@ -868,11 +865,11 @@ do_switch_frame (frame, track, for_deletion)
   if (!for_deletion && FRAME_HAS_MINIBUF_P (sf))
     resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1);
 
-  if (FRAME_TERMCAP_P (XFRAME (selected_frame))
-      && FRAME_TERMCAP_P (XFRAME (frame))
-      && FRAME_TTY (XFRAME (selected_frame)) == FRAME_TTY (XFRAME (frame)))
+  if (FRAME_TERMCAP_P (XFRAME (frame)))
     {
-      XFRAME (selected_frame)->async_visible = 2; /* obscured */
+      if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
+       /* Mark previously displayed frame as now obscured.  */
+       XFRAME (FRAME_TTY (XFRAME (frame))->top_frame)->async_visible = 2;
       XFRAME (frame)->async_visible = 1;
       FRAME_TTY (XFRAME (frame))->top_frame = frame;
     }
@@ -883,23 +880,6 @@ do_switch_frame (frame, track, for_deletion)
 
   Fselect_window (XFRAME (frame)->selected_window, Qnil);
 
-#ifndef WINDOWSNT
-  /* Make sure to switch the tty color mode to that of the newly
-     selected frame.  */
-  sf = SELECTED_FRAME ();
-  if (FRAME_TERMCAP_P (sf))
-    {
-      Lisp_Object color_mode_spec, color_mode;
-
-      color_mode_spec = assq_no_quit (Qtty_color_mode, sf->param_alist);
-      if (CONSP (color_mode_spec))
-       color_mode = XCDR (color_mode_spec);
-      else
-       color_mode = make_number (0);
-      set_tty_color_mode (sf, color_mode);
-    }
-#endif /* !WINDOWSNT */
-
   /* We want to make sure that the next event generates a frame-switch
      event to the appropriate frame.  This seems kludgy to me, but
      before you take it out, make sure that evaluating something like
@@ -1333,6 +1313,8 @@ delete_frame_handler (Lisp_Object arg)
   return Qnil;
 }
 
+extern Lisp_Object Qrun_hook_with_args;
+
 DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "",
        doc: /* Delete FRAME, permanently eliminating it from use.
 If omitted, FRAME defaults to the selected frame.
@@ -1342,7 +1324,9 @@ but if the second optional argument FORCE is non-nil, you may do so.
 
 This function runs `delete-frame-functions' before actually deleting the
 frame, unless the frame is a tooltip.
-The functions are run with one arg, the frame to be deleted.  */)
+The functions are run with one arg, the frame to be deleted.
+But FORCE inhibits this too.  */)
+/* FORCE is non-nil when handling a disconnected terminal.  */
      (frame, force)
      Lisp_Object frame, force;
 {
@@ -1393,31 +1377,36 @@ The functions are run with one arg, the frame to be deleted.  */)
              && EQ (frame,
                     WINDOW_FRAME (XWINDOW
                                   (FRAME_MINIBUF_WINDOW (XFRAME (this))))))
-           error ("Attempt to delete a surrogate minibuffer frame");
+           {
+             /* If we MUST delete this frame, delete the other first.  */
+             if (!NILP (force))
+               Fdelete_frame (this, force);
+             else
+               error ("Attempt to delete a surrogate minibuffer frame");
+           }
        }
     }
 
-  /* Run `delete-frame-functions' unless frame is a tooltip.  */
-  if (!NILP (Vrun_hooks)
-      && NILP (Fframe_parameter (frame, intern ("tooltip"))))
-    {
-      Lisp_Object args[2];
-      struct gcpro gcpro1, gcpro2;
-
-      /* Don't let a rogue function in `delete-frame-functions'
-        prevent the frame deletion. */
-      GCPRO2 (args[0], args[1]);
-      args[0] = intern ("delete-frame-functions");
-      args[1] = frame;
-      internal_condition_case_2 (Frun_hook_with_args, 2, args,
-                                Qt, delete_frame_handler);
-      UNGCPRO;
-    }
+  /* Run `delete-frame-functions'
+     unless FORCE is `noelisp' or frame is a tooltip.
+     FORCE is set to `noelisp' when handling a disconnect from the terminal,
+     so we don't dare call Lisp code.  */
+  if (NILP (Vrun_hooks) || !NILP (Fframe_parameter (frame, intern ("tooltip"))))
+    ;
+  if (EQ (force, Qnoelisp))
+    pending_funcalls
+      = Fcons (list3 (Qrun_hook_with_args, Qdelete_frame_functions, frame),
+              pending_funcalls);
+  else
+    safe_call2 (Qrun_hook_with_args, Qdelete_frame_functions, frame);
 
   /* The hook may sometimes (indirectly) cause the frame to be deleted.  */
   if (! FRAME_LIVE_P (f))
     return Qnil;
 
+  /* At this point, we are committed to deleting the frame.
+     There is no more chance for errors to prevent it.  */
+
   minibuffer_selected = EQ (minibuf_window, selected_window);
 
   /* Don't let the frame remain selected.  */
@@ -1475,10 +1464,10 @@ The functions are run with one arg, the frame to be deleted.  */)
      memory. */
   free_glyphs (f);
 
-#ifdef USE_FONT_BACKEND
+#ifdef HAVE_WINDOW_SYSTEM
   /* Give chance to each font driver to free a frame specific data.  */
   font_update_drivers (f, Qnil);
-#endif /* USE_FONT_BACKEND */
+#endif
 
   /* Mark all the windows that used to be on FRAME as deleted, and then
      remove the reference to them.  */
@@ -1488,20 +1477,13 @@ The functions are run with one arg, the frame to be deleted.  */)
   Vframe_list = Fdelq (frame, Vframe_list);
   FRAME_SET_VISIBLE (f, 0);
 
-  if (f->namebuf)
-    xfree (f->namebuf);
-  if (f->decode_mode_spec_buffer)
-    xfree (f->decode_mode_spec_buffer);
-  if (FRAME_INSERT_COST (f))
-    xfree (FRAME_INSERT_COST (f));
-  if (FRAME_DELETEN_COST (f))
-    xfree (FRAME_DELETEN_COST (f));
-  if (FRAME_INSERTN_COST (f))
-    xfree (FRAME_INSERTN_COST (f));
-  if (FRAME_DELETE_COST (f))
-    xfree (FRAME_DELETE_COST (f));
-  if (FRAME_MESSAGE_BUF (f))
-    xfree (FRAME_MESSAGE_BUF (f));
+  xfree (f->namebuf);
+  xfree (f->decode_mode_spec_buffer);
+  xfree (FRAME_INSERT_COST (f));
+  xfree (FRAME_DELETEN_COST (f));
+  xfree (FRAME_INSERTN_COST (f));
+  xfree (FRAME_DELETE_COST (f));
+  xfree (FRAME_MESSAGE_BUF (f));
 
   /* Since some events are handled at the interrupt level, we may get
      an event for f at any time; if we zero out the frame's terminal
@@ -1523,11 +1505,11 @@ The functions are run with one arg, the frame to be deleted.  */)
     terminal->reference_count--;
     if (terminal->reference_count == 0)
       {
+       Lisp_Object tmp;
+       XSETTERMINAL (tmp, terminal);
+
         kb = NULL;
-        if (terminal->delete_terminal_hook)
-          (*terminal->delete_terminal_hook) (terminal);
-        else
-          delete_terminal (terminal);
+       Fdelete_terminal (tmp, NILP (force) ? Qt : force);
       }
 #ifdef MULTI_KBOARD
     else
@@ -2292,11 +2274,13 @@ store_frame_param (f, prop, val)
     }
 
 #ifndef WINDOWSNT
-  /* The tty color mode needs to be set before the frame's parameter
-     alist is updated with the new value, because set_tty_color_mode
-     wants to look at the old mode.  */
-  if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode))
-    set_tty_color_mode (f, val);
+  /* The tty color needed to be set before the frame's parameter
+     alist was updated with the new value.  This is not true any more,
+     but we still do this test early on.  */
+  if (FRAME_TERMCAP_P (f) && EQ (prop, Qtty_color_mode)
+      && f == FRAME_TTY (f)->previous_frame)
+    /* Force redisplay of this tty.  */
+    FRAME_TTY (f)->previous_frame = NULL;
 #endif
 
   /* Update the frame parameter alist.  */
@@ -2558,11 +2542,11 @@ enabled such bindings for that variable with `make-variable-frame-local'.  */)
       /* Extract parm names and values into those vectors.  */
 
       i = 0;
-      for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+      for (tail = alist; CONSP (tail); tail = XCDR (tail))
        {
          Lisp_Object elt;
 
-         elt = Fcar (tail);
+         elt = XCAR (tail);
          parms[i] = Fcar (elt);
          values[i] = Fcdr (elt);
          i++;
@@ -2840,9 +2824,8 @@ static struct frame_parm_table frame_parms[] =
   {"right-fringe",             &Qright_fringe},
   {"wait-for-wm",              &Qwait_for_wm},
   {"fullscreen",                &Qfullscreen},
-#ifdef USE_FONT_BACKEND
-  {"font-backend",             &Qfont_backend}
-#endif /* USE_FONT_BACKEND */
+  {"font-backend",             &Qfont_backend},
+  {"alpha",                    &Qalpha}
 };
 
 #ifdef HAVE_WINDOW_SYSTEM
@@ -2941,11 +2924,11 @@ x_set_frame_parameters (f, alist)
   /* Extract parm names and values into those vectors.  */
 
   i = 0;
-  for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+  for (tail = alist; CONSP (tail); tail = XCDR (tail))
     {
       Lisp_Object elt;
 
-      elt = Fcar (tail);
+      elt = XCAR (tail);
       parms[i] = Fcar (elt);
       values[i] = Fcdr (elt);
       i++;
@@ -3352,89 +3335,59 @@ x_set_font (f, arg, oldval)
      struct frame *f;
      Lisp_Object arg, oldval;
 {
-  Lisp_Object result;
-  Lisp_Object fontset_name;
   Lisp_Object frame;
-  int old_fontset = FRAME_FONTSET(f);
+  int fontset = -1;
+  Lisp_Object font_object;
 
-#ifdef USE_FONT_BACKEND
-  if (enable_font_backend)
-    {
-      int fontset = -1;
-      Lisp_Object font_object;
+  /* Set the frame parameter back to the old value because we mail
+     fail to use ARG as the new parameter value.  */
+  store_frame_param (f, Qfont, oldval);
 
-      /* ARG is a fontset name, a font name, or a font object.
-        In the last case, this function never fail.  */
-      if (STRINGP (arg))
+  /* ARG is a fontset name, a font name, or a font object.
+     In the last case, this function never fail.  */
+  if (STRINGP (arg))
+    {
+      fontset = fs_query_fontset (arg, 0);
+      if (fontset < 0)
        {
-         fontset = fs_query_fontset (arg, 0);
-         if (fontset < 0)
-           font_object = font_open_by_name (f, SDATA (arg));
-         else if (fontset > 0)
-           {
-             Lisp_Object ascii_font = fontset_ascii (fontset);
-
-             font_object = font_open_by_name (f, SDATA (ascii_font));
-           }
+         font_object = font_open_by_name (f, SDATA (arg));
+         if (NILP (font_object))
+           error ("Font `%s' is not defined", SDATA (arg));
+         arg = AREF (font_object, FONT_NAME_INDEX);
        }
-      else
-       font_object = arg;
-
-      if (fontset < 0 && ! NILP (font_object))
-       fontset = new_fontset_from_font (font_object);
+      else if (fontset > 0)
+       {
+         Lisp_Object ascii_font = fontset_ascii (fontset);
 
-      if (fontset == 0)
-       /* Refuse the default fontset.  */
-       result = Qt;
-      else if (NILP (font_object))
-       result = Qnil;
+         font_object = font_open_by_name (f, SDATA (ascii_font));
+         if (NILP (font_object))
+           error ("Font `%s' is not defined", SDATA (arg));
+         arg = fontset_name (fontset);
+       }
       else
-       result = x_new_fontset2 (f, fontset, font_object);
+       error ("The default fontset can't be used for a frame font");
     }
-  else
+  else if (FONT_OBJECT_P (arg))
     {
-#endif /* USE_FONT_BACKEND */
-  CHECK_STRING (arg);
-
-  fontset_name = Fquery_fontset (arg, Qnil);
-
-  BLOCK_INPUT;
-  result = (STRINGP (fontset_name)
-            ? x_new_fontset (f, fontset_name)
-            : x_new_fontset (f, arg));
-  UNBLOCK_INPUT;
-#ifdef USE_FONT_BACKEND
+      font_object = arg;
+      /* This is store the XLFD font name in the frame parameter for
+        backward compatiblity.  We should store the font-object
+        itself in the future.  */
+      arg = AREF (font_object, FONT_NAME_INDEX);
     }
-#endif
-
-  if (EQ (result, Qnil))
-    error ("Font `%s' is not defined", SDATA (arg));
-  else if (EQ (result, Qt))
-    error ("The default fontset can't be used for a frame font");
-  else if (STRINGP (result))
-    {
-      set_default_ascii_font (result);
-      if (STRINGP (fontset_name))
-       {
-         /* Fontset names are built from ASCII font names, so the
-            names may be equal despite there was a change.  */
-         if (old_fontset == FRAME_FONTSET (f))
-           return;
-       }
-      store_frame_param (f, Qfont, result);
-
-      if (!NILP (Fequal (result, oldval)))
-        return;
+  else
+    signal_error ("Invalid font", arg);
 
-      /* Recalculate toolbar height.  */
-      f->n_tool_bar_rows = 0;
-      /* Ensure we redraw it.  */
-      clear_current_matrices (f);
+  if (! NILP (Fequal (font_object, oldval)))
+    return;
+  x_new_font (f, font_object, fontset);
+  store_frame_param (f, Qfont, arg);
+  /* Recalculate toolbar height.  */
+  f->n_tool_bar_rows = 0;
+  /* Ensure we redraw it.  */
+  clear_current_matrices (f);
 
-      recompute_basic_faces (f);
-    }
-  else
-    abort ();
+  recompute_basic_faces (f);
 
   do_pending_window_change (0);
 
@@ -3451,7 +3404,6 @@ x_set_font (f, arg, oldval)
 }
 
 
-#ifdef USE_FONT_BACKEND
 void
 x_set_font_backend (f, new_value, old_value)
      struct frame *f;
@@ -3481,7 +3433,7 @@ x_set_font_backend (f, new_value, old_value)
   if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
     return;
 
-  if (FRAME_FONT_OBJECT (f))
+  if (FRAME_FONT (f))
     free_all_realized_faces (Qnil);
 
   new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
@@ -3494,7 +3446,7 @@ x_set_font_backend (f, new_value, old_value)
     }
   store_frame_param (f, Qfont_backend, new_value);
 
-  if (FRAME_FONT_OBJECT (f))
+  if (FRAME_FONT (f))
     {
       Lisp_Object frame;
 
@@ -3504,7 +3456,6 @@ x_set_font_backend (f, new_value, old_value)
       ++windows_or_buffers_changed;
     }
 }
-#endif /* USE_FONT_BACKEND */
 
 
 void
@@ -3684,6 +3635,61 @@ x_icon_type (f)
     return Qnil;
 }
 
+void
+x_set_alpha (f, arg, oldval)
+     struct frame *f;
+     Lisp_Object arg, oldval;
+{
+  double alpha = 1.0;
+  double newval[2];
+  int i, ialpha;
+  Lisp_Object item;
+
+  for (i = 0; i < 2; i++)
+    {
+      newval[i] = 1.0;
+      if (CONSP (arg))
+        {
+          item = CAR (arg);
+          arg  = CDR (arg);
+        }
+      else
+        item=arg;
+
+      if (! NILP (item))
+        {
+          if (FLOATP (item))
+            {
+              alpha = XFLOAT_DATA (item);
+              if (alpha < 0.0 || 1.0 < alpha)
+                args_out_of_range (make_float (0.0), make_float (1.0));
+            }
+          else if (INTEGERP (item))
+            {
+              ialpha = XINT (item);
+              if (ialpha < 0 || 100 < ialpha)
+                args_out_of_range (make_number (0), make_number (100));
+              else
+                alpha = ialpha / 100.0;
+            }
+          else
+            wrong_type_argument (Qnumberp, item);
+        }
+      newval[i] = alpha;
+    }
+
+  for (i = 0; i < 2; i++)
+    f->alpha[i] = newval[i];
+
+#ifdef HAVE_X_WINDOWS
+  BLOCK_INPUT;
+  x_set_frame_alpha (f);
+  UNBLOCK_INPUT;
+#endif
+
+  return;
+}
+
 \f
 /* Subroutines of creating an X frame.  */
 
@@ -4381,6 +4387,8 @@ syms_of_frame ()
   staticpro (&Qdisplay_type);
   Qbackground_mode = intern ("background-mode");
   staticpro (&Qbackground_mode);
+  Qnoelisp = intern ("noelisp");
+  staticpro (&Qnoelisp);
   Qtty_color_mode = intern ("tty-color-mode");
   staticpro (&Qtty_color_mode);
   Qtty = intern ("tty");
@@ -4451,6 +4459,13 @@ Setting this variable permanently is not a reasonable thing to do,
 but binding this variable locally around a call to `x-get-resource'
 is a reasonable practice.  See also the variable `x-resource-name'.  */);
   Vx_resource_class = build_string (EMACS_CLASS);
+
+  DEFVAR_LISP ("frame-alpha-lower-limit", &Vframe_alpha_lower_limit,
+    doc: /* The lower limit of the frame opacity (alpha transparency).
+The value should range from 0 (invisible) to 100 (completely opaque).
+You can also use a floating number between 0.0 and 1.0.
+The default is 20.  */);
+  Vframe_alpha_lower_limit = make_number (20);
 #endif
 
   DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
@@ -4509,13 +4524,13 @@ when the mouse is over clickable text.  */);
 The functions are run with one arg, the frame to be deleted.
 See `delete-frame'.
 
-Note that functions in this list may be called twice on the same
-frame.  In the second invocation, the frame is already deleted, and
-the function should do nothing.  (You can use `frame-live-p' to check
-for this.)  This wrinkle happens when an earlier function in
-`delete-frame-functions' (indirectly) calls `delete-frame'
-recursively.  */);
+Note that functions in this list may be called just before the frame is
+actually deleted, or some time later (or even both when an earlier function
+in `delete-frame-functions' (indirectly) calls `delete-frame'
+recursively).  */);
   Vdelete_frame_functions = Qnil;
+  Qdelete_frame_functions = intern ("delete-frame-functions");
+  staticpro (&Qdelete_frame_functions);
 
   DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
                 doc: /* Minibufferless frames use this frame's minibuffer.