/[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.65.2.6 by fx, Tue Jul 16 15:10:44 2002 UTC revision 1.65.2.7 by handa, Fri Jul 26 04:06:25 2002 UTC
# Line 54  EXFUN (Fclear_face_cache, 1); Line 54  EXFUN (Fclear_face_cache, 1);
54  /* FONTSET  /* FONTSET
55    
56     A fontset is a collection of font related information to give     A fontset is a collection of font related information to give
57     similar appearance (style, etc) of characters.  There are two kinds     similar appearance (style, etc) of characters.  A fontset has two
58     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
59     `new-fontset' from Emacs Lisp explicitly.  A realized fontset is     ASCII font.  In that case, Emacs uses the font specified for
60     created implicitly when a face is realized for ASCII characters.  A     `ascii' script for the frame's default font.
61     face is also realized for non-ASCII characters based on an ASCII  
62     face.  All of non-ASCII faces based on the same ASCII face share     Another role, the more important one, is to provide information
63     the same realized fontset.     about which font to use for each non-ASCII character.
64    
65       There are two kinds of fontsets; base and realized.  A base fontset
66       is created by `new-fontset' from Emacs Lisp explicitly.  A realized
67       fontset is created implicitly when a face is realized for ASCII
68       characters.  A face is also realized for non-ASCII characters based
69       on an ASCII face.  All of non-ASCII faces based on the same ASCII
70       face share the same realized fontset.
71        
72     A fontset object is implemented by a char-table whose default value     A fontset object is implemented by a char-table whose default value
73     and parent are always nil.     and parent are always nil.
74    
75     An element of a base fontset is a font specification of the form:     An element of a base fontset is a vector of FONT-DEFs which itself
76          [ FAMILY WEIGHT SLANT SWIDTH REGISTRY ] (vector of size 5)     is a vector [ FONT-SPEC ENCODING REPERTORY ].
77    
78       FONT-SPEC is:
79            [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
80     or     or
81          FONT-NAME (strig)          FONT-NAME
82       where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
83       FONT-NAME are strings.
84    
85       ENCODING is a charset ID or a char-table that can convert
86       characters to glyph codes of the corresponding font.
87    
88       REPERTORY is a charset ID or nil.  If REPERTORY is a charset ID,
89       the repertory of the charset exactly matches with that of the font.
90       If REPERTORY is nil, we consult with the font itself to get the
91       repertory.
92    
93       ENCODING and REPERTORY are extracted from the variable
94       Vfont_encoding_alist by using a font name generated form FONT-SPEC
95       (if it is a vector) or FONT-NAME as a key.
96    
97    
98       An element of a realized fontset is nil or t, or has this form:
99    
100            ( CHARSET-PRIORITY-LIST-TICK . FONT-VECTOR )
101    
102       FONT-VECTOR is a vector whose elements have this form:
103    
104     FAMILY and REGISTRY are strings.          [ FACE-ID FONT-INDEX FONT-DEF ]
105    
106     WEIGHT, SLANT, and SWIDTH must be symbols that set-face-attribute     FONT-VECTOR is automatically reordered by the current charset
107     accepts as attribute values for :weight, :slant, :swidth     priority list.
    respectively.  
108    
109       The value nil means that we have not yet generated FONT-VECTOR from
110       the base of the fontset.
111    
112     A fontset has 7 extra slots.     The value t means that no font is available for the corresponding
113       range of characters.
114    
    The 1st slot is an ID number of the fontset.  
115    
116     The 2nd slot is a name of the fontset in a base fontset, and nil in     A fontset has 5 extra slots.
    a realized fontset.  
117    
118     The 3rd slot is nil in a base fontset, and a base fontset in a     The 1st slot: the ID number of the fontset
    realized fontset.  
119    
120     The 4th slot is a frame that the fontset belongs to.  This is nil     The 2nd slot:
121     in a base fontset.          base: the name of the fontset
122            realized: nil
123    
124     The 5th slot is a cons of 0 and fontname for ASCII characters in a     The 3rd slot:
125     base fontset, and nil in a realized face.          base: nli
126            realized: the base fontset
127    
128     The 6th slot is an alist of a charset vs. the corresponding font     The 4th slot:
129     specification.          base: nil
130            realized: the frame that the fontset belongs to
131    
132     The 7th slot is an alist of a font specification vs. the     The 5th slot:
133     corresponding face ID.  In a base fontset, the face IDs are all          base: the font name for ASCII characters
134     nil.          realized: nil
135    
136     All fontsets are recorded in Vfontset_table.     The 6th slot:
137            base: nil
138            realized: the ID number of a face to use for characters that
139                      has no font in a realized fontset.
140    
141       The 7th slot:
142            base: nil
143            realized: Alist of font index vs the corresponding repertory
144            char-table.
145            
146    
147       All fontsets are recorded in the vector Vfontset_table.
148    
149    
150     DEFAULT FONTSET     DEFAULT FONTSET
151    
152     There's a special fontset named `default fontset' which defines the     There's a special base fontset named `default fontset' which
153     default font specifications.  When a base fontset doesn't specify a     defines the default font specifications.  When a base fontset
154     font for a specific character, the corresponding value in the     doesn't specify a font for a specific character, the corresponding
155     default fontset is used.  The format is the same as a base fontset.     value in the default fontset is used.
156    
157     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
158     no fontset is the default fontset.     no fontset is the default fontset.
# Line 118  EXFUN (Fclear_face_cache, 1); Line 162  EXFUN (Fclear_face_cache, 1);
162     The other codes handle fontsets only by their ID numbers.  They     The other codes handle fontsets only by their ID numbers.  They
163     usually use the variable name `fontset' for IDs.  But, in this     usually use the variable name `fontset' for IDs.  But, in this
164     file, we always use varialbe name `id' for IDs, and name `fontset'     file, we always use varialbe name `id' for IDs, and name `fontset'
165     for the actual fontset objects (i.e. char-table objects).     for an actual fontset object, i.e., char-table.
166    
167  */  */
168    
# Line 126  EXFUN (Fclear_face_cache, 1); Line 170  EXFUN (Fclear_face_cache, 1);
170    
171  extern Lisp_Object Qfont;  extern Lisp_Object Qfont;
172  Lisp_Object Qfontset;  Lisp_Object Qfontset;
173    static Lisp_Object Qprepend, Qappend;
174    
175  /* Vector containing all fontsets.  */  /* Vector containing all fontsets.  */
176  static Lisp_Object Vfontset_table;  static Lisp_Object Vfontset_table;
# Line 176  void (*set_frame_fontset_func) P_ ((FRAM Line 221  void (*set_frame_fontset_func) P_ ((FRAM
221     This function set the member `encoder' of the structure.  */     This function set the member `encoder' of the structure.  */
222  void (*find_ccl_program_func) P_ ((struct font_info *));  void (*find_ccl_program_func) P_ ((struct font_info *));
223    
224    Lisp_Object (*get_font_repertory_func) P_ ((struct frame *,
225                                                struct font_info *));
226    
227  /* Check if any window system is used now.  */  /* Check if any window system is used now.  */
228  void (*check_window_system_func) P_ ((void));  void (*check_window_system_func) P_ ((void));
229    
# Line 184  void (*check_window_system_func) P_ ((vo Line 232  void (*check_window_system_func) P_ ((vo
232  static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));  static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
233  static int fontset_id_valid_p P_ ((int));  static int fontset_id_valid_p P_ ((int));
234  static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));  static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
235    static void accumulate_script_ranges P_ ((Lisp_Object, Lisp_Object,
236                                              Lisp_Object));
237    
238    
239    
240  /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/  /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
# Line 203  static Lisp_Object fontset_pattern_regex Line 254  static Lisp_Object fontset_pattern_regex
254  /* Macros to access special values of (realized) FONTSET.  */  /* Macros to access special values of (realized) FONTSET.  */
255  #define FONTSET_BASE(fontset)           XCHAR_TABLE (fontset)->extras[2]  #define FONTSET_BASE(fontset)           XCHAR_TABLE (fontset)->extras[2]
256  #define FONTSET_FRAME(fontset)          XCHAR_TABLE (fontset)->extras[3]  #define FONTSET_FRAME(fontset)          XCHAR_TABLE (fontset)->extras[3]
257  #define FONTSET_CHARSET_ALIST(fontset)  XCHAR_TABLE (fontset)->extras[5]  #define FONTSET_NOFONT_FACE(fontset)    XCHAR_TABLE (fontset)->extras[5]
258  #define FONTSET_FACE_ALIST(fontset)     XCHAR_TABLE (fontset)->extras[6]  #define FONTSET_REPERTORY(fontset)      XCHAR_TABLE (fontset)->extras[6]
259    
260    
261  /* Return the element of FONTSET (char-table) at index C (character).  */  /* Return the element of FONTSET for the character C.  If FONTSET is a
262       base fontset other then the default fontset and FONTSET doesn't
263  #define FONTSET_REF(fontset, c, etl)    ((elt) = fontset_ref ((fontset), (c)))     contain information for C, return the information in the default
264       fontset.  */
265    
266    #define FONTSET_REF(fontset, c)         \
267      (EQ (fontset, Vdefault_fontset)       \
268       ? CHAR_TABLE_REF (fontset, c)        \
269       : fontset_ref ((fontset), (c)))
270    
271  static Lisp_Object  static Lisp_Object
272  fontset_ref (fontset, c)  fontset_ref (fontset, c)
# Line 218  fontset_ref (fontset, c) Line 275  fontset_ref (fontset, c)
275  {  {
276    Lisp_Object elt;    Lisp_Object elt;
277    
278    while (1)    elt = CHAR_TABLE_REF (fontset, c);
279      {    if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
280        elt = CHAR_TABLE_REF (fontset, c);        /* Don't check Vdefault_fontset for a realized fontset.  */
281        if (NILP (elt) && ASCII_CHAR_P (c))        && NILP (FONTSET_BASE (fontset)))
282          elt = FONTSET_ASCII (fontset);      elt = CHAR_TABLE_REF (Vdefault_fontset, c);
283        if (NILP (elt))    return elt;
284          {  }
           Lisp_Object tail;  
           struct charset *charset;  
285    
286            for (tail = FONTSET_CHARSET_ALIST (fontset);  
287                 CONSP (tail);  tail = XCDR (tail))  /* Return the element of FONTSET for the character C, set FROM and TO
288              {     to the range of characters around C that have the same value as C.
289                charset = CHARSET_FROM_ID (XINT (XCAR (XCAR (tail))));     If FONTSET is a base fontset other then the default fontset and
290                if (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset))     FONTSET doesn't contain information for C, return the information
291                  {     in the default fontset.  */
292                    elt = XCDR (XCAR (tail));  
293                    break;  #define FONTSET_REF_AND_RANGE(fontset, c, form, to)     \
294                  }    (EQ (fontset, Vdefault_fontset)                       \
295              }     ? char_table_ref_and_range (fontset, c, &from, &to)  \
296          }     : fontset_ref_and_range (fontset, c, &from, &to))
297        if (! NILP (elt) || EQ (fontset, Vdefault_fontset))  
298          break;  static Lisp_Object
299        fontset = Vdefault_fontset;  fontset_ref_and_range (fontset, c, from, to)
300         Lisp_Object fontset;
301         int c;
302         int *from, *to;
303    {
304      Lisp_Object elt;
305    
306      elt = char_table_ref_and_range (fontset, c, from, to);
307      if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
308          /* Don't check Vdefault_fontset for a realized fontset.  */
309          && NILP (FONTSET_BASE (fontset)))
310        {
311          int from1, to1;
312    
313          elt = char_table_ref_and_range (Vdefault_fontset, c, &from1, &to1);
314          if (*from < from1)
315            *from = from1;
316          if (*to > to1)
317            *to = to1;
318      }      }
319    return elt;    return elt;
320  }  }
321    
322    
323  /* Set the element of FONTSET at index IDX to the value ELT.  IDX may  /* Set elements of FONTSET for characters in RANGE to the value ELT.
324     be a character or a charset.  */     RANGE is a cons (FROM . TO), where FROM and TO are character codes
325       specifying a range.  */
326    
327    #define FONTSET_SET(fontset, range, elt)        \
328      Fset_char_table_range ((fontset), (range), (elt))
329    
330    
331    /* Modify the elements of FONTSET for characters in RANGE by replacing
332       with ELT or adding ETL.  RANGE is a cons (FROM . TO), where FROM
333       and TO are character codes specifying a range.  If ADD is nil,
334       replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
335       append ELT.  */
336    
337    #define FONTSET_ADD(fontset, range, elt, add)                           \
338      (NILP (add)                                                           \
339       ? Fset_char_table_range ((fontset), (range),                         \
340                                Fmake_vector (make_number (1), (elt)))      \
341       : fontset_add ((fontset), (range), (elt), (add)))
342    
343    static void
344    fontset_add (fontset, range, elt, add)
345    {
346      int from, to, from1, to1;
347      Lisp_Object elt1;
348      
349      from = XINT (XCAR (range));
350      to = XINT (XCDR (range));
351      do {
352        elt1 = char_table_ref_and_range (fontset, from, &from1, &to1);
353        if (NILP (elt1))
354          elt1 = Fmake_vector (make_number (1), elt);
355        else
356          {
357            int i, i0 = 1, i1 = ASIZE (elt1) + 1;
358            Lisp_Object new;
359    
360            new = Fmake_vector (i1, elt);
361            if (EQ (add, Qappend))
362              i0--, i1--;
363            for (i = 0; i0 < i1; i++, i0++)
364              ASET (new, i0, AREF (elt1, i));
365            elt1 = new;
366          }
367        char_table_set_range (fontset, from, to1, elt1);    
368        from = to1 + 1;
369      } while (from < to);
370    }
371    
372  #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)  
373    /* Update FONTSET_ELEMENT which has this form:
374            ( CHARSET-PRIORITY-LIST-TICK . FONT-VECTOR).
375       Reorder FONT-VECTOR according to the current order of charset
376       (Vcharset_ordered_list), and update CHARSET-PRIORITY-LIST-TICK to
377       the latest value.  */
378    
379  static void  static void
380  fontset_set (fontset, idx, elt)  reorder_font_vector (fontset_element)
381       Lisp_Object fontset, idx, elt;       Lisp_Object fontset_element;
382  {  {
383    if (SYMBOLP (idx))    Lisp_Object vec, list, *new_vec;
384      int size;
385      int *charset_id_table;
386      int i, idx;
387    
388      XSETCAR (fontset_element, make_number (charset_ordered_list_tick));
389      vec = XCDR (fontset_element);
390      size = ASIZE (vec);
391      if (size < 2)
392        /* No need of reordering VEC.  */
393        return;
394      charset_id_table = (int *) alloca (sizeof (int) * size);
395      new_vec = (Lisp_Object *) alloca (sizeof (Lisp_Object) * size);
396      /* At first, extract ENCODING (a chaset ID) from VEC.  VEC has this
397         form:
398            [[FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] ...] */
399      for (i = 0; i < size; i++)
400        charset_id_table[i] = XINT (AREF (AREF (AREF (vec, i), 2), 1));
401    
402      /* Then, store the elements of VEC in NEW_VEC in the correct
403         order.  */
404      idx = 0;
405      for (list = Vcharset_ordered_list; CONSP (list); list = XCDR (list))
406      {      {
407        Lisp_Object id, slot, tail;        for (i = 0; i < size; i++)
408                  if (charset_id_table[i] == XINT (XCAR (list)))
409        id = CHARSET_SYMBOL_ID (idx);            new_vec[idx++] = AREF (vec, i);
410        if (XFASTINT (id) == charset_ascii)        if (idx == size)
411          Fset_char_table_range (fontset,          break;
                                Fcons (make_number (0), make_number (127)),  
                                elt);  
       else  
         {  
           slot = Fassq (id, FONTSET_CHARSET_ALIST (fontset));  
           if (CONSP (slot))  
             XCDR (slot) = elt;  
           else if (CONSP (FONTSET_CHARSET_ALIST (fontset)))  
             {  
               for (tail = FONTSET_CHARSET_ALIST (fontset);  
                    CONSP (XCDR (tail)); tail = XCDR (tail));  
               XCDR (tail) = Fcons (Fcons (id, elt), Qnil);  
             }  
           else  
             FONTSET_CHARSET_ALIST (fontset) = Fcons (Fcons (id, elt), Qnil);  
         }  
412      }      }
413    else  
414      /* At last, update VEC.  */
415      for (i = 0; i < size; i++)
416        ASET (vec, i, new_vec[i]);
417    }
418    
419    
420    /* Load a font matching the font related attributes in FACE->lface and
421       font pattern in FONT_DEF of FONTSET, and return an index of the
422       font.  FONT_DEF has this form:
423            [ FONT-SPEC ENCODING REPERTORY ]
424       If REPERTORY is nil, generate a char-table representing the font
425       repertory by looking into the font itself.  */
426    
427    static int
428    load_font_get_repertory (f, face, font_def, fontset)
429         FRAME_PTR f;
430         struct face *face;
431         Lisp_Object font_def;
432         Lisp_Object fontset;
433    {
434      char *font_name;
435      struct font_info *font_info;
436    
437      font_name = choose_face_font (f, face->lface, AREF (font_def, 0));
438      if (! (font_info = fs_load_font (f, font_name, XINT (AREF (font_def, 1)))))
439        return -1;
440    
441      if (NILP (AREF (font_def, 2))
442          && NILP (Fassq (make_number (font_info->font_idx),
443                          FONTSET_REPERTORY (fontset))))
444      {      {
445        int from = XINT (XCAR (idx));        /* We must look into the font to get the correct repertory as a
446        int to = XINT (XCDR (idx));           char-table.  */
447          Lisp_Object repertory;
448    
449        if (from == to)        repertory = (*get_font_repertory_func) (f, font_info);
450          CHAR_TABLE_SET (fontset, from, elt);        FONTSET_REPERTORY (fontset)
451        else          = Fcons (Fcons (make_number (font_info->font_idx), repertory),
452          Fset_char_table_range (fontset, idx, elt);                   FONTSET_REPERTORY (fontset));        
453      }      }
454            
455      return font_info->font_idx;
456  }  }
457    
458    
459  /* Return a face registerd in the realized fontset FONTSET for the  /* Return a face ID registerd in the realized fontset FONTSET for the
460     character C.  Return -1 if a face ID is not yet set.  */     character C.  If FACE is NULL, return -1 if a face is not yet
461       set.  Otherwise, realize a proper face from FACE and return it.  */
462    
463  static struct face *  static int
464  fontset_face (fontset, c)  fontset_face (fontset, c, face)
465       Lisp_Object fontset;       Lisp_Object fontset;
466       int c;       int c;
467         struct face *face;
468  {  {
469    Lisp_Object base, elt;    Lisp_Object elt, vec;
470    int id;    int i, from, to;
471    struct face *face;    int font_idx;
472      FRAME_PTR f = XFRAME (FONTSET_FRAME (fontset));
473    
474    base = FONTSET_BASE (fontset);    elt = CHAR_TABLE_REF (fontset, c);
   FONTSET_REF (base, c, elt);  
475    
476      if (EQ (elt, Qt))
477        goto font_not_found;
478    if (NILP (elt))    if (NILP (elt))
479      return NULL;      {
480          /* We have not yet decided a face for C.  */
481          Lisp_Object base_fontset, range;
482    
483    elt = Fassoc (elt, FONTSET_FACE_ALIST (fontset));        if (! face)
484    if (! CONSP (elt))          return -1;
485      return NULL;        base_fontset = FONTSET_BASE (fontset);
486    id = XINT (XCDR (elt));        elt = FONTSET_REF_AND_RANGE (base_fontset, c, from, to);
487    face = FACE_FROM_ID (XFRAME (FONTSET_FRAME (fontset)), id);        range = Fcons (make_number (from), make_number (to));
488    return face;        if (NILP (elt))
489            {
490              /* Record that we have no font for characters of this
491                 range.  */
492              FONTSET_SET (fontset, range, Qt);
493              goto font_not_found;
494            }
495          elt = Fcopy_sequence (elt);
496          /* Now ELT is a vector of FONT-DEFs.  We at first change it to
497             FONT-VECTOR, a vector of [ nil nil FONT-DEF ].  */
498          for (i = 0; i < ASIZE (elt); i++)
499            {
500              Lisp_Object tmp;
501    
502              tmp = Fmake_vector (make_number (3), Qnil);
503              ASET (tmp, 2, AREF (elt, i));
504              ASET (elt, i, tmp);
505            }
506          /* Then store (-1 . FONT-VECTOR) in the fontset.  -1 is to force
507             reordering of FONT-VECTOR.  */
508          elt = Fcons (make_number (-1), elt);
509          FONTSET_SET (fontset, range, elt);
510        }
511    
512      if (XINT (XCAR (elt)) != charset_ordered_list_tick)
513        /* The priority of charsets is changed after we selected a face
514           for C last time.  */
515        reorder_font_vector (elt);
516    
517      vec = XCDR (elt);
518      /* Find the first available font in the font vector VEC.  */
519      for (i = 0; i < ASIZE (vec); i++)
520        {
521          Lisp_Object font_def;
522    
523          elt = AREF (vec, i);
524          /* ELT == [ FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ] ] */
525          font_def = AREF (elt, 2);
526          if (INTEGERP (AREF (elt, 1)) && XINT (AREF (elt, 1)) < 0)
527            /* We couldn't open this font last time.  */
528            continue;
529    
530          if (!face && (NILP (AREF (elt, 1)) || NILP (AREF (elt, 0))))
531            /* We have not yet opened the font, or we have not yet made a
532               realized face for the font.  */
533            return -1;
534    
535          if (INTEGERP (AREF (font_def, 2)))
536            {
537              /* The repertory is specified by charset ID.  */
538              struct charset *charset
539                = CHARSET_FROM_ID (XINT (AREF (font_def, 2)));
540    
541              if (! CHAR_CHARSET_P (c, charset))
542                /* This fond can't display C.  */
543                continue;
544            }
545          else
546            {
547              Lisp_Object slot;
548    
549              if (! INTEGERP (AREF (elt, 1)))
550                {
551                  /* We have not yet opened a font matching this spec.
552                     Open the best matching font now and register the
553                     repertory.  */
554                  font_idx = load_font_get_repertory (f, face, font_def, fontset);
555                  ASET (elt, 1, make_number (font_idx));
556                  if (font_idx < 0)
557                    /* This means that we couldn't find a font matching
558                       FONT_DEF.  */
559                    continue;
560                }
561    
562              slot = Fassq (AREF (elt, 1), FONTSET_REPERTORY (fontset));
563              if (! CONSP (slot))
564                abort ();
565              if (NILP (CHAR_TABLE_REF (XCDR (slot), c)))
566                /* This fond can't display C.  */
567                continue;
568            }
569    
570          /* Now we have decided to use this font spec to display C.  */
571          if (INTEGERP (AREF (elt, 1)))
572            font_idx = XINT (AREF (elt, 1));
573          else
574            {
575              /* But not yet opened the best matching font.  */
576              font_idx = load_font_get_repertory (f, face, font_def, fontset);
577              ASET (elt, 1, make_number (font_idx));
578              if (font_idx < 0)
579                continue;
580            }
581    
582          /* Now we have the opened font.  */
583          if (NILP (AREF (elt, 0)))
584            {
585              /* But not yet made a realized face that uses this font.  */
586              int face_id = lookup_non_ascii_face (f, font_idx, face);
587    
588              ASET (elt, 0, make_number (face_id));
589            }
590    
591          /* Ok, this face can display C.  */
592          return XINT (AREF (elt, 0));
593        }
594    
595     font_not_found:
596      /* We have tried all the fonts for C, but none of them can be opened
597         nor can display C.  */
598      if (NILP (FONTSET_NOFONT_FACE (fontset)))
599        {
600          int face_id;
601    
602          if (! face)
603            return -1;
604          face_id = lookup_non_ascii_face (f, -1, face);
605          FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
606        }
607      return XINT (FONTSET_NOFONT_FACE (fontset));
608  }  }
609    
610    
# Line 341  make_fontset (frame, name, base) Line 629  make_fontset (frame, name, base)
629    
630    if (id + 1 == size)    if (id + 1 == size)
631      {      {
632          /* We must grow Vfontset_table.  */
633        Lisp_Object tem;        Lisp_Object tem;
634        int i;        int i;
635    
# Line 371  make_fontset (frame, name, base) Line 660  make_fontset (frame, name, base)
660    
661    
662    
663  /********** INTERFACES TO xfaces.c and dispextern.h **********/  /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
664    
665  /* Return name of the fontset with ID.  */  /* Return the name of the fontset who has ID.  */
666    
667  Lisp_Object  Lisp_Object
668  fontset_name (id)  fontset_name (id)
# Line 386  fontset_name (id) Line 675  fontset_name (id)
675  }  }
676    
677    
678  /* Return ASCII font name of the fontset with ID.  */  /* Return the ASCII font name of the fontset who has ID.  */
679    
680  Lisp_Object  Lisp_Object
681  fontset_ascii (id)  fontset_ascii (id)
682       int id;       int id;
683  {  {
684    Lisp_Object fontset;    Lisp_Object fontset, elt;
685    
686    fontset= FONTSET_FROM_ID (id);    fontset= FONTSET_FROM_ID (id);
687    return FONTSET_ASCII (fontset);    elt = FONTSET_ASCII (fontset);
688      /* It is assured that ELT is always a string (i.e. fontname
689         pattern).  */
690      return elt;
691  }  }
692    
693    
# Line 407  free_face_fontset (f, face) Line 699  free_face_fontset (f, face)
699       FRAME_PTR f;       FRAME_PTR f;
700       struct face *face;       struct face *face;
701  {  {
702    AREF (Vfontset_table, face->fontset) = Qnil;    ASET (Vfontset_table, face->fontset, Qnil);
703    if (face->fontset < next_fontset_id)    if (face->fontset < next_fontset_id)
704      next_fontset_id = face->fontset;      next_fontset_id = face->fontset;
705  }  }
# Line 425  face_suitable_for_char_p (face, c) Line 717  face_suitable_for_char_p (face, c)
717    Lisp_Object fontset;    Lisp_Object fontset;
718    
719    fontset = FONTSET_FROM_ID (face->fontset);    fontset = FONTSET_FROM_ID (face->fontset);
720    return (face == fontset_face (fontset, c));    return (face->id == fontset_face (fontset, c, NULL));
721  }  }
722    
723    
724  /* Return ID of face suitable for displaying character C on frame F.  /* Return ID of face suitable for displaying character C on frame F.
725     The selection of face is done based on the fontset of FACE.  FACE     FACE must be reazlied for ASCII characters in advance.  Called from
726     must be reazlied for ASCII characters in advance.  Called from the     the macro FACE_FOR_CHAR.  */
    macro FACE_FOR_CHAR when C is not an ASCII character.  */  
