Function: internal-set-lisp-face-attribute

internal-set-lisp-face-attribute is a function defined in xfaces.c.

Signature

(internal-set-lisp-face-attribute FACE ATTR VALUE &optional FRAME)

Documentation

Set attribute ATTR of FACE to VALUE.

FRAME being a frame means change the face on that frame. FRAME nil means change the face of the selected frame. FRAME t means change the default for new frames. FRAME 0 means change the face on all frames, and change the default
  for new frames.

Source Code

// Defined in /usr/src/emacs/src/xfaces.c
// Skipping highlighting due to helpful-max-highlight.
{
  Lisp_Object lface;
  Lisp_Object old_value = Qnil;
  /* Set one of enum font_property_index (> 0) if ATTR is one of
     font-related attributes other than QCfont and QCfontset.  */
  enum font_property_index prop_index = 0;
  struct frame *f;

  CHECK_SYMBOL (face);
  CHECK_SYMBOL (attr);

  face = resolve_face_name (face, true);

  /* If FRAME is 0, change face on all frames, and change the
     default for new frames.  */
  if (FIXNUMP (frame) && XFIXNUM (frame) == 0)
    {
      Lisp_Object tail;
      Finternal_set_lisp_face_attribute (face, attr, value, Qt);
      FOR_EACH_FRAME (tail, frame)
	Finternal_set_lisp_face_attribute (face, attr, value, frame);
      return face;
    }

  /* Set lface to the Lisp attribute vector of FACE.  */
  if (EQ (frame, Qt))
    {
      f = NULL;
      lface = lface_from_face_name (NULL, face, true);

      /* When updating face--new-frame-defaults, we put :ignore-defface
	 where the caller wants `unspecified'.  This forces the frame
	 defaults to ignore the defface value.  Otherwise, the defface
	 will take effect, which is generally not what is intended.
	 The value of that attribute will be inherited from some other
	 face during face merging.  See internal_merge_in_global_face. */
      if (UNSPECIFIEDP (value))
	value = QCignore_defface;
    }
  else
    {
      if (NILP (frame))
	frame = selected_frame;

      CHECK_LIVE_FRAME (frame);
      f = XFRAME (frame);

      lface = lface_from_face_name (f, face, false);

      /* If a frame-local face doesn't exist yet, create one.  */
      if (NILP (lface))
	lface = Finternal_make_lisp_face (face, frame);
    }

  if (EQ (attr, QCfamily))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  CHECK_STRING (value);
	  if (SCHARS (value) == 0)
	    signal_error ("Invalid face family", value);
	}
      old_value = LFACE_FAMILY (lface);
      ASET (lface, LFACE_FAMILY_INDEX, value);
      prop_index = FONT_FAMILY_INDEX;
    }
  else if (EQ (attr, QCfoundry))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  CHECK_STRING (value);
	  if (SCHARS (value) == 0)
	    signal_error ("Invalid face foundry", value);
	}
      old_value = LFACE_FOUNDRY (lface);
      ASET (lface, LFACE_FOUNDRY_INDEX, value);
      prop_index = FONT_FOUNDRY_INDEX;
    }
  else if (EQ (attr, QCheight))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  if (EQ (face, Qdefault))
	    {
	      /* The default face must have an absolute size.  */
	      if (!FIXNUMP (value) || XFIXNUM (value) <= 0)
		signal_error ("Default face height not absolute and positive",
			      value);
	    }
	  else
	    {
	      /* For non-default faces, do a test merge with a random
		 height to see if VALUE's ok. */
	      Lisp_Object test = merge_face_heights (value,
						     make_fixnum (10),
						     Qnil);
	      if (!FIXNUMP (test) || XFIXNUM (test) <= 0)
		signal_error ("Face height does not produce a positive integer",
			      value);
	    }
	}

      old_value = LFACE_HEIGHT (lface);
      ASET (lface, LFACE_HEIGHT_INDEX, value);
      prop_index = FONT_SIZE_INDEX;
    }
  else if (EQ (attr, QCweight))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  CHECK_SYMBOL (value);
	  if (FONT_WEIGHT_NAME_NUMERIC (value) < 0)
	    signal_error ("Invalid face weight", value);
	}
      old_value = LFACE_WEIGHT (lface);
      ASET (lface, LFACE_WEIGHT_INDEX, value);
      prop_index = FONT_WEIGHT_INDEX;
    }
  else if (EQ (attr, QCslant))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  CHECK_SYMBOL (value);
	  if (FONT_SLANT_NAME_NUMERIC (value) < 0)
	    signal_error ("Invalid face slant", value);
	}
      old_value = LFACE_SLANT (lface);
      ASET (lface, LFACE_SLANT_INDEX, value);
      prop_index = FONT_SLANT_INDEX;
    }
  else if (EQ (attr, QCunderline))
    {
      bool valid_p = false;

      if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value) || RESET_P (value))
	valid_p = true;
      else if (NILP (value) || EQ (value, Qt))
        valid_p = true;
      else if (STRINGP (value) && SCHARS (value) > 0)
        valid_p = true;
      else if (CONSP (value))
        {
          Lisp_Object key, val, list;

          list = value;
          /* FIXME?  This errs on the side of acceptance.  Eg it accepts:
               (defface foo '((t :underline 'foo) "doc")
             Maybe this is intentional, maybe it isn't.
             Non-nil symbols other than t are not documented as being valid.
             Eg compare with inverse-video, which explicitly rejects them.
          */
          valid_p = true;

          while (!NILP (CAR_SAFE (list)))
            {
              key = CAR_SAFE (list);
              list = CDR_SAFE (list);
              val = CAR_SAFE (list);
              list = CDR_SAFE (list);

              if (NILP (key) || (NILP (val)
				 && !EQ (key, QCposition)))
                {
                  valid_p = false;
                  break;
                }

              else if (EQ (key, QCcolor)
                       && !(EQ (val, Qforeground_color)
                            || (STRINGP (val) && SCHARS (val) > 0)))
                {
                  valid_p = false;
                  break;
                }

              else if (EQ (key, QCstyle)
                       && !(EQ (val, Qline)
                            || EQ (val, Qdouble_line)
                            || EQ (val, Qwave)
                            || EQ (val, Qdots)
                            || EQ (val, Qdashes)))
                {
                  valid_p = false;
                  break;
                }
            }
        }

      if (!valid_p)
        signal_error ("Invalid face underline", value);

      old_value = LFACE_UNDERLINE (lface);
      ASET (lface, LFACE_UNDERLINE_INDEX, value);
    }
  else if (EQ (attr, QCoverline))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	if ((SYMBOLP (value)
	     && !EQ (value, Qt)
	     && !NILP (value))
	    /* Overline color.  */
	    || (STRINGP (value)
		&& SCHARS (value) == 0))
	  signal_error ("Invalid face overline", value);

      old_value = LFACE_OVERLINE (lface);
      ASET (lface, LFACE_OVERLINE_INDEX, value);
    }
  else if (EQ (attr, QCstrike_through))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	if ((SYMBOLP (value)
	     && !EQ (value, Qt)
	     && !NILP (value))
	    /* Strike-through color.  */
	    || (STRINGP (value)
		&& SCHARS (value) == 0))
	  signal_error ("Invalid face strike-through", value);

      old_value = LFACE_STRIKE_THROUGH (lface);
      ASET (lface, LFACE_STRIKE_THROUGH_INDEX, value);
    }
  else if (EQ (attr, QCbox))
    {
      bool valid_p;

      /* Allow t meaning a simple box of width 1 in foreground color
	 of the face.  */
      if (EQ (value, Qt))
	value = make_fixnum (1);

      if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value) || RESET_P (value))
	valid_p = true;
      else if (NILP (value))
	valid_p = true;
      else if (FIXNUMP (value))
	valid_p = XFIXNUM (value) != 0;
      else if (STRINGP (value))
	valid_p = SCHARS (value) > 0;
      else if (CONSP (value) && FIXNUMP (XCAR (value)) && FIXNUMP (XCDR (value)))
	valid_p = true;
      else if (CONSP (value))
	{
	  Lisp_Object tem;

	  tem = value;
	  while (CONSP (tem))
	    {
	      Lisp_Object k, v;

	      k = XCAR (tem);
	      tem = XCDR (tem);
	      if (!CONSP (tem))
		break;
	      v = XCAR (tem);

	      if (EQ (k, QCline_width))
		{
		  if ((!CONSP(v)
		       || !FIXNUMP (XCAR (v))
		       || XFIXNUM (XCAR (v)) == 0
		       || !FIXNUMP (XCDR (v)) || XFIXNUM (XCDR (v)) == 0)
		      && (!FIXNUMP (v) || XFIXNUM (v) == 0))
		    break;
		}
	      else if (EQ (k, QCcolor))
		{
		  if (!NILP (v) && (!STRINGP (v) || SCHARS (v) == 0))
		    break;
		}
	      else if (EQ (k, QCstyle))
		{
		  if (!NILP (v)
		      && !EQ (v, Qpressed_button)
		      && !EQ (v, Qreleased_button)
		      && !EQ (v, Qflat_button))
		    break;
		}
	      else
		break;

	      tem = XCDR (tem);
	    }

	  valid_p = NILP (tem);
	}
      else
	valid_p = false;

      if (!valid_p)
	signal_error ("Invalid face box", value);

      old_value = LFACE_BOX (lface);
      ASET (lface, LFACE_BOX_INDEX, value);
    }
  else if (EQ (attr, QCinverse_video))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  CHECK_SYMBOL (value);
	  if (!EQ (value, Qt) && !NILP (value))
	    signal_error ("Invalid inverse-video face attribute value", value);
	}
      old_value = LFACE_INVERSE (lface);
      ASET (lface, LFACE_INVERSE_INDEX, value);
    }
  else if (EQ (attr, QCextend))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  CHECK_SYMBOL (value);
	  if (!EQ (value, Qt) && !NILP (value))
	    signal_error ("Invalid extend face attribute value", value);
	}
      old_value = LFACE_EXTEND (lface);
      ASET (lface, LFACE_EXTEND_INDEX, value);
    }
  else if (EQ (attr, QCforeground))
    {
      HANDLE_INVALID_NIL_VALUE (QCforeground, face);
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  /* Don't check for valid color names here because it depends
	     on the frame (display) whether the color will be valid
	     when the face is realized.  */
	  CHECK_STRING (value);
	  if (SCHARS (value) == 0)
	    signal_error ("Empty foreground color value", value);
	}
      old_value = LFACE_FOREGROUND (lface);
      ASET (lface, LFACE_FOREGROUND_INDEX, value);
    }
  else if (EQ (attr, QCdistant_foreground))
    {
      HANDLE_INVALID_NIL_VALUE (QCdistant_foreground, face);
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  /* Don't check for valid color names here because it depends
	     on the frame (display) whether the color will be valid
	     when the face is realized.  */
	  CHECK_STRING (value);
	  if (SCHARS (value) == 0)
	    signal_error ("Empty distant-foreground color value", value);
	}
      old_value = LFACE_DISTANT_FOREGROUND (lface);
      ASET (lface, LFACE_DISTANT_FOREGROUND_INDEX, value);
    }
  else if (EQ (attr, QCbackground))
    {
      HANDLE_INVALID_NIL_VALUE (QCbackground, face);
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  /* Don't check for valid color names here because it depends
	     on the frame (display) whether the color will be valid
	     when the face is realized.  */
	  CHECK_STRING (value);
	  if (SCHARS (value) == 0)
	    signal_error ("Empty background color value", value);
	}
      old_value = LFACE_BACKGROUND (lface);
      ASET (lface, LFACE_BACKGROUND_INDEX, value);
    }
  else if (EQ (attr, QCstipple))
    {
#if defined (HAVE_WINDOW_SYSTEM)
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value)
	  && !NILP (value)
	  && NILP (Fbitmap_spec_p (value)))
	signal_error ("Invalid stipple attribute", value);
      old_value = LFACE_STIPPLE (lface);
      ASET (lface, LFACE_STIPPLE_INDEX, value);
