diff src/fontset.c @ 28963:24af4ff8f7b6

Include "buffer.h". (fs_load_font): If the face has fontset, record the face ID in that fontset. (Finternal_char_font): New function. (accumulate_font_info): New function. (Ffontset_info): Rewritten for the new fontset implementation. (syms_of_fontset): Register Vdefault_fontset in the first element of Vfontset_table. Include Vdefault_fontset in Vfontset_alias_alist. Declare `internal-char-font' as a Lisp function.

--- a/src/fontset.c	Wed May 17 23:30:06 2000 +0000
+++ b/src/fontset.c	Wed May 17 23:30:30 2000 +0000
@@ -28,6 +28,7 @@
 #endif
 
 #include "lisp.h"
+#include "buffer.h"
 #include "charset.h"
 #include "ccl.h"
 #include "frame.h"
@@ -75,8 +76,8 @@
    element in a fontset.  The element is stored in `defalt' slot of
    the fontset.  And this slot is never used as a default value of
    multibyte characters.  That means that the first 256 elements of a
-   fontset set is always nil (as this is not efficient, we may
-   implement a fontset in a different way in the future).
+   fontset are always nil (as this is not efficient, we may implement
+   a fontset in a different way in the future).
 
    To access or set each element, use macros FONTSET_REF and
    FONTSET_SET respectively for efficiency.
@@ -251,7 +252,6 @@
 {
   int charset, c1, c2;
   Lisp_Object elt;
-  int i;
 
   if (SINGLE_BYTE_CHAR_P (*c))
     return FONTSET_ASCII (fontset);
@@ -689,6 +689,12 @@
   if (find_ccl_program_func)
     (*find_ccl_program_func) (fontp);
 
+  /* If we loaded a font for a face that has fontset, record the face
+     ID in the fontset for C.  */
+  if (face
+      && !NILP (fontset)
+      && !BASE_FONTSET_P (fontset))
+    FONTSET_SET (fontset, c, make_number (face->id));
   return fontp;
 }
 
@@ -1123,23 +1129,128 @@
   return info;
 }
 
