code.delx.au - gnu-emacs-elpa/blob - packages/muse/muse-import-xml.el

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