lisp/nxml/nxml-util.el

   1 ;;; nxml-util.el --- utility functions for nxml-*.el
   2
   3 ;; Copyright (C) 2003, 2007-2013 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 ;;; Code:
  26
  27 (defconst nxml-debug nil
  28   "Enable nxml debugging.  Effective only at compile time.")
  29
  30 (defsubst nxml-debug (format &rest args)
  31   (when nxml-debug
  32     (apply #'message format args)))
  33
  34 (defmacro nxml-debug-change (name start end)
  35   (when nxml-debug
  36     `(nxml-debug "%s: %S" ,name
  37                 (buffer-substring-no-properties ,start ,end))))
  38
  39 (defmacro nxml-debug-set-inside (start end)
  40   (when nxml-debug
  41     `(let ((overlay (make-overlay ,start ,end)))
  42        (overlay-put overlay 'face '(:background "red"))
  43        (overlay-put overlay 'nxml-inside-debug t)
  44        (nxml-debug-change "nxml-set-inside" ,start ,end))))
  45
  46 (defmacro nxml-debug-clear-inside (start end)
  47   (when nxml-debug
  48     `(loop for overlay in (overlays-in ,start ,end)
  49            if (overlay-get overlay 'nxml-inside-debug)
  50            do (delete-overlay overlay)
  51            finally (nxml-debug-change "nxml-clear-inside" ,start ,end))))
  52
  53 (defun nxml-make-namespace (str)
  54   "Return a symbol for the namespace URI STR.
  55 STR must be a string.  If STR is the empty string, return nil.
  56 Otherwise, return the symbol whose name is STR prefixed with a colon."
  57   (if (string-equal str "")
  58       nil
  59     (intern (concat ":" str))))
  60
  61 (defun nxml-namespace-name (ns)
  62   "Return the namespace URI corresponding to the symbol NS.
  63 This is the inverse of `nxml-make-namespace'."
  64   (and ns (substring (symbol-name ns) 1)))
  65
  66 (defconst nxml-xml-namespace-uri
  67   (nxml-make-namespace "http://www.w3.org/XML/1998/namespace"))
  68
  69 (defconst nxml-xmlns-namespace-uri
  70   (nxml-make-namespace "http://www.w3.org/2000/xmlns/"))
  71
  72 (defmacro nxml-with-degradation-on-error (context &rest body)
  73   (if (not nxml-debug)
  74       (let ((error-symbol (make-symbol "err")))
  75         `(condition-case ,error-symbol
  76              (progn ,@body)
  77            (error
  78             (nxml-degrade ,context ,error-symbol))))
  79     `(progn ,@body)))
  80
  81 (defmacro nxml-with-invisible-motion (&rest body)
  82   "Evaluate body without calling any point motion hooks."
  83   `(let ((inhibit-point-motion-hooks t))
  84      ,@body))
  85
  86 (put 'nxml-with-invisible-motion 'lisp-indent-function 0)
  87 (def-edebug-spec nxml-with-invisible-motion t)
  88
  89 (defun nxml-display-file-parse-error (err)
  90   (let* ((filename (nth 1 err))
  91          (buffer (find-file-noselect filename))
  92          (pos (nth 2 err))
  93          (message (nth 3 err)))
  94     (pop-to-buffer buffer)
  95     ;; What's the right thing to do if the buffer's modified?
  96     ;; The position in the saved file could be completely different.
  97     (goto-char (if (buffer-modified-p) 1 pos))
  98     (error "%s" message)))
  99
 100 (defun nxml-signal-file-parse-error (file pos message &optional error-symbol)
 101   (signal (or error-symbol 'nxml-file-parse-error)
 102           (list file pos message)))
 103
 104 (put 'nxml-file-parse-error
 105      'error-conditions
 106      '(error nxml-file-parse-error))
 107
 108 (put 'nxml-parse-file-error
 109      'error-message
 110      "Error parsing file")
 111
 112 (provide 'nxml-util)
 113
 114 ;;; nxml-util.el ends here