727    
728  int  int
729  face_for_char (f, face, c)  face_for_char (f, face, c)
# Line 441  face_for_char (f, face, c) Line 732  face_for_char (f, face, c)
732       int c;       int c;
733  {  {
734    Lisp_Object fontset;    Lisp_Object fontset;
735    struct face *new_face;    Lisp_Object elt, vec;
736      int font_idx;
737      int i;
738    
739      if (ASCII_CHAR_P (c))
740        return face->ascii_face->id;
741    
742    xassert (fontset_id_valid_p (face->fontset));    xassert (fontset_id_valid_p (face->fontset));
743    fontset = FONTSET_FROM_ID (face->fontset);    fontset = FONTSET_FROM_ID (face->fontset);
744    xassert (!BASE_FONTSET_P (fontset));    xassert (!BASE_FONTSET_P (fontset));
745      return fontset_face (fontset, c, face);
   new_face = fontset_face (fontset, c);  
   if (new_face)  
     return new_face->id;  
   
   /* No face is recorded for C in the fontset of FACE.  Make a new  
      realized face for C that has the same fontset.  */  
   return lookup_face (f, face->lface, c, face);  
746  }  }
747    
748    
# Line 463  face_for_char (f, face, c) Line 752  face_for_char (f, face, c)
752     Called from realize_x_face.  */     Called from realize_x_face.  */
753    
754  int  int
755  make_fontset_for_ascii_face (f, base_fontset_id)  make_fontset_for_ascii_face (f, base_fontset_id, face)
756       FRAME_PTR f;       FRAME_PTR f;
757       int base_fontset_id;       int base_fontset_id;
758         struct face *face;
759  {  {
760    Lisp_Object base_fontset, fontset, frame;    Lisp_Object base_fontset, fontset, frame;
761    
# Line 476  make_fontset_for_ascii_face (f, base_fon Line 766  make_fontset_for_ascii_face (f, base_fon
766        if (!BASE_FONTSET_P (base_fontset))        if (!BASE_FONTSET_P (base_fontset))
767          base_fontset = FONTSET_BASE (base_fontset);          base_fontset = FONTSET_BASE (base_fontset);
768        xassert (BASE_FONTSET_P (base_fontset));        xassert (BASE_FONTSET_P (base_fontset));
769          if (! BASE_FONTSET_P (base_fontset))
770            abort ();
771      }      }
772    else    else
773      base_fontset = Vdefault_fontset;      base_fontset = Vdefault_fontset;
774    
775    fontset = make_fontset (frame, Qnil, base_fontset);    fontset = make_fontset (frame, Qnil, base_fontset);
776    return XINT (FONTSET_ID (fontset));    {
777  }      Lisp_Object elt;
   
   
 /* Return FONT-SPEC recorded in the fontset of FACE for character C.  
    If FACE is null, or the fontset doesn't contain information about  
    C, get the font name pattern from the default fontset.  Called from  
    choose_face_font.  */  
   
 Lisp_Object  
 fontset_font_pattern (f, face, c)  
      FRAME_PTR f;  
      struct face *face;  
      int c;  
 {  
   Lisp_Object fontset, base, elt;  
   int id = face ? face->fontset : -1;  
   
   if (id >= 0)  
     {  
       fontset = FONTSET_FROM_ID (id);  
       xassert (!BASE_FONTSET_P (fontset));  
       base = FONTSET_BASE (fontset);  
     }  
   else  
     {  
       base = Vdefault_fontset;  
     }  
   
   FONTSET_REF (base, c, elt);  
   if (face && ! NILP (elt))  
     {  
       Lisp_Object slot;  
778    
779        slot = Fassoc (elt, FONTSET_FACE_ALIST (fontset));      elt = FONTSET_REF (base_fontset, 0);
780        if (CONSP (slot))      elt = Fmake_vector (make_number (3), AREF (elt, 0));
781          XSETCDR (slot, make_number (face->id));      ASET (elt, 0, make_number (face->id));
782        FONTSET_FACE_ALIST (fontset)            ASET (elt, 1, make_number (face->font_info_id));
783          = Fcons (Fcons (elt, make_number (face->id)),      elt = Fcons (make_number (charset_ordered_list_tick),
784                   FONTSET_FACE_ALIST (fontset));                   Fmake_vector (make_number (1), elt));
785      }      char_table_set_range (fontset, 0, 127, elt);
786    return elt;    }
787      return XINT (FONTSET_ID (fontset));
788  }  }
789    
790    
# Line 532  fontset_font_pattern (f, face, c) Line 794  fontset_font_pattern (f, face, c)
794    
795  /* Load a font named FONTNAME on frame F.  Return a pointer to the  /* Load a font named FONTNAME on frame F.  Return a pointer to the
796     struct font_info of the loaded font.  If loading fails, return     struct font_info of the loaded font.  If loading fails, return
797     NULL.  */     NULL.  CHARSET_ID is an ID of charset to encode characters for this
798       font.  */
799    
800  struct font_info *  struct font_info *
801  fs_load_font (f, fontname)  fs_load_font (f, fontname, charset_id)
802       FRAME_PTR f;       FRAME_PTR f;
803       char *fontname;       char *fontname;
804         int charset_id;
805  {  {
   Lisp_Object tail, elt;  
806    struct font_info *fontp;    struct font_info *fontp;
807    
808    if (!fontname)    if (!fontname)
809      /* No way to get fontname.  */      /* No way to get fontname.  */
810      return 0;      return NULL;
811    
812    fontp = (*load_font_func) (f, fontname, 0);    fontp = (*load_font_func) (f, fontname, 0);
813    if (!fontp)    if (!fontp)
814      return NULL;      return NULL;
815    
816    fontname = fontp->full_name;    fontname = fontp->full_name;
   /* Fill in members (charset, vertical_centering, encoding, etc) of  
      font_info structure that are not set by (*load_font_func).  */  
   for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))  
     {  
       elt = XCAR (tail);  
       if (STRINGP (XCAR (elt)) && CHARSETP (XCDR (elt))  
           && fast_c_string_match_ignore_case (XCAR (elt), fontname) >= 0)  
         {  
           fontp->charset = XFASTINT (CHARSET_SYMBOL_ID (XCDR (elt)));  
           break;  
         }  
     }  
   if (! CONSP (tail))  
     return NULL;  
   
   fontp->vertical_centering  
     = (STRINGP (Vvertical_centering_font_regexp)  
        && (fast_c_string_match_ignore_case  
            (Vvertical_centering_font_regexp, fontname) >= 0));  
