annotate lisp/coding.el @ 738:5039859429c5

[xemacs-hg @ 2002-02-02 13:39:59 by wmperry] Support :callback-ex in GTK widgets
author wmperry
date Sat, 02 Feb 2002 13:39:59 +0000
parents 4d00488244c1
children 943eaba38521
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; coding.el --- Coding-system functions for XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Licensed to the Free Software Foundation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Copyright (C) 1995 Amdahl Corporation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Copyright (C) 1995 Sun Microsystems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Copyright (C) 1997 MORIOKA Tomohiko
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; This file is very similar to mule-coding.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; You should have received a copy of the GNU General Public License
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
24 ;; along with XEmacs; see the file COPYING. If not, write to the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;;; split off of mule.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
34 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
35 '(coding-system-lock-shift
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
36 coding-system-seven coding-system-charset charset-dimension))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
37
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 (defalias 'check-coding-system 'get-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 (defconst modeline-multibyte-status '("%C")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 "Modeline control for showing multibyte extension status.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; override the default value defined in loaddefs.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 (setq-default modeline-format
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
45 (cons ""
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
46 (cons 'modeline-multibyte-status
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
47 (cdr modeline-format))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (defun modify-coding-system-alist (target-type regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 "Modify one of look up tables for finding a coding system on I/O operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 There are three of such tables, `file-coding-system-alist',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 `process-coding-system-alist', and `network-coding-system-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 TARGET-TYPE specifies which of them to modify.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 If it is `file', it affects `file-coding-system-alist' (which see).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 If it is `process', it affects `process-coding-system-alist' (which see).
599
55614ee2fb8d [xemacs-hg @ 2001-06-01 06:30:08 by martinb]
martinb
parents: 502
diff changeset
57 If it is `network', it affects `network-coding-system-alist' (which see).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 REGEXP is a regular expression matching a target of I/O operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 The target is a file name if TARGET-TYPE is `file', a program name if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 TARGET-TYPE is `process', or a network service name or a port number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 to connect to if TARGET-TYPE is `network'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 CODING-SYSTEM is a coding system to perform code conversion on the I/O
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 for decoding and encoding respectively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 or a function symbol which, when called, returns such a cons cell."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (or (memq target-type '(file process network))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (error "Invalid target type: %s" target-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (or (stringp regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (and (eq target-type 'network) (integerp regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (error "Invalid regular expression: %s" regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (if (symbolp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 (if (not (fboundp coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (check-coding-system coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (setq coding-system (cons coding-system coding-system))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (check-coding-system (car coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (check-coding-system (cdr coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (cond ((eq target-type 'file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (let ((slot (assoc regexp file-coding-system-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (if slot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (setcdr slot coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (setq file-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 (cons (cons regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 file-coding-system-alist)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ((eq target-type 'process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (let ((slot (assoc regexp process-coding-system-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (if slot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (setcdr slot coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 (setq process-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (cons (cons regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 process-coding-system-alist)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (let ((slot (assoc regexp network-coding-system-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (if slot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (setcdr slot coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (setq network-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (cons (cons regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 network-coding-system-alist)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (defsubst keyboard-coding-system ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 "Return coding-system of what is sent from terminal keyboard."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 keyboard-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (defun set-keyboard-coding-system (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 "Set the coding system used for TTY keyboard input. Currently broken."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (interactive "zkeyboard-coding-system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (get-coding-system coding-system) ; correctness check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (setq keyboard-coding-system coding-system)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
111 (if (eq (device-type) 'tty)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
112 (declare-fboundp (set-console-tty-input-coding-system
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
113 (device-console) keyboard-coding-system)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (redraw-modeline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (defsubst terminal-coding-system ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 "Return coding-system of your terminal."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 terminal-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (defun set-terminal-coding-system (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 "Set the coding system used for TTY display output. Currently broken."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 (interactive "zterminal-coding-system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (get-coding-system coding-system) ; correctness check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (setq terminal-coding-system coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 ; #### should this affect all current tty consoles ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (if (eq (device-type) 'tty)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
127 (declare-fboundp (set-console-tty-output-coding-system
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
128 (device-console) terminal-coding-system)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (redraw-modeline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 (defun set-pathname-coding-system (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 "Set the coding system used for file system path names."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (interactive "zPathname-coding-system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (get-coding-system coding-system) ; correctness check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (setq file-name-coding-system coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (defun what-coding-system (start end &optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 "Show the encoding of text in the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 This function is meant to be called interactively;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 from a Lisp program, use `detect-coding-region' instead."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (interactive "r\nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (princ (detect-coding-region start end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (defun decode-coding-string (str coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 "Decode the string STR which is encoded in CODING-SYSTEM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 Does not modify STR. Returns the decoded string on successful conversion."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (with-string-as-buffer-contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 str (decode-coding-region (point-min) (point-max) coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (defun encode-coding-string (str coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 "Encode the string STR using CODING-SYSTEM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 Does not modify STR. Returns the encoded string on successful conversion."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (with-string-as-buffer-contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 str (encode-coding-region (point-min) (point-max) coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 ;;;; Coding system accessors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (defun coding-system-mnemonic (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 "Return the 'mnemonic property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (coding-system-property coding-system 'mnemonic))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (defalias 'coding-system-docstring 'coding-system-doc-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (defun coding-system-eol-type (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 "Return the 'eol-type property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (coding-system-property coding-system 'eol-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 (defun coding-system-eol-lf (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 "Return the 'eol-lf property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (coding-system-property coding-system 'eol-lf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (defun coding-system-eol-crlf (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 "Return the 'eol-crlf property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (coding-system-property coding-system 'eol-crlf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (defun coding-system-eol-cr (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 "Return the 'eol-cr property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (coding-system-property coding-system 'eol-cr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 (defun coding-system-post-read-conversion (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 "Return the 'post-read-conversion property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (coding-system-property coding-system 'post-read-conversion))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 (defun coding-system-pre-write-conversion (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 "Return the 'pre-write-conversion property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (coding-system-property coding-system 'pre-write-conversion))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (defun coding-system-base (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 "Return the base coding system of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (if (not (coding-system-eol-type coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 coding-system
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
193 (find-coding-system
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (intern
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
195 (substring
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (symbol-name (coding-system-name coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (string-match "-unix$\\|-dos$\\|-mac$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (symbol-name (coding-system-name coding-system))))))))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
200
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
201
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
202 ;;; #### bleagh!!!!!!!
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
203
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
204 (defun coding-system-get (coding-system prop)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
205 "Extract a value from CODING-SYSTEM's property list for property PROP."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
206 (or (plist-get
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
207 (get (coding-system-name coding-system) 'coding-system-property)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
208 prop)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
209 (condition-case nil
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
210 (coding-system-property coding-system prop)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
211 (error nil))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
212
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
213 (defun coding-system-put (coding-system prop value)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
214 "Change value in CODING-SYSTEM's property list PROP to VALUE."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
215 (put (coding-system-name coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
216 'coding-system-property
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
217 (plist-put (get (coding-system-name coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
218 'coding-system-property)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
219 prop value)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
220
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
221 (defun coding-system-category (coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
222 "Return the coding category of CODING-SYSTEM."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
223 (or (coding-system-get coding-system 'category)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
224 (let ((type (coding-system-type coding-system)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
225 (cond ((eq type 'no-conversion)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
226 'no-conversion)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
227 ((eq type 'shift-jis)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
228 'shift-jis)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
229 ((eq type 'ucs-4)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
230 'ucs-4)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
231 ((eq type 'utf-8)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
232 'utf-8)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
233 ((eq type 'big5)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
234 'big5)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
235 ((eq type 'iso2022)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
236 (cond ((coding-system-lock-shift coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
237 'iso-lock-shift)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
238 ((coding-system-seven coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
239 'iso-7)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
240 (t
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
241 (let ((dim 0)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
242 ccs
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
243 (i 0))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
244 (while (< i 4)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
245 (setq ccs (coding-system-charset coding-system i))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
246 (if (and ccs
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
247 (> (charset-dimension ccs) dim))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
248 (setq dim (charset-dimension ccs))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
249 )
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
250 (setq i (1+ i)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
251 (cond ((= dim 1) 'iso-8-1)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
252 ((= dim 2) 'iso-8-2)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
253 (t 'iso-8-designate))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
254 ))))))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
255
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 ;;;; Definitions of predefined coding systems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (make-coding-system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 'undecided 'undecided
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 "Automatic conversion."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 '(mnemonic "Auto"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
264 ;;; Make certain variables equivalent to coding-system aliases
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
265 (defun dontusethis-set-value-file-name-coding-system-handler (sym args fun harg handlers)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
266 (define-coding-system-alias 'file-name (or (car args) 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
267
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
268 (dontusethis-set-symbol-value-handler
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
269 'file-name-coding-system
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
270 'set-value
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
271 'dontusethis-set-value-file-name-coding-system-handler)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
272
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
273 (defun dontusethis-set-value-terminal-coding-system-handler (sym args fun harg handlers)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
274 (define-coding-system-alias 'terminal (or (car args) 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
275
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
276 (dontusethis-set-symbol-value-handler
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
277 'terminal-coding-system
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
278 'set-value
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
279 'dontusethis-set-value-terminal-coding-system-handler)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
280
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
281 (defun dontusethis-set-value-keyboard-coding-system-handler (sym args fun harg handlers)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
282 (define-coding-system-alias 'keyboard (or (car args) 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
283
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
284 (dontusethis-set-symbol-value-handler
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
285 'keyboard-coding-system
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
286 'set-value
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
287 'dontusethis-set-value-keyboard-coding-system-handler)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
288
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
289 (unless (boundp 'file-name-coding-system)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
290 (setq file-name-coding-system nil))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
291
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
292 (when (not (featurep 'mule))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
293 ;; these are so that gnus and friends work when not mule
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
294 (copy-coding-system 'undecided 'iso-8859-1)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
295 (copy-coding-system 'undecided 'iso-8859-2)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
296
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
297 (define-coding-system-alias 'ctext 'binary))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
298
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 ;; compatibility for old XEmacsen (don't use it)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (copy-coding-system 'undecided 'automatic-conversion)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 (make-compatible-variable 'enable-multibyte-characters "Unimplemented")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (define-obsolete-variable-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 'pathname-coding-system 'file-name-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
728
4d00488244c1 [xemacs-hg @ 2002-01-10 09:50:43 by stephent]
stephent
parents: 599
diff changeset
308 ;;; coding.el ends here