+
+/* Return the font name for the character at POSITION in the current
+   buffer.  This is computed from all the text properties and overlays
+   that apply to POSITION.  It returns nil in the following cases:
+
+   (1) The window system doesn't have a font for the character (thus
+   it is displayed by an empty box).
+
+   (2) The character code is invalid.
+
+   (3) The current buffer is not displayed in any window.
+
+   In addition, the returned font name may not take into account of
+   such redisplay engine hooks as what used in jit-lock-mode if
+   POSITION is currently not visible.  */
+
+
+DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 1, 0,
+  "For internal use only.")
+  (position)
+     Lisp_Object position;
+{
+  int pos, pos_byte, dummy;
+  int face_id;
+  int c;
+  Lisp_Object window;
+  struct window *w;
+  struct frame *f;
+  struct face *face;
+
+  CHECK_NUMBER_COERCE_MARKER (position, 0);
+  pos = XINT (position);
+  if (pos < BEGV || pos >= ZV)
+    args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
+  pos_byte = CHAR_TO_BYTE (pos);
+  c = FETCH_CHAR (pos_byte);
+  if (! CHAR_VALID_P (c, 0))
+    return Qnil;
+  window = Fget_buffer_window (Fcurrent_buffer (), Qt);
+  if (NILP (window))
+    return Qnil;
+  w = XWINDOW (window);
+  f = XFRAME (w->frame);
+  face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
+  face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
+  face = FACE_FROM_ID (f, face_id);
+  return (face->font && face->font_name
+	  ? build_string (face->font_name)
+	  : Qnil);
+}
+
+
+/* Called from Ffontset_info via map_char_table on each leaf of
+   fontset.  ARG is a list (LAST FONT-INFO ...), where LAST is `(last
+   ARG)' and FONT-INFOs have this form:
+	(CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
+   The current leaf is indexed by CHARACTER and has value ELT.  This
+   function add the information of the current leaf to ARG by
+   appending a new element or modifying the last element..  */
+
+static void
+accumulate_font_info (arg, character, elt)
+     Lisp_Object arg, character, elt;
+{
+  Lisp_Object last, last_char, last_elt, tmp;
+
+  if (!CONSP (elt))
+    return;
+  last = XCAR (arg);
+  last_char = XCAR (XCAR (last));
+  last_elt = XCAR (XCDR (XCAR (last)));
+  elt = XCDR (elt);
+  if (!NILP (Fequal (elt, last_elt)))
+    {
+      int this_charset = CHAR_CHARSET (XINT (character));
+
+      if (CONSP (last_char))	/* LAST_CHAR == (FROM . TO)  */
+	{
+	  if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
+	    {
+	      XCDR (last_char) = character;
+	      return;
+	    }
+	}
+      else
+	{
+	  if (this_charset == CHAR_CHARSET (XINT (last_char)))
+	    {
+	      XCAR (XCAR (last)) = Fcons (last_char, character);
+	      return;
+	    }
+	}
+    }
+  XCDR (last) = Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil);
+  XCAR (arg) = XCDR (last);
+}
+
+
 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
   "Return information about a fontset named NAME on frame FRAME.\n\
-If FRAME is omitted or nil, use the selected frame.\n\
-The returned value is a vector of SIZE, HEIGHT, and FONT-LIST,\n\
-where\n\
-  SIZE is the maximum bound width of ASCII font of the fontset,\n\
-  HEIGHT is the height of the ASCII font in the fontset, and\n\
-  FONT-LIST is an alist of the format:\n\
-    (CHARSET REQUESTED-FONT-NAME LOADED-FONT-NAME).\n\
-LOADED-FONT-NAME t means the font is not yet loaded, nil means the\n\
-loading failed.")
+The value is a list:\n\
+  \(FONTSET-NAME (CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...),\n\
+where,\n\
+  FONTSET-NAME is a full name of the fontset.\n\
+  CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\ 
+    or a cons of two characters specifying the range of characters.\n\ 
+  FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
+    where FAMILY is a `FAMILY' field of a XLFD font name,\n\
+    REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
+    FAMILY may contain a `FOUNDARY' field at the head.\n\
+    REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
+  OPENEDs are names of fonts actually opened.\n\
+If FRAME is omitted, it defaults to the currently selected frame.")
   (name, frame)
      Lisp_Object name, frame;
 {
+  Lisp_Object fontset;
   FRAME_PTR f;
-  Lisp_Object fontset, realized;
-  Lisp_Object info, val, loaded, requested;
+  Lisp_Object indices[3];
+  Lisp_Object val, tail, elt;
+  Lisp_Object *realized;
+  int n_realized = 0;
   int i;
   
   (*check_window_system_func) ();
@@ -1151,77 +1262,66 @@
   CHECK_LIVE_FRAME (frame, 1);
   f = XFRAME (frame);
 
-  info = Fmake_vector (make_number (3), Qnil);
-
+  /* Recodeq realized fontsets whose base is FONTSET in the table
+     `realized'.  */
+  realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
+				     * ASIZE (Vfontset_table));
   for (i = 0; i < ASIZE (Vfontset_table); i++)
     {
-      realized = FONTSET_FROM_ID (i);
-      if (!NILP (realized)
-	  && EQ (FONTSET_FRAME (realized), frame)
-	  && EQ (FONTSET_BASE (realized), fontset)
-	  && INTEGERP (FONTSET_ASCII (realized)))
-	break;
+      elt = FONTSET_FROM_ID (i);
+      if (!NILP (elt)
+	  && EQ (FONTSET_BASE (elt), fontset))
+	realized[n_realized++] = elt;
     }
 
-  if (NILP (realized))
-    return Qnil;
-
-  XVECTOR (info)->contents[0] = Qnil;
-  XVECTOR (info)->contents[1] = Qnil;
-  loaded = Qnil;
+  /* Accumulate information of the fontset in VAL.  The format is
+     (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
+     FONT-SPEC).  See the comment for accumulate_font_info for the
+     detail.  */
+  val = Fcons (Fcons (make_number (0),
+		      Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
+	       Qnil);
+  val = Fcons (val, val);
+  map_char_table (accumulate_font_info, Qnil, fontset, val, 0, indices);
+  val = XCDR (val);
 
-  val = Fcons (Fcons (CHARSET_SYMBOL (CHARSET_ASCII),
-		      Fcons (FONTSET_ASCII (fontset),
-			     Fcons (loaded, Qnil))),
-	       Qnil);
-  for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
+  /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
+     character for a charset, replace it wiht the charset symbol.  If
+     fonts are opened for FONT-SPEC, append the names of the fonts to
+     FONT-SPEC.  */
+  for (tail = val; CONSP (tail); tail = XCDR (tail))
     {
-      Lisp_Object elt;
-      elt = XCHAR_TABLE (fontset)->contents[i + 128];
-
-      if (VECTORP (elt))
+      int c;
+      elt = XCAR (tail);
+      if (INTEGERP (XCAR (elt)))
 	{
-	  int face_id;
+	  int charset, c1, c2;
+	  c = XINT (XCAR (elt));
+	  SPLIT_CHAR (c, charset, c1, c2);
+	  if (c1 == 0)
+	    XCAR (elt) = CHARSET_SYMBOL (charset);
+	}
+      else
+	c = XINT (XCAR (XCAR (elt)));
+      for (i = 0; i < n_realized; i++)
+	{
+	  Lisp_Object face_id, font;
 	  struct face *face;
 
-	  if (INTEGERP (AREF (elt, 2))
-	      && (face_id = XINT (AREF (elt, 2)),
-		  face = FACE_FROM_ID (f, face_id)))
-	    {
-	      struct font_info *fontp;
-	      fontp = (*get_font_info_func) (f, face->font_info_id);
-   	      requested = build_string (fontp->name);
-	      loaded = (fontp->full_name
-			? build_string (fontp->full_name)
-			: Qnil);
-	    }
-	  else
+	  face_id = FONTSET_REF_VIA_BASE (realized[i], c);
+	  if (INTEGERP (face_id))
 	    {
-	      char *str;
-	      int family_len = 0, registry_len = 0;
-
-	      if (STRINGP (AREF (elt, 0)))
-		family_len = STRING_BYTES (XSTRING (AREF (elt, 0)));
-	      if (STRINGP (AREF (elt, 1)))
-		registry_len = STRING_BYTES (XSTRING (AREF (elt, 1)));
-	      str = (char *) alloca (1 + family_len + 3 + registry_len + 1);
-	      str[0] = '-';
-	      str[1] = 0;
-	      if (family_len)
-		strcat (str, XSTRING (AREF (elt, 0))->data);
-	      strcat (str, "-*-");
-	      if (registry_len)
-   		strcat (str, XSTRING (AREF (elt, 1))->data);
-	      requested = build_string (str);
-	      loaded = Qnil;
+	      face = FACE_FROM_ID (f, XINT (face_id));
+	      if (face->font && face->font_name)
+		{
+		  font = build_string (face->font_name);
+		  if (NILP (Fmember (font, XCDR (XCDR (elt)))))
+		    XCDR (XCDR (elt)) = Fcons (font, XCDR (XCDR (elt)));
+		}
 	    }
-	  val = Fcons (Fcons (CHARSET_SYMBOL (i),
-			      Fcons (requested, Fcons (loaded, Qnil))),
-		       val);
 	}
     }
-  XVECTOR (info)->contents[2] = val;
-  return info;
+  return Fcons (FONTSET_NAME (fontset), val);
 }
 
 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
@@ -1263,6 +1363,7 @@
 	  && BASE_FONTSET_P (fontset))
 	list = Fcons (FONTSET_NAME (fontset), list);
     }
