/[emacs]/emacs/src/fontset.c
ViewVC logotype

Diff of /emacs/src/fontset.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.77 by rms, Sat May 17 12:46:53 2003 UTC revision 1.77.4.1 by handa, Mon Sep 8 12:48:11 2003 UTC
# Line 1  Line 1 
1  /* Fontset handler.  /* Fontset handler.
2     Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.     Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
3     Licensed to the Free Software Foundation.       Licensed to the Free Software Foundation.
4       Copyright (C) 2003
5         National Institute of Advanced Industrial Science and Technology (AIST)
6         Registration Number H13PRO009
7    
8  This file is part of GNU Emacs.  This file is part of GNU Emacs.
9    
# Line 28  Boston, MA 02111-1307, USA.  */ Line 31  Boston, MA 02111-1307, USA.  */
31  #endif  #endif
32    
33  #include "lisp.h"  #include "lisp.h"
34    #include "blockinput.h"
35  #include "buffer.h"  #include "buffer.h"
36    #include "character.h"
37  #include "charset.h"  #include "charset.h"
38  #include "ccl.h"  #include "ccl.h"
39  #include "keyboard.h"  #include "keyboard.h"
# Line 37  Boston, MA 02111-1307, USA.  */ Line 42  Boston, MA 02111-1307, USA.  */
42  #include "fontset.h"  #include "fontset.h"
43  #include "window.h"  #include "window.h"
44    
 #ifdef FONTSET_DEBUG  
45  #undef xassert  #undef xassert
46    #ifdef FONTSET_DEBUG
47  #define xassert(X)      do {if (!(X)) abort ();} while (0)  #define xassert(X)      do {if (!(X)) abort ();} while (0)
48  #undef INLINE  #undef INLINE
49  #define INLINE  #define INLINE
50  #endif  #else   /* not FONTSET_DEBUG */
51    #define xassert(X)      (void) 0
52    #endif  /* not FONTSET_DEBUG */
53    
54    EXFUN (Fclear_face_cache, 1);
55    
56  /* FONTSET  /* FONTSET
57    
58     A fontset is a collection of font related information to give     A fontset is a collection of font related information to give
59     similar appearance (style, size, etc) of characters.  There are two     similar appearance (style, etc) of characters.  A fontset has two
60     kinds of fontsets; base and realized.  A base fontset is created by     roles.  One is to use for the frame parameter `font' as if it is an
61     new-fontset from Emacs Lisp explicitly.  A realized fontset is     ASCII font.  In that case, Emacs uses the font specified for
62     created implicitly when a face is realized for ASCII characters.  A     `ascii' script for the frame's default font.
63     face is also realized for multibyte characters based on an ASCII  
64     face.  All of the multibyte faces based on the same ASCII face     Another role, the more important one, is to provide information
65     share the same realized fontset.     about which font to use for each non-ASCII character.
66    
67     A fontset object is implemented by a char-table.     There are two kinds of fontsets; base and realized.  A base fontset
68       is created by `new-fontset' from Emacs Lisp explicitly.  A realized
69     An element of a base fontset is:     fontset is created implicitly when a face is realized for ASCII
70          (INDEX . FONTNAME) or     characters.  A face is also realized for non-ASCII characters based
71          (INDEX . (FOUNDRY . REGISTRY ))     on an ASCII face.  All of non-ASCII faces based on the same ASCII
72     FONTNAME is a font name pattern for the corresponding character.     face share the same realized fontset.
73     FOUNDRY and REGISTRY are respectively foundry and registry fields of  
74     a font name for the corresponding character.  INDEX specifies for     A fontset object is implemented by a char-table whose default value
75     which character (or generic character) the element is defined.  It     and parent are always nil.
76     may be different from an index to access this element.  For  
77     instance, if a fontset defines some font for all characters of     An element of a base fontset is a vector of FONT-DEFs which itself
78     charset `japanese-jisx0208', INDEX is the generic character of this     is a vector [ FONT-SPEC ENCODING REPERTORY ].
79     charset.  REGISTRY is the  
80       FONT-SPEC is:
81     An element of a realized fontset is FACE-ID which is a face to use          [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
82     for displaying the corresponding character.     or
83            FONT-NAME
84     All single byte characters (ASCII and 8bit-unibyte) share the same     where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
85     element in a fontset.  The element is stored in the first element     FONT-NAME are strings.
86     of the fontset.  
87       ENCODING is a charset ID or a char-table that can convert
88     To access or set each element, use macros FONTSET_REF and     characters to glyph codes of the corresponding font.
89     FONTSET_SET respectively for efficiency.  
90       REPERTORY is a charset ID or nil.  If REPERTORY is a charset ID,
91     A fontset has 3 extra slots.     the repertory of the charset exactly matches with that of the font.
92       If REPERTORY is nil, we consult with the font itself to get the
93     The 1st slot is an ID number of the fontset.     repertory.
94    
95     The 2nd slot is a name of the fontset.  This is nil for a realized     ENCODING and REPERTORY are extracted from the variable
96     face.     Vfont_encoding_alist by using a font name generated form FONT-SPEC
97       (if it is a vector) or FONT-NAME as a key.
98    
99    
100       An element of a realized fontset is nil or t, or has this form:
101    
102            ( CHARSET-PRIORITY-LIST-TICK . FONT-VECTOR )
103    
104       FONT-VECTOR is a vector whose elements have this form:
105    
106            [ FACE-ID FONT-INDEX FONT-DEF ]
107    
108       FONT-VECTOR is automatically reordered by the current charset
109       priority list.
110    
111       The value nil means that we have not yet generated FONT-VECTOR from
112       the base of the fontset.
113    
114       The value t means that no font is available for the corresponding
115       range of characters.
116    
117    
118       A fontset has 8 extra slots.
119    
120       The 1st slot: the ID number of the fontset
121    
122       The 2nd slot:
123            base: the name of the fontset
124            realized: nil
125    
126       The 3rd slot:
127            base: nil
128            realized: the base fontset
129    
130       The 4th slot:
131            base: nil
132            realized: the frame that the fontset belongs to
133    
134     The 3rd slot is a frame that the fontset belongs to.  This is nil     The 5th slot:
135     for a default face.          base: the font name for ASCII characters
136            realized: nil
137    
138     A parent of a base fontset is nil.  A parent of a realized fontset     The 6th slot:
139     is a base fontset.          base: nil
140            realized: the ID number of a face to use for characters that
141                      has no font in a realized fontset.
142    
143     All fontsets are recorded in Vfontset_table.     The 7th slot:
144            base: nil
145            realized: Alist of font index vs the corresponding repertory
146            char-table.
147            
148       The 8th slot:
149            base: nil
150            realized: If the base is not the default fontset, a fontset
151            realized from the default fontset, else nil.
152    
153       All fontsets are recorded in the vector Vfontset_table.
154    
155    
156     DEFAULT FONTSET     DEFAULT FONTSET
157    
158     There's a special fontset named `default fontset' which defines a     There's a special base fontset named `default fontset' which
159     default fontname pattern.  When a base fontset doesn't specify a     defines the default font specifications.  When a base fontset
160     font for a specific character, the corresponding value in the     doesn't specify a font for a specific character, the corresponding
161     default fontset is used.  The format is the same as a base fontset.     value in the default fontset is used.
162    
163     The parent of a realized fontset created for such a face that has     The parent of a realized fontset created for such a face that has
164     no fontset is the default fontset.     no fontset is the default fontset.
# Line 109  Boston, MA 02111-1307, USA.  */ Line 166  Boston, MA 02111-1307, USA.  */
166    
167     These structures are hidden from the other codes than this file.     These structures are hidden from the other codes than this file.
168     The other codes handle fontsets only by their ID numbers.  They     The other codes handle fontsets only by their ID numbers.  They
169     usually use variable name `fontset' for IDs.  But, in this file, we     usually use the variable name `fontset' for IDs.  But, in this
170     always use variable name `id' for IDs, and name `fontset' for the     file, we always use varialbe name `id' for IDs, and name `fontset'
171     actual fontset objects.     for an actual fontset object, i.e., char-table.
172    
173  */  */
174    
175  /********** VARIABLES and FUNCTION PROTOTYPES **********/  /********** VARIABLES and FUNCTION PROTOTYPES **********/
176    
177  extern Lisp_Object Qfont;  extern Lisp_Object Qfont;
178  Lisp_Object Qfontset;  static Lisp_Object Qfontset;
179    static Lisp_Object Qfontset_info;
180    static Lisp_Object Qprepend, Qappend;
181    
182  /* Vector containing all fontsets.  */  /* Vector containing all fontsets.  */
183  static Lisp_Object Vfontset_table;  static Lisp_Object Vfontset_table;
# Line 128  static Lisp_Object Vfontset_table; Line 187  static Lisp_Object Vfontset_table;
187  static int next_fontset_id;  static int next_fontset_id;
188    
189  /* The default fontset.  This gives default FAMILY and REGISTRY of  /* The default fontset.  This gives default FAMILY and REGISTRY of
190     font for each characters.  */     font for each character.  */
191  static Lisp_Object Vdefault_fontset;  static Lisp_Object Vdefault_fontset;
192    
193  Lisp_Object Vfont_encoding_alist;  Lisp_Object Vfont_encoding_alist;
# Line 169  void (*set_frame_fontset_func) P_ ((FRAM Line 228  void (*set_frame_fontset_func) P_ ((FRAM
228     This function set the member `encoder' of the structure.  */     This function set the member `encoder' of the structure.  */
229  void (*find_ccl_program_func) P_ ((struct font_info *));  void (*find_ccl_program_func) P_ ((struct font_info *));
230    
231    Lisp_Object (*get_font_repertory_func) P_ ((struct frame *,
232                                                struct font_info *));
233    
234  /* Check if any window system is used now.  */  /* Check if any window system is used now.  */
235  void (*check_window_system_func) P_ ((void));  void (*check_window_system_func) P_ ((void));
236    
237    
238  /* Prototype declarations for static functions.  */  /* Prototype declarations for static functions.  */
239  static Lisp_Object fontset_ref P_ ((Lisp_Object, int));  static Lisp_Object fontset_add P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
240  static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));                                      Lisp_Object));
241  static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));  static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 static int fontset_id_valid_p P_ ((int));  
242  static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));  static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
243  static Lisp_Object font_family_registry P_ ((Lisp_Object, int));  static void accumulate_script_ranges P_ ((Lisp_Object, Lisp_Object,
244                                              Lisp_Object));
245    static Lisp_Object find_font_encoding P_ ((char *));
246    
247    #ifdef FONTSET_DEBUG
248    
249    /* Return 1 if ID is a valid fontset id, else return 0.  */
250    
251    static int
252    fontset_id_valid_p (id)
253         int id;
254    {
255      return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
256    }
257    
258    #endif
259    
260    
261    
262  /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/  /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
# Line 189  static Lisp_Object font_family_registry Line 266  static Lisp_Object font_family_registry
266    
267  /* Macros to access special values of FONTSET.  */  /* Macros to access special values of FONTSET.  */
268  #define FONTSET_ID(fontset)             XCHAR_TABLE (fontset)->extras[0]  #define FONTSET_ID(fontset)             XCHAR_TABLE (fontset)->extras[0]
 #define FONTSET_NAME(fontset)           XCHAR_TABLE (fontset)->extras[1]  
 #define FONTSET_FRAME(fontset)          XCHAR_TABLE (fontset)->extras[2]  
 #define FONTSET_ASCII(fontset)          XCHAR_TABLE (fontset)->contents[0]  
 #define FONTSET_BASE(fontset)           XCHAR_TABLE (fontset)->parent  
