Mercurial > emacs
comparison lisp/international/fontset.el @ 18714:5d47a06d19bf
(create-fontset-from-fontset-spec): Add
optional arg NOERROR.
(create-fontset-from-x-resource): Give t as arg NOERROR to
create-fontset-from-fontset-spec.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Thu, 10 Jul 1997 06:46:42 +0000 |
| parents | 8b4a66c66dd6 |
| children | de8249499f33 |
comparison
equal
deleted
inserted
replaced
| 18713:bca5a6b78f91 | 18714:5d47a06d19bf |
|---|---|
| 322 ((string-match "^ro$" slant) | 322 ((string-match "^ro$" slant) |
| 323 (setq name (concat name " " "reverse slant")))) | 323 (setq name (concat name " " "reverse slant")))) |
| 324 name)) | 324 name)) |
| 325 fontset))) | 325 fontset))) |
| 326 | 326 |
| 327 (defun create-fontset-from-fontset-spec (fontset-spec &optional style) | 327 (defun create-fontset-from-fontset-spec (fontset-spec &optional style noerror) |
| 328 "Create a fontset from fontset specification string FONTSET-SPEC. | 328 "Create a fontset from fontset specification string FONTSET-SPEC. |
| 329 FONTSET-SPEC is a string of the format: | 329 FONTSET-SPEC is a string of the format: |
| 330 FONTSET-NAME,CHARSET-NAME0:FONT-NAME0,CHARSET-NAME1:FONT-NAME1, ... | 330 FONTSET-NAME,CHARSET-NAME0:FONT-NAME0,CHARSET-NAME1:FONT-NAME1, ... |
| 331 Any number of SPACE, TAB, and NEWLINE can be put before and after commas. | 331 Any number of SPACE, TAB, and NEWLINE can be put before and after commas. |
| 332 If optional argument STYLE is specified, create a fontset of STYLE | 332 If optional argument STYLE is specified, create a fontset of STYLE |
| 333 by modifying FONTSET-SPEC appropriately. STYLE can be one of `bold', | 333 by modifying FONTSET-SPEC appropriately. STYLE can be one of `bold', |
| 334 `italic', and `bold-italic'." | 334 `italic', and `bold-italic'. |
| 335 If this function attemps to create already existing fontset, error is | |
| 336 signaled unlress the optional 3rd argument NOERROR is non-nil." | |
| 335 (if (not (string-match "^[^,]+" fontset-spec)) | 337 (if (not (string-match "^[^,]+" fontset-spec)) |
| 336 (error "Invalid fontset spec: %s" fontset-spec)) | 338 (error "Invalid fontset spec: %s" fontset-spec)) |
| 337 (let ((idx (match-end 0)) | 339 (let ((idx (match-end 0)) |
| 338 (name (match-string 0 fontset-spec)) | 340 (name (match-string 0 fontset-spec)) |
| 339 fontlist charset) | 341 fontlist charset) |
| 365 (let ((xlfd-fields (x-decompose-font-name name))) | 367 (let ((xlfd-fields (x-decompose-font-name name))) |
| 366 (if xlfd-fields | 368 (if xlfd-fields |
| 367 (setq fontlist | 369 (setq fontlist |
| 368 (x-complement-fontset-spec xlfd-fields fontlist)))) | 370 (x-complement-fontset-spec xlfd-fields fontlist)))) |
| 369 | 371 |
| 370 ;; Create the fontset, and define the alias if appropriate. | 372 (if (and noerror (query-fontset name)) |
| 371 (new-fontset name fontlist) | 373 ;; Don't try to create an already existing fontset. |
| 372 (if (and (not style) | 374 nil |
| 373 (not (assoc name fontset-alias-alist)) | 375 ;; Create the fontset, and define the alias if appropriate. |
| 374 (string-match "fontset-.*$" name)) | 376 (new-fontset name fontlist) |
| 375 (let ((alias (match-string 0 name))) | 377 (if (and (not style) |
| 376 (or (rassoc alias fontset-alias-alist) | 378 (not (assoc name fontset-alias-alist)) |
| 377 (setq fontset-alias-alist | 379 (string-match "fontset-.*$" name)) |
| 378 (cons (cons name alias) fontset-alias-alist))))) | 380 (let ((alias (match-string 0 name))) |
| 379 )) | 381 (or (rassoc alias fontset-alias-alist) |
| 382 (setq fontset-alias-alist | |
| 383 (cons (cons name alias) fontset-alias-alist)))))))) | |
| 380 | 384 |
| 381 | 385 |
| 382 ;; Create standard fontset from 16 dots fonts which are the most widely | 386 ;; Create standard fontset from 16 dots fonts which are the most widely |
| 383 ;; installed fonts. Fonts for Chinese-GB, Korean, and Chinese-CNS are | 387 ;; installed fonts. Fonts for Chinese-GB, Korean, and Chinese-CNS are |
| 384 ;; specified here because FAMILY of those fonts are not "fixed" in | 388 ;; specified here because FAMILY of those fonts are not "fixed" in |
| 407 (defun create-fontset-from-x-resource () | 411 (defun create-fontset-from-x-resource () |
| 408 (let ((idx 0) | 412 (let ((idx 0) |
| 409 fontset-spec) | 413 fontset-spec) |
| 410 (while (setq fontset-spec (x-get-resource (concat "fontset-" idx) | 414 (while (setq fontset-spec (x-get-resource (concat "fontset-" idx) |
| 411 (concat "Fontset-" idx))) | 415 (concat "Fontset-" idx))) |
| 412 (create-fontset-from-fontset-spec fontset-spec) | 416 (create-fontset-from-fontset-spec fontset-spec nil 'noerror) |
| 413 (setq idx (1+ idx))))) | 417 (setq idx (1+ idx))))) |
| 414 | 418 |
| 415 (defsubst fontset-list () | 419 (defsubst fontset-list () |
| 416 "Returns a list of all defined fontset names." | 420 "Returns a list of all defined fontset names." |
| 417 (mapcar 'car global-fontset-alist)) | 421 (mapcar 'car global-fontset-alist)) |