I have in the past used the org-freemind-to-org-mode function, which is no longer included in org-mode. It used to be part of org-freemind.el file (see http://orgmode.org/w/org-mode.git?p=org-mode.git;a=blob_plain;f=lisp/org-freemind.el;hb=8f49547aaf0f9396f2a0bcfb25ce2c33be5e91fd ).
I have since tried this function, and it does still work, so I am wondering if we could add it back into the org-mode source tree. I am attaching a stripped-down version of org-freemind.el in which most of the code that is irrelevant to org-freemind-to-org-mode has been removed. Regards, Mark
;;; 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 <http://www.gnu.org/licenses/>. ;; -------------------------------------------------------------------- ;; 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 <richcontent type=\"NODE\" ...>")) (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 <richcontent type=\"NOTE\" ...>")) (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