269    
270  #define BASE_FONTSET_P(fontset)         NILP (FONTSET_BASE(fontset))  /* Macros to access special values of (base) FONTSET.  */
271    #define FONTSET_NAME(fontset)           XCHAR_TABLE (fontset)->extras[1]
272    #define FONTSET_ASCII(fontset)          XCHAR_TABLE (fontset)->extras[4]
 /* Return the element of FONTSET (char-table) at index C (character).  */  
273    
274  #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)  /* Macros to access special values of (realized) FONTSET.  */
275    #define FONTSET_BASE(fontset)           XCHAR_TABLE (fontset)->extras[2]
276    #define FONTSET_FRAME(fontset)          XCHAR_TABLE (fontset)->extras[3]
277    #define FONTSET_NOFONT_FACE(fontset)    XCHAR_TABLE (fontset)->extras[5]
278    #define FONTSET_REPERTORY(fontset)      XCHAR_TABLE (fontset)->extras[6]
279    #define FONTSET_FALLBACK(fontset)       XCHAR_TABLE (fontset)->extras[7]
280    
281    #define BASE_FONTSET_P(fontset)         (NILP (FONTSET_BASE (fontset)))
282    
283    
284    /* Return the element of FONTSET for the character C.  If FONTSET is a
285       base fontset other then the default fontset and FONTSET doesn't
286       contain information for C, return the information in the default
287       fontset.  */
288    
289    #define FONTSET_REF(fontset, c)         \
290      (EQ (fontset, Vdefault_fontset)       \
291       ? CHAR_TABLE_REF (fontset, c)        \
292       : fontset_ref ((fontset), (c)))
293    
294  static Lisp_Object  static Lisp_Object
295  fontset_ref (fontset, c)  fontset_ref (fontset, c)
296       Lisp_Object fontset;       Lisp_Object fontset;
297       int c;       int c;
298  {  {
299    int charset, c1, c2;    Lisp_Object elt;
   Lisp_Object elt, defalt;  
   
   if (SINGLE_BYTE_CHAR_P (c))  
     return FONTSET_ASCII (fontset);  
300    
301    SPLIT_CHAR (c, charset, c1, c2);    elt = CHAR_TABLE_REF (fontset, c);
302    elt = XCHAR_TABLE (fontset)->contents[charset + 128];    if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
303    if (!SUB_CHAR_TABLE_P (elt))        /* Don't check Vdefault_fontset for a realized fontset.  */
304      return elt;        && NILP (FONTSET_BASE (fontset)))
305    defalt = XCHAR_TABLE (elt)->defalt;      elt = CHAR_TABLE_REF (Vdefault_fontset, c);
   if (c1 < 32  
       || (elt = XCHAR_TABLE (elt)->contents[c1],  
           NILP (elt)))  
     return defalt;  
   if (!SUB_CHAR_TABLE_P (elt))  
     return elt;  
   defalt = XCHAR_TABLE (elt)->defalt;  
   if (c2 < 32  
       || (elt = XCHAR_TABLE (elt)->contents[c2],  
           NILP (elt)))  
     return defalt;  
306    return elt;    return elt;
307  }  }
308    
309    
310  #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)  /* Return the element of FONTSET for the character C, set FROM and TO
311       to the range of characters around C that have the same value as C.
312       If FONTSET is a base fontset other then the default fontset and
313       FONTSET doesn't contain information for C, return the information
314       in the default fontset.  */
315    
316    #define FONTSET_REF_AND_RANGE(fontset, c, form, to)     \
317      (EQ (fontset, Vdefault_fontset)                       \
318       ? char_table_ref_and_range (fontset, c, &from, &to)  \
319       : fontset_ref_and_range (fontset, c, &from, &to))
320    
321  static Lisp_Object  static Lisp_Object
322  fontset_ref_via_base (fontset, c)  fontset_ref_and_range (fontset, c, from, to)
323       Lisp_Object fontset;       Lisp_Object fontset;
324       int *c;       int c;
325         int *from, *to;
326  {  {
   int charset, c1, c2;  
327    Lisp_Object elt;    Lisp_Object elt;
328    
329    if (SINGLE_BYTE_CHAR_P (*c))    elt = char_table_ref_and_range (fontset, c, from, to);
330      return FONTSET_ASCII (fontset);    if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
331          /* Don't check Vdefault_fontset for a realized fontset.  */
332          && NILP (FONTSET_BASE (fontset)))
333        {
334          int from1, to1;
335    
336          elt = char_table_ref_and_range (Vdefault_fontset, c, &from1, &to1);
337          if (*from < from1)
338            *from = from1;
339          if (*to > to1)
340            *to = to1;
341        }
342      return elt;
343    }
344    
345    
346    elt = FONTSET_REF (FONTSET_BASE (fontset), *c);  /* Set elements of FONTSET for characters in RANGE to the value ELT.
347    if (NILP (elt) && ! EQ (fontset, Vdefault_fontset))     RANGE is a cons (FROM . TO), where FROM and TO are character codes
348      elt = FONTSET_REF (Vdefault_fontset, *c);     specifying a range.  */
349    if (NILP (elt))  
350      return Qnil;  #define FONTSET_SET(fontset, range, elt)        \
351      Fset_char_table_range ((fontset), (range), (elt))
352    
353    
354    /* Modify the elements of FONTSET for characters in RANGE by replacing
355       with ELT or adding ETL.  RANGE is a cons (FROM . TO), where FROM
356       and TO are character codes specifying a range.  If ADD is nil,
357       replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
358       append ELT.  */
359    
360    #define FONTSET_ADD(fontset, range, elt, add)                           \
361      (NILP (add)                                                           \
362       ? Fset_char_table_range ((fontset), (range),                         \
363                                Fmake_vector (make_number (1), (elt)))      \
364       : fontset_add ((fontset), (range), (elt), (add)))
365    
366    *c = XINT (XCAR (elt));  static Lisp_Object
367    SPLIT_CHAR (*c, charset, c1, c2);  fontset_add (fontset, range, elt, add)
368    elt = XCHAR_TABLE (fontset)->contents[charset + 128];       Lisp_Object fontset, range, elt, add;
369    if (c1 < 32)  {
370      return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);    int from, to, from1, to1;
371    if (!SUB_CHAR_TABLE_P (elt))    Lisp_Object elt1;
372      return Qnil;  
373    elt = XCHAR_TABLE (elt)->contents[c1];    from = XINT (XCAR (range));
374    if (c2 < 32)    to = XINT (XCDR (range));
375      return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);    do {
376    if (!SUB_CHAR_TABLE_P (elt))      elt1 = char_table_ref_and_range (fontset, from, &from1, &to1);
377      return Qnil;      if (to < to1)
378    elt = XCHAR_TABLE (elt)->contents[c2];        to1 = to;
379    return elt;      if (NILP (elt1))
380          elt1 = Fmake_vector (make_number (1), elt);
381        else
382          {
383            int i, i0 = 1, i1 = ASIZE (elt1) + 1;
384            Lisp_Object new;
385    
386            new = Fmake_vector (make_number (i1), elt);
387            if (EQ (add, Qappend))
388              i0--, i1--;
389            for (i = 0; i0 < i1; i++, i0++)
390              ASET (new, i0, AREF (elt1, i));
391            elt1 = new;
392          }
393        char_table_set_range (fontset, from, to1, elt1);
394        from = to1 + 1;
395      } while (from < to);
396      return Qnil;
397  }  }
398    
399    
400  /* Store into the element of FONTSET at index C the value NEWELT.  */  /* Update FONTSET_ELEMENT which has this form:
401  #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)          ( CHARSET-PRIORITY-LIST-TICK . FONT-VECTOR).
402       Reorder FONT-VECTOR according to the current order of charset
403       (Vcharset_ordered_list), and update CHARSET-PRIORITY-LIST-TICK to
404       the latest value.  */
405    
406  static void  static void
407  fontset_set (fontset, c, newelt)  reorder_font_vector (fontset_element)
408         Lisp_Object fontset_element;
409    {
410      Lisp_Object vec, list, *new_vec;
411      int size;
412      int *charset_id_table;
413      int i, idx;
414    
415      XSETCAR (fontset_element, make_number (charset_ordered_list_tick));
416      vec = XCDR (fontset_element);
417      size = ASIZE (vec);
418      if (size < 2)
419        /* No need of reordering VEC.  */
420        return;
421      charset_id_table = (int *) alloca (sizeof (int) * size);
422      new_vec = (Lisp_Object *) alloca (sizeof (Lisp_Object) * size);
423      /* At first, extract ENCODING (a chaset ID) from VEC.  VEC has this
424         form:
425            [[FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] ...] */
426      for (i = 0; i < size; i++)
427        charset_id_table[i] = XINT (AREF (AREF (AREF (vec, i), 2), 1));
428    
429      /* Then, store the elements of VEC in NEW_VEC in the correct
430         order.  */
431      idx = 0;
432      for (list = Vcharset_ordered_list; CONSP (list); list = XCDR (list))
433        {
434          for (i = 0; i < size; i++)
435            if (charset_id_table[i] == XINT (XCAR (list)))
436              new_vec[idx++] = AREF (vec, i);
437          if (idx == size)
438            break;
439        }
440    
441      /* At last, update VEC.  */
442      for (i = 0; i < size; i++)
443        ASET (vec, i, new_vec[i]);
444    }
445    
446    
447    /* Load a font matching the font related attributes in FACE->lface and
448       font pattern in FONT_DEF of FONTSET, and return an index of the
449       font.  FONT_DEF has this form:
450            [ FONT-SPEC ENCODING REPERTORY ]
451       If REPERTORY is nil, generate a char-table representing the font
452       repertory by looking into the font itself.  */
453    
454    static int
455    load_font_get_repertory (f, face, font_def, fontset)
456         FRAME_PTR f;
457         struct face *face;
458         Lisp_Object font_def;
459         Lisp_Object fontset;
460    {
461      char *font_name;
462      struct font_info *font_info;
463    
464      font_name = choose_face_font (f, face->lface, AREF (font_def, 0), NULL);
465      if (! (font_info = fs_load_font (f, font_name, XINT (AREF (font_def, 1)))))
466        return -1;
467    
468      if (NILP (AREF (font_def, 2))
469          && NILP (Fassq (make_number (font_info->font_idx),
470                          FONTSET_REPERTORY (fontset))))
471        {
472          /* We must look into the font to get the correct repertory as a
473             char-table.  */
474          Lisp_Object repertory;
475    
476          repertory = (*get_font_repertory_func) (f, font_info);
477          FONTSET_REPERTORY (fontset)
478            = Fcons (Fcons (make_number (font_info->font_idx), repertory),
479                     FONTSET_REPERTORY (fontset));
480        }
481            
482      return font_info->font_idx;
483    }
484    
485    
486    /* Return a face ID registerd in the realized fontset FONTSET for the
487       character C.  If FACE is NULL, return -1 if a face is not yet
488       set.  Otherwise, realize a proper face from FACE and return it.  */
489    
490    static int
491    fontset_face (fontset, c, face)
492       Lisp_Object fontset;       Lisp_Object fontset;
493       int c;       int c;
494       Lisp_Object newelt;       struct face *face;
495  {  {
496    int charset, code[3];    Lisp_Object base_fontset, elt, vec;
497    Lisp_Object *elt;    int i, from, to;
498    int i;    int font_idx;
499      FRAME_PTR f = XFRAME (FONTSET_FRAME (fontset));
500    
501    if (SINGLE_BYTE_CHAR_P (c))    base_fontset = FONTSET_BASE (fontset);
502      elt = CHAR_TABLE_REF (fontset, c);
503    
504      if (EQ (elt, Qt))
505        goto try_default;
506    
507      if (NILP (elt))
508      {      {
509        FONTSET_ASCII (fontset) = newelt;        /* We have not yet decided a face for C.  */
510        return;        Lisp_Object range;
511    
512          if (! face)
513            return -1;
514          elt = FONTSET_REF_AND_RANGE (base_fontset, c, from, to);
515          range = Fcons (make_number (from), make_number (to));
516          if (NILP (elt))
517            {
518              /* Record that we have no font for characters of this
519                 range.  */
520              FONTSET_SET (fontset, range, Qt);
521              goto try_default;
522            }
523          elt = Fcopy_sequence (elt);
524          /* Now ELT is a vector of FONT-DEFs.  We at first change it to
525             FONT-VECTOR, a vector of [ nil nil FONT-DEF ].  */
526          for (i = 0; i < ASIZE (elt); i++)
527            {
528              Lisp_Object tmp;
529    
530              tmp = Fmake_vector (make_number (3), Qnil);
531              ASET (tmp, 2, AREF (elt, i));
532              ASET (elt, i, tmp);
533            }
534          /* Then store (-1 . FONT-VECTOR) in the fontset.  -1 is to force
535             reordering of FONT-VECTOR.  */
536          elt = Fcons (make_number (-1), elt);
537          FONTSET_SET (fontset, range, elt);
538        }
539    
540      if (XINT (XCAR (elt)) != charset_ordered_list_tick)
541        /* The priority of charsets is changed after we selected a face
542           for C last time.  */
543        reorder_font_vector (elt);
544    
545      vec = XCDR (elt);
546      /* Find the first available font in the font vector VEC.  */
547      for (i = 0; i < ASIZE (vec); i++)
548        {
549          Lisp_Object font_def;
550    
551          elt = AREF (vec, i);
552          /* ELT == [ FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ] ] */
553          font_def = AREF (elt, 2);
554          if (INTEGERP (AREF (elt, 1)) && XINT (AREF (elt, 1)) < 0)
555            /* We couldn't open this font last time.  */
556            continue;
557    
558          if (!face && (NILP (AREF (elt, 1)) || NILP (AREF (elt, 0))))
559            /* We have not yet opened the font, or we have not yet made a
560               realized face for the font.  */
561            return -1;
562    
563          if (INTEGERP (AREF (font_def, 2)))
564            {
565              /* The repertory is specified by charset ID.  */
566              struct charset *charset
567                = CHARSET_FROM_ID (XINT (AREF (font_def, 2)));
568    
569              if (! CHAR_CHARSET_P (c, charset))
570                /* This font can't display C.  */
571                continue;
572            }
573          else
574            {
575              Lisp_Object slot;
576    
577              if (! INTEGERP (AREF (elt, 1)))
578                {
579                  /* We have not yet opened a font matching this spec.
580                     Open the best matching font now and register the
581                     repertory.  */
582                  font_idx = load_font_get_repertory (f, face, font_def, fontset);
583                  ASET (elt, 1, make_number (font_idx));
584                  if (font_idx < 0)
585                    /* This means that we couldn't find a font matching
586                       FONT_DEF.  */
587                    continue;
588                }
589    
590              slot = Fassq (AREF (elt, 1), FONTSET_REPERTORY (fontset));
591              if (! CONSP (slot))
592                abort ();
593              if (NILP (CHAR_TABLE_REF (XCDR (slot), c)))
594                /* This fond can't display C.  */
595                continue;
596            }
597    
598          /* Now we have decided to use this font spec to display C.  */
599          if (INTEGERP (AREF (elt, 1)))
600            font_idx = XINT (AREF (elt, 1));
601          else
602            {
603              /* But not yet opened the best matching font.  */
604              font_idx = load_font_get_repertory (f, face, font_def, fontset);
605              ASET (elt, 1, make_number (font_idx));
606              if (font_idx < 0)
607                continue;
608            }
609    
610          /* Now we have the opened font.  */
611          if (NILP (AREF (elt, 0)))
612            {
613              /* But not yet made a realized face that uses this font.  */
614              int face_id = lookup_non_ascii_face (f, font_idx, face);
615    
616              ASET (elt, 0, make_number (face_id));
617            }
618    
619          /* Ok, this face can display C.  */
620          return XINT (AREF (elt, 0));
621      }      }
622    
623    SPLIT_CHAR (c, charset, code[0], code[1]);   try_default:
624    code[2] = 0;                  /* anchor */    if (! EQ (base_fontset, Vdefault_fontset))
625    elt = &XCHAR_TABLE (fontset)->contents[charset + 128];      return fontset_face (FONTSET_FALLBACK (fontset), c, face);
626    for (i = 0; code[i] > 0; i++)  
627      /* We have tried all the fonts for C, but none of them can be opened
628         nor can display C.  */
629      if (NILP (FONTSET_NOFONT_FACE (fontset)))
630      {      {
631        if (!SUB_CHAR_TABLE_P (*elt))        int face_id;
632          *elt = make_sub_char_table (*elt);  
633        elt = &XCHAR_TABLE (*elt)->contents[code[i]];        if (! face)
634            return -1;
635          face_id = lookup_non_ascii_face (f, -1, face);
636          FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
637      }      }
638    if (SUB_CHAR_TABLE_P (*elt))    return XINT (FONTSET_NOFONT_FACE (fontset));
     XCHAR_TABLE (*elt)->defalt = newelt;  
   else  
     *elt = newelt;  
639  }  }
640    
641    
642  /* Return a newly created fontset with NAME.  If BASE is nil, make a  /* Return a newly created fontset with NAME.  If BASE is nil, make a
643     base fontset.  Otherwise make a realized fontset whose parent is     base fontset.  Otherwise make a realized fontset whose base is
644     BASE.  */     BASE.  */
645    
646  static Lisp_Object  static Lisp_Object
# Line 324  make_fontset (frame, name, base) Line 660  make_fontset (frame, name, base)
660    
661    if (id + 1 == size)    if (id + 1 == size)
662      {      {
663          /* We must grow Vfontset_table.  */
664        Lisp_Object tem;        Lisp_Object tem;
665        int i;        int i;
666    
667        tem = Fmake_vector (make_number (size + 8), Qnil);        tem = Fmake_vector (make_number (size + 32), Qnil);
668        for (i = 0; i < size; i++)        for (i = 0; i < size; i++)
669          AREF (tem, i) = AREF (Vfontset_table, i);          AREF (tem, i) = AREF (Vfontset_table, i);
670        Vfontset_table = tem;        Vfontset_table = tem;
# Line 336  make_fontset (frame, name, base) Line 673  make_fontset (frame, name, base)
673    fontset = Fmake_char_table (Qfontset, Qnil);    fontset = Fmake_char_table (Qfontset, Qnil);
674    
675    FONTSET_ID (fontset) = make_number (id);    FONTSET_ID (fontset) = make_number (id);
676    FONTSET_NAME (fontset) = name;    if (NILP (base))
677    FONTSET_FRAME (fontset) = frame;      {
678    FONTSET_BASE (fontset) = base;        FONTSET_NAME (fontset) = name;
679        }
680      else
681        {
682          FONTSET_NAME (fontset) = Qnil;
683          FONTSET_FRAME (fontset) = frame;
684          FONTSET_BASE (fontset) = base;
685        }
686    
687    AREF (Vfontset_table, id) = fontset;    ASET (Vfontset_table, id, fontset);
688    next_fontset_id = id + 1;    next_fontset_id = id + 1;
689      if (! NILP (base) && ! EQ (base, Vdefault_fontset))
690        FONTSET_FALLBACK (fontset) = make_fontset (frame, Qnil, Vdefault_fontset);
691    return fontset;    return fontset;
692  }  }
693    
694    
 /* Return 1 if ID is a valid fontset id, else return 0.  */  
   
 static INLINE int  
 fontset_id_valid_p (id)  
      int id;  
 {  
   return (id >= 0 && id < ASIZE (Vfontset_table) - 1);  
 }  
   
   
 /* Extract `family' and `registry' string from FONTNAME and a cons of  
    them.  Actually, `family' may also contain `foundry', `registry'  
    may also contain `encoding' of FONTNAME.  But, if FONTNAME doesn't  
    conform to XLFD nor explicitely specifies the other fields  
    (i.e. not using wildcard `*'), return FONTNAME.  If FORCE is  
    nonzero, specifications of the other fields are ignored, and return  
    a cons as far as FONTNAME conform to XLFD.  */  
   
 static Lisp_Object  
 font_family_registry (fontname, force)  
      Lisp_Object fontname;  
      int force;  
 {  
   Lisp_Object family, registry;  
   const char *p = SDATA (fontname);  
   const char *sep[15];  
   int i = 0;  
   
   while (*p && i < 15)  
     if (*p++ == '-')  
       {  
         if (!force && i >= 2 && i <= 11 && *p != '*' && p[1] != '-')  
           return fontname;  
         sep[i++] = p;  
       }  
   if (i != 14)  
     return fontname;  
   
   family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);  
   registry = make_unibyte_string (sep[12], p - sep[12]);  
   return Fcons (family, registry);  
 }  
   
