Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
7d354dd5
Commit
7d354dd5
authored
Sep 17, 2000
by
Dave Love
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
*** empty log message ***
parent
6a142f26
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
639 additions
and
0 deletions
+639
-0
lisp/ChangeLog
lisp/ChangeLog
+2
-0
lisp/international/latin1-disp.el
lisp/international/latin1-disp.el
+637
-0
No files found.
lisp/ChangeLog
View file @
7d354dd5
2000-09-17 Dave Love <fx@gnu.org>
* international/latin1-disp.el: New file.
* calendar/cal-move.el (scroll-calendar-left)
(scroll-calendar-right): Make arg optional (for active mode line).
...
...
lisp/international/latin1-disp.el
0 → 100644
View file @
7d354dd5
;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*- coding: emacs-mule -*-
;; Copyright (C) 2000 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
;; This file is part of GNU Emacs.
;; 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)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; 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.
;;; Commentary:
;; This package sets up display of ISO 8859-n for n>1 by substituting
;; Latin-1 characters and sequences of them for characters which can't
;; be displayed, either beacuse we're on a tty or beacuse we don't
;; have the relevant window system fonts available. For instance,
;; Latin-9 is very similar to Latin-1, so we can display most Latin-9
;; characters using the Latin-1 characters at the same code point and
;; fall back on more-or-less mnemonic ASCII sequences for the rest.
;; For the Latin charsets the ASCII sequences are mostly consistent
;; with the Quail prefix input sequences. Latin-4 uses the Quail
;; postfix sequences as a prefix method isn't defined for Latin-4.
;; A different approach is taken in the DOS display tables in
;; term/internal.el, and the relevant ASCII sequences from there are
;; available as an alternative; see `latin1-display-mnemonic'. Only
;; these sequences are used for Cyrillic, Greek and Hebrew.
;; If you don't even have Latin-1, see iso-ascii.el and use the
;; complete tables from internal.el. The ASCII sequences used here
;; are mostly in the same style as iso-ascii.
;;; Code:
(
defconst
latin1-display-sets
'
(
latin-2
latin-3
latin-4
latin-5
latin-8
latin-9
cyrillic
greek
hebrew
)
"The ISO8859 character sets with defined Latin-1 display sequences.
These are the nicknames for the sets and correspond to Emacs language
environments."
)
(
defgroup
latin1-display
()
"Set up display tables for ISO8859 characters using Latin-1."
:version
"21.1"
:group
'i18n
)
(
defcustom
latin1-display-format
"{%s}"
"A format string used to display the ASCII sequences.
The default encloses the sequence in braces, but you could just use
\"%s\" to avoid the braces."
:group
'latin1-display
:type
'string
)
;;;###autoload
(
defcustom
latin1-display
nil
"Set up Latin-1/ASCII display for ISO8859 character sets.
This is done for each character set in the list `latin1-display-sets',
if no font is available to display it. Characters are displayed using
the corresponding Latin-1 characters where they match. Otherwise
ASCII sequences are used, mostly following the Latin prefix input
methods. Some different ASCII sequences are used if
`latin1-display-mnemonic' is non-nil.
Setting this variable directly does not take effect;
use either M-x customize of the function `latin1-display'."
:group
'latin1-display
:type
'boolean
:require
'latin1-disp
:initialize
'custom-initialize-default
:set
(
lambda
(
symbol
value
)
(
if
value
(
mapc
(
if
value
#'
latin1-display-setup
#'
latin1-display-reset
)
latin1-display-sets
))))
;;;###autoload
(
defun
latin1-display
(
&rest
sets
)
"Set up Latin-1/ASCII display for the arguments character SETS.
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'."
(
if
sets
(
mapc
#'
latin1-display-setup
sets
)
(
mapc
#'
latin1-display-reset
latin1-display-sets
)))
(
defcustom
latin1-display-mnemonic
nil
"Non-nil means to display potentially more mnemonic sequences.
These are taken from the tables in `internal.el' rather than the Quail
input sequences."
:type
'boolean
:group
'latin1-display
)
(
defun
latin1-display-char
(
char
display
&optional
alt-display
)
"Make an entry in `standard-display-table' for CHAR using string DISPLAY.
If ALT-DISPLAY is provided, use that instead if
`latin1-display-mnemonic' is non-nil. The actual string displayed is
formatted using `latin1-display-format'."
(
if
(
and
(
stringp
alt-display
)
latin1-display-mnemonic
)
(
setq
display
alt-display
))
(
if
(
stringp
display
)
(
standard-display-ascii
char
(
format
latin1-display-format
display
))
(
aset
standard-display-table
char
display
)))
(
defun
latin1-display-identities
(
charset
)
"Display each character in CHARSET as the corresponding Latin-1 character.
CHARSET is a symbol naming a language environment using an ISO8859
character set."
(
if
(
eq
charset
'cyrillic
)
(
setq
charset
'cyrillic-iso
))
(
let
((
i
32
)
(
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
)))
(
setq
i
(
1+
i
)))))
(
defun
latin1-display-reset
(
language
)
"Set up the default display for each character of LANGUAGE's charset.
CHARSET is a symbol naming a language environment using an ISO8859
character set."
(
if
(
eq
language
'cyrillic
)
(
setq
language
'cyrillic-iso
))
(
let
((
charset
(
car
(
remq
'ascii
(
get-language-info
language
'charset
)))))
(
standard-display-default
(
make-char
charset
32
)
(
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
))))))
(
defun
latin1-display-setup
(
set
&optional
force
)
"Set up Latin-1 display for characters in the given SET.
SET must be a member of `latin1-display-sets'. Normally, check
whether a font for SET is available and don't set the display if it
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
))
'
((
?
と
"'C"
"C'"
)
(
?
ひ
"'D"
"/D"
)
(
?
え
"'S"
"S'"
)
(
?
よ
"'c"
"c'"
)
(
?
を
"'d"
"/d"
)
(
?
で
"'L"
"L'"
)
(
?
ん
"'n"
"n'"
)
(
?
び
"'N"
"N'"
)
(
?
も
"'r"
"r'"
)
(
?
ぢ
"'R"
"R'"
)
(
?
じ
"'s"
"s'"
)
(
?
ぞ
"'z"
"z'"
)
(
?
ぎ
"'Z"
"Z'"
)
(
?
ぃ
"`A"
"A;"
)
(
?
ぬ
"`E"
"E;"
)
(
?
ぅ
"`L"
"/L"
)
(
?
が
"`S"
",S"
)
(
?
む
"`T"
",T"
)
(
?
け
"`Z"
"Z^."
)
(
?
こ
"`a"
"a;"
)
(
?
さ
"`l"
"/l"
)
(
?
れ
"`e"
"e;"
)
(
?
ぜ
"`s"
",s"
)
(
?
"`t"
",t"
)
(
?
ち
"`z"
"z^."
)
(
?
"`."
"'."
)
(
?
づ
"~A"
"A("
)
(
?
な
"~C"
"C<"
)
(
?
ぱ
"~D"
"D<"
)
(
?
の
"~E"
"E<"
)
(
?
ゎ
"~e"
"e<"
)
(
?
ぇ
"~L"
"L<"
)
(
?
ぴ
"~N"
"N<"
)
(
?
ぷ
"~O"
"O''"
)
(
?
ぺ
"~R"
"R<"
)
(
?
か
"~S"
"S<"
)
(
?
き
"~T"
"T<"
)
(
?
ぽ
"~U"
"U''"
)
(
?
ぐ
"~Z"
"Z<"
)
(
?
ゅ
"~a"
"a(}"
)
(
?
り
"~c"
"c<"
)
(
?
ゑ
"~d"
"d<"
)
(
?
し
"~l"
"l<"
)
(
?
"~n"
"n<"
)
(
?
"~o"
"o''"
)
(
?
"~r"
"r<"
)
(
?
せ
"~s"
"s<"
)
(
?
そ
"~t"
"t<"
)
(
?
"~u"
"u''"
)
(
?
だ
"~z"
"z<"
)
(
?
す
"~v"
"'<"
)
; ?い in latin-pre
(
?
い
"~~"
"'("
)
(
?
"uu"
"u^0"
)
(
?
ほ
"UU"
"U^0"
)
(
?
て
"\"A"
)
(
?
ゆ
"\"a"
)
(
?
ね
"\"E"
"E:"
)
(
?
ろ
"\"e"
)
(
?
た
"''"
"'"
)
(
?
す
"'<"
)
; 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
))
'
((
?
Γ
"/H"
)
(
?
Δ
"~`"
"'("
)
(
?
Θ
"^H"
"H^"
)
(
?
Ω
"^h"
"h^"
)
(
?
Λ
".I"
"I^."
)
(
?
Μ
",S"
)
(
?
Ν
"~G"
"G("
)
(
?
Ξ
"^J"
"J^"
)
(
?
Ρ
".Z"
"Z^."
)
(
?
Τ
"/h"
)
(
?
".i"
"i^."
)
(
?
",s"
)
(
?
"~g"
"g("
)
(
?
"^j"
"j^"
)
(
?
α
".Z"
"z^."
)
(
?
η
".c"
"C^."
)
(
?
θ
"^C"
"C^"
)
(
?
ψ
".G"
"G^."
)
(
?
"^G"
"G^"
)
(
?
"~U"
"U("
)
(
?
"^S"
"S^"
)
(
?
".C"
"c^."
)
(
?
"^c"
"c^"
)
(
?
".g"
"g^."
)
(
?
"^g"
"g^"
)
(
?
"~u"
"u("
)
(
?
"^s"
"s^"
)
(
?
"/."
"^."
)))))
((
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
))
'
((
?
┌
"A,"
"A;"
)
(
?
┐
"k/"
"kk"
)
(
?
┘
"R,"
",R"
)
(
?
├
"I~"
"?I"
)
(
?
┬
"L,"
",L"
)
(
?
┼
"S~"
"S<"
)
(
?
━
"E-"
)
(
?
┃
"G,"
",G"
)
(
?
┏
"T/"
"/T"
)
(
?
┛
"Z~"
"Z<"
)
(
?
┳
"a,"
"a;"
)
(
?
┫
"';"
)
(
?
┻
"r,"
",r"
)
(
?
┠
"i~"
"~i"
)
(
?
┯
"l,"
",l"
)
(
?
┨
"'<"
)
(
?
┿
"s~"
"s<"
)
(
?
┝
"e-"
)
(
?
┰
"g,"
",g"
)
(
?
┥
"t/"
"/t"
)
(
?
┸
"N/"
"NG"
)
(
?
╂
"z~"
"z<"
)
(
?
"n/"
"ng"
)
(
?
"A-"
)
(
?
"I,"
"I;"
)
(
?
"C~"
"C<"
)
(
?
"E,"
"E;"
)
(
?
"E."
"E^."
)
(
?
"I-"
)
(
?
"N,"
",N"
)
(
?
"O-"
)
(
?
"K,"
",K"
)
(
?
"U,"
"U;"
)
(
?
"U~"
"~U"
)
(
?
"U-"
)
(
?
"a-"
)
(
?
"i,"
"i;"
)
(
?
"c~"
"c<"
)
(
?
"e,"
"e;"
)
(
?
"e."
"e^."
)
(
?
"i-"
)
(
?
"d/"
"/d"
)
(
?
"n,"
",n"
)
(
?
"o-"
)
(
?
"k,"
",k"
)
(
?
"u,"
"u;"
)
(
?
"u~"
"~u"
)
(
?
"u-"
)
(
?
"^."
)))))
((
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
))
'
((
?
昨
"~g"
"g("
)
(
?
災
"~G"
"G("
)
(
?
在
".I"
"I^."
)
(
?
",s"
)
(
?
材
",S"
)
(
?
碕
"^e"
"e<"
)
; from latin-post
(
?
作
".e"
"e^."
)
(
?
搾
"\"i"
"i-"
)
; from latin-post
(
?
".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
))
'
((
?
升
".B"
"B`"
)
(
?
召
".b"
"b`"
)
(
?
唱
".c"
"c`"
)
(
?
商
".C"
"C`"
)
(
?
嘗
".D"
"D`"
)
(
?
将
".d"
"d`"
)
(
?
昇
"`w"
)
(
?
妾
"`W"
)
(
?
昭
"'w"
"w'"
)
(
?
宵
"'W"
"W'"
)
(
?
松
"`y"
)
(
?
小
"`Y"
)
(
?
廠
".f"
"f`"
)
(
?
床
".F"
"F`"
)
(
?
承
".g"
"g`"
)
(
?
彰
".G"
"G`"
)
(
?
招
".m"
"m`"
)
(
?
抄
".M"
"M`"
)
(
?
昌
".p"
"p`"
)
(
?
捷
".P"
"P`"
)
(
?
樵
".s"
"s`"
)
(
?
晶
".S"
"S`"
)
(
?
樟
"\"w"
)
(
?
梢
"\"W"
)
(
?
条
"^w"
"w^"
)
(
?
紹
"^W"
"W^"
)
(
?
譲
".t"
"t`"
)
(
?
訟
".T"
"T`"
)
(
?
"^y"
"y^"
)
(
?
鉦
"^Y"
"Y^"
)
(
?
庄
"\"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
))
'
((
?
耳
"~s"
"s<"
)
(
?
示
"~S"
"S<"
)
(
?
痔
"Euro"
"E="
)
(
?
失
"~z"
"z<"
)
(
?
雫
"~Z"
"Z<"
)
(
?
疾
"\"Y"
)
(
?
漆
"oe"
)
(
?
湿
"OE"
)))))
((
eq
set
'greek
)
(
when
(
or
force
(
not
(
latin1-display-check-font
set
)))
(
mapc
(
lambda
(
l
)
(
apply
'latin1-display-char
l
))
'
((
?
"9'"
)
(
?
"'9"
)
(
?
"-M"
)
(
?
"'%"
)
(
?
"'A"
)
(
?
"'E"
)
(
?
"'H"
)
(
?
"'I"
)
(
?
"'O"
)
(
?
"'Y"
)
(
?
"W%"
)
(
?
"i3"
)
(
?
"G*"
)
(
?
"D*"
)
(
?
"TH"
)
(
?
"L*"
)
(
?
"C*"
)
(
?
"P*"
)
(
?
"S*"
)
(
?
"F*"
)
(
?
"Q*"
)
(
?
"W*"
)
(
?
"\"I"
)
(
?
"\"Y"
)
(
?
"a%"
)
(
?
"e%"
)
(
?
"y%"
)
(
?
"i%"
)
(
?
"u3"
)
(
?
"a*"
)
(
?
"b*"
)
(
?
"g*"
)
(
?
"d*"
)
(
?
"e*"
)
(
?
"z*"
)
(
?
"y*"
)
(
?
"h*"
)
(
?
"i*"
)
(
?
"k"
)
(
?
"l*"
)
(
?
"m*"
)
(
?
"n*"
)
(
?
"c*"
)
(
?
"p*"
)
(
?
"r*"
)
(
?
"*s"
)
(
?
"s*"
)
(
?
"t*"
)
(
?
"u"
)
(
?
"f*"
)
(
?
"x*"
)
(
?
"q*"
)
(
?
"w*"
)
(
?
"\"i"
)
(
?
"\"u"
)
(
?
"'o"
)
(
?
"'u"
)
(
?
"'w"
)))
(
mapc
(
lambda
(
l
)
(
aset
standard-display-table
(
car
l
)
(
string-to-vector
(
cadr
l
))))
'
((
?
"A"
)
(
?
"B"
)
(
?
"E"
)
(
?
"Z"
)
(
?
"H"
)
(
?
"I"
)
(
?
"J"
)
(
?
"M"
)
(
?
"N"
)
(
?
"O"
)
(
?
"P"
)
(
?
"T"
)
(
?
"Y"
)
(
?
"X"
)
(
?
"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
))))
'
((
?
衣
"=2"
)
(
?
謂
"A+"
)
(
?
違
"B+"
)
(
?
遺
"G+"
)
(
?
医
"D+"
)
(
?
井
"H+"
)
(
?
亥
"W+"
)
(
?
域
"Z+"
)
(
?
育
"X+"
)
(
?
郁
"Tj"
)
(
?
磯
"J+"
)
(
?
一
"K%"
)
(
?
壱
"K+"
)
(
?
溢
"L+"
)
(
?
逸
"M%"
)
(
?
稲
"M+"
)
(
?
茨
"N%"
)
(
?
芋
"N+"
)
(
?
鰯
"S+"
)
(
?
允
"E+"
)
(
?
印
"P%"
)
(
?
咽
"P+"
)
(
?
員
"Zj"
)
(
?
因
"ZJ"
)
(
?
姻
"Q+"
)
(
?
引
"R+"
)
(
?
飲
"Sh"
)
(
?
淫
"T+"
)))))
((
eq
set
'cyrillic
)
(
setq
set
'cyrillic-iso
)
(
when
(
or
force
(
not
(
latin1-display-check-font
set
)))
(
mapc
(
lambda
(
l
)
(
apply
'latin1-display-char
l
))
'
((
?
犬
"Dj"
)
(
?
献
"Gj"
)
(
?
研
"IE"
)
(
?
見
"Lj"
)
(
?
謙
"Nj"
)
(
?
賢
"Ts"
)
(
?
軒
"Kj"
)
(
?
鍵
"V%"
)
(
?
険
"Dzh"
)
(
?
験
"B="
)
(
?
元
""
)
(
?
原
"D"
)
(
?
幻
"Z%"
)
(
?
弦
"3"
)
(
?
減
"U"
)
(
?
源
"J="
)
(
?
現
"L="
)
(
?
諺
"P="
)
(
?
古
"Y"
)
(
?
呼
""
)
(
?
姑
"C="
)
(
?
孤
"C%"
)
(
?
己
"S%"
)
(
?
庫
"Sc"
)
(
?
弧
"=\""
)
(
?
戸
"Y="
)
(
?
故
"%\""
)
(
?
枯
"Ee"
)
(
?
湖
"Yu"
)
(
?
狐
"Ya"
)
(
?
袴
"b"
)
(
?
股
"v="
)
(
?
胡
"g="
)
(
?
菰
"g"
)
(
?
誇
"z%"
)
(
?
跨
"z="
)
(
?
鈷
"u"
)
(
?
雇
"j="
)
(
?
顧
"k"
)
(
?
鼓
"l="
)
(
?
五
"m="
)
(
?
互
"n="
)
(
?
午
"n"
)
(
?
呉
"p"
)
(
?
娯
"t="
)
(
?
御
"f="
)
(
?
梧
"c="
)
(
?
檎
"c%"
)
(
?
瑚
"s%"
)
(
?
碁
"sc"
)
(
?
語
"='"
)
(
?
誤
"y="
)
(
?
護
"%'"
)
(
?
醐
"ee"
)
(
?
乞
"yu"
)
(
?
鯉
"ya"
)
(
?
交
"N0"
)
(
?
侯
"dj"
)
(
?
候
"gj"
)
(
?
倖
"ie"
)
(
?
勾
"lj"
)
(
?
厚
"nj"
)
(
?
口
"ts"
)
(
?
向
"kj"
)
(
?
"v%"
)
(
?
"dzh"
)))
(
mapc
(
lambda
(
l
)
(
aset
standard-display-table
(
car
l
)
(
string-to-vector
(
cadr
l
))))
'
((
?
牽
"⇒"
)
(
?
硯
"S"
)
(
?
絹
"I"
)
(
?
県
""
)
(
?
肩
"J"
)
(
?