]> code.delx.au - gnu-emacs/blobdiff - src/fontset.c
(Fbyte_code): Use BEFORE_POTENTIAL_GC and
[gnu-emacs] / src / fontset.c
index d1819cc0385f89d32afc2a77134bfdd4adf954d2..7b602092610f1ea7862f74744edd5d9cede84746 100644 (file)
@@ -26,13 +26,14 @@ Boston, MA 02111-1307, USA.  */
 #include "lisp.h"
 #include "charset.h"
 #include "ccl.h"
-#include "fontset.h"
 #include "frame.h"
+#include "fontset.h"
 
 Lisp_Object Vglobal_fontset_alist;
 Lisp_Object Vfont_encoding_alist;
 Lisp_Object Vuse_default_ascent;
-Lisp_Object Valternative_fontname_alist;
+Lisp_Object Vignore_relative_composition;
+Lisp_Object Valternate_fontname_alist;
 Lisp_Object Vfontset_alias_alist;
 Lisp_Object Vhighlight_wrong_size_font;
 Lisp_Object Vclip_large_size_font;
@@ -59,25 +60,34 @@ my_strcasecmp (s0, s1)
    the comments in src/fontset.h for more detail.  */
 
 /* Return a pointer to struct font_info of font FONT_IDX of frame F.  */
-struct font_info *(*get_font_info_func) (/* FRAME_PTR f; int font_idx */);
+struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx));
 
 /* Return a list of font names which matches PATTERN.  See the document of
    `x-list-fonts' for more detail.  */
-Lisp_Object (*list_fonts_func) (/* Lisp_Object pattern, face, frame, width */);
+Lisp_Object (*list_fonts_func) P_ ((struct frame *f,
+                                   Lisp_Object pattern,
+                                   int size,
+                                   int maxnames));
 
 /* Load a font named NAME for frame F and return a pointer to the
    information of the loaded font.  If loading is failed, return 0.  */
-struct font_info *(*load_font_func) (/* FRAME_PTR f; char *name */);
+struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int));
 
 /* Return a pointer to struct font_info of a font named NAME for frame F.  */
-struct font_info *(*query_font_func) (/* FRAME_PTR f; char *name */);
+struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name));
 
 /* Additional function for setting fontset or changing fontset
    contents of frame F.  */
-void (*set_frame_fontset_func) (/* FRAME_PTR f; Lisp_Object arg, oldval */);
+void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg,
+                                   Lisp_Object oldval));
+
+/* To find a CCL program, fs_load_font calls this function.
+   The argument is a pointer to the struct font_info.
+   This function set the memer `encoder' of the structure.  */
+void (*find_ccl_program_func) P_ ((struct font_info *));
 
 /* Check if any window system is used now.  */
-void (*check_window_system_func) ();
+void (*check_window_system_func) P_ ((void));
 
 struct fontset_data *
 alloc_fontset_data ()
@@ -94,19 +104,22 @@ void
 free_fontset_data (fontset_data)
      struct fontset_data *fontset_data;
 {
-  int i;
-
-  for (i = 0; i < fontset_data->n_fontsets; i++)
+  if (fontset_data->fontset_table)
     {
-      int j;
+      int i;
 
-      xfree (fontset_data->fontset_table[i]->name);
-      for (j = 0; j <= MAX_CHARSET; j++)
-       if (fontset_data->fontset_table[i]->fontname[j])
-         xfree (fontset_data->fontset_table[i]->fontname[j]);
-      xfree (fontset_data->fontset_table[i]);
+      for (i = 0; i < fontset_data->n_fontsets; i++)
+       {
+         int j;
+         
+         xfree (fontset_data->fontset_table[i]->name);
+         for (j = 0; j <= MAX_CHARSET; j++)
+           if (fontset_data->fontset_table[i]->fontname[j])
+             xfree (fontset_data->fontset_table[i]->fontname[j]);
+         xfree (fontset_data->fontset_table[i]);
+       }
+      xfree (fontset_data->fontset_table);
     }
-  xfree (fontset_data->fontset_table);
 
   xfree (fontset_data);
 }