695    
696  /********** INTERFACES TO xfaces.c and dispextern.h **********/  /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
697    
698  /* Return name of the fontset with ID.  */  /* Return the name of the fontset who has ID.  */
699    
700  Lisp_Object  Lisp_Object
701  fontset_name (id)  fontset_name (id)
702       int id;       int id;
703  {  {
704    Lisp_Object fontset;    Lisp_Object fontset;
705    
706    fontset = FONTSET_FROM_ID (id);    fontset = FONTSET_FROM_ID (id);
707    return FONTSET_NAME (fontset);    return FONTSET_NAME (fontset);
708  }  }
709    
710    
711  /* Return ASCII font name of the fontset with ID.  */  /* Return the ASCII font name of the fontset who has ID.  */
712    
713  Lisp_Object  Lisp_Object
714  fontset_ascii (id)  fontset_ascii (id)
715       int id;       int id;
716  {  {
717    Lisp_Object fontset, elt;    Lisp_Object fontset, elt;
718    
719    fontset= FONTSET_FROM_ID (id);    fontset= FONTSET_FROM_ID (id);
720    elt = FONTSET_ASCII (fontset);    elt = FONTSET_ASCII (fontset);
721    return XCDR (elt);    /* It is assured that ELT is always a string (i.e. fontname
722         pattern).  */
723      return elt;
724  }  }
725    
726    
727  /* Free fontset of FACE.  Called from free_realized_face.  */  /* Free fontset of FACE defined on frame F.  Called from
728       free_realized_face.  */
729    
730  void  void
731  free_face_fontset (f, face)  free_face_fontset (f, face)
732       FRAME_PTR f;       FRAME_PTR f;
733       struct face *face;       struct face *face;
734  {  {
735    if (fontset_id_valid_p (face->fontset))    ASET (Vfontset_table, face->fontset, Qnil);
736      {    if (face->fontset < next_fontset_id)
737        AREF (Vfontset_table, face->fontset) = Qnil;      next_fontset_id = face->fontset;
       if (face->fontset < next_fontset_id)  
         next_fontset_id = face->fontset;  
     }  
738  }  }
739    
740    
741  /* Return 1 iff FACE is suitable for displaying character C.  /* Return 1 iff FACE is suitable for displaying character C.
742     Otherwise return 0.  Called from the macro FACE_SUITABLE_FOR_CHAR_P     Otherwise return 0.  Called from the macro FACE_SUITABLE_FOR_CHAR_P
743     when C is not a single byte character..  */     when C is not an ASCII character.  */
744    
745  int  int
746  face_suitable_for_char_p (face, c)  face_suitable_for_char_p (face, c)
747       struct face *face;       struct face *face;
748       int c;       int c;
749  {  {
750    Lisp_Object fontset, elt;    Lisp_Object fontset;
   
   if (SINGLE_BYTE_CHAR_P (c))  
     return (face == face->ascii_face);  
751    
   xassert (fontset_id_valid_p (face->fontset));  
752    fontset = FONTSET_FROM_ID (face->fontset);    fontset = FONTSET_FROM_ID (face->fontset);
753    xassert (!BASE_FONTSET_P (fontset));    return (face->id == fontset_face (fontset, c, NULL));
   
   elt = FONTSET_REF_VIA_BASE (fontset, c);  
   return (!NILP (elt) && face->id == XFASTINT (elt));  
754  }  }
755    
756    
757  /* Return ID of face suitable for displaying character C on frame F.  /* Return ID of face suitable for displaying character C on frame F.
758     The selection of face is done based on the fontset of FACE.  FACE     FACE must be reazlied for ASCII characters in advance.  Called from
759     should already have been realized for ASCII characters.  Called     the macro FACE_FOR_CHAR.  */
    from the macro FACE_FOR_CHAR when C is not a single byte character.  */  