817    
818      fontp->charset = charset_id;
819      fontp->vertical_centering = 0;
820    fontp->font_encoder = NULL;    fontp->font_encoder = NULL;
821    
822    if (find_ccl_program_func)    if (charset_id != charset_ascii)
823      (*find_ccl_program_func) (fontp);      {
824          fontp->vertical_centering
825            = (STRINGP (Vvertical_centering_font_regexp)
826               && (fast_c_string_match_ignore_case
827                   (Vvertical_centering_font_regexp, fontname) >= 0));
828    
829          if (find_ccl_program_func)
830            (*find_ccl_program_func) (fontp);
831        }
832    
833    return fontp;    return fontp;
834  }  }
# Line 584  fs_load_font (f, fontname) Line 838  fs_load_font (f, fontname)
838  #endif  #endif
839    
840    
841    /* Return ENCODING or a cons(ENCODING REPERTORY) of the font FONTNAME.
842       ENCODING is a charset symbol that specifies the encoding of the
843       font.  REPERTORY is a charset symbol or nil.  */
844    
845    
846    static Lisp_Object
847    find_font_encoding (fontname)
848         char *fontname;
849    {
850      Lisp_Object tail, elt;
851    
852      for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))
853        {
854          elt = XCAR (tail);
855          if (CONSP (elt)
856              && STRINGP (XCAR (elt))
857              && fast_c_string_match_ignore_case (XCAR (elt), fontname) >= 0
858              && (SYMBOLP (XCDR (elt))
859                  ? CHARSETP (XCDR (elt))
860                  : CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt)))))
861            return (XCDR (elt));
862        }
863      /* We don't know the encoding of this font.  Let's assume Unicode
864         encoding.  */
865      return Qunicode;
866    }
867    
868    
869  /* Cache data used by fontset_pattern_regexp.  The car part is a  /* Cache data used by fontset_pattern_regexp.  The car part is a
870     pattern string containing at least one wild card, the cdr part is     pattern string containing at least one wild card, the cdr part is
871     the corresponding regular expression.  */     the corresponding regular expression.  */
# Line 738  list_fontsets (f, pattern, size) Line 1020  list_fontsets (f, pattern, size)
1020          continue;          continue;
1021        name = XSTRING (FONTSET_NAME (fontset))->data;        name = XSTRING (FONTSET_NAME (fontset))->data;
1022    
1023        if (!NILP (regexp)        if (STRINGP (regexp)
1024            ? (fast_c_string_match_ignore_case (regexp, name) < 0)            ? (fast_c_string_match_ignore_case (regexp, name) < 0)
1025            : strcmp (XSTRING (pattern)->data, name))            : strcmp (XSTRING (pattern)->data, name))
1026          continue;          continue;
# Line 811  check_fontset_name (name) Line 1093  check_fontset_name (name)
1093    return FONTSET_FROM_ID (id);    return FONTSET_FROM_ID (id);
1094  }  }
1095    
1096  DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,  static void
1097         doc: /* Modify fontset NAME to use FONT-SPEC for characters of CHARSETS.  accumulate_script_ranges (arg, range, val)
1098         Lisp_Object arg, range, val;
1099    {
1100      if (EQ (XCAR (arg), val))
1101        {
1102          if (CONSP (range))
1103            XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1104          else
1105            XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1106        }
1107    }
1108    
1109    
1110    DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
1111           doc: /*
1112    Modify fontset NAME to use FONT-SPEC for CHARACTER.
1113    
1114    CHARACTER may be a cons; (FROM . TO), where FROM and TO are
1115    characters.  In that case, use FONT-SPEC for all characters in the
1116    range FROM and TO (inclusive).
1117    
1118    CHARACTER may be a script name symbol.  In that case, use FONT-SPEC
1119    for all characters that belong to the script.
1120    
1121  CHARSET may be a cons; (FROM . TO), where FROM and TO are characters.  CHARACTER may be a charset who has :code-offset attribute and the
1122  In that case, use FONT-SPEC for all characters in the range FROM and  attribute value is greater than the maximum Unicode character
1123  TO (inclusive).  \(#x10FFFF).  In that case, use FONT-SPEC for all characters in the
1124    charset.
1125    
1126  FONT-SPEC is be a vector; [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ]  FONT-SPEC is a vector; [ FAMILY WEIGHT SLANT ADSTYLE REGISTRY ].
1127    See the documentation of `set-face-attribute' for the detail of
1128    these vector elements.
1129    
1130    FONT-SPEC may be a cons; (FAMILY . REGISTRY).
1131    
1132  FONT-SPEC may be a cons; (FAMILY . REGISTRY), where FAMILY is a family  FONT-SPEC may be a font name string.
 name of a font, REGSITRY is a registry name of a font.  
1133    
1134  FONT-SPEC may be a font name string.  */)  Optional 4th argument FRAME, if non-nil, is a frame.  This argument is
1135       (name, charset, font_spec, frame)  kept for backward compatibility and has no meaning.
1136       Lisp_Object name, charset, font_spec, frame;  
1137    Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1138    to the font specifications for RANGE previously set.  If it is
1139    `prepend', FONT-SPEC is prepended.  If it is `append', FONT-SPEC is
1140    appended.  By default, FONT-SPEC overrides the previous settings.  */)
1141         (name, character, font_spec, frame, add)
1142         Lisp_Object name, character, font_spec, frame, add;
1143  {  {
1144    Lisp_Object fontset;    Lisp_Object fontset;
1145    Lisp_Object family, registry;    int i;
1146      Lisp_Object font_def, registry;
1147      Lisp_Object val, encoding, repertory;
1148      Lisp_Object range_list;
1149    
1150    fontset = check_fontset_name (name);    fontset = check_fontset_name (name);
1151    
1152      /* The arg FRAME is kept for backward compatibility.  We only check
1153         the validity.  */
1154      if (!NILP (frame))
1155        CHECK_LIVE_FRAME (frame);
1156    
1157    if (VECTORP (font_spec))    if (VECTORP (font_spec))
1158      {      {
1159        int i;        int j;
1160        Lisp_Object val;  
1161          if (ASIZE (font_spec) != 6)
1162            args_out_of_range (make_number (6),
1163                               make_number (ASIZE (font_spec)));
1164    
1165        font_spec = Fcopy_sequence (font_spec);        font_spec = Fcopy_sequence (font_spec);
1166        for (i = 0; i < 5; i++)        for (j = 0; j < 5; j++)
1167          {          if (! NILP (AREF (font_spec, j)))
1168            val = Faref (font_spec, make_number (i));            {
1169            if (! NILP (val))              CHECK_STRING (AREF (font_spec, j));
1170              {              ASET (font_spec, j, Fdowncase (AREF (font_spec, j)));
1171                CHECK_STRING (val);            }
1172                ASET (font_spec, i, Fdowncase (val));        /* REGISTRY should not be omitted.  */
1173              }        CHECK_STRING (AREF (font_spec, 5));
1174          }        registry = Fdowncase (AREF (font_spec, 5));
1175        val = Faref (font_spec, make_number (5));        ASET (font_spec, 5, registry);
1176        CHECK_STRING (val);  
       ASET (font_spec, 5, Fdowncase (val));  
1177      }      }
   else if (STRINGP (font_spec))  
     font_spec = Fdowncase (font_spec);  
1178    else if (CONSP (font_spec))    else if (CONSP (font_spec))
1179      {      {
1180        CHECK_CONS (font_spec);        Lisp_Object family;
1181    
1182        family = XCAR (font_spec);        family = XCAR (font_spec);
1183        registry = XCDR (font_spec);        registry = XCDR (font_spec);
1184        font_spec = Fmake_vector (make_number (6), Qnil);  
1185        if (!NILP (family))        if (! NILP (family))
1186          {          {
1187            CHECK_STRING (family);            CHECK_STRING (family);
1188            ASET (font_spec, 0, Fdowncase (family));            family = Fdowncase (family);
1189          }          }
1190        CHECK_STRING (registry);        CHECK_STRING (registry);
1191        ASET (font_spec, 5, Fdowncase (registry));        registry = Fdowncase (registry);
1192          font_spec = Fmake_vector (make_number (6), Qnil);
1193          ASET (font_spec, 0, family);
1194          ASET (font_spec, 5, registry);
1195      }      }
1196      else
   if (SYMBOLP (charset))  
1197      {      {
1198        CHECK_CHARSET (charset);        CHECK_STRING (font_spec);
1199          font_spec = Fdowncase (font_spec);
1200          registry = font_name_registry (font_spec);
1201          if (NILP (registry))
1202            error ("No XLFD: %s", XSTRING (font_spec)->data);
1203      }      }
1204    
1205      if (STRINGP (font_spec))
1206        encoding = find_font_encoding ((char *) XSTRING (font_spec)->data);
1207    else    else
1208        encoding = find_font_encoding ((char *) XSTRING (registry)->data);
1209      if (SYMBOLP (encoding))
1210        encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1211      else
1212        {
1213          repertory = XCDR (encoding);
1214          encoding = CHARSET_SYMBOL_ID (XCAR (encoding));
1215        }
1216      font_def = Fmake_vector (make_number (3), font_spec);
1217      ASET (font_def, 1, encoding);
1218      ASET (font_def, 2, repertory);
1219    
1220      if (CHARACTERP (character))
1221        range_list = Fcons (Fcons (character, character), Qnil);
1222      else if (CONSP (character))
1223      {      {
1224        Lisp_Object from, to;        Lisp_Object from, to;
1225    
1226        /* CHARSET should be (FROM . TO).  */        from = Fcar (character);
1227        from = Fcar (charset);        to = Fcdr (character);
       to = Fcdr (charset);  
1228        CHECK_CHARACTER (from);        CHECK_CHARACTER (from);
1229        CHECK_CHARACTER (to);        CHECK_CHARACTER (to);
1230          range_list = Fcons (character, Qnil);
1231      }      }
1232      else
1233        {
1234          Lisp_Object script_list;
1235          Lisp_Object val;
1236    
1237    /* The arg FRAME is kept for backward compatibility.  We only check        CHECK_SYMBOL (character);
1238       the validity.  */        range_list = Qnil;
1239    if (!NILP (frame))        script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
1240      CHECK_LIVE_FRAME (frame);        if (! NILP (Fmemq (character, script_list)))
1241            {
1242              val = Fcons (character, Qnil);
1243              map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
1244                              val, 0, NULL);
1245              range_list = XCDR (val);
1246              if (EQ (character, Qascii))
1247                {
1248                  if (! STRINGP (font_spec))
1249                    font_spec = generate_ascii_font_name (FONTSET_NAME (fontset),
1250                                                          font_spec);
1251                  FONTSET_ASCII (fontset) = font_spec;
1252                }
1253            }
1254          else if (CHARSETP (character))
1255            {
1256              struct charset *charset;
1257    
1258              CHECK_CHARSET_GET_CHARSET (character, charset);
1259              if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET)
1260                range_list
1261                  = Fcons (Fcons (make_number (CHARSET_MIN_CHAR (charset)),
1262                                  make_number (CHARSET_MAX_CHAR (charset))),
1263                           range_list);
1264            }
1265    
1266          if (NILP (range_list))
1267            error ("Invalid script or charset name: %s",
1268                   XSYMBOL (character)->name->data);
1269        }
1270    
1271    FONTSET_SET (fontset, charset, font_spec);    for (; CONSP (range_list); range_list = XCDR (range_list))
1272        FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
1273    
1274    /* Free all realized fontsets whose base is FONTSET.  This way, the    /* Free all realized fontsets whose base is FONTSET.  This way, the
1275       specified character(s) are surely redisplayed by a correct       specified character(s) are surely redisplayed by a correct
# Line 902  FONT-SPEC may be a font name string.  */ Line 1283  FONT-SPEC may be a font name string.  */
1283  DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,  DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1284         doc: /* Create a new fontset NAME from font information in FONTLIST.         doc: /* Create a new fontset NAME from font information in FONTLIST.
1285    
1286  FONTLIST is an alist of charsets vs corresponding font specifications.  FONTLIST is an alist of scripts vs the corresponding font specification list.
1287  Each element of FONTLIST has the form (CHARSET . FONT-SPEC), where  Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where
1288  a character of CHARSET is displayed by a font that matches FONT-SPEC.  a character of SCRIPT is displayed by a font that matches FONT-SPEC.
   
 FONT-SPEC is a vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ], where  
 FAMILY is a string specifying the font family,  
 WEIGHT is a string specifying the weight of the font,  
 SLANT is a string specifying the slant of the font,  
 WIDTH is a string specifying the width of the font,  
 ADSTYLE is a string specifying the adstyle of the font,  
 REGISTRY is a string specifying the charset-registry of the font.  
1289    
1290  See also the documentation of `set-face-attribute' for the detail of  SCRIPT is a symbol that appears in the variable `script-alist'.
 these vector elements.  
1291    
1292  FONT-SPEC may be a font name (string).  */)  FONT-SPEC is a vector, a cons, or a string.  See the documentation of
1293    `set-fontset-font' for the meaning.  */)
1294    (name, fontlist)    (name, fontlist)
1295       Lisp_Object name, fontlist;       Lisp_Object name, fontlist;
1296  {  {
1297    Lisp_Object fontset, ascii_font;    Lisp_Object fontset;
1298    Lisp_Object tem, tail;    Lisp_Object val;
1299      int id;
1300    
1301    CHECK_STRING (name);    CHECK_STRING (name);
1302    CHECK_LIST (fontlist);    CHECK_LIST (fontlist);
1303    
1304    name = Fdowncase (name);    /* Check if an ASCII font is specified in FONTLIST.  */
1305    tem = Fquery_fontset (name, Qnil);    val = Fcar (Fcdr (Fassq (Qascii, fontlist)));
1306    if (! NILP (tem))    if (NILP (val))
     free_realized_fontsets (tem);  
   
   fontset = make_fontset (Qnil, name, Qnil);  
   
   /* Check the validity of FONTLIST.  */  
   ascii_font = Fcdr (Fassq (Qascii, fontlist));  
   if (NILP (ascii_font))  
1307      error ("No ascii font specified");      error ("No ascii font specified");
   if (! STRINGP (ascii_font))  
     ascii_font = generate_ascii_font (name, ascii_font);  
1308    
1309    fontlist = Fcopy_sequence (fontlist);    id = fs_query_fontset (name, 0);
1310    for (tail = fontlist; ! NILP (tail); tail = Fcdr (tail))    if (id < 0)
1311      Fset_fontset_font (name, Fcar (Fcar (tail)), Fcdr (Fcar (tail)), Qnil);      fontset = make_fontset (Qnil, Fdowncase (name), Qnil);
1312      else
1313        {
1314          fontset = FONTSET_FROM_ID (id);;
1315          free_realized_fontsets (fontset);
1316          Fset_char_table_range (fontset, Qt, Qnil);
1317        }
1318    
1319    FONTSET_ASCII (fontset) = ascii_font;    for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
1320        {
1321          Lisp_Object elt, script;
1322    
1323          elt = Fcar (fontlist);
1324          script = Fcar (elt);
1325          elt = Fcdr (elt);
1326          Fset_fontset_font (name, script, Fcar (elt), Qnil, Qnil);
1327          for (elt = Fcdr (elt); ! NILP (elt); elt = Fcdr (elt))
1328            Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
1329        }
1330    return name;    return name;
1331  }  }
1332    
# Line 1051  DEFUN ("internal-char-font", Finternal_c Line 1431  DEFUN ("internal-char-font", Finternal_c
1431  }  }
1432    
1433    
1434  #if 0                           /* unused */  DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1435  /* Called from Ffontset_info via map_char_table on each leaf of         doc: /* Return information about a fontset FONTSET on frame FRAME.
1436     fontset.  ARG is a list (LAST FONT-INFO ...), where LAST is `(last  The value is a char-table of which elements has this form.
    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..  */  
1437    
1438  static void      ((FONT-PATTERN OPENED-FONT ...) ...)
 accumulate_font_info (arg, character, elt)  
      Lisp_Object arg, character, elt;  
 {  
   Lisp_Object last, last_char, last_elt;  
1439    
1440    if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))  FONT-PATTERN is a vector:
     FONTSET_REF (Vdefault_fontset, XINT (character), elt);  
   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)))  
     {  
       struct charset *this_charset = CHAR_CHARSET (XINT (character));  
1441    
1442        if (CONSP (last_char))    /* LAST_CHAR == (FROM . TO)  */          [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
         {  
           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));  
 }  
 #endif /* 0 */  
