/* Fontset handler.
- Ver.1.0
- Copyright (C) 1995 Free Software Foundation, Inc.
- Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+ Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
+ Licensed to the Free Software Foundation.
This file is part of GNU Emacs.
#include "lisp.h"
#include "charset.h"
#include "ccl.h"
-#include "fontset.h"
#include "frame.h"
+#include "fontset.h"
Lisp_Object Vglobal_fontset_alist;
-
Lisp_Object Vfont_encoding_alist;
Lisp_Object Vuse_default_ascent;
+Lisp_Object Vignore_relative_composition;
+Lisp_Object Valternate_fontname_alist;
+Lisp_Object Vfontset_alias_alist;
+Lisp_Object Vhighlight_wrong_size_font;
+Lisp_Object Vclip_large_size_font;
+
+/* Used as a temporary in macro FS_LOAD_FONT. */
+int font_idx_temp;
/* We had better have our own strcasecmp function because some system
doesn't have it. */
the comments in src/fontset.h for more detail. */
/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
-struct font_info *(*get_font_info_func) (/* FRAME_PTR f; int font_idx */);
+struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx));
/* Return a list of font names which matches PATTERN. See the document of
`x-list-fonts' for more detail. */
-Lisp_Object (*list_fonts_func) (/* Lisp_Object pattern, face, frame, width */);
+Lisp_Object (*list_fonts_func) P_ ((struct frame *f,
+ Lisp_Object pattern,
+ int size,
+ int maxnames));
/* Load a font named NAME for frame F and return a pointer to the
information of the loaded font. If loading is failed, return 0. */
-struct font_info *(*load_font_func) (/* FRAME_PTR f; char *name */);
+struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int));
/* Return a pointer to struct font_info of a font named NAME for frame F. */
-struct font_info *(*query_font_func) (/* FRAME_PTR f; char *name */);
+struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name));
/* Additional function for setting fontset or changing fontset
contents of frame F. */
-void (*set_frame_fontset_func) (/* FRAME_PTR f; Lisp_Object arg, oldval */);
+void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg,
+ Lisp_Object oldval));
+
+/* To find a CCL program, fs_load_font calls this function.
+ The argument is a pointer to the struct font_info.
+ This function set the memer `encoder' of the structure. */
+void (*find_ccl_program_func) P_ ((struct font_info *));
/* Check if any window system is used now. */
-void (*check_window_system_func) ();
+void (*check_window_system_func) P_ ((void));
struct fontset_data *
alloc_fontset_data ()
free_fontset_data (fontset_data)
struct fontset_data *fontset_data;
{
- int i;
-
- for (i = 0; i < fontset_data->n_fontsets; i++)
+ if (fontset_data->fontset_table)
{
- int j;
+ int i;
- xfree (fontset_data->fontset_table[i]->name);
- for (j = 0; j <= MAX_CHARSET; j++)
- if (fontset_data->fontset_table[i]->fontname[j])
- xfree (fontset_data->fontset_table[i]->fontname[j]);
- xfree (fontset_data->fontset_table[i]);
+ for (i = 0; i < fontset_data->n_fontsets; i++)
+ {
+ int j;
+
+ xfree (fontset_data->fontset_table[i]->name);
+ for (j = 0; j <= MAX_CHARSET; j++)
+ if (fontset_data->fontset_table[i]->fontname[j])
+ xfree (fontset_data->fontset_table[i]->fontname[j]);
+ xfree (fontset_data->fontset_table[i]);
+ }
+ xfree (fontset_data->fontset_table);
}
- xfree (fontset_data->fontset_table);
xfree (fontset_data);
}
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. */
+ FONTSET, and, the font index is stored in the table for FONTSET.
+
+ If you give FONTSET argument, don't call this function directry,
+ instead call macro FS_LOAD_FONT with the same argument. */
struct font_info *
fs_load_font (f, font_table, charset, fontname, fontset)
/* 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);
+ /* If CHARSET is not ASCII and FONTSET is specified, we must load a
+ font of appropriate size to be used with other fonts in this
+ fontset. */
+ if (charset != CHARSET_ASCII && fontsetp)
+ {
+ /* If we have not yet loaded ASCII font of FONTSET, we must load
+ it now to decided the size and height of this fontset. */
+ if (fontsetp->size == 0)
+ {
+ fontp = fs_load_font (f, font_table, CHARSET_ASCII, 0, fontset);
+ if (!fontp)
+ /* Any fontset should contain available ASCII. */
+ return 0;
+ }
+ /* Now we have surely decided the size of this fontset. */
+ size = fontsetp->size * CHARSET_WIDTH (charset);
+ }
fontp = (*load_font_func) (f, fontname, size);
not set by (*load_font_func). */
fontp->charset = charset;
- if (fontp->encoding[1] >= 0)
+ if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
{
/* The font itself tells which code points to be used. Use this
encoding for all other charsets. */
for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
fontp->encoding[i] = 1;
/* Then override them by a specification in Vfont_encoding_alist. */
- for (list = Vfont_encoding_alist; CONSP (list); list = XCONS (list)->cdr)
+ for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))
{
- elt = XCONS (list)->car;
+ elt = XCAR (list);
if (CONSP (elt)
- && STRINGP (XCONS (elt)->car) && CONSP (XCONS (elt)->cdr)
- && (fast_string_match_ignore_case (XCONS (elt)->car, fontname)
+ && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
+ && (fast_c_string_match_ignore_case (XCAR (elt), fontname)
>= 0))
{
Lisp_Object tmp;
- for (tmp = XCONS (elt)->cdr; CONSP (tmp); tmp = XCONS (tmp)->cdr)
- if (CONSP (XCONS (tmp)->car)
- && ((i = get_charset_id (XCONS (XCONS (tmp)->car)->car))
+ for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))
+ if (CONSP (XCAR (tmp))
+ && ((i = get_charset_id (XCAR (XCAR (tmp))))
>= 0)
- && INTEGERP (XCONS (XCONS (tmp)->car)->cdr)
- && XFASTINT (XCONS (XCONS (tmp)->car)->cdr) < 4)
+ && INTEGERP (XCDR (XCAR (tmp)))
+ && XFASTINT (XCDR (XCAR (tmp))) < 4)
fontp->encoding[i]
- = XFASTINT (XCONS (XCONS (tmp)->car)->cdr);
+ = XFASTINT (XCDR (XCAR (tmp)));
}
}
}
fontp->font_encoder = (struct ccl_program *) 0;
- for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCONS (list)->cdr)
- {
- elt = XCONS (list)->car;
- if (CONSP (elt)
- && STRINGP (XCONS (elt)->car) && VECTORP (XCONS (elt)->cdr)
- && fast_string_match_ignore_case (XCONS (elt)->car, fontname) >= 0)
- {
- fontp->font_encoder
- = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
- setup_ccl_program (fontp->font_encoder, XCONS (elt)->cdr);
- break;
- }
- }
+ if (find_ccl_program_func)
+ (*find_ccl_program_func) (fontp);
+
+ /* If FONTSET is specified, setup various fields of it. */
if (fontsetp)
{
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)
+ if (charset == CHARSET_ASCII)
{
- /* 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++)
+ /* Decide or change the size and height of this fontset. */
+ if (fontsetp->size == 0)
+ {
+ fontsetp->size = fontp->size;
+ fontsetp->height = fontp->height;
+ }
+ else if (fontsetp->size != fontp->size
+ || fontsetp->height != fontp->height)
{
- font_idx = fontsetp->font_indexes[i];
- if (font_idx >= 0)
+ /* 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++)
{
- struct font_info *fontp2 = font_table + font_idx;
-
- if (fontp2->size != fontp->size * CHARSET_WIDTH (i))
- fontsetp->font_indexes[i] = FONT_NOT_OPENED;
- /* The following code should be disabled until Emacs
- supports variable height lines. */
+ 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;
+ /* The following code should be disabled until
+ Emacs supports variable height lines. */
#if 0
- else if (fontsetp->height < fontp->height)
- fontsetp->height = fontp->height;
+ else if (fontsetp->height < fontp->height)
+ fontsetp->height = fontp->height;
#endif
+ }
}
}
}
- else if (fontsetp->height < fontp->height)
- fontsetp->height = fontp->height;
}
return fontp;
int i;
if (!CONSP (fontset_info)
- || !STRINGP (XCONS (fontset_info)->car)
- || !CONSP (XCONS (fontset_info)->cdr))
+ || !STRINGP (XCAR (fontset_info))
+ || !CONSP (XCDR (fontset_info)))
/* Invalid data in FONTSET_INFO. */
return -1;
- name = XCONS (fontset_info)->car;
+ name = XCAR (fontset_info);
if ((fontset = fs_query_fontset (f, XSTRING (name)->data)) >= 0)
/* This fontset already exists on frame F. */
return fontset;
fontsetp->font_indexes[i] = FONT_NOT_OPENED;
}
- for (fontlist = XCONS (fontset_info)->cdr; CONSP (fontlist);
- fontlist = XCONS (fontlist)->cdr)
+ for (fontlist = XCDR (fontset_info); CONSP (fontlist);
+ fontlist = XCDR (fontlist))
{
Lisp_Object tem = Fcar (fontlist);
int charset;
if (CONSP (tem)
- && (charset = get_charset_id (XCONS (tem)->car)) >= 0
- && STRINGP (XCONS (tem)->cdr))
+ && (charset = get_charset_id (XCAR (tem))) >= 0
+ && STRINGP (XCDR (tem)))
{
fontsetp->fontname[charset]
- = (char *) xmalloc (XSTRING (XCONS (tem)->cdr)->size + 1);
- bcopy (XSTRING (XCONS (tem)->cdr)->data,
+ = (char *) xmalloc (XSTRING (XCDR (tem))->size + 1);
+ bcopy (XSTRING (XCDR (tem))->data,
fontsetp->fontname[charset],
- XSTRING (XCONS (tem)->cdr)->size + 1);
+ XSTRING (XCDR (tem))->size + 1);
}
else
/* Broken or invalid data structure. */
the corresponding regular expression. */
static Lisp_Object Vcached_fontset_data;
-#define CACHED_FONTSET_NAME (XSTRING (XCONS (Vcached_fontset_data)->car)->data)
-#define CACHED_FONTSET_REGEX (XCONS (Vcached_fontset_data)->cdr)
+#define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
+#define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
/* If fontset name PATTERN contains any wild card, return regular
expression corresponding to PATTERN. */
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;
- }
+ 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 *regex = (char *) alloca (XSTRING (pattern)->size * 2);
char *p0, *p1 = regex;
- if (nickname)
+ /* Convert "*" to ".*", "?" to ".". */
+ *p1++ = '^';
+ for (p0 = (char *) XSTRING (pattern)->data; *p0; p0++)
{
- /* 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 == '*')
{
- if (*p0 == '*')
- {
- *p1++ = '.';
- *p1++ = '*';
- }
- else if (*p0 == '?')
- *p1++ == '.';
- else
- *p1++ = *p0;
+ *p1++ = '.';
+ *p1++ = '*';
}
+ else if (*p0 == '?')
+ *p1++ = '.';
+ else
+ *p1++ = *p0;
}
*p1++ = '$';
*p1++ = 0;
return CACHED_FONTSET_REGEX;
}
-DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 1, 0,
- "Return a fontset name which matches PATTERN, nil if no matching fontset.\n\
-PATTERN can contain `*' or `?' as a wild card\n\
-just like X's font name matching algorithm allows.")
- (pattern)
- Lisp_Object pattern;
+DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
+ "Return the name of an existing fontset which matches PATTERN.\n\
+The value is nil if there is no matching fontset.\n\
+PATTERN can contain `*' or `?' as a wildcard\n\
+just as X font name matching algorithm allows.\n\
+If REGEXPP is non-nil, PATTERN is a regular expression.")
+ (pattern, regexpp)
+ Lisp_Object pattern, regexpp;
{
Lisp_Object regexp, tem;
if (XSTRING (pattern)->size == 0)
return Qnil;
- regexp = fontset_pattern_regexp (pattern);
+ tem = Frassoc (pattern, Vfontset_alias_alist);
+ if (!NILP (tem))
+ return Fcar (tem);
- for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
+ if (NILP (regexpp))
+ regexp = fontset_pattern_regexp (pattern);
+ else
+ regexp = pattern;
+
+ for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
{
- Lisp_Object fontset_name = XCONS (XCONS (tem)->car)->car;
+ Lisp_Object fontset_name = XCAR (XCAR (tem));
if (!NILP (regexp))
{
- if (fast_string_match_ignore_case (regexp,
- XSTRING (fontset_name)->data)
+ if (fast_c_string_match_ignore_case (regexp,
+ XSTRING (fontset_name)->data)
>= 0)
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. */
if (!NILP (regexp))
{
- if (fast_string_match_ignore_case (regexp, fontsetp->name) >= 0)
+ if (fast_c_string_match_ignore_case (regexp, fontsetp->name) >= 0)
name_matched = 1;
}
else
CHECK_STRING (name, 0);
CHECK_LIST (fontlist, 1);
- fullname = Fquery_fontset (name);
+ fullname = Fquery_fontset (name, Qnil);
if (!NILP (fullname))
- error ("Fontset \"%s\" matches the existing fontset \"%s\"",
+ error ("Fontset `%s' matches the existing fontset `%s'",
XSTRING (name)->data, XSTRING (fullname)->data);
/* Check the validity of FONTLIST. */
- for (tail = fontlist; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object tem = XCONS (tail)->car;
+ Lisp_Object tem = XCAR (tail);
int charset;
if (!CONSP (tem)
- || (charset = get_charset_id (XCONS (tem)->car)) < 0
- || !STRINGP (XCONS (tem)->cdr))
+ || (charset = get_charset_id (XCAR (tem))) < 0
+ || !STRINGP (XCDR (tem)))
error ("Elements of fontlist must be a cons of charset and font name");
}
return Qnil;
}
-extern Lisp_Object Fframe_parameters ();
extern Lisp_Object Qfont;
Lisp_Object Qfontset;
if ((charset = get_charset_id (charset_symbol)) < 0)
error ("Invalid charset: %s", XSYMBOL (charset_symbol)->name->data);
- fullname = Fquery_fontset (name);
+ fullname = Fquery_fontset (name, Qnil);
if (NILP (fullname))
- error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+ error ("Fontset `%s' does not exist", XSTRING (name)->data);
/* If FRAME is not specified, we must, at first, update contents of
`global-fontset-alist' for a frame created in the future. */
if (NILP (frame))
{
Lisp_Object fontset_info = Fassoc (fullname, Vglobal_fontset_alist);
- Lisp_Object tem = Fassq (charset_symbol, XCONS (fontset_info)->cdr);
+ Lisp_Object tem = Fassq (charset_symbol, XCDR (fontset_info));
if (NILP (tem))
- XCONS (fontset_info)->cdr
+ XCDR (fontset_info)
= Fcons (Fcons (charset_symbol, fontname),
- XCONS (fontset_info)->cdr);
+ XCDR (fontset_info));
else
- XCONS (tem)->cdr = fontname;
+ XCDR (tem) = fontname;
}
/* Then, update information in the specified frame or all existing
if (set_frame_fontset_func
&& !NILP (font_param)
&& !strcmp (XSTRING (fullname)->data,
- XSTRING (XCONS (font_param)->cdr)->data))
+ XSTRING (XCDR (font_param))->data))
/* This fontset is the default fontset on frame TEM.
We may have to resize this frame because of new
ASCII font. */
CHECK_STRING (name, 0);
if (NILP (frame))
- f = selected_frame;
- else
- {
- CHECK_LIVE_FRAME (frame, 1);
- f = XFRAME (frame);
- }
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame, 1);
+ f = XFRAME (frame);
if (!query_font_func)
error ("Font query function is not supported");
if (!fontp)
return Qnil;
- info = Fmake_vector (make_number (7), Qnil);
+ info = Fmake_vector (make_number (8), Qnil);
XVECTOR (info)->contents[0] = build_string (fontp->name);
XVECTOR (info)->contents[1] = build_string (fontp->full_name);
CHECK_STRING(name, 0);
if (NILP (frame))
- f = selected_frame;
- else
- {
- CHECK_LIVE_FRAME (frame, 1);
- f = XFRAME (frame);
- }
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame, 1);
+ f = XFRAME (frame);
fontset = fs_query_fontset (f, XSTRING (name)->data);
if (fontset < 0)
- error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+ error ("Fontset `%s' does not exist", XSTRING (name)->data);
info = Fmake_vector (make_number (3), Qnil);
return info;
}
+void
syms_of_fontset ()
{
int i;
Vfont_encoding_alist = Qnil;
DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
- "Char table of characters of which ascent values should be ignored.\n\
+ "Char table of characters whose ascent values should be ignored.\n\
If an entry for a character is non-nil, the ascent value of the glyph\n\
-is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.");
+is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
+\n\
+This affects how a composite character which contains\n\
+such a character is displayed on screen.");
Vuse_default_ascent = Qnil;
+ DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
+ "Char table of characters which is not composed relatively.\n\
+If an entry for a character is non-nil, a composite character\n\
+which contains that character is displayed so that\n\
+the glyph of that character is put without considering\n\
+an ascent and descent value of a previous character.");
+ Vuse_default_ascent = Qnil;
+
+ DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
+ "Alist of fontname vs list of the alternate fontnames.\n\
+When a specified font name is not found, the corresponding\n\
+alternate fontnames (if any) are tried instead.");
+ Valternate_fontname_alist = Qnil;
+
+ DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
+ "Alist of fontset names vs the aliases.");
+ Vfontset_alias_alist = Qnil;
+
+ DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font,
+ "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
+The way to highlight them depends on window system on which Emacs runs.\n\
+On X11, a rectangle is shown around each such character.");
+ Vhighlight_wrong_size_font = Qnil;
+
+ DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font,
+ "*Non-nil means characters shown in overlarge fonts are clipped.\n\
+The height of clipping area is the same as that of an ASCII character.\n\
+The width of the area is the same as that of an ASCII character,\n\
+or twice as wide, depending on the character set's column-width.\n\
+\n\
+If the only font you have for a specific character set is too large,\n\
+and clipping these characters makes them hard to read,\n\
+you can set this variable to nil to display the characters without clipping.\n\
+The drawback is that you will get some garbage left on your screen.");
+ Vclip_large_size_font = Qt;
+
defsubr (&Squery_fontset);
defsubr (&Snew_fontset);
defsubr (&Sset_fontset_font);