;;; org-freemind.el --- Export Org files to freemind
;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see .
;; --------------------------------------------------------------------
;; Features that might be required by this library:
;;
;; `backquote', `bytecomp', `cl', `easymenu', `font-lock',
;; `noutline', `org', `org-compat', `org-faces', `org-footnote',
;; `org-list', `org-macs', `org-src', `outline', `syntax',
;; `time-date', `xml'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; This file tries to implement some functions useful for
;; transformation between org-mode and FreeMind files.
;;
;; Here are the commands you can use:
;;
;; M-x `org-freemind-from-org-mode'
;; M-x `org-freemind-from-org-mode-node'
;; M-x `org-freemind-from-org-sparse-tree'
;;
;; M-x `org-freemind-to-org-mode'
;;
;; M-x `org-freemind-show'
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2009-02-15: Added check for next level=current+1
;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'.
;; 2009-10-25: Added support for `org-odd-levels-only'.
;; Added y/n question before showing in FreeMind.
;; 2009-11-04: Added support for #+BEGIN_HTML.
;;
;;; Code:
(require 'xml)
(require 'org)
;(require 'rx)
;(require 'org-exp)
(eval-when-compile (require 'cl))
(defgroup org-freemind nil
"Customization group for org-freemind export/import."
:group 'org)
;; Fix-me: I am not sure these are useful:
;;
;; (defcustom org-freemind-main-fgcolor "black"
;; "Color of main node's text."
;; :type 'color
;; :group 'org-freemind)
;; (defcustom org-freemind-main-color "black"
;; "Background color of main node."
;; :type 'color
;; :group 'org-freemind)
;; (defcustom org-freemind-child-fgcolor "black"
;; "Color of child nodes' text."
;; :type 'color
;; :group 'org-freemind)
;; (defcustom org-freemind-child-color "black"
;; "Background color of child nodes."
;; :type 'color
;; :group 'org-freemind)
(defvar org-freemind-node-style nil "Internal use.")
(defcustom org-freemind-node-styles nil
"Styles to apply to node.
NOT READY YET."
:type '(repeat
(list :tag "Node styles for file"
(regexp :tag "File name")
(repeat
(list :tag "Node"
(regexp :tag "Node name regexp")
(set :tag "Node properties"
(list :format "%v" (const :format "" node-style)
(choice :tag "Style"
:value bubble
(const bubble)
(const fork)))
(list :format "%v" (const :format "" color)
(color :tag "Color" :value "red"))
(list :format "%v" (const :format "" background-color)
(color :tag "Background color" :value "yellow"))
(list :format "%v" (const :format "" edge-color)
(color :tag "Edge color" :value "green"))
(list :format "%v" (const :format "" edge-style)
(choice :tag "Edge style" :value bezier
(const :tag "Linear" linear)
(const :tag "Bezier" bezier)
(const :tag "Sharp Linear" sharp-linear)
(const :tag "Sharp Bezier" sharp-bezier)))
(list :format "%v" (const :format "" edge-width)
(choice :tag "Edge width" :value thin
(const :tag "Parent" parent)
(const :tag "Thin" thin)
(const 1)
(const 2)
(const 4)
(const 8)))
(list :format "%v" (const :format "" italic)
(const :tag "Italic font" t))
(list :format "%v" (const :format "" bold)
(const :tag "Bold font" t))
(list :format "%v" (const :format "" font-name)
(string :tag "Font name" :value "SansSerif"))
(list :format "%v" (const :format "" font-size)
(integer :tag "Font size" :value 12)))))))
:group 'org-freemind)
(defconst org-freemind-org-nfix "--org-mode: ")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Format converters
(defvar org-freemind-bol-helper-base-indent nil)
(defcustom org-freemind-node-css-style
"p { margin-top: 3px; margin-bottom: 3px; }"
"CSS style for Freemind nodes."
;; Fix-me: I do not understand this. It worked to export from Freemind
;; with this setting now, but not before??? Was this perhaps a java
;; bug or is it a windows xp bug (some resource gets exhausted if you
;; use sticky keys which I do).
:version "24.1"
:group 'org-freemind)
(defun org-freemind-check-overwrite (file interactively)
"Check if file FILE already exists.
If FILE does not exists return t.
If INTERACTIVELY is non-nil ask if the file should be replaced
and return t/nil if it should/should not be replaced.
Otherwise give an error say the file exists."
(if (file-exists-p file)
(if interactively
(y-or-n-p (format "File %s exists, replace it? " file))
(error "File %s already exists" file))
t))
(defvar org-freemind-node-pattern
;;(rx bol
;; (submatch (1+ "*"))
;; (1+ space)
;; (submatch (*? nonl))
;; eol)
"^\\(\\*+\\)[[:space:]]+\\(.*?\\)$")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FreeMind => Org
;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs)
(defun org-freemind-lt-xml-attrs (attr-a attr-b)
(string< (symbol-name (car attr-a)) (symbol-name (car attr-b))))
;; (org-freemind-symbols= 'a (car '(A B)))
(defsubst org-freemind-symbols= (sym-a sym-b)
"Return t if downcased names of SYM-A and SYM-B are equal.
SYM-A and SYM-B should be symbols."
(or (eq sym-a sym-b)
(string= (downcase (symbol-name sym-a))
(downcase (symbol-name sym-b)))))
(defun org-freemind-get-children (parent path)
"Find children node to PARENT from PATH.
PATH should be a list of steps, where each step has the form
'(NODE-NAME (ATTR-NAME . ATTR-VALUE))"
;; Fix-me: maybe implement op? step: Name, number, attr, attr op val
;; Fix-me: case insensitive version for children?
(let* ((children (if (not (listp (car parent)))
(cddr parent)
(let (cs)
(dolist (p parent)
(dolist (c (cddr p))
(add-to-list 'cs c)))
cs)
))
(step (car path))
(step-node (if (listp step) (car step) step))
(step-attr-list (when (listp step) (sort (cdr step) 'org-freemind-lt-xml-attrs)))
(path-tail (cdr path))
path-children)
(dolist (child children)
;; skip xml.el formatting nodes
(unless (stringp child)
;; compare node name
(when (if (not step-node)
t ;; any node name
(org-freemind-symbols= step-node (car child)))
(if (not step-attr-list)
;;(throw 'path-child child) ;; no attr to care about
(add-to-list 'path-children child)
(let* ((child-attr-list (cadr child))
(step-attr-copy (copy-sequence step-attr-list)))
(dolist (child-attr child-attr-list)
;; Compare attr names:
(when (org-freemind-symbols= (caar step-attr-copy) (car child-attr))
;; Compare values:
(let ((step-val (cdar step-attr-copy))
(child-val (cdr child-attr)))
(when (if (not step-val)
t ;; any value
(string= step-val child-val))
(setq step-attr-copy (cdr step-attr-copy))))))
;; Did we find all?
(unless step-attr-copy
;;(throw 'path-child child)
(add-to-list 'path-children child)
))))))
(if path-tail
(org-freemind-get-children path-children path-tail)
path-children)))
(defun org-freemind-get-richcontent-node (node)
(let ((rc-nodes
(org-freemind-get-children node '((richcontent (type . "NODE")) html body))))
(when (> (length rc-nodes) 1)
(lwarn t :warning "Unexpected structure: several "))
(car rc-nodes)))
(defun org-freemind-get-richcontent-note (node)
(let ((rc-notes
(org-freemind-get-children node '((richcontent (type . "NOTE")) html body))))
(when (> (length rc-notes) 1)
(lwarn t :warning "Unexpected structure: several "))
(car rc-notes)))
(defun org-freemind-get-tree-text (node)
(when node
(let ((ntxt "")
(link nil)
(lf-after nil))
(dolist (n node)
(case n
;;(a (setq is-link t) )
((h1 h2 h3 h4 h5 h6 p)
;;(setq ntxt (concat "\n" ntxt))
(setq lf-after 2))
(br
(setq lf-after 1))
(t
(cond
((stringp n)
(when (string= n "\n") (setq n ""))
(if link
(setq ntxt (concat ntxt
"[[" link "][" n "]]"))
(setq ntxt (concat ntxt n))))
((and n (listp n))
(if (symbolp (car n))
(setq ntxt (concat ntxt (org-freemind-get-tree-text n)))
;; This should be the attributes:
(dolist (att-val n)
(let ((att (car att-val))
(val (cdr att-val)))
(when (eq att 'href)
(setq link val))))))))))
(if lf-after
(setq ntxt (concat ntxt (make-string lf-after ?\n)))
(setq ntxt (concat ntxt " ")))
;;(setq ntxt (concat ntxt (format "{%s}" n)))
ntxt)))
(defun org-freemind-get-richcontent-node-text (node)
"Get the node text as from the richcontent node NODE."
(save-match-data
(let* ((rc (org-freemind-get-richcontent-node node))
(txt (org-freemind-get-tree-text rc)))
;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
txt
)))
(defun org-freemind-get-richcontent-note-text (node)
"Get the node text as from the richcontent note NODE."
(save-match-data
(let* ((rc (org-freemind-get-richcontent-note node))
(txt (when rc (org-freemind-get-tree-text rc))))
;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
txt
)))
(defun org-freemind-get-icon-names (node)
(let* ((icon-nodes (org-freemind-get-children node '((icon ))))
names)
(dolist (icn icon-nodes)
(setq names (cons (cdr (assq 'builtin (cadr icn))) names)))
;; (icon (builtin . "full-1"))
names))
(defun org-freemind-node-to-org (node level skip-levels)
(let ((qname (car node))
(attributes (cadr node))
text
;; Fix-me: note is never inserted
(note (org-freemind-get-richcontent-note-text node))
(mark "-- This is more about ")
(icons (org-freemind-get-icon-names node))
(children (cddr node)))
(when (< 0 (- level skip-levels))
(dolist (attrib attributes)
(case (car attrib)
('TEXT (setq text (cdr attrib)))
('text (setq text (cdr attrib)))))
(unless text
;; There should be a richcontent node holding the text:
(setq text (org-freemind-get-richcontent-node-text node)))
(when icons
(when (member "full-1" icons) (setq text (concat "[#A] " text)))
(when (member "full-2" icons) (setq text (concat "[#B] " text)))
(when (member "full-3" icons) (setq text (concat "[#C] " text)))
(when (member "full-4" icons) (setq text (concat "[#D] " text)))
(when (member "full-5" icons) (setq text (concat "[#E] " text)))
(when (member "full-6" icons) (setq text (concat "[#F] " text)))
(when (member "full-7" icons) (setq text (concat "[#G] " text)))
(when (member "button_cancel" icons) (setq text (concat "TODO " text)))
)
(if (and note
(string= mark (substring note 0 (length mark))))
(progn
(setq text (replace-regexp-in-string "\n $" "" text))
(insert text))
(case qname
('node
(insert (make-string (- level skip-levels) ?*) " " text "\n")
(when note
(insert ":COMMENT:\n" note "\n:END:\n"))
))))
(dolist (child children)
(unless (or (null child)
(stringp child))
(org-freemind-node-to-org child (1+ level) skip-levels)))))
;; Fix-me: put back special things, like drawers that are stored in
;; the notes. Should maybe all notes contents be put in drawers?
;;;###autoload
(defun org-freemind-to-org-mode (mm-file org-file)
"Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."
(interactive
(save-match-data
(let* ((mm-file (buffer-file-name))
(default-org-file (concat (file-name-nondirectory mm-file) ".org"))
(org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file)))
(list mm-file org-file))))
(when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any))
(let ((mm-buffer (find-file-noselect mm-file))
(org-buffer (find-file-noselect org-file)))
(with-current-buffer mm-buffer
(let* ((xml-list (xml-parse-file mm-file))
(top-node (cadr (cddar xml-list)))
(note (org-freemind-get-richcontent-note-text top-node))
(skip-levels
(if (and note
(string-match "^--org-mode: WHOLE FILE$" note))
1
0)))
(with-current-buffer org-buffer
(erase-buffer)
(org-freemind-node-to-org top-node 1 skip-levels)
(goto-char (point-min))
(org-set-tags t t) ;; Align all tags
)
(switch-to-buffer-other-window org-buffer)
)))))
(provide 'org-freemind)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; org-freemind.el ends here