;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;; Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
;; GNU Emacs 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
charsets if you don't have a Unicode font with which to display them.
Setting this variable directly does not take effect;
-use either M-x customize of the function `latin1-display'."
+use either \\[customize] or the function `latin1-display'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
See option `latin1-display' for the method. The members of the list
must be in `latin1-display-sets'. With no arguments, reset the
display for all of `latin1-display-sets'. See also
-`latin1-display-setup'. As well as iso-8859 characters, this treats
-some characters in the `mule-unicode-...' charsets if you don't have
-a Unicode font with which to display them."
+`latin1-display-setup'."
(if sets
(progn
(mapc #'latin1-display-setup sets)
- (unless (latin1-char-displayable-p
- (make-char 'mule-unicode-0100-24ff 32 33))
- ;; It doesn't look as though we have a Unicode font.
- (map-char-table
- (lambda (c uc)
- (when (and (char-valid-p c)
- (char-valid-p uc)
- (not (aref standard-display-table uc)))
- (aset standard-display-table uc
- (or (aref standard-display-table c)
- (vector c)))))
- ucs-mule-8859-to-mule-unicode)
+ (unless (char-displayable-p #x101) ; a with macron
;; Extra stuff for windows-1252, in particular.
(mapc
(lambda (l)
(?\\e$,1rt\e(B "--") ;; EM DASH
(?\\e$,1ub\e(B "TM") ;; TRADE MARK SIGN
(?\\e$,1s:\e(B ">") ;; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+ (?\e$,1s"\e(B "\e,A7\e(B")
)))
(setq latin1-display t))
(mapc #'latin1-display-reset latin1-display-sets)
- (aset standard-display-table
- (make-char 'mule-unicode-0100-24ff) nil)
- (aset standard-display-table
- (make-char 'mule-unicode-2500-33ff) nil)
- (aset standard-display-table
- (make-char 'mule-unicode-e000-ffff) nil)
+ (set-char-table-range standard-display-table '(#x0100 . #x33FF) nil)
+ (set-char-table-range standard-display-table '(#xE000 . #xFFFF) nil)
(setq latin1-display nil)
(redraw-display)))
(defcustom latin1-display-face 'default
"Face to use for displaying substituted ASCII sequences."
:type 'face
- :version "21.4"
+ :version "22.1"
:group 'latin1-display)
(defun latin1-display-char (char display &optional alt-display)
(if (eq 'default latin1-display-face)
(standard-display-ascii char (format latin1-display-format display))
(aset standard-display-table char
- (vconcat (mapcar (lambda (c)
- (logior c (lsh (face-id latin1-display-face)
- 19)))
+ (vconcat (mapcar (lambda (c) (make-glyph-code c latin1-display-face))
display))))
(aset standard-display-table char
- (if (eq 'default latin1-display-face)
- display
- (logior display (lsh (face-id latin1-display-face) 19))))))
+ (make-glyph-code display latin1-display-face))))
(defun latin1-display-identities (charset)
"Display each character in CHARSET as the corresponding Latin-1 character.
using an ISO8859 character set."
(if (eq charset 'cyrillic)
(setq charset 'cyrillic-iso))
- (let ((i 32)
+ (let ((i 128)
(set (car (remq 'ascii (get-language-info charset 'charset)))))
- (while (<= i 127)
- (aset standard-display-table
- (make-char set i)
- (vector (make-char 'latin-iso8859-1 i)))
+ (while (<= i 255)
+ (let ((ch (decode-char set i)))
+ (if ch
+ (aset standard-display-table ch (vector i))))
(setq i (1+ i)))))
(defun latin1-display-reset (language)
'arabic-iso8859-6
(car (remq 'ascii (get-language-info language
'charset))))))
- (standard-display-default (make-char charset 32)
- (make-char charset 127)))
+ (map-charset-chars #'(lambda (range arg)
+ (standard-display-default (car range) (cdr range)))
+ charset))
(sit-for 0))
(defun latin1-display-check-font (language)
(if (eq language 'cyrillic)
(setq language 'cyrillic-iso))
(let* ((info (get-language-info language 'charset))
- (char (and info (make-char (car (remq 'ascii info)) ?\ ))))
- (and char (latin1-char-displayable-p char))))
+ (char (and info (decode-char (car (remq 'ascii info)) ?\ ))))
+ (and char (char-displayable-p char))))
-;; This should be moved into mule-utils or somewhere after 21.1.
-(defun latin1-char-displayable-p (char)
- "Return non-nil if we should be able to display CHAR.
-On a multi-font display, the test is only whether there is an
-appropriate font from the selected frame's fontset to display CHAR's
-charset in general. Since fonts may be specified on a per-character
-basis, this may not be accurate."
- (cond ((< char 256)
- ;; Single byte characters are always displayable.
- t)
- ((display-multi-font-p)
- ;; 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 field 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)))))))))
+;; Backwards compatibility.
+(defalias 'latin1-char-displayable-p 'char-displayable-p)
+(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "22.1")
(defun latin1-display-setup (set &optional force)
"Set up Latin-1 display for characters in the given SET.
is. If FORCE is non-nil, set up the display regardless."
(cond
((eq set 'latin-2)
- (when (or force
- (not (latin1-display-check-font set)))
- (latin1-display-identities set)
- (mapc
- (lambda (l)
- (apply 'latin1-display-char l))
+ (latin1-display-identities set)
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
'((?\e,BF\e(B "'C" "C'")
(?\e,BP\e(B "'D" "/D")
(?\e,B&\e(B "'S" "S'")
(?\e,Bk\e(B "\"e")
(?\e,B=\e(B "''" "'")
(?\e,B7\e(B "'<") ; Lynx's rendering of caron
- ))))
+ )))
((eq set 'latin-3)
- (when (or force
- (not (latin1-display-check-font set)))
- (latin1-display-identities set)
- (mapc
- (lambda (l)
- (apply 'latin1-display-char l))
+ (latin1-display-identities set)
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
'((?\e,C!\e(B "/H")
(?\e,C"\e(B "~`" "'(")
(?\e,C&\e(B "^H" "H^")
(?\e,Cx\e(B "^g" "g^")
(?\e,C}\e(B "~u" "u(")
(?\e,C~\e(B "^s" "s^")
- (?\e,C\7f\e(B "/." "^.")))))
+ (?\e,C\7f\e(B "/." "^."))))
((eq set 'latin-4)
- (when (or force
- (not (latin1-display-check-font set)))
- (latin1-display-identities set)
- (mapc
- (lambda (l)
- (apply 'latin1-display-char l))
+ (latin1-display-identities set)
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
'((?\e,D!\e(B "A," "A;")
(?\e,D"\e(B "k/" "kk")
(?\e,D#\e(B "R," ",R")
(?\e,Dy\e(B "u," "u;")
(?\e,D}\e(B "u~" "~u")
(?\e,D~\e(B "u-")
- (?\e,D\7f\e(B "^.")))))
+ (?\e,D\7f\e(B "^."))))
((eq set 'latin-5)
- (when (or force
- (not (latin1-display-check-font set)))
- (latin1-display-identities set)
- (mapc
- (lambda (l)
- (apply 'latin1-display-char l))
+ (latin1-display-identities set)
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
'((?\e,Mp\e(B "~g" "g(")
(?\e,MP\e(B "~G" "G(")
(?\e,M]\e(B ".I" "I^.")
(?\e,Mj\e(B "^e" "e<") ; from latin-post
(?\e,Ml\e(B ".e" "e^.")
(?\e,Mo\e(B "\"i" "i-") ; from latin-post
- (?\e,M}\e(B ".i" "i.")))))
+ (?\e,M}\e(B ".i" "i."))))
((eq set 'latin-8)
- (when (or force
- (not (latin1-display-check-font set)))
- (latin1-display-identities set)
- (mapc
- (lambda (l)
- (apply 'latin1-display-char l))
+ (latin1-display-identities set)
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
'((?\e,_!\e(B ".B" "B`")
(?\e,_"\e(B ".b" "b`")
(?\e,_%\e(B ".c" "c`")
(?\e,_W\e(B ".T" "T`")
(?\e,_~\e(B "^y" "y^")
(?\e,_^\e(B "^Y" "Y^")
- (?\e,_/\e(B "\"Y")))))
+ (?\e,_/\e(B "\"Y"))))
((eq set 'latin-9)
- (when (or force
- (not (latin1-display-check-font set)))
- (latin1-display-identities set)
- (mapc
- (lambda (l)
- (apply 'latin1-display-char l))
+ (latin1-display-identities set)
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
'((?\e,b(\e(B "~s" "s<")
(?\e,b&\e(B "~S" "S<")
(?\e,b$\e(B "Euro" "E=")
(?\e,b4\e(B "~Z" "Z<")
(?\e,b>\e(B "\"Y")
(?\e,b=\e(B "oe")
- (?\e,b<\e(B "OE")))))
+ (?\e,b<\e(B "OE"))))
((eq set 'greek)
- (when (or force
- (not (latin1-display-check-font set)))
- (mapc
- (lambda (l)
- (apply 'latin1-display-char l))
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
'((?\e,F!\e(B "9'")
(?\e,F"\e(B "'9")
(?\e,F/\e(B "-M")
(?\e,F|\e(B "'o")
(?\e,F}\e(B "'u")
(?\e,F~\e(B "'w")))
- (mapc
- (lambda (l)
- (aset standard-display-table (car l) (string-to-vector (cadr l))))
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (aset standard-display-table (car l) (string-to-vector (cadr l)))))
'((?\e,FA\e(B "A")
(?\e,FB\e(B "B")
(?\e,FE\e(B "E")
(?\e,FT\e(B "T")
(?\e,FU\e(B "Y")
(?\e,FW\e(B "X")
- (?\e,Fo\e(B "o")))))
+ (?\e,Fo\e(B "o"))))
((eq set 'hebrew)
- (when (or force
- (not (latin1-display-check-font set)))
- ;; Don't start with identities, since we don't have definitions
- ;; for a lot of Hebrew in internal.el. (Intlfonts is also
- ;; missing some glyphs.)
- (let ((i 34))
- (while (<= i 62)
- (aset standard-display-table
- (make-char 'hebrew-iso8859-8 i)
- (vector (make-char 'latin-iso8859-1 i)))
- (setq i (1+ i))))
- (mapc
- (lambda (l)
- (aset standard-display-table (car l) (string-to-vector (cadr l))))
+ ;; Don't start with identities, since we don't have definitions
+ ;; for a lot of Hebrew in internal.el. (Intlfonts is also
+ ;; missing some glyphs.)
+ (let ((i 34))
+ (while (<= i 62)
+ (let ((ch (decode-char 'hebrew-iso8859-8 i)))
+ (if ch
+ (aset standard-display-table ch
+ (vector (decode-char 'latin-iso8859-1 i)))))
+ (setq i (1+ i))))
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (aset standard-display-table (car l) (string-to-vector (cadr l)))))
'((?\e,H_\e(B "=2")
(?\e,H`\e(B "A+")
(?\e,Ha\e(B "B+")
(?\e,Hw\e(B "Q+")
(?\e,Hx\e(B "R+")
(?\e,Hy\e(B "Sh")
- (?\e,Hz\e(B "T+")))))
+ (?\e,Hz\e(B "T+"))))
;; Arabic probably isn't so useful in the absence of Arabic
;; language support...
((eq set 'arabic)
(setq set 'arabic)
- (when (or force
- (not (latin1-display-check-font set)))
- (aset standard-display-table ?\e,G \e(B "\e,A \e(B")
- (aset standard-display-table ?\e,G$\e(B "\e,A$\e(B")
- (aset standard-display-table ?\e,G-\e(B "\e,A-\e(B")
- (mapc (lambda (l)
- (apply 'latin1-display-char l))
+ (or (char-displayable-p ?\e,G \e(B)
+ (aset standard-display-table ?\e,G \e(B "\e,A \e(B"))
+ (or (char-displayable-p ?\e,G$\e(B)
+ (aset standard-display-table ?\e,G$\e(B "\e,A$\e(B"))
+ (or (char-displayable-p ?\e,G-\e(B)
+ (aset standard-display-table ?\e,G-\e(B "\e,A-\e(B"))
+ (mapc (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
'((?\e,G,\e(B ",+")
(?\e,G;\e(B ";+")
(?\e,G?\e(B "?+")
(?\e,Go\e(B "'+")
(?\e,Gp\e(B "1+")
(?\e,Gq\e(B "3+")
- (?\e,Gr\e(B "0+")))))
+ (?\e,Gr\e(B "0+"))))
((eq set 'cyrillic)
(setq set 'cyrillic-iso)
- (when (or force
- (not (latin1-display-check-font set)))
- (mapc
- (lambda (l)
- (apply 'latin1-display-char l))
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
'((?\e,L"\e(B "Dj")
(?\e,L#\e(B "Gj")
(?\e,L$\e(B "IE")
(?\e,L|\e(B "kj")
(?\e,L~\e(B "v%")
(?\e,L\7f\e(B "dzh")))
- (mapc
- (lambda (l)
- (aset standard-display-table (car l) (string-to-vector (cadr l))))
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (aset standard-display-table (car l) (string-to-vector (cadr l)))))
'((?\e,L!\e(B "\e,AK\e(B")
(?\e,L%\e(B "S")
(?\e,L&\e(B "I")
(?\e,Lu\e(B "s")
(?\e,Lv\e(B "i")
(?\e,Lw\e(B "\e,Ao\e(B")
- (?\e,Lx\e(B "j")))))
+ (?\e,Lx\e(B "j"))))
(t (error "Unsupported character set: %S" set)))
;;;###autoload
(defcustom latin1-display-ucs-per-lynx nil
"Set up Latin-1/ASCII display for Unicode characters.
-This uses the transliterations of the Lynx browser. The display is't
+This uses the transliterations of the Lynx browser. The display isn't
changed if the display can render Unicode characters.
Setting this variable directly does not take effect;
-use either M-x customize of the function `latin1-display'."
+use either \\[customize] or the function `latin1-display'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
"Set up Latin-1/ASCII display for Unicode characters.
This uses the transliterations of the Lynx browser.
-With argument ARG, turn such display on iff ARG is positive, otherwise
+With argument ARG, turn such display on if ARG is positive, otherwise
turn it off and display Unicode characters literally. The display
-is't changed if the display can render Unicode characters."
+isn't changed if the display can render Unicode characters."
(interactive "p")
(if (> arg 0)
- (unless (latin1-char-displayable-p
- (make-char 'mule-unicode-0100-24ff 32 33))
+ (unless (char-displayable-p #x101) ; a with macron
;; It doesn't look as though we have a Unicode font.
(let ((latin1-display-format "%s"))
(mapc
(?\\e$,3sc\e(B "\"")
(?\\e$,3sd\e(B ",")
;; Not from Lynx
- (?\e$,3r_\e(B . "")
- (?\e$,3u=\e(B . "?")))))
+ (?\e$,3r_\e(B "")
+ (?\e$,3u=\e(B "?")))))
(aset standard-display-table
(make-char 'mule-unicode-0100-24ff) nil)
(aset standard-display-table
(provide 'latin1-disp)
+;;; arch-tag: 68b2872e-d667-4f48-8e2f-ec2ba2d29406
;;; latin1-disp.el ends here