lisp/muse-import-xml.el

   1 ;;; muse-import-xml.el --- common to all from-xml converters
   2
   3 ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
   4
   5 ;; Author: Elena Pomohaci <e.pomohaci@gmail.com>
   6
   7 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   8
   9 ;; Emacs Muse is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published
  11 ;; by the Free Software Foundation; either version 2, or (at your
  12 ;; option) any later version.
  13
  14 ;; Emacs Muse is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with Emacs Muse; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Contributors:
  27
  28 ;;; Code:
  29
  30 (provide 'muse-import-xml)
  31
  32 (require 'xml)
  33
  34 (defvar muse-import-xml-prefix ""
  35   "The name prefix for tag functions")
  36
  37 (defvar muse-import-xml-generic-function-name "muse-import-xml-generic"
  38   "The generic function name")
  39
  40 (defun muse-import-xml-convert-to-list (buf)
  41   "Convert xml BUF in a xml-list"
  42   (with-temp-buffer
  43     (insert-buffer-substring buf)
  44     (goto-char (point-min))
  45     (while (re-search-forward ">[ \n\t]*<" nil t)
  46       (replace-match "><" nil nil)) ; clean all superfluous blank characters
  47     (xml-parse-region (point-min)
  48                       (point-max)
  49                       (current-buffer))))
  50
  51
  52 (defun muse-import-xml-generic (node)
  53   "The generic function called when there is no node specific function."
  54   (let ((name (xml-node-name node)))
  55     (insert "<" (symbol-name name)  ">")
  56     (muse-import-xml-node node)
  57     (insert "</" (symbol-name name) ">")))
  58
  59 (defun muse-import-xml-parse-tree (lst)
  60   "Parse an xml tree list"
  61   (mapc #'muse-import-xml-parse-node lst))
  62
  63 (defun muse-import-xml-parse-node (node)
  64   "Parse a xml tree node"
  65   (if (stringp node)
  66       (insert (replace-regexp-in-string "^[ \t]+" "" node))
  67     (let ((fname (intern-soft (concat muse-import-xml-prefix
  68                                       (symbol-name (xml-node-name node))))))
  69       (if (functionp fname)
  70           (funcall fname node)
  71         (funcall (intern muse-import-xml-generic-function-name) node)))))
  72
  73
  74 (defun muse-import-xml-node (node)
  75   "Default node function"
  76   (muse-import-xml-parse-tree (xml-node-children node)))
  77
  78
  79 (defun muse-import-xml (src dest)
  80   "Convert the xml SRC buffer in a muse DEST buffer"
  81   (set-buffer (get-buffer-create dest))
  82   (when (fboundp 'muse-mode)
  83     (muse-mode))
  84   (muse-import-xml-parse-tree (muse-import-xml-convert-to-list src)))
  85
  86 ;;; muse-import-xml.el ends here