1443    
1444  DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,  or a string of font name pattern.
1445         doc: /* Return information about a fontset named NAME on frame FRAME.  
1446  The value is a vector:  OPENED-FONT is a name of a font actually opened.  */)
1447    [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],       (fontset, frame)
1448  where,       Lisp_Object fontset, frame;
   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 or a cons of two characters specifying  
     the range of characters.  
   FONT-SPEC is a fontname pattern string or a vector  
     [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].  
     See the documentation of `new-fontset' for the meanings those elements.  
   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;  
1449  {  {
   Lisp_Object fontset;  
1450    FRAME_PTR f;    FRAME_PTR f;
1451    Lisp_Object val, tail, elt;    Lisp_Object table, val, elt;
1452    Lisp_Object *realized;    Lisp_Object *realized;
1453    struct font_info *fontp = NULL;    struct font_info *fontp = NULL;
1454    int n_realized = 0;    int n_realized = 0;
1455    int i;    int c, i, j;
1456    
1457    (*check_window_system_func) ();    (*check_window_system_func) ();
1458    
1459    fontset = check_fontset_name (name);    fontset = check_fontset_name (fontset);
1460    
1461    if (NILP (frame))    if (NILP (frame))
1462      frame = selected_frame;      frame = selected_frame;
1463    CHECK_LIVE_FRAME (frame);    CHECK_LIVE_FRAME (frame);
1464    f = XFRAME (frame);    f = XFRAME (frame);
1465    
1466    /* Recode realized fontsets whose base is FONTSET in the table    /* Recode fontsets realized on FRAME from the base fontset FONTSET
1467       `realized'.  */       in the table `realized'.  */
1468    realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)    realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1469                                       * ASIZE (Vfontset_table));                                       * ASIZE (Vfontset_table));
1470    for (i = 0; i < ASIZE (Vfontset_table); i++)    for (i = 0; i < ASIZE (Vfontset_table); i++)
1471      {      {
1472        elt = FONTSET_FROM_ID (i);        elt = FONTSET_FROM_ID (i);
1473        if (!NILP (elt)        if (!NILP (elt)
1474            && EQ (FONTSET_BASE (elt), fontset))            && EQ (FONTSET_BASE (elt), fontset)
1475              && EQ (FONTSET_FRAME (elt), frame))
1476          realized[n_realized++] = elt;          realized[n_realized++] = elt;
1477      }      }
1478    
1479    /* Accumulate information of the fontset in VAL.  The format is  
1480       (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE    table = Fmake_char_table (Qnil, Qnil);
1481       FONT-SPEC).  See the comment for accumulate_font_info for the    /* Accumulate information of the fontset in TABLE.  The format of
1482       detail.  */       each element is ((FONT-SPEC OPENED-FONT ...) ...).  */
1483    val = Fcons (Fcons (Qascii, Fcons (FONTSET_ASCII (fontset), Qnil)), Qnil);    for (c = 0; c <= MAX_CHAR; )
   val = Fcons (val, val);  
   for (i = 128; i <= MAX_CHAR; )  