#endif /* HAVE_WINDOW_SYSTEM */
    }
  else if (EQ (attr, QCwidth))
    {
      if (!UNSPECIFIEDP (value)
	  && !IGNORE_DEFFACE_P (value)
	  && !RESET_P (value))
	{
	  CHECK_SYMBOL (value);
	  if (FONT_WIDTH_NAME_NUMERIC (value) < 0)
	    signal_error ("Invalid face width", value);
	}
      old_value = LFACE_SWIDTH (lface);
      ASET (lface, LFACE_SWIDTH_INDEX, value);
      prop_index = FONT_WIDTH_INDEX;
    }
  else if (EQ (attr, QCfont))
    {
#ifdef HAVE_WINDOW_SYSTEM
      if (EQ (frame, Qt) || FRAME_WINDOW_P (f))
	{
	  if (!UNSPECIFIEDP (value)
	      && !IGNORE_DEFFACE_P (value)
	      && !RESET_P (value))
	    {
	      struct frame *f1;

	      old_value = LFACE_FONT (lface);
	      if (! FONTP (value))
		{
		  if (STRINGP (value))
		    {
		      Lisp_Object name = value;
		      int fontset = fs_query_fontset (name, 0);

		      if (fontset >= 0)
			name = fontset_ascii (fontset);
		      value = font_spec_from_name (name);
		      if (!FONTP (value))
			signal_error ("Invalid font name", name);
		    }
		  else
		    signal_error ("Invalid font or font-spec", value);
		}
	      if (EQ (frame, Qt))
		f1 = XFRAME (selected_frame);
	      else
		f1 = XFRAME (frame);

              /* FIXME:
                 If frame is t, and selected frame is a tty frame, the font
                 can't be realized.  An improvement would be to loop over frames
                 for a non-tty frame and use that.  See discussion in Bug#18573.
                 For a daemon, frame may be an initial frame (Bug#18869).  */
              if (FRAME_WINDOW_P (f1))
                {
                  if (! FONT_OBJECT_P (value))
                    {
                      Lisp_Object *attrs = XVECTOR (lface)->contents;
                      Lisp_Object font_object;

                      font_object = font_load_for_lface (f1, attrs, value);
                      if (NILP (font_object))
                        signal_error ("Font not available", value);
                      value = font_object;
                    }
                  set_lface_from_font (f1, lface, value, true);
		  f1->face_change = 1;
                }
	    }
	  else
	    ASET (lface, LFACE_FONT_INDEX, value);
	}
#endif /* HAVE_WINDOW_SYSTEM */
    }
  else if (EQ (attr, QCfontset))
    {
#ifdef HAVE_WINDOW_SYSTEM
      if (EQ (frame, Qt) || FRAME_WINDOW_P (f))
	{
	  Lisp_Object tmp = value;

	  old_value = LFACE_FONTSET (lface);
	  if (!RESET_P (value))
	    {
	      tmp = Fquery_fontset (value, Qnil);
	      if (NILP (tmp))
		signal_error ("Invalid fontset name", value);
	    }
	  ASET (lface, LFACE_FONTSET_INDEX, value = tmp);
	}
#endif /* HAVE_WINDOW_SYSTEM */
    }
  else if (EQ (attr, QCinherit))
    {
      Lisp_Object tail;
      if (SYMBOLP (value))
	tail = Qnil;
      else
	for (tail = value; CONSP (tail); tail = XCDR (tail))
	  if (!SYMBOLP (XCAR (tail)))
	    break;
      if (EQ (value, face) || face_inheritance_cycle (f, value, face))
	signal_error ("Face inheritance results in inheritance cycle", value);
      else if (NILP (tail))
	ASET (lface, LFACE_INHERIT_INDEX, value);
      else
	signal_error ("Invalid face inheritance", value);
    }
  else if (EQ (attr, QCbold))
    {
      old_value = LFACE_WEIGHT (lface);
      if (RESET_P (value))
	ASET (lface, LFACE_WEIGHT_INDEX, value);
      else
	ASET (lface, LFACE_WEIGHT_INDEX, NILP (value) ? Qnormal : Qbold);
      prop_index = FONT_WEIGHT_INDEX;
    }
  else if (EQ (attr, QCitalic))
    {
      attr = QCslant;
      old_value = LFACE_SLANT (lface);
      if (RESET_P (value))
	ASET (lface, LFACE_SLANT_INDEX, value);
      else
	ASET (lface, LFACE_SLANT_INDEX, NILP (value) ? Qnormal : Qitalic);
      prop_index = FONT_SLANT_INDEX;
    }
  else
    signal_error ("Invalid face attribute name", attr);

  if (prop_index)
    {
      /* If a font-related attribute other than QCfont and QCfontset
	 is specified, and if the original QCfont attribute has a font
	 (font-spec or font-object), set the corresponding property in
	 the font to nil so that the font selector doesn't think that
	 the attribute is mandatory.  Also, clear the average
	 width.  */
      font_clear_prop (XVECTOR (lface)->contents, prop_index);
    }

  /* Changing a named face means that all realized faces depending on
     that face are invalid.  Since we cannot tell which realized faces
     depend on the face, make sure they are all removed.  This is done
     by setting face_change.  The next call to init_iterator will then
     free realized faces.  */
  if (!EQ (frame, Qt)
      && NILP (Fget (face, Qface_no_inherit))
      && NILP (Fequal (old_value, value)))
    {
      f->face_change = true;
      fset_redisplay (f);
    }

  if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)
      && NILP (Fequal (old_value, value)))
    {
      Lisp_Object param;

      param = Qnil;

      if (EQ (face, Qdefault))
	{
#ifdef HAVE_WINDOW_SYSTEM
	  /* Changed font-related attributes of the `default' face are
	     reflected in changed `font' frame parameters.  */
	  if (FRAMEP (frame)
	      && (prop_index || EQ (attr, QCfont))
	      && lface_fully_specified_p (XVECTOR (lface)->contents))
	    set_font_frame_param (frame, lface);
	  else
#endif /* HAVE_WINDOW_SYSTEM */

	  if (EQ (attr, QCforeground))
	    param = Qforeground_color;
	  else if (EQ (attr, QCbackground))
	    param = Qbackground_color;
	}
#ifdef HAVE_WINDOW_SYSTEM
#ifndef HAVE_NTGUI
      else if (EQ (face, Qscroll_bar))
	{
	  /* Changing the colors of `scroll-bar' sets frame parameters
	     `scroll-bar-foreground' and `scroll-bar-background'. */
	  if (EQ (attr, QCforeground))
	    param = Qscroll_bar_foreground;
	  else if (EQ (attr, QCbackground))
	    param = Qscroll_bar_background;
	}
#endif /* not HAVE_NTGUI */
      else if (EQ (face, Qborder))
	{
	  /* Changing background color of `border' sets frame parameter
	     `border-color'.  */
	  if (EQ (attr, QCbackground))
	    param = Qborder_color;
	}
      else if (EQ (face, Qcursor))
	{
	  /* Changing background color of `cursor' sets frame parameter
	     `cursor-color'.  */
	  if (EQ (attr, QCbackground))
	    param = Qcursor_color;
	}
      else if (EQ (face, Qmouse))
	{
	  /* Changing background color of `mouse' sets frame parameter
	     `mouse-color'.  */
	  if (EQ (attr, QCbackground))
	    param = Qmouse_color;
	}
#endif /* HAVE_WINDOW_SYSTEM */
      else if (EQ (face, Qmenu))
	{
	  /* Indicate that we have to update the menu bar when realizing
	     faces on FRAME.  FRAME t change the default for new frames.
	     We do this by setting the flag in new face caches.  */
	  if (FRAMEP (frame))
	    {
	      struct frame *f = XFRAME (frame);
	      if (FRAME_FACE_CACHE (f) == NULL)
		FRAME_FACE_CACHE (f) = make_face_cache (f);
	      FRAME_FACE_CACHE (f)->menu_face_changed_p = true;
	    }
	  else
	    menu_face_changed_default = true;
	}

      if (!NILP (param))
	{
	  if (EQ (frame, Qt))
	    /* Update `default-frame-alist', which is used for new frames.  */
	    {
	      store_in_alist (&Vdefault_frame_alist, param, value);
	    }
	  else
	    /* Update the current frame's parameters.  */
	    {
	      AUTO_FRAME_ARG (arg, param, value);
	      Fmodify_frame_parameters (frame, arg);
	    }
	}
    }

  return face;
}