diff --git a/Makefile b/Makefile
index 8d31daae1..6e45f53cf 100644
--- a/Makefile
+++ b/Makefile
@@ -29,8 +29,7 @@ infodir = $(prefix)/share/info
# Using emacs in batch mode.
BATCH=$(EMACS) -batch -q -no-site-file -eval \
- "(progn (add-to-list (quote load-path) \"$(lispdir)\") \
- (add-to-list (quote load-path) (expand-file-name \"./lisp/\")))"
+ "(progn (add-to-list (quote load-path) \"$(lispdir)\") (add-to-list (quote load-path) (expand-file-name \"./lisp/\")))"
# Specify the byte-compiler for compiling org-mode files
ELC= $(BATCH) -f batch-byte-compile
@@ -76,6 +75,7 @@ LISPF = org.el \
org-faces.el \
org-feed.el \
org-footnote.el \
+ org-freemind.el \
org-gnus.el \
org-habit.el \
org-html.el \
@@ -350,8 +350,10 @@ lisp/org-docbook.elc: lisp/org.el lisp/org-exp.el
lisp/org-faces.elc: lisp/org-macs.el lisp/org-compat.el
lisp/org-feed.elc: lisp/org.el
lisp/org-footnotes.elc: lisp/org-macs.el lisp/org-compat.el
+lisp/org-freemind.elc: lisp/org.el
lisp/org-gnus.elc: lisp/org.el
lisp/org-html.elc: lisp/org-exp.el
+lisp/org-habit.elc: lisp/org.el lisp/org-agenda.el
lisp/org-icalendar.elc: lisp/org-exp.el
lisp/org-id.elc: lisp/org.el
lisp/org-indent.elc: lisp/org.el lisp/org-macs.el lisp/org-compat.el
diff --git a/doc/org.texi b/doc/org.texi
index 10d26faf5..130a4dab3 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -337,6 +337,7 @@ Exporting
* HTML export:: Exporting to HTML
* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF
* DocBook export:: Exporting to DocBook
+* Freemind export:: Exporting to Freemind mind maps
* XOXO export:: Exporting to XOXO
* iCalendar export:: Exporting in iCalendar format
@@ -8755,6 +8756,7 @@ enabled (default in Emacs 23).
* HTML export:: Exporting to HTML
* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF
* DocBook export:: Exporting to DocBook
+* Freemind export:: Exporting to Freemind mind maps
* XOXO export:: Exporting to XOXO
* iCalendar export:: Exporting in iCalendar format
@end menu
@@ -9514,7 +9516,7 @@ settings for @code{\includegraphics} and @code{wrapfigure}.
If you need references to a label created in this way, write
@samp{\ref@{fig:SED-HR4049@}} just like in La@TeX{}.
-@node DocBook export, XOXO export, LaTeX and PDF export, Exporting
+@node DocBook export, Freemind export, LaTeX and PDF export, Exporting
@section DocBook export
@cindex DocBook export
@cindex PDF export
@@ -9707,7 +9709,20 @@ special characters included in XHTML entities:
"
@end example
-@node XOXO export, iCalendar export, DocBook export, Exporting
+@node Freemind export, XOXO export, DocBook export, Exporting
+@section Freemind export
+@cindex Freemind export
+@cindex mind map
+
+The freemind exporter was written by Lennart Borgman.
+
+@table @kbd
+@kindex C-c C-e m
+@item C-c C-e m
+Export as Freemind mind map @file{myfile.mm}.
+@end table
+
+@node XOXO export, iCalendar export, Freemind export, Exporting
@section XOXO export
@cindex XOXO export
diff --git a/lisp/org-exp.el b/lisp/org-exp.el
index c6ffe75a7..6ed171207 100644
--- a/lisp/org-exp.el
+++ b/lisp/org-exp.el
@@ -849,6 +849,8 @@ value of `org-export-run-in-background'."
\[D] export as DocBook
\[V] export as DocBook, process to PDF, and open the resulting PDF document
+\[m] export as Freemind mind map
+
\[x] export as XOXO
\[g] export using Wes Hardaker's generic exporter
@@ -871,6 +873,7 @@ value of `org-export-run-in-background'."
(?g org-export-generic t)
(?D org-export-as-docbook t)
(?V org-export-as-docbook-pdf-and-open t)
+ (?m org-export-as-freemind t)
(?l org-export-as-latex t)
(?p org-export-as-pdf t)
(?d org-export-as-pdf-and-open t)
@@ -2899,3 +2902,4 @@ The depends on the variable `org-export-copy-to-kill'."
;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95
;;; org-exp.el ends here
+
diff --git a/lisp/org-freemind.el b/lisp/org-freemind.el
new file mode 100644
index 000000000..07b57746e
--- /dev/null
+++ b/lisp/org-freemind.el
@@ -0,0 +1,1143 @@
+;;; org-freemind.el --- Export Org files to freemind
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 6.33
+;;
+;; 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.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program 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 2, or
+;; (at your option) any later version.
+;;
+;; This program 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 this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'xml)
+(require 'org)
+(eval-when-compile (require 'cl))
+
+;; Fix-me: I am not sure these are useful:
+;;
+;; (defcustom org-freemind-main-fgcolor "black"
+;; "Color of main node's text."
+;; :type 'color
+;; :group 'freemind)
+
+;; (defcustom org-freemind-main-color "black"
+;; "Background color of main node."
+;; :type 'color
+;; :group 'freemind)
+
+;; (defcustom org-freemind-child-fgcolor "black"
+;; "Color of child nodes' text."
+;; :type 'color
+;; :group 'freemind)
+
+;; (defcustom org-freemind-child-color "black"
+;; "Background color of child nodes."
+;; :type 'color
+;; :group '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 'freemind)
+
+;;;###autoload
+(defun org-export-as-freemind (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ (interactive "P")
+ (let* ((opt-plist (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist)))
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (if (plist-get opt-plist :ignore-subree-p)
+ nil
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))))))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+ (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
+ (filename (concat (file-name-as-directory
+ (or pub-dir
+ (org-export-directory :ascii opt-plist)))
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get (region-beginning)
+ "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory bfname)))
+ ".mm")))
+ (when (file-exists-p filename)
+ (delete-file filename))
+ (cond
+ (subtree-p
+ (org-freemind-from-org-mode-node (line-number-at-pos rbeg)
+ filename))
+ (t (org-freemind-from-org-mode bfname filename)))))
+
+
+;;;###autoload
+(defun org-freemind-show (mm-file)
+ "Show file MM-FILE in Freemind."
+ (interactive
+ (list
+ (save-match-data
+ (let ((name (read-file-name "FreeMind file: "
+ nil nil nil
+ (if (buffer-file-name)
+ (file-name-nondirectory (buffer-file-name))
+ "")
+ ;; Fix-me: Is this an Emacs bug?
+ ;; This predicate function is never
+ ;; called.
+ (lambda (fn)
+ (string-match "^mm$" (file-name-extension fn))))))
+ (setq name (expand-file-name name))
+ name))))
+ (org-open-file mm-file))
+
+(defconst org-freemind-org-nfix "--org-mode: ")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Format converters
+
+(defun org-freemind-escape-str-from-org (org-str)
+ "Do some html-escaping of ORG-STR and return the result.
+The characters \"&<> will be escaped."
+ (let ((chars (append org-str nil))
+ (fm-str ""))
+ (dolist (cc chars)
+ (setq fm-str
+ (concat fm-str
+ (if (< cc 256)
+ (cond
+ ((= cc ?\") """)
+ ((= cc ?\&) "&")
+ ((= cc ?\<) "<")
+ ((= cc ?\>) ">")
+ (t (char-to-string cc)))
+ ;; Formatting as &#number; is maybe needed
+ ;; according to a bug report from kazuo
+ ;; fujimoto, but I have now instead added a xml
+ ;; processing instruction saying that the mm
+ ;; file is utf-8:
+ ;;
+ ;; (format "&#x%x;" (- cc ;; ?\x800))
+ (char-to-string cc)
+ ))))
+ fm-str))
+
+(defun org-freemind-unescape-str-to-org (fm-str)
+ "Do some html-unescaping of FM-STR and return the result.
+This is the opposite of `org-freemind-escape-str-from-org' but it
+will also unescape &#nn;."
+ (let ((org-str fm-str))
+ (setq org-str (replace-regexp-in-string """ "\"" org-str))
+ (setq org-str (replace-regexp-in-string "&" "&" org-str))
+ (setq org-str (replace-regexp-in-string "<" "<" org-str))
+ (setq org-str (replace-regexp-in-string ">" ">" org-str))
+ (setq org-str (replace-regexp-in-string
+ "&#x\\([a-f0-9]\\{2\\}\\);"
+ (lambda (m)
+ (char-to-string (+ (string-to-number (match-string 1 org-str) 16)
+ ?\x800)))
+ org-str))))
+
+;; (org-freemind-test-escape)
+;; (defun org-freemind-test-escape ()
+;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: φεδΦΕΔ")
+;; (str2 (org-freemind-escape-str-from-org str1))
+;; (str3 (org-freemind-unescape-str-to-org str2))
+;; )
+;; (unless (string= str1 str3)
+;; (error "str3=%s" str3))
+;; ))
+
+(defun org-freemind-convert-links-from-org (org-str)
+ "Convert org links in ORG-STR to freemind links and return the result."
+ (let ((fm-str (replace-regexp-in-string
+ (rx (not (any "[\""))
+ (submatch
+ "http"
+ (opt ?\s)
+ "://"
+ (1+
+ (any "-%.?@a-zA-Z0-9()_/:~=&#"))))
+ "[[\\1][\\1]]"
+ org-str)))
+ (replace-regexp-in-string (rx "[["
+ (submatch (*? nonl))
+ "]["
+ (submatch (*? nonl))
+ "]]")
+ "\\2"
+ fm-str)))
+
+;;(org-freemind-convert-links-to-org "link-text")
+(defun org-freemind-convert-links-to-org (fm-str)
+ "Convert freemind links in FM-STR to org links and return the result."
+ (let ((org-str (replace-regexp-in-string
+ (rx "")))
+ space)
+ "href=\""
+ (submatch (0+ (not (any "\""))))
+ "\""
+ (0+ (not (any ">")))
+ ">"
+ (submatch (0+ (not (any "<"))))
+ "")
+ "[[\\1][\\2]]"
+ fm-str)))
+ org-str))
+
+;; Fix-me:
+;;(defun org-freemind-convert-drawers-from-org (text)
+;; )
+
+;; (org-freemind-test-links)
+;; (defun org-freemind-test-links ()
+;; (let* ((str1 "[[http://www.somewhere/][link-text]")
+;; (str2 (org-freemind-convert-links-from-org str1))
+;; (str3 (org-freemind-convert-links-to-org str2))
+;; )
+;; (unless (string= str1 str3)
+;; (error "str3=%s" str3))
+;; ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Org => FreeMind
+
+(defun org-freemind-convert-text-p (text)
+ (setq text (org-freemind-escape-str-from-org text))
+ (setq text (replace-regexp-in-string (rx "\n" (0+ blank) "\n") "\n" text))
+ ;;(setq text (replace-regexp-in-string (rx bol (1+ blank) eol) "" text))
+ ;;(setq text (replace-regexp-in-string (rx bol (1+ blank)) "
" text))
+ (setq text (replace-regexp-in-string "\n" "
" text))
+ (concat "
"
+ (org-freemind-convert-links-from-org text)
+ "
\n"))
+
+(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp)
+ "Convert text part of org node to freemind subnode or note.
+Convert the text part of the org node named NODE-NAME. The text
+is in the current buffer between START and END. Drawers matching
+DRAWERS-REGEXP are converted to freemind notes."
+ ;; fix-me: doc
+ (let ((text (buffer-substring-no-properties start end))
+ (node-res "")
+ (note-res ""))
+ (save-match-data
+ ;;(setq text (org-freemind-escape-str-from-org text))
+ ;; First see if there is something that should be moved to the
+ ;; note part:
+ (let (drawers)
+ (while (string-match drawers-regexp text)
+ (setq drawers (cons (match-string 0 text) drawers))
+ (setq text
+ (concat (substring text 0 (match-beginning 0))
+ (substring text (match-end 0))))
+ )
+ (when drawers
+ (dolist (drawer drawers)
+ (let ((lines (split-string drawer "\n")))
+ (dolist (line lines)
+ (setq note-res (concat
+ note-res
+ org-freemind-org-nfix line "
\n")))
+ ))))
+
+ (when (> (length note-res) 0)
+ (setq note-res (concat
+ "\n"
+ "\n"
+ "\n"
+ "\n"
+ note-res
+ "\n"
+ "\n"
+ "\n"))
+ )
+
+ ;; There is always an LF char:
+ (when (> (length text) 1)
+ (setq node-res (concat
+ "\n"
+ "\n"
+ "\n"
+ "\n"
+ "\n"
+ "\n"))
+ (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML"))
+ (end-html-mark (regexp-quote "#+END_HTML"))
+ head
+ end-pos
+ end-pos-match
+ )
+ ;; Take care of #+BEGIN_HTML - #+END_HTML
+ (while (string-match begin-html-mark text)
+ (setq head (substring text 0 (match-beginning 0)))
+ (setq end-pos-match (match-end 0))
+ (setq node-res (concat node-res
+ (org-freemind-convert-text-p head)))
+ (setq text (substring text end-pos-match))
+ (setq end-pos (string-match end-html-mark text))
+ (if end-pos
+ (setq end-pos-match (match-end 0))
+ (message "org-freemind: Missing #+END_HTML")
+ (setq end-pos (length text))
+ (setq end-pos-match end-pos))
+ (setq node-res (concat node-res
+ (substring text 0 end-pos)))
+ (setq text (substring text end-pos-match)))
+ (setq node-res (concat node-res
+ (org-freemind-convert-text-p text))))
+ (setq node-res (concat
+ node-res
+ "\n"
+ "\n"
+ "\n"
+ ;; Put a note that this is for the parent node
+ ""
+ ""
+ ""
+ ""
+ ""
+ "-- This is more about \"" node-name "\" --"
+ "
"
+ ""
+ ""
+ "\n"
+ "\n" ;; ok
+ )))
+ (list node-res note-res))))
+
+(defun org-freemind-write-node (this-m2
+ this-node-end
+ drawers-regexp
+ next-has-some-visible-child
+ this-children-visible
+ mm-buffer
+ num-nodes-left
+ next-level
+ current-level
+ base-level)
+ (let* (this-icons
+ this-bg-color
+ this-m2-escaped
+ this-rich-node
+ this-rich-note
+ )
+ (when (string-match "TODO" this-m2)
+ (setq this-m2 (replace-match "" nil nil this-m2))
+ (add-to-list 'this-icons "button_cancel")
+ (setq this-bg-color "#ffff88")
+ (when (string-match "\\[#\\(.\\)\\]" this-m2)
+ (let ((prior (string-to-char (match-string 1 this-m2))))
+ (setq this-m2 (replace-match "" nil nil this-m2))
+ (cond
+ ((= prior ?A)
+ (add-to-list 'this-icons "full-1")
+ (setq this-bg-color "#ff0000"))
+ ((= prior ?B)
+ (add-to-list 'this-icons "full-2")
+ (setq this-bg-color "#ffaa00"))
+ ((= prior ?C)
+ (add-to-list 'this-icons "full-3")
+ (setq this-bg-color "#ffdd00"))
+ ((= prior ?D)
+ (add-to-list 'this-icons "full-4")
+ (setq this-bg-color "#ffff00"))
+ ((= prior ?E)
+ (add-to-list 'this-icons "full-5"))
+ ((= prior ?F)
+ (add-to-list 'this-icons "full-6"))
+ ((= prior ?G)
+ (add-to-list 'this-icons "full-7"))
+ ))))
+ (setq this-m2 (org-trim this-m2))
+ (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2))
+ (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
+ this-m2-escaped
+ this-node-end (1- next-node-start)
+ drawers-regexp
+ )))
+ (setq this-rich-node (nth 0 node-notes))
+ (setq this-rich-note (nth 1 node-notes)))
+ (with-current-buffer mm-buffer
+ (insert " current-level base-level) (> next-level current-level))
+ (when (> next-level current-level)
+ (unless (or this-children-visible
+ next-has-some-visible-child)
+ (insert " folded=\"true\"")))
+ (when (and (= current-level (1+ base-level))
+ (> num-nodes-left 0))
+ (setq num-nodes-left (1- num-nodes-left))
+ (insert " position=\"left\""))
+ (when this-bg-color
+ (insert " background_color=\"" this-bg-color "\""))
+ (insert ">\n")
+ (when this-icons
+ (dolist (icon this-icons)
+ (insert "\n")))
+ )
+ (with-current-buffer mm-buffer
+ (when this-rich-note (insert this-rich-note))
+ (when this-rich-node (insert this-rich-node))
+ )
+ ))
+
+(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))
+
+(defun org-freemind-look-for-visible-child (node-level)
+ (save-excursion
+ (save-match-data
+ (let ((found-visible-child nil))
+ (while (and (not found-visible-child)
+ (re-search-forward org-freemind-node-pattern nil t))
+ (let* ((m1 (match-string-no-properties 1))
+ (level (length m1)))
+ (if (>= node-level level)
+ (setq found-visible-child 'none)
+ (unless (get-char-property (line-beginning-position) 'invisible)
+ (setq found-visible-child 'found)))))
+ (eq found-visible-child 'found)
+ ))))
+
+(defun org-freemind-goto-line (line)
+ "Go to line number LINE."
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))))
+
+(defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line)
+ (with-current-buffer org-buffer
+ (dolist (node-style org-freemind-node-styles)
+ (when (string-match-p (car node-style) buffer-file-name)
+ (setq org-freemind-node-style (cadr node-style))))
+ ;;(message "org-freemind-node-style =%s" org-freemind-node-style)
+ (save-match-data
+ (let* ((drawers (copy-sequence org-drawers))
+ drawers-regexp
+ (num-top1-nodes 0)
+ (num-top2-nodes 0)
+ num-nodes-left
+ (unclosed-nodes 0)
+ (first-time t)
+ (current-level 1)
+ base-level
+ skipping-odd
+ (skipped-odd 0)
+ prev-node-end
+ rich-text
+ unfinished-tag
+ node-at-line-level
+ node-at-line-last)
+ (with-current-buffer mm-buffer
+ (erase-buffer)
+ (insert "\n")
+ (insert "\ncurrent-level=%s, next-level%s\n" current-level next-level))
+ (setq current-level (1- current-level))
+ (when (< 0 skipped-odd)
+ (setq skipped-odd (1- skipped-odd))
+ (setq current-level (1- current-level)))
+ )))
+ (setq this-node-end (1+ next-node-end))
+ (setq this-m2 next-m2)
+ (setq current-level next-level)
+ (setq this-children-visible next-children-visible)
+ (forward-char)
+ ))
+;;; (unless (if node-at-line-last
+;;; (>= (point) node-at-line-last)
+;;; nil)
+ ;; Write last node:
+ (setq this-m2 next-m2)
+ (setq current-level next-level)
+ (setq next-node-start (if node-at-line-last
+ (1+ node-at-line-last)
+ (point-max)))
+ (org-freemind-write-node this-m2 this-node-end drawers-regexp next-has-some-visible-child this-children-visible mm-buffer num-nodes-left next-level current-level base-level)
+ (with-current-buffer mm-buffer (insert "\n"))
+ ;)
+ )
+ (with-current-buffer mm-buffer
+ (while (> current-level base-level)
+ (insert "\n")
+ (setq current-level (1- current-level))
+ ))
+ (with-current-buffer mm-buffer
+ (insert "")
+ (delete-trailing-whitespace)
+ (goto-char (point-min))
+ ))))))
+
+(defun org-freemind-get-node-style (node-name)
+ "NOT READY YET."
+ ;;
+ ;;
+ (let (node-styles
+ node-style)
+ (dolist (style-list org-freemind-node-style)
+ (let ((node-regexp (car style-list)))
+ (message "node-regexp=%s node-name=%s" node-regexp node-name)
+ (when (string-match-p node-regexp node-name)
+ ;;(setq node-style (org-freemind-do-apply-node-style style-list))
+ (setq node-style (cadr style-list))
+ (when node-style
+ (message "node-style=%s" node-style)
+ (setq node-styles (append node-styles node-style)))
+ )))))
+
+(defun org-freemind-do-apply-node-style (style-list)
+ (message "style-list=%S" style-list)
+ (let ((node-style 'fork)
+ (color "red")
+ (background-color "yellow")
+ (edge-color "green")
+ (edge-style 'bezier)
+ (edge-width 'thin)
+ (italic t)
+ (bold t)
+ (font-name "SansSerif")
+ (font-size 12))
+ (dolist (style (cadr style-list))
+ (message " style=%s" style)
+ (let ((what (car style)))
+ (cond
+ ((eq what 'node-style)
+ (setq node-style (cadr style)))
+ ((eq what 'color)
+ (setq color (cadr style)))
+ ((eq what 'background-color)
+ (setq background-color (cadr style)))
+
+ ((eq what 'edge-color)
+ (setq edge-color (cadr style)))
+
+ ((eq what 'edge-style)
+ (setq edge-style (cadr style)))
+
+ ((eq what 'edge-width)
+ (setq edge-width (cadr style)))
+
+ ((eq what 'italic)
+ (setq italic (cadr style)))
+
+ ((eq what 'bold)
+ (setq bold (cadr style)))
+
+ ((eq what 'font-name)
+ (setq font-name (cadr style)))
+
+ ((eq what 'font-size)
+ (setq font-size (cadr style)))
+ )
+ (insert (format " style=\"%s\"" node-style))
+ (insert (format " color=\"%s\"" color))
+ (insert (format " background_color=\"%s\"" background-color))
+ (insert ">\n")
+ (insert "\n")
+ (insert " Org
+
+;; (sort '(b a c) 'org-freemind-lt-symbols)
+(defun org-freemind-lt-symbols (sym-a sym-b)
+ (string< (symbol-name sym-a) (symbol-name sym-b)))
+;; (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))))
+
+;; xml-parse-region gives things like
+;; ((p nil "\n"
+;; (a
+;; ((href . "link"))
+;; "text")
+;; "\n"
+;; (b nil "hej")
+;; "\n"))
+
+;; '(a . nil)
+
+;; (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-test-get-tree-text ()
+ (let ((node '(p nil "\n"
+ (a
+ ((href . "link"))
+ "text")
+ "\n"
+ (b nil "hej")
+ "\n")))
+ (org-freemind-get-tree-text node)))
+;; (org-freemind-test-get-tree-text)
+
+(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 (rx (1+ whitespace)) " " 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 (rx (1+ whitespace)) " " 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
+ (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")
+ ))))
+ (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 (called-interactively-p))
+ (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 (rx bol "--org-mode: WHOLE FILE" eol) 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)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; arch-tag: e7b0d776-94fd-404a-b35e-0f855fae3627
+
+;;; org-freemind.el ends here