@@ -165,7 +178,7 @@ fs_load_font (f, font_table, charset, fontname, fontset)
        {
          fontp = fs_load_font (f, font_table, CHARSET_ASCII, 0, fontset);
          if (!fontp)
-           /* Any fontset should contain avairable ASCII.  */
+           /* Any fontset should contain available ASCII.  */
            return 0;
        }
       /* Now we have surely decided the size of this fontset.  */
@@ -205,42 +218,32 @@ fs_load_font (f, font_table, charset, fontname, fontset)
       for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
        fontp->encoding[i] = 1;
       /* Then override them by a specification in Vfont_encoding_alist.  */
-      for (list = Vfont_encoding_alist; CONSP (list); list = XCONS (list)->cdr)
+      for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))
        {
-         elt = XCONS (list)->car;
+         elt = XCAR (list);
          if (CONSP (elt)
-             && STRINGP (XCONS (elt)->car) && CONSP (XCONS (elt)->cdr)
-             && (fast_c_string_match_ignore_case (XCONS (elt)->car, fontname)
+             && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
+             && (fast_c_string_match_ignore_case (XCAR (elt), fontname)
                  >= 0))
            {
              Lisp_Object tmp;
 
-             for (tmp = XCONS (elt)->cdr; CONSP (tmp); tmp = XCONS (tmp)->cdr)
-               if (CONSP (XCONS (tmp)->car)
-                   && ((i = get_charset_id (XCONS (XCONS (tmp)->car)->car))
+             for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))
+               if (CONSP (XCAR (tmp))
+                   && ((i = get_charset_id (XCAR (XCAR (tmp))))
                        >= 0)
-                   && INTEGERP (XCONS (XCONS (tmp)->car)->cdr)
-                   && XFASTINT (XCONS (XCONS (tmp)->car)->cdr) < 4)
+                   && INTEGERP (XCDR (XCAR (tmp)))
+                   && XFASTINT (XCDR (XCAR (tmp))) < 4)
                  fontp->encoding[i]
-                   = XFASTINT (XCONS (XCONS (tmp)->car)->cdr);
+                   = XFASTINT (XCDR (XCAR (tmp)));
            }
        }
     }
 
   fontp->font_encoder = (struct ccl_program *) 0;
-  for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCONS (list)->cdr)
-    {
-      elt = XCONS (list)->car;
-      if (CONSP (elt)
-         && STRINGP (XCONS (elt)->car) && VECTORP (XCONS (elt)->cdr)
-         && fast_c_string_match_ignore_case (XCONS (elt)->car, fontname) >= 0)
-       {
-         fontp->font_encoder
-           = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
-         setup_ccl_program (fontp->font_encoder, XCONS (elt)->cdr);
-         break;
-       }
-    }
+
+  if (find_ccl_program_func)
+    (*find_ccl_program_func) (fontp);
 
   /* If FONTSET is specified, setup various fields of it.  */
   if (fontsetp)
@@ -325,12 +328,12 @@ fs_register_fontset (f, fontset_info)
   int i;
 
   if (!CONSP (fontset_info)
-      || !STRINGP (XCONS (fontset_info)->car)
-      || !CONSP (XCONS (fontset_info)->cdr))
+      || !STRINGP (XCAR (fontset_info))
+      || !CONSP (XCDR (fontset_info)))
     /* Invalid data in FONTSET_INFO.  */
     return -1;
 
-  name = XCONS (fontset_info)->car;
+  name = XCAR (fontset_info);
   if ((fontset = fs_query_fontset (f, XSTRING (name)->data)) >= 0)
     /* This fontset already exists on frame F.  */
     return fontset;
@@ -348,21 +351,21 @@ fs_register_fontset (f, fontset_info)
       fontsetp->font_indexes[i] = FONT_NOT_OPENED;
     }
 
