Commit | Line | Data |
---|---|---|
8cd39fb3 MH |
1 | ;;; nxml-enc.el --- XML encoding auto-detection |
2 | ||
3 | ;; Copyright (C) 2003 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: James Clark | |
6 | ;; Keywords: XML | |
7 | ||
8 | ;; This program is free software; you can redistribute it and/or | |
9 | ;; modify it under the terms of the GNU General Public License as | |
10 | ;; published by the Free Software Foundation; either version 2 of | |
11 | ;; the License, or (at your option) any later version. | |
12 | ||
13 | ;; This program is distributed in the hope that it will be | |
14 | ;; useful, but WITHOUT ANY WARRANTY; without even the implied | |
15 | ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR | |
16 | ;; PURPOSE. See the GNU General Public License for more details. | |
17 | ||
18 | ;; You should have received a copy of the GNU General Public | |
19 | ;; License along with this program; if not, write to the Free | |
20 | ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, | |
21 | ;; MA 02111-1307 USA | |
22 | ||
23 | ;;; Commentary: | |
24 | ||
25 | ;; User entry points are nxml-start-auto-coding and | |
26 | ;; nxml-stop-auto-coding. This is separate from nxml-mode, because | |
27 | ;; this cannot be autoloaded. It may use | |
28 | ;; `xmltok-get-declared-encoding-position' which can be autoloaded. | |
29 | ;; It's separate from rng-auto.el so it can be byte-compiled, and | |
30 | ;; because it provides independent, useful functionality. | |
31 | ||
32 | ;;; Code: | |
33 | ||
34 | (defvar nxml-file-name-ignore-case | |
35 | (memq system-type '(vax-vms windows-nt))) | |
36 | ||
37 | (defvar nxml-cached-file-name-auto-coding-regexp nil) | |
38 | (defvar nxml-cached-auto-mode-alist nil) | |
39 | ||
40 | (defun nxml-file-name-auto-coding-regexp () | |
41 | "Return regexp for filenames for which XML auto-coding should be done." | |
42 | (if (eq auto-mode-alist nxml-cached-auto-mode-alist) | |
43 | nxml-cached-file-name-auto-coding-regexp | |
44 | (let ((alist auto-mode-alist) | |
45 | (case-fold-search nxml-file-name-ignore-case) | |
46 | regexps) | |
47 | (setq nxml-cached-auto-mode-alist alist) | |
48 | (while alist | |
49 | (when (eq (cdar alist) 'nxml-mode) | |
50 | (setq regexps (cons (caar alist) regexps))) | |
51 | (setq alist (cdr alist))) | |
52 | (setq nxml-cached-file-name-auto-coding-regexp | |
53 | (if (null (cdr regexps)) | |
54 | (car regexps) | |
55 | (mapconcat (lambda (r) | |
56 | (concat "\\(?:" r "\\)")) | |
57 | regexps | |
58 | "\\|")))))) | |
59 | ||
60 | (defvar nxml-non-xml-set-auto-coding-function nil | |
61 | "The function that `set-auto-coding-function' should call for non-XML files.") | |
62 | (defun nxml-set-auto-coding (file-name size) | |
63 | (if (let ((case-fold-search nxml-file-name-ignore-case) | |
64 | (regexp (nxml-file-name-auto-coding-regexp))) | |
65 | (and regexp | |
66 | (string-match regexp file-name))) | |
67 | (nxml-set-xml-coding file-name size) | |
68 | (and nxml-non-xml-set-auto-coding-function | |
69 | (funcall nxml-non-xml-set-auto-coding-function file-name size)))) | |
70 | ||
71 | (defun nxml-set-xml-coding (file-name size) | |
72 | "Function to use as `set-auto-coding-function' when file is known to be XML." | |
73 | (nxml-detect-coding-system (+ (point) (min size 1024)))) | |
74 | ||
75 | (defun nxml-detect-coding-system (limit) | |
76 | (if (< limit (+ (point) 2)) | |
77 | (if (eq (char-after) 0) 'no-conversion 'utf-8) | |
78 | (let ((first-two-chars (list (char-after) | |
79 | (char-after (1+ (point)))))) | |
80 | (cond ((equal first-two-chars '(#xFE #xFF)) | |
81 | (and (coding-system-p 'utf-16-be) 'utf-16-be)) | |
82 | ((equal first-two-chars '(#xFF #xFE)) | |
83 | (and (coding-system-p 'utf-16-le) 'utf-16-le)) | |
84 | ((memq 0 first-two-chars) | |
85 | ;; Certainly not well-formed XML; | |
86 | ;; perhaps UTF-16 without BOM. | |
87 | ;; In any case, we can't handle it. | |
88 | ;; no-conversion gives the user a chance to fix it. | |
89 | 'no-conversion) | |
90 | ;; There are other things we might try here in the future | |
91 | ;; eg UTF-8 BOM, UTF-16 with no BOM | |
92 | ;; translate to EBCDIC | |
93 | (t | |
94 | (let ((enc-pos (xmltok-get-declared-encoding-position limit))) | |
95 | (cond ((consp enc-pos) | |
96 | (or (nxml-mime-charset-coding-system | |
97 | (buffer-substring-no-properties (car enc-pos) | |
98 | (cdr enc-pos))) | |
99 | ;; We have an encoding whose name we don't recognize. | |
100 | ;; What to do? | |
101 | ;; raw-text seems the best bet: since we got | |
102 | ;; the XML decl it must be a superset of ASCII, | |
103 | ;; so we don't need to go to no-conversion | |
104 | 'raw-text)) | |
105 | (enc-pos 'utf-8) | |
106 | ;; invalid XML declaration | |
107 | (t nil)))))))) | |
108 | ||
109 | (defun nxml-mime-charset-coding-system (charset) | |
110 | (let ((charset-sym (intern (downcase charset))) | |
111 | (coding-systems (coding-system-list t)) | |
112 | coding-system ret) | |
113 | (while (and coding-systems (not ret)) | |
114 | (setq coding-system (car coding-systems)) | |
115 | (if (eq (coding-system-get coding-system 'mime-charset) | |
116 | charset-sym) | |
117 | (setq ret coding-system) | |
118 | (setq coding-systems (cdr coding-systems)))) | |
119 | ret)) | |
120 | ||
121 | (defun nxml-start-auto-coding () | |
122 | "Do encoding auto-detection as specified in the XML standard. | |
123 | Applied to any files that `auto-mode-alist' says should be handled by | |
124 | `nxml-mode'." | |
125 | (interactive) | |
126 | (unless (eq set-auto-coding-function 'nxml-set-auto-coding) | |
127 | (let ((inhibit-quit t)) | |
128 | (setq nxml-non-xml-set-auto-coding-function set-auto-coding-function) | |
129 | (setq set-auto-coding-function 'nxml-set-auto-coding)))) | |
130 | ||
131 | (defun nxml-stop-auto-coding () | |
132 | "Stop doing encoding auto-detection as specified in the XML standard." | |
133 | (interactive) | |
134 | (when (eq set-auto-coding-function 'nxml-set-auto-coding) | |
135 | (let ((inhibit-quit t)) | |
136 | (setq set-auto-coding-function nxml-non-xml-set-auto-coding-function) | |
137 | (setq nxml-non-xml-set-auto-coding-function nil)))) | |
138 | ||
139 | (unless (coding-system-p 'us-ascii) | |
140 | (make-coding-system | |
141 | ;; Unicode Emacs uses ?- last time I looked | |
142 | 'us-ascii 2 ?- | |
143 | "ISO 2022 based 7-bit encoding for ASCII (MIME:US-ASCII)" | |
144 | '(ascii) | |
145 | '((safe-charsets ascii) | |
146 | (mime-charset . us-ascii)))) | |
147 | ||
148 | ;; Emacs 21.3.50 makes us-ascii an alias for iso-safe without | |
149 | ;; giving it a mime-charset property. | |
150 | (unless (coding-system-get 'us-ascii 'mime-charset) | |
151 | (coding-system-put 'us-ascii 'mime-charset 'us-ascii)) | |
152 | ||
153 | ;; Work around bug in Emacs 21.3 | |
154 | ||
155 | (when (and (coding-system-p 'utf-16-le) | |
156 | (eq (coding-system-get 'utf-16-le 'pre-write-conversion) | |
157 | 'utf-16-le-pre-write-conversion)) | |
158 | (coding-system-put 'utf-16-le 'pre-write-conversion nil)) | |
159 | ||
160 | (when (and (coding-system-p 'utf-16-le) | |
161 | (eq (coding-system-get 'utf-16-be 'pre-write-conversion) | |
162 | 'utf-16-be-pre-write-conversion)) | |
163 | (coding-system-put 'utf-16-be 'pre-write-conversion nil)) | |
164 | ||
165 | (provide 'nxml-enc) | |
166 | ||
ab4c34c6 | 167 | ;; arch-tag: c2436247-78f3-418c-8069-85dc5335d083 |
8cd39fb3 | 168 | ;;; nxml-enc.el ends here |