summaryrefslogtreecommitdiff
path: root/src/fontset.c
diff options
context:
space:
mode:
authorKarl Heuer <kwzh@gnu.org>1997-02-20 07:02:49 +0000
committerKarl Heuer <kwzh@gnu.org>1997-02-20 07:02:49 +0000
commit29ce3607c99f8b6f8c8971ab2768175f3674fcb9 (patch)
treebd6fe5058bf419dd8d69bdc2c13ffbe9c4abfdb8 /src/fontset.c
parentd58e6703b3d19cdda2b640b6784ab17b8048cb51 (diff)
downloademacs-29ce3607c99f8b6f8c8971ab2768175f3674fcb9.tar.gz
Initial revision
Diffstat (limited to 'src/fontset.c')
-rw-r--r--src/fontset.c819
1 files changed, 819 insertions, 0 deletions
diff --git a/src/fontset.c b/src/fontset.c
new file mode 100644
index 00000000000..7d88e90ae89
--- /dev/null
+++ b/src/fontset.c
@@ -0,0 +1,819 @@
+/* Fontset handler.
+ Ver.1.0
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <config.h>
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#endif /* HAVE_ALLOCA_H */
+#include "lisp.h"
+#include "charset.h"
+#include "ccl.h"
+#include "fontset.h"
+#include "frame.h"
+
+Lisp_Object Vglobal_fontset_alist;
+
+Lisp_Object Vfont_encoding_alist;
+
+/* We had better have our own strcasecmp function because some system
+ doesn't have it. */
+static char my_strcasetbl[256];
+
+/* Compare two strings S0 and S1 while ignoring differences in case.
+ Return 1 if they differ, else return 0. */
+static int
+my_strcasecmp (s0, s1)
+ unsigned char *s0, *s1;
+{
+ while (*s0)
+ if (my_strcasetbl[*s0++] != my_strcasetbl[*s1++]) return 1;
+ return (int) *s1;
+}
+
+/* The following six are window system dependent functions. See
+ the comments in src/fontset.h for more detail. */
+
+/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
+struct font_info *(*get_font_info_func) (/* FRAME_PTR f; int font_idx */);
+
+/* Return a list of font names which matches PATTERN. See the document of
+ `x-list-fonts' for more detail. */
+Lisp_Object (*list_fonts_func) (/* Lisp_Object pattern, face, frame, width */);
+
+/* Load a font named NAME for frame F and return a pointer to the
+ information of the loaded font. If loading is failed, return 0. */
+struct font_info *(*load_font_func) (/* FRAME_PTR f; char *name */);
+
+/* Return a pointer to struct font_info of a font named NAME for frame F. */
+struct font_info *(*query_font_func) (/* FRAME_PTR f; char *name */);
+
+/* Additional function for setting fontset or changing fontset
+ contents of frame F. */
+void (*set_frame_fontset_func) (/* FRAME_PTR f; Lisp_Object arg, oldval */);
+
+/* Check if any window system is used now. */
+void (*check_window_system_func) ();
+
+struct fontset_data *
+alloc_fontset_data ()
+{
+ struct fontset_data *fontset_data
+ = (struct fontset_data *) xmalloc (sizeof (struct fontset_data));
+
+ bzero (fontset_data, sizeof (struct fontset_data));
+
+ return fontset_data;
+}
+
+void
+free_fontset_data (fontset_data)
+ struct fontset_data *fontset_data;
+{
+ int i;
+
+ for (i = 0; i < fontset_data->n_fontsets; i++)
+ {
+ int j;
+
+ xfree (fontset_data->fontset_table[i]->name);
+ for (j = 0; j < MAX_CHARSET; j++)
+ if (fontset_data->fontset_table[i]->fontname[j])
+ xfree (fontset_data->fontset_table[i]->fontname[j]);
+ xfree (fontset_data->fontset_table[i]);
+ }
+ xfree (fontset_data->fontset_table);
+
+ xfree (fontset_data);
+}
+
+/* Load a font named FONTNAME for displaying CHARSET on frame F.
+ All fonts for frame F is stored in a table pointed by FONT_TABLE.
+ Return a pointer to the struct font_info of the loaded font.
+ If loading fails, return 0;
+ If FONTNAME is NULL, the name is taken from the information of FONTSET.
+ If FONTSET is given, try to load a font whose size matches that of
+ FONTSET, and, the font index is stored in the table for FONTSET. */
+
+struct font_info *
+fs_load_font (f, font_table, charset, fontname, fontset)
+ FRAME_PTR f;
+ struct font_info *font_table;
+ int charset, fontset;
+ char *fontname;
+{
+ Lisp_Object font_list;
+ Lisp_Object list, elt;
+ int font_idx;
+ int size = 0;
+ struct fontset_info *fontsetp = 0;
+ struct font_info *fontp;
+
+ if (fontset >= 0 && fontset < FRAME_FONTSET_DATA (f)->n_fontsets)
+ {
+ fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
+ font_idx = fontsetp->font_indexes[charset];
+ if (font_idx >= 0)
+ /* We have already loaded a font. */
+ return font_table + font_idx;
+ else if (font_idx == FONT_NOT_FOUND)
+ /* We have already tried loading a font and failed. */
+ return 0;
+ if (!fontname)
+ fontname = fontsetp->fontname[charset];
+ }
+
+ if (!fontname)
+ /* No way to get fontname. */
+ return 0;
+
+ /* If a fontset is specified and we have already loaded some fonts
+ in the fontset, we need a font of appropriate size to be used
+ with the fonts. */
+ if (fontsetp && fontsetp->size)
+ size = fontsetp->size * CHARSET_WIDTH (charset);
+
+ fontp = (*load_font_func) (f, fontname, size);
+
+ if (!fontp)
+ {
+ if (fontsetp)
+ fontsetp->font_indexes[charset] = FONT_NOT_FOUND;
+ return 0;
+ }
+
+ /* Fill in fields (CHARSET, ENCODING, and FONT_ENCODER) which are
+ not set by (*load_font_func). */
+ fontp->charset = charset;
+
+ if (fontp->encoding[1] >= 0)
+ {
+ /* The font itself tells which code points to be used. Use this
+ encoding for all other charsets. */
+ int i;
+
+ fontp->encoding[0] = fontp->encoding[1];
+ for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i < MAX_CHARSET; i++)
+ fontp->encoding[i] = fontp->encoding[1];
+ }
+ else
+ {
+ /* The font itself doesn't tell which code points to be used. */
+ int i;
+
+ /* At first, set 1 (means 0xA0..0xFF) as the default. */
+ fontp->encoding[0] = 1;
+ for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i < MAX_CHARSET; i++)
+ fontp->encoding[i] = 1;
+ /* Then override them by a specification in Vfont_encoding_alist. */
+ for (list = Vfont_encoding_alist; CONSP (list); list = XCONS (list)->cdr)
+ {
+ elt = XCONS (list)->car;
+ if (CONSP (elt)
+ && STRINGP (XCONS (elt)->car) && CONSP (XCONS (elt)->cdr)
+ && (fast_string_match_ignore_case (XCONS (elt)->car, fontname)
+ >= 0))
+ {
+ Lisp_Object tmp;
+
+ for (tmp = XCONS (elt)->cdr; CONSP (tmp); tmp = XCONS (tmp)->cdr)
+ if (CONSP (XCONS (tmp)->car)
+ && INTEGERP (XCONS (XCONS (tmp)->car)->car)
+ && ((i = get_charset_id (XCONS (XCONS (tmp)->car)->car))
+ >= 0)
+ && INTEGERP (XCONS (XCONS (tmp)->car)->cdr)
+ && XFASTINT (XCONS (XCONS (tmp)->car)->cdr) < 4)
+ fontp->encoding[i]
+ = XFASTINT (XCONS (XCONS (tmp)->car)->cdr);
+ }
+ }
+ }
+
+ fontp->font_encoder = (struct ccl_program *) 0;
+ for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCONS (list)->cdr)
+ {
+ elt = XCONS (list)->car;
+ if (CONSP (elt)
+ && STRINGP (XCONS (elt)->car) && VECTORP (XCONS (elt)->cdr)
+ && fast_string_match_ignore_case (XCONS (elt)->car, fontname) >= 0)
+ {
+ fontp->font_encoder
+ = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
+ setup_ccl_program (fontp->font_encoder, XCONS (elt)->cdr);
+ break;
+ }
+ }
+
+ if (fontsetp)
+ {
+ fontsetp->font_indexes[charset] = fontp->font_idx;
+ if (fontsetp->size == 0)
+ fontsetp->size = fontp->size / CHARSET_WIDTH (charset);
+
+ if (charset == CHARSET_ASCII
+ && fontsetp->size != fontp->size)
+ {
+ /* When loading ASCII font of the different size from the
+ size of FONTSET, we have to update the size of FONTSET.
+ Since changing the size of FONTSET may make some fonts
+ already loaded inappropriate to be used in FONTSET, we
+ must delete the record of such fonts. In that case, we
+ also have to calculate the height of FONTSET from the
+ remaining fonts. */
+ int i;
+
+ fontsetp->size = fontp->size;
+ fontsetp->height = fontp->height;
+ for (i = CHARSET_ASCII + 1; i < MAX_CHARSET; i++)
+ {
+ font_idx = fontsetp->font_indexes[i];
+ if (font_idx >= 0)
+ {
+ struct font_info *fontp2 = font_table + font_idx;
+
+ if (fontp2->size != fontp->size * CHARSET_WIDTH (i))
+ fontsetp->font_indexes[i] = FONT_NOT_OPENED;
+ else if (fontsetp->height < fontp->height)
+ fontsetp->height = fontp->height;
+ }
+ }
+ }
+ else if (fontsetp->height < fontp->height)
+ fontsetp->height = fontp->height;
+ }
+
+ return fontp;
+}
+
+/* Return ID of the fontset named NAME on frame F. */
+
+int
+fs_query_fontset (f, name)
+ FRAME_PTR f;
+ char *name;
+{
+ struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f);
+ int i;
+
+ for (i = 0; i < fontset_data->n_fontsets; i++)
+ if (!my_strcasecmp(name, fontset_data->fontset_table[i]->name))
+ return i;
+ return -1;
+}
+
+/* Register a fontset specified by FONTSET_INFO for frame FRAME.
+ Return the fontset ID if successfully registered, else return -1.
+ FONTSET_INFO is a cons of name of the fontset and FONTLIST, where
+ FONTLIST is an alist of charsets vs fontnames. */
+
+int
+fs_register_fontset (f, fontset_info)
+ FRAME_PTR f;
+ Lisp_Object fontset_info;
+{
+ struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f);
+ Lisp_Object name, fontlist;
+ int fontset;
+ struct fontset_info *fontsetp;
+ int i;
+
+ if (!CONSP (fontset_info)
+ || !STRINGP (XCONS (fontset_info)->car)
+ || !CONSP (XCONS (fontset_info)->cdr))
+ /* Invalid data in FONTSET_INFO. */
+ return -1;
+
+ name = XCONS (fontset_info)->car;
+ if ((fontset = fs_query_fontset (f, XSTRING (name)->data)) >= 0)
+ /* This fontset already exists on frame F. */
+ return fontset;
+
+ fontsetp = (struct fontset_info *) xmalloc (sizeof (struct fontset_info));
+
+ fontsetp->name = (char *) xmalloc (XSTRING (name)->size + 1);
+ bcopy(XSTRING (name)->data, fontsetp->name, XSTRING (name)->size + 1);
+
+ fontsetp->size = fontsetp->height = 0;
+
+ for (i = 0; i < MAX_CHARSET; i++)
+ {
+ fontsetp->fontname[i] = (char *) 0;
+ fontsetp->font_indexes[i] = FONT_NOT_OPENED;
+ }
+
+ for (fontlist = XCONS (fontset_info)->cdr; CONSP (fontlist);
+ fontlist = XCONS (fontlist)->cdr)
+ {
+ Lisp_Object tem = Fcar (fontlist);
+ int charset;
+
+ if (CONSP (tem)
+ && (charset = get_charset_id (XCONS (tem)->car)) >= 0
+ && STRINGP (XCONS (tem)->cdr))
+ {
+ fontsetp->fontname[charset]
+ = (char *) xmalloc (XSTRING (XCONS (tem)->cdr)->size + 1);
+ bcopy (XSTRING (XCONS (tem)->cdr)->data,
+ fontsetp->fontname[charset],
+ XSTRING (XCONS (tem)->cdr)->size + 1);
+ }
+ else
+ /* Broken or invalid data structure. */
+ return -1;
+ }
+
+ /* Do we need to create the table? */
+ if (fontset_data->fontset_table_size == 0)
+ {
+ fontset_data->fontset_table_size = 8;
+ fontset_data->fontset_table
+ = (struct fontset_info **) xmalloc (fontset_data->fontset_table_size
+ * sizeof (struct fontset_info *));
+ }
+ /* Do we need to grow the table? */
+ else if (fontset_data->n_fontsets >= fontset_data->fontset_table_size)
+ {
+ fontset_data->fontset_table_size += 8;
+ fontset_data->fontset_table
+ = (struct fontset_info **) xrealloc (fontset_data->fontset_table,
+ fontset_data->fontset_table_size
+ * sizeof (struct fontset_info *));
+ }
+ fontset = fontset_data->n_fontsets++;
+ fontset_data->fontset_table[fontset] = fontsetp;
+
+ return fontset;
+}
+
+/* Cache data used by fontset_pattern_regexp. The car part is a
+ pattern string containing at least one wild card, the cdr part is
+ the corresponding regular expression. */
+static Lisp_Object Vcached_fontset_data;
+
+#define CACHED_FONTSET_NAME (XSTRING (XCONS (Vcached_fontset_data)->car)->data)
+#define CACHED_FONTSET_REGEX (XCONS (Vcached_fontset_data)->cdr)
+
+/* If fontset name PATTERN contains any wild card, return regular
+ expression corresponding to PATTERN. */
+
+Lisp_Object
+fontset_pattern_regexp (pattern)
+ Lisp_Object pattern;
+{
+ int nickname = 0;
+
+ if (!index (XSTRING (pattern)->data, '*')
+ && !index (XSTRING (pattern)->data, '?'))
+ /* PATTERN does not contain any wild cards. */
+ {
+ if (XSTRING (pattern)->size > 8
+ && ! bcmp (XSTRING (pattern)->data, "fontset-", 8))
+ /* Just a nickname of a fontset is specified. */
+ nickname = 1;
+ else
+ return Qnil;
+ }
+
+ if (!CONSP (Vcached_fontset_data)
+ || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
+ {
+ /* We must at first update the cached data. */
+ char *regex = (char *) alloca (XSTRING (pattern)->size * 2 + 3);
+ char *p0, *p1 = regex;
+
+ if (nickname)
+ {
+ /* Just prepend ".*-" to PATTERN. */
+ *p1++= '.'; *p1++= '*', *p1++= '-';
+ bcopy (XSTRING (pattern)->data, p1, XSTRING (pattern)->size);
+ p1 += XSTRING (pattern)->size;
+ }
+ else
+ {
+ /* Convert "*" to ".*", "?" to ".". */
+ *p1++ = '^';
+ for (p0 = XSTRING (pattern)->data; *p0; p0++)
+ {
+ if (*p0 == '*')
+ {
+ *p1++ = '.';
+ *p1++ = '*';
+ }
+ else if (*p0 == '?')
+ *p1++ == '.';
+ else
+ *p1++ = *p0;
+ }
+ }
+ *p1++ = '$';
+ *p1++ = 0;
+
+ Vcached_fontset_data = Fcons (build_string (XSTRING (pattern)->data),
+ build_string (regex));
+ }
+
+ return CACHED_FONTSET_REGEX;
+}
+
+DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 1, 0,
+ "Return a fontset name which matches PATTERN, nil if no matching fontset.\n\
+PATTERN can contain `*' or `?' as a wild card\n\
+just like X's font name matching algorithm allows.")
+ (pattern)
+ Lisp_Object pattern;
+{
+ Lisp_Object regexp, tem;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING (pattern, 0);
+
+ if (XSTRING (pattern)->size == 0)
+ return Qnil;
+
+ regexp = fontset_pattern_regexp (pattern);
+
+ for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
+ {
+ Lisp_Object fontset_name = XCONS (XCONS (tem)->car)->car;
+ if (!NILP (regexp))
+ {
+ if (fast_string_match_ignore_case (regexp,
+ XSTRING (fontset_name)->data)
+ >= 0)
+ return fontset_name;
+ }
+ else
+ {
+ if (!my_strcasecmp (XSTRING (pattern)->data,
+ XSTRING (fontset_name)->data))
+ return fontset_name;
+ }
+ }
+
+ return Qnil;
+}
+
+Lisp_Object Fframe_char_width ();
+
+/* Return a list of names of available fontsets matching PATTERN on
+ frame F. If SIZE is not 0, it is the size (maximum bound width) of
+ fontsets to be listed. */
+
+Lisp_Object
+list_fontsets (f, pattern, size)
+ FRAME_PTR f;
+ Lisp_Object pattern;
+ int size;
+{
+ int i;
+ Lisp_Object regexp, val;
+
+ regexp = fontset_pattern_regexp (pattern);
+
+ val = Qnil;
+ for (i = 0; i < FRAME_FONTSET_DATA (f)->n_fontsets; i++)
+ {
+ struct fontset_info *fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[i];
+ int name_matched = 0;
+ int size_matched = 0;
+
+ if (!NILP (regexp))
+ {
+ if (fast_string_match_ignore_case (regexp, fontsetp->name) >= 0)
+ name_matched = 1;
+ }
+ else
+ {
+ if (!my_strcasecmp (XSTRING (pattern)->data, fontsetp->name))
+ name_matched = 1;
+ }
+
+ if (name_matched)
+ {
+ if (!size || fontsetp->size == size)
+ size_matched = 1;
+ else if (fontsetp->size == 0)
+ {
+ /* No font of this fontset has loaded yet. Try loading
+ one with SIZE. */
+ int j;
+
+ for (j = 0; j < MAX_CHARSET; j++)
+ if (fontsetp->fontname[j])
+ {
+ if ((*load_font_func) (f, fontsetp->fontname[j], size))
+ size_matched = 1;
+ break;
+ }
+ }
+
+ if (size_matched)
+ val = Fcons (build_string (fontsetp->name), val);
+ }
+ }
+
+ return val;
+}
+
+DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
+ "Create a new fontset NAME which contains fonts in FONTLIST.\n\
+FONTLIST is an alist of charsets vs corresponding font names.")
+ (name, fontlist)
+ Lisp_Object name, fontlist;
+{
+ Lisp_Object fullname, fontset_info;
+ Lisp_Object tail;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING (name, 0);
+ CHECK_LIST (fontlist, 1);
+
+ fullname = Fquery_fontset (name);
+ if (!NILP (fullname))
+ error ("Fontset \"%s\" matches the existing fontset \"%s\"",
+ XSTRING (name)->data, XSTRING (fullname)->data);
+
+ /* Check the validity of FONTLIST. */
+ for (tail = fontlist; CONSP (tail); tail = XCONS (tail)->cdr)
+ {
+ Lisp_Object tem = XCONS (tail)->car;
+ int charset;
+
+ if (!CONSP (tem)
+ || (charset = get_charset_id (XCONS (tem)->car)) < 0
+ || !STRINGP (XCONS (tem)->cdr))
+ error ("Elements of fontlist must be a cons of charset and font name");
+ }
+
+ fontset_info = Fcons (name, fontlist);
+ Vglobal_fontset_alist = Fcons (fontset_info, Vglobal_fontset_alist);
+
+ /* Register this fontset for all existing frames. */
+ {
+ Lisp_Object framelist, frame;
+
+ FOR_EACH_FRAME (framelist, frame)
+ if (!FRAME_TERMCAP_P (XFRAME (frame)))
+ fs_register_fontset (XFRAME (frame), fontset_info);
+ }
+
+ return Qnil;
+}
+
+extern Lisp_Object Fframe_parameters ();
+extern Lisp_Object Qfont;
+Lisp_Object Qfontset;
+
+DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
+ "Set FONTNAME for a font of CHARSET in fontset NAME on frame FRAME.\n\
+If FRAME is omitted or nil, all frames are affected.")
+ (name, charset_symbol, fontname, frame)
+ Lisp_Object name, charset_symbol, fontname, frame;
+{
+ int charset;
+ Lisp_Object fullname, fontlist;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING (name, 0);
+ CHECK_SYMBOL (charset_symbol, 1);
+ CHECK_STRING (fontname, 2);
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame, 3);
+
+ if ((charset = get_charset_id (charset_symbol)) < 0)
+ error ("Invalid charset: %s", XSYMBOL (charset_symbol)->name->data);
+
+ fullname = Fquery_fontset (name);
+ if (NILP (fullname))
+ error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+
+ /* If FRAME is not specified, we must, at first, update contents of
+ `global-fontset-alist' for a frame created in the future. */
+ if (NILP (frame))
+ {
+ Lisp_Object fontset_info = Fassoc (fullname, Vglobal_fontset_alist);
+ Lisp_Object tem = Fassq (charset, XCONS (fontset_info)->cdr);
+
+ if (NILP (tem))
+ XCONS (fontset_info)->cdr
+ = Fcons (Fcons (charset, fontname), XCONS (fontset_info)->cdr);
+ else
+ XCONS (tem)->cdr = fontname;
+ }
+
+ /* Then, update information in the specified frame or all existing
+ frames. */
+ {
+ Lisp_Object framelist, tem;
+
+ FOR_EACH_FRAME (framelist, tem)
+ if (!FRAME_TERMCAP_P (XFRAME (tem))
+ && (NILP (frame) || EQ (frame, tem)))
+ {
+ FRAME_PTR f = XFRAME (tem);
+ int fontset = fs_query_fontset (f, XSTRING (fullname)->data);
+ struct fontset_info *fontsetp
+ = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
+
+ if (fontsetp->fontname[XINT (charset)])
+ xfree (fontsetp->fontname[XINT (charset)]);
+ fontsetp->fontname[XINT (charset)]
+ = (char *) xmalloc (XSTRING (fontname)->size + 1);
+ bcopy (XSTRING (fontname)->data, fontsetp->fontname[XINT (charset)],
+ XSTRING (fontname)->size + 1);
+ fontsetp->font_indexes[XINT (charset)] = FONT_NOT_OPENED;
+
+ if (charset == CHARSET_ASCII)
+ {
+ Lisp_Object font_param = Fassq (Qfont, Fframe_parameters (tem));
+
+ if (set_frame_fontset_func
+ && !NILP (font_param)
+ && !strcmp (XSTRING (fullname)->data,
+ XSTRING (XCONS (font_param)->cdr)->data))
+ /* This fontset is the default fontset on frame TEM.
+ We may have to resize this frame because of new
+ ASCII font. */
+ (*set_frame_fontset_func) (f, fullname, Qnil);
+ }
+ }
+ }
+
+ return Qnil;
+}
+
+DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
+ "Return information about a font named NAME on frame FRAME.\n\
+If FRAME is omitted or nil, use the selected frame.\n\
+The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
+ HEIGHT, BASELINE-OFFSET, and RELATIVE-COMPOSE,\n\
+where\n\
+ OPENED-NAME is the name used for opening the font,\n\
+ FULL-NAME is the full name of the font,\n\
+ CHARSET is the charset displayed by the font,\n\
+ SIZE is the minimum bound width of the font,\n\
+ HEIGHT is the height of the font,\n\
+ BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
+ RELATIVE-COMPOSE is the number controlling how to compose characters.\n\
+If the named font is not yet loaded, return nil.")
+ (name, frame)
+ Lisp_Object name, frame;
+{
+ FRAME_PTR f;
+ struct font_info *fontp;
+ Lisp_Object info;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING (name, 0);
+ if (NILP (frame))
+ f = selected_frame;
+ else
+ {
+ CHECK_LIVE_FRAME (frame, 1);
+ f = XFRAME (frame);
+ }
+
+ if (!query_font_func)
+ error ("Font query function is not supported");
+
+ fontp = (*query_font_func) (f, XSTRING (name)->data);
+ if (!fontp)
+ return Qnil;
+
+ info = Fmake_vector (make_number (6), Qnil);
+
+ XVECTOR (info)->contents[0] = build_string (fontp->name);
+ XVECTOR (info)->contents[1] = build_string (fontp->full_name);
+ XVECTOR (info)->contents[2] = CHARSET_SYMBOL (fontp->charset);
+ XVECTOR (info)->contents[3] = make_number (fontp->size);
+ XVECTOR (info)->contents[4] = make_number (fontp->height);
+ XVECTOR (info)->contents[5] = make_number (fontp->baseline_offset);
+ XVECTOR (info)->contents[6] = make_number (fontp->relative_compose);
+
+ return info;
+}
+
+DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
+ "Return information about a fontset named NAME on frame FRAME.\n\
+If FRAME is omitted or nil, use the selected frame.\n\
+The returned value is a vector of SIZE, HEIGHT, and FONT-LIST,\n\
+where\n\
+ SIZE is the minimum bound width of ASCII font of the fontset,\n\
+ HEIGHT is the height of the tallest font in the fontset, and\n\
+ FONT-LIST is an alist of the format:\n\
+ (CHARSET REQUESTED-FONT-NAME LOADED-FONT-NAME).\n\
+LOADED-FONT-NAME t means the font is not yet loaded, nil means the\n\
+loading failed.")
+ (name, frame)
+ Lisp_Object name, frame;
+{
+ FRAME_PTR f;
+ int fontset;
+ struct fontset_info *fontsetp;
+ Lisp_Object info, val;
+ int i;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING(name, 0);
+ if (NILP (frame))
+ f = selected_frame;
+ else
+ {
+ CHECK_LIVE_FRAME (frame, 1);
+ f = XFRAME (frame);
+ }
+
+ fontset = fs_query_fontset (f, XSTRING (name)->data);
+ if (fontset < 0)
+ error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+
+ info = Fmake_vector (make_number (3), Qnil);
+
+ fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
+
+ XVECTOR (info)->contents[0] = make_number (fontsetp->size);
+ XVECTOR (info)->contents[1] = make_number (fontsetp->height);
+ val = Qnil;
+ for (i = 0; i < MAX_CHARSET; i++)
+ if (fontsetp->fontname[i])
+ {
+ int font_idx = fontsetp->font_indexes[i];
+ Lisp_Object loaded;
+
+ if (font_idx == FONT_NOT_OPENED)
+ loaded = Qt;
+ else if (font_idx == FONT_NOT_FOUND)
+ loaded = Qnil;
+ else
+ loaded
+ = build_string ((*get_font_info_func) (f, font_idx)->full_name);
+ val = Fcons (Fcons (CHARSET_SYMBOL (i),
+ Fcons (build_string (fontsetp->fontname[i]),
+ Fcons (loaded, Qnil))),
+ val);
+ }
+ XVECTOR (info)->contents[2] = val;
+ return info;
+}
+
+syms_of_fontset ()
+{
+ int i;
+
+ for (i = 0; i < 256; i++)
+ my_strcasetbl[i] = (i >= 'A' && i <= 'Z') ? i + 'a' - 'A' : i;
+
+ if (!load_font_func)
+ /* Window system initializer should have set proper functions. */
+ abort ();
+
+ staticpro (&Qfontset);
+
+ Vcached_fontset_data = Qnil;
+ staticpro (&Vcached_fontset_data);
+
+ DEFVAR_LISP ("global-fontset-alist", &Vglobal_fontset_alist,
+ "Internal data for fontset. Not for external use.\n\
+This is an alist associating fontset names with the lists of fonts\n\
+ contained in them.\n\
+Newly created frames make their own fontset database from here.");
+ Vglobal_fontset_alist = Qnil;
+
+ DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
+ "Alist of fontname patterns vs corresponding encoding info.\n\
+Each element looks like (REGEXP . ENCODING-INFO),\n\
+ where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
+ENCODING is one of the following integer values:\n\
+ 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
+ 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
+ 2: code points 0x20A0..0x7FFF are used,\n\
+ 3: code points 0xA020..0xFF7F are used.");
+ Vfont_encoding_alist = Qnil;
+
+ defsubr (&Squery_fontset);
+ defsubr (&Snew_fontset);
+ defsubr (&Sset_fontset_font);
+ defsubr (&Sfont_info);
+ defsubr (&Sfontset_info);
+}