Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-coding.el @ 102:a145efe76779 r20-1b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 364816949b59
children cf808b4c4290
comparison
equal deleted inserted replaced
101:a0ec055d74dd 102:a145efe76779
25 25
26 ;;; split off of mule.el. 26 ;;; split off of mule.el.
27 27
28 ;;; Code: 28 ;;; Code:
29 29
30 (defun set-keyboard-coding-system (coding-system)
31 "Set the coding system used for TTY keyboard input. Currently broken."
32 (interactive "zkeyboard-coding-system: ")
33 (get-coding-system coding-system) ; correctness check
34 (setq keyboard-coding-system coding-system)
35 (redraw-modeline t))
36
30 (defun set-terminal-coding-system (coding-system) 37 (defun set-terminal-coding-system (coding-system)
31 "Set the coding system used for TTY display output." 38 "Set the coding system used for TTY display output. Currently broken."
32 (interactive "zterminal-coding-system: ") 39 (interactive "zterminal-coding-system: ")
33 (get-coding-system coding-system) ;; correctness check 40 (get-coding-system coding-system) ; correctness check
34 (setq terminal-coding-system coding-system) 41 (setq terminal-coding-system coding-system)
35 (redraw-modeline t)) 42 (redraw-modeline t))
36 43
37 (defun set-pathname-coding-system (coding-system) 44 (defun set-pathname-coding-system (coding-system)
38 "Set the coding system used for file system path names." 45 "Set the coding system used for file system path names."
39 (interactive "zPathname-coding-system: ") 46 (interactive "zPathname-coding-system: ")
40 (get-coding-system coding-system) ;; correctness check 47 (get-coding-system coding-system) ; correctness check
41 (setq pathname-coding-system coding-system)) 48 (setq pathname-coding-system coding-system))
42 49
43 (defun what-coding-system (start end &optional arg) 50 (defun what-coding-system (start end &optional arg)
44 "Show the encoding of text in the region. 51 "Show the encoding of text in the region.
45 This function is meant to be called interactively; 52 This function is meant to be called interactively;
107 "Return the 'pre-write-conversion property of CODING-SYSTEM." 114 "Return the 'pre-write-conversion property of CODING-SYSTEM."
108 (coding-system-property coding-system 'pre-write-conversion)) 115 (coding-system-property coding-system 'pre-write-conversion))
109 116
110 (defun coding-system-charset (coding-system register) 117 (defun coding-system-charset (coding-system register)
111 "Return the 'charset property of CODING-SYSTEM for the specified REGISTER." 118 "Return the 'charset property of CODING-SYSTEM for the specified REGISTER."
112 (cond ((not (integerp register)) 119 (unless (integerp register)
113 (signal 'wrong-type-argument (list 'integerp register))) 120 (signal 'wrong-type-argument (list 'integerp register)))
114 ((= register 0) 121 (coding-system-property
115 (coding-system-property coding-system 'charset-g0)) 122 coding-system
116 ((= register 1) 123 (case register
117 (coding-system-property coding-system 'charset-g1)) 124 (0 'charset-g0)
118 ((= register 2) 125 (1 'charset-g1)
119 (coding-system-property coding-system 'charset-g2)) 126 (2 'charset-g2)
120 ((= register 3) 127 (3 'charset-g3)
121 (coding-system-property coding-system 'charset-g3)) 128 (t (signal 'args-out-of-range (list register 0 3))))))
122 (t
123 (signal 'args-out-of-range (list register 0 3)))))
124 129
125 (defun coding-system-force-on-output (coding-system register) 130 (defun coding-system-force-on-output (coding-system register)
126 "Return the 'force-on-output property of CODING-SYSTEM for the specified REGISTER." 131 "Return the 'force-on-output property of CODING-SYSTEM for the specified REGISTER."
127 (cond ((not (integerp register)) 132 (unless (integerp register)
128 (signal 'wrong-type-argument (list 'integerp register))) 133 (signal 'wrong-type-argument (list 'integerp register)))
129 ((= register 0) 134 (coding-system-property
130 (coding-system-property coding-system 'force-g0-on-output)) 135 coding-system
131 ((= register 1) 136 (case register
132 (coding-system-property coding-system 'force-g1-on-output)) 137 (0 'force-g0-on-output)
133 ((= register 2) 138 (1 'force-g1-on-output)
134 (coding-system-property coding-system 'force-g2-on-output)) 139 (2 'force-g2-on-output)
135 ((= register 3) 140 (3 'force-g3-on-output)
136 (coding-system-property coding-system 'force-g3-on-output)) 141 (t (signal 'args-out-of-range (list register 0 3))))))
137 (t
138 (signal 'args-out-of-range (list register 0 3)))))
139 142
140 (defun coding-system-short (coding-system) 143 (defun coding-system-short (coding-system)
141 "Return the 'short property of CODING-SYSTEM." 144 "Return the 'short property of CODING-SYSTEM."
142 (coding-system-property coding-system 'short)) 145 (coding-system-property coding-system 'short))
143 146
155 158
156 (defun coding-system-lock-shift (coding-system) 159 (defun coding-system-lock-shift (coding-system)
157 "Return the 'lock-shift property of CODING-SYSTEM." 160 "Return the 'lock-shift property of CODING-SYSTEM."
158 (coding-system-property coding-system 'lock-shift)) 161 (coding-system-property coding-system 'lock-shift))
159 162
160 (defun coding-system-use-japanese-jisx0201-roman (coding-system) 163 ;;(defun coding-system-use-japanese-jisx0201-roman (coding-system)
161 "Return the 'use-japanese-jisx0201-roman property of CODING-SYSTEM." 164 ;; "Return the 'use-japanese-jisx0201-roman property of CODING-SYSTEM."
162 (coding-system-property coding-system 'use-japanese-jisx0201-roman)) 165 ;; (coding-system-property coding-system 'use-japanese-jisx0201-roman))
163 166
164 (defun coding-system-use-japanese-jisx0208-1978 (coding-system) 167 ;;(defun coding-system-use-japanese-jisx0208-1978 (coding-system)
165 "Return the 'use-japanese-jisx0208-1978 property of CODING-SYSTEM." 168 ;; "Return the 'use-japanese-jisx0208-1978 property of CODING-SYSTEM."
166 (coding-system-property coding-system 'use-japanese-jisx0208-2978)) 169 ;; (coding-system-property coding-system 'use-japanese-jisx0208-2978))
167 170
168 (defun coding-system-no-iso6429 (coding-system) 171 (defun coding-system-no-iso6429 (coding-system)
169 "Return the 'no-iso6429 property of CODING-SYSTEM." 172 "Return the 'no-iso6429 property of CODING-SYSTEM."
170 (coding-system-property coding-system 'no-iso6429)) 173 (coding-system-property coding-system 'no-iso6429))
171 174
191 '(charset-g0 ascii 194 '(charset-g0 ascii
192 charset-g1 latin-iso8859-1 195 charset-g1 latin-iso8859-1
193 eol-type lf 196 eol-type lf
194 mnemonic "CText" 197 mnemonic "CText"
195 )) 198 ))
199
200 ;;; iso-8859-1 and ctext are aliases.
201
202 (copy-coding-system 'ctext 'iso-8859-1)
196 203
197 (make-coding-system 204 (make-coding-system
198 'iso-2022-ss2-8 'iso2022 205 'iso-2022-ss2-8 'iso2022
199 "ISO-2022 coding system using SS2 for 96-charset in 8-bit code." 206 "ISO-2022 coding system using SS2 for 96-charset in 8-bit code."
200 '(charset-g0 ascii 207 '(charset-g0 ascii