xemacs-beta: lisp/coding.el annotate

annotate lisp/coding.el @ 4569:80e0588fb42f

Merge.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Sun, 28 Dec 2008 14:55:02 +0000
parents	1d74a1d115ee
children	e6a7054a9c30

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
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	8 ;; Copyright (C) 2000, 2001, 2002 Ben Wing.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	9
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	11
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	16
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	21
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	22 ;; 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	23 ;; 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	24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	25 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	26
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	27 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	28
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	29 ;;; split off of mule.el.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	30
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	31 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	32
502 7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	33 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	34 '(coding-system-lock-shift
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	35 coding-system-seven coding-system-charset charset-dimension))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	36
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	37 (defalias 'check-coding-system 'get-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	38
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	39 (defun modify-coding-system-alist (target-type regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	40 "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	41 There are three of such tables, `file-coding-system-alist',
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	42 `process-coding-system-alist', and `network-coding-system-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	43
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	44 TARGET-TYPE specifies which of them to modify.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	45 If it is `file', it affects `file-coding-system-alist' (which see).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	46 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	47 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	48
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	49 REGEXP is a regular expression matching a target of I/O operation.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	50 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	51 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	52 to connect to if TARGET-TYPE is `network'.
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 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	55 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	56 for decoding and encoding respectively,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	57 or a function symbol which, when called, returns such a cons cell."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	58 (or (memq target-type '(file process network))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	59 (error "Invalid target type: %s" target-type))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	60 (or (stringp regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	61 (and (eq target-type 'network) (integerp regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	62 (error "Invalid regular expression: %s" regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	63 (if (symbolp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	64 (if (not (fboundp coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	65 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	66 (check-coding-system coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	67 (setq coding-system (cons coding-system coding-system))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	68 (check-coding-system (car coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	69 (check-coding-system (cdr coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	70 (cond ((eq target-type 'file)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	71 (let ((slot (assoc regexp file-coding-system-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	72 (if slot
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	73 (setcdr slot coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	74 (setq file-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	75 (cons (cons regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	76 file-coding-system-alist)))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	77 ((eq target-type 'process)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	78 (let ((slot (assoc regexp process-coding-system-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	79 (if slot
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	80 (setcdr slot coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	81 (setq process-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	82 (cons (cons regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	83 process-coding-system-alist)))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	84 (t
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	85 (let ((slot (assoc regexp network-coding-system-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	86 (if slot
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	87 (setcdr slot coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	88 (setq network-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	89 (cons (cons regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	90 network-coding-system-alist)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	91
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	92 (defsubst keyboard-coding-system ()
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	93 "Return coding-system of what is sent from terminal keyboard."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	94 keyboard-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	95
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	96 (defun set-keyboard-coding-system (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	97 "Set the coding system used for TTY keyboard input. Currently broken."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	98 (interactive "zkeyboard-coding-system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	99 (get-coding-system coding-system) ; correctness check
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	100 (setq keyboard-coding-system coding-system)
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	101 (if (eq (device-type) 'tty)
502 7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	102 (declare-fboundp (set-console-tty-input-coding-system
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	103 (device-console) keyboard-coding-system)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	104 (redraw-modeline t))
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 (defsubst terminal-coding-system ()
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	107 "Return coding-system of your terminal."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	108 terminal-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	109
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	110 (defun set-terminal-coding-system (coding-system)
4477 e34711681f30 Don't determine whether to call general device-type code at startup, Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	111 "Set the coding system used for TTY display output."
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	112 (interactive "zterminal-coding-system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	113 (get-coding-system coding-system) ; correctness check
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	114 (setq terminal-coding-system coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	115 ; #### should this affect all current tty consoles ?
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	116 (if (eq (device-type) 'tty)
502 7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	117 (declare-fboundp (set-console-tty-output-coding-system
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	118 (device-console) terminal-coding-system)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	119 (redraw-modeline t))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	120
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	121 (defun what-coding-system (start end &optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	122 "Show the encoding of text in the region.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	123 This function is meant to be called interactively;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	124 from a Lisp program, use `detect-coding-region' instead."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	125 (interactive "r\nP")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	126 (princ (detect-coding-region start end)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	127
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	128 (defun decode-coding-string (str coding-system &optional nocopy)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	129 "Decode the string STR which is encoded in CODING-SYSTEM.
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	130 Normally does not modify STR. Returns the decoded string on
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	131 successful conversion.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	132 Optional argument NOCOPY says that modifying STR and returning it is
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	133 allowed."
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	134 (with-string-as-buffer-contents
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	135 str (decode-coding-region (point-min) (point-max) coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	136
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	137 (defun encode-coding-string (str coding-system &optional nocopy)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	138 "Encode the string STR using CODING-SYSTEM.
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	139 Does not modify STR. Returns the encoded string on successful conversion.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	140 Optional argument NOCOPY says that the original string may be returned
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	141 if does not differ from the encoded string. "
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	142 (with-string-as-buffer-contents
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	143 str (encode-coding-region (point-min) (point-max) coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	144
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	145
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	146 ;;;; Coding system accessors
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	147
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	148 (defun coding-system-mnemonic (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	149 "Return the 'mnemonic property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	150 (coding-system-property coding-system 'mnemonic))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	151
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	152 (defun coding-system-documentation (coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	153 "Return the 'documentation property of CODING-SYSTEM."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	154 (coding-system-property coding-system 'documentation))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	155
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	156 (define-obsolete-function-alias 'coding-system-doc-string
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	157 'coding-system-description)
428 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-eol-type (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	160 "Return the 'eol-type property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	161 (coding-system-property coding-system 'eol-type))
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 (defun coding-system-eol-lf (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	164 "Return the 'eol-lf property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	165 (coding-system-property coding-system 'eol-lf))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	166
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	167 (defun coding-system-eol-crlf (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	168 "Return the 'eol-crlf property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	169 (coding-system-property coding-system 'eol-crlf))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	170
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	171 (defun coding-system-eol-cr (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	172 "Return the 'eol-cr property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	173 (coding-system-property coding-system 'eol-cr))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	174
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	175 (defun coding-system-post-read-conversion (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	176 "Return the 'post-read-conversion property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	177 (coding-system-property coding-system 'post-read-conversion))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	178
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	179 (defun coding-system-pre-write-conversion (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	180 "Return the 'pre-write-conversion property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	181 (coding-system-property coding-system 'pre-write-conversion))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	182
502 7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	183 ;;; #### bleagh!!!!!!!
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	184
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	185 (defun coding-system-get (coding-system prop)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	186 "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	187 (or (plist-get
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	188 (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	189 prop)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	190 (condition-case nil
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	191 (coding-system-property coding-system prop)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	192 (error nil))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	193
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	194 (defun coding-system-put (coding-system prop value)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	195 "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	196 (put (coding-system-name coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	197 'coding-system-property
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	198 (plist-put (get (coding-system-name coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	199 'coding-system-property)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	200 prop value)))
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 (defun coding-system-category (coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	203 "Return the coding category of CODING-SYSTEM."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	204 (or (coding-system-get coding-system 'category)
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	205 (case (coding-system-type coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	206 (no-conversion 'no-conversion)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	207 (shift-jis 'shift-jis)
3767 6b2ef948e140 [xemacs-hg @ 2006-12-29 18:09:38 by aidan] aidan parents: 985 diff changeset	208 (unicode (case (coding-system-property coding-system 'unicode-type)
985 7f62a956b825 [xemacs-hg @ 2002-09-01 06:41:40 by youngs] youngs parents: 771 diff changeset	209 (utf-8 (let ((bom (coding-system-property coding-system
7f62a956b825 [xemacs-hg @ 2002-09-01 06:41:40 by youngs] youngs parents: 771 diff changeset	210 'need-bom)))
7f62a956b825 [xemacs-hg @ 2002-09-01 06:41:40 by youngs] youngs parents: 771 diff changeset	211 (cond (bom 'utf-8-bom)
7f62a956b825 [xemacs-hg @ 2002-09-01 06:41:40 by youngs] youngs parents: 771 diff changeset	212 ((not bom) 'utf-8))))
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	213 (ucs-4 'ucs-4)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	214 (utf-16 (let ((bom (coding-system-property coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	215 'need-bom))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	216 (le (coding-system-property coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	217 'little-endian)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	218 (cond ((and bom le) 'utf-16-little-endian-bom)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	219 ((and bom (not le) 'utf-16-bom))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	220 ((and (not bom) le) 'utf-16-little-endian)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	221 ((and (not bom) (not le) 'utf-16)))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	222 (big5 'big5)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	223 (iso2022 (cond ((coding-system-lock-shift coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	224 'iso-lock-shift)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	225 ((coding-system-seven coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	226 'iso-7)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	227 (t
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	228 (let ((dim 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	229 ccs
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	230 (i 0))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	231 (while (< i 4)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	232 (setq ccs (declare-fboundp
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	233 (coding-system-iso2022-charset
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	234 coding-system i)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	235 (if (and ccs
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	236 (> (charset-dimension ccs) dim))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	237 (setq dim (charset-dimension ccs))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	238 )
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	239 (setq i (1+ i)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	240 (cond ((= dim 1) 'iso-8-1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	241 ((= dim 2) 'iso-8-2)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	242 (t 'iso-8-designate))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	243 )))
502 7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 444 diff changeset	244
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	245
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	246 ;;; Make certain variables equivalent to coding-system aliases
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	247 (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	248 (define-coding-system-alias 'file-name (or (car args) 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	249
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	250 (dontusethis-set-symbol-value-handler
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	251 'file-name-coding-system
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	252 'set-value
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	253 'dontusethis-set-value-file-name-coding-system-handler)
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	254
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	255 (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	256 (define-coding-system-alias 'terminal (or (car args) 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	257
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	258 (dontusethis-set-symbol-value-handler
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	259 'terminal-coding-system
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	260 'set-value
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	261 'dontusethis-set-value-terminal-coding-system-handler)
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	262
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	263 (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	264 (define-coding-system-alias 'keyboard (or (car args) 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	265
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	266 (dontusethis-set-symbol-value-handler
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	267 'keyboard-coding-system
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	268 'set-value
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	269 'dontusethis-set-value-keyboard-coding-system-handler)
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	270
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	271 (when (not (featurep 'mule))
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	272 (define-coding-system-alias 'escape-quoted 'binary)
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	273 ;; these are so that gnus and friends work when not mule
4227 dd9c1d5f5319 [xemacs-hg @ 2007-10-15 10:53:33 by aidan] aidan parents: 4222 diff changeset	274 (define-coding-system-alias 'iso-8859-1 'raw-text)
4222 38ef5a6da799 [xemacs-hg @ 2007-10-13 14:08:26 by aidan] aidan parents: 3767 diff changeset	275 ;; We're misrepresenting ourselves to the gnus code by saying we support
38ef5a6da799 [xemacs-hg @ 2007-10-13 14:08:26 by aidan] aidan parents: 3767 diff changeset	276 ;; both.
4227 dd9c1d5f5319 [xemacs-hg @ 2007-10-15 10:53:33 by aidan] aidan parents: 4222 diff changeset	277 ; (define-coding-system-alias 'iso-8859-2 'raw-text)
dd9c1d5f5319 [xemacs-hg @ 2007-10-15 10:53:33 by aidan] aidan parents: 4222 diff changeset	278 (define-coding-system-alias 'ctext 'raw-text))
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	279
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	280 (make-compatible-variable 'enable-multibyte-characters "Unimplemented")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	281
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	282 ;; Sure would be nice to be able to use defface here.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	283 (copy-face 'highlight 'query-coding-warning-face)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	284
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	285 (defvar default-query-coding-region-safe-charset-skip-chars-map
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	286 #s(hash-table test equal data ())
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	287 "A map from list of charsets to `skip-chars-forward' arguments for them.")
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	288
4555 20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	289 (defsubst query-coding-clear-highlights (begin end &optional buffer)
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	290 "Remove extent faces added by `query-coding-region' between BEGIN and END.
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	291
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	292 Optional argument BUFFER is the buffer to use, and defaults to the current
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	293 buffer.
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	294
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	295 The HIGHLIGHTP argument to `query-coding-region' indicates that it should
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	296 display unencodable characters using `query-coding-warning-face'. After
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	297 this function has been called, this will no longer be the case. "
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	298 (map-extents #'(lambda (extent ignored-arg)
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	299 (when (eq 'query-coding-warning-face
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	300 (extent-face extent))
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	301 (delete-extent extent))) buffer begin end))
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	302
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	303 (defun* default-query-coding-region (begin end coding-system
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	304 &optional buffer errorp highlightp)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	305 "The default `query-coding-region' implementation.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	306
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	307 Uses the `safe-charsets' and `safe-chars' coding system properties.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	308 The former is a list of XEmacs character sets that can be safely
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	309 encoded by CODING-SYSTEM; the latter a char table describing, in
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	310 addition, characters that can be safely encoded by CODING-SYSTEM."
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	311 (check-argument-type #'coding-system-p
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	312 (setq coding-system (find-coding-system coding-system)))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	313 (check-argument-type #'integer-or-marker-p begin)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	314 (check-argument-type #'integer-or-marker-p end)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	315 (let* ((safe-charsets
4551 6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	316 (or (coding-system-get coding-system 'safe-charsets)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	317 (coding-system-get (coding-system-base coding-system)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	318 'safe-charsets)))
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	319 (safe-chars
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	320 (or (coding-system-get coding-system 'safe-chars)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	321 (coding-system-get (coding-system-base coding-system)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	322 'safe-chars)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	323 (skip-chars-arg
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	324 (gethash safe-charsets
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	325 default-query-coding-region-safe-charset-skip-chars-map))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	326 (ranges (make-range-table))
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	327 fail-range-start fail-range-end char-after
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	328 looking-at-arg failed extent)
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	329 ;; Coding systems with a value of t for safe-charsets support everything.
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	330 (when (eq t safe-charsets)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	331 (return-from default-query-coding-region (values t nil)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	332 (unless skip-chars-arg
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	333 (setq skip-chars-arg
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	334 (puthash safe-charsets
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	335 (mapconcat #'charset-skip-chars-string
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	336 safe-charsets "")
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	337 default-query-coding-region-safe-charset-skip-chars-map)))
4551 6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	338 (when highlightp
4555 20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	339 (query-coding-clear-highlights begin end buffer))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	340 (if (and (zerop (length skip-chars-arg)) (null safe-chars))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	341 (progn
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	342 ;; Uh-oh, nothing known about this coding system. Fail.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	343 (when errorp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	344 (error 'text-conversion-error
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	345 "Coding system doesn't say what it can encode"
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	346 (coding-system-name coding-system)))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	347 (put-range-table begin end t ranges)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	348 (when highlightp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	349 (setq extent (make-extent begin end buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	350 (set-extent-priority extent (+ mouse-highlight-priority 2))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	351 (set-extent-face extent 'query-coding-warning-face))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	352 (values nil ranges))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	353 (setq looking-at-arg (if (equal "" skip-chars-arg)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	354 ;; Regexp that will never match.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	355 #r".\{0,0\}"
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	356 (concat "[" skip-chars-arg "]")))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	357 (save-excursion
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	358 (goto-char begin buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	359 (skip-chars-forward skip-chars-arg end buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	360 (while (< (point buffer) end)
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	361 ; (message
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	362 ; "fail-range-start is %S, point is %S, end is %S"
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	363 ; fail-range-start (point buffer) end)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	364 (setq char-after (char-after (point buffer) buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	365 fail-range-start (point buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	366 (while (and
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	367 (< (point buffer) end)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	368 (not (looking-at looking-at-arg))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	369 (or (not safe-chars)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	370 (not (get-char-table char-after safe-chars))))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	371 (forward-char 1 buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	372 (setq char-after (char-after (point buffer) buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	373 failed t))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	374 (if (= fail-range-start (point buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	375 ;; The character can actually be encoded by the coding
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	376 ;; system; check the characters past it.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	377 (forward-char 1 buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	378 ;; Can't be encoded; note this.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	379 (when errorp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	380 (error 'text-conversion-error
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	381 (format "Cannot encode %s using coding system"
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	382 (buffer-substring fail-range-start (point buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	383 buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	384 (coding-system-name coding-system)))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	385 (put-range-table fail-range-start
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	386 ;; If char-after is non-nil, we're not at
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	387 ;; the end of the buffer.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	388 (setq fail-range-end (if char-after
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	389 (point buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	390 (point-max buffer)))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	391 t ranges)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	392 (when highlightp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	393 (setq extent (make-extent fail-range-start fail-range-end buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	394 (set-extent-priority extent (+ mouse-highlight-priority 2))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	395 (set-extent-face extent 'query-coding-warning-face)))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	396 (skip-chars-forward skip-chars-arg end buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	397 (if failed
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	398 (values nil ranges)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	399 (values t nil))))))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	400
4555 20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	401 (defun query-coding-region (start end coding-system &optional buffer
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	402 errorp highlight)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	403 "Work out whether CODING-SYSTEM can losslessly encode a region.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	404
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	405 START and END are the beginning and end of the region to check.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	406 CODING-SYSTEM is the coding system to try.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	407
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	408 Optional argument BUFFER is the buffer to check, and defaults to the current
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	409 buffer. Optional argument ERRORP says to signal a `text-conversion-error'
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	410 if some character in the region cannot be encoded, and defaults to nil.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	411
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	412 Optional argument HIGHLIGHT says to display unencodable characters in the
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	413 region using `query-coding-warning-face'. It defaults to nil.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	414
4553 75654496fa0e Correct a docstring Aidan Kehoe <kehoea@parhasard.net> parents: 4551 diff changeset	415 This function returns a list; the intention is that callers use
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	416 `multiple-value-bind' or the related CL multiple value functions to deal
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	417 with it. The first element is `t' if the region can be encoded using
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	418 CODING-SYSTEM, or `nil' if not. The second element is `nil' if the region
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	419 can be encoded using CODING-SYSTEM; otherwise, it is a range table
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	420 describing the positions of the unencodable characters. See
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	421 `make-range-table'."
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	422 (funcall (or (coding-system-get coding-system 'query-coding-function)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	423 #'default-query-coding-region)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	424 start end coding-system buffer errorp highlight))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	425
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	426 (defun query-coding-string (string coding-system &optional errorp highlight)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	427 "Work out whether CODING-SYSTEM can losslessly encode STRING.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	428 CODING-SYSTEM is the coding system to check.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	429
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	430 Optional argument ERRORP says to signal a `text-conversion-error' if some
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	431 character in the region cannot be encoded, and defaults to nil.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	432
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	433 Optional argument HIGHLIGHT says to display unencodable characters in the
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	434 region using `query-coding-warning-face'. It defaults to nil.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	435
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	436 This function returns a list; the intention is that callers use use
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	437 `multiple-value-bind' or the related CL multiple value functions to deal
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	438 with it. The first element is `t' if the string can be encoded using
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	439 CODING-SYSTEM, or `nil' if not. The second element is `nil' if the string
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	440 can be encoded using CODING-SYSTEM; otherwise, it is a range table
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	441 describing the positions of the unencodable characters. See
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	442 `make-range-table'."
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	443 (with-temp-buffer
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	444 (insert string)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	445 (query-coding-region (point-min) (point-max) coding-system (current-buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	446 ;; ### Will highlight work here?
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	447 errorp highlight)))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	448
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	449 (defun unencodable-char-position (start end coding-system
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	450 &optional count string)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	451 "Return position of first un-encodable character in a region.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	452 START and END specify the region and CODING-SYSTEM specifies the
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	453 encoding to check. Return nil if CODING-SYSTEM does encode the region.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	454
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	455 If optional 4th argument COUNT is non-nil, it specifies at most how
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	456 many un-encodable characters to search. In this case, the value is a
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	457 list of positions.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	458
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	459 If optional 5th argument STRING is non-nil, it is a string to search
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	460 for un-encodable characters. In that case, START and END are indexes
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	461 in the string."
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	462 (let ((thunk
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	463 #'(lambda (start end coding-system &optional count)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	464 (multiple-value-bind (result ranges)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	465 (query-coding-region start end coding-system)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	466 (if result
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	467 nil
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	468 (block worked-it-all-out
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	469 (if count
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	470 (map-range-table
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	471 #'(lambda (begin end value)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	472 (while (and (< begin end)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	473 (< (length result) count))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	474 (push begin result)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	475 (incf begin))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	476 (when (= (length result) count)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	477 (return-from worked-it-all-out result)))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	478 ranges)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	479 (map-range-table
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	480 #'(lambda (begin end value)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	481 (return-from worked-it-all-out begin))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	482 ranges))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	483 (assert (not (null count)) t
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	484 "We should never reach this point with null COUNT.")
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	485 result))))))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	486 (check-argument-type #'integer-or-marker-p start)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	487 (check-argument-type #'integer-or-marker-p end)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	488 (check-coding-system coding-system)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	489 (and count (check-argument-type #'natnump count)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	490 ;; Special-case zero, sigh.
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	491 (if (zerop count) (setq count 1)))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	492 (and string (check-argument-type #'stringp string))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	493 (if string
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	494 (with-temp-buffer
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	495 (insert string)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	496 (funcall thunk start end coding-system count))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	497 (funcall thunk start end coding-system count))))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	498
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	499 (defun encode-coding-char (char coding-system)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	500 "Encode CHAR by CODING-SYSTEM and return the resulting string.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	501 If CODING-SYSTEM can't safely encode CHAR, return nil."
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	502 (check-argument-type #'characterp char)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	503 (multiple-value-bind (succeededp)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	504 (query-coding-string char coding-system)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	505 (when succeededp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	506 (encode-coding-string char coding-system))))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	507
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	508 (unless (featurep 'mule)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	509 ;; If we're under non-Mule, every XEmacs character can be encoded
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	510 ;; with every XEmacs coding system.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	511 (fset #'default-query-coding-region
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	512 #'(lambda (&rest ignored) (values t nil)))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	513 (unintern 'default-query-coding-region-safe-charset-skip-chars-map))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	514
728 4d00488244c1 [xemacs-hg @ 2002-01-10 09:50:43 by stephent] stephent parents: 599 diff changeset	515 ;;; coding.el ends here

Mercurial > hg > xemacs-beta

annotate lisp/coding.el @ 4569:80e0588fb42f