760    
761  int  int
762  face_for_char (f, face, c)  face_for_char (f, face, c)
# Line 467  face_for_char (f, face, c) Line 764  face_for_char (f, face, c)
764       struct face *face;       struct face *face;
765       int c;       int c;
766  {  {
767    Lisp_Object fontset, elt;    Lisp_Object fontset;
768    int face_id;  
769      if (ASCII_CHAR_P (c))
770        return face->ascii_face->id;
771    
772    xassert (fontset_id_valid_p (face->fontset));    xassert (fontset_id_valid_p (face->fontset));
773    fontset = FONTSET_FROM_ID (face->fontset);    fontset = FONTSET_FROM_ID (face->fontset);
774    xassert (!BASE_FONTSET_P (fontset));    xassert (!BASE_FONTSET_P (fontset));
775      return fontset_face (fontset, c, face);
   elt = FONTSET_REF_VIA_BASE (fontset, c);  
   if (!NILP (elt))  
     return XINT (elt);  
   
   /* No face is recorded for C in the fontset of FACE.  Make a new  
      realized face for C that has the same fontset.  */  
   face_id = lookup_face (f, face->lface, c, face);  
   
   /* Record the face ID in FONTSET at the same index as the  
      information in the base fontset.  */  
   FONTSET_SET (fontset, c, make_number (face_id));  
   return face_id;  
776  }  }
777    
778    
# Line 495  face_for_char (f, face, c) Line 782  face_for_char (f, face, c)
782     Called from realize_x_face.  */     Called from realize_x_face.  */
783    
784  int  int
785  make_fontset_for_ascii_face (f, base_fontset_id)  make_fontset_for_ascii_face (f, base_fontset_id, face)
786       FRAME_PTR f;       FRAME_PTR f;
787       int base_fontset_id;       int base_fontset_id;
788         struct face *face;
789  {  {
790    Lisp_Object base_fontset, fontset, frame;    Lisp_Object base_fontset, fontset, frame;
791    
# Line 508  make_fontset_for_ascii_face (f, base_fon Line 796  make_fontset_for_ascii_face (f, base_fon
796        if (!BASE_FONTSET_P (base_fontset))        if (!BASE_FONTSET_P (base_fontset))
797          base_fontset = FONTSET_BASE (base_fontset);          base_fontset = FONTSET_BASE (base_fontset);
798        xassert (BASE_FONTSET_P (base_fontset));        xassert (BASE_FONTSET_P (base_fontset));
799          if (! BASE_FONTSET_P (base_fontset))
800            abort ();
801      }      }
802    else    else
803      base_fontset = Vdefault_fontset;      base_fontset = Vdefault_fontset;
804    
805    fontset = make_fontset (frame, Qnil, base_fontset);    fontset = make_fontset (frame, Qnil, base_fontset);
806    return XINT (FONTSET_ID (fontset));    {
807  }      Lisp_Object elt;
   
   
 /* Return the font name pattern for C that is recorded in the fontset  
    with ID.  If a font name pattern is specified (instead of a cons of  
    family and registry), check if a font can be opened by that pattern  
    to get the fullname.  If a font is opened, return that name.  
    Otherwise, return nil.  If ID is -1, or the fontset doesn't contain  
    information about C, get the registry and encoding of C from the  
    default fontset.  Called from choose_face_font.  */  
   
 Lisp_Object  
 fontset_font_pattern (f, id, c)  
      FRAME_PTR f;  
      int id, c;  
 {  
   Lisp_Object fontset, elt;  
   struct font_info *fontp;  
   
   elt = Qnil;  
   if (fontset_id_valid_p (id))  
     {  
       fontset = FONTSET_FROM_ID (id);  
       xassert (!BASE_FONTSET_P (fontset));  
       fontset = FONTSET_BASE (fontset);  
       elt = FONTSET_REF (fontset, c);  
     }  
   if (NILP (elt))  
     elt = FONTSET_REF (Vdefault_fontset, c);  
808    
809    if (!CONSP (elt))      elt = FONTSET_REF (base_fontset, 0);
810      return Qnil;      elt = Fmake_vector (make_number (3), AREF (elt, 0));
811    if (CONSP (XCDR (elt)))      ASET (elt, 0, make_number (face->id));
812      return XCDR (elt);      ASET (elt, 1, make_number (face->font_info_id));
813        elt = Fcons (make_number (charset_ordered_list_tick),
814    /* The fontset specifies only a font name pattern (not cons of                   Fmake_vector (make_number (1), elt));
815       family and registry).  If a font can be opened by that pattern,      char_table_set_range (fontset, 0, 127, elt);
816       return the name of opened font.  Otherwise return nil.  The    }
817       exception is a font for single byte characters.  In that case, we    return XINT (FONTSET_ID (fontset));
      return a cons of FAMILY and REGISTRY extracted from the opened  
      font name.  */  
   elt = XCDR (elt);  
   xassert (STRINGP (elt));  
   fontp = FS_LOAD_FONT (f, c, SDATA (elt), -1);  
   if (!fontp)  
     return Qnil;  
   
   return font_family_registry (build_string (fontp->full_name),  
                                SINGLE_BYTE_CHAR_P (c));  
818  }  }
819    
820    
# Line 570  fontset_font_pattern (f, id, c) Line 822  fontset_font_pattern (f, id, c)
822  #pragma optimize("", off)  #pragma optimize("", off)
823  #endif  #endif
824    
825  /* Load a font named FONTNAME to display character C on frame F.  /* Load a font named FONTNAME on frame F.  Return a pointer to the
826     Return a pointer to the struct font_info of the loaded font.  If     struct font_info of the loaded font.  If loading fails, return
827     loading fails, return NULL.  If FACE is non-zero and a fontset is     NULL.  CHARSET is an ID of charset to encode characters for this
828     assigned to it, record FACE->id in the fontset for C.  If FONTNAME     font.  If it is -1, find one from Vfont_encoding_alist.  */
    is NULL, the name is taken from the fontset of FACE or what  
    specified by ID.  */  
829    
830  struct font_info *  struct font_info *
831  fs_load_font (f, c, fontname, id, face)  fs_load_font (f, fontname, charset)
832       FRAME_PTR f;       FRAME_PTR f;
      int c;  
833       char *fontname;       char *fontname;
834       int id;       int charset;
      struct face *face;  
