|
259
|
1 ;;; coding.el --- Coding-system functions for XEmacs.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
|
|
|
4 ;; Licensed to the Free Software Foundation.
|
|
|
5 ;; Copyright (C) 1995 Amdahl Corporation.
|
|
|
6 ;; Copyright (C) 1995 Sun Microsystems.
|
|
|
7 ;; Copyright (C) 1997 MORIOKA Tomohiko
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
11 ;; This file is very similar to mule-coding.el
|
|
|
12
|
|
|
13 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
14 ;; under the terms of the GNU General Public License as published by
|
|
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;; any later version.
|
|
|
17
|
|
|
18 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
21 ;; General Public License for more details.
|
|
|
22
|
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
|
24 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
26 ;; Boston, MA 02111-1307, USA.
|
|
|
27
|
|
|
28 ;;; Commentary:
|
|
|
29
|
|
|
30 ;;; split off of mule.el.
|
|
|
31
|
|
|
32 ;;; Code:
|
|
|
33
|
|
|
34 (defalias 'check-coding-system 'get-coding-system)
|
|
|
35
|
|
|
36 (defconst modeline-multibyte-status '("%C")
|
|
|
37 "Modeline control for showing multibyte extension status.")
|
|
|
38
|
|
|
39 ;; override the default value defined in loaddefs.el.
|
|
|
40 (setq-default modeline-format
|
|
|
41 (cons (purecopy "")
|
|
|
42 (cons 'modeline-multibyte-status
|
|
|
43 (cdr modeline-format))))
|
|
|
44
|
|
|
45 (defun modify-coding-system-alist (target-type regexp coding-system)
|
|
|
46 "Modify one of look up tables for finding a coding system on I/O operation.
|
|
|
47 There are three of such tables, `file-coding-system-alist',
|
|
|
48 `process-coding-system-alist', and `network-coding-system-alist'.
|
|
|
49
|
|
|
50 TARGET-TYPE specifies which of them to modify.
|
|
|
51 If it is `file', it affects `file-coding-system-alist' (which see).
|
|
|
52 If it is `process', it affects `process-coding-system-alist' (which see).
|
|
|
53 If it is `network', it affects `network-codign-system-alist' (which see).
|
|
|
54
|
|
|
55 REGEXP is a regular expression matching a target of I/O operation.
|
|
|
56 The target is a file name if TARGET-TYPE is `file', a program name if
|
|
|
57 TARGET-TYPE is `process', or a network service name or a port number
|
|
|
58 to connect to if TARGET-TYPE is `network'.
|
|
|
59
|
|
|
60 CODING-SYSTEM is a coding system to perform code conversion on the I/O
|
|
|
61 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems
|
|
|
62 for decoding and encoding respectively,
|
|
|
63 or a function symbol which, when called, returns such a cons cell."
|
|
|
64 (or (memq target-type '(file process network))
|
|
|
65 (error "Invalid target type: %s" target-type))
|
|
|
66 (or (stringp regexp)
|
|
|
67 (and (eq target-type 'network) (integerp regexp))
|
|
|
68 (error "Invalid regular expression: %s" regexp))
|
|
|
69 (if (symbolp coding-system)
|
|
|
70 (if (not (fboundp coding-system))
|
|
|
71 (progn
|
|
|
72 (check-coding-system coding-system)
|
|
|
73 (setq coding-system (cons coding-system coding-system))))
|
|
|
74 (check-coding-system (car coding-system))
|
|
|
75 (check-coding-system (cdr coding-system)))
|
|
|
76 (cond ((eq target-type 'file)
|
|
|
77 (let ((slot (assoc regexp file-coding-system-alist)))
|
|
|
78 (if slot
|
|
|
79 (setcdr slot coding-system)
|
|
|
80 (setq file-coding-system-alist
|
|
|
81 (cons (cons regexp coding-system)
|
|
|
82 file-coding-system-alist)))))
|
|
|
83 ((eq target-type 'process)
|
|
|
84 (let ((slot (assoc regexp process-coding-system-alist)))
|
|
|
85 (if slot
|
|
|
86 (setcdr slot coding-system)
|
|
|
87 (setq process-coding-system-alist
|
|
|
88 (cons (cons regexp coding-system)
|
|
|
89 process-coding-system-alist)))))
|
|
|
90 (t
|
|
|
91 (let ((slot (assoc regexp network-coding-system-alist)))
|
|
|
92 (if slot
|
|
|
93 (setcdr slot coding-system)
|
|
|
94 (setq network-coding-system-alist
|
|
|
95 (cons (cons regexp coding-system)
|
|
|
96 network-coding-system-alist)))))))
|
|
|
97
|
|
|
98 (defsubst keyboard-coding-system ()
|
|
|
99 "Return coding-system of what is sent from terminal keyboard."
|
|
|
100 keyboard-coding-system)
|
|
|
101
|
|
|
102 (defun set-keyboard-coding-system (coding-system)
|
|
|
103 "Set the coding system used for TTY keyboard input. Currently broken."
|
|
|
104 (interactive "zkeyboard-coding-system: ")
|
|
|
105 (get-coding-system coding-system) ; correctness check
|
|
|
106 (setq keyboard-coding-system coding-system)
|
|
|
107 (redraw-modeline t))
|
|
|
108
|
|
|
109 (defsubst terminal-coding-system ()
|
|
|
110 "Return coding-system of your terminal."
|
|
|
111 terminal-coding-system)
|
|
|
112
|
|
|
113 (defun set-terminal-coding-system (coding-system)
|
|
|
114 "Set the coding system used for TTY display output. Currently broken."
|
|
|
115 (interactive "zterminal-coding-system: ")
|
|
|
116 (get-coding-system coding-system) ; correctness check
|
|
|
117 (setq terminal-coding-system coding-system)
|
|
371
|
118 (set-console-tty-coding-system (device-console) terminal-coding-system)
|
|
259
|
119 (redraw-modeline t))
|
|
|
120
|
|
|
121 (defun set-pathname-coding-system (coding-system)
|
|
|
122 "Set the coding system used for file system path names."
|
|
|
123 (interactive "zPathname-coding-system: ")
|
|
|
124 (get-coding-system coding-system) ; correctness check
|
|
|
125 (setq file-name-coding-system coding-system))
|
|
|
126
|
|
|
127 (defun what-coding-system (start end &optional arg)
|
|
|
128 "Show the encoding of text in the region.
|
|
|
129 This function is meant to be called interactively;
|
|
|
130 from a Lisp program, use `detect-coding-region' instead."
|
|
|
131 (interactive "r\nP")
|
|
|
132 (princ (detect-coding-region start end)))
|
|
|
133
|
|
|
134 (defun decode-coding-string (str coding-system)
|
|
|
135 "Decode the string STR which is encoded in CODING-SYSTEM.
|
|
|
136 Does not modify STR. Returns the decoded string on successful conversion."
|
|
|
137 (with-string-as-buffer-contents
|
|
|
138 str (decode-coding-region (point-min) (point-max) coding-system)))
|
|
|
139
|
|
|
140 (defun encode-coding-string (str coding-system)
|
|
|
141 "Encode the string STR using CODING-SYSTEM.
|
|
|
142 Does not modify STR. Returns the encoded string on successful conversion."
|
|
|
143 (with-string-as-buffer-contents
|
|
|
144 str (encode-coding-region (point-min) (point-max) coding-system)))
|
|
|
145
|
|
|
146
|
|
|
147 ;;;; Coding system accessors
|
|
|
148
|
|
|
149 (defun coding-system-mnemonic (coding-system)
|
|
|
150 "Return the 'mnemonic property of CODING-SYSTEM."
|
|
|
151 (coding-system-property coding-system 'mnemonic))
|
|
|
152
|
|
|
153 (defalias 'coding-system-docstring 'coding-system-doc-string)
|
|
|
154
|
|
|
155 (defun coding-system-eol-type (coding-system)
|
|
|
156 "Return the 'eol-type property of CODING-SYSTEM."
|
|
|
157 (coding-system-property coding-system 'eol-type))
|
|
|
158
|
|
|
159 (defun coding-system-eol-lf (coding-system)
|
|
|
160 "Return the 'eol-lf property of CODING-SYSTEM."
|
|
|
161 (coding-system-property coding-system 'eol-lf))
|
|
|
162
|
|
|
163 (defun coding-system-eol-crlf (coding-system)
|
|
|
164 "Return the 'eol-crlf property of CODING-SYSTEM."
|
|
|
165 (coding-system-property coding-system 'eol-crlf))
|
|
|
166
|
|
|
167 (defun coding-system-eol-cr (coding-system)
|
|
|
168 "Return the 'eol-cr property of CODING-SYSTEM."
|
|
|
169 (coding-system-property coding-system 'eol-cr))
|
|
|
170
|
|
|
171 (defun coding-system-post-read-conversion (coding-system)
|
|
|
172 "Return the 'post-read-conversion property of CODING-SYSTEM."
|
|
|
173 (coding-system-property coding-system 'post-read-conversion))
|
|
|
174
|
|
|
175 (defun coding-system-pre-write-conversion (coding-system)
|
|
|
176 "Return the 'pre-write-conversion property of CODING-SYSTEM."
|
|
|
177 (coding-system-property coding-system 'pre-write-conversion))
|
|
|
178
|
|
|
179 (defun coding-system-base (coding-system)
|
|
|
180 "Return the base coding system of CODING-SYSTEM."
|
|
|
181 (if (not (coding-system-eol-type coding-system))
|
|
|
182 coding-system
|
|
|
183 (find-coding-system
|
|
|
184 (intern
|
|
|
185 (substring
|
|
|
186 (symbol-name (coding-system-name coding-system))
|
|
|
187 0
|
|
|
188 (string-match "-unix$\\|-dos$\\|-mac$"
|
|
|
189 (symbol-name (coding-system-name coding-system))))))))
|
|
|
190
|
|
|
191 ;;;; Definitions of predefined coding systems
|
|
|
192
|
|
|
193 (make-coding-system
|
|
|
194 'undecided 'undecided
|
|
|
195 "Automatic conversion."
|
|
|
196 '(mnemonic "Auto"))
|
|
|
197
|
|
261
|
198 ;; these are so that gnus and friends work when not mule
|
|
|
199 (or (featurep 'mule)
|
|
|
200 (progn
|
|
|
201 (copy-coding-system 'undecided 'iso-8859-1)
|
|
|
202 (copy-coding-system 'undecided 'iso-8859-2)))
|
|
|
203
|
|
259
|
204 ;; compatibility for old XEmacsen (don't use it)
|
|
|
205 (copy-coding-system 'undecided 'automatic-conversion)
|
|
|
206
|
|
|
207 (copy-coding-system 'no-conversion 'raw-text)
|
|
|
208
|
|
|
209 (make-compatible-variable 'enable-multibyte-characters "Unimplemented")
|
|
|
210
|
|
|
211 (define-obsolete-variable-alias
|
|
|
212 'pathname-coding-system 'file-name-coding-system)
|
|
|
213
|
|
|
214 ;;; mule-coding.el ends here
|