1484      {      {
       Lisp_Object elt;  
1485        int from, to;        int from, to;
1486    
1487        elt = char_table_ref_and_range (fontset, i, &from, &to);        val = FONTSET_REF_AND_RANGE (fontset, c, from, to);
1488        if (! NILP (elt))        if (VECTORP (val))
1489          {          {
1490            elt = Fcons (Fcons (make_number (from), make_number (to)),            Lisp_Object alist;
                        Fcons (elt, Qnil));  
           XSETCDR (XCAR (val), Fcons (elt, Qnil));  
           XSETCAR (val, XCDR (XCAR (val)));  
         }  
       i = to + 1;  
     }  
   
   for (tail = FONTSET_CHARSET_ALIST (fontset);  
        CONSP (tail); tail = XCDR (tail))  
     {  
       elt = XCAR (tail);  
       elt = Fcons ((INTEGERP (XCAR (elt))  
                     ? CHARSET_NAME (CHARSET_FROM_ID (XFASTINT (XCAR (elt))))  
                     : XCAR (elt)),  
                    Fcons (XCDR (elt), Qnil));  
       XSETCDR (XCAR (val), Fcons (elt, Qnil));  
       XSETCAR (val, XCDR (XCAR (val)));  
     }  
1491    
1492    val = XCDR (val);            /* At first, set ALIST to ((FONT-SPEC) ...).  */
1493              for (alist = Qnil, i = 0; i < ASIZE (val); i++)
1494    /* If fonts are opened for FONT-SPEC, append the names of the fonts to              alist = Fcons (Fcons (AREF (AREF (val, i), 0), Qnil), alist);
1495       FONT-SPEC.  */            alist = Fnreverse (alist);
   for (tail = val; CONSP (tail); tail = XCDR (tail))  
     {  
       elt = XCAR (tail);  
       for (i = 0; i < n_realized; i++)  
         {  
           Lisp_Object face_list, fontname;  
1496    
1497            for (face_list = FONTSET_FACE_ALIST (realized[i]);            /* Then store opend font names to cdr of each elements.  */
1498                 CONSP (face_list); face_list = XCDR (face_list))            for (i = 0; i < n_realized; i++)
1499              {              {
1500                int face_id = XINT (XCDR (XCAR (face_list)));                val = FONTSET_REF (realized[i], c);
1501                struct face *face = FACE_FROM_ID (f, face_id);                if (NILP (val))
1502                    continue;
1503                if (face->font && face->font_name)                val = XCDR (val);
1504                  {                /* Now VAL is [[FACE-ID FONT-INDEX FONT-DEF] ...].
1505                    fontname = build_string (face->font_name);                   If a font of an element is already opened,
1506                    if (NILP (Fmember (fontname, XCDR (XCDR (elt)))))                   FONT-INDEX of the element is integer.  */
1507                      XSETCDR (XCDR (elt), Fcons (fontname, XCDR (XCDR (elt))));                for (j = 0; j < ASIZE (val); j++)
1508                  }                  if (INTEGERP (AREF (AREF (val, j), 0)))
1509                      {
1510                        Lisp_Object font_idx;
1511    
1512                        font_idx = AREF (AREF (val, j), 1);
1513                        elt = Fassq (AREF (AREF (AREF (val, j), 2), 0), alist);
1514                        if (CONSP (elt)
1515                            && NILP (Fmemq (font_idx, XCDR(elt))))
1516                          nconc2 (elt, Fcons (font_idx, Qnil));
1517                      }
1518              }              }
1519              for (val = alist; CONSP (val); val = XCDR (val))
1520                for (elt = XCDR (XCAR (val)); CONSP (elt); elt = XCDR (elt))
1521                  {
1522                    struct font_info *font_info
1523                      = (*get_font_info_func) (f, XINT (XCAR (elt)));
1524                    XSETCAR (elt, build_string (font_info->full_name));
1525                  }
1526    
1527              /* Store ALIST in TABLE for characters C..TO.  */
1528              char_table_set_range (table, c, to, alist);
1529          }          }
1530          c = to + 1;
1531      }      }
1532    
1533    elt = XCDR (XCDR (XCAR (val)));    return table;
   if (CONSP (elt))  
     fontp = (*query_font_func) (f, XSTRING (XCAR (elt))->data);  
   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;  