835  {  {
   Lisp_Object fontset;  
   Lisp_Object list, elt;  
   int size = 0;  
836    struct font_info *fontp;    struct font_info *fontp;
   int charset = CHAR_CHARSET (c);  
   
   if (face)  
     id = face->fontset;  
   if (id < 0)  
     fontset = Qnil;  
   else  
     fontset = FONTSET_FROM_ID (id);  
   
   if (!NILP (fontset)  
       && !BASE_FONTSET_P (fontset))  
     {  
       elt = FONTSET_REF_VIA_BASE (fontset, c);  
       if (!NILP (elt))  
         {  
           /* A suitable face for C is already recorded, which means  
              that a proper font is already loaded.  */  
           int face_id = XINT (elt);  
   
           xassert (face_id == face->id);  
           face = FACE_FROM_ID (f, face_id);  
           return (*get_font_info_func) (f, face->font_info_id);  
         }  
   
       if (!fontname && charset == CHARSET_ASCII)  
         {  
           elt = FONTSET_ASCII (fontset);  
           fontname = SDATA (XCDR (elt));  
         }  
     }  
837    
838    if (!fontname)    if (!fontname)
839      /* No way to get fontname.  */      /* No way to get fontname.  */
840      return 0;      return NULL;
841    
842    fontp = (*load_font_func) (f, fontname, size);    fontp = (*load_font_func) (f, fontname, 0);
843    if (!fontp)    if (! fontp || fontp->charset >= 0)
844      return 0;      return fontp;
   
   /* Fill in members (charset, vertical_centering, encoding, etc) of  
      font_info structure that are not set by (*load_font_func).  */  
   fontp->charset = charset;  
845    
846    fontp->vertical_centering    fontname = fontp->full_name;
     = (STRINGP (Vvertical_centering_font_regexp)  
        && (fast_c_string_match_ignore_case  
            (Vvertical_centering_font_regexp, fontp->full_name) >= 0));  
847    
848    if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)    if (charset < 0)
849      {      {
850        /* The font itself tells which code points to be used.  Use this        Lisp_Object charset_symbol;
          encoding for all other charsets.  */  
       int i;  
851    
852        fontp->encoding[0] = fontp->encoding[1];        charset_symbol = find_font_encoding (fontname);
853        for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)        if (CONSP (charset_symbol))
854          fontp->encoding[i] = fontp->encoding[1];          charset_symbol = XCAR (charset_symbol);
855          charset = XINT (CHARSET_SYMBOL_ID (charset_symbol));
856      }      }
857    else    fontp->charset = charset;
858      {    fontp->vertical_centering = 0;
859        /* The font itself doesn't have information about encoding.  */    fontp->font_encoder = NULL;
       int i;  
860    
861        fontname = fontp->full_name;    if (charset != charset_ascii)
862        /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),      {
863           others is 1 (i.e. 0x80..0xFF).  */        fontp->vertical_centering
864        fontp->encoding[0] = 0;          = (STRINGP (Vvertical_centering_font_regexp)
865        for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)             && (fast_c_string_match_ignore_case
866          fontp->encoding[i] = 1;                 (Vvertical_centering_font_regexp, fontname) >= 0));
       /* Then override them by a specification in Vfont_encoding_alist.  */  
       for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))  
         {  
           elt = XCAR (list);  
           if (CONSP (elt)  
               && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))  
               && (fast_c_string_match_ignore_case (XCAR (elt), fontname)  
                   >= 0))  
             {  
               Lisp_Object tmp;  
867    
868                for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))        if (find_ccl_program_func)
869                  if (CONSP (XCAR (tmp))          (*find_ccl_program_func) (fontp);
                     && ((i = get_charset_id (XCAR (XCAR (tmp))))  
                         >= 0)  
                     && INTEGERP (XCDR (XCAR (tmp)))  
                     && XFASTINT (XCDR (XCAR (tmp))) < 4)  
                   fontp->encoding[i]  
                     = XFASTINT (XCDR (XCAR (tmp)));  
             }  
         }  
870      }      }
871    
   fontp->font_encoder = (struct ccl_program *) 0;  
   
   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));  
872    return fontp;    return fontp;
873  }  }
874    
# Line 700  fs_load_font (f, c, fontname, id, face) Line 877  fs_load_font (f, c, fontname, id, face)
877  #endif  #endif
878    
879    
880    /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
881       FONTNAME.  ENCODING is a charset symbol that specifies the encoding
882       of the font.  REPERTORY is a charset symbol or nil.  */
883    
884    
885    static Lisp_Object
886    find_font_encoding (fontname)
887         char *fontname;
888    {
889      Lisp_Object tail, elt;
890    
891      for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))
892        {
893          elt = XCAR (tail);
894          if (CONSP (elt)
895              && STRINGP (XCAR (elt))
896              && fast_c_string_match_ignore_case (XCAR (elt), fontname) >= 0
897              && (SYMBOLP (XCDR (elt))
898                  ? CHARSETP (XCDR (elt))
899                  : CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt)))))
900            return (XCDR (elt));
901        }
902      /* We don't know the encoding of this font.  Let's assume Unicode
903         encoding.  */
904      return Qunicode;
905    }
906    
907    
908  /* Cache data used by fontset_pattern_regexp.  The car part is a  /* Cache data used by fontset_pattern_regexp.  The car part is a
909     pattern string containing at least one wild card, the cdr part is     pattern string containing at least one wild card, the cdr part is
910     the corresponding regular expression.  */     the corresponding regular expression.  */
# Line 782  fs_query_fontset (name, regexpp) Line 987  fs_query_fontset (name, regexpp)
987    for (i = 0; i < ASIZE (Vfontset_table); i++)    for (i = 0; i < ASIZE (Vfontset_table); i++)
988      {      {
989        Lisp_Object fontset;        Lisp_Object fontset;
990        const unsigned char *this_name;        unsigned char *this_name;
991    
992        fontset = FONTSET_FROM_ID (i);        fontset = FONTSET_FROM_ID (i);
993        if (NILP (fontset)        if (NILP (fontset)
# Line 826  If REGEXPP is non-nil, PATTERN is a regu Line 1031  If REGEXPP is non-nil, PATTERN is a regu
1031    return FONTSET_NAME (fontset);    return FONTSET_NAME (fontset);
1032  }  }
1033    
1034  /* Return a list of base fontset names matching PATTERN on frame F.  /* Return a list of base fontset names matching PATTERN on frame F.  */
    If SIZE is not 0, it is the size (maximum bound width) of fontsets  
    to be listed.  */  
1035    
1036  Lisp_Object  Lisp_Object
1037  list_fontsets (f, pattern, size)  list_fontsets (f, pattern, size)
# Line 847  list_fontsets (f, pattern, size) Line 1050  list_fontsets (f, pattern, size)
1050    for (id = 0; id < ASIZE (Vfontset_table); id++)    for (id = 0; id < ASIZE (Vfontset_table); id++)
1051      {      {
1052        Lisp_Object fontset;        Lisp_Object fontset;
1053        const unsigned char *name;        unsigned char *name;
1054    
1055        fontset = FONTSET_FROM_ID (id);        fontset = FONTSET_FROM_ID (id);
1056        if (NILP (fontset)        if (NILP (fontset)
# Line 856  list_fontsets (f, pattern, size) Line 1059  list_fontsets (f, pattern, size)
1059          continue;          continue;
1060        name = SDATA (FONTSET_NAME (fontset));        name = SDATA (FONTSET_NAME (fontset));
1061    
1062        if (!NILP (regexp)        if (STRINGP (regexp)
1063            ? (fast_c_string_match_ignore_case (regexp, name) < 0)            ? (fast_c_string_match_ignore_case (regexp, name) < 0)
1064            : strcmp (SDATA (pattern), name))            : strcmp (SDATA (pattern), name))
1065          continue;          continue;
1066    
       if (size)  
         {  
           struct font_info *fontp;  
           fontp = FS_LOAD_FONT (f, 0, NULL, id);  
           if (!fontp || size != fontp->size)  
             continue;  
         }  
1067        val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);        val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
1068      }      }
1069    
1070    return val;    return val;
1071  }  }
1072    
 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,  
        doc: /* Create a new fontset NAME that contains font information in FONTLIST.  
 FONTLIST is an alist of charsets vs corresponding font name patterns.  */)  
      (name, fontlist)  
      Lisp_Object name, fontlist;  
 {  
   Lisp_Object fontset, elements, ascii_font;  
   Lisp_Object tem, tail, elt;  
1073    
1074    (*check_window_system_func) ();  /* Free all realized fontsets whose base fontset is BASE.  */
1075    
1076    CHECK_STRING (name);  static void
1077    CHECK_LIST (fontlist);  free_realized_fontsets (base)
1078         Lisp_Object base;
1079    {
1080    #if 0
1081      int id;
1082    
1083    name = Fdowncase (name);    /* For the moment, this doesn't work because free_realized_face
1084    tem = Fquery_fontset (name, Qnil);       doesn't remove FACE from a cache.  Until we find a solution, we
1085    if (!NILP (tem))       suppress this code, and simply use Fclear_face_cache even though
1086      error ("Fontset `%s' matches the existing fontset `%s'",       that is not efficient.  */
1087             SDATA (name), SDATA (tem));    BLOCK_INPUT;
1088      for (id = 0; id < ASIZE (Vfontset_table); id++)
1089    /* Check the validity of FONTLIST while creating a template for      {
1090       fontset elements.  */        Lisp_Object this = AREF (Vfontset_table, id);
1091    elements = ascii_font = Qnil;  
1092    for (tail = fontlist; CONSP (tail); tail = XCDR (tail))        if (EQ (FONTSET_BASE (this), base))
     {  
       int c, charset;  
   
       tem = XCAR (tail);  
       if (!CONSP (tem)  
           || (charset = get_charset_id (XCAR (tem))) < 0  
           || (!STRINGP (XCDR (tem)) && !CONSP (XCDR (tem))))  
         error ("Elements of fontlist must be a cons of charset and font name pattern");  
   
       tem = XCDR (tem);  
       if (STRINGP (tem))  
         tem = Fdowncase (tem);  
       else  
         tem = Fcons (Fdowncase (Fcar (tem)), Fdowncase (Fcdr (tem)));  
       if (charset == CHARSET_ASCII)  
         ascii_font = tem;  
       else  
1093          {          {
1094            c = MAKE_CHAR (charset, 0, 0);            Lisp_Object tail;
           elements = Fcons (Fcons (make_number (c), tem), elements);  
         }  
     }  
1095    
1096    if (NILP (ascii_font))            for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
1097      error ("No ASCII font in the fontlist");                 tail = XCDR (tail))
1098                {
1099                  FRAME_PTR f = XFRAME (FONTSET_FRAME (this));
1100                  int face_id = XINT (XCDR (XCAR (tail)));
1101                  struct face *face = FACE_FROM_ID (f, face_id);
1102    
1103    fontset = make_fontset (Qnil, name, Qnil);                /* Face THIS itself is also freed by the following call.  */
1104    FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);                free_realized_face (f, face);
1105    for (; CONSP (elements); elements = XCDR (elements))              }
1106      {          }
       elt = XCAR (elements);  
       tem = XCDR (elt);  
       if (STRINGP (tem))  
         tem = font_family_registry (tem, 0);  
       tem = Fcons (XCAR (elt), tem);  
       FONTSET_SET (fontset, XINT (XCAR (elt)), tem);  
1107      }      }
1108      UNBLOCK_INPUT;
1109    return Qnil;  #else  /* not 0 */
1110  }    Fclear_face_cache (Qt);
1111    #endif /* not 0 */
   
 /* Clear all elements of FONTSET for multibyte characters.  */  
   
 static void  
 clear_fontset_elements (fontset)  
      Lisp_Object fontset;  
 {  
   int i;  
   
   for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)  
     XCHAR_TABLE (fontset)->contents[i] = Qnil;  
