+
+/* 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,
+ doc: /* 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);
+ 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 (), Qnil);
+ 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;
+
+ if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
+ elt = FONTSET_REF (Vdefault_fontset, XINT (character));
+ 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))))
+ {
+ XSETCDR (last_char, character);
+ return;
+ }
+ }
+ else if (XINT (last_char) == XINT (character))
+ return;
+ else if (this_charset == CHAR_CHARSET (XINT (last_char)))
+ {
+ XSETCAR (XCAR (last), Fcons (last_char, character));
+ return;
+ }
+ }
+ XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil));
+ XSETCAR (arg, XCDR (last));
+}
+
+