+
   return list;
 }
 
@@ -1284,12 +1385,16 @@
 
   Vfontset_table = Fmake_vector (make_number (32), Qnil);
   staticpro (&Vfontset_table);
-  next_fontset_id = 0;
 
   Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
   staticpro (&Vdefault_fontset);
+  FONTSET_ID (Vdefault_fontset) = make_number (0);
+  FONTSET_NAME (Vdefault_fontset)
+    = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
   FONTSET_ASCII (Vdefault_fontset)
     = Fcons (make_number (0), Fcons (Qnil, build_string ("iso8859-1")));
+  AREF (Vfontset_table, 0) = Vdefault_fontset;
+  next_fontset_id = 1;
 
   DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
     "Alist of fontname patterns vs corresponding encoding info.\n\
@@ -1327,7 +1432,9 @@
 
   DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
      "Alist of fontset names vs the aliases.");
-  Vfontset_alias_alist = Qnil;
+  Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
+				       build_string ("fontset-default")),
+				Qnil);
 
   DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font,
      "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
@@ -1358,6 +1465,7 @@
   defsubr (&Snew_fontset);
   defsubr (&Sset_fontset_font);
   defsubr (&Sfont_info);
+  defsubr (&Sinternal_char_font);
   defsubr (&Sfontset_info);
   defsubr (&Sfontset_font);
   defsubr (&Sfontset_list);