1112  }  }
1113    
1114    
1115  /* Check validity of NAME as a fontset name and return the  /* Check validity of NAME as a fontset name and return the
1116     corresponding fontset.  If not valid, signal an error.     corresponding fontset.  If not valid, signal an error.
1117     If NAME is nil, return Vdefault_fontset.  */     If NAME is t, return Vdefault_fontset.  */
1118    
1119  static Lisp_Object  static Lisp_Object
1120  check_fontset_name (name)  check_fontset_name (name)
# Line 963  check_fontset_name (name) Line 1122  check_fontset_name (name)
1122  {  {
1123    int id;    int id;
1124    
1125    if (EQ (name, Qnil))    if (EQ (name, Qt))
1126      return Vdefault_fontset;      return Vdefault_fontset;
1127    
1128    CHECK_STRING (name);    CHECK_STRING (name);
# Line 973  check_fontset_name (name) Line 1132  check_fontset_name (name)
1132    return FONTSET_FROM_ID (id);    return FONTSET_FROM_ID (id);
1133  }  }
1134    
1135  DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,  static void
1136         doc: /* Modify fontset NAME to use FONTNAME for CHARACTER.  accumulate_script_ranges (arg, range, val)
1137         Lisp_Object arg, range, val;
1138    {
1139      if (EQ (XCAR (arg), val))
1140        {
1141          if (CONSP (range))
1142            XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1143          else
1144            XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1145        }
1146    }
1147    
1148    
1149    /* Return an ASCII font name generated from fontset name NAME and
1150       ASCII font specification ASCII_SPEC.  NAME is a string conforming
1151       to XLFD.  ASCII_SPEC is a vector:
1152            [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY].  */
1153    
1154    static INLINE Lisp_Object
1155    generate_ascii_font_name (name, ascii_spec)
1156         Lisp_Object name, ascii_spec;
1157    {
1158      Lisp_Object vec;
1159      int i;
1160    
1161      vec = split_font_name_into_vector (name);
1162      for (i = FONT_SPEC_FAMILY_INDEX; i <= FONT_SPEC_ADSTYLE_INDEX; i++)
1163        if (! NILP (AREF (ascii_spec, i)))
1164          ASET (vec, 1 + i, AREF (ascii_spec, i));
1165      if (! NILP (AREF (ascii_spec, FONT_SPEC_REGISTRY_INDEX)))
1166        ASET (vec, 12, AREF (ascii_spec, FONT_SPEC_REGISTRY_INDEX));
1167      return build_font_name_from_vector (vec);
1168    }
1169    
1170    
1171    DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
1172           doc: /*
1173    Modify fontset NAME to use FONT-SPEC for CHARACTER.
1174    
 If NAME is nil, modify the default fontset.  
1175  CHARACTER may be a cons; (FROM . TO), where FROM and TO are  CHARACTER may be a cons; (FROM . TO), where FROM and TO are
1176  non-generic characters.  In that case, use FONTNAME  characters.  In that case, use FONT-SPEC for all characters in the
1177  for all characters in the range FROM and TO (inclusive).  range FROM and TO (inclusive).
1178  CHARACTER may be a charset.  In that case, use FONTNAME  
1179  for all character in the charsets.  CHARACTER may be a script name symbol.  In that case, use FONT-SPEC
1180    for all characters that belong to the script.
1181  FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family  
1182  name of a font, REGISTRY is a registry name of a font.  */)  CHARACTER may be a charset which has a :code-offset attribute and the
1183       (name, character, fontname, frame)  attribute value is greater than the maximum Unicode character
1184       Lisp_Object name, character, fontname, frame;  \(#x10FFFF).  In that case, use FONT-SPEC for all characters in the
1185    charset.
1186    
1187    FONT-SPEC may be:
1188     * A vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].
1189       See the documentation of `set-face-attribute' for the detail of
1190       these vector elements;
1191     * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1192       REGISTRY is a font registry name;
1193     * A font name string.
1194    
1195    Optional 4th argument FRAME, if non-nil, is a frame.  This argument is
1196    kept for backward compatibility and has no meaning.
1197    
1198    Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1199    to the font specifications for RANGE previously set.  If it is
1200    `prepend', FONT-SPEC is prepended.  If it is `append', FONT-SPEC is
1201    appended.  By default, FONT-SPEC overrides the previous settings.  */)
1202         (name, character, font_spec, frame, add)
1203         Lisp_Object name, character, font_spec, frame, add;
1204  {  {
1205    Lisp_Object fontset, elt;    Lisp_Object fontset;
1206    Lisp_Object realized;    Lisp_Object font_def, registry;
1207    int from, to;    Lisp_Object encoding, repertory;
1208    int id;    Lisp_Object range_list;
   Lisp_Object family, registry;  
1209    
1210    fontset = check_fontset_name (name);    fontset = check_fontset_name (name);
1211    
1212    if (CONSP (character))    /* The arg FRAME is kept for backward compatibility.  We only check
1213         the validity.  */
1214      if (!NILP (frame))
1215        CHECK_LIVE_FRAME (frame);
1216    
1217      if (VECTORP (font_spec))
1218      {      {
1219        /* CH should be (FROM . TO) where FROM and TO are non-generic        int j;
1220           characters.  */  
1221        CHECK_NUMBER_CAR (character);        if (ASIZE (font_spec) != FONT_SPEC_MAX_INDEX)
1222        CHECK_NUMBER_CDR (character);          args_out_of_range (make_number (FONT_SPEC_MAX_INDEX),
1223        from = XINT (XCAR (character));                             make_number (ASIZE (font_spec)));
1224        to = XINT (XCDR (character));  
1225        if (!char_valid_p (from, 0) || !char_valid_p (to, 0))        font_spec = Fcopy_sequence (font_spec);
1226          error ("Character range should be by non-generic characters.");        for (j = 0; j < FONT_SPEC_MAX_INDEX - 1; j++)
1227        if (!NILP (name)          if (! NILP (AREF (font_spec, j)))
1228            && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))            {
1229          error ("Can't change font for a single byte character");              CHECK_STRING (AREF (font_spec, j));
1230      }              ASET (font_spec, j, Fdowncase (AREF (font_spec, j)));
1231    else if (SYMBOLP (character))            }
1232      {        /* REGISTRY should not be omitted.  */
1233        elt = Fget (character, Qcharset);        CHECK_STRING (AREF (font_spec, FONT_SPEC_REGISTRY_INDEX));
1234        if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0)))        registry = Fdowncase (AREF (font_spec, FONT_SPEC_REGISTRY_INDEX));
1235          error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character)));        ASET (font_spec, FONT_SPEC_REGISTRY_INDEX, registry);
1236        from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0);  
1237        to = from;      }
1238      else if (CONSP (font_spec))
1239        {
1240          Lisp_Object family;
1241    
1242          family = XCAR (font_spec);
1243          registry = XCDR (font_spec);
1244    
1245          if (! NILP (family))
1246            {
1247              CHECK_STRING (family);
1248              family = Fdowncase (family);
1249            }
1250          CHECK_STRING (registry);
1251          registry = Fdowncase (registry);
1252          font_spec = Fmake_vector (make_number (FONT_SPEC_MAX_INDEX), Qnil);
1253          ASET (font_spec, FONT_SPEC_FAMILY_INDEX, family);
1254          ASET (font_spec, FONT_SPEC_REGISTRY_INDEX, registry);
1255      }      }
1256    else    else
1257      {      {
1258        CHECK_NUMBER (character);        CHECK_STRING (font_spec);
1259        from = XINT (character);        font_spec = Fdowncase (font_spec);
1260        to = from;        registry = split_font_name_into_vector (font_spec);
1261      }        if (NILP (registry))
1262    if (!char_valid_p (from, 1))          error ("No XLFD: %s", SDATA (font_spec));
1263      invalid_character (from);        if (NILP (AREF (registry, 12))
1264    if (SINGLE_BYTE_CHAR_P (from))            || NILP (AREF (registry, 13)))
1265      error ("Can't change font for a single byte character");          error ("Registry must be specified");
1266    if (from < to)        registry = concat2 (concat2 (AREF (registry, 12), build_string ("-")),
1267      {                            AREF (registry, 13));
       if (!char_valid_p (to, 1))  
         invalid_character (to);  
       if (SINGLE_BYTE_CHAR_P (to))  
         error ("Can't change font for a single byte character");  
1268      }      }
1269    
1270    if (STRINGP (fontname))    if (STRINGP (font_spec))
1271        encoding = find_font_encoding ((char *) SDATA (font_spec));
1272      else
1273        encoding = find_font_encoding ((char *) SDATA (registry));
1274      if (SYMBOLP (encoding))
1275        encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1276      else
1277      {      {
1278        fontname = Fdowncase (fontname);        repertory = XCDR (encoding);
1279        elt = Fcons (make_number (from), font_family_registry (fontname, 0));        encoding = CHARSET_SYMBOL_ID (XCAR (encoding));
1280        }
1281      font_def = Fmake_vector (make_number (3), font_spec);
1282      ASET (font_def, 1, encoding);
1283      ASET (font_def, 2, repertory);
1284    
1285      if (CHARACTERP (character))
1286        range_list = Fcons (Fcons (character, character), Qnil);
1287      else if (CONSP (character))
1288        {
1289          Lisp_Object from, to;
1290    
1291          from = Fcar (character);
1292          to = Fcdr (character);
1293          CHECK_CHARACTER (from);
1294          CHECK_CHARACTER (to);
1295          range_list = Fcons (character, Qnil);
1296      }      }
1297    else    else
1298      {      {
1299        CHECK_CONS (fontname);        Lisp_Object script_list;
1300        family = XCAR (fontname);        Lisp_Object val;
1301        registry = XCDR (fontname);  
1302        if (!NILP (family))        CHECK_SYMBOL (character);
1303          range_list = Qnil;
1304          script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
1305          if (! NILP (Fmemq (character, script_list)))
1306          {          {
1307            CHECK_STRING (family);            val = Fcons (character, Qnil);
1308            family = Fdowncase (family);            map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
1309                              val);
1310              range_list = XCDR (val);
1311          }          }
1312        if (!NILP (registry))        else if (CHARSETP (character))
1313          {          {
1314            CHECK_STRING (registry);            struct charset *charset;
1315            registry = Fdowncase (registry);  
1316              CHECK_CHARSET_GET_CHARSET (character, charset);
1317              if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET)
1318                range_list
1319                  = Fcons (Fcons (make_number (CHARSET_MIN_CHAR (charset)),
1320                                  make_number (CHARSET_MAX_CHAR (charset))),
1321                           range_list);
1322              if (EQ (character, Qascii))
1323                {
1324                  if (VECTORP (font_spec))
1325                    font_spec = generate_ascii_font_name (FONTSET_NAME (fontset),
1326                                                          font_spec);
1327                  FONTSET_ASCII (fontset) = font_spec;
1328                }
1329          }          }
1330        elt = Fcons (make_number (from), Fcons (family, registry));  
1331          if (NILP (range_list))
1332            error ("Invalid script or charset name: %s",
1333                   SDATA (SYMBOL_NAME (character)));
1334      }      }
1335    
1336    /* The arg FRAME is kept for backward compatibility.  We only check    for (; CONSP (range_list); range_list = XCDR (range_list))
1337       the validity.  */      FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
1338    if (!NILP (frame))  
1339      CHECK_LIVE_FRAME (frame);    /* Free all realized fontsets whose base is FONTSET.  This way, the
1340         specified character(s) are surely redisplayed by a correct
1341         font.  */
1342      free_realized_fontsets (fontset);
1343    
1344    for (; from <= to; from++)    return Qnil;
1345      FONTSET_SET (fontset, from, elt);  }
1346    Foptimize_char_table (fontset);  
1347    
1348    /* If there's a realized fontset REALIZED whose parent is FONTSET,  DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1349       clear all the elements of REALIZED and free all multibyte faces         doc: /* Create a new fontset NAME from font information in FONTLIST.
1350       whose fontset is REALIZED.  This way, the specified character(s)  
1351       are surely redisplayed by a correct font.  */  FONTLIST is an alist of scripts vs the corresponding font specification list.
1352    for (id = 0; id < ASIZE (Vfontset_table); id++)  Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1353    character of SCRIPT is displayed by a font that matches one of
1354    FONT-SPEC.
1355    
1356    SCRIPT is a symbol that appears in the first extra slot of the
1357    char-table `char-script-table'.
1358    
1359    FONT-SPEC is a vector, a cons, or a string.  See the documentation of
1360    `set-fontset-font' for the meaning.  */)
1361      (name, fontlist)
1362         Lisp_Object name, fontlist;
1363    {
1364      Lisp_Object fontset;
1365      Lisp_Object val;
1366      int id;
1367    
1368      CHECK_STRING (name);
1369      CHECK_LIST (fontlist);
1370    
1371      id = fs_query_fontset (name, 0);
1372      if (id < 0)
1373      {      {
1374        realized = AREF (Vfontset_table, id);        name = Fdowncase (name);
1375        if (!NILP (realized)        val = split_font_name_into_vector (name);
1376            && !BASE_FONTSET_P (realized)        if (NILP (val))
1377            && EQ (FONTSET_BASE (realized), fontset))          error ("Fontset name must be in XLFD format");
1378          {        if (strcmp (SDATA (AREF (val, 12)), "fontset"))
1379            FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));          error ("Registry field of fontset name must be \"fontset\"");
1380            clear_fontset_elements (realized);        Vfontset_alias_alist
1381            free_realized_multibyte_face (f, id);          = Fcons (Fcons (name,
1382          }                          concat2 (concat2 (AREF (val, 12), build_string ("-")),
1383                                     AREF (val, 13))),
1384                     Vfontset_alias_alist);
1385          ASET (val, 12, build_string ("iso8859-1"));
1386          fontset = make_fontset (Qnil, name, Qnil);
1387          FONTSET_ASCII (fontset) = build_font_name_from_vector (val);
1388        }
1389      else
1390        {
1391          fontset = FONTSET_FROM_ID (id);;
1392          free_realized_fontsets (fontset);
1393          Fset_char_table_range (fontset, Qt, Qnil);
1394      }      }
1395    
1396    return Qnil;    for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
1397        {
1398          Lisp_Object elt, script;
1399    
1400          elt = Fcar (fontlist);
1401          script = Fcar (elt);
1402          for (elt = Fcdr (elt); ! NILP (elt); elt = Fcdr (elt))
1403            Fset_fontset_font (name, script, Fcar (elt), Qnil, Qappend);
1404        }
1405      return name;
1406  }  }
1407    
1408    
1409    /* Number of fontsets created from a fontname automatically.  */
1410    static int n_auto_fontsets;
1411    
1412    int
1413    new_fontset_from_font_name (Lisp_Object fontname)
1414    {
1415      Lisp_Object name;
1416      Lisp_Object vec;
1417    
1418      fontname = Fdowncase (fontname);
1419      vec = split_font_name_into_vector (fontname);
1420      if ( NILP (vec))
1421        vec = Fmake_vector (make_number (14), build_string (""));
1422      ASET (vec, 12, build_string ("fontset"));
1423      if (n_auto_fontsets == 0)
1424        {
1425          ASET (vec, 13, build_string ("startup"));
1426          name = build_font_name_from_vector (vec);
1427          n_auto_fontsets++;
1428        }
1429      else
1430        {
1431          char temp[20];
1432    
1433          do {
1434            sprintf (temp, "auto%d", n_auto_fontsets);
1435            ASET (vec, 13, build_string (temp));
1436            name = build_font_name_from_vector (vec);
1437            n_auto_fontsets++;
1438          } while (fs_query_fontset (name, 0) >= 0);
1439        }
1440      name = Fnew_fontset (name,
1441                           Fcons (Fcons (Qascii, Fcons (fontname, Qnil)), Qnil));
1442      Vfontset_alias_alist = Fcons (Fcons (name, fontname), Vfontset_alias_alist);
1443      return fs_query_fontset (name, 0);
1444    }
1445    
1446    
1447  DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,  DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
1448         doc: /* Return information about a font named NAME on frame FRAME.         doc: /* Return information about a font named NAME on frame FRAME.
1449  If FRAME is omitted or nil, use the selected frame.  If FRAME is omitted or nil, use the selected frame.
# Line 1174  DEFUN ("internal-char-font", Finternal_c Line 1530  DEFUN ("internal-char-font", Finternal_c
1530      args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));      args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1531    pos_byte = CHAR_TO_BYTE (pos);    pos_byte = CHAR_TO_BYTE (pos);
1532    c = FETCH_CHAR (pos_byte);    c = FETCH_CHAR (pos_byte);
   if (! CHAR_VALID_P (c, 0))  
     return Qnil;  
1533    window = Fget_buffer_window (Fcurrent_buffer (), Qnil);    window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1534    if (NILP (window))    if (NILP (window))
1535      return Qnil;      return Qnil;
# Line 1190  DEFUN ("internal-char-font", Finternal_c Line 1544  DEFUN ("internal-char-font", Finternal_c
1544  }  }
1545    
1546    
1547  /* Called from Ffontset_info via map_char_table on each leaf of  DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1548     fontset.  ARG is a copy of the default fontset.  The current leaf         doc: /* Return information about a fontset FONTSET on frame FRAME.
1549     is indexed by CHARACTER and has value ELT.  This function override  The value is a char-table of which elements has this form.
    the copy by ELT if ELT is not nil.  */  
   
 static void  
 override_font_info (fontset, character, elt)  
      Lisp_Object fontset, character, elt;  
 {  
   if (! NILP (elt))  
     Faset (fontset, character, elt);  
 }  
