]> code.delx.au - gnu-emacs/blobdiff - src/font.c
; Merge branch 'fix/no-undo-boundary-on-secondary-buffer-change'
[gnu-emacs] / src / font.c
index b2b43c7971329125e173b631957809d60b361d47..016b7e0a88e83592f12cf444795e5edb3e60f1d7 100644 (file)
@@ -36,6 +36,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "composite.h"
 #include "fontset.h"
 #include "font.h"
+#include "termhooks.h"
 
 #ifdef HAVE_WINDOW_SYSTEM
 #include TERM_HEADER
@@ -1770,7 +1771,7 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec
       p1 = strchr (p0, '-');
       if (! p1)
        {
-         AUTO_STRING (extra, ("*-*" + (len && p0[len - 1] == '*')));
+         AUTO_STRING (extra, (&"*-*"[len && p0[len - 1] == '*']));
          registry = concat2 (registry, extra);
        }
       registry = Fdowncase (registry);
@@ -2908,7 +2909,12 @@ font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size)
               : font->average_width ? font->average_width
               : font->space_width ? font->space_width
               : 1);
-  height = (font->height ? font->height : 1);
+
+  int font_ascent, font_descent;
+  get_font_ascent_descent (font, &font_ascent, &font_descent);
+  height = font_ascent + font_descent;
+  if (height <= 0)
+    height = 1;
 #ifdef HAVE_WINDOW_SYSTEM
   FRAME_DISPLAY_INFO (f)->n_fonts++;
   if (FRAME_DISPLAY_INFO (f)->n_fonts == 1)
@@ -3332,6 +3338,38 @@ font_load_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec)
       /* No font is listed for SPEC, but each font-backend may have
         different criteria about "font matching".  So, try it.  */
       entity = font_matching_entity (f, attrs, spec);
+      /* Perhaps the user asked for a font "Foobar-123", and we
+        interpreted "-123" as the size, whereas it really is part of
+        the name.  So we reset the size to nil and the family name to
+        the entire "Foobar-123" thing, and try again with that.  */
+      if (NILP (entity))
+       {
+         name = Ffont_get (spec, QCuser_spec);
+         if (STRINGP (name))
+           {
+             char *p = SSDATA (name), *q = strrchr (p, '-');
+
+             if (q != NULL && c_isdigit (q[1]))
+               {
+                 char *tail;
+                 double font_size = strtod (q + 1, &tail);
+
+                 if (font_size > 0 && tail != q + 1)
+                   {
+                     Lisp_Object lsize = Ffont_get (spec, QCsize);
+
+                     if ((FLOATP (lsize) && XFLOAT_DATA (lsize) == font_size)
+                         || (INTEGERP (lsize) && XINT (lsize) == font_size))
+                       {
+                         ASET (spec, FONT_FAMILY_INDEX,
+                               font_intern_prop (p, tail - p, 1));
+                         ASET (spec, FONT_SIZE_INDEX, Qnil);
+                         entity = font_matching_entity (f, attrs, spec);
+                       }
+                   }
+               }
+           }
+       }
       if (NILP (entity))
        return Qnil;
     }
@@ -3822,17 +3860,17 @@ They are the same as face attributes of the same name.  See
 
 `:foundry'
 
-VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
+VALUE must be a string or a symbol specifying the font foundry, e.g. `misc'.
 
 `:adstyle'
 
 VALUE must be a string or a symbol specifying the additional
-typographic style information of a font, e.g. ``sans''.
+typographic style information of a font, e.g. `sans'.
 
 `:registry'
 
 VALUE must be a string or a symbol specifying the charset registry and
-encoding of a font, e.g. ``iso8859-1''.
+encoding of a font, e.g. `iso8859-1'.
 
 `:size'
 
@@ -3852,8 +3890,10 @@ listed in the variable `script-representative-chars'.
 
 `:lang'
 
-VALUE must be a symbol of two-letter ISO-639 language names,
-e.g. `ja'.
+VALUE must be a symbol whose name is a two-letter ISO-639 language
+name, e.g. `ja'.  The value is matched against the "Additional Style"
+field of the XLFD spec of a font, if it's non-empty, on X, and
+against the codepages supported by the font on w32.
 
 `:otf'
 
@@ -3866,7 +3906,7 @@ required OpenType features.
   GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
   GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
 
