lisp/nxml/nxml-enc.el

   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
 167 ;;; nxml-enc.el ends here