Mercurial > hg > xemacs-beta
diff lisp/code-cmds.el @ 444:576fb035e263 r21-2-37
Import from CVS: tag r21-2-37
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:36:19 +0200 |
parents | |
children | 943eaba38521 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/code-cmds.el Mon Aug 13 11:36:19 2007 +0200 @@ -0,0 +1,204 @@ +;;; code-cmds.el --- Commands for manipulating coding systems.. + +;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. +;; Copyright (C) 2000 Free Software Foundation +;; Copyright (C) 1997 MORIOKA Tomohiko + + +;; This file is part of XEmacs. + +;; 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. + +;; +;; This code defines the keybindings and utility commands for the +;; user to manipulate coding systems. +;; This code used to be in mule-cmds.el which now only needs the +;; additional bindings/commands that are avaible on the real mule. + + +;;; Code: + +;;; Coding related key bindings and menus. + +(defvar coding-keymap (make-sparse-keymap "Mule/Conding") + "Keymap for Mule and Coding cystem specific commands.") + +;; Keep "C-x C-m ..." for mule specific commands. +(define-key ctl-x-map "\C-m" coding-keymap) + +(define-key coding-keymap "f" 'set-buffer-file-coding-system) +(define-key coding-keymap "F" 'set-default-buffer-file-coding-system) ; XEmacs +(define-key coding-keymap "t" 'set-terminal-coding-system) +(define-key coding-keymap "p" 'set-buffer-process-coding-system) +;(define-key coding-keymap "x" 'set-selection-coding-system) +;(define-key coding-keymap "X" 'set-next-selection-coding-system) +(define-key coding-keymap "c" 'universal-coding-system-argument) +;;(define-key coding-keymap "c" 'list-coding-system-briefly) ; XEmacs +;;(define-key coding-keymap "C" 'describe-coding-system) ; XEmacs + + +(defun coding-system-change-eol-conversion (coding-system eol-type) + "Return a coding system which differs from CODING-SYSTEM in eol conversion. +The returned coding system converts end-of-line by EOL-TYPE +but text as the same way as CODING-SYSTEM. +EOL-TYPE should be `lf', `crlf', `cr' or nil. +If EOL-TYPE is nil, the returned coding system detects +how end-of-line is formatted automatically while decoding. + +EOL-TYPE can be specified by an symbol `unix', `dos' or `mac'. +They means `lf', `crlf', and `cr' respectively." + (if (symbolp eol-type) + (setq eol-type (cond ((or (eq eol-type 'unix) + (eq eol-type 'lf)) + 'eol-lf) + ((or (eq eol-type 'dos) + (eq eol-type 'crlf)) + 'eol-crlf) + ((or (eq eol-type 'mac) + (eq eol-type 'cr)) + 'eol-cr) + (t eol-type)))) + (let ((orig-eol-type (coding-system-eol-type coding-system))) + (if (null orig-eol-type) + (if (not eol-type) + coding-system + (coding-system-property coding-system eol-type)) + (let ((base (coding-system-base coding-system))) + (if (not eol-type) + base + (if (= eol-type orig-eol-type) + coding-system + (setq orig-eol-type (coding-system-eol-type base)) + (if (null orig-eol-type) + (coding-system-property base eol-type)))))))) + + +(defun universal-coding-system-argument () + "Execute an I/O command using the specified coding system." + (interactive) + (let* ((default (and buffer-file-coding-system + (not (eq (coding-system-type buffer-file-coding-system) + t)) + (coding-system-name buffer-file-coding-system))) + (coding-system + (read-coding-system + (if default + (format "Coding system for following command (default, %s): " + default) + "Coding system for following command: ") + default)) + (keyseq (read-key-sequence + (format "Command to execute with %s:" coding-system))) + (cmd (key-binding keyseq))) + (let ((coding-system-for-read coding-system) + (coding-system-for-write coding-system)) + (message "") + (call-interactively cmd)))) + +(defun set-default-coding-systems (coding-system) + "Set default value of various coding systems to CODING-SYSTEM. +This sets the following coding systems: + o coding system of a newly created buffer + o default coding system for terminal output + o default coding system for keyboard input + o default coding system for subprocess I/O + o default coding system for converting file names." + (check-coding-system coding-system) + ;;(setq-default buffer-file-coding-system coding-system) + (set-default-buffer-file-coding-system coding-system) + ;; (if default-enable-multibyte-characters + ;; (setq default-file-name-coding-system coding-system)) + ;; If coding-system is nil, honor that on MS-DOS as well, so + ;; that they could reset the terminal coding system. + ;; (unless (and (eq window-system 'pc) coding-system) + ;; (setq default-terminal-coding-system coding-system)) + (set-terminal-coding-system coding-system) + ;;(setq default-keyboard-coding-system coding-system) + (set-keyboard-coding-system coding-system) + ;;(setq default-process-coding-system (cons coding-system coding-system)) + ;; Refer to coding-system-for-read and coding-system-for-write + ;; so that C-x RET c works. + (add-hook 'comint-exec-hook + `(lambda () + (let ((proc (get-buffer-process (current-buffer)))) + (set-process-input-coding-system + proc (or coding-system-for-read ',coding-system)) + (set-process-output-coding-system + proc (or coding-system-for-write ',coding-system)))) + 'append) + (setq file-name-coding-system coding-system)) + +(defun prefer-coding-system (coding-system) + "Add CODING-SYSTEM at the front of the priority list for automatic detection. +This also sets the following coding systems: + o coding system of a newly created buffer + o default coding system for terminal output + o default coding system for keyboard input + o default coding system for converting file names. + +If CODING-SYSTEM specifies a certain type of EOL conversion, the coding +systems set by this function will use that type of EOL conversion. + +This command does not change the default value of terminal coding system +for MS-DOS terminal, because DOS terminals only support a single coding +system, and Emacs automatically sets the default to that coding system at +startup." + (interactive "zPrefer coding system: ") + (if (not (and coding-system (find-coding-system coding-system))) + (error "Invalid coding system `%s'" coding-system)) + (let ((coding-category (coding-system-category coding-system)) + (base (coding-system-base coding-system)) + (eol-type (coding-system-eol-type coding-system))) + (if (not coding-category) + ;; CODING-SYSTEM is no-conversion or undecided. + (error "Can't prefer the coding system `%s'" coding-system)) + (set-coding-category-system coding-category (or base coding-system)) + ;; (update-coding-systems-internal) + (or (eq coding-category (car (coding-category-list))) + ;; We must change the order. + (set-coding-priority-list (list coding-category))) + (if (and base (interactive-p)) + (message "Highest priority is set to %s (base of %s)" + base coding-system)) + ;; If they asked for specific EOL conversion, honor that. + (if (memq eol-type '(lf crlf mac)) + (setq coding-system + (coding-system-change-eol-conversion base eol-type)) + (setq coding-system base)) + (set-default-coding-systems coding-system))) + +;;; Commands + +(defun set-buffer-process-coding-system (decoding encoding) + "Set coding systems for the process associated with the current buffer. +DECODING is the coding system to be used to decode input from the process, +ENCODING is the coding system to be used to encode output to the process. + +For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems]." + (interactive + "zCoding-system for process input: \nzCoding-system for process output: ") + (let ((proc (get-buffer-process (current-buffer)))) + (if (null proc) + (error "no process") + (check-coding-system decoding) + (check-coding-system encoding) + (set-process-coding-system proc decoding encoding))) + (force-mode-line-update)) + +(provide 'code-cmds) + +;;; code-cmds.el ends here