diff options
author | Dave Love <fx@gnu.org> | 2000-10-23 17:47:06 +0000 |
---|---|---|
committer | Dave Love <fx@gnu.org> | 2000-10-23 17:47:06 +0000 |
commit | fa2c768f76b45b207e38d3fde7fb424f23293e1f (patch) | |
tree | 1f2c1f9b32118e3cbca2ab795420a30417fb2819 /lisp/international/latin1-disp.el | |
parent | 446c097e30de5509ef33a5432febcc28a4e680cf (diff) | |
download | emacs-fa2c768f76b45b207e38d3fde7fb424f23293e1f.tar.gz |
(latin1-char-displayable-p): New
function (from Handa).
(latin1-display-check-font): Use it.
Diffstat (limited to 'lisp/international/latin1-disp.el')
-rw-r--r-- | lisp/international/latin1-disp.el | 43 |
1 files changed, 37 insertions, 6 deletions
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el index 94d8e08f1a9..ee011d21fa5 100644 --- a/lisp/international/latin1-disp.el +++ b/lisp/international/latin1-disp.el @@ -143,18 +143,49 @@ character set." (make-char charset 127))) (sit-for 0)) -;; Is there a better way than this? (defun latin1-display-check-font (language) "Return non-nil if we have a font with an encoding for LANGUAGE. LANGUAGE is a symbol naming a language environment using an ISO8859 character set: `latin-2', `hebrew' etc." (if (eq language 'cyrillic) (setq language 'cyrillic-iso)) - (if window-system - (let* ((info (get-language-info language 'charset)) - (str (symbol-name (car (remq 'ascii info))))) - (string-match "-iso8859-[0-9]+\\'" str) - (x-list-fonts (concat "*" (match-string 0 str)))))) + (let* ((info (get-language-info language 'charset)) + (char (make-char (car (remq 'ascii info)) ?\ ))) + (latin1-char-displayable-p char))) + +;; This should be moved into mule-utils or somewhere after 21.1. +(defun latin1-char-displayable-p (char) + (cond ((< char 256) + ;; Single byte characters are always displayable. + t) + (window-system + ;; On a window system, a character is displayable if we have + ;; a font for that character in the default face of the + ;; currently selected frame. + (let ((fontset (frame-parameter (selected-frame) 'font)) + font-pattern) + (if (query-fontset fontset) + (setq font-pattern (fontset-font fontset char))) + (or font-pattern + (setq font-pattern (fontset-font "fontset-default" char))) + (if font-pattern + (progn + ;; Now FONT-PATTERN is a string or a cons of family + ;; field pattern and registry filed pattern. + (or (stringp font-pattern) + (setq font-pattern (concat (or (car font-pattern) "*") + "-*-" + (cdr font-pattern)))) + (x-list-fonts font-pattern 'default (selected-frame) 1))))) + (t + (let ((coding (terminal-coding-system))) + (if coding + (let ((safe-chars (coding-system-get coding 'safe-chars)) + (safe-charsets (coding-system-get coding 'safe-charsets))) + (or (and safe-chars + (aref safe-chars char)) + (and safe-charsets + (memq (char-charset char) safe-charsets))))))))) (defun latin1-display-setup (set &optional force) "Set up Latin-1 display for characters in the given SET. |