changeset 40398:560b1c474b1a

(merge_face_heights): Handle TO being relative as well. Remove #ifdef'd-out code. (Fface_attribute_relative_p, Fmerge_face_attribute): New functions. (syms_of_xfaces): Initialize them.

--- a/src/xfaces.c	Sun Oct 28 06:48:56 2001 +0000
+++ b/src/xfaces.c	Sun Oct 28 10:09:29 2001 +0000
@@ -3217,66 +3217,53 @@
 
 /* Merges the face height FROM with the face height TO, and returns the
    merged height.  If FROM is an invalid height, then INVALID is
-   returned instead.  FROM may be a either an absolute face height or a
-   `relative' height, and TO must be an absolute height.  The returned
-   value is always an absolute height.  GCPRO is a lisp value that will
-   be protected from garbage-collection if this function makes a call
-   into lisp.  */
+   returned instead.  FROM and TO may be either absolute face heights or
+   `relative' heights; the returned value is always an absolute height
+   unless both FROM and TO are relative.  GCPRO is a lisp value that
+   will be protected from garbage-collection if this function makes a
+   call into lisp.  */
 
 Lisp_Object
 merge_face_heights (from, to, invalid, gcpro)
      Lisp_Object from, to, invalid, gcpro;
 {
-  int result = 0;
+  Lisp_Object result = invalid;
 
   if (INTEGERP (from))
-    result = XINT (from);
-  else if (NUMBERP (from))
-    result = XFLOATINT (from) * XINT (to);
-#if 0 /* Probably not so useful.  */
-  else if (CONSP (from) && CONSP (XCDR (from)))
-    {
-      if (EQ (XCAR(from), Qplus) || EQ (XCAR(from), Qminus))
-	{
-	  if (INTEGERP (XCAR (XCDR (from))))
-	    {
-	      int inc = XINT (XCAR (XCDR (from)));
-	      if (EQ (XCAR (from), Qminus))
-		inc = -inc;
-
-	      result = XFASTINT (to);
-	      if (result + inc > 0)
-		/* Note that `underflows' don't mean FROM is invalid, so
-		   we just pin the result at TO if it would otherwise be
-		   negative or 0.  */
-		result += inc;
-	    }
-	}
-    }
-#endif
+    /* FROM is absolute, just use it as is.  */
+    result = from;
+  else if (FLOATP (from))
+    /* FROM is a scale, use it to adjust TO.  */
+    {
+      if (INTEGERP (to))
+	/* relative X absolute => absolute */
+	result = make_number (XFLOAT_DATA (from) * XINT (to));
+      else if (FLOATP (to))
+	/* relative X relative => relative */
+	result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to));
+    }
   else if (FUNCTIONP (from))
+    /* FROM is a function, which use to adjust TO.  */
     {
       /* Call function with current height as argument.
 	 From is the new height.  */
-      Lisp_Object args[2], height;
+      Lisp_Object args[2];
       struct gcpro gcpro1;
 
       GCPRO1 (gcpro);
 
       args[0] = from;
       args[1] = to;
-      height = safe_call (2, args);
+      result = safe_call (2, args);
 
       UNGCPRO;
 
-      if (NUMBERP (height))
-	result = XFLOATINT (height);
-    }
-
-  if (result > 0)
-    return make_number (result);
-  else
-    return invalid;
+      /* Ensure that if TO was absolute, so is the result.  */
+      if (INTEGERP (to) && !INTEGERP (result))
+	result = invalid;
+    }
+
+  return result;
 }
 
 
@@ -4495,6 +4482,36 @@
 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
 
 
+DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p, 
+       Sface_attribute_relative_p,
+       2, 2, 0,
+       doc: /* Return non-nil if face ATTRIBUTE VALUE is relative.  */)
+     (attribute, value)
+{
+  if (EQ (value, Qunspecified))
+    return Qt;
+  else if (EQ (attribute, QCheight))
+    return INTEGERP (value) ? Qnil : Qt;
+  else
+    return Qnil;
+}
+
+DEFUN ("merge-face-attribute", Fmerge_face_attribute, Smerge_face_attribute,
+       3, 3, 0,
+       doc: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
+If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
+the result will be absolute, otherwise it will be relative.  */)
+     (attribute, value1, value2)
+     Lisp_Object attribute, value1, value2;
+{
+  if (EQ (value1, Qunspecified))
+    return value2;
+  else if (EQ (attribute, QCheight))
+    return merge_face_heights (value1, value2, value1, Qnil);
+  else
+    return value1;
+}
+
 
 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute,
        Sinternal_get_lisp_face_attribute,
@@ -7205,6 +7222,8 @@
 #endif
   defsubr (&Scolor_gray_p);
   defsubr (&Scolor_supported_p);
+  defsubr (&Sface_attribute_relative_p);
+  defsubr (&Smerge_face_attribute);
   defsubr (&Sinternal_get_lisp_face_attribute);
   defsubr (&Sinternal_lisp_face_attribute_values);
   defsubr (&Sinternal_lisp_face_equal_p);