1534  }  }
1535    
1536    
1537  DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,  DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
1538         doc: /* Return a font name pattern for character CH in fontset NAME.         doc: /* Return a font name pattern for character CH in fontset NAME.
1539  If NAME is t, find a font name pattern in the default fontset.  */)  If NAME is t, find a font name pattern in the default fontset.  */)
# Line 1229  If NAME is t, find a font name pattern i Line 1547  If NAME is t, find a font name pattern i
1547    
1548    CHECK_CHARACTER (ch);    CHECK_CHARACTER (ch);
1549    c = XINT (ch);    c = XINT (ch);
1550    FONTSET_REF (fontset, c, elt);    elt = FONTSET_REF (fontset, c);
1551    return elt;    return Fcopy_sequence (elt);
1552  }  }
1553    
1554  DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,  DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
# Line 1259  syms_of_fontset () Line 1577  syms_of_fontset ()
1577      /* Window system initializer should have set proper functions.  */      /* Window system initializer should have set proper functions.  */
1578      abort ();      abort ();
1579    
1580    Qfontset = intern ("fontset");    DEFSYM (Qfontset, "fontset");
   staticpro (&Qfontset);  
1581    Fput (Qfontset, Qchar_table_extra_slots, make_number (7));    Fput (Qfontset, Qchar_table_extra_slots, make_number (7));
1582    
1583      DEFSYM (Qprepend, "prepend");
1584      DEFSYM (Qappend, "append");
1585    
1586    Vcached_fontset_data = Qnil;    Vcached_fontset_data = Qnil;
1587    staticpro (&Vcached_fontset_data);    staticpro (&Vcached_fontset_data);
1588    
# Line 1293  syms_of_fontset () Line 1613  syms_of_fontset ()
1613    next_fontset_id = 1;    next_fontset_id = 1;
1614    
1615    DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,    DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
1616                 doc: /* Alist of fontname patterns vs corresponding encoding info.                 doc: /*
1617  Each element looks like (REGEXP . CHARSET), where CHARSET is an  Alist of fontname patterns vs the corresponding encoding and repertory info.
1618  Emacs charset symbol.  */);  Each element looks like (REGEXP . (ENCODING . REPERTORY)),
1619    where ENCODING is a charset or a char-table,
1620    and REPERTORY is a charset, a char-table, or nil.  
1621    
1622    ENCODING is for converting a character to a glyph code of the font.
1623    If ENCODING is a charset, encoding a character by the charset gives
1624    the corresponding glyph code.  If ENCODING is a char-table, looking up
1625    the table by a character gives the corresponding glyph code.
1626    
1627    REPERTORY specifies a repertory of characters supported by the font.
1628    If REPERTORY is a charset, all characters beloging to the charset are
1629    supported.  If REPERTORY is a char-table, all characters who have a
1630    non-nil value in the table are supported.  It REPERTORY is nil, Emacs
1631    gets the repertory information by an opened font and ENCODING.  */);
1632    Vfont_encoding_alist = Qnil;    Vfont_encoding_alist = Qnil;
1633    
1634    DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,    DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
1635                 doc: /* Char table of characters whose ascent values should be ignored.                 doc: /*
1636    Char table of characters whose ascent values should be ignored.
1637  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
1638  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.
1639    
# Line 1308  such a character is displayed on screen. Line 1642  such a character is displayed on screen.
1642    Vuse_default_ascent = Qnil;    Vuse_default_ascent = Qnil;
1643    
1644    DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,    DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
1645                 doc: /* Char table of characters which is not composed relatively.                 doc: /*
1646    Char table of characters which is not composed relatively.
1647  If an entry for a character is non-nil, a composition sequence  If an entry for a character is non-nil, a composition sequence
1648  which contains that character is displayed so that  which contains that character is displayed so that
1649  the glyph of that character is put without considering  the glyph of that character is put without considering

Legend:
Removed from v.1.65.2.6  
changed lines
  Added in v.1.65.2.7

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