HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Prefer UTF-8 when the encoding shouldn't matter and changes are small.
[bpt/emacs.git] / lisp / org / org-freemind.el
CommitLineData
8bfe682a
CD		 1;;; org-freemind.el --- Export Org files to freemind
2
ab422c4d 3;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
8bfe682a
CD		 4
5;; Author: Lennart Borgman (lennart O borgman A gmail O com)
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8bfe682a
CD		 8;;
9;; This file is part of GNU Emacs.
10;;
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.
15
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.
20
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/>.
23
24;; --------------------------------------------------------------------
25;; Features that might be required by this library:
26;;
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'.
31;;
32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33;;
34;;; Commentary:
35;;
36;; This file tries to implement some functions useful for
37;; transformation between org-mode and FreeMind files.
38;;
39;; Here are the commands you can use:
40;;
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'
44;;
45;; M-x `org-freemind-to-org-mode'
46;;
47;; M-x `org-freemind-show'
48;;
49;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
50;;
51;;; Change log:
52;;
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.
58;;
8bfe682a
CD		 59;;; Code:
60
61(require 'xml)
62(require 'org)
8223b1d2 63 ;(require 'rx)
8bfe682a
CD		 64(require 'org-exp)
65(eval-when-compile (require 'cl))
66
afe98dfa
CD		 67(defgroup org-freemind nil
68 "Customization group for org-freemind export/import."
69 :group 'org)
70
8bfe682a
CD		 71;; Fix-me: I am not sure these are useful:
72;;
73;; (defcustom org-freemind-main-fgcolor "black"
74;; "Color of main node's text."
75;; :type 'color
afe98dfa 76;; :group 'org-freemind)
8bfe682a
CD		 77
78;; (defcustom org-freemind-main-color "black"
79;; "Background color of main node."
80;; :type 'color
afe98dfa 81;; :group 'org-freemind)
8bfe682a
CD		 82
83;; (defcustom org-freemind-child-fgcolor "black"
84;; "Color of child nodes' text."
85;; :type 'color
afe98dfa 86;; :group 'org-freemind)
8bfe682a
CD		 87
88;; (defcustom org-freemind-child-color "black"
89;; "Background color of child nodes."
90;; :type 'color
afe98dfa 91;; :group 'org-freemind)
8bfe682a
CD		 92
93(defvar org-freemind-node-style nil "Internal use.")
94
95(defcustom org-freemind-node-styles nil
96 "Styles to apply to node.
97NOT READY YET."
98 :type '(repeat
99 (list :tag "Node styles for file"
100 (regexp :tag "File name")
101 (repeat
102 (list :tag "Node"
103 (regexp :tag "Node name regexp")
104 (set :tag "Node properties"
105 (list :format "%v" (const :format "" node-style)
106 (choice :tag "Style"
107 :value bubble
108 (const bubble)
109 (const fork)))
110 (list :format "%v" (const :format "" color)
111 (color :tag "Color" :value "red"))
112 (list :format "%v" (const :format "" background-color)
113 (color :tag "Background color" :value "yellow"))
114 (list :format "%v" (const :format "" edge-color)
115 (color :tag "Edge color" :value "green"))
116 (list :format "%v" (const :format "" edge-style)
117 (choice :tag "Edge style" :value bezier
118 (const :tag "Linear" linear)
119 (const :tag "Bezier" bezier)
120 (const :tag "Sharp Linear" sharp-linear)
121 (const :tag "Sharp Bezier" sharp-bezier)))
122 (list :format "%v" (const :format "" edge-width)
123 (choice :tag "Edge width" :value thin
124 (const :tag "Parent" parent)
125 (const :tag "Thin" thin)
126 (const 1)
127 (const 2)
128 (const 4)
129 (const 8)))
130 (list :format "%v" (const :format "" italic)
131 (const :tag "Italic font" t))
132 (list :format "%v" (const :format "" bold)
133 (const :tag "Bold font" t))
134 (list :format "%v" (const :format "" font-name)
135 (string :tag "Font name" :value "SansSerif"))
136 (list :format "%v" (const :format "" font-size)
137 (integer :tag "Font size" :value 12)))))))
afe98dfa 138 :group 'org-freemind)
8bfe682a
CD		 139
140;;;###autoload
afe98dfa 141(defun org-export-as-freemind (&optional hidden ext-plist
8223b1d2 142 to-buffer body-only pub-dir)
afe98dfa
CD		 143 "Export the current buffer as a Freemind file.
144If there is an active region, export only the region. HIDDEN is
145obsolete and does nothing. EXT-PLIST is a property list with
146external parameters overriding org-mode's default settings, but
147still inferior to file-local settings. When TO-BUFFER is
148non-nil, create a buffer with that name and export to that
149buffer. If TO-BUFFER is the symbol `string', don't leave any
150buffer behind but just return the resulting HTML as a string.
151When BODY-ONLY is set, don't produce the file header and footer,
152simply return the content of the document (all top level
153sections). When PUB-DIR is set, use this as the publishing
154directory.
155
156See `org-freemind-from-org-mode' for more information."
8bfe682a
CD		 157 (interactive "P")
158 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
159 ext-plist
160 (org-infile-export-plist)))
161 (region-p (org-region-active-p))
162 (rbeg (and region-p (region-beginning)))
163 (rend (and region-p (region-end)))
164 (subtree-p
165 (if (plist-get opt-plist :ignore-subtree-p)
166 nil
167 (when region-p
168 (save-excursion
169 (goto-char rbeg)
170 (and (org-at-heading-p)
171 (>= (org-end-of-subtree t t) rend))))))
172 (opt-plist (setq org-export-opt-plist
173 (if subtree-p
174 (org-export-add-subtree-options opt-plist rbeg)
175 opt-plist)))
176 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
177 (filename (concat (file-name-as-directory
178 (or pub-dir
179 (org-export-directory :ascii opt-plist)))
180 (file-name-sans-extension
181 (or (and subtree-p
182 (org-entry-get (region-beginning)
183 "EXPORT_FILE_NAME" t))
184 (file-name-nondirectory bfname)))
185 ".mm")))
186 (when (file-exists-p filename)
187 (delete-file filename))
188 (cond
189 (subtree-p
190 (org-freemind-from-org-mode-node (line-number-at-pos rbeg)
191 filename))
192 (t (org-freemind-from-org-mode bfname filename)))))
193
194;;;###autoload
195(defun org-freemind-show (mm-file)
196 "Show file MM-FILE in Freemind."
197 (interactive
198 (list
199 (save-match-data
200 (let ((name (read-file-name "FreeMind file: "
201 nil nil nil
202 (if (buffer-file-name)
afe98dfa
CD		 203 (let* ((name-ext (file-name-nondirectory (buffer-file-name)))
204 (name (file-name-sans-extension name-ext))
205 (ext (file-name-extension name-ext)))
206 (cond
207 ((string= "mm" ext)
208 name-ext)
209 ((string= "org" ext)
210 (let ((name-mm (concat name ".mm")))
211 (if (file-exists-p name-mm)
212 name-mm
213 (message "Not exported to Freemind format yet")
214 "")))
215 (t
216 "")))
8bfe682a
CD		 217 "")
218 ;; Fix-me: Is this an Emacs bug?
219 ;; This predicate function is never
220 ;; called.
221 (lambda (fn)
222 (string-match "^mm$" (file-name-extension fn))))))
223 (setq name (expand-file-name name))
224 name))))
225 (org-open-file mm-file))
226
227(defconst org-freemind-org-nfix "--org-mode: ")
228
229;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
230;;; Format converters
231
232(defun org-freemind-escape-str-from-org (org-str)
233 "Do some html-escaping of ORG-STR and return the result.
234The characters \"&<> will be escaped."
235 (let ((chars (append org-str nil))
236 (fm-str ""))
237 (dolist (cc chars)
238 (setq fm-str
239 (concat fm-str
afe98dfa 240 (if (< cc 160)
8bfe682a
CD		 241 (cond
242 ((= cc ?\") "&quot;")
243 ((= cc ?\&) "&amp;")
244 ((= cc ?\<) "&lt;")
245 ((= cc ?\>) "&gt;")
246 (t (char-to-string cc)))
247 ;; Formatting as &#number; is maybe needed
248 ;; according to a bug report from kazuo
249 ;; fujimoto, but I have now instead added a xml
250 ;; processing instruction saying that the mm
251 ;; file is utf-8:
252 ;;
253 ;; (format "&#x%x;" (- cc ;; ?\x800))
ed21c5c8 254 (format "&#x%x;" (encode-char cc 'ucs))
8bfe682a
CD		 255 ))))
256 fm-str))
257
258;;(org-freemind-unescape-str-to-org "&#x6d;A&#x224C;B&lt;C&#x3C;&#x3D;")
259;;(org-freemind-unescape-str-to-org "&#x3C;&lt;")
260(defun org-freemind-unescape-str-to-org (fm-str)
8223b1d2 261 "Do some html-unescaping of FM-STR and return the result.
8bfe682a
CD		 262This is the opposite of `org-freemind-escape-str-from-org' but it
263will also unescape &#nn;."
8223b1d2
BG		 264 (let ((org-str fm-str))
265 (setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
266 (setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
267 (setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
268 (setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
269 (setq org-str (replace-regexp-in-string
270 "&#x\\([a-f0-9]\\{2,4\\}\\);"
271 (lambda (m)
272 (char-to-string
273 (+ (string-to-number (match-string 1 m) 16)
274 0 ;?\x800 ;; What is this for? Encoding?
275 )))
276 org-str))))
8bfe682a 277
c38e0c97 278;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
afe98dfa
CD		 279;; (str2 (org-freemind-escape-str-from-org str1))
280;; (str3 (org-freemind-unescape-str-to-org str2)))
281;; (unless (string= str1 str3)
282;; (error "Error str3=%s" str3)))
283
284(defun org-freemind-convert-links-helper (matched)
285 "Helper for `org-freemind-convert-links-from-org'.
286MATCHED is the link just matched."
287 (let* ((link (match-string 1 matched))
288 (text (match-string 2 matched))
289 (ext (file-name-extension link))
3ab2c837 290 (col-pos (org-string-match-p ":" link))
afe98dfa
CD		 291 (is-img (and (image-type-from-file-name link)
292 (let ((url-type (substring link 0 col-pos)))
293 (member url-type '("file" "http" "https")))))
8223b1d2 294 )
afe98dfa
CD		 295 (if is-img
296 ;; Fix-me: I can't find a way to get the border to "shrink
297 ;; wrap" around the image using <div>.
298 ;;
299 ;; (concat "<div style=\"border: solid 1px #ddd; width:auto;\">"
300 ;; "<img src=\"" link "\" alt=\"" text "\" />"
301 ;; "<br />"
302 ;; "<i>" text "</i>"
303 ;; "</div>")
304 (concat "<table border=\"0\" style=\"border: solid 1px #ddd;\"><tr><td>"
305 "<img src=\"" link "\" alt=\"" text "\" />"
306 "<br />"
307 "<i>" text "</i>"
308 "</td></tr></table>")
309 (concat "<a href=\"" link "\">" text "</a>"))))
8bfe682a
CD		 310
311(defun org-freemind-convert-links-from-org (org-str)
312 "Convert org links in ORG-STR to freemind links and return the result."
313 (let ((fm-str (replace-regexp-in-string
afe98dfa
CD		 314 ;;(rx (not (any "[\""))
315 ;; (submatch
316 ;; "http"
317 ;; (opt ?\s)
318 ;; "://"
319 ;; (1+
320 ;; (any "-%.?@a-zA-Z0-9()_/:~=&#"))))
321 "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)"
8bfe682a 322 "[[\\1][\\1]]"
afe98dfa
CD		 323 org-str
324 nil ;; fixedcase
325 nil ;; literal
326 1 ;; subexp
327 )))
328 (replace-regexp-in-string
329 ;;(rx "[["
330 ;; (submatch (*? nonl))
331 ;; "]["
332 ;; (submatch (*? nonl))
333 ;; "]]")
334 "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]"
335 ;;"<a href=\"\\1\">\\2</a>"
336 'org-freemind-convert-links-helper
8223b1d2 337 fm-str t t)))
8bfe682a
CD		 338
339;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>")
340(defun org-freemind-convert-links-to-org (fm-str)
341 "Convert freemind links in FM-STR to org links and return the result."
342 (let ((org-str (replace-regexp-in-string
afe98dfa
CD		 343 ;;(rx "<a"
344 ;; space
345 ;; (0+
346 ;; (0+ (not (any ">")))
347 ;; space)
348 ;; "href=\""
349 ;; (submatch (0+ (not (any "\""))))
350 ;; "\""
351 ;; (0+ (not (any ">")))
352 ;; ">"
353 ;; (submatch (0+ (not (any "<"))))
354 ;; "</a>")
355 "<a[[:space:]]\\(?:[^>]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)</a>"
8bfe682a
CD		 356 "[[\\1][\\2]]"
357 fm-str)))
358 org-str))
359
360;; Fix-me:
361;;(defun org-freemind-convert-drawers-from-org (text)
362;; )
363
8bfe682a
CD		 364;; (let* ((str1 "[[http://www.somewhere/][link-text]")
365;; (str2 (org-freemind-convert-links-from-org str1))
afe98dfa 366;; (str3 (org-freemind-convert-links-to-org str2)))
8bfe682a 367;; (unless (string= str1 str3)
afe98dfa 368;; (error "Error str3=%s" str3)))
8bfe682a
CD		 369
370;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
371;;; Org => FreeMind
372
afe98dfa
CD		 373(defvar org-freemind-bol-helper-base-indent nil)
374
375(defun org-freemind-bol-helper (matched)
376 "Helper for `org-freemind-convert-text-p'.
377MATCHED is the link just matched."
378 (let ((res "")
379 (bi org-freemind-bol-helper-base-indent))
380 (dolist (cc (append matched nil))
381 (if (= 32 cc)
382 ;;(setq res (concat res "&nbsp;"))
8223b1d2 383 ;; We need to use the numerical version. Otherwise Freemind
afe98dfa
CD		 384 ;; ver 0.9.0 RC9 can not export to html/javascript.
385 (progn
386 (if (< 0 bi)
387 (setq bi (1- bi))
388 (setq res (concat res "&#160;"))))
389 (setq res (concat res (char-to-string cc)))))
390 res))
391;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n "))
392
8bfe682a
CD		 393(defun org-freemind-convert-text-p (text)
394 "Convert TEXT to html with <p> paragraphs."
afe98dfa 395 ;; (string-match-p "[^ ]" " a")
3ab2c837 396 (setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text))
8bfe682a 397 (setq text (org-freemind-escape-str-from-org text))
afe98dfa
CD		 398
399 (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text))
400 (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1<b>\\3</b>\\5" text))
401
402 (setq text (concat "<p>" text))
403 (setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "</p><p>" text))
404 (setq text (replace-regexp-in-string "\\(?:<p>\\|\n\\) +" 'org-freemind-bol-helper text))
8bfe682a 405 (setq text (replace-regexp-in-string "\n" "<br />" text))
afe98dfa
CD		 406 (setq text (concat text "</p>"))
407
408 (org-freemind-convert-links-from-org text))
409
410(defcustom org-freemind-node-css-style
411 "p { margin-top: 3px; margin-bottom: 3px; }"
412 "CSS style for Freemind nodes."
8223b1d2 413 ;; Fix-me: I do not understand this. It worked to export from Freemind
afe98dfa
CD		 414 ;; with this setting now, but not before??? Was this perhaps a java
415 ;; bug or is it a windows xp bug (some resource gets exhausted if you
416 ;; use sticky keys which I do).
372d7b21 417 :version "24.1"
afe98dfa 418 :group 'org-freemind)
8bfe682a
CD		 419
420(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp)
421 "Convert text part of org node to freemind subnode or note.
422Convert the text part of the org node named NODE-NAME. The text
423is in the current buffer between START and END. Drawers matching
424DRAWERS-REGEXP are converted to freemind notes."
425 ;; fix-me: doc
426 (let ((text (buffer-substring-no-properties start end))
427 (node-res "")
428 (note-res ""))
429 (save-match-data
430 ;;(setq text (org-freemind-escape-str-from-org text))
431 ;; First see if there is something that should be moved to the
432 ;; note part:
433 (let (drawers)
434 (while (string-match drawers-regexp text)
435 (setq drawers (cons (match-string 0 text) drawers))
436 (setq text
437 (concat (substring text 0 (match-beginning 0))
438 (substring text (match-end 0))))
439 )
440 (when drawers
441 (dolist (drawer drawers)
442 (let ((lines (split-string drawer "\n")))
443 (dolist (line lines)
444 (setq note-res (concat
445 note-res
446 org-freemind-org-nfix line "<br />\n")))
447 ))))
448
449 (when (> (length note-res) 0)
450 (setq note-res (concat
451 "<richcontent TYPE=\"NOTE\"><html>\n"
452 "<head>\n"
453 "</head>\n"
454 "<body>\n"
455 note-res
456 "</body>\n"
457 "</html>\n"
8223b1d2 458 "</richcontent>\n")))
8bfe682a
CD		 459
460 ;; There is always an LF char:
461 (when (> (length text) 1)
462 (setq node-res (concat
463 "<node style=\"bubble\" background_color=\"#eeee00\">\n"
464 "<richcontent TYPE=\"NODE\"><html>\n"
465 "<head>\n"
afe98dfa
CD		 466 (if (= 0 (length org-freemind-node-css-style))
467 ""
468 (concat
8223b1d2
BG		 469 "<style type=\"text/css\">\n"
470 "<!--\n"
afe98dfa 471 org-freemind-node-css-style
8223b1d2 472 "-->\n"
afe98dfa 473 "</style>\n"))
8bfe682a
CD		 474 "</head>\n"
475 "<body>\n"))
476 (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML"))
477 (end-html-mark (regexp-quote "#+END_HTML"))
478 head
479 end-pos
480 end-pos-match
481 )
482 ;; Take care of #+BEGIN_HTML - #+END_HTML
483 (while (string-match begin-html-mark text)
484 (setq head (substring text 0 (match-beginning 0)))
485 (setq end-pos-match (match-end 0))
486 (setq node-res (concat node-res
487 (org-freemind-convert-text-p head)))
488 (setq text (substring text end-pos-match))
489 (setq end-pos (string-match end-html-mark text))
490 (if end-pos
491 (setq end-pos-match (match-end 0))
492 (message "org-freemind: Missing #+END_HTML")
493 (setq end-pos (length text))
494 (setq end-pos-match end-pos))
495 (setq node-res (concat node-res
496 (substring text 0 end-pos)))
497 (setq text (substring text end-pos-match)))
498 (setq node-res (concat node-res
499 (org-freemind-convert-text-p text))))
500 (setq node-res (concat
501 node-res
502 "</body>\n"
503 "</html>\n"
504 "</richcontent>\n"
505 ;; Put a note that this is for the parent node
afe98dfa
CD		 506 ;; "<richcontent TYPE=\"NOTE\"><html>"
507 ;; "<head>"
508 ;; "</head>"
509 ;; "<body>"
510 ;; "<p>"
511 ;; "-- This is more about \"" node-name "\" --"
512 ;; "</p>"
513 ;; "</body>"
514 ;; "</html>"
515 ;; "</richcontent>\n"
516 note-res
8bfe682a
CD		 517 "</node>\n" ;; ok
518 )))
519 (list node-res note-res))))
520
afe98dfa 521(defun org-freemind-write-node (mm-buffer drawers-regexp
8223b1d2
BG		 522 num-left-nodes base-level
523 current-level next-level this-m2
524 this-node-end
525 this-children-visible
526 next-node-start
527 next-has-some-visible-child)
8bfe682a
CD		 528 (let* (this-icons
529 this-bg-color
8223b1d2 530 this-m2-link
8bfe682a
CD		 531 this-m2-escaped
532 this-rich-node
533 this-rich-note
534 )
535 (when (string-match "TODO" this-m2)
536 (setq this-m2 (replace-match "" nil nil this-m2))
537 (add-to-list 'this-icons "button_cancel")
538 (setq this-bg-color "#ffff88")
539 (when (string-match "\\[#\\(.\\)\\]" this-m2)
540 (let ((prior (string-to-char (match-string 1 this-m2))))
541 (setq this-m2 (replace-match "" nil nil this-m2))
542 (cond
543 ((= prior ?A)
544 (add-to-list 'this-icons "full-1")
545 (setq this-bg-color "#ff0000"))
546 ((= prior ?B)
547 (add-to-list 'this-icons "full-2")
548 (setq this-bg-color "#ffaa00"))
549 ((= prior ?C)
550 (add-to-list 'this-icons "full-3")
551 (setq this-bg-color "#ffdd00"))
552 ((= prior ?D)
553 (add-to-list 'this-icons "full-4")
554 (setq this-bg-color "#ffff00"))
555 ((= prior ?E)
556 (add-to-list 'this-icons "full-5"))
557 ((= prior ?F)
558 (add-to-list 'this-icons "full-6"))
559 ((= prior ?G)
560 (add-to-list 'this-icons "full-7"))
561 ))))
562 (setq this-m2 (org-trim this-m2))
8223b1d2
BG		 563 (when (string-match org-bracket-link-analytic-regexp this-m2)
564 (setq this-m2-link (concat "link=\"" (match-string 1 this-m2)
565 (match-string 3 this-m2) "\" ")
566 this-m2 (replace-match "\\5" nil nil this-m2 0)))
8bfe682a
CD		 567 (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2))
568 (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
569 this-m2-escaped
570 this-node-end
571 (1- next-node-start)
572 drawers-regexp)))
573 (setq this-rich-node (nth 0 node-notes))
574 (setq this-rich-note (nth 1 node-notes)))
575 (with-current-buffer mm-buffer
8223b1d2
BG		 576 (insert "<node " (if this-m2-link this-m2-link "")
577 "text=\"" this-m2-escaped "\"")
8bfe682a
CD		 578 (org-freemind-get-node-style this-m2)
579 (when (> next-level current-level)
580 (unless (or this-children-visible
581 next-has-some-visible-child)
582 (insert " folded=\"true\"")))
583 (when (and (= current-level (1+ base-level))
584 (> num-left-nodes 0))
585 (setq num-left-nodes (1- num-left-nodes))
586 (insert " position=\"left\""))
587 (when this-bg-color
588 (insert " background_color=\"" this-bg-color "\""))
589 (insert ">\n")
590 (when this-icons
591 (dolist (icon this-icons)
592 (insert "<icon builtin=\"" icon "\"/>\n")))
593 )
594 (with-current-buffer mm-buffer
afe98dfa 595 ;;(when this-rich-note (insert this-rich-note))
8bfe682a
CD		 596 (when this-rich-node (insert this-rich-node))))
597 num-left-nodes)
598
599(defun org-freemind-check-overwrite (file interactively)
600 "Check if file FILE already exists.
601If FILE does not exists return t.
602
603If INTERACTIVELY is non-nil ask if the file should be replaced
604and return t/nil if it should/should not be replaced.
605
606Otherwise give an error say the file exists."
607 (if (file-exists-p file)
608 (if interactively
609 (y-or-n-p (format "File %s exists, replace it? " file))
610 (error "File %s already exists" file))
611 t))
612
afe98dfa
CD		 613(defvar org-freemind-node-pattern
614 ;;(rx bol
615 ;; (submatch (1+ "*"))
616 ;; (1+ space)
617 ;; (submatch (*? nonl))
618 ;; eol)
619 "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$")
8bfe682a
CD		 620
621(defun org-freemind-look-for-visible-child (node-level)
622 (save-excursion
623 (save-match-data
624 (let ((found-visible-child nil))
625 (while (and (not found-visible-child)
626 (re-search-forward org-freemind-node-pattern nil t))
627 (let* ((m1 (match-string-no-properties 1))
628 (level (length m1)))
629 (if (>= node-level level)
630 (setq found-visible-child 'none)
631 (unless (get-char-property (line-beginning-position) 'invisible)
632 (setq found-visible-child 'found)))))
633 (eq found-visible-child 'found)
634 ))))
635
636(defun org-freemind-goto-line (line)
637 "Go to line number LINE."
638 (save-restriction
639 (widen)
640 (goto-char (point-min))
641 (forward-line (1- line))))
642
643(defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line)
644 (with-current-buffer org-buffer
645 (dolist (node-style org-freemind-node-styles)
3ab2c837 646 (when (org-string-match-p (car node-style) buffer-file-name)
8bfe682a
CD		 647 (setq org-freemind-node-style (cadr node-style))))
648 ;;(message "org-freemind-node-style =%s" org-freemind-node-style)
649 (save-match-data
650 (let* ((drawers (copy-sequence org-drawers))
651 drawers-regexp
652 (num-top1-nodes 0)
653 (num-top2-nodes 0)
654 num-left-nodes
655 (unclosed-nodes 0)
ed21c5c8 656 (odd-only org-odd-levels-only)
8bfe682a
CD		 657 (first-time t)
658 (current-level 1)
659 base-level
8bfe682a
CD		 660 prev-node-end
661 rich-text
662 unfinished-tag
663 node-at-line-level
664 node-at-line-last)
665 (with-current-buffer mm-buffer
666 (erase-buffer)
afe98dfa 667 (setq buffer-file-coding-system 'utf-8)
ee7683eb 668 ;; Fix-me: Currently Freemind (ver 0.9.0 RC9) does not support this:
afe98dfa 669 ;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
8bfe682a
CD		 670 (insert "<map version=\"0.9.0\">\n")
671 (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n"))
672 (save-excursion
673 ;; Get special buffer vars:
674 (goto-char (point-min))
afe98dfa
CD		 675 (message "Writing Freemind file...")
676 (while (re-search-forward "^#\\+DRAWERS:" nil t)
8bfe682a
CD		 677 (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position))))
678 (setq drawers (append drawers (split-string dr-txt) nil))))
679 (setq drawers-regexp
afe98dfa 680 (concat "^[[:blank:]]*:"
8bfe682a 681 (regexp-opt drawers)
afe98dfa
CD		 682 ;;(rx ":" (0+ blank)
683 ;; "\n"
684 ;; (*? anything)
685 ;; "\n"
686 ;; (0+ blank)
687 ;; ":END:"
688 ;; (0+ blank)
689 ;; eol)
690 ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$"
691 ))
8bfe682a
CD		 692
693 (if node-at-line
694 ;; Get number of top nodes and last line for this node
695 (progn
696 (org-freemind-goto-line node-at-line)
697 (unless (looking-at org-freemind-node-pattern)
698 (error "No node at line %s" node-at-line))
699 (setq node-at-line-level (length (match-string-no-properties 1)))
700 (forward-line)
701 (setq node-at-line-last
702 (catch 'last-line
703 (while (re-search-forward org-freemind-node-pattern nil t)
704 (let* ((m1 (match-string-no-properties 1))
705 (level (length m1)))
706 (if (<= level node-at-line-level)
707 (progn
708 (beginning-of-line)
709 (throw 'last-line (1- (point))))
710 (if (= level (1+ node-at-line-level))
711 (setq num-top2-nodes (1+ num-top2-nodes))))))))
712 (setq current-level node-at-line-level)
713 (setq num-top1-nodes 1)
714 (org-freemind-goto-line node-at-line))
715
716 ;; First get number of top nodes
717 (goto-char (point-min))
718 (while (re-search-forward org-freemind-node-pattern nil t)
719 (let* ((m1 (match-string-no-properties 1))
720 (level (length m1)))
721 (if (= level 1)
722 (setq num-top1-nodes (1+ num-top1-nodes))
723 (if (= level 2)
724 (setq num-top2-nodes (1+ num-top2-nodes))))))
725 ;; If there is more than one top node we need to insert a node
726 ;; to keep them together.
727 (goto-char (point-min))
728 (when (> num-top1-nodes 1)
729 (setq num-top2-nodes num-top1-nodes)
730 (setq current-level 0)
731 (let ((orig-name (if buffer-file-name
732 (file-name-nondirectory (buffer-file-name))
733 (buffer-name))))
734 (with-current-buffer mm-buffer
735 (insert "<node text=\"" orig-name "\" background_color=\"#00bfff\">\n"
736 ;; Put a note that this is for the parent node
737 "<richcontent TYPE=\"NOTE\"><html>"
738 "<head>"
739 "</head>"
740 "<body>"
741 "<p>"
742 org-freemind-org-nfix "WHOLE FILE"
743 "</p>"
744 "</body>"
745 "</html>"
746 "</richcontent>\n")))))
747
748 (setq num-left-nodes (floor num-top2-nodes 2))
749 (setq base-level current-level)
750 (let (this-m2
751 this-node-end
752 this-children-visible
753 next-m2
754 next-node-start
755 next-level
756 next-has-some-visible-child
757 next-children-visible
758 )
759 (while (and
760 (re-search-forward org-freemind-node-pattern nil t)
761 (if node-at-line-last (<= (point) node-at-line-last) t)
762 )
763 (let* ((next-m1 (match-string-no-properties 1))
764 (next-node-end (match-end 0))
765 )
766 (setq next-node-start (match-beginning 0))
767 (setq next-m2 (match-string-no-properties 2))
768 (setq next-level (length next-m1))
8bfe682a
CD		 769 (setq next-children-visible
770 (not (eq 'outline
771 (get-char-property (line-end-position) 'invisible))))
772 (setq next-has-some-visible-child
773 (if next-children-visible t
774 (org-freemind-look-for-visible-child next-level)))
775 (when this-m2
776 (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)))
777 (when (if (= num-top1-nodes 1) (> current-level base-level) t)
778 (while (>= current-level next-level)
779 (with-current-buffer mm-buffer
780 (insert "</node>\n")
ed21c5c8
CD		 781 (setq current-level
782 (- current-level (if odd-only 2 1))))))
8bfe682a
CD		 783 (setq this-node-end (1+ next-node-end))
784 (setq this-m2 next-m2)
785 (setq current-level next-level)
786 (setq this-children-visible next-children-visible)
787 (forward-char)
788 ))
789;;; (unless (if node-at-line-last
790;;; (>= (point) node-at-line-last)
791;;; nil)
8223b1d2
BG		 792 ;; Write last node:
793 (setq this-m2 next-m2)
794 (setq current-level next-level)
795 (setq next-node-start (if node-at-line-last
796 (1+ node-at-line-last)
797 (point-max)))
798 (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))
799 (with-current-buffer mm-buffer (insert "</node>\n"))
800 ;)
8bfe682a
CD		 801 )
802 (with-current-buffer mm-buffer
803 (while (> current-level base-level)
804 (insert "</node>\n")
ed21c5c8
CD		 805 (setq current-level
806 (- current-level (if odd-only 2 1)))
8bfe682a
CD		 807 ))
808 (with-current-buffer mm-buffer
809 (insert "</map>")
810 (delete-trailing-whitespace)
811 (goto-char (point-min))
812 ))))))
813
814(defun org-freemind-get-node-style (node-name)
815 "NOT READY YET."
816 ;;<node BACKGROUND_COLOR="#eeee00" CREATED="1234668815593" MODIFIED="1234668815593" STYLE="bubble">
817 ;;<font BOLD="true" NAME="SansSerif" SIZE="12"/>
818 (let (node-styles
819 node-style)
820 (dolist (style-list org-freemind-node-style)
821 (let ((node-regexp (car style-list)))
822 (message "node-regexp=%s node-name=%s" node-regexp node-name)
3ab2c837 823 (when (org-string-match-p node-regexp node-name)
8bfe682a
CD		 824 ;;(setq node-style (org-freemind-do-apply-node-style style-list))
825 (setq node-style (cadr style-list))
826 (when node-style
827 (message "node-style=%s" node-style)
828 (setq node-styles (append node-styles node-style)))
829 )))))
830
831(defun org-freemind-do-apply-node-style (style-list)
832 (message "style-list=%S" style-list)
833 (let ((node-style 'fork)
834 (color "red")
835 (background-color "yellow")
836 (edge-color "green")
837 (edge-style 'bezier)
838 (edge-width 'thin)
839 (italic t)
840 (bold t)
841 (font-name "SansSerif")
842 (font-size 12))
843 (dolist (style (cadr style-list))
844 (message " style=%s" style)
845 (let ((what (car style)))
846 (cond
847 ((eq what 'node-style)
848 (setq node-style (cadr style)))
849 ((eq what 'color)
850 (setq color (cadr style)))
851 ((eq what 'background-color)
852 (setq background-color (cadr style)))
853
854 ((eq what 'edge-color)
855 (setq edge-color (cadr style)))
856
857 ((eq what 'edge-style)
858 (setq edge-style (cadr style)))
859
860 ((eq what 'edge-width)
861 (setq edge-width (cadr style)))
862
863 ((eq what 'italic)
864 (setq italic (cadr style)))
865
866 ((eq what 'bold)
867 (setq bold (cadr style)))
868
869 ((eq what 'font-name)
870 (setq font-name (cadr style)))
871
872 ((eq what 'font-size)
873 (setq font-size (cadr style)))
874 )
875 (insert (format " style=\"%s\"" node-style))
876 (insert (format " color=\"%s\"" color))
877 (insert (format " background_color=\"%s\"" background-color))
878 (insert ">\n")
879 (insert "<edge")
880 (insert (format " color=\"%s\"" edge-color))
881 (insert (format " style=\"%s\"" edge-style))
882 (insert (format " width=\"%s\"" edge-width))
883 (insert "/>\n")
884 (insert "<font")
885 (insert (format " italic=\"%s\"" italic))
886 (insert (format " bold=\"%s\"" bold))
887 (insert (format " name=\"%s\"" font-name))
888 (insert (format " size=\"%s\"" font-size))
889 ))))
890
891;;;###autoload
892(defun org-freemind-from-org-mode-node (node-line mm-file)
afe98dfa
CD		 893 "Convert node at line NODE-LINE to the FreeMind file MM-FILE.
894See `org-freemind-from-org-mode' for more information."
8bfe682a
CD		 895 (interactive
896 (progn
897 (unless (org-back-to-heading nil)
898 (error "Can't find org-mode node start"))
899 (let* ((line (line-number-at-pos))
900 (default-mm-file (concat (if buffer-file-name
901 (file-name-nondirectory buffer-file-name)
902 "nofile")
903 "-line-" (number-to-string line)
904 ".mm"))
905 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
906 (list line mm-file))))
afe98dfa 907 (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
8bfe682a
CD		 908 (let ((org-buffer (current-buffer))
909 (mm-buffer (find-file-noselect mm-file)))
910 (org-freemind-write-mm-buffer org-buffer mm-buffer node-line)
911 (with-current-buffer mm-buffer
912 (basic-save-buffer)
afe98dfa 913 (when (org-called-interactively-p 'any)
8bfe682a
CD		 914 (switch-to-buffer-other-window mm-buffer)
915 (when (y-or-n-p "Show in FreeMind? ")
916 (org-freemind-show buffer-file-name)))))))
917
918;;;###autoload
919(defun org-freemind-from-org-mode (org-file mm-file)
afe98dfa
CD		 920 "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE.
921All the nodes will be opened or closed in Freemind just as you
922have them in `org-mode'.
923
924Note that exporting to Freemind also gives you an alternative way
925to export from `org-mode' to html. You can create a dynamic html
926version of the your org file, by first exporting to Freemind and
927then exporting from Freemind to html. The 'As
928XHTML (JavaScript)' version in Freemind works very well \(and you
929can use a CSS stylesheet to style it)."
8bfe682a
CD		 930 ;; Fix-me: better doc, include recommendations etc.
931 (interactive
932 (let* ((org-file buffer-file-name)
933 (default-mm-file (concat
934 (if org-file
935 (file-name-nondirectory org-file)
936 "nofile")
937 ".mm"))
938 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
939 (list org-file mm-file)))
afe98dfa 940 (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
8bfe682a
CD		 941 (let ((org-buffer (if org-file (find-file-noselect org-file) (current-buffer)))
942 (mm-buffer (find-file-noselect mm-file)))
943 (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
944 (with-current-buffer mm-buffer
945 (basic-save-buffer)
afe98dfa 946 (when (org-called-interactively-p 'any)
8bfe682a
CD		 947 (switch-to-buffer-other-window mm-buffer)
948 (when (y-or-n-p "Show in FreeMind? ")
949 (org-freemind-show buffer-file-name)))))))
950
951;;;###autoload
952(defun org-freemind-from-org-sparse-tree (org-buffer mm-file)
953 "Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE."
954 (interactive
955 (let* ((org-file buffer-file-name)
956 (default-mm-file (concat
957 (if org-file
958 (file-name-nondirectory org-file)
959 "nofile")
960 "-sparse.mm"))
961 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
962 (list (current-buffer) mm-file)))
afe98dfa 963 (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
8bfe682a
CD		 964 (let (org-buffer
965 (mm-buffer (find-file-noselect mm-file)))
966 (save-window-excursion
967 (org-export-visible ?\ nil)
968 (setq org-buffer (current-buffer)))
969 (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
970 (with-current-buffer mm-buffer
971 (basic-save-buffer)
afe98dfa 972 (when (org-called-interactively-p 'any)
8bfe682a
CD		 973 (switch-to-buffer-other-window mm-buffer)
974 (when (y-or-n-p "Show in FreeMind? ")
975 (org-freemind-show buffer-file-name)))))))
976
977
978;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
979;;; FreeMind => Org
980
981;; (sort '(b a c) 'org-freemind-lt-symbols)
982(defun org-freemind-lt-symbols (sym-a sym-b)
983 (string< (symbol-name sym-a) (symbol-name sym-b)))
984;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs)
985(defun org-freemind-lt-xml-attrs (attr-a attr-b)
986 (string< (symbol-name (car attr-a)) (symbol-name (car attr-b))))
987
988;; xml-parse-region gives things like
989;; ((p nil "\n"
990;; (a
991;; ((href . "link"))
992;; "text")
993;; "\n"
994;; (b nil "hej")
995;; "\n"))
996
997;; '(a . nil)
998
999;; (org-freemind-symbols= 'a (car '(A B)))
1000(defsubst org-freemind-symbols= (sym-a sym-b)
1001 "Return t if downcased names of SYM-A and SYM-B are equal.
1002SYM-A and SYM-B should be symbols."
1003 (or (eq sym-a sym-b)
1004 (string= (downcase (symbol-name sym-a))
1005 (downcase (symbol-name sym-b)))))
1006
1007(defun org-freemind-get-children (parent path)
1008 "Find children node to PARENT from PATH.
1009PATH should be a list of steps, where each step has the form
1010
1011 '(NODE-NAME (ATTR-NAME . ATTR-VALUE))"
1012 ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val
1013 ;; Fix-me: case insensitive version for children?
1014 (let* ((children (if (not (listp (car parent)))
1015 (cddr parent)
1016 (let (cs)
1017 (dolist (p parent)
1018 (dolist (c (cddr p))
1019 (add-to-list 'cs c)))
1020 cs)
1021 ))
1022 (step (car path))
1023 (step-node (if (listp step) (car step) step))
1024 (step-attr-list (when (listp step) (sort (cdr step) 'org-freemind-lt-xml-attrs)))
1025 (path-tail (cdr path))
1026 path-children)
1027 (dolist (child children)
1028 ;; skip xml.el formatting nodes
1029 (unless (stringp child)
1030 ;; compare node name
1031 (when (if (not step-node)
1032 t ;; any node name
1033 (org-freemind-symbols= step-node (car child)))
1034 (if (not step-attr-list)
1035 ;;(throw 'path-child child) ;; no attr to care about
1036 (add-to-list 'path-children child)
1037 (let* ((child-attr-list (cadr child))
1038 (step-attr-copy (copy-sequence step-attr-list)))
1039 (dolist (child-attr child-attr-list)
8223b1d2 1040 ;; Compare attr names:
8bfe682a
CD		 1041 (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr))
1042 ;; Compare values:
1043 (let ((step-val (cdar step-attr-copy))
1044 (child-val (cdr child-attr)))
1045 (when (if (not step-val)
1046 t ;; any value
1047 (string= step-val child-val))
1048 (setq step-attr-copy (cdr step-attr-copy))))))
1049 ;; Did we find all?
1050 (unless step-attr-copy
1051 ;;(throw 'path-child child)
1052 (add-to-list 'path-children child)
1053 ))))))
1054 (if path-tail
1055 (org-freemind-get-children path-children path-tail)
1056 path-children)))
1057
1058(defun org-freemind-get-richcontent-node (node)
1059 (let ((rc-nodes
1060 (org-freemind-get-children node '((richcontent (type . "NODE")) html body))))
1061 (when (> (length rc-nodes) 1)
1062 (lwarn t :warning "Unexpected structure: several <richcontent type=\"NODE\" ...>"))
1063 (car rc-nodes)))
1064
1065(defun org-freemind-get-richcontent-note (node)
1066 (let ((rc-notes
1067 (org-freemind-get-children node '((richcontent (type . "NOTE")) html body))))
1068 (when (> (length rc-notes) 1)
1069 (lwarn t :warning "Unexpected structure: several <richcontent type=\"NOTE\" ...>"))
1070 (car rc-notes)))
1071
1072(defun org-freemind-test-get-tree-text ()
1073 (let ((node '(p nil "\n"
8223b1d2
BG		 1074 (a
1075 ((href . "link"))
1076 "text")
1077 "\n"
1078 (b nil "hej")
1079 "\n")))
8bfe682a
CD		 1080 (org-freemind-get-tree-text node)))
1081;; (org-freemind-test-get-tree-text)
1082
1083(defun org-freemind-get-tree-text (node)
1084 (when node
1085 (let ((ntxt "")
1086 (link nil)
1087 (lf-after nil))
1088 (dolist (n node)
1089 (case n
1090 ;;(a (setq is-link t) )
1091 ((h1 h2 h3 h4 h5 h6 p)
1092 ;;(setq ntxt (concat "\n" ntxt))
8223b1d2 1093 (setq lf-after 2))
8bfe682a 1094 (br
8223b1d2 1095 (setq lf-after 1))
8bfe682a
CD		 1096 (t
1097 (cond
1098 ((stringp n)
1099 (when (string= n "\n") (setq n ""))
1100 (if link
1101 (setq ntxt (concat ntxt
1102 "[[" link "][" n "]]"))
1103 (setq ntxt (concat ntxt n))))
1104 ((and n (listp n))
1105 (if (symbolp (car n))
1106 (setq ntxt (concat ntxt (org-freemind-get-tree-text n)))
1107 ;; This should be the attributes:
1108 (dolist (att-val n)
1109 (let ((att (car att-val))
1110 (val (cdr att-val)))
1111 (when (eq att 'href)
8223b1d2 1112 (setq link val))))))))))
8bfe682a
CD		 1113 (if lf-after
1114 (setq ntxt (concat ntxt (make-string lf-after ?\n)))
1115 (setq ntxt (concat ntxt " ")))
1116 ;;(setq ntxt (concat ntxt (format "{%s}" n)))
1117 ntxt)))
1118
1119(defun org-freemind-get-richcontent-node-text (node)
1120 "Get the node text as from the richcontent node NODE."
1121 (save-match-data
1122 (let* ((rc (org-freemind-get-richcontent-node node))
1123 (txt (org-freemind-get-tree-text rc)))
afe98dfa 1124 ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
8bfe682a
CD		 1125 txt
1126 )))
1127
1128(defun org-freemind-get-richcontent-note-text (node)
1129 "Get the node text as from the richcontent note NODE."
1130 (save-match-data
1131 (let* ((rc (org-freemind-get-richcontent-note node))
1132 (txt (when rc (org-freemind-get-tree-text rc))))
afe98dfa 1133 ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
8bfe682a
CD		 1134 txt
1135 )))
1136
1137(defun org-freemind-get-icon-names (node)
1138 (let* ((icon-nodes (org-freemind-get-children node '((icon ))))
1139 names)
1140 (dolist (icn icon-nodes)
1141 (setq names (cons (cdr (assq 'builtin (cadr icn))) names)))
1142 ;; (icon (builtin . "full-1"))
1143 names))
1144
1145(defun org-freemind-node-to-org (node level skip-levels)
1146 (let ((qname (car node))
1147 (attributes (cadr node))
1148 text
afe98dfa 1149 ;; Fix-me: note is never inserted
8bfe682a
CD		 1150 (note (org-freemind-get-richcontent-note-text node))
1151 (mark "-- This is more about ")
1152 (icons (org-freemind-get-icon-names node))
1153 (children (cddr node)))
1154 (when (< 0 (- level skip-levels))
1155 (dolist (attrib attributes)
1156 (case (car attrib)
3ab2c837
BG		 1157 ('TEXT (setq text (cdr attrib)))
1158 ('text (setq text (cdr attrib)))))
8bfe682a
CD		 1159 (unless text
1160 ;; There should be a richcontent node holding the text:
1161 (setq text (org-freemind-get-richcontent-node-text node)))
1162 (when icons
1163 (when (member "full-1" icons) (setq text (concat "[#A] " text)))
1164 (when (member "full-2" icons) (setq text (concat "[#B] " text)))
1165 (when (member "full-3" icons) (setq text (concat "[#C] " text)))
1166 (when (member "full-4" icons) (setq text (concat "[#D] " text)))
1167 (when (member "full-5" icons) (setq text (concat "[#E] " text)))
1168 (when (member "full-6" icons) (setq text (concat "[#F] " text)))
1169 (when (member "full-7" icons) (setq text (concat "[#G] " text)))
1170 (when (member "button_cancel" icons) (setq text (concat "TODO " text)))
1171 )
1172 (if (and note
1173 (string= mark (substring note 0 (length mark))))
1174 (progn
1175 (setq text (replace-regexp-in-string "\n $" "" text))
1176 (insert text))
1177 (case qname
3ab2c837 1178 ('node
8bfe682a 1179 (insert (make-string (- level skip-levels) ?*) " " text "\n")
afe98dfa
CD		 1180 (when note
1181 (insert ":COMMENT:\n" note "\n:END:\n"))
8bfe682a
CD		 1182 ))))
1183 (dolist (child children)
1184 (unless (or (null child)
1185 (stringp child))
1186 (org-freemind-node-to-org child (1+ level) skip-levels)))))
1187
1188;; Fix-me: put back special things, like drawers that are stored in
8223b1d2 1189;; the notes. Should maybe all notes contents be put in drawers?
8bfe682a
CD		 1190;;;###autoload
1191(defun org-freemind-to-org-mode (mm-file org-file)
1192 "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."
1193 (interactive
1194 (save-match-data
1195 (let* ((mm-file (buffer-file-name))
1196 (default-org-file (concat (file-name-nondirectory mm-file) ".org"))
1197 (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file)))
1198 (list mm-file org-file))))
afe98dfa 1199 (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any))
8bfe682a
CD		 1200 (let ((mm-buffer (find-file-noselect mm-file))
1201 (org-buffer (find-file-noselect org-file)))
1202 (with-current-buffer mm-buffer
1203 (let* ((xml-list (xml-parse-file mm-file))
1204 (top-node (cadr (cddar xml-list)))
1205 (note (org-freemind-get-richcontent-note-text top-node))
1206 (skip-levels
1207 (if (and note
afe98dfa 1208 (string-match "^--org-mode: WHOLE FILE$" note))
8bfe682a
CD		 1209 1
1210 0)))
1211 (with-current-buffer org-buffer
1212 (erase-buffer)
1213 (org-freemind-node-to-org top-node 1 skip-levels)
1214 (goto-char (point-min))
1215 (org-set-tags t t) ;; Align all tags
1216 )
1217 (switch-to-buffer-other-window org-buffer)
1218 )))))
1219
1220(provide 'org-freemind)
1221
bdebdb64
BG		 1222;; Local variables:
1223;; generated-autoload-file: "org-loaddefs.el"
c38e0c97 1224;; coding: utf-8
bdebdb64 1225;; End:
e66ba1df 1226
8bfe682a 1227;;; org-freemind.el ends here
Unnamed repository; edit this file 'description' to name the repository.