lisp/nxml/nxml-enc.el

   1 ;;; nxml-enc.el --- XML encoding auto-detection
   2
   3 ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: James Clark
   6 ;; Keywords: XML
   7
   8 ;; This file is part of GNU Emacs.
   9
  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 of the License, or
  13 ;; (at your option) any later version.
  14
  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.  If not, see <http://www.gnu.org/licenses/>.
  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 (declare-function xmltok-get-declared-encoding-position "xmltok"
  76                   (&optional limit))    ; autoloaded
  77
  78 (defun nxml-detect-coding-system (limit)
  79   (if (< limit (+ (point) 2))
  80       (if (eq (char-after) 0) 'no-conversion 'utf-8)
  81     (let ((first-two-chars (list (char-after)
  82                                  (char-after (1+ (point))))))
  83       (cond ((equal first-two-chars '(#xFE #xFF))
  84              (and (coding-system-p 'utf-16-be) 'utf-16-be))
  85             ((equal first-two-chars '(#xFF #xFE))
  86              (and (coding-system-p 'utf-16-le) 'utf-16-le))
  87             ((memq 0 first-two-chars)
  88              ;; Certainly not well-formed XML;
  89              ;; perhaps UTF-16 without BOM.
  90              ;; In any case, we can't handle it.
  91              ;; no-conversion gives the user a chance to fix it.
  92              'no-conversion)
  93             ;; There are other things we might try here in the future
  94             ;; eg UTF-8 BOM, UTF-16 with no BOM
  95             ;; translate to EBCDIC
  96             (t
  97              (let ((enc-pos (xmltok-get-declared-encoding-position limit)))
  98                (cond ((consp enc-pos)
  99                       (or (nxml-mime-charset-coding-system
 100                            (buffer-substring-no-properties (car enc-pos)
 101                                                            (cdr enc-pos)))
 102                           ;; We have an encoding whose name we don't recognize.
 103                           ;; What to do?
 104                           ;; raw-text seems the best bet: since we got
 105                           ;; the XML decl it must be a superset of ASCII,
 106                           ;; so we don't need to go to no-conversion
 107                           'raw-text))
 108                      (enc-pos 'utf-8)
 109                      ;; invalid XML declaration
 110                      (t nil))))))))
 111
 112 (defun nxml-mime-charset-coding-system (charset)
 113   (let ((charset-sym (intern (downcase charset)))
 114         (coding-systems (coding-system-list t))
 115         coding-system ret)
 116     (while (and coding-systems (not ret))
 117       (setq coding-system (car coding-systems))
 118       (if (eq (coding-system-get coding-system 'mime-charset)
 119               charset-sym)
 120           (setq ret coding-system)
 121         (setq coding-systems (cdr coding-systems))))
 122     ret))
 123
 124 (defun nxml-start-auto-coding ()
 125   "Do encoding auto-detection as specified in the XML standard.
 126 Applied to any files that `auto-mode-alist' says should be handled by
 127 `nxml-mode'."
 128   (interactive)
 129   (unless (eq set-auto-coding-function 'nxml-set-auto-coding)
 130     (let ((inhibit-quit t))
 131       (setq nxml-non-xml-set-auto-coding-function set-auto-coding-function)
 132       (setq set-auto-coding-function 'nxml-set-auto-coding))))
 133
 134 (defun nxml-stop-auto-coding ()
 135   "Stop doing encoding auto-detection as specified in the XML standard."
 136   (interactive)
 137   (when (eq set-auto-coding-function 'nxml-set-auto-coding)
 138     (let ((inhibit-quit t))
 139       (setq set-auto-coding-function nxml-non-xml-set-auto-coding-function)
 140       (setq nxml-non-xml-set-auto-coding-function nil))))
 141
 142 (unless (coding-system-p 'us-ascii)
 143   (make-coding-system
 144    ;; Unicode Emacs uses ?- last time I looked
 145    'us-ascii 2 ?-
 146    "ISO 2022 based 7-bit encoding for ASCII (MIME:US-ASCII)"
 147    '(ascii)
 148    '((safe-charsets ascii)
 149      (mime-charset . us-ascii))))
 150
 151 ;; Emacs 21.3.50 makes us-ascii an alias for iso-safe without
 152 ;; giving it a mime-charset property.
 153 (unless (coding-system-get 'us-ascii 'mime-charset)
 154   (coding-system-put 'us-ascii 'mime-charset 'us-ascii))
 155
 156 ;; Work around bug in Emacs 21.3
 157
 158 (when (and (coding-system-p 'utf-16-le)
 159            (eq (coding-system-get 'utf-16-le 'pre-write-conversion)
 160                'utf-16-le-pre-write-conversion))
 161   (coding-system-put 'utf-16-le 'pre-write-conversion nil))
 162
 163 (when (and (coding-system-p 'utf-16-le)
 164            (eq (coding-system-get 'utf-16-be 'pre-write-conversion)
 165                'utf-16-be-pre-write-conversion))
 166   (coding-system-put 'utf-16-be 'pre-write-conversion nil))
 167
 168 (provide 'nxml-enc)
 169
 170 ;; arch-tag: c2436247-78f3-418c-8069-85dc5335d083
 171 ;;; nxml-enc.el ends here