Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
b25eef20
Commit
b25eef20
authored
May 18, 1998
by
Kenichi Handa
Browse files
Change term unification to translation
throughtout the file. (set-clipboard-coding-system): New function.
parent
0548a7fd
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
54 additions
and
40 deletions
+54
-40
lisp/international/mule.el
lisp/international/mule.el
+54
-40
No files found.
lisp/international/mule.el
View file @
b25eef20
...
...
@@ -328,15 +328,16 @@ See also the documentation of make-char."
;; in `write-region-annotate-functions', i.e. FROM and TO specifying
;; region of a text.
;;
;; o character-
unific
ation-table-for-decode
;; o character-
transl
ation-table-for-decode
;;
;; The value is a
unific
ation table to be applied on
decoding. See
;; the function `make-
unific
ation-table' for the format
of unification
;; table.
;; The value is a
character transl
ation table to be applied on
;;
decoding. See
the function `make-
transl
ation-table' for the format
;;
of translation
table.
;;
;; o character-
unific
ation-table-for-encode
;; o character-
transl
ation-table-for-encode
;;
;; The value is a unification table to be applied on encoding.
;; The value is a character translation table to be applied on
;; encoding.
;;
;; o safe-charsets
;;
...
...
@@ -346,7 +347,11 @@ See also the documentation of make-char."
;; mean that the charset can't be encoded in the coding system,
;; instead, it just means that some other receiver of a text encoded
;; in the coding system won't be able to handle that charset.
;;
;; o mime-charset
;;
;; The value is a symbol of which name is `MIME-charset' parameter of
;; the coding system.
;; Return coding-spec of CODING-SYSTEM
(defsubst coding-system-spec (coding-system)
...
...
@@ -742,6 +747,13 @@ For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems]."
(set-process-coding-system proc decoding encoding)))
(force-mode-line-update))
(defun set-clipboard-coding-system (coding-system)
"
Make
CODING-SYSTEM
used
for
communicating
with
other
X
clients
.
When
sending
or
receiving
text
via
cut_buffer,
selection,
and
clipboard,
the
text
is
encoded
or
decoded
by
CODING-SYSTEM.
"
(check-coding-system coding-system)
(setq clipboard-coding-system coding-system))
(defun set-coding-priority (arg)
"
Set
priority
of
coding
categories
according
to
LIST.
LIST
is
a
list
of
coding
categories
ordered
by
priority.
"
...
...
@@ -973,17 +985,17 @@ or a function symbol which, when called, returns such a cons cell."
(
cons
(
cons
regexp
coding-system
)
network-coding-system-alist
)))))))
(
defun
make-
unific
ation-table
(
&rest
args
)
"Make a
unific
ation table (char table) from arguments.
(
defun
make-
transl
ation-table
(
&rest
args
)
"Make a
character transl
ation table (char table) from arguments.
Each argument is a list of the form (FROM . TO),
where FROM is a character to be
unifi
ed to TO.
where FROM is a character to be
translat
ed to TO.
FROM can be a generic character (see make-char). In this case, TO is
a generic character containing the same number of charcters or a
oridinal character. If FROM and TO are both generic characters, all
characters belonging to FROM are
unifi
ed to characters belonging to TO
characters belonging to FROM are
translat
ed to characters belonging to TO
without changing their position code(s)."
(
let
((
table
(
make-char-table
'character-
unific
ation-table
))
(
let
((
table
(
make-char-table
'character-
transl
ation-table
))
revlist
)
(
while
args
(
let
((
elts
(
car
args
)))
...
...
@@ -1001,9 +1013,9 @@ without changing their position code(s)."
(
setq
to-i
(
1+
to-i
)
to-rev
(
cdr
to-rev
)))
(
if
(
and
(
/=
from-i
to-i
)
(
/=
to-i
0
))
(
error
"Invalid character pair (%d . %d)"
from
to
))
;; If we have already
unifi
ed TO to TO-ALT, FROM should
;; also be
unifi
ed to TO-ALT. But, this is only if TO
is
;; a generic character or TO-ALT is not a generic
;; If we have already
translat
ed TO to TO-ALT, FROM should
;; also be
translat
ed to TO-ALT. But, this is only if TO
;;
is
a generic character or TO-ALT is not a generic
;; character.
(
let
((
to-alt
(
aref
table
to
)))
(
if
(
and
to-alt
...
...
@@ -1012,8 +1024,8 @@ without changing their position code(s)."
(
if
(
>
from-i
0
)
(
set-char-table-default
table
from
to
)
(
aset
table
from
to
))
;; If we have already
unifi
ed some chars to FROM, they
;; should also be
unifi
ed to TO.
;; If we have already
translat
ed some chars to FROM, they
;; should also be
translat
ed to TO.
(
let
((
l
(
assq
from
revlist
)))
(
if
l
(
let
((
ch
(
car
l
)))
...
...
@@ -1032,33 +1044,35 @@ without changing their position code(s)."
;; Return TABLE just created.
table
))
(
defun
define-character-unification-table
(
symbol
&rest
args
)
"define character unification table. This function call make-unification-table,
store a returned table to character-unification-table-vector.
And then set the table as SYMBOL's unification-table property,
the index of the vector as SYMBOL's unification-table-id."
(
let
((
table
(
apply
'make-unification-table
args
))
(
len
(
length
character-unification-table-vector
))
(
defun
define-character-translation-table
(
symbol
&rest
args
)
"Define SYMBOL as a name of character translation table makde by ARGS.
See the documentation of the function `make-translation-table' for the
meaning of ARGS.
This function sets properties character-translation-table and
character-translation-table-id of SYMBOL to the created table itself
and identification number of the table respectively."
(
let
((
table
(
apply
'make-translation-table
args
))
(
len
(
length
character-translation-table-vector
))
(
id
0
)
slot
)
(
or
(
symbolp
symbol
)
(
signal
'wrong-type-argument
symbol
))
(
put
symbol
'unification-table
table
)
(
while
(
and
(
<
id
len
)
(
if
(
consp
(
setq
slot
(
aref
character-unification-table-vector
id
)))
(
if
(
eq
(
car
slot
)
symbol
)
nil
t
)
(
aset
character-unification-table-vector
id
(
cons
symbol
table
))
nil
))
(
done
nil
))
(
put
symbol
'character-translation-table
table
)
(
while
(
not
done
)
(
if
(
>=
id
len
)
(
setq
character-translation-table-vector
(
vconcat
character-translation-table-vector
(
make-vector
len
nil
))))
(
let
((
slot
(
aref
character-translation-table-vector
id
)))
(
if
(
or
(
not
slot
)
(
eq
(
car
slot
)
symbol
))
(
progn
(
aset
character-translation-table-vector
id
(
cons
symbol
table
))
(
setq
done
t
))))
(
setq
id
(
1+
id
)))
(
if
(
=
id
len
)
(
progn
(
setq
character-unification-table-vector
(
vconcat
character-unification-table-vector
(
make-vector
len
nil
)))
(
aset
character-unification-table-vector
id
(
cons
symbol
table
))))
(
put
symbol
'unification-table-id
id
)
(
put
symbol
'character-translation-table-id
id
)
id
))
;;; Initialize some variables.
(
put
'use-default-ascent
'char-table-extra-slots
0
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment