Mercurial > emacs
comparison lisp/international/fontset.el @ 22161:7a4c3fd89dda
(x-font-name-charset-alist): New
variable.
(register-alternate-fontnames): Doc-string modified.
(x-complement-fontset-spec): Likewise.
(x-complement-fontset-spec): Delete unused local variable. Delete
ad hoc code for Latin-1, instead refer to
x-font-name-charset-alist.
(uninstantiated-fontset-alist): Format changed (BASE-FONTSET ->
FONTLIST).
(x-style-funcs-alist): New variable.
(create-fontset-from-fontset-spec): 2nd optional arg is changed
from STYLE to STYLE-VARIANT-P. The meaning also changed. Delete
unused code. Adjusted for the change of
uninstantiated-fontset-alist.
(instantiate-fontset): Adjusted for the change of
uninstantiated-fontset-alist.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Thu, 21 May 1998 01:46:39 +0000 |
parents | 8f7a59fc78db |
children | c87830c691a5 |
comparison
equal
deleted
inserted
replaced
22160:c1998807c140 | 22161:7a4c3fd89dda |
---|---|
101 (set-font-encoding "JISX0201" 'latin-jisx0201 0) | 101 (set-font-encoding "JISX0201" 'latin-jisx0201 0) |
102 | 102 |
103 ;; Setting for suppressing XLoadQueryFont on big fonts. | 103 ;; Setting for suppressing XLoadQueryFont on big fonts. |
104 (setq x-pixel-size-width-font-regexp | 104 (setq x-pixel-size-width-font-regexp |
105 "gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5") | 105 "gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5") |
106 | |
107 (defvar x-font-name-charset-alist | |
108 '(("iso8859-1" ascii latin-iso8859-1) | |
109 ("iso8859-2" ascii latin-iso8859-2) | |
110 ("iso8859-3" ascii latin-iso8859-3) | |
111 ("iso8859-4" ascii latin-iso8859-4) | |
112 ("iso8859-5" ascii cyrillic-iso8859-5) | |
113 ("iso8859-6" ascii arabic-iso8859-6) | |
114 ("iso8859-7" ascii greek-iso8859-7) | |
115 ("iso8859-8" ascii hebrew-iso8859-8) | |
116 ("tis620" ascii thai-tis620) | |
117 ("koi8" ascii cyrillic-iso8859-5) | |
118 ("viscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower) | |
119 ("vscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower) | |
120 ("mulelao-1" ascii lao)) | |
121 "Alist of font names vs list of charsets the font can display. | |
122 | |
123 When a font name which matches some element of this alist is given as | |
124 `-fn' command line argument or is specified by X resource, a fontset | |
125 which uses the specified font for the corresponding charsets are | |
126 created and used for the initial frame.") | |
106 | 127 |
107 ;;; XLFD (X Logical Font Description) format handler. | 128 ;;; XLFD (X Logical Font Description) format handler. |
108 | 129 |
109 ;; Define XLFD's field index numbers. ; field name | 130 ;; Define XLFD's field index numbers. ; field name |
110 (defconst xlfd-regexp-foundry-subnum 0) ; FOUNDRY | 131 (defconst xlfd-regexp-foundry-subnum 0) ; FOUNDRY |
219 (x-reduce-font-name name) | 240 (x-reduce-font-name name) |
220 name))) | 241 name))) |
221 | 242 |
222 (defun register-alternate-fontnames (fontname) | 243 (defun register-alternate-fontnames (fontname) |
223 "Register alternate fontnames for FONTNAME in `alternate-fontname-alist'. | 244 "Register alternate fontnames for FONTNAME in `alternate-fontname-alist'. |
224 When Emacs fails to open FONTNAME, it tries to open alternate font | 245 When Emacs fails to open FONTNAME, it tries to open an alternate font |
225 registered in the variable `alternate-fontname-alist' (which see). | 246 registered in the variable `alternate-fontname-alist' (which see). |
226 | 247 |
227 For FONTNAME, the following three alternate fontnames are registered: | 248 For FONTNAME, the following three alternate fontnames are registered: |
228 fontname which ignores style specification of FONTNAME, | 249 fontname which ignores style specification of FONTNAME, |
229 fontname which ignores size specification of FONTNAME, | 250 fontname which ignores size specification of FONTNAME, |
230 fontname which ignores both style and size specification of FONTNAME." | 251 fontname which ignores both style and size specification of FONTNAME. |
252 Emacs tries to open fonts in this order." | |
231 (unless (assoc fontname alternate-fontname-alist) | 253 (unless (assoc fontname alternate-fontname-alist) |
232 (let ((xlfd-fields (x-decompose-font-name fontname)) | 254 (let ((xlfd-fields (x-decompose-font-name fontname)) |
233 style-ignored size-ignored both-ignored) | 255 style-ignored size-ignored both-ignored) |
234 (when xlfd-fields | 256 (when xlfd-fields |
235 (aset xlfd-fields xlfd-regexp-foundry-subnum nil) | 257 (aset xlfd-fields xlfd-regexp-foundry-subnum nil) |
261 alternate-fontname-alist)))))) | 283 alternate-fontname-alist)))))) |
262 | 284 |
263 (defun x-complement-fontset-spec (xlfd-fields fontlist) | 285 (defun x-complement-fontset-spec (xlfd-fields fontlist) |
264 "Complement FONTLIST for all charsets based on XLFD-FIELDS and return it. | 286 "Complement FONTLIST for all charsets based on XLFD-FIELDS and return it. |
265 XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields. | 287 XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields. |
266 FONTLIST is an alist of cons of charset and fontname. | 288 FONTLIST is an alist of charsets vs the corresponding font names. |
267 | 289 |
268 Fontnames for charsets not listed in FONTLIST are generated from | 290 Font names for charsets not listed in FONTLIST are generated from |
269 XLFD-FIELDS and a property of x-charset-registry of each charset | 291 XLFD-FIELDS and a property of x-charset-registry of each charset |
270 automatically." | 292 automatically." |
271 (let ((charsets charset-list)) | 293 (let ((charsets charset-list)) |
272 (while charsets | 294 (while charsets |
273 (let ((charset (car charsets))) | 295 (let ((charset (car charsets))) |
274 (unless (assq charset fontlist) | 296 (unless (assq charset fontlist) |
275 (let ((registry (get-charset-property charset | 297 (let ((registry (get-charset-property charset |
276 'x-charset-registry)) | 298 'x-charset-registry)) |
277 registry-val encoding-val fontname loose-fontname) | 299 registry-val encoding-val fontname) |
278 (if (string-match "-" registry) | 300 (if (string-match "-" registry) |
279 ;; REGISTRY contains `CHARSET_ENCODING' field. | 301 ;; REGISTRY contains `CHARSET_ENCODING' field. |
280 (setq registry-val (substring registry 0 (match-beginning 0)) | 302 (setq registry-val (substring registry 0 (match-beginning 0)) |
281 encoding-val (substring registry (match-end 0))) | 303 encoding-val (substring registry (match-end 0))) |
282 (setq registry-val (concat registry "*") | 304 (setq registry-val (concat registry "*") |
286 (setq fontname (downcase (x-compose-font-name xlfd-fields))) | 308 (setq fontname (downcase (x-compose-font-name xlfd-fields))) |
287 (setq fontlist (cons (cons charset fontname) fontlist)) | 309 (setq fontlist (cons (cons charset fontname) fontlist)) |
288 (register-alternate-fontnames fontname)))) | 310 (register-alternate-fontnames fontname)))) |
289 (setq charsets (cdr charsets)))) | 311 (setq charsets (cdr charsets)))) |
290 | 312 |
291 ;; Here's a trick for the charset latin-iso8859-1. If font for | 313 ;; If the font for ASCII can also be used for another charsets, use |
292 ;; ascii also contains Latin-1 characters, use it also for | 314 ;; that font instead of what generated based on x-charset-registery |
293 ;; latin-iso8859-1. This prevent loading a font for latin-iso8859-1 | 315 ;; in the previous code. |
294 ;; by a different name. | 316 (let ((ascii-font (cdr (assq 'ascii fontlist))) |
295 (if (string-match (cdr (assq 'latin-iso8859-1 x-charset-registries)) | 317 (l x-font-name-charset-alist)) |
296 (cdr (assq 'ascii fontlist))) | 318 (while l |
297 (setcdr (assq 'latin-iso8859-1 fontlist) (cdr (assq 'ascii fontlist)))) | 319 (if (string-match (car (car l)) ascii-font) |
320 (let ((charsets (cdr (car l)))) | |
321 (while charsets | |
322 (if (not (eq (car charsets) 'ascii)) | |
323 (setcdr (assq (car charsets) fontlist) ascii-font)) | |
324 (setq charsets (cdr charsets))) | |
325 (setq l nil)) | |
326 (setq l (cdr l))))) | |
327 | |
298 fontlist) | 328 fontlist) |
299 | 329 |
300 (defun fontset-name-p (fontset) | 330 (defun fontset-name-p (fontset) |
301 "Return non-nil if FONTSET is valid as fontset name. | 331 "Return non-nil if FONTSET is valid as fontset name. |
302 A valid fontset name should conform to XLFD (X Logical Font Description) | 332 A valid fontset name should conform to XLFD (X Logical Font Description) |
349 name)) | 379 name)) |
350 fontset))) | 380 fontset))) |
351 | 381 |
352 (defvar uninstantiated-fontset-alist nil | 382 (defvar uninstantiated-fontset-alist nil |
353 "Alist of fontset names vs. information for instantiating them. | 383 "Alist of fontset names vs. information for instantiating them. |
354 Each element has the form (FONTSET STYLE BASE-FONTSET), where | 384 Each element has the form (FONTSET STYLE FONTLIST), where |
355 FONTSET is a name of fontset not yet instantiated. | 385 FONTSET is a name of fontset not yet instantiated. |
356 STYLE is a style of FONTSET, one of the followings: | 386 STYLE is a style of FONTSET, one of the followings: |
357 bold, demobold, italic, oblique, | 387 bold, demobold, italic, oblique, |
358 bold-italic, demibold-italic, bold-oblique, demibold-oblique. | 388 bold-italic, demibold-italic, bold-oblique, demibold-oblique. |
359 BASE-FONTSET is a name of fontset base from which FONSET is instantiated.") | 389 FONTLIST is an alist of charsets vs font names to be used in FONSET.") |
390 | |
391 (defconst x-style-funcs-alist | |
392 '((bold x-make-font-bold) | |
393 (demibold x-make-font-demibold) | |
394 (italic x-make-font-italic) | |
395 (oblique x-make-font-oblique) | |
396 (bold-italic x-make-font-bold x-make-font-italic) | |
397 (demibold-italic x-make-font-demibold x-make-font-italic) | |
398 (demibold-oblique x-make-font-demibold x-make-font-oblique) | |
399 (bold-oblique x-make-font-bold x-make-font-oblique)) | |
400 "Alist of font style vs functions to generate a X font name of the style.") | |
360 | 401 |
361 ;;;###autoload | 402 ;;;###autoload |
362 (defun create-fontset-from-fontset-spec (fontset-spec &optional style noerror) | 403 (defun create-fontset-from-fontset-spec (fontset-spec |
404 &optional style-variant-p noerror) | |
363 "Create a fontset from fontset specification string FONTSET-SPEC. | 405 "Create a fontset from fontset specification string FONTSET-SPEC. |
364 FONTSET-SPEC is a string of the format: | 406 FONTSET-SPEC is a string of the format: |
365 FONTSET-NAME,CHARSET-NAME0:FONT-NAME0,CHARSET-NAME1:FONT-NAME1, ... | 407 FONTSET-NAME,CHARSET-NAME0:FONT-NAME0,CHARSET-NAME1:FONT-NAME1, ... |
366 Any number of SPACE, TAB, and NEWLINE can be put before and after commas. | 408 Any number of SPACE, TAB, and NEWLINE can be put before and after commas. |
367 If optional argument STYLE is specified, create a fontset of STYLE | 409 If optional argument STYLE-VARIANT-P is specified, it also creates |
368 by modifying FONTSET-SPEC appropriately. STYLE can be one of `bold', | 410 fontsets which differs from FONTSET-NAME in styles (e.g. bold, italic). |
369 `italic', and `bold-italic'. | |
370 If this function attempts to create already existing fontset, error is | 411 If this function attempts to create already existing fontset, error is |
371 signaled unless the optional 3rd argument NOERROR is non-nil." | 412 signaled unless the optional 3rd argument NOERROR is non-nil." |
372 (if (not (string-match "^[^,]+" fontset-spec)) | 413 (if (not (string-match "^[^,]+" fontset-spec)) |
373 (error "Invalid fontset spec: %s" fontset-spec)) | 414 (error "Invalid fontset spec: %s" fontset-spec)) |
374 (let ((idx (match-end 0)) | 415 (let ((idx (match-end 0)) |
375 (name (match-string 0 fontset-spec)) | 416 (name (match-string 0 fontset-spec)) |
376 fontlist charset) | 417 fontlist charset) |
377 ;; At first, extract pairs of charset and fontname from FONTSET-SPEC. | 418 (if (query-fontset name) |
378 (while (string-match "[, \t\n]*\\([^:]+\\):\\([^,]+\\)" fontset-spec idx) | 419 (or noerror |
379 (setq idx (match-end 0)) | 420 (error "Fontset \"%s\" already exists")) |
380 (setq charset (intern (match-string 1 fontset-spec))) | 421 ;; At first, extract pairs of charset and fontname from FONTSET-SPEC. |
381 (if (charsetp charset) | 422 (while (string-match "[, \t\n]*\\([^:]+\\):\\([^,]+\\)" fontset-spec idx) |
382 (setq fontlist (cons (cons charset (match-string 2 fontset-spec)) | 423 (setq idx (match-end 0)) |
383 fontlist)))) | 424 (setq charset (intern (match-string 1 fontset-spec))) |
384 | 425 (if (charsetp charset) |
385 ;; If NAME conforms to XLFD, complement FONTLIST for charsets not | 426 (setq fontlist (cons (cons charset (match-string 2 fontset-spec)) |
386 ;; specified in FONTSET-SPEC. | 427 fontlist)))) |
387 (let ((xlfd-fields (x-decompose-font-name name))) | 428 |
388 (if xlfd-fields | 429 (if style-variant-p |
389 (setq fontlist | 430 ;; Generate fontset names of style variants and set them in |
390 (x-complement-fontset-spec xlfd-fields fontlist)))) | 431 ;; uninstantiated-fontset-alist. |
391 | 432 (let ((style-funcs-alist x-style-funcs-alist) |
392 ;; If STYLE is specified, modify fontset name (NAME) and FONTLIST. | 433 new-name style funcs) |
393 (if nil | 434 (while style-funcs-alist |
394 (let ((func (cdr (assq style '((bold . x-make-font-bold) | 435 (setq style (car (car style-funcs-alist)) |
395 (italic . x-make-font-italic) | 436 funcs (cdr (car style-funcs-alist))) |
396 (bold-italic . x-make-font-bold-italic))))) | 437 (setq new-name name) |
397 (l fontlist) | 438 (while funcs |
398 new-name) | 439 (setq new-name (funcall (car funcs) new-name)) |
399 (if (and func | 440 (setq funcs (cdr funcs))) |
400 (setq new-name (funcall func name))) | 441 (setq uninstantiated-fontset-alist |
401 (progn | 442 (cons (list new-name style fontlist) |
402 (setq name new-name) | 443 uninstantiated-fontset-alist)) |
403 (while l | 444 (setq style-funcs-alist (cdr style-funcs-alist))))) |
404 (if (setq new-name (funcall func (cdr (car l)))) | 445 |
405 (setcdr (car l) new-name)) | 446 ;; If NAME conforms to XLFD, complement FONTLIST for charsets |
406 (setq l (cdr l)))))) | 447 ;; which are not specified in FONTSET-SPEC. |
407 (let ((funcs-alist | 448 (let ((xlfd-fields (x-decompose-font-name name))) |
408 '((bold x-make-font-bold) | 449 (if xlfd-fields |
409 (demibold x-make-font-demibold) | 450 (setq fontlist |
410 (italic x-make-font-italic) | 451 (x-complement-fontset-spec xlfd-fields fontlist)))) |
411 (oblique x-make-font-oblique) | 452 |
412 (bold-italic x-make-font-bold x-make-font-italic) | 453 ;; Create the fontset. |
413 (demibold-italic x-make-font-demibold x-make-font-italic) | |
414 (bold-oblique x-make-font-bold x-make-font-oblique) | |
415 (demibold-oblique x-make-font-demibold x-make-font-oblique))) | |
416 new-name style funcs) | |
417 (while funcs-alist | |
418 (setq funcs (car funcs-alist)) | |
419 (setq style (car funcs)) | |
420 (setq funcs (cdr funcs)) | |
421 (setq new-name name) | |
422 (while funcs | |
423 (setq new-name (funcall (car funcs) new-name)) | |
424 (setq funcs (cdr funcs))) | |
425 (setq uninstantiated-fontset-alist | |
426 (cons (list new-name style name) uninstantiated-fontset-alist)) | |
427 (setq funcs-alist (cdr funcs-alist))))) | |
428 | |
429 (if (and noerror (query-fontset name)) | |
430 ;; Don't try to create an already existing fontset. | |
431 nil | |
432 ;; Create the fontset, and define the alias if appropriate. | |
433 (new-fontset name fontlist) | 454 (new-fontset name fontlist) |
434 (if (and (not style) | 455 |
435 (not (assoc name fontset-alias-alist)) | 456 ;; Define the alias (short name) if appropriate. |
457 (if (and (not (assoc name fontset-alias-alist)) | |
436 (string-match "fontset-.*$" name)) | 458 (string-match "fontset-.*$" name)) |
437 (let ((alias (match-string 0 name))) | 459 (let ((alias (match-string 0 name))) |
438 (or (rassoc alias fontset-alias-alist) | 460 (or (rassoc alias fontset-alias-alist) |
439 (setq fontset-alias-alist | 461 (setq fontset-alias-alist |
440 (cons (cons name alias) fontset-alias-alist)))))))) | 462 (cons (cons name alias) fontset-alias-alist)))))))) |
441 | 463 |
442 (defun instantiate-fontset (fontset) | 464 (defun instantiate-fontset (fontset) |
443 "Create a new fontset FONTSET if it is not yet instantiated. | 465 "Make FONTSET be readly to use. |
466 FONTSET should be in the variable `uninstantiated-fontset-alist' in advance. | |
444 Return FONTSET if it is created successfully, else return nil." | 467 Return FONTSET if it is created successfully, else return nil." |
445 (let ((fontset-data (assoc fontset uninstantiated-fontset-alist))) | 468 (let ((fontset-data (assoc fontset uninstantiated-fontset-alist))) |
446 (if (null fontset-data) | 469 (if (null fontset-data) |
447 nil | 470 nil |
448 (let ((style (nth 1 fontset-data)) | 471 (let* ((xlfd-fields (x-decompose-font-name fontset)) |
449 (base-fontset (nth 2 fontset-data)) | 472 (fontlist (x-complement-fontset-spec xlfd-fields |
450 (funcs-alist | 473 (nth 2 fontset-data))) |
451 '((bold x-make-font-bold) | 474 (funcs (cdr (assq (nth 1 fontset-data) x-style-funcs-alist))) |
452 (demibold x-make-font-demibold) | 475 ascii-font font font2) |
453 (italic x-make-font-italic) | |
454 (oblique x-make-font-oblique) | |
455 (bold-italic x-make-font-bold x-make-font-italic) | |
456 (demibold-italic x-make-font-demibold x-make-font-italic) | |
457 (bold-oblique x-make-font-bold x-make-font-oblique) | |
458 (demibold-oblique x-make-font-demibold x-make-font-oblique))) | |
459 ascii-font font font2 funcs) | |
460 (setq uninstantiated-fontset-alist | 476 (setq uninstantiated-fontset-alist |
461 (delete fontset-data uninstantiated-fontset-alist)) | 477 (delete fontset-data uninstantiated-fontset-alist)) |
462 (setq fontset-data (assoc base-fontset global-fontset-alist)) | 478 (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist)) |
463 (setq ascii-font (cdr (assq 'ascii (cdr fontset-data)))) | 479 |
464 (setq funcs (cdr (assq style funcs-alist))) | 480 ;; At first, check if ASCII font of this style is surely available. |
481 (setq ascii-font (cdr (assq 'ascii fontlist))) | |
465 (if (= (length funcs) 1) | 482 (if (= (length funcs) 1) |
466 (and (setq font (funcall (car funcs) ascii-font)) | 483 (and (setq font (funcall (car funcs) ascii-font)) |
467 (setq font (x-resolve-font-name font 'default))) | 484 (setq font (x-resolve-font-name font 'default))) |
468 (and (setq font (funcall (car funcs) ascii-font)) | 485 (and (setq font (funcall (car funcs) ascii-font)) |
469 (not (equal font ascii-font)) | 486 (not (equal font ascii-font)) |
470 (setq font2 (funcall (nth 1 funcs) font)) | 487 (setq font2 (funcall (nth 1 funcs) font)) |
471 (not (equal font2 font)) | 488 (not (equal font2 font)) |
472 (setq font (x-resolve-font-name font2 'default)))) | 489 (setq font (x-resolve-font-name font2 'default)))) |
490 | |
491 ;; If ASCII font is available, instantiate the fontset. | |
473 (when font | 492 (when font |
474 (let ((new-fontset-data (copy-alist fontset-data))) | 493 (let ((new-fontlist (list (cons 'ascii font)))) |
475 (setq funcs (cdr (assq style funcs-alist))) | 494 (while fontlist |
476 (while funcs | 495 (setq font (cdr (car fontlist))) |
477 (setcar new-fontset-data | 496 (or (eq (car (car fontlist)) 'ascii) |
478 (funcall (car funcs) (car new-fontset-data))) | 497 (if (if (= (length funcs) 1) |
479 (let ((l (cdr new-fontset-data))) | 498 (setq font (funcall (car funcs) font)) |
480 (while l | 499 (and (setq font (funcall (car funcs) font)) |
481 (if (= (length funcs) 1) | 500 (not (equal font (cdr (car fontlist)))) |
482 (setq font (funcall (car funcs) (cdr (car l)))) | 501 (setq font2 (funcall (nth 1 funcs) font)) |
483 (and (setq font (funcall (car funcs) (cdr (car l)))) | 502 (not (equal font2 font)) |
484 (not (equal font (cdr (car l)))) | 503 (setq font font2))) |
485 (setq font2 (funcall (nth 1 funcs) font)) | 504 (setq new-fontlist |
486 (not (equal font2 font)) | 505 (cons (cons (car fontlist) font) new-fontlist)))) |
487 (setq font font2))) | 506 (setq fontlist (cdr fontlist))) |
488 (when font | 507 (new-fontset fontset (x-complement-fontset-spec xlfd-fields |
489 (setcdr (car l) font) | 508 fontlist)) |
490 (register-alternate-fontnames font)) | 509 fontset)))))) |
491 (setq l (cdr l)))) | |
492 (setq funcs (cdr funcs))) | |
493 (new-fontset (car new-fontset-data) (cdr new-fontset-data)) | |
494 (car new-fontset-data))))))) | |
495 | 510 |
496 ;; Create standard fontset from 16 dots fonts which are the most widely | 511 ;; Create standard fontset from 16 dots fonts which are the most widely |
497 ;; installed fonts. Fonts for Chinese-GB, Korean, and Chinese-CNS are | 512 ;; installed fonts. Fonts for Chinese-GB, Korean, and Chinese-CNS are |
498 ;; specified here because FAMILY of those fonts are not "fixed" in | 513 ;; specified here because FAMILY of those fonts are not "fixed" in |
499 ;; many cases. | 514 ;; many cases. |