xemacs-beta: lisp/coding.el annotate

annotate lisp/coding.el @ 4614:afbfad080ddd

The URLs in our current config.guess and config.sub files are obsolete. Update to the latest upstream release to get correct URLs, as well as fixes and enhancements to those scripts.

author	Jerry James <james@xemacs.org>
date	Wed, 11 Feb 2009 11:09:35 -0700
parents	33b8c874b2c8
children	8cbca852bcd4

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
4597 7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	246 ;;; Make certain variables equivalent to coding-system aliases:
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	247 (macrolet
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	248 ((force-coding-system-equivalency (&rest details-list)
4599 0347879667ed Document the force-coding-system-equivalency macro in coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4598 diff changeset	249 "Certain coding-system aliases should correspond to certain variables.
0347879667ed Document the force-coding-system-equivalency macro in coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4598 diff changeset	250
0347879667ed Document the force-coding-system-equivalency macro in coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4598 diff changeset	251 This macro implements that correspondence. This gives us compatiblity with
0347879667ed Document the force-coding-system-equivalency macro in coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4598 diff changeset	252 other Mule implementations (which don't use the coding system aliases), and
0347879667ed Document the force-coding-system-equivalency macro in coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4598 diff changeset	253 a certain amount of freedom of implementation for XEmacs; using a variable's
0347879667ed Document the force-coding-system-equivalency macro in coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4598 diff changeset	254 value in C for every file operation or write to a terminal in C is probably
0347879667ed Document the force-coding-system-equivalency macro in coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4598 diff changeset	255 an improvement on the hash-table lookup(s) necessary for a coding system
0347879667ed Document the force-coding-system-equivalency macro in coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4598 diff changeset	256 alias, though we haven't profiled this yet to see if it makes a difference."
4597 7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	257 (loop for (alias variable-symbol)
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	258 in details-list
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	259 with result = (list 'progn)
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	260 do
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	261 (push
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	262 `(dontusethis-set-symbol-value-handler ',variable-symbol
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	263 'set-value #'(lambda (sym args fun harg handlers)
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	264 (define-coding-system-alias ',alias
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	265 (or (car args) 'binary))))
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	266 result)
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	267 finally return (nreverse result))))
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	268 (force-coding-system-equivalency
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	269 (file-name file-name-coding-system)
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	270 (terminal terminal-coding-system)
7191a7b120f1 Some cosmetic namespace cleanup, glyphs.el, coding.el. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	271 (keyboard keyboard-coding-system)))
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	272
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	273 (when (not (featurep 'mule))
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 728 diff changeset	274 (define-coding-system-alias 'escape-quoted 'binary)
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	275 ;; 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	276 (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	277 ;; 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	278 ;; both.
4227 dd9c1d5f5319 [xemacs-hg @ 2007-10-15 10:53:33 by aidan] aidan parents: 4222 diff changeset	279 ; (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	280 (define-coding-system-alias 'ctext 'raw-text))
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 428 diff changeset	281
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	282 (make-compatible-variable 'enable-multibyte-characters "Unimplemented")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	283
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	284 ;; 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	285 (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	286
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	287 (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	288 #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	289 "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	290
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	291 (defsubst query-coding-clear-highlights (begin end &optional buffer-or-string)
4555 20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	292 "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	293
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	294 Optional argument BUFFER-OR-STRING is the buffer or string to use, and
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	295 defaults to the current buffer.
4555 20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	296
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	297 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	298 display unencodable characters using `query-coding-warning-face'. After
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	299 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	300 (map-extents #'(lambda (extent ignored-arg)
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	301 (when (eq 'query-coding-warning-face
20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	302 (extent-face extent))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	303 (delete-extent extent))) buffer-or-string begin end))
4555 20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	304
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	305 (defun* default-query-coding-region (begin end coding-system
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	306 &optional buffer ignore-invalid-sequencesp
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	307 errorp highlightp)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	308 "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	309
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	310 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	311 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	312 encoded by CODING-SYSTEM; the latter a char table describing, in
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	313 addition, characters that can be safely encoded by CODING-SYSTEM.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	314
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	315 Does not support IGNORE-INVALID-SEQUENCESP."
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	316 (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	317 (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	318 (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	319 (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	320 (let* ((safe-charsets
4551 6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	321 (or (coding-system-get coding-system 'safe-charsets)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	322 (coding-system-get (coding-system-base coding-system)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	323 'safe-charsets)))
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	324 (safe-chars
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	325 (or (coding-system-get coding-system 'safe-chars)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	326 (coding-system-get (coding-system-base coding-system)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	327 'safe-chars)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	328 (skip-chars-arg
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	329 (gethash safe-charsets
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	330 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	331 (ranges (make-range-table))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	332 (case-fold-search nil)
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	333 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	334 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	335 ;; 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	336 (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	337 (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	338 (unless skip-chars-arg
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	339 (setq skip-chars-arg
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	340 (puthash safe-charsets
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	341 (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	342 safe-charsets "")
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	343 default-query-coding-region-safe-charset-skip-chars-map)))
4551 6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	344 (when highlightp
4555 20c32e489235 Add #'query-coding-clear-highlights. Aidan Kehoe <kehoea@parhasard.net> parents: 4553 diff changeset	345 (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	346 (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	347 (progn
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	348 ;; 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	349 (when errorp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	350 (error 'text-conversion-error
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	351 "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	352 (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	353 (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	354 (when highlightp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	355 (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	356 (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	357 (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	358 (values nil ranges))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	359 (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	360 ;; 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	361 #r".\{0,0\}"
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	362 (concat "[" skip-chars-arg "]")))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	363 (save-excursion
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	364 (goto-char begin buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	365 (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	366 (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	367 ; (message
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	368 ; "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	369 ; 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	370 (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	371 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	372 (while (and
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	373 (< (point buffer) end)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	374 (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	375 (or (not safe-chars)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	376 (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	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 (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	379 failed t))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	380 (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	381 ;; 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	382 ;; 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	383 (forward-char 1 buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	384 ;; 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	385 (when errorp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	386 (error 'text-conversion-error
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	387 (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	388 (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	389 buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	390 (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	391 (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	392 ;; 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	393 ;; 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	394 (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	395 (point buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	396 (point-max buffer)))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	397 t ranges)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	398 (when highlightp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	399 (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	400 (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	401 (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	402 (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	403 (if failed
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	404 (values nil ranges)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	405 (values t nil))))))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	406
4596 4fc32a3a086e Fix a couple of bugs, #'query-coding-region, #'query-coding-string. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	407 (defun query-coding-region (start end coding-system &optional buffer
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	408 ignore-invalid-sequencesp errorp highlight)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	409 "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	410
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	411 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	412 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	413
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	414 Optional argument BUFFER is the buffer to check, and defaults to the current
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	415 buffer.
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	416
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	417 IGNORE-INVALID-SEQUENCESP, also an optional argument, says to treat XEmacs
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	418 characters which have an unambiguous encoded representation, despite being
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	419 undefined in what they represent, as encodable. These chiefly arise with
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	420 variable-length encodings like UTF-8 and UTF-16, where an invalid sequence
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	421 is passed through to XEmacs as a sequence of characters with a defined
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	422 correspondence to the octets on disk, but no non-error semantics; see the
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	423 `invalid-sequence-coding-system' argument to `set-language-info'.
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	424
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	425 They can also arise with fixed-length encodings like ISO 8859-7, where
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	426 certain octets on disk have undefined values, and treating them as
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	427 corresponding to the ISO 8859-1 characters with the same numerical values
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	428 may lead to data that is not understood by other applications.
4549 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
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	436 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	437 `multiple-value-bind' or the related CL multiple value functions to deal
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	438 with it. The first element is `t' if the region can be encoded using
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	439 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	440 can be encoded using CODING-SYSTEM; otherwise, it is a range table
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	441 describing the positions of the unencodable characters. Ranges that
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	442 describe characters that would be ignored were IGNORE-INVALID-SEQUENCESP
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	443 non-nil map to the symbol `invalid-sequence'; other ranges map to the symbol
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	444 `unencodable'. If IGNORE-INVALID-SEQUENCESP is non-nil, all ranges will map
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	445 to the symbol `unencodable'. See `make-range-table' for more details of
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	446 range tables."
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	447 (funcall (or (coding-system-get coding-system 'query-coding-function)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	448 #'default-query-coding-region)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	449 start end coding-system buffer ignore-invalid-sequencesp errorp
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	450 highlight))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	451
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	452 (define-compiler-macro query-coding-region (start end coding-system
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	453 &optional buffer
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	454 ignore-invalid-sequencesp
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	455 errorp highlight)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	456 `(funcall (or (coding-system-get ,coding-system 'query-coding-function)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	457 #'default-query-coding-region)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	458 ,start ,end ,coding-system ,@(append (when (or buffer
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	459 ignore-invalid-sequencesp
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	460 errorp highlight)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	461 (list buffer))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	462 (when (or ignore-invalid-sequencesp
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	463 errorp highlight)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	464 (list ignore-invalid-sequencesp))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	465 (when (or errorp highlight)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	466 (list errorp))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	467 (when highlight (list highlight)))))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	468
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	469 (defun query-coding-string (string coding-system &optional
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	470 ignore-invalid-sequencesp errorp highlight)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	471 "Work out whether CODING-SYSTEM can losslessly encode STRING.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	472 CODING-SYSTEM is the coding system to check.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	473
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	474 IGNORE-INVALID-SEQUENCESP, an optional argument, says to treat XEmacs
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	475 characters which have an unambiguous encoded representation, despite being
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	476 undefined in what they represent, as encodable. These chiefly arise with
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	477 variable-length encodings like UTF-8 and UTF-16, where an invalid sequence
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	478 is passed through to XEmacs as a sequence of characters with a defined
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	479 correspondence to the octets on disk, but no non-error semantics; see the
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	480 `invalid-sequence-coding-system' argument to `set-language-info'.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	481
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	482 They can also arise with fixed-length encodings like ISO 8859-7, where
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	483 certain octets on disk have undefined values, and treating them as
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	484 corresponding to the ISO 8859-1 characters with the same numerical values
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	485 may lead to data that is not understood by other applications.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	486
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	487 Optional argument ERRORP says to signal a `text-conversion-error' if some
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	488 character in the region cannot be encoded, and defaults to nil.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	489
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	490 Optional argument HIGHLIGHT says to display unencodable characters in the
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	491 region using `query-coding-warning-face'. It defaults to nil.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	492
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	493 This function returns a list; the intention is that callers use
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	494 `multiple-value-bind' or the related CL multiple value functions to deal
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	495 with it. The first element is `t' if the region can be encoded using
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	496 CODING-SYSTEM, or `nil' if not. The second element is `nil' if the region
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	497 can be encoded using CODING-SYSTEM; otherwise, it is a range table
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	498 describing the positions of the unencodable characters. Ranges that
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	499 describe characters that would be ignored were IGNORE-INVALID-SEQUENCESP
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	500 non-nil map to the symbol `invalid-sequence'; other ranges map to the symbol
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	501 `unencodable'. If IGNORE-INVALID-SEQUENCESP is non-nil, all ranges will map
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	502 to the symbol `unencodable'. See `make-range-table' for more details of
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	503 range tables."
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	504 (with-temp-buffer
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	505 (when highlight
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	506 (query-coding-clear-highlights 0 (length string) string))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	507 (insert string)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	508 (multiple-value-bind (result ranges extent)
4596 4fc32a3a086e Fix a couple of bugs, #'query-coding-region, #'query-coding-string. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	509 (query-coding-region (point-min) (point-max) coding-system
4609 33b8c874b2c8 Correct string offset and arg handling, #'query-coding-string and related. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	510 (current-buffer) ignore-invalid-sequencesp
33b8c874b2c8 Correct string offset and arg handling, #'query-coding-string and related. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	511 errorp)
4596 4fc32a3a086e Fix a couple of bugs, #'query-coding-region, #'query-coding-string. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	512 (unless result
4fc32a3a086e Fix a couple of bugs, #'query-coding-region, #'query-coding-string. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	513 (map-range-table
4fc32a3a086e Fix a couple of bugs, #'query-coding-region, #'query-coding-string. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	514 #'(lambda (begin end value)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	515 ;; Sigh, string indices are zero-based, buffer offsets are
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	516 ;; one-based.
4596 4fc32a3a086e Fix a couple of bugs, #'query-coding-region, #'query-coding-string. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	517 (remove-range-table begin end ranges)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	518 (put-range-table (decf begin) (decf end) value ranges)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	519 (when highlight
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	520 (setq extent (make-extent begin end string))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	521 (set-extent-priority extent (+ mouse-highlight-priority 2))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	522 (set-extent-property extent 'duplicable t)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4599 diff changeset	523 (set-extent-face extent 'query-coding-warning-face)))
4596 4fc32a3a086e Fix a couple of bugs, #'query-coding-region, #'query-coding-string. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	524 ranges))
4fc32a3a086e Fix a couple of bugs, #'query-coding-region, #'query-coding-string. Aidan Kehoe <kehoea@parhasard.net> parents: 4570 diff changeset	525 (values result ranges))))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	526
4570 e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	527 ;; Function docstring and API are taken from GNU coding.c version 1.353, GPLv2.
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	528 (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	529 &optional count string)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	530 "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	531 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	532 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	533
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	534 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	535 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	536 list of positions.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	537
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	538 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	539 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	540 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	541 (let ((thunk
4609 33b8c874b2c8 Correct string offset and arg handling, #'query-coding-string and related. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	542 #'(lambda (start end coding-system stringp count)
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	543 (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	544 (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	545 (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	546 nil
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	547 (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	548 (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	549 (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	550 #'(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	551 (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	552 (< (length result) count))
4609 33b8c874b2c8 Correct string offset and arg handling, #'query-coding-string and related. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	553 (push (if stringp (1- begin) begin) result)
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	554 (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	555 (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	556 (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	557 ranges)
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	558 (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	559 #'(lambda (begin end value)
4609 33b8c874b2c8 Correct string offset and arg handling, #'query-coding-string and related. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	560 (return-from worked-it-all-out
33b8c874b2c8 Correct string offset and arg handling, #'query-coding-string and related. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	561 (if stringp (1- begin) begin)))
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	562 ranges))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	563 (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	564 "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	565 result))))))
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	566 (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	567 (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	568 (check-coding-system coding-system)
4570 e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	569 (when count (check-argument-type #'natnump count)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	570 ;; Special-case zero, sigh.
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	571 (if (zerop count) (setq count 1)))
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4564 diff changeset	572 (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	573 (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	574 (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	575 (insert string)
4609 33b8c874b2c8 Correct string offset and arg handling, #'query-coding-string and related. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	576 (funcall thunk (1+ start) (1+ end) coding-system t count))
33b8c874b2c8 Correct string offset and arg handling, #'query-coding-string and related. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	577 (funcall thunk start end coding-system nil count))))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	578
4570 e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	579 ;; XEmacs; this is a GPLv3 function in coding.c in GNU. This is why we have
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	580 ;; both a very divergent docstring and a very divergent implementation.
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	581 (defun check-coding-systems-region (begin end coding-system-list)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	582 "Can coding systems in CODING-SYSTEM-LIST encode text in a region?
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	583
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	584 CODING-SYSTEM-LIST must be a list of coding systems. BEGIN and END are
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	585 normally buffer positions delimiting the region. If some coding system in
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	586 CODING-SYSTEM-LIST cannot encode the entire region, the return value of this
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	587 function is an alist mapping coding system names to lists of individual
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	588 buffer positions (not ranges) that the individual coding systems cannot
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	589 encode.
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	590
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	591 If all coding systems in CODING-SYSTEM-LIST can encode the region,
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	592 this function returns t. This conflicts with the documented, but not
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	593 with the observed, GNU behavior.
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	594
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	595 If BEGIN is a string, `check-coding-systems-region' ignores END, and checks
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	596 whether the coding systems can encode BEGIN. The alist that is returned
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	597 uses zero-based string indices, not one-based buffer positions.
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	598
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	599 This function is for GNU compatibility. See also `query-coding-region'."
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	600 (let ((thunk
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	601 #'(lambda (begin end coding-system-list stringp)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	602 (loop
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	603 for coding-system in coding-system-list
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	604 with result = nil
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	605 with intermediate = nil
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	606 with range-lambda = (if stringp
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	607 #'(lambda (begin end value)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	608 (while (< begin end)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	609 (push (1- begin) intermediate)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	610 (incf begin)))
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	611 #'(lambda (begin end value)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	612 (while (< begin end)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	613 (push begin intermediate)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	614 (incf begin))))
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	615 do (setq coding-system (check-coding-system coding-system))
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	616 (multiple-value-bind (encoded ranges)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	617 (query-coding-region begin end coding-system)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	618 (unless encoded
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	619 (setq intermediate (list (coding-system-name coding-system)))
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	620 (map-range-table range-lambda ranges)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	621 (push (nreverse intermediate) result)))
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	622 finally return (or result t)))))
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	623 (if (stringp begin)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	624 (with-temp-buffer
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	625 (insert begin)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	626 (funcall thunk (point-min) (point-max) coding-system-list t))
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	627 (check-argument-type #'integer-or-marker-p begin)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	628 (check-argument-type #'integer-or-marker-p end)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	629 (funcall thunk begin end coding-system-list nil))))
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	630
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	631 ;; XEmacs; docstring taken from GNU, international/mule-cmds.el, revision
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	632 ;; 1.311, GPLv2.
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	633 (defun encode-coding-char (char coding-system &optional charset)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	634 "Encode CHAR by CODING-SYSTEM and return the resulting string.
4570 e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	635 If CODING-SYSTEM can't safely encode CHAR, return nil.
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	636 The optional third argument CHARSET is, for the moment, ignored."
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	637 (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	638 (multiple-value-bind (succeededp)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	639 (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	640 (when succeededp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	641 (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	642
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	643 (unless (featurep 'mule)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	644 ;; 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	645 ;; 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	646 (fset #'default-query-coding-region
4570 e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	647 #'(lambda (&rest ignored)
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	648 "Stub `query-coding-region' implementation. Always succeeds."
e6a7054a9c30 Add check-coding-systems-region, test it and others, fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	649 (values t nil)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4227 diff changeset	650 (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	651
728 4d00488244c1 [xemacs-hg @ 2002-01-10 09:50:43 by stephent] stephent parents: 599 diff changeset	652 ;;; coding.el ends here

Mercurial > hg > xemacs-beta

annotate lisp/coding.el @ 4614:afbfad080ddd