1550    
1551  /* Called from Ffontset_info via map_char_table on each leaf of      ((FONT-PATTERN OPENED-FONT ...) ...)
    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.  */  
1552    
1553  static void  FONT-PATTERN is a vector:
 accumulate_font_info (arg, character, elt)  
      Lisp_Object arg, character, elt;  
 {  
   Lisp_Object last, last_char, last_elt;  
1554    
1555    if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))          [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
     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));  
1556    
1557        if (CONSP (last_char))    /* LAST_CHAR == (FROM . TO)  */  or a string of font name pattern.
         {  
           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));  
 }  
1558    
1559    OPENED-FONT is a name of a font actually opened.
1560    
1561  DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,  The char-table has one extra slot.  The value is a char-table
1562         doc: /* Return information about a fontset named NAME on frame FRAME.  containing the information about the derived fonts from the default
1563  If NAME is nil, return information about the default fontset.  fontset.  The format is the same as abobe.  */)
1564  The value is a vector:       (fontset, frame)
1565    [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],       Lisp_Object fontset, frame;
 where,  
   SIZE is the maximum bound width of ASCII font in the fontset,  
   HEIGHT is the maximum bound height of ASCII font in the fontset,  
   CHARSET-OR-RANGE is a charset, a character (may be a generic character)  
     or a cons of two characters specifying the range of characters.  
   FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),  
     where FAMILY is a `FAMILY' field of a XLFD font name,  
     REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.  
     FAMILY may contain a `FOUNDRY' field at the head.  
     REGISTRY may contain a `CHARSET_ENCODING' field at the tail.  
   OPENEDs are names of fonts actually opened.  
 If the ASCII font is not yet opened, SIZE and HEIGHT are 0.  
 If FRAME is omitted, it defaults to the currently selected frame.  */)  
      (name, frame)  
      Lisp_Object name, frame;  
1566  {  {
   Lisp_Object fontset;  
1567    FRAME_PTR f;    FRAME_PTR f;
1568    Lisp_Object indices[3];    Lisp_Object table, val, elt;
   Lisp_Object val, tail, elt;  
1569    Lisp_Object *realized;    Lisp_Object *realized;
   struct font_info *fontp = NULL;  
1570    int n_realized = 0;    int n_realized = 0;
1571    int i;    int fallback;
1572      int c, i, j;
1573    
1574    (*check_window_system_func) ();    (*check_window_system_func) ();
1575    
1576    fontset = check_fontset_name (name);    fontset = check_fontset_name (fontset);
1577    
1578    if (NILP (frame))    if (NILP (frame))
1579      frame = selected_frame;      frame = selected_frame;
1580    CHECK_LIVE_FRAME (frame);    CHECK_LIVE_FRAME (frame);
1581    f = XFRAME (frame);    f = XFRAME (frame);
1582    
1583    /* Recode realized fontsets whose base is FONTSET in the table    /* Recode fontsets realized on FRAME from the base fontset FONTSET
1584       `realized'.  */       in the table `realized'.  */
1585    realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)    realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1586                                       * ASIZE (Vfontset_table));                                       * ASIZE (Vfontset_table));
1587    for (i = 0; i < ASIZE (Vfontset_table); i++)    for (i = 0; i < ASIZE (Vfontset_table); i++)
1588      {      {
1589        elt = FONTSET_FROM_ID (i);        elt = FONTSET_FROM_ID (i);
1590        if (!NILP (elt)        if (!NILP (elt)
1591            && EQ (FONTSET_BASE (elt), fontset))            && EQ (FONTSET_BASE (elt), fontset)
1592              && EQ (FONTSET_FRAME (elt), frame))
1593          realized[n_realized++] = elt;          realized[n_realized++] = elt;
1594      }      }
1595    
1596    if (! EQ (fontset, Vdefault_fontset))  
1597      {    table = Fmake_char_table (Qfontset_info, Qnil);
1598        /* Merge FONTSET onto the default fontset.  */    XCHAR_TABLE (table)->extras[0] = Fmake_char_table (Qnil, Qnil);
1599        val = Fcopy_sequence (Vdefault_fontset);    /* Accumulate information of the fontset in TABLE.  The format of
1600        map_char_table (override_font_info, Qnil, fontset, fontset, val, 0, indices);       each element is ((FONT-SPEC OPENED-FONT ...) ...).  */
1601        fontset = val;    for (fallback = 0; fallback <= 1; fallback++)
     }  
   
   /* 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, fontset, val, 0, indices);  
   val = XCDR (val);  
   
   /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic  
      character for a charset, replace it with 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))  
1602      {      {
1603        int c;        Lisp_Object this_fontset, this_table;
1604        elt = XCAR (tail);  
1605        if (INTEGERP (XCAR (elt)))        if (! fallback)
1606          {          {
1607            int charset, c1, c2;            this_fontset = fontset;
1608            c = XINT (XCAR (elt));            this_table = table;
           SPLIT_CHAR (c, charset, c1, c2);  
           if (c1 == 0)  
             XSETCAR (elt, CHARSET_SYMBOL (charset));  
1609          }          }
1610        else        else
         c = XINT (XCAR (XCAR (elt)));  
       for (i = 0; i < n_realized; i++)  
1611          {          {
1612            Lisp_Object face_id, font;            this_fontset = Vdefault_fontset;
1613            struct face *face;            this_table = XCHAR_TABLE (table)->extras[0];
1614    #if 0
1615              for (i = 0; i < n_realized; i++)
1616                realized[i] = FONTSET_FALLBACK (realized[i]);
1617    #endif
1618            }
1619          for (c = 0; c <= MAX_5_BYTE_CHAR; )
1620            {
1621              int from, to;
1622    
1623            face_id = FONTSET_REF_VIA_BASE (realized[i], c);            val = char_table_ref_and_range (this_fontset, c, &from, &to);
1624            if (INTEGERP (face_id))            if (VECTORP (val))
1625              {              {
1626                face = FACE_FROM_ID (f, XINT (face_id));                Lisp_Object alist;
1627                if (face && face->font && face->font_name)  
1628                  /* At first, set ALIST to ((FONT-SPEC) ...).  */
1629                  for (alist = Qnil, i = 0; i < ASIZE (val); i++)
1630                    alist = Fcons (Fcons (AREF (AREF (val, i), 0), Qnil), alist);
1631                  alist = Fnreverse (alist);
1632    
1633                  /* Then store opend font names to cdr of each elements.  */
1634                  for (i = 0; i < n_realized; i++)
1635                  {                  {
1636                    font = build_string (face->font_name);                    if (NILP (realized[i]))
1637                    if (NILP (Fmember (font, XCDR (XCDR (elt)))))                      continue;
1638                      XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt))));                    val = FONTSET_REF (realized[i], c);
1639                      if (NILP (val))
1640                        continue;
1641                      val = XCDR (val);
1642                      /* Now VAL is [[FACE-ID FONT-INDEX FONT-DEF] ...].
1643                         If a font of an element is already opened,
1644                         FONT-INDEX of the element is integer.  */
1645                      for (j = 0; j < ASIZE (val); j++)
1646                        if (INTEGERP (AREF (AREF (val, j), 0)))
1647                          {
1648                            Lisp_Object font_idx;
1649    
1650                            font_idx = AREF (AREF (val, j), 1);
1651                            elt = Fassq (AREF (AREF (AREF (val, j), 2), 0), alist);
1652                            if (CONSP (elt)
1653                                && NILP (Fmemq (font_idx, XCDR(elt))))
1654                              nconc2 (elt, Fcons (font_idx, Qnil));
1655                          }
1656                  }                  }
1657                  for (val = alist; CONSP (val); val = XCDR (val))
1658                    for (elt = XCDR (XCAR (val)); CONSP (elt); elt = XCDR (elt))
1659                      {
1660                        struct font_info *font_info
1661                          = (*get_font_info_func) (f, XINT (XCAR (elt)));
1662                        XSETCAR (elt, build_string (font_info->full_name));
1663                      }
1664    
1665                  /* Store ALIST in TBL for characters C..TO.  */
1666                  char_table_set_range (this_table, c, to, alist);
1667              }              }
1668              c = to + 1;
1669          }          }
1670      }      }
1671    
1672    elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val)));    return table;
   if (CONSP (elt))  
     {  
       elt = XCAR (elt);  
       fontp = (*query_font_func) (f, SDATA (elt));  
     }  
   val = Fmake_vector (make_number (3), val);  
   AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0);  
   AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0);  
   return val;  
