1 ;;; coding.el --- Coding-system functions for XEmacs.
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
9 ;; This file is part of SXEmacs.
11 ;; This file is very similar to mule-coding.el
13 ;; SXEmacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; SXEmacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
28 ;;; split off of mule.el.
32 (defalias 'check-coding-system 'get-coding-system)
34 (defconst modeline-multibyte-status '("%C")
35 "Modeline control for showing multibyte extension status.")
37 ;; override the default value defined in loaddefs.el.
38 (setq-default modeline-format
40 (cons 'modeline-multibyte-status
41 (cdr modeline-format))))
43 (defun modify-coding-system-alist (target-type regexp coding-system)
44 "Modify one of look up tables for finding a coding system on I/O operation.
45 There are three of such tables, `file-coding-system-alist',
46 `process-coding-system-alist', and `network-coding-system-alist'.
48 TARGET-TYPE specifies which of them to modify.
49 If it is `file', it affects `file-coding-system-alist' (which see).
50 If it is `process', it affects `process-coding-system-alist' (which see).
51 If it is `network', it affects `network-coding-system-alist' (which see).
53 REGEXP is a regular expression matching a target of I/O operation.
54 The target is a file name if TARGET-TYPE is `file', a program name if
55 TARGET-TYPE is `process', or a network service name or a port number
56 to connect to if TARGET-TYPE is `network'.
58 CODING-SYSTEM is a coding system to perform code conversion on the I/O
59 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems
60 for decoding and encoding respectively,
61 or a function symbol which, when called, returns such a cons cell."
62 (or (memq target-type '(file process network))
63 (error "Invalid target type: %s" target-type))
65 (and (eq target-type 'network) (integerp regexp))
66 (error "Invalid regular expression: %s" regexp))
67 (if (symbolp coding-system)
68 (if (not (fboundp coding-system))
70 (check-coding-system coding-system)
71 (setq coding-system (cons coding-system coding-system))))
72 (check-coding-system (car coding-system))
73 (check-coding-system (cdr coding-system)))
74 (cond ((eq target-type 'file)
75 (let ((slot (assoc regexp file-coding-system-alist)))
77 (setcdr slot coding-system)
78 (setq file-coding-system-alist
79 (cons (cons regexp coding-system)
80 file-coding-system-alist)))))
81 ((eq target-type 'process)
82 (let ((slot (assoc regexp process-coding-system-alist)))
84 (setcdr slot coding-system)
85 (setq process-coding-system-alist
86 (cons (cons regexp coding-system)
87 process-coding-system-alist)))))
89 (let ((slot (assoc regexp network-coding-system-alist)))
91 (setcdr slot coding-system)
92 (setq network-coding-system-alist
93 (cons (cons regexp coding-system)
94 network-coding-system-alist)))))))
96 (defsubst keyboard-coding-system ()
97 "Return coding-system of what is sent from terminal keyboard."
98 keyboard-coding-system)
100 (defun set-keyboard-coding-system (coding-system)
101 "Set the coding system used for TTY keyboard input. Currently broken."
102 (interactive "zkeyboard-coding-system: ")
103 (get-coding-system coding-system) ; correctness check
104 (setq keyboard-coding-system coding-system)
105 (if (eq (device-type) 'tty)
106 (set-console-tty-input-coding-system
107 (device-console) keyboard-coding-system))
110 (defsubst terminal-coding-system ()
111 "Return coding-system of your terminal."
112 terminal-coding-system)
114 (defun set-terminal-coding-system (coding-system)
115 "Set the coding system used for TTY display output. Currently broken."
116 (interactive "zterminal-coding-system: ")
117 (get-coding-system coding-system) ; correctness check
118 (setq terminal-coding-system coding-system)
119 ; #### should this affect all current tty consoles ?
120 (if (eq (device-type) 'tty)
121 (set-console-tty-output-coding-system
122 (device-console) terminal-coding-system))
125 (defun set-pathname-coding-system (coding-system)
126 "Set the coding system used for file system path names."
127 (interactive "zPathname-coding-system: ")
128 (get-coding-system coding-system) ; correctness check
129 (setq file-name-coding-system coding-system))
131 (defun what-coding-system (start end &optional arg)
132 "Show the encoding of text in the region.
133 This function is meant to be called interactively;
134 from a Lisp program, use `detect-coding-region' instead."
136 (princ (detect-coding-region start end)))
138 (defun decode-coding-string (str coding-system)
139 "Decode the string STR which is encoded in CODING-SYSTEM.
140 Does not modify STR. Returns the decoded string on successful conversion."
141 (with-string-as-buffer-contents
142 str (decode-coding-region (point-min) (point-max) coding-system)))
144 (defun encode-coding-string (str coding-system)
145 "Encode the string STR using CODING-SYSTEM.
146 Does not modify STR. Returns the encoded string on successful conversion."
147 (with-string-as-buffer-contents
148 str (encode-coding-region (point-min) (point-max) coding-system)))
151 ;;;; Coding system accessors
153 (defun coding-system-mnemonic (coding-system)
154 "Return the 'mnemonic property of CODING-SYSTEM."
155 (coding-system-property coding-system 'mnemonic))
157 (defalias 'coding-system-docstring 'coding-system-doc-string)
159 (defun coding-system-eol-type (coding-system)
160 "Return the 'eol-type property of CODING-SYSTEM."
161 (coding-system-property coding-system 'eol-type))
163 (defun coding-system-eol-lf (coding-system)
164 "Return the 'eol-lf property of CODING-SYSTEM."
165 (coding-system-property coding-system 'eol-lf))
167 (defun coding-system-eol-crlf (coding-system)
168 "Return the 'eol-crlf property of CODING-SYSTEM."
169 (coding-system-property coding-system 'eol-crlf))
171 (defun coding-system-eol-cr (coding-system)
172 "Return the 'eol-cr property of CODING-SYSTEM."
173 (coding-system-property coding-system 'eol-cr))
175 (defun coding-system-post-read-conversion (coding-system)
176 "Return the 'post-read-conversion property of CODING-SYSTEM."
177 (coding-system-property coding-system 'post-read-conversion))
179 (defun coding-system-pre-write-conversion (coding-system)
180 "Return the 'pre-write-conversion property of CODING-SYSTEM."
181 (coding-system-property coding-system 'pre-write-conversion))
183 (defun coding-system-base (coding-system)
184 "Return the base coding system of CODING-SYSTEM."
185 (if (not (coding-system-eol-type coding-system))
190 (symbol-name (coding-system-name coding-system))
192 (string-match #r"-unix$\|-dos$\|-mac$"
193 (symbol-name (coding-system-name coding-system))))))))
195 ;;;; Definitions of predefined coding systems
198 'undecided 'undecided
199 "Automatic conversion."
202 ;;; Make certain variables equivalent to coding-system aliases
203 (defun dontusethis-set-value-file-name-coding-system-handler (sym args fun harg handlers)
204 (define-coding-system-alias 'file-name (or (car args) 'binary)))
206 (dontusethis-set-symbol-value-handler
207 'file-name-coding-system
209 'dontusethis-set-value-file-name-coding-system-handler)
211 (defun dontusethis-set-value-terminal-coding-system-handler (sym args fun harg handlers)
212 (define-coding-system-alias 'terminal (or (car args) 'binary)))
214 (dontusethis-set-symbol-value-handler
215 'terminal-coding-system
217 'dontusethis-set-value-terminal-coding-system-handler)
219 (defun dontusethis-set-value-keyboard-coding-system-handler (sym args fun harg handlers)
220 (define-coding-system-alias 'keyboard (or (car args) 'binary)))
222 (dontusethis-set-symbol-value-handler
223 'keyboard-coding-system
225 'dontusethis-set-value-keyboard-coding-system-handler)
227 (unless (boundp 'file-name-coding-system)
228 (setq file-name-coding-system nil))
230 (when (not (featurep 'mule))
231 ;; these are so that gnus and friends work when not mule
232 (copy-coding-system 'undecided 'iso-8859-1)
233 (copy-coding-system 'undecided 'iso-8859-2)
234 (copy-coding-system 'undecided 'iso-8859-15)
235 (copy-coding-system 'undecided 'emacs-internal)
236 (define-coding-system-alias 'ctext 'binary))
239 ;; compatibility for old XEmacsen (don't use it)
240 (copy-coding-system 'undecided 'automatic-conversion)
242 (make-compatible-variable 'enable-multibyte-characters "Unimplemented")
244 (define-obsolete-variable-alias
245 'pathname-coding-system 'file-name-coding-system)
247 ;;; coding.el ends here