Mercurial > hg > xemacs-beta
diff lisp/coding.el @ 259:11cf20601dec r20-5b28
Import from CVS: tag r20-5b28
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:23:02 +0200 |
parents | |
children | 405dd6d1825b |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/coding.el Mon Aug 13 10:23:02 2007 +0200 @@ -0,0 +1,208 @@ +;;; coding.el --- Coding-system functions for XEmacs. + +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. +;; Copyright (C) 1995 Amdahl Corporation. +;; Copyright (C) 1995 Sun Microsystems. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; This file is part of XEmacs. + +;; This file is very similar to mule-coding.el + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; split off of mule.el. + +;;; Code: + +(defalias 'check-coding-system 'get-coding-system) + +(defconst modeline-multibyte-status '("%C") + "Modeline control for showing multibyte extension status.") + +;; override the default value defined in loaddefs.el. +(setq-default modeline-format + (cons (purecopy "") + (cons 'modeline-multibyte-status + (cdr modeline-format)))) + +(defun modify-coding-system-alist (target-type regexp coding-system) + "Modify one of look up tables for finding a coding system on I/O operation. +There are three of such tables, `file-coding-system-alist', +`process-coding-system-alist', and `network-coding-system-alist'. + +TARGET-TYPE specifies which of them to modify. +If it is `file', it affects `file-coding-system-alist' (which see). +If it is `process', it affects `process-coding-system-alist' (which see). +If it is `network', it affects `network-codign-system-alist' (which see). + +REGEXP is a regular expression matching a target of I/O operation. +The target is a file name if TARGET-TYPE is `file', a program name if +TARGET-TYPE is `process', or a network service name or a port number +to connect to if TARGET-TYPE is `network'. + +CODING-SYSTEM is a coding system to perform code conversion on the I/O +operation, or a cons cell (DECODING . ENCODING) specifying the coding systems +for decoding and encoding respectively, +or a function symbol which, when called, returns such a cons cell." + (or (memq target-type '(file process network)) + (error "Invalid target type: %s" target-type)) + (or (stringp regexp) + (and (eq target-type 'network) (integerp regexp)) + (error "Invalid regular expression: %s" regexp)) + (if (symbolp coding-system) + (if (not (fboundp coding-system)) + (progn + (check-coding-system coding-system) + (setq coding-system (cons coding-system coding-system)))) + (check-coding-system (car coding-system)) + (check-coding-system (cdr coding-system))) + (cond ((eq target-type 'file) + (let ((slot (assoc regexp file-coding-system-alist))) + (if slot + (setcdr slot coding-system) + (setq file-coding-system-alist + (cons (cons regexp coding-system) + file-coding-system-alist))))) + ((eq target-type 'process) + (let ((slot (assoc regexp process-coding-system-alist))) + (if slot + (setcdr slot coding-system) + (setq process-coding-system-alist + (cons (cons regexp coding-system) + process-coding-system-alist))))) + (t + (let ((slot (assoc regexp network-coding-system-alist))) + (if slot + (setcdr slot coding-system) + (setq network-coding-system-alist + (cons (cons regexp coding-system) + network-coding-system-alist))))))) + +(defsubst keyboard-coding-system () + "Return coding-system of what is sent from terminal keyboard." + keyboard-coding-system) + +(defun set-keyboard-coding-system (coding-system) + "Set the coding system used for TTY keyboard input. Currently broken." + (interactive "zkeyboard-coding-system: ") + (get-coding-system coding-system) ; correctness check + (setq keyboard-coding-system coding-system) + (redraw-modeline t)) + +(defsubst terminal-coding-system () + "Return coding-system of your terminal." + terminal-coding-system) + +(defun set-terminal-coding-system (coding-system) + "Set the coding system used for TTY display output. Currently broken." + (interactive "zterminal-coding-system: ") + (get-coding-system coding-system) ; correctness check + (setq terminal-coding-system coding-system) + (set-console-tty-coding-system (device-console) terminal-coding-system) + (redraw-modeline t)) + +(defun set-pathname-coding-system (coding-system) + "Set the coding system used for file system path names." + (interactive "zPathname-coding-system: ") + (get-coding-system coding-system) ; correctness check + (setq file-name-coding-system coding-system)) + +(defun what-coding-system (start end &optional arg) + "Show the encoding of text in the region. +This function is meant to be called interactively; +from a Lisp program, use `detect-coding-region' instead." + (interactive "r\nP") + (princ (detect-coding-region start end))) + +(defun decode-coding-string (str coding-system) + "Decode the string STR which is encoded in CODING-SYSTEM. +Does not modify STR. Returns the decoded string on successful conversion." + (with-string-as-buffer-contents + str (decode-coding-region (point-min) (point-max) coding-system))) + +(defun encode-coding-string (str coding-system) + "Encode the string STR using CODING-SYSTEM. +Does not modify STR. Returns the encoded string on successful conversion." + (with-string-as-buffer-contents + str (encode-coding-region (point-min) (point-max) coding-system))) + + +;;;; Coding system accessors + +(defun coding-system-mnemonic (coding-system) + "Return the 'mnemonic property of CODING-SYSTEM." + (coding-system-property coding-system 'mnemonic)) + +(defalias 'coding-system-docstring 'coding-system-doc-string) + +(defun coding-system-eol-type (coding-system) + "Return the 'eol-type property of CODING-SYSTEM." + (coding-system-property coding-system 'eol-type)) + +(defun coding-system-eol-lf (coding-system) + "Return the 'eol-lf property of CODING-SYSTEM." + (coding-system-property coding-system 'eol-lf)) + +(defun coding-system-eol-crlf (coding-system) + "Return the 'eol-crlf property of CODING-SYSTEM." + (coding-system-property coding-system 'eol-crlf)) + +(defun coding-system-eol-cr (coding-system) + "Return the 'eol-cr property of CODING-SYSTEM." + (coding-system-property coding-system 'eol-cr)) + +(defun coding-system-post-read-conversion (coding-system) + "Return the 'post-read-conversion property of CODING-SYSTEM." + (coding-system-property coding-system 'post-read-conversion)) + +(defun coding-system-pre-write-conversion (coding-system) + "Return the 'pre-write-conversion property of CODING-SYSTEM." + (coding-system-property coding-system 'pre-write-conversion)) + +(defun coding-system-base (coding-system) + "Return the base coding system of CODING-SYSTEM." + (if (not (coding-system-eol-type coding-system)) + coding-system + (find-coding-system + (intern + (substring + (symbol-name (coding-system-name coding-system)) + 0 + (string-match "-unix$\\|-dos$\\|-mac$" + (symbol-name (coding-system-name coding-system)))))))) + +;;;; Definitions of predefined coding systems + +(make-coding-system + 'undecided 'undecided + "Automatic conversion." + '(mnemonic "Auto")) + +;; compatibility for old XEmacsen (don't use it) +(copy-coding-system 'undecided 'automatic-conversion) + +(copy-coding-system 'no-conversion 'raw-text) + +(make-compatible-variable 'enable-multibyte-characters "Unimplemented") + +(define-obsolete-variable-alias + 'pathname-coding-system 'file-name-coding-system) + +;;; mule-coding.el ends here