Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-coding.el @ 197:acd284d43ca1 r20-3b25

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b25
author cvs
date Mon, 13 Aug 2007 10:00:02 +0200
parents 3d6bfa290dbd
children e45d5e7c476e
comparison
equal deleted inserted replaced
196:58e0786448ca 197:acd284d43ca1
1 ;;; mule-coding.el --- Coding-system functions for Mule. 1 ;;; mule-coding.el --- Coding-system functions for Mule.
2 2
3 ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
4 ;; Licensed to the Free Software Foundation.
4 ;; Copyright (C) 1995 Amdahl Corporation. 5 ;; Copyright (C) 1995 Amdahl Corporation.
5 ;; Copyright (C) 1995 Sun Microsystems. 6 ;; Copyright (C) 1995 Sun Microsystems.
7 ;; Copyright (C) 1997 MORIOKA Tomohiko
6 8
7 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
8 10
9 ;; XEmacs is free software; you can redistribute it and/or modify it 11 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by 12 ;; under the terms of the GNU General Public License as published by
24 ;;; Commentary: 26 ;;; Commentary:
25 27
26 ;;; split off of mule.el. 28 ;;; split off of mule.el.
27 29
28 ;;; Code: 30 ;;; Code:
31
32 (defalias 'check-coding-system 'get-coding-system)
33
34 (defun modify-coding-system-alist (target-type regexp coding-system)
35 "Modify one of look up tables for finding a coding system on I/O operation.
36 There are three of such tables, `file-coding-system-alist',
37 `process-coding-system-alist', and `network-coding-system-alist'.
38
39 TARGET-TYPE specifies which of them to modify.
40 If it is `file', it affects `file-coding-system-alist' (which see).
41 If it is `process', it affects `process-coding-system-alist' (which see).
42 If it is `network', it affects `network-codign-system-alist' (which see).
43
44 REGEXP is a regular expression matching a target of I/O operation.
45 The target is a file name if TARGET-TYPE is `file', a program name if
46 TARGET-TYPE is `process', or a network service name or a port number
47 to connect to if TARGET-TYPE is `network'.
48
49 CODING-SYSTEM is a coding system to perform code conversion on the I/O
50 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems
51 for decoding and encoding respectively,
52 or a function symbol which, when called, returns such a cons cell."
53 (or (memq target-type '(file process network))
54 (error "Invalid target type: %s" target-type))
55 (or (stringp regexp)
56 (and (eq target-type 'network) (integerp regexp))
57 (error "Invalid regular expression: %s" regexp))
58 (if (symbolp coding-system)
59 (if (not (fboundp coding-system))
60 (progn
61 (check-coding-system coding-system)
62 (setq coding-system (cons coding-system coding-system))))
63 (check-coding-system (car coding-system))
64 (check-coding-system (cdr coding-system)))
65 (cond ((eq target-type 'file)
66 (let ((slot (assoc regexp file-coding-system-alist)))
67 (if slot
68 (setcdr slot coding-system)
69 (setq file-coding-system-alist
70 (cons (cons regexp coding-system)
71 file-coding-system-alist)))))
72 ((eq target-type 'process)
73 (let ((slot (assoc regexp process-coding-system-alist)))
74 (if slot
75 (setcdr slot coding-system)
76 (setq process-coding-system-alist
77 (cons (cons regexp coding-system)
78 process-coding-system-alist)))))
79 (t
80 (let ((slot (assoc regexp network-coding-system-alist)))
81 (if slot
82 (setcdr slot coding-system)
83 (setq network-coding-system-alist
84 (cons (cons regexp coding-system)
85 network-coding-system-alist)))))))
29 86
30 (defun set-keyboard-coding-system (coding-system) 87 (defun set-keyboard-coding-system (coding-system)
31 "Set the coding system used for TTY keyboard input. Currently broken." 88 "Set the coding system used for TTY keyboard input. Currently broken."
32 (interactive "zkeyboard-coding-system: ") 89 (interactive "zkeyboard-coding-system: ")
33 (get-coding-system coding-system) ; correctness check 90 (get-coding-system coding-system) ; correctness check
43 100
44 (defun set-pathname-coding-system (coding-system) 101 (defun set-pathname-coding-system (coding-system)
45 "Set the coding system used for file system path names." 102 "Set the coding system used for file system path names."
46 (interactive "zPathname-coding-system: ") 103 (interactive "zPathname-coding-system: ")
47 (get-coding-system coding-system) ; correctness check 104 (get-coding-system coding-system) ; correctness check
48 (setq pathname-coding-system coding-system)) 105 (setq file-name-coding-system coding-system))
49 106
50 (defun what-coding-system (start end &optional arg) 107 (defun what-coding-system (start end &optional arg)
51 "Show the encoding of text in the region. 108 "Show the encoding of text in the region.
52 This function is meant to be called interactively; 109 This function is meant to be called interactively;
53 from a Lisp program, use `detect-coding-region' instead." 110 from a Lisp program, use `detect-coding-region' instead."
207 )) 264 ))
208 265
209 (copy-coding-system 'iso-2022-7bit-ss2 'iso-2022-jp-2) 266 (copy-coding-system 'iso-2022-7bit-ss2 'iso-2022-jp-2)
210 267
211 (make-coding-system 268 (make-coding-system
212 'iso-2022-7 'iso2022 269 'iso-2022-7bit 'iso2022
213 "ISO-2022 seven-bit coding system. No single-shift or locking-shift." 270 "ISO 2022 based 7-bit encoding using only G0"
214 '(charset-g0 ascii 271 '(charset-g0 ascii
215 seven t 272 seven t
216 short t 273 short t
217 mnemonic "ISO7" 274 mnemonic "ISO7"))
218 )) 275
276 ;; compatibility for old XEmacsen
277 (copy-coding-system 'iso-2022-7bit 'iso-2022-7)
219 278
220 (make-coding-system 279 (make-coding-system
221 'iso-2022-8 'iso2022 280 'iso-2022-8 'iso2022
222 "ISO-2022 eight-bit coding system. No single-shift or locking-shift." 281 "ISO-2022 eight-bit coding system. No single-shift or locking-shift."
223 '(charset-g0 ascii 282 '(charset-g0 ascii
259 (set-coding-category-system 'iso-lock-shift 'iso-2022-lock) 318 (set-coding-category-system 'iso-lock-shift 'iso-2022-lock)
260 (set-coding-category-system 'no-conversion 'no-conversion) 319 (set-coding-category-system 'no-conversion 'no-conversion)
261 320
262 (make-compatible-variable 'enable-multibyte-characters "Unimplemented") 321 (make-compatible-variable 'enable-multibyte-characters "Unimplemented")
263 322
323 (define-obsolete-variable-alias
324 'pathname-coding-system 'file-name-coding-system)
325
264 ;;; mule-coding.el ends here 326 ;;; mule-coding.el ends here