1 ;;; org-freemind.el --- Export Org files to freemind
3 ;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
5 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
6 ;; Keywords: outlines, hypermedia, calendar, wp
7 ;; Homepage: http://orgmode.org
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; --------------------------------------------------------------------
26 ;; Features that might be required by this library:
28 ;; `backquote', `bytecomp', `cl', `easymenu', `font-lock',
29 ;; `noutline', `org', `org-compat', `org-faces', `org-footnote',
30 ;; `org-list', `org-macs', `org-src', `outline', `syntax',
31 ;; `time-date', `xml'.
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37 ;; This file tries to implement some functions useful for
38 ;; transformation between org-mode and FreeMind files.
40 ;; Here are the commands you can use:
42 ;; M-x `org-freemind-from-org-mode'
43 ;; M-x `org-freemind-from-org-mode-node'
44 ;; M-x `org-freemind-from-org-sparse-tree'
46 ;; M-x `org-freemind-to-org-mode'
48 ;; M-x `org-freemind-show'
50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
54 ;; 2009-02-15: Added check for next level=current+1
55 ;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'.
56 ;; 2009-10-25: Added support for `org-odd-levels-only'.
57 ;; Added y/n question before showing in FreeMind.
58 ;; 2009-11-04: Added support for #+BEGIN_HTML.
65 (eval-when-compile (require 'cl
))
67 ;; Fix-me: I am not sure these are useful:
69 ;; (defcustom org-freemind-main-fgcolor "black"
70 ;; "Color of main node's text."
74 ;; (defcustom org-freemind-main-color "black"
75 ;; "Background color of main node."
79 ;; (defcustom org-freemind-child-fgcolor "black"
80 ;; "Color of child nodes' text."
84 ;; (defcustom org-freemind-child-color "black"
85 ;; "Background color of child nodes."
89 (defvar org-freemind-node-style nil
"Internal use.")
91 (defcustom org-freemind-node-styles nil
92 "Styles to apply to node.
95 (list :tag
"Node styles for file"
96 (regexp :tag
"File name")
99 (regexp :tag
"Node name regexp")
100 (set :tag
"Node properties"
101 (list :format
"%v" (const :format
"" node-style
)
106 (list :format
"%v" (const :format
"" color
)
107 (color :tag
"Color" :value
"red"))
108 (list :format
"%v" (const :format
"" background-color
)
109 (color :tag
"Background color" :value
"yellow"))
110 (list :format
"%v" (const :format
"" edge-color
)
111 (color :tag
"Edge color" :value
"green"))
112 (list :format
"%v" (const :format
"" edge-style
)
113 (choice :tag
"Edge style" :value bezier
114 (const :tag
"Linear" linear
)
115 (const :tag
"Bezier" bezier
)
116 (const :tag
"Sharp Linear" sharp-linear
)
117 (const :tag
"Sharp Bezier" sharp-bezier
)))
118 (list :format
"%v" (const :format
"" edge-width
)
119 (choice :tag
"Edge width" :value thin
120 (const :tag
"Parent" parent
)
121 (const :tag
"Thin" thin
)
126 (list :format
"%v" (const :format
"" italic
)
127 (const :tag
"Italic font" t
))
128 (list :format
"%v" (const :format
"" bold
)
129 (const :tag
"Bold font" t
))
130 (list :format
"%v" (const :format
"" font-name
)
131 (string :tag
"Font name" :value
"SansSerif"))
132 (list :format
"%v" (const :format
"" font-size
)
133 (integer :tag
"Font size" :value
12)))))))
137 (defun org-export-as-freemind (arg &optional hidden ext-plist
138 to-buffer body-only pub-dir
)
140 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
142 (org-infile-export-plist)))
143 (region-p (org-region-active-p))
144 (rbeg (and region-p
(region-beginning)))
145 (rend (and region-p
(region-end)))
147 (if (plist-get opt-plist
:ignore-subtree-p
)
152 (and (org-at-heading-p)
153 (>= (org-end-of-subtree t t
) rend
))))))
154 (opt-plist (setq org-export-opt-plist
156 (org-export-add-subtree-options opt-plist rbeg
)
158 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
159 (filename (concat (file-name-as-directory
161 (org-export-directory :ascii opt-plist
)))
162 (file-name-sans-extension
164 (org-entry-get (region-beginning)
165 "EXPORT_FILE_NAME" t
))
166 (file-name-nondirectory bfname
)))
168 (when (file-exists-p filename
)
169 (delete-file filename
))
172 (org-freemind-from-org-mode-node (line-number-at-pos rbeg
)
174 (t (org-freemind-from-org-mode bfname filename
)))))
177 (defun org-freemind-show (mm-file)
178 "Show file MM-FILE in Freemind."
182 (let ((name (read-file-name "FreeMind file: "
184 (if (buffer-file-name)
185 (file-name-nondirectory (buffer-file-name))
187 ;; Fix-me: Is this an Emacs bug?
188 ;; This predicate function is never
191 (string-match "^mm$" (file-name-extension fn
))))))
192 (setq name
(expand-file-name name
))
194 (org-open-file mm-file
))
196 (defconst org-freemind-org-nfix
"--org-mode: ")
198 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
199 ;;; Format converters
201 (defun org-freemind-escape-str-from-org (org-str)
202 "Do some html-escaping of ORG-STR and return the result.
203 The characters \"&<> will be escaped."
204 (let ((chars (append org-str nil
))
211 ((= cc ?
\") """)
215 (t (char-to-string cc
)))
216 ;; Formatting as &#number; is maybe needed
217 ;; according to a bug report from kazuo
218 ;; fujimoto, but I have now instead added a xml
219 ;; processing instruction saying that the mm
222 ;; (format "&#x%x;" (- cc ;; ?\x800))
223 (format "&#x%x" (encode-char cc
'ucs
))
227 ;;(org-freemind-unescape-str-to-org "mA≌B<C<=")
228 ;;(org-freemind-unescape-str-to-org "<<")
229 (defun org-freemind-unescape-str-to-org (fm-str)
230 "Do some html-unescaping of FM-STR and return the result.
231 This is the opposite of `org-freemind-escape-str-from-org' but it
232 will also unescape &#nn;."
233 (let ((org-str fm-str
))
234 (setq org-str
(replace-regexp-in-string """ "\"" org-str
))
235 (setq org-str
(replace-regexp-in-string "&" "&" org-str
))
236 (setq org-str
(replace-regexp-in-string "<" "<" org-str
))
237 (setq org-str
(replace-regexp-in-string ">" ">" org-str
))
238 (setq org-str
(replace-regexp-in-string
239 "&#x\\([a-f0-9]\\{2,4\\}\\);"
242 (+ (string-to-number (match-string 1 m
) 16)
243 0 ;?\x800 ;; What is this for? Encoding?
247 ;; (org-freemind-test-escape)
248 (defun org-freemind-test-escape ()
249 (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
250 (str2 (org-freemind-escape-str-from-org str1
))
251 (str3 (org-freemind-unescape-str-to-org str2
))
253 (unless (string= str1 str3
)
254 (error "str3=%s" str3
))
257 (defun org-freemind-convert-links-from-org (org-str)
258 "Convert org links in ORG-STR to freemind links and return the result."
259 (let ((fm-str (replace-regexp-in-string
260 (rx (not (any "[\""))
266 (any "-%.?@a-zA-Z0-9()_/:~=&#"))))
269 (replace-regexp-in-string (rx "[["
274 "<a href=\"\\1\">\\2</a>"
277 ;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>")
278 (defun org-freemind-convert-links-to-org (fm-str)
279 "Convert freemind links in FM-STR to org links and return the result."
280 (let ((org-str (replace-regexp-in-string
287 (submatch (0+ (not (any "\""))))
291 (submatch (0+ (not (any "<"))))
298 ;;(defun org-freemind-convert-drawers-from-org (text)
301 ;; (org-freemind-test-links)
302 ;; (defun org-freemind-test-links ()
303 ;; (let* ((str1 "[[http://www.somewhere/][link-text]")
304 ;; (str2 (org-freemind-convert-links-from-org str1))
305 ;; (str3 (org-freemind-convert-links-to-org str2))
307 ;; (unless (string= str1 str3)
308 ;; (error "str3=%s" str3))
311 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
314 (defun org-freemind-convert-text-p (text)
315 "Convert TEXT to html with <p> paragraphs."
316 (setq text
(org-freemind-escape-str-from-org text
))
317 (setq text
(replace-regexp-in-string (rx "\n" (0+ blank
) "\n") "</p><p>\n" text
))
318 ;;(setq text (replace-regexp-in-string (rx bol (1+ blank) eol) "" text))
319 ;;(setq text (replace-regexp-in-string (rx bol (1+ blank)) "<br />" text))
320 (setq text
(replace-regexp-in-string "\n" "<br />" text
))
322 (org-freemind-convert-links-from-org text
)
325 (defun org-freemind-org-text-to-freemind-subnode/note
(node-name start end drawers-regexp
)
326 "Convert text part of org node to freemind subnode or note.
327 Convert the text part of the org node named NODE-NAME. The text
328 is in the current buffer between START and END. Drawers matching
329 DRAWERS-REGEXP are converted to freemind notes."
331 (let ((text (buffer-substring-no-properties start end
))
335 ;;(setq text (org-freemind-escape-str-from-org text))
336 ;; First see if there is something that should be moved to the
339 (while (string-match drawers-regexp text
)
340 (setq drawers
(cons (match-string 0 text
) drawers
))
342 (concat (substring text
0 (match-beginning 0))
343 (substring text
(match-end 0))))
346 (dolist (drawer drawers
)
347 (let ((lines (split-string drawer
"\n")))
349 (setq note-res
(concat
351 org-freemind-org-nfix line
"<br />\n")))
354 (when (> (length note-res
) 0)
355 (setq note-res
(concat
356 "<richcontent TYPE=\"NOTE\"><html>\n"
366 ;; There is always an LF char:
367 (when (> (length text
) 1)
368 (setq node-res
(concat
369 "<node style=\"bubble\" background_color=\"#eeee00\">\n"
370 "<richcontent TYPE=\"NODE\"><html>\n"
372 "<style type=\"text/css\">\n"
374 "p { margin-top: 0 }\n"
379 (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML"))
380 (end-html-mark (regexp-quote "#+END_HTML"))
385 ;; Take care of #+BEGIN_HTML - #+END_HTML
386 (while (string-match begin-html-mark text
)
387 (setq head
(substring text
0 (match-beginning 0)))
388 (setq end-pos-match
(match-end 0))
389 (setq node-res
(concat node-res
390 (org-freemind-convert-text-p head
)))
391 (setq text
(substring text end-pos-match
))
392 (setq end-pos
(string-match end-html-mark text
))
394 (setq end-pos-match
(match-end 0))
395 (message "org-freemind: Missing #+END_HTML")
396 (setq end-pos
(length text
))
397 (setq end-pos-match end-pos
))
398 (setq node-res
(concat node-res
399 (substring text
0 end-pos
)))
400 (setq text
(substring text end-pos-match
)))
401 (setq node-res
(concat node-res
402 (org-freemind-convert-text-p text
))))
403 (setq node-res
(concat
408 ;; Put a note that this is for the parent node
409 "<richcontent TYPE=\"NOTE\"><html>"
414 "-- This is more about \"" node-name
"\" --"
421 (list node-res note-res
))))
423 (defun org-freemind-write-node (mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child
)
430 (when (string-match "TODO" this-m2
)
431 (setq this-m2
(replace-match "" nil nil this-m2
))
432 (add-to-list 'this-icons
"button_cancel")
433 (setq this-bg-color
"#ffff88")
434 (when (string-match "\\[#\\(.\\)\\]" this-m2
)
435 (let ((prior (string-to-char (match-string 1 this-m2
))))
436 (setq this-m2
(replace-match "" nil nil this-m2
))
439 (add-to-list 'this-icons
"full-1")
440 (setq this-bg-color
"#ff0000"))
442 (add-to-list 'this-icons
"full-2")
443 (setq this-bg-color
"#ffaa00"))
445 (add-to-list 'this-icons
"full-3")
446 (setq this-bg-color
"#ffdd00"))
448 (add-to-list 'this-icons
"full-4")
449 (setq this-bg-color
"#ffff00"))
451 (add-to-list 'this-icons
"full-5"))
453 (add-to-list 'this-icons
"full-6"))
455 (add-to-list 'this-icons
"full-7"))
457 (setq this-m2
(org-trim this-m2
))
458 (setq this-m2-escaped
(org-freemind-escape-str-from-org this-m2
))
459 (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
464 (setq this-rich-node
(nth 0 node-notes
))
465 (setq this-rich-note
(nth 1 node-notes
)))
466 (with-current-buffer mm-buffer
467 (insert "<node text=\"" this-m2-escaped
"\"")
468 (org-freemind-get-node-style this-m2
)
469 (when (> next-level current-level
)
470 (unless (or this-children-visible
471 next-has-some-visible-child
)
472 (insert " folded=\"true\"")))
473 (when (and (= current-level
(1+ base-level
))
474 (> num-left-nodes
0))
475 (setq num-left-nodes
(1- num-left-nodes
))
476 (insert " position=\"left\""))
478 (insert " background_color=\"" this-bg-color
"\""))
481 (dolist (icon this-icons
)
482 (insert "<icon builtin=\"" icon
"\"/>\n")))
484 (with-current-buffer mm-buffer
485 (when this-rich-note
(insert this-rich-note
))
486 (when this-rich-node
(insert this-rich-node
))))
489 (defun org-freemind-check-overwrite (file interactively
)
490 "Check if file FILE already exists.
491 If FILE does not exists return t.
493 If INTERACTIVELY is non-nil ask if the file should be replaced
494 and return t/nil if it should/should not be replaced.
496 Otherwise give an error say the file exists."
497 (if (file-exists-p file
)
499 (y-or-n-p (format "File %s exists, replace it? " file
))
500 (error "File %s already exists" file
))
503 (defvar org-freemind-node-pattern
(rx bol
509 (defun org-freemind-look-for-visible-child (node-level)
512 (let ((found-visible-child nil
))
513 (while (and (not found-visible-child
)
514 (re-search-forward org-freemind-node-pattern nil t
))
515 (let* ((m1 (match-string-no-properties 1))
517 (if (>= node-level level
)
518 (setq found-visible-child
'none
)
519 (unless (get-char-property (line-beginning-position) 'invisible
)
520 (setq found-visible-child
'found
)))))
521 (eq found-visible-child
'found
)
524 (defun org-freemind-goto-line (line)
525 "Go to line number LINE."
528 (goto-char (point-min))
529 (forward-line (1- line
))))
531 (defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line
)
532 (with-current-buffer org-buffer
533 (dolist (node-style org-freemind-node-styles
)
534 (when (string-match-p (car node-style
) buffer-file-name
)
535 (setq org-freemind-node-style
(cadr node-style
))))
536 ;;(message "org-freemind-node-style =%s" org-freemind-node-style)
538 (let* ((drawers (copy-sequence org-drawers
))
554 (with-current-buffer mm-buffer
556 (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
557 (insert "<map version=\"0.9.0\">\n")
558 (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n"))
560 ;; Get special buffer vars:
561 (goto-char (point-min))
562 (while (re-search-forward (rx bol
"#+DRAWERS:") nil t
)
563 (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position))))
564 (setq drawers
(append drawers
(split-string dr-txt
) nil
))))
566 (concat (rx bol
(0+ blank
) ":")
579 ;; Get number of top nodes and last line for this node
581 (org-freemind-goto-line node-at-line
)
582 (unless (looking-at org-freemind-node-pattern
)
583 (error "No node at line %s" node-at-line
))
584 (setq node-at-line-level
(length (match-string-no-properties 1)))
586 (setq node-at-line-last
588 (while (re-search-forward org-freemind-node-pattern nil t
)
589 (let* ((m1 (match-string-no-properties 1))
591 (if (<= level node-at-line-level
)
594 (throw 'last-line
(1- (point))))
595 (if (= level
(1+ node-at-line-level
))
596 (setq num-top2-nodes
(1+ num-top2-nodes
))))))))
597 (setq current-level node-at-line-level
)
598 (setq num-top1-nodes
1)
599 (org-freemind-goto-line node-at-line
))
601 ;; First get number of top nodes
602 (goto-char (point-min))
603 (while (re-search-forward org-freemind-node-pattern nil t
)
604 (let* ((m1 (match-string-no-properties 1))
607 (setq num-top1-nodes
(1+ num-top1-nodes
))
609 (setq num-top2-nodes
(1+ num-top2-nodes
))))))
610 ;; If there is more than one top node we need to insert a node
611 ;; to keep them together.
612 (goto-char (point-min))
613 (when (> num-top1-nodes
1)
614 (setq num-top2-nodes num-top1-nodes
)
615 (setq current-level
0)
616 (let ((orig-name (if buffer-file-name
617 (file-name-nondirectory (buffer-file-name))
619 (with-current-buffer mm-buffer
620 (insert "<node text=\"" orig-name
"\" background_color=\"#00bfff\">\n"
621 ;; Put a note that this is for the parent node
622 "<richcontent TYPE=\"NOTE\"><html>"
627 org-freemind-org-nfix
"WHOLE FILE"
631 "</richcontent>\n")))))
633 (setq num-left-nodes
(floor num-top2-nodes
2))
634 (setq base-level current-level
)
637 this-children-visible
641 next-has-some-visible-child
642 next-children-visible
645 (re-search-forward org-freemind-node-pattern nil t
)
646 (if node-at-line-last
(<= (point) node-at-line-last
) t
)
648 (let* ((next-m1 (match-string-no-properties 1))
649 (next-node-end (match-end 0))
651 (setq next-node-start
(match-beginning 0))
652 (setq next-m2
(match-string-no-properties 2))
653 (setq next-level
(length next-m1
))
654 (when (> next-level current-level
)
655 (if (not (and org-odd-levels-only
656 (/= (mod current-level
2) 0)
657 (= next-level
(+ 2 current-level
))))
658 (setq skipping-odd nil
)
659 (setq skipping-odd t
)
660 (setq skipped-odd
(1+ skipped-odd
)))
661 (unless (or (= next-level
(1+ current-level
))
663 (if (or org-odd-levels-only
664 (/= next-level
(+ 2 current-level
)))
665 (error "Next level step > +1 for node ending at line %s" (line-number-at-pos))
666 (error "Next level step = +2 for node ending at line %s, forgot org-odd-levels-only?"
667 (line-number-at-pos)))
669 (setq next-children-visible
671 (get-char-property (line-end-position) 'invisible
))))
672 (setq next-has-some-visible-child
673 (if next-children-visible t
674 (org-freemind-look-for-visible-child next-level
)))
676 (setq num-left-nodes
(org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child
)))
677 (when (if (= num-top1-nodes
1) (> current-level base-level
) t
)
678 (while (>= current-level next-level
)
679 (with-current-buffer mm-buffer
681 (setq current-level
(1- current-level
))
682 (when (< 0 skipped-odd
)
683 (setq skipped-odd
(1- skipped-odd
))
684 (setq current-level
(1- current-level
)))
686 (setq this-node-end
(1+ next-node-end
))
687 (setq this-m2 next-m2
)
688 (setq current-level next-level
)
689 (setq this-children-visible next-children-visible
)
692 ;;; (unless (if node-at-line-last
693 ;;; (>= (point) node-at-line-last)
696 (setq this-m2 next-m2
)
697 (setq current-level next-level
)
698 (setq next-node-start
(if node-at-line-last
699 (1+ node-at-line-last
)
701 (setq num-left-nodes
(org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child
))
702 (with-current-buffer mm-buffer
(insert "</node>\n"))
705 (with-current-buffer mm-buffer
706 (while (> current-level base-level
)
708 (setq current-level
(1- current-level
))
710 (with-current-buffer mm-buffer
712 (delete-trailing-whitespace)
713 (goto-char (point-min))
716 (defun org-freemind-get-node-style (node-name)
718 ;;<node BACKGROUND_COLOR="#eeee00" CREATED="1234668815593" MODIFIED="1234668815593" STYLE="bubble">
719 ;;<font BOLD="true" NAME="SansSerif" SIZE="12"/>
722 (dolist (style-list org-freemind-node-style
)
723 (let ((node-regexp (car style-list
)))
724 (message "node-regexp=%s node-name=%s" node-regexp node-name
)
725 (when (string-match-p node-regexp node-name
)
726 ;;(setq node-style (org-freemind-do-apply-node-style style-list))
727 (setq node-style
(cadr style-list
))
729 (message "node-style=%s" node-style
)
730 (setq node-styles
(append node-styles node-style
)))
733 (defun org-freemind-do-apply-node-style (style-list)
734 (message "style-list=%S" style-list
)
735 (let ((node-style 'fork
)
737 (background-color "yellow")
743 (font-name "SansSerif")
745 (dolist (style (cadr style-list
))
746 (message " style=%s" style
)
747 (let ((what (car style
)))
749 ((eq what
'node-style
)
750 (setq node-style
(cadr style
)))
752 (setq color
(cadr style
)))
753 ((eq what
'background-color
)
754 (setq background-color
(cadr style
)))
756 ((eq what
'edge-color
)
757 (setq edge-color
(cadr style
)))
759 ((eq what
'edge-style
)
760 (setq edge-style
(cadr style
)))
762 ((eq what
'edge-width
)
763 (setq edge-width
(cadr style
)))
766 (setq italic
(cadr style
)))
769 (setq bold
(cadr style
)))
771 ((eq what
'font-name
)
772 (setq font-name
(cadr style
)))
774 ((eq what
'font-size
)
775 (setq font-size
(cadr style
)))
777 (insert (format " style=\"%s\"" node-style
))
778 (insert (format " color=\"%s\"" color
))
779 (insert (format " background_color=\"%s\"" background-color
))
782 (insert (format " color=\"%s\"" edge-color
))
783 (insert (format " style=\"%s\"" edge-style
))
784 (insert (format " width=\"%s\"" edge-width
))
787 (insert (format " italic=\"%s\"" italic
))
788 (insert (format " bold=\"%s\"" bold
))
789 (insert (format " name=\"%s\"" font-name
))
790 (insert (format " size=\"%s\"" font-size
))
794 (defun org-freemind-from-org-mode-node (node-line mm-file
)
795 "Convert node at line NODE-LINE to the FreeMind file MM-FILE."
798 (unless (org-back-to-heading nil
)
799 (error "Can't find org-mode node start"))
800 (let* ((line (line-number-at-pos))
801 (default-mm-file (concat (if buffer-file-name
802 (file-name-nondirectory buffer-file-name
)
804 "-line-" (number-to-string line
)
806 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file
)))
807 (list line mm-file
))))
808 (when (org-freemind-check-overwrite mm-file
(called-interactively-p 'any
))
809 (let ((org-buffer (current-buffer))
810 (mm-buffer (find-file-noselect mm-file
)))
811 (org-freemind-write-mm-buffer org-buffer mm-buffer node-line
)
812 (with-current-buffer mm-buffer
814 (when (called-interactively-p 'any
)
815 (switch-to-buffer-other-window mm-buffer
)
816 (when (y-or-n-p "Show in FreeMind? ")
817 (org-freemind-show buffer-file-name
)))))))
820 (defun org-freemind-from-org-mode (org-file mm-file
)
821 "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE."
822 ;; Fix-me: better doc, include recommendations etc.
824 (let* ((org-file buffer-file-name
)
825 (default-mm-file (concat
827 (file-name-nondirectory org-file
)
830 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file
)))
831 (list org-file mm-file
)))
832 (when (org-freemind-check-overwrite mm-file
(called-interactively-p 'any
))
833 (let ((org-buffer (if org-file
(find-file-noselect org-file
) (current-buffer)))
834 (mm-buffer (find-file-noselect mm-file
)))
835 (org-freemind-write-mm-buffer org-buffer mm-buffer nil
)
836 (with-current-buffer mm-buffer
838 (when (called-interactively-p 'any
)
839 (switch-to-buffer-other-window mm-buffer
)
840 (when (y-or-n-p "Show in FreeMind? ")
841 (org-freemind-show buffer-file-name
)))))))
844 (defun org-freemind-from-org-sparse-tree (org-buffer mm-file
)
845 "Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE."
847 (let* ((org-file buffer-file-name
)
848 (default-mm-file (concat
850 (file-name-nondirectory org-file
)
853 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file
)))
854 (list (current-buffer) mm-file
)))
855 (when (org-freemind-check-overwrite mm-file
(called-interactively-p 'any
))
857 (mm-buffer (find-file-noselect mm-file
)))
858 (save-window-excursion
859 (org-export-visible ?\ nil
)
860 (setq org-buffer
(current-buffer)))
861 (org-freemind-write-mm-buffer org-buffer mm-buffer nil
)
862 (with-current-buffer mm-buffer
864 (when (called-interactively-p 'any
)
865 (switch-to-buffer-other-window mm-buffer
)
866 (when (y-or-n-p "Show in FreeMind? ")
867 (org-freemind-show buffer-file-name
)))))))
870 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
873 ;; (sort '(b a c) 'org-freemind-lt-symbols)
874 (defun org-freemind-lt-symbols (sym-a sym-b
)
875 (string< (symbol-name sym-a
) (symbol-name sym-b
)))
876 ;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs)
877 (defun org-freemind-lt-xml-attrs (attr-a attr-b
)
878 (string< (symbol-name (car attr-a
)) (symbol-name (car attr-b
))))
880 ;; xml-parse-region gives things like
891 ;; (org-freemind-symbols= 'a (car '(A B)))
892 (defsubst org-freemind-symbols
= (sym-a sym-b
)
893 "Return t if downcased names of SYM-A and SYM-B are equal.
894 SYM-A and SYM-B should be symbols."
896 (string= (downcase (symbol-name sym-a
))
897 (downcase (symbol-name sym-b
)))))
899 (defun org-freemind-get-children (parent path
)
900 "Find children node to PARENT from PATH.
901 PATH should be a list of steps, where each step has the form
903 '(NODE-NAME (ATTR-NAME . ATTR-VALUE))"
904 ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val
905 ;; Fix-me: case insensitive version for children?
906 (let* ((children (if (not (listp (car parent
)))
911 (add-to-list 'cs c
)))
915 (step-node (if (listp step
) (car step
) step
))
916 (step-attr-list (when (listp step
) (sort (cdr step
) 'org-freemind-lt-xml-attrs
)))
917 (path-tail (cdr path
))
919 (dolist (child children
)
920 ;; skip xml.el formatting nodes
921 (unless (stringp child
)
923 (when (if (not step-node
)
925 (org-freemind-symbols= step-node
(car child
)))
926 (if (not step-attr-list
)
927 ;;(throw 'path-child child) ;; no attr to care about
928 (add-to-list 'path-children child
)
929 (let* ((child-attr-list (cadr child
))
930 (step-attr-copy (copy-sequence step-attr-list
)))
931 (dolist (child-attr child-attr-list
)
932 ;; Compare attr names:
933 (when (org-freemind-symbols= (caar step-attr-copy
) (car child-attr
))
935 (let ((step-val (cdar step-attr-copy
))
936 (child-val (cdr child-attr
)))
937 (when (if (not step-val
)
939 (string= step-val child-val
))
940 (setq step-attr-copy
(cdr step-attr-copy
))))))
942 (unless step-attr-copy
943 ;;(throw 'path-child child)
944 (add-to-list 'path-children child
)
947 (org-freemind-get-children path-children path-tail
)
950 (defun org-freemind-get-richcontent-node (node)
952 (org-freemind-get-children node
'((richcontent (type .
"NODE")) html body
))))
953 (when (> (length rc-nodes
) 1)
954 (lwarn t
:warning
"Unexpected structure: several <richcontent type=\"NODE\" ...>"))
957 (defun org-freemind-get-richcontent-note (node)
959 (org-freemind-get-children node
'((richcontent (type .
"NOTE")) html body
))))
960 (when (> (length rc-notes
) 1)
961 (lwarn t
:warning
"Unexpected structure: several <richcontent type=\"NOTE\" ...>"))
964 (defun org-freemind-test-get-tree-text ()
965 (let ((node '(p nil
"\n"
972 (org-freemind-get-tree-text node
)))
973 ;; (org-freemind-test-get-tree-text)
975 (defun org-freemind-get-tree-text (node)
982 ;;(a (setq is-link t) )
983 ((h1 h2 h3 h4 h5 h6 p
)
984 ;;(setq ntxt (concat "\n" ntxt))
993 (when (string= n
"\n") (setq n
""))
995 (setq ntxt
(concat ntxt
996 "[[" link
"][" n
"]]"))
997 (setq ntxt
(concat ntxt n
))))
999 (if (symbolp (car n
))
1000 (setq ntxt
(concat ntxt
(org-freemind-get-tree-text n
)))
1001 ;; This should be the attributes:
1003 (let ((att (car att-val
))
1004 (val (cdr att-val
)))
1005 (when (eq att
'href
)
1009 (setq ntxt
(concat ntxt
(make-string lf-after ?
\n)))
1010 (setq ntxt
(concat ntxt
" ")))
1011 ;;(setq ntxt (concat ntxt (format "{%s}" n)))
1014 (defun org-freemind-get-richcontent-node-text (node)
1015 "Get the node text as from the richcontent node NODE."
1017 (let* ((rc (org-freemind-get-richcontent-node node
))
1018 (txt (org-freemind-get-tree-text rc
)))
1019 ;;(when txt (setq txt (replace-regexp-in-string (rx (1+ whitespace)) " " txt)))
1023 (defun org-freemind-get-richcontent-note-text (node)
1024 "Get the node text as from the richcontent note NODE."
1026 (let* ((rc (org-freemind-get-richcontent-note node
))
1027 (txt (when rc
(org-freemind-get-tree-text rc
))))
1028 ;;(when txt (setq txt (replace-regexp-in-string (rx (1+ whitespace)) " " txt)))
1032 (defun org-freemind-get-icon-names (node)
1033 (let* ((icon-nodes (org-freemind-get-children node
'((icon ))))
1035 (dolist (icn icon-nodes
)
1036 (setq names
(cons (cdr (assq 'builtin
(cadr icn
))) names
)))
1037 ;; (icon (builtin . "full-1"))
1040 (defun org-freemind-node-to-org (node level skip-levels
)
1041 (let ((qname (car node
))
1042 (attributes (cadr node
))
1044 (note (org-freemind-get-richcontent-note-text node
))
1045 (mark "-- This is more about ")
1046 (icons (org-freemind-get-icon-names node
))
1047 (children (cddr node
)))
1048 (when (< 0 (- level skip-levels
))
1049 (dolist (attrib attributes
)
1051 ('TEXT
(setq text
(cdr attrib
)))
1052 ('text
(setq text
(cdr attrib
)))))
1054 ;; There should be a richcontent node holding the text:
1055 (setq text
(org-freemind-get-richcontent-node-text node
)))
1057 (when (member "full-1" icons
) (setq text
(concat "[#A] " text
)))
1058 (when (member "full-2" icons
) (setq text
(concat "[#B] " text
)))
1059 (when (member "full-3" icons
) (setq text
(concat "[#C] " text
)))
1060 (when (member "full-4" icons
) (setq text
(concat "[#D] " text
)))
1061 (when (member "full-5" icons
) (setq text
(concat "[#E] " text
)))
1062 (when (member "full-6" icons
) (setq text
(concat "[#F] " text
)))
1063 (when (member "full-7" icons
) (setq text
(concat "[#G] " text
)))
1064 (when (member "button_cancel" icons
) (setq text
(concat "TODO " text
)))
1067 (string= mark
(substring note
0 (length mark
))))
1069 (setq text
(replace-regexp-in-string "\n $" "" text
))
1073 (insert (make-string (- level skip-levels
) ?
*) " " text
"\n")
1075 (dolist (child children
)
1076 (unless (or (null child
)
1078 (org-freemind-node-to-org child
(1+ level
) skip-levels
)))))
1080 ;; Fix-me: put back special things, like drawers that are stored in
1081 ;; the notes. Should maybe all notes contents be put in drawers?
1083 (defun org-freemind-to-org-mode (mm-file org-file
)
1084 "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."
1087 (let* ((mm-file (buffer-file-name))
1088 (default-org-file (concat (file-name-nondirectory mm-file
) ".org"))
1089 (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file
)))
1090 (list mm-file org-file
))))
1091 (when (org-freemind-check-overwrite org-file
(called-interactively-p 'any
))
1092 (let ((mm-buffer (find-file-noselect mm-file
))
1093 (org-buffer (find-file-noselect org-file
)))
1094 (with-current-buffer mm-buffer
1095 (let* ((xml-list (xml-parse-file mm-file
))
1096 (top-node (cadr (cddar xml-list
)))
1097 (note (org-freemind-get-richcontent-note-text top-node
))
1100 (string-match (rx bol
"--org-mode: WHOLE FILE" eol
) note
))
1103 (with-current-buffer org-buffer
1105 (org-freemind-node-to-org top-node
1 skip-levels
)
1106 (goto-char (point-min))
1107 (org-set-tags t t
) ;; Align all tags
1109 (switch-to-buffer-other-window org-buffer
)
1112 (provide 'org-freemind
)
1114 ;; arch-tag: e7b0d776-94fd-404a-b35e-0f855fae3627
1116 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1117 ;;; org-freemind.el ends here