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