-GSUB and GPOS may contain `nil' element.  In such a case, the font
+GSUB and GPOS may contain nil elements.  In such a case, the font
 must not have any of the remaining elements.
 
 For instance, if the VALUE is `(thai nil nil (mark))', the font must
@@ -3942,7 +3982,10 @@ copy_font_spec (Lisp_Object font)
   pcdr = spec->props + FONT_EXTRA_INDEX;
   for (tail = AREF (font, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
     if (!EQ (XCAR (XCAR (tail)), QCfont_entity))
-      *pcdr = Fcons (XCAR (tail), Qnil), pcdr = xcdr_addr (*pcdr);
+      {
+        *pcdr = Fcons (Fcons (XCAR (XCAR (tail)), CDR (XCAR (tail))), Qnil);
+        pcdr = xcdr_addr (*pcdr);
+      }
 
   XSETFONT (new_spec, spec);
   return new_spec;
@@ -4029,7 +4072,7 @@ DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1,
 FONT is a font name, a font-spec, a font-entity, or a font-object.
 The return value is a list of the form
 
-\(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
+(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
 
 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
 compatible with `set-face-attribute'.  Some of these key-attribute pairs
@@ -4433,6 +4476,106 @@ where
   return val;
 }
 
+/* Return a description of the font at POSITION in the current buffer.
+   If the 2nd optional arg CH is non-nil, it is a character to check
+   the font instead of the character at POSITION.
+
+   For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
+   FONT-OBJECT is the font for the character at POSITION in the current
+   buffer.  This is computed from all the text properties and overlays
+   that apply to POSITION.  POSITION may be nil, in which case,
+   FONT-SPEC is the font for displaying the character CH with the
+   default face.  GLYPH-CODE is the glyph code in the font to use for
+   the character.
+
+   For a text terminal, return a nonnegative integer glyph code for
+   the character, or a negative integer if the character is not
+   displayable.  Terminal glyph codes are system-dependent integers
+   that represent displayable characters: for example, on a Linux x86
+   console they represent VGA code points.
+
+   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) If POSITION is not nil, and the current buffer is not displayed
+   in any window.
+
+   (4) For a text terminal, the terminal does not report glyph codes.
+
+   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, 2, 0,
+       doc: /* For internal use only.  */)
+  (Lisp_Object position, Lisp_Object ch)
+{
+  ptrdiff_t pos, pos_byte, dummy;
+  int face_id;
+  int c;
+  struct frame *f;
+
+  if (NILP (position))
+    {
+      CHECK_CHARACTER (ch);
+      c = XINT (ch);
+      f = XFRAME (selected_frame);
+      face_id = lookup_basic_face (f, DEFAULT_FACE_ID);
+      pos = -1;
+    }
+  else
+    {
+      Lisp_Object window;
+      struct window *w;
+
+      CHECK_NUMBER_COERCE_MARKER (position);
+      if (! (BEGV <= XINT (position) && XINT (position) < ZV))
+       args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
+      pos = XINT (position);
+      pos_byte = CHAR_TO_BYTE (pos);
+      if (NILP (ch))
+       c = FETCH_CHAR (pos_byte);
+      else
+       {
+         CHECK_NATNUM (ch);
+         c = XINT (ch);
+       }
+      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, &dummy,
+                                        pos + 100, false, -1);
+    }
+  if (! CHAR_VALID_P (c))
+    return Qnil;
+
+  if (! FRAME_WINDOW_P (f))
+    return terminal_glyph_code (FRAME_TERMINAL (f), c);
+
+  /* We need the basic faces to be valid below, so recompute them if
+     some code just happened to clear the face cache.  */
+  if (FRAME_FACE_CACHE (f)->used == 0)
+    recompute_basic_faces (f);
+
+  face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
+  struct face *face = FACE_FROM_ID (f, face_id);
+  if (! face->font)
+    return Qnil;
+  unsigned code = face->font->driver->encode_char (face->font, c);
+  if (code == FONT_INVALID_CODE)
+    return Qnil;
+  Lisp_Object font_object;
+  XSETFONT (font_object, face->font);
+  return Fcons (font_object, INTEGER_TO_CONS (code));
+}
+
 #if 0
 
 DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
@@ -4610,15 +4753,15 @@ ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
 pixels.
 
 CAPABILITY is a list whose first element is a symbol representing the
-font format \(x, opentype, truetype, type1, pcf, or bdf) and the
+font format (x, opentype, truetype, type1, pcf, or bdf) and the
 remaining elements describe the details of the font capability.
 
 If the font is OpenType font, the form of the list is
-  \(opentype GSUB GPOS)
+  (opentype GSUB GPOS)
 where GSUB shows which "GSUB" features the font supports, and GPOS
 shows which "GPOS" features the font supports.  Both GSUB and GPOS are
 lists of the format:
-  \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
+  ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
 
 If the font is not OpenType font, currently the length of the form is
 one.
@@ -4904,11 +5047,11 @@ where
     as follows:
 
       If the font is OpenType font, the form of the list is
-        \(opentype GSUB GPOS)
+        (opentype GSUB GPOS)
       where GSUB shows which "GSUB" features the font supports, and GPOS
       shows which "GPOS" features the font supports.  Both GSUB and GPOS are
       lists of the form:
-       \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
+       ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
 
       where
         SCRIPT is a symbol representing OpenType script tag.
@@ -5011,7 +5154,7 @@ build_style_table (const struct table_entry *entry, int nelement)
 static Lisp_Object Vfont_log_deferred;
 
 /* Prepend the font-related logging data in Vfont_log if it is not
-   `t'.  ACTION describes a kind of font-related action (e.g. listing,
+   t.  ACTION describes a kind of font-related action (e.g. listing,
    opening), ARG is the argument for the action, and RESULT is the
    result of the action.  */
 void
@@ -5133,10 +5276,6 @@ syms_of_font (void)
   DEFSYM (Qiso8859_1, "iso8859-1");
   DEFSYM (Qiso10646_1, "iso10646-1");
   DEFSYM (Qunicode_bmp, "unicode-bmp");
-  DEFSYM (Qunicode_sip, "unicode-sip");
-
-  /* Unicode category `Cf'.  */
-  DEFSYM (QCf, "Cf");
 
   /* Symbols representing keys of font extra info.  */
   DEFSYM (QCotf, ":otf");
@@ -5151,7 +5290,6 @@ syms_of_font (void)
   DEFSYM (QCscalable, ":scalable");
   DEFSYM (QCavgwidth, ":avgwidth");
   DEFSYM (QCfont_entity, ":font-entity");
-  DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec");
 
   /* Symbols representing values of font spacing property.  */
   DEFSYM (Qc, "c");
@@ -5195,6 +5333,7 @@ syms_of_font (void)
   defsubr (&Sclear_font_cache);
   defsubr (&Sfont_shape_gstring);
   defsubr (&Sfont_variation_glyphs);
+  defsubr (&Sinternal_char_font);
 #if 0
   defsubr (&Sfont_drive_otf);
   defsubr (&Sfont_otf_alternates);
@@ -5224,7 +5363,7 @@ where ENCODING is a charset or a char-table,
 and REPERTORY is a charset, a char-table, or nil.
 
 If ENCODING and REPERTORY are the same, the element can have the form
-\(REGEXP . ENCODING).
+(REGEXP . ENCODING).
 
 ENCODING is for converting a character to a glyph code of the font.
 If ENCODING is a charset, encoding a character by the charset gives
@@ -5270,21 +5409,25 @@ See `font-weight-table' for the format of the vector. */);
   ASET (font_style_table, 2, Vfont_width_table);
 
   DEFVAR_LISP ("font-log", Vfont_log, doc: /*
-*Logging list of font related actions and results.
-The value t means to suppress the logging.
-The initial value is set to nil if the environment variable
-EMACS_FONT_LOG is set.  Otherwise, it is set to t.  */);
+A list that logs font-related actions and results, for debugging.
+The default value is t, which means to suppress logging.
+Set it to nil to enable logging.  If the environment variable
+EMACS_FONT_LOG is set at startup, it defaults to nil.  */);
   Vfont_log = Qnil;
 
 #ifdef HAVE_WINDOW_SYSTEM
 #ifdef HAVE_FREETYPE
   syms_of_ftfont ();
 #ifdef HAVE_X_WINDOWS
+#ifdef USE_CAIRO
+  syms_of_ftcrfont ();
+#else
   syms_of_xfont ();
   syms_of_ftxfont ();
 #ifdef HAVE_XFT
   syms_of_xftfont ();
 #endif  /* HAVE_XFT */
+#endif  /* not USE_CAIRO */
 #endif /* HAVE_X_WINDOWS */
 #else  /* not HAVE_FREETYPE */
 #ifdef HAVE_X_WINDOWS