lisp/muse-import-xml.el

   1 ;;; muse-import-xml.el --- common to all from-xml converters
   2
   3 ;; Copyright (C) 2006, 2007, 2008, 2009  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 3, 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 (require 'muse)
  34
  35 (defvar muse-import-xml-prefix ""
  36   "The name prefix for tag functions")
  37
  38 (defvar muse-import-xml-generic-function-name "muse-import-xml-generic"
  39   "The generic function name")
  40
  41 (defun muse-import-xml-convert-to-list (buf)
  42   "Convert xml BUF in a xml-list"
  43   (with-temp-buffer
  44     (insert-buffer-substring buf)
  45     (goto-char (point-min))
  46     (while (re-search-forward ">[ \n\t]*<" nil t)
  47       (replace-match "><" nil nil)) ; clean all superfluous blank characters
  48     (xml-parse-region (point-min)
  49                       (point-max)
  50                       (current-buffer))))
  51
  52
  53 (defun muse-import-xml-generic (node)
  54   "The generic function called when there is no node specific function."
  55   (let ((name (xml-node-name node)))
  56     (insert "<" (symbol-name name)  ">")
  57     (muse-import-xml-node node)
  58     (insert "</" (symbol-name name) ">")))
  59
  60 (defun muse-import-xml-parse-tree (lst)
  61   "Parse an xml tree list"
  62   (mapc #'muse-import-xml-parse-node lst))
  63
  64 (defun muse-import-xml-parse-node (node)
  65   "Parse a xml tree node"
  66   (if (stringp node)
  67       (insert (muse-replace-regexp-in-string "^[ \t]+" "" node))
  68     (let ((fname (intern-soft (concat muse-import-xml-prefix
  69                                       (symbol-name (xml-node-name node))))))
  70       (if (functionp fname)
  71           (funcall fname node)
  72         (funcall (intern muse-import-xml-generic-function-name) node)))))
  73
  74
  75 (defun muse-import-xml-node (node)
  76   "Default node function"
  77   (muse-import-xml-parse-tree (xml-node-children node)))
  78
  79
  80 (defun muse-import-xml (src dest)
  81   "Convert the xml SRC buffer in a muse DEST buffer"
  82   (set-buffer (get-buffer-create dest))
  83   (when (fboundp 'muse-mode)
  84     (muse-mode))
  85   (muse-import-xml-parse-tree (muse-import-xml-convert-to-list src)))
  86
  87 ;;; muse-import-xml.el ends here