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, or (at your option)
  13 ;; 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; 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.
  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
  77 (declare-function xmltok-get-declared-encoding-position "xmltok"
  78                   (&optional limit))    ; autoloaded
  79
  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
 172 ;; arch-tag: c2436247-78f3-418c-8069-85dc5335d083
 173 ;;; nxml-enc.el ends here