1 ;;; org-freemind.el --- Export Org files to freemind
3 ;; Copyright (C) 2009-2011 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
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;; --------------------------------------------------------------------
25 ;; Features that might be required by this library:
27 ;; `backquote', `bytecomp', `cl', `easymenu', `font-lock',
28 ;; `noutline', `org', `org-compat', `org-faces', `org-footnote',
29 ;; `org-list', `org-macs', `org-src', `outline', `syntax',
30 ;; `time-date', `xml'.
32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 ;; This file tries to implement some functions useful for
37 ;; transformation between org-mode and FreeMind files.
39 ;; Here are the commands you can use:
41 ;; M-x `org-freemind-from-org-mode'
42 ;; M-x `org-freemind-from-org-mode-node'
43 ;; M-x `org-freemind-from-org-sparse-tree'
45 ;; M-x `org-freemind-to-org-mode'
47 ;; M-x `org-freemind-show'
49 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53 ;; 2009-02-15: Added check for next level=current+1
54 ;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'.
55 ;; 2009-10-25: Added support for `org-odd-levels-only'.
56 ;; Added y/n question before showing in FreeMind.
57 ;; 2009-11-04: Added support for #+BEGIN_HTML.
60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62 ;; This program is free software; you can redistribute it and/or
63 ;; modify it under the terms of the GNU General Public License as
64 ;; published by the Free Software Foundation; either version 2, or
65 ;; (at your option) any later version.
67 ;; This program is distributed in the hope that it will be useful,
68 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
69 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
70 ;; General Public License for more details.
72 ;; You should have received a copy of the GNU General Public License
73 ;; along with this program; see the file COPYING. If not, write to
74 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
75 ;; Floor, Boston, MA 02110-1301, USA.
77 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
85 (eval-when-compile (require 'cl
))
87 (defgroup org-freemind nil
88 "Customization group for org-freemind export/import."
91 ;; Fix-me: I am not sure these are useful:
93 ;; (defcustom org-freemind-main-fgcolor "black"
94 ;; "Color of main node's text."
96 ;; :group 'org-freemind)
98 ;; (defcustom org-freemind-main-color "black"
99 ;; "Background color of main node."
101 ;; :group 'org-freemind)
103 ;; (defcustom org-freemind-child-fgcolor "black"
104 ;; "Color of child nodes' text."
106 ;; :group 'org-freemind)
108 ;; (defcustom org-freemind-child-color "black"
109 ;; "Background color of child nodes."
111 ;; :group 'org-freemind)
113 (defvar org-freemind-node-style nil
"Internal use.")
115 (defcustom org-freemind-node-styles nil
116 "Styles to apply to node.
119 (list :tag
"Node styles for file"
120 (regexp :tag
"File name")
123 (regexp :tag
"Node name regexp")
124 (set :tag
"Node properties"
125 (list :format
"%v" (const :format
"" node-style
)
130 (list :format
"%v" (const :format
"" color
)
131 (color :tag
"Color" :value
"red"))
132 (list :format
"%v" (const :format
"" background-color
)
133 (color :tag
"Background color" :value
"yellow"))
134 (list :format
"%v" (const :format
"" edge-color
)
135 (color :tag
"Edge color" :value
"green"))
136 (list :format
"%v" (const :format
"" edge-style
)
137 (choice :tag
"Edge style" :value bezier
138 (const :tag
"Linear" linear
)
139 (const :tag
"Bezier" bezier
)
140 (const :tag
"Sharp Linear" sharp-linear
)
141 (const :tag
"Sharp Bezier" sharp-bezier
)))
142 (list :format
"%v" (const :format
"" edge-width
)
143 (choice :tag
"Edge width" :value thin
144 (const :tag
"Parent" parent
)
145 (const :tag
"Thin" thin
)
150 (list :format
"%v" (const :format
"" italic
)
151 (const :tag
"Italic font" t
))
152 (list :format
"%v" (const :format
"" bold
)
153 (const :tag
"Bold font" t
))
154 (list :format
"%v" (const :format
"" font-name
)
155 (string :tag
"Font name" :value
"SansSerif"))
156 (list :format
"%v" (const :format
"" font-size
)
157 (integer :tag
"Font size" :value
12)))))))
158 :group
'org-freemind
)
161 (defun org-export-as-freemind (&optional hidden ext-plist
162 to-buffer body-only pub-dir
)
163 "Export the current buffer as a Freemind file.
164 If there is an active region, export only the region. HIDDEN is
165 obsolete and does nothing. EXT-PLIST is a property list with
166 external parameters overriding org-mode's default settings, but
167 still inferior to file-local settings. When TO-BUFFER is
168 non-nil, create a buffer with that name and export to that
169 buffer. If TO-BUFFER is the symbol `string', don't leave any
170 buffer behind but just return the resulting HTML as a string.
171 When BODY-ONLY is set, don't produce the file header and footer,
172 simply return the content of the document (all top level
173 sections). When PUB-DIR is set, use this as the publishing
176 See `org-freemind-from-org-mode' for more information."
178 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
180 (org-infile-export-plist)))
181 (region-p (org-region-active-p))
182 (rbeg (and region-p
(region-beginning)))
183 (rend (and region-p
(region-end)))
185 (if (plist-get opt-plist
:ignore-subtree-p
)
190 (and (org-at-heading-p)
191 (>= (org-end-of-subtree t t
) rend
))))))
192 (opt-plist (setq org-export-opt-plist
194 (org-export-add-subtree-options opt-plist rbeg
)
196 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
197 (filename (concat (file-name-as-directory
199 (org-export-directory :ascii opt-plist
)))
200 (file-name-sans-extension
202 (org-entry-get (region-beginning)
203 "EXPORT_FILE_NAME" t
))
204 (file-name-nondirectory bfname
)))
206 (when (file-exists-p filename
)
207 (delete-file filename
))
210 (org-freemind-from-org-mode-node (line-number-at-pos rbeg
)
212 (t (org-freemind-from-org-mode bfname filename
)))))
215 (defun org-freemind-show (mm-file)
216 "Show file MM-FILE in Freemind."
220 (let ((name (read-file-name "FreeMind file: "
222 (if (buffer-file-name)
223 (let* ((name-ext (file-name-nondirectory (buffer-file-name)))
224 (name (file-name-sans-extension name-ext
))
225 (ext (file-name-extension name-ext
)))
230 (let ((name-mm (concat name
".mm")))
231 (if (file-exists-p name-mm
)
233 (message "Not exported to Freemind format yet")
238 ;; Fix-me: Is this an Emacs bug?
239 ;; This predicate function is never
242 (string-match "^mm$" (file-name-extension fn
))))))
243 (setq name
(expand-file-name name
))
245 (org-open-file mm-file
))
247 (defconst org-freemind-org-nfix
"--org-mode: ")
249 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
250 ;;; Format converters
252 (defun org-freemind-escape-str-from-org (org-str)
253 "Do some html-escaping of ORG-STR and return the result.
254 The characters \"&<> will be escaped."
255 (let ((chars (append org-str nil
))
262 ((= cc ?
\") """)
266 (t (char-to-string cc
)))
267 ;; Formatting as &#number; is maybe needed
268 ;; according to a bug report from kazuo
269 ;; fujimoto, but I have now instead added a xml
270 ;; processing instruction saying that the mm
273 ;; (format "&#x%x;" (- cc ;; ?\x800))
274 (format "&#x%x;" (encode-char cc
'ucs
))
278 ;;(org-freemind-unescape-str-to-org "mA≌B<C<=")
279 ;;(org-freemind-unescape-str-to-org "<<")
280 (defun org-freemind-unescape-str-to-org (fm-str)
281 "Do some html-unescaping of FM-STR and return the result.
282 This is the opposite of `org-freemind-escape-str-from-org' but it
283 will also unescape &#nn;."
284 (let ((org-str fm-str
))
285 (setq org-str
(replace-regexp-in-string """ "\"" org-str
))
286 (setq org-str
(replace-regexp-in-string "&" "&" org-str
))
287 (setq org-str
(replace-regexp-in-string "<" "<" org-str
))
288 (setq org-str
(replace-regexp-in-string ">" ">" org-str
))
289 (setq org-str
(replace-regexp-in-string
290 "&#x\\([a-f0-9]\\{2,4\\}\\);"
293 (+ (string-to-number (match-string 1 m
) 16)
294 0 ;?\x800 ;; What is this for? Encoding?
298 ;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
299 ;; (str2 (org-freemind-escape-str-from-org str1))
300 ;; (str3 (org-freemind-unescape-str-to-org str2)))
301 ;; (unless (string= str1 str3)
302 ;; (error "Error str3=%s" str3)))
304 (defun org-freemind-convert-links-helper (matched)
305 "Helper for `org-freemind-convert-links-from-org'.
306 MATCHED is the link just matched."
307 (let* ((link (match-string 1 matched
))
308 (text (match-string 2 matched
))
309 (ext (file-name-extension link
))
310 (col-pos (org-string-match-p ":" link
))
311 (is-img (and (image-type-from-file-name link
)
312 (let ((url-type (substring link
0 col-pos
)))
313 (member url-type
'("file" "http" "https")))))
316 ;; Fix-me: I can't find a way to get the border to "shrink
317 ;; wrap" around the image using <div>.
319 ;; (concat "<div style=\"border: solid 1px #ddd; width:auto;\">"
320 ;; "<img src=\"" link "\" alt=\"" text "\" />"
324 (concat "<table border=\"0\" style=\"border: solid 1px #ddd;\"><tr><td>"
325 "<img src=\"" link
"\" alt=\"" text
"\" />"
328 "</td></tr></table>")
329 (concat "<a href=\"" link
"\">" text
"</a>"))))
331 (defun org-freemind-convert-links-from-org (org-str)
332 "Convert org links in ORG-STR to freemind links and return the result."
333 (let ((fm-str (replace-regexp-in-string
334 ;;(rx (not (any "[\""))
340 ;; (any "-%.?@a-zA-Z0-9()_/:~=&#"))))
341 "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)"
348 (replace-regexp-in-string
350 ;; (submatch (*? nonl))
352 ;; (submatch (*? nonl))
354 "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]"
355 ;;"<a href=\"\\1\">\\2</a>"
356 'org-freemind-convert-links-helper
359 ;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>")
360 (defun org-freemind-convert-links-to-org (fm-str)
361 "Convert freemind links in FM-STR to org links and return the result."
362 (let ((org-str (replace-regexp-in-string
366 ;; (0+ (not (any ">")))
369 ;; (submatch (0+ (not (any "\""))))
371 ;; (0+ (not (any ">")))
373 ;; (submatch (0+ (not (any "<"))))
375 "<a[[:space:]]\\(?:[^>]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)</a>"
381 ;;(defun org-freemind-convert-drawers-from-org (text)
384 ;; (let* ((str1 "[[http://www.somewhere/][link-text]")
385 ;; (str2 (org-freemind-convert-links-from-org str1))
386 ;; (str3 (org-freemind-convert-links-to-org str2)))
387 ;; (unless (string= str1 str3)
388 ;; (error "Error str3=%s" str3)))
390 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
393 (defvar org-freemind-bol-helper-base-indent nil
)
395 (defun org-freemind-bol-helper (matched)
396 "Helper for `org-freemind-convert-text-p'.
397 MATCHED is the link just matched."
399 (bi org-freemind-bol-helper-base-indent
))
400 (dolist (cc (append matched nil
))
402 ;;(setq res (concat res " "))
403 ;; We need to use the numerical version. Otherwise Freemind
404 ;; ver 0.9.0 RC9 can not export to html/javascript.
408 (setq res
(concat res
" "))))
409 (setq res
(concat res
(char-to-string cc
)))))
411 ;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n "))
413 (defun org-freemind-convert-text-p (text)
414 "Convert TEXT to html with <p> paragraphs."
415 ;; (string-match-p "[^ ]" " a")
416 (setq org-freemind-bol-helper-base-indent
(org-string-match-p "[^ ]" text
))
417 (setq text
(org-freemind-escape-str-from-org text
))
419 (setq text
(replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text
))
420 (setq text
(replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1<b>\\3</b>\\5" text
))
422 (setq text
(concat "<p>" text
))
423 (setq text
(replace-regexp-in-string "\n[[:blank:]]*\n" "</p><p>" text
))
424 (setq text
(replace-regexp-in-string "\\(?:<p>\\|\n\\) +" 'org-freemind-bol-helper text
))
425 (setq text
(replace-regexp-in-string "\n" "<br />" text
))
426 (setq text
(concat text
"</p>"))
428 (org-freemind-convert-links-from-org text
))
430 (defcustom org-freemind-node-css-style
431 "p { margin-top: 3px; margin-bottom: 3px; }"
432 "CSS style for Freemind nodes."
433 ;; Fix-me: I do not understand this. It worked to export from Freemind
434 ;; with this setting now, but not before??? Was this perhaps a java
435 ;; bug or is it a windows xp bug (some resource gets exhausted if you
436 ;; use sticky keys which I do).
437 :group
'org-freemind
)
439 (defun org-freemind-org-text-to-freemind-subnode/note
(node-name start end drawers-regexp
)
440 "Convert text part of org node to freemind subnode or note.
441 Convert the text part of the org node named NODE-NAME. The text
442 is in the current buffer between START and END. Drawers matching
443 DRAWERS-REGEXP are converted to freemind notes."
445 (let ((text (buffer-substring-no-properties start end
))
449 ;;(setq text (org-freemind-escape-str-from-org text))
450 ;; First see if there is something that should be moved to the
453 (while (string-match drawers-regexp text
)
454 (setq drawers
(cons (match-string 0 text
) drawers
))
456 (concat (substring text
0 (match-beginning 0))
457 (substring text
(match-end 0))))
460 (dolist (drawer drawers
)
461 (let ((lines (split-string drawer
"\n")))
463 (setq note-res
(concat
465 org-freemind-org-nfix line
"<br />\n")))
468 (when (> (length note-res
) 0)
469 (setq note-res
(concat
470 "<richcontent TYPE=\"NOTE\"><html>\n"
480 ;; There is always an LF char:
481 (when (> (length text
) 1)
482 (setq node-res
(concat
483 "<node style=\"bubble\" background_color=\"#eeee00\">\n"
484 "<richcontent TYPE=\"NODE\"><html>\n"
486 (if (= 0 (length org-freemind-node-css-style
))
489 "<style type=\"text/css\">\n"
491 org-freemind-node-css-style
496 (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML"))
497 (end-html-mark (regexp-quote "#+END_HTML"))
502 ;; Take care of #+BEGIN_HTML - #+END_HTML
503 (while (string-match begin-html-mark text
)
504 (setq head
(substring text
0 (match-beginning 0)))
505 (setq end-pos-match
(match-end 0))
506 (setq node-res
(concat node-res
507 (org-freemind-convert-text-p head
)))
508 (setq text
(substring text end-pos-match
))
509 (setq end-pos
(string-match end-html-mark text
))
511 (setq end-pos-match
(match-end 0))
512 (message "org-freemind: Missing #+END_HTML")
513 (setq end-pos
(length text
))
514 (setq end-pos-match end-pos
))
515 (setq node-res
(concat node-res
516 (substring text
0 end-pos
)))
517 (setq text
(substring text end-pos-match
)))
518 (setq node-res
(concat node-res
519 (org-freemind-convert-text-p text
))))
520 (setq node-res
(concat
525 ;; Put a note that this is for the parent node
526 ;; "<richcontent TYPE=\"NOTE\"><html>"
531 ;; "-- This is more about \"" node-name "\" --"
535 ;; "</richcontent>\n"
539 (list node-res note-res
))))
541 (defun org-freemind-write-node (mm-buffer drawers-regexp
542 num-left-nodes base-level
543 current-level next-level this-m2
545 this-children-visible
547 next-has-some-visible-child
)
554 (when (string-match "TODO" this-m2
)
555 (setq this-m2
(replace-match "" nil nil this-m2
))
556 (add-to-list 'this-icons
"button_cancel")
557 (setq this-bg-color
"#ffff88")
558 (when (string-match "\\[#\\(.\\)\\]" this-m2
)
559 (let ((prior (string-to-char (match-string 1 this-m2
))))
560 (setq this-m2
(replace-match "" nil nil this-m2
))
563 (add-to-list 'this-icons
"full-1")
564 (setq this-bg-color
"#ff0000"))
566 (add-to-list 'this-icons
"full-2")
567 (setq this-bg-color
"#ffaa00"))
569 (add-to-list 'this-icons
"full-3")
570 (setq this-bg-color
"#ffdd00"))
572 (add-to-list 'this-icons
"full-4")
573 (setq this-bg-color
"#ffff00"))
575 (add-to-list 'this-icons
"full-5"))
577 (add-to-list 'this-icons
"full-6"))
579 (add-to-list 'this-icons
"full-7"))
581 (setq this-m2
(org-trim this-m2
))
582 (setq this-m2-escaped
(org-freemind-escape-str-from-org this-m2
))
583 (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
588 (setq this-rich-node
(nth 0 node-notes
))
589 (setq this-rich-note
(nth 1 node-notes
)))
590 (with-current-buffer mm-buffer
591 (insert "<node text=\"" this-m2-escaped
"\"")
592 (org-freemind-get-node-style this-m2
)
593 (when (> next-level current-level
)
594 (unless (or this-children-visible
595 next-has-some-visible-child
)
596 (insert " folded=\"true\"")))
597 (when (and (= current-level
(1+ base-level
))
598 (> num-left-nodes
0))
599 (setq num-left-nodes
(1- num-left-nodes
))
600 (insert " position=\"left\""))
602 (insert " background_color=\"" this-bg-color
"\""))
605 (dolist (icon this-icons
)
606 (insert "<icon builtin=\"" icon
"\"/>\n")))
608 (with-current-buffer mm-buffer
609 ;;(when this-rich-note (insert this-rich-note))
610 (when this-rich-node
(insert this-rich-node
))))
613 (defun org-freemind-check-overwrite (file interactively
)
614 "Check if file FILE already exists.
615 If FILE does not exists return t.
617 If INTERACTIVELY is non-nil ask if the file should be replaced
618 and return t/nil if it should/should not be replaced.
620 Otherwise give an error say the file exists."
621 (if (file-exists-p file
)
623 (y-or-n-p (format "File %s exists, replace it? " file
))
624 (error "File %s already exists" file
))
627 (defvar org-freemind-node-pattern
629 ;; (submatch (1+ "*"))
631 ;; (submatch (*? nonl))
633 "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$")
635 (defun org-freemind-look-for-visible-child (node-level)
638 (let ((found-visible-child nil
))
639 (while (and (not found-visible-child
)
640 (re-search-forward org-freemind-node-pattern nil t
))
641 (let* ((m1 (match-string-no-properties 1))
643 (if (>= node-level level
)
644 (setq found-visible-child
'none
)
645 (unless (get-char-property (line-beginning-position) 'invisible
)
646 (setq found-visible-child
'found
)))))
647 (eq found-visible-child
'found
)
650 (defun org-freemind-goto-line (line)
651 "Go to line number LINE."
654 (goto-char (point-min))
655 (forward-line (1- line
))))
657 (defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line
)
658 (with-current-buffer org-buffer
659 (dolist (node-style org-freemind-node-styles
)
660 (when (org-string-match-p (car node-style
) buffer-file-name
)
661 (setq org-freemind-node-style
(cadr node-style
))))
662 ;;(message "org-freemind-node-style =%s" org-freemind-node-style)
664 (let* ((drawers (copy-sequence org-drawers
))
670 (odd-only org-odd-levels-only
)
679 (with-current-buffer mm-buffer
681 (setq buffer-file-coding-system
'utf-8
)
682 ;; Fix-me: Currentl Freemind (ver 0.9.0 RC9) does not support this:
683 ;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
684 (insert "<map version=\"0.9.0\">\n")
685 (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n"))
687 ;; Get special buffer vars:
688 (goto-char (point-min))
689 (message "Writing Freemind file...")
690 (while (re-search-forward "^#\\+DRAWERS:" nil t
)
691 (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position))))
692 (setq drawers
(append drawers
(split-string dr-txt
) nil
))))
694 (concat "^[[:blank:]]*:"
704 ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$"
708 ;; Get number of top nodes and last line for this node
710 (org-freemind-goto-line node-at-line
)
711 (unless (looking-at org-freemind-node-pattern
)
712 (error "No node at line %s" node-at-line
))
713 (setq node-at-line-level
(length (match-string-no-properties 1)))
715 (setq node-at-line-last
717 (while (re-search-forward org-freemind-node-pattern nil t
)
718 (let* ((m1 (match-string-no-properties 1))
720 (if (<= level node-at-line-level
)
723 (throw 'last-line
(1- (point))))
724 (if (= level
(1+ node-at-line-level
))
725 (setq num-top2-nodes
(1+ num-top2-nodes
))))))))
726 (setq current-level node-at-line-level
)
727 (setq num-top1-nodes
1)
728 (org-freemind-goto-line node-at-line
))
730 ;; First get number of top nodes
731 (goto-char (point-min))
732 (while (re-search-forward org-freemind-node-pattern nil t
)
733 (let* ((m1 (match-string-no-properties 1))
736 (setq num-top1-nodes
(1+ num-top1-nodes
))
738 (setq num-top2-nodes
(1+ num-top2-nodes
))))))
739 ;; If there is more than one top node we need to insert a node
740 ;; to keep them together.
741 (goto-char (point-min))
742 (when (> num-top1-nodes
1)
743 (setq num-top2-nodes num-top1-nodes
)
744 (setq current-level
0)
745 (let ((orig-name (if buffer-file-name
746 (file-name-nondirectory (buffer-file-name))
748 (with-current-buffer mm-buffer
749 (insert "<node text=\"" orig-name
"\" background_color=\"#00bfff\">\n"
750 ;; Put a note that this is for the parent node
751 "<richcontent TYPE=\"NOTE\"><html>"
756 org-freemind-org-nfix
"WHOLE FILE"
760 "</richcontent>\n")))))
762 (setq num-left-nodes
(floor num-top2-nodes
2))
763 (setq base-level current-level
)
766 this-children-visible
770 next-has-some-visible-child
771 next-children-visible
774 (re-search-forward org-freemind-node-pattern nil t
)
775 (if node-at-line-last
(<= (point) node-at-line-last
) t
)
777 (let* ((next-m1 (match-string-no-properties 1))
778 (next-node-end (match-end 0))
780 (setq next-node-start
(match-beginning 0))
781 (setq next-m2
(match-string-no-properties 2))
782 (setq next-level
(length next-m1
))
783 (setq next-children-visible
785 (get-char-property (line-end-position) 'invisible
))))
786 (setq next-has-some-visible-child
787 (if next-children-visible t
788 (org-freemind-look-for-visible-child next-level
)))
790 (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
)))
791 (when (if (= num-top1-nodes
1) (> current-level base-level
) t
)
792 (while (>= current-level next-level
)
793 (with-current-buffer mm-buffer
796 (- current-level
(if odd-only
2 1))))))
797 (setq this-node-end
(1+ next-node-end
))
798 (setq this-m2 next-m2
)
799 (setq current-level next-level
)
800 (setq this-children-visible next-children-visible
)
803 ;;; (unless (if node-at-line-last
804 ;;; (>= (point) node-at-line-last)
807 (setq this-m2 next-m2
)
808 (setq current-level next-level
)
809 (setq next-node-start
(if node-at-line-last
810 (1+ node-at-line-last
)
812 (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
))
813 (with-current-buffer mm-buffer
(insert "</node>\n"))
816 (with-current-buffer mm-buffer
817 (while (> current-level base-level
)
820 (- current-level
(if odd-only
2 1)))
822 (with-current-buffer mm-buffer
824 (delete-trailing-whitespace)
825 (goto-char (point-min))
828 (defun org-freemind-get-node-style (node-name)
830 ;;<node BACKGROUND_COLOR="#eeee00" CREATED="1234668815593" MODIFIED="1234668815593" STYLE="bubble">
831 ;;<font BOLD="true" NAME="SansSerif" SIZE="12"/>
834 (dolist (style-list org-freemind-node-style
)
835 (let ((node-regexp (car style-list
)))
836 (message "node-regexp=%s node-name=%s" node-regexp node-name
)
837 (when (org-string-match-p node-regexp node-name
)
838 ;;(setq node-style (org-freemind-do-apply-node-style style-list))
839 (setq node-style
(cadr style-list
))
841 (message "node-style=%s" node-style
)
842 (setq node-styles
(append node-styles node-style
)))
845 (defun org-freemind-do-apply-node-style (style-list)
846 (message "style-list=%S" style-list
)
847 (let ((node-style 'fork
)
849 (background-color "yellow")
855 (font-name "SansSerif")
857 (dolist (style (cadr style-list
))
858 (message " style=%s" style
)
859 (let ((what (car style
)))
861 ((eq what
'node-style
)
862 (setq node-style
(cadr style
)))
864 (setq color
(cadr style
)))
865 ((eq what
'background-color
)
866 (setq background-color
(cadr style
)))
868 ((eq what
'edge-color
)
869 (setq edge-color
(cadr style
)))
871 ((eq what
'edge-style
)
872 (setq edge-style
(cadr style
)))
874 ((eq what
'edge-width
)
875 (setq edge-width
(cadr style
)))
878 (setq italic
(cadr style
)))
881 (setq bold
(cadr style
)))
883 ((eq what
'font-name
)
884 (setq font-name
(cadr style
)))
886 ((eq what
'font-size
)
887 (setq font-size
(cadr style
)))
889 (insert (format " style=\"%s\"" node-style
))
890 (insert (format " color=\"%s\"" color
))
891 (insert (format " background_color=\"%s\"" background-color
))
894 (insert (format " color=\"%s\"" edge-color
))
895 (insert (format " style=\"%s\"" edge-style
))
896 (insert (format " width=\"%s\"" edge-width
))
899 (insert (format " italic=\"%s\"" italic
))
900 (insert (format " bold=\"%s\"" bold
))
901 (insert (format " name=\"%s\"" font-name
))
902 (insert (format " size=\"%s\"" font-size
))
906 (defun org-freemind-from-org-mode-node (node-line mm-file
)
907 "Convert node at line NODE-LINE to the FreeMind file MM-FILE.
908 See `org-freemind-from-org-mode' for more information."
911 (unless (org-back-to-heading nil
)
912 (error "Can't find org-mode node start"))
913 (let* ((line (line-number-at-pos))
914 (default-mm-file (concat (if buffer-file-name
915 (file-name-nondirectory buffer-file-name
)
917 "-line-" (number-to-string line
)
919 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file
)))
920 (list line mm-file
))))
921 (when (org-freemind-check-overwrite mm-file
(org-called-interactively-p 'any
))
922 (let ((org-buffer (current-buffer))
923 (mm-buffer (find-file-noselect mm-file
)))
924 (org-freemind-write-mm-buffer org-buffer mm-buffer node-line
)
925 (with-current-buffer mm-buffer
927 (when (org-called-interactively-p 'any
)
928 (switch-to-buffer-other-window mm-buffer
)
929 (when (y-or-n-p "Show in FreeMind? ")
930 (org-freemind-show buffer-file-name
)))))))
933 (defun org-freemind-from-org-mode (org-file mm-file
)
934 "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE.
935 All the nodes will be opened or closed in Freemind just as you
936 have them in `org-mode'.
938 Note that exporting to Freemind also gives you an alternative way
939 to export from `org-mode' to html. You can create a dynamic html
940 version of the your org file, by first exporting to Freemind and
941 then exporting from Freemind to html. The 'As
942 XHTML (JavaScript)' version in Freemind works very well \(and you
943 can use a CSS stylesheet to style it)."
944 ;; Fix-me: better doc, include recommendations etc.
946 (let* ((org-file buffer-file-name
)
947 (default-mm-file (concat
949 (file-name-nondirectory org-file
)
952 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file
)))
953 (list org-file mm-file
)))
954 (when (org-freemind-check-overwrite mm-file
(org-called-interactively-p 'any
))
955 (let ((org-buffer (if org-file
(find-file-noselect org-file
) (current-buffer)))
956 (mm-buffer (find-file-noselect mm-file
)))
957 (org-freemind-write-mm-buffer org-buffer mm-buffer nil
)
958 (with-current-buffer mm-buffer
960 (when (org-called-interactively-p 'any
)
961 (switch-to-buffer-other-window mm-buffer
)
962 (when (y-or-n-p "Show in FreeMind? ")
963 (org-freemind-show buffer-file-name
)))))))
966 (defun org-freemind-from-org-sparse-tree (org-buffer mm-file
)
967 "Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE."
969 (let* ((org-file buffer-file-name
)
970 (default-mm-file (concat
972 (file-name-nondirectory org-file
)
975 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file
)))
976 (list (current-buffer) mm-file
)))
977 (when (org-freemind-check-overwrite mm-file
(org-called-interactively-p 'any
))
979 (mm-buffer (find-file-noselect mm-file
)))
980 (save-window-excursion
981 (org-export-visible ?\ nil
)
982 (setq org-buffer
(current-buffer)))
983 (org-freemind-write-mm-buffer org-buffer mm-buffer nil
)
984 (with-current-buffer mm-buffer
986 (when (org-called-interactively-p 'any
)
987 (switch-to-buffer-other-window mm-buffer
)
988 (when (y-or-n-p "Show in FreeMind? ")
989 (org-freemind-show buffer-file-name
)))))))
992 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
995 ;; (sort '(b a c) 'org-freemind-lt-symbols)
996 (defun org-freemind-lt-symbols (sym-a sym-b
)
997 (string< (symbol-name sym-a
) (symbol-name sym-b
)))
998 ;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs)
999 (defun org-freemind-lt-xml-attrs (attr-a attr-b
)
1000 (string< (symbol-name (car attr-a
)) (symbol-name (car attr-b
))))
1002 ;; xml-parse-region gives things like
1005 ;; ((href . "link"))
1013 ;; (org-freemind-symbols= 'a (car '(A B)))
1014 (defsubst org-freemind-symbols
= (sym-a sym-b
)
1015 "Return t if downcased names of SYM-A and SYM-B are equal.
1016 SYM-A and SYM-B should be symbols."
1017 (or (eq sym-a sym-b
)
1018 (string= (downcase (symbol-name sym-a
))
1019 (downcase (symbol-name sym-b
)))))
1021 (defun org-freemind-get-children (parent path
)
1022 "Find children node to PARENT from PATH.
1023 PATH should be a list of steps, where each step has the form
1025 '(NODE-NAME (ATTR-NAME . ATTR-VALUE))"
1026 ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val
1027 ;; Fix-me: case insensitive version for children?
1028 (let* ((children (if (not (listp (car parent
)))
1032 (dolist (c (cddr p
))
1033 (add-to-list 'cs c
)))
1037 (step-node (if (listp step
) (car step
) step
))
1038 (step-attr-list (when (listp step
) (sort (cdr step
) 'org-freemind-lt-xml-attrs
)))
1039 (path-tail (cdr path
))
1041 (dolist (child children
)
1042 ;; skip xml.el formatting nodes
1043 (unless (stringp child
)
1044 ;; compare node name
1045 (when (if (not step-node
)
1047 (org-freemind-symbols= step-node
(car child
)))
1048 (if (not step-attr-list
)
1049 ;;(throw 'path-child child) ;; no attr to care about
1050 (add-to-list 'path-children child
)
1051 (let* ((child-attr-list (cadr child
))
1052 (step-attr-copy (copy-sequence step-attr-list
)))
1053 (dolist (child-attr child-attr-list
)
1054 ;; Compare attr names:
1055 (when (org-freemind-symbols= (caar step-attr-copy
) (car child-attr
))
1057 (let ((step-val (cdar step-attr-copy
))
1058 (child-val (cdr child-attr
)))
1059 (when (if (not step-val
)
1061 (string= step-val child-val
))
1062 (setq step-attr-copy
(cdr step-attr-copy
))))))
1064 (unless step-attr-copy
1065 ;;(throw 'path-child child)
1066 (add-to-list 'path-children child
)
1069 (org-freemind-get-children path-children path-tail
)
1072 (defun org-freemind-get-richcontent-node (node)
1074 (org-freemind-get-children node
'((richcontent (type .
"NODE")) html body
))))
1075 (when (> (length rc-nodes
) 1)
1076 (lwarn t
:warning
"Unexpected structure: several <richcontent type=\"NODE\" ...>"))
1079 (defun org-freemind-get-richcontent-note (node)
1081 (org-freemind-get-children node
'((richcontent (type .
"NOTE")) html body
))))
1082 (when (> (length rc-notes
) 1)
1083 (lwarn t
:warning
"Unexpected structure: several <richcontent type=\"NOTE\" ...>"))
1086 (defun org-freemind-test-get-tree-text ()
1087 (let ((node '(p nil
"\n"
1094 (org-freemind-get-tree-text node
)))
1095 ;; (org-freemind-test-get-tree-text)
1097 (defun org-freemind-get-tree-text (node)
1104 ;;(a (setq is-link t) )
1105 ((h1 h2 h3 h4 h5 h6 p
)
1106 ;;(setq ntxt (concat "\n" ntxt))
1115 (when (string= n
"\n") (setq n
""))
1117 (setq ntxt
(concat ntxt
1118 "[[" link
"][" n
"]]"))
1119 (setq ntxt
(concat ntxt n
))))
1121 (if (symbolp (car n
))
1122 (setq ntxt
(concat ntxt
(org-freemind-get-tree-text n
)))
1123 ;; This should be the attributes:
1125 (let ((att (car att-val
))
1126 (val (cdr att-val
)))
1127 (when (eq att
'href
)
1131 (setq ntxt
(concat ntxt
(make-string lf-after ?
\n)))
1132 (setq ntxt
(concat ntxt
" ")))
1133 ;;(setq ntxt (concat ntxt (format "{%s}" n)))
1136 (defun org-freemind-get-richcontent-node-text (node)
1137 "Get the node text as from the richcontent node NODE."
1139 (let* ((rc (org-freemind-get-richcontent-node node
))
1140 (txt (org-freemind-get-tree-text rc
)))
1141 ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
1145 (defun org-freemind-get-richcontent-note-text (node)
1146 "Get the node text as from the richcontent note NODE."
1148 (let* ((rc (org-freemind-get-richcontent-note node
))
1149 (txt (when rc
(org-freemind-get-tree-text rc
))))
1150 ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
1154 (defun org-freemind-get-icon-names (node)
1155 (let* ((icon-nodes (org-freemind-get-children node
'((icon ))))
1157 (dolist (icn icon-nodes
)
1158 (setq names
(cons (cdr (assq 'builtin
(cadr icn
))) names
)))
1159 ;; (icon (builtin . "full-1"))
1162 (defun org-freemind-node-to-org (node level skip-levels
)
1163 (let ((qname (car node
))
1164 (attributes (cadr node
))
1166 ;; Fix-me: note is never inserted
1167 (note (org-freemind-get-richcontent-note-text node
))
1168 (mark "-- This is more about ")
1169 (icons (org-freemind-get-icon-names node
))
1170 (children (cddr node
)))
1171 (when (< 0 (- level skip-levels
))
1172 (dolist (attrib attributes
)
1174 ('TEXT
(setq text
(cdr attrib
)))
1175 ('text
(setq text
(cdr attrib
)))))
1177 ;; There should be a richcontent node holding the text:
1178 (setq text
(org-freemind-get-richcontent-node-text node
)))
1180 (when (member "full-1" icons
) (setq text
(concat "[#A] " text
)))
1181 (when (member "full-2" icons
) (setq text
(concat "[#B] " text
)))
1182 (when (member "full-3" icons
) (setq text
(concat "[#C] " text
)))
1183 (when (member "full-4" icons
) (setq text
(concat "[#D] " text
)))
1184 (when (member "full-5" icons
) (setq text
(concat "[#E] " text
)))
1185 (when (member "full-6" icons
) (setq text
(concat "[#F] " text
)))
1186 (when (member "full-7" icons
) (setq text
(concat "[#G] " text
)))
1187 (when (member "button_cancel" icons
) (setq text
(concat "TODO " text
)))
1190 (string= mark
(substring note
0 (length mark
))))
1192 (setq text
(replace-regexp-in-string "\n $" "" text
))
1196 (insert (make-string (- level skip-levels
) ?
*) " " text
"\n")
1198 (insert ":COMMENT:\n" note
"\n:END:\n"))
1200 (dolist (child children
)
1201 (unless (or (null child
)
1203 (org-freemind-node-to-org child
(1+ level
) skip-levels
)))))
1205 ;; Fix-me: put back special things, like drawers that are stored in
1206 ;; the notes. Should maybe all notes contents be put in drawers?
1208 (defun org-freemind-to-org-mode (mm-file org-file
)
1209 "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."
1212 (let* ((mm-file (buffer-file-name))
1213 (default-org-file (concat (file-name-nondirectory mm-file
) ".org"))
1214 (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file
)))
1215 (list mm-file org-file
))))
1216 (when (org-freemind-check-overwrite org-file
(org-called-interactively-p 'any
))
1217 (let ((mm-buffer (find-file-noselect mm-file
))
1218 (org-buffer (find-file-noselect org-file
)))
1219 (with-current-buffer mm-buffer
1220 (let* ((xml-list (xml-parse-file mm-file
))
1221 (top-node (cadr (cddar xml-list
)))
1222 (note (org-freemind-get-richcontent-note-text top-node
))
1225 (string-match "^--org-mode: WHOLE FILE$" note
))
1228 (with-current-buffer org-buffer
1230 (org-freemind-node-to-org top-node
1 skip-levels
)
1231 (goto-char (point-min))
1232 (org-set-tags t t
) ;; Align all tags
1234 (switch-to-buffer-other-window org-buffer
)
1237 (provide 'org-freemind
)
1241 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1243 ;;; org-freemind.el ends here