1673  }  }
1674    
1675    
1676  DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,  DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
1677         doc: /* Return a font name pattern for character CH in fontset NAME.         doc: /* Return a font name pattern for character CH in fontset NAME.
1678  If NAME is nil, find a font name pattern in the default fontset.  */)  If NAME is t, find a font name pattern in the default fontset.  */)
1679       (name, ch)       (name, ch)
1680       Lisp_Object name, ch;       Lisp_Object name, ch;
1681  {  {
# Line 1380  If NAME is nil, find a font name pattern Line 1684  If NAME is nil, find a font name pattern
1684    
1685    fontset = check_fontset_name (name);    fontset = check_fontset_name (name);
1686    
1687    CHECK_NUMBER (ch);    CHECK_CHARACTER (ch);
1688    c = XINT (ch);    c = XINT (ch);
   if (!char_valid_p (c, 1))  
     invalid_character (c);  
   
1689    elt = FONTSET_REF (fontset, c);    elt = FONTSET_REF (fontset, c);
1690    if (CONSP (elt))    return Fcopy_sequence (elt);
     elt = XCDR (elt);  
   
   return elt;  
1691  }  }
1692    
1693  DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,  DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
# Line 1418  syms_of_fontset () Line 1716  syms_of_fontset ()
1716      /* Window system initializer should have set proper functions.  */      /* Window system initializer should have set proper functions.  */
1717      abort ();      abort ();
1718    
1719    Qfontset = intern ("fontset");    DEFSYM (Qfontset, "fontset");
1720    staticpro (&Qfontset);    Fput (Qfontset, Qchar_table_extra_slots, make_number (8));
1721    Fput (Qfontset, Qchar_table_extra_slots, make_number (3));    DEFSYM (Qfontset_info, "fontset-info");
1722      Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
1723    
1724      DEFSYM (Qprepend, "prepend");
1725      DEFSYM (Qappend, "append");
1726    
1727    Vcached_fontset_data = Qnil;    Vcached_fontset_data = Qnil;
1728    staticpro (&Vcached_fontset_data);    staticpro (&Vcached_fontset_data);
# Line 1433  syms_of_fontset () Line 1735  syms_of_fontset ()
1735    FONTSET_ID (Vdefault_fontset) = make_number (0);    FONTSET_ID (Vdefault_fontset) = make_number (0);
1736    FONTSET_NAME (Vdefault_fontset)    FONTSET_NAME (Vdefault_fontset)
1737      = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");      = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1738  #if defined (MAC_OS)    {
1739    FONTSET_ASCII (Vdefault_fontset)      Lisp_Object default_ascii_font;
1740      = Fcons (make_number (0),  
1741               build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));  #if defined (macintosh)
1742        default_ascii_font
1743          = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
1744  #elif defined (WINDOWSNT)  #elif defined (WINDOWSNT)
1745    FONTSET_ASCII (Vdefault_fontset)      default_ascii_font
1746      = Fcons (make_number (0),        = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
              build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));  
1747  #else  #else
1748    FONTSET_ASCII (Vdefault_fontset)      default_ascii_font
1749      = Fcons (make_number (0),        = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
              build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));  
1750  #endif  #endif
1751        FONTSET_ASCII (Vdefault_fontset) = default_ascii_font;
1752      }
1753    AREF (Vfontset_table, 0) = Vdefault_fontset;    AREF (Vfontset_table, 0) = Vdefault_fontset;
1754    next_fontset_id = 1;    next_fontset_id = 1;
1755    
1756    DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,    DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
1757                 doc: /* Alist of fontname patterns vs corresponding encoding info.                 doc: /*
1758  Each element looks like (REGEXP . ENCODING-INFO),  Alist of fontname patterns vs the corresponding encoding and repertory info.
1759   where ENCODING-INFO is an alist of CHARSET vs ENCODING.  Each element looks like (REGEXP . (ENCODING . REPERTORY)),
1760  ENCODING is one of the following integer values:  where ENCODING is a charset or a char-table,
1761          0: code points 0x20..0x7F or 0x2020..0x7F7F are used,  and REPERTORY is a charset, a char-table, or nil.
1762          1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,  
1763          2: code points 0x20A0..0x7FFF are used,  ENCODING is for converting a character to a glyph code of the font.
1764          3: code points 0xA020..0xFF7F are used.  */);  If ENCODING is a charset, encoding a character by the charset gives
1765    the corresponding glyph code.  If ENCODING is a char-table, looking up
1766    the table by a character gives the corresponding glyph code.
1767    
1768    REPERTORY specifies a repertory of characters supported by the font.
1769    If REPERTORY is a charset, all characters beloging to the charset are
1770    supported.  If REPERTORY is a char-table, all characters who have a
1771    non-nil value in the table are supported.  It REPERTORY is nil, Emacs
1772    gets the repertory information by an opened font and ENCODING.  */);
1773    Vfont_encoding_alist = Qnil;    Vfont_encoding_alist = Qnil;
   Vfont_encoding_alist  
     = Fcons (Fcons (build_string ("JISX0201"),  
                     Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)),  
                            Qnil)),  
              Vfont_encoding_alist);  
   Vfont_encoding_alist  
     = Fcons (Fcons (build_string ("ISO8859-1"),  
                     Fcons (Fcons (intern ("ascii"), make_number (0)),  
                            Qnil)),  
              Vfont_encoding_alist);  
1774    
1775    DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,    DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
1776                 doc: /* Char table of characters whose ascent values should be ignored.                 doc: /*
1777    Char table of characters whose ascent values should be ignored.
1778  If an entry for a character is non-nil, the ascent value of the glyph  If an entry for a character is non-nil, the ascent value of the glyph
1779  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.
1780    
# Line 1480  such a character is displayed on screen. Line 1783  such a character is displayed on screen.
1783    Vuse_default_ascent = Qnil;    Vuse_default_ascent = Qnil;
1784    
1785    DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,    DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
1786                 doc: /* Char table of characters which is not composed relatively.                 doc: /*
1787    Char table of characters which is not composed relatively.
1788  If an entry for a character is non-nil, a composition sequence  If an entry for a character is non-nil, a composition sequence
1789  which contains that character is displayed so that  which contains that character is displayed so that
1790  the glyph of that character is put without considering  the glyph of that character is put without considering
# Line 1515  at the vertical center of lines.  */); Line 1819  at the vertical center of lines.  */);
1819    defsubr (&Sfontset_font);    defsubr (&Sfontset_font);
1820    defsubr (&Sfontset_list);    defsubr (&Sfontset_list);
1821  }  }
1822    
1823    Lisp_Object
1824    dump_fontset (fontset)
1825         Lisp_Object fontset;
1826    {
1827      Lisp_Object val;
1828    
1829      if (NILP (FONTSET_FALLBACK (fontset)))
1830        val = Fcons (Fcons (intern ("fallback-id"), Qnil), Qnil);
1831      else
1832        val = Fcons (Fcons (intern ("fallback-id"),
1833                            FONTSET_ID (FONTSET_FALLBACK (fontset))),
1834                     Qnil);
1835      if (NILP (FONTSET_BASE (fontset)))
1836        val = Fcons (Fcons (intern ("base"), Qnil), val);
1837      else
1838        val = Fcons (Fcons (intern ("base"),
1839                            FONTSET_NAME (FONTSET_BASE (fontset))),
1840                     val);
1841      val = Fcons (Fcons (intern ("name"), FONTSET_NAME (fontset)), val);
1842      val = Fcons (Fcons (intern ("id"), FONTSET_ID (fontset)), val);
1843      return val;
1844    }

Legend:
Removed from v.1.77  
changed lines
  Added in v.1.77.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26