-  for (fontlist = XCONS (fontset_info)->cdr; CONSP (fontlist);
-       fontlist = XCONS (fontlist)->cdr)
+  for (fontlist = XCDR (fontset_info); CONSP (fontlist);
+       fontlist = XCDR (fontlist))
     {
       Lisp_Object tem = Fcar (fontlist);
       int charset;
 
       if (CONSP (tem)
-         && (charset = get_charset_id (XCONS (tem)->car)) >= 0
-         && STRINGP (XCONS (tem)->cdr))
+         && (charset = get_charset_id (XCAR (tem))) >= 0
+         && STRINGP (XCDR (tem)))
        {
          fontsetp->fontname[charset]
-            = (char *) xmalloc (XSTRING (XCONS (tem)->cdr)->size + 1);
-         bcopy (XSTRING (XCONS (tem)->cdr)->data,
+            = (char *) xmalloc (XSTRING (XCDR (tem))->size + 1);
+         bcopy (XSTRING (XCDR (tem))->data,
                 fontsetp->fontname[charset],
-                XSTRING (XCONS (tem)->cdr)->size + 1);
+                XSTRING (XCDR (tem))->size + 1);
        }
       else
        /* Broken or invalid data structure.  */
@@ -397,8 +400,8 @@ fs_register_fontset (f, fontset_info)
    the corresponding regular expression.  */
 static Lisp_Object Vcached_fontset_data;
 
-#define CACHED_FONTSET_NAME (XSTRING (XCONS (Vcached_fontset_data)->car)->data)
-#define CACHED_FONTSET_REGEX (XCONS (Vcached_fontset_data)->cdr)
+#define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
+#define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
 
 /* If fontset name PATTERN contains any wild card, return regular
    expression corresponding to PATTERN.  */
@@ -429,7 +432,7 @@ fontset_pattern_regexp (pattern)
              *p1++ = '*';
            }
          else if (*p0 == '?')
-           *p1++ == '.';
+           *p1++ = '.';
          else
            *p1++ = *p0;
        }
@@ -443,12 +446,14 @@ fontset_pattern_regexp (pattern)
   return CACHED_FONTSET_REGEX;
 }
 
-DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 1, 0,
-  "Return a fontset name which matches PATTERN, nil if no matching fontset.\n\
-PATTERN can contain `*' or `?' as a wild card\n\
-just like X's font name matching algorithm allows.")
-  (pattern)
-     Lisp_Object pattern;
+DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
+  "Return the name of an existing fontset which matches PATTERN.\n\
+The value is nil if there is no matching fontset.\n\
+PATTERN can contain `*' or `?' as a wildcard\n\
+just as X font name matching algorithm allows.\n\
+If REGEXPP is non-nil, PATTERN is a regular expression.")
+  (pattern, regexpp)
+     Lisp_Object pattern, regexpp;
 {
   Lisp_Object regexp, tem;
 
@@ -463,11 +468,14 @@ just like X's font name matching algorithm allows.")
   if (!NILP (tem))
     return Fcar (tem);
 
-  regexp = fontset_pattern_regexp (pattern);
+  if (NILP (regexpp))
+    regexp = fontset_pattern_regexp (pattern);
+  else
+    regexp = pattern;
 
-  for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
+  for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
     {
-      Lisp_Object fontset_name = XCONS (XCONS (tem)->car)->car;
+      Lisp_Object fontset_name = XCAR (XCAR (tem));
       if (!NILP (regexp))
        {
          if (fast_c_string_match_ignore_case (regexp,
@@ -486,8 +494,6 @@ just like X's font name matching algorithm allows.")
   return Qnil;
 }
 
-Lisp_Object Fframe_char_width ();
-
 /* Return a list of names of available fontsets matching PATTERN on
    frame F.  If SIZE is not 0, it is the size (maximum bound width) of
    fontsets to be listed. */
@@ -562,20 +568,20 @@ FONTLIST is an alist of charsets vs corresponding font names.")
   CHECK_STRING (name, 0);
   CHECK_LIST (fontlist, 1);
 
-  fullname = Fquery_fontset (name);
+  fullname = Fquery_fontset (name, Qnil);
   if (!NILP (fullname))
-    error ("Fontset \"%s\" matches the existing fontset \"%s\"",
+    error ("Fontset `%s' matches the existing fontset `%s'",
           XSTRING (name)->data, XSTRING (fullname)->data);
 
   /* Check the validity of FONTLIST.  */
-  for (tail = fontlist; CONSP (tail); tail = XCONS (tail)->cdr)
+  for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
     {
-      Lisp_Object tem = XCONS (tail)->car;
+      Lisp_Object tem = XCAR (tail);
       int charset;
 
       if (!CONSP (tem)
-         || (charset = get_charset_id (XCONS (tem)->car)) < 0
-         || !STRINGP (XCONS (tem)->cdr))
+         || (charset = get_charset_id (XCAR (tem))) < 0
+         || !STRINGP (XCDR (tem)))
        error ("Elements of fontlist must be a cons of charset and font name");
     }
 
@@ -594,7 +600,6 @@ FONTLIST is an alist of charsets vs corresponding font names.")
   return Qnil;
 }
 
-extern Lisp_Object Fframe_parameters ();
 extern Lisp_Object Qfont;
 Lisp_Object Qfontset;
 
@@ -618,23 +623,23 @@ If FRAME is omitted or nil, all frames are affected.")
   if ((charset = get_charset_id (charset_symbol)) < 0)
     error ("Invalid charset: %s", XSYMBOL (charset_symbol)->name->data);
 
-  fullname = Fquery_fontset (name);
+  fullname = Fquery_fontset (name, Qnil);
   if (NILP (fullname))
-    error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+    error ("Fontset `%s' does not exist", XSTRING (name)->data);
 
   /* If FRAME is not specified, we must, at first, update contents of
      `global-fontset-alist' for a frame created in the future.  */
   if (NILP (frame))
     {
       Lisp_Object fontset_info = Fassoc (fullname, Vglobal_fontset_alist);
-      Lisp_Object tem = Fassq (charset_symbol, XCONS (fontset_info)->cdr);
+      Lisp_Object tem = Fassq (charset_symbol, XCDR (fontset_info));
 
       if (NILP (tem))
-       XCONS (fontset_info)->cdr
+       XCDR (fontset_info)
          = Fcons (Fcons (charset_symbol, fontname),
-                  XCONS (fontset_info)->cdr);
+                  XCDR (fontset_info));
       else
-       XCONS (tem)->cdr = fontname;
+       XCDR (tem) = fontname;
     }
 
   /* Then, update information in the specified frame or all existing
@@ -666,7 +671,7 @@ If FRAME is omitted or nil, all frames are affected.")
              if (set_frame_fontset_func
                  && !NILP (font_param)
                  && !strcmp (XSTRING (fullname)->data,
-                             XSTRING (XCONS (font_param)->cdr)->data))
+                             XSTRING (XCDR (font_param))->data))
                /* This fontset is the default fontset on frame TEM.
                   We may have to resize this frame because of new
                   ASCII font.  */
@@ -704,12 +709,9 @@ If the named font is not yet loaded, return nil.")
 
   CHECK_STRING (name, 0);
   if (NILP (frame))
-    f = selected_frame;
-  else
-    {
-      CHECK_LIVE_FRAME (frame, 1);
-      f = XFRAME (frame);
-    }
+    frame = selected_frame;
+  CHECK_LIVE_FRAME (frame, 1);
+  f = XFRAME (frame);
 
   if (!query_font_func)
     error ("Font query function is not supported");
@@ -718,7 +720,7 @@ If the named font is not yet loaded, return nil.")
   if (!fontp)
     return Qnil;
 
-  info = Fmake_vector (make_number (7), Qnil);
+  info = Fmake_vector (make_number (8), Qnil);
 
   XVECTOR (info)->contents[0] = build_string (fontp->name);
   XVECTOR (info)->contents[1] = build_string (fontp->full_name);
@@ -756,16 +758,13 @@ loading failed.")
 
   CHECK_STRING(name, 0);
   if (NILP (frame))
-    f = selected_frame;
-  else
-    {
-      CHECK_LIVE_FRAME (frame, 1);
-      f = XFRAME (frame);
-    }
+    frame = selected_frame;
+  CHECK_LIVE_FRAME (frame, 1);
+  f = XFRAME (frame);
 
   fontset = fs_query_fontset (f, XSTRING (name)->data);
   if (fontset < 0)
-    error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+    error ("Fontset `%s' does not exist", XSTRING (name)->data);
 
   info = Fmake_vector (make_number (3), Qnil);
 
@@ -796,6 +795,7 @@ loading failed.")
   return info;
 }
 
+void
 syms_of_fontset ()
 {
   int i;
@@ -832,16 +832,27 @@ ENCODING is one of the following integer values:\n\
   Vfont_encoding_alist = Qnil;
 
   DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
-     "Char table of characters of which ascent values should be ignored.\n\
+     "Char table of characters whose ascent values should be ignored.\n\
 If an entry for a character is non-nil, the ascent value of the glyph\n\
-is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.");
+is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
+\n\
+This affects how a composite character which contains\n\
+such a character is displayed on screen.");
+  Vuse_default_ascent = Qnil;
+
+  DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
+     "Char table of characters which is not composed relatively.\n\
+If an entry for a character is non-nil, a composite character\n\
+which contains that character is displayed so that\n\
+the glyph of that character is put without considering\n\
+an ascent and descent value of a previous character.");
   Vuse_default_ascent = Qnil;
 
-  DEFVAR_LISP ("alternative-fontname-alist", &Valternative_fontname_alist,
-     "Alist of fontname vs list of the alternative fontnames.\n\
-When no font can be opened by a fontname, the corresponding\n\
-alternative fontnames are tried.");
-  Valternative_fontname_alist = Qnil;
+  DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
+     "Alist of fontname vs list of the alternate fontnames.\n\
+When a specified font name is not found, the corresponding\n\
+alternate fontnames (if any) are tried instead.");
+  Valternate_fontname_alist = Qnil;
 
   DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
      "Alist of fontset names vs the aliases.");
@@ -850,21 +861,19 @@ alternative fontnames are tried.");
   DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font,
      "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
 The way to highlight them depends on window system on which Emacs runs.\n\
-On X window, a rectangle is shown around each such character.");
-  Vhighlight_wrong_size_font = Qt;
+On X11, a rectangle is shown around each such character.");
+  Vhighlight_wrong_size_font = Qnil;
 
   DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font,
-     "*Non-nil means characters shown in large size fonts are clipped.\n\
+     "*Non-nil means characters shown in overlarge fonts are clipped.\n\
 The height of clipping area is the same as that of an ASCII character.\n\
-The width of the area is the same as that of an ASCII character or\n\
-twice wider than that of an ASCII character depending on\n\
-the width (i.e. column numbers occupied on screen) of the character set\n\
-of the character.\n\
+The width of the area is the same as that of an ASCII character,\n\
+or twice as wide, depending on the character set's column-width.\n\
 \n\
-In the case that you only have too large size font for a specific\n\
-charscter set, and clipping characters of the character set makes them\n\
-almost unreadable, you can set this variable to t to see the\n\
-characters in exchage for garbage dots left on your screen.");
+If the only font you have for a specific character set is too large,\n\
+and clipping these characters makes them hard to read,\n\
+you can set this variable to nil to display the characters without clipping.\n\
+The drawback is that you will get some garbage left on your screen.");
   Vclip_large_size_font = Qt;
 
   defsubr (&Squery_fontset);