Add :version to org-bibtex.el options.
[org-mode/org-mode-NeilSmithlineMods.git] / lisp / org-freemind.el
blob3b94d928945cc9c46b03cfab1910f0b25373cdf3
1 ;;; org-freemind.el --- Export Org files to freemind
3 ;; Copyright (C) 2009-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
8 ;;
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34 ;;; Commentary:
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51 ;;; Change log:
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.
59 ;;; Code:
61 (require 'xml)
62 (require 'org)
63 ;(require 'rx)
64 (require 'org-exp)
65 (eval-when-compile (require 'cl))
67 (defgroup org-freemind nil
68 "Customization group for org-freemind export/import."
69 :group 'org)
71 ;; Fix-me: I am not sure these are useful:
73 ;; (defcustom org-freemind-main-fgcolor "black"
74 ;; "Color of main node's text."
75 ;; :type 'color
76 ;; :group 'org-freemind)
78 ;; (defcustom org-freemind-main-color "black"
79 ;; "Background color of main node."
80 ;; :type 'color
81 ;; :group 'org-freemind)
83 ;; (defcustom org-freemind-child-fgcolor "black"
84 ;; "Color of child nodes' text."
85 ;; :type 'color
86 ;; :group 'org-freemind)
88 ;; (defcustom org-freemind-child-color "black"
89 ;; "Background color of child nodes."
90 ;; :type 'color
91 ;; :group 'org-freemind)
93 (defvar org-freemind-node-style nil "Internal use.")
95 (defcustom org-freemind-node-styles nil
96 "Styles to apply to node.
97 NOT 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)))))))
138 :group 'org-freemind)
140 ;;;###autoload
141 (defun org-export-as-freemind (&optional hidden ext-plist
142 to-buffer body-only pub-dir)
143 "Export the current buffer as a Freemind file.
144 If there is an active region, export only the region. HIDDEN is
145 obsolete and does nothing. EXT-PLIST is a property list with
146 external parameters overriding org-mode's default settings, but
147 still inferior to file-local settings. When TO-BUFFER is
148 non-nil, create a buffer with that name and export to that
149 buffer. If TO-BUFFER is the symbol `string', don't leave any
150 buffer behind but just return the resulting HTML as a string.
151 When BODY-ONLY is set, don't produce the file header and footer,
152 simply return the content of the document (all top level
153 sections). When PUB-DIR is set, use this as the publishing
154 directory.
156 See `org-freemind-from-org-mode' for more information."
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)
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)))))
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)
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 "")))
216 "")))
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))
227 (defconst org-freemind-org-nfix "--org-mode: ")
229 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
230 ;;; Format converters
232 (defun org-freemind-escape-str-from-org (org-str)
233 "Do some html-escaping of ORG-STR and return the result.
234 The 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
240 (if (< cc 160)
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:
253 ;; (format "&#x%x;" (- cc ;; ?\x800))
254 (format "&#x%x;" (encode-char cc 'ucs))
255 ))))
256 fm-str))
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)
261 "Do some html-unescaping of FM-STR and return the result.
262 This is the opposite of `org-freemind-escape-str-from-org' but it
263 will also unescape &#nn;."
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?
276 org-str))))
278 ;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
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)))
284 (defun org-freemind-convert-links-helper (matched)
285 "Helper for `org-freemind-convert-links-from-org'.
286 MATCHED is the link just matched."
287 (let* ((link (match-string 1 matched))
288 (text (match-string 2 matched))
289 (ext (file-name-extension link))
290 (col-pos (org-string-match-p ":" link))
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")))))
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>.
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>"))))
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
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~]+\\)"
322 "[[\\1][\\1]]"
323 org-str
324 nil ;; fixedcase
325 nil ;; literal
326 1 ;; subexp
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
337 fm-str)))
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
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>"
356 "[[\\1][\\2]]"
357 fm-str)))
358 org-str))
360 ;; Fix-me:
361 ;;(defun org-freemind-convert-drawers-from-org (text)
362 ;; )
364 ;; (let* ((str1 "[[http://www.somewhere/][link-text]")
365 ;; (str2 (org-freemind-convert-links-from-org str1))
366 ;; (str3 (org-freemind-convert-links-to-org str2)))
367 ;; (unless (string= str1 str3)
368 ;; (error "Error str3=%s" str3)))
370 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
371 ;;; Org => FreeMind
373 (defvar org-freemind-bol-helper-base-indent nil)
375 (defun org-freemind-bol-helper (matched)
376 "Helper for `org-freemind-convert-text-p'.
377 MATCHED 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;"))
383 ;; We need to use the numerical version. Otherwise Freemind
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 "))
393 (defun org-freemind-convert-text-p (text)
394 "Convert TEXT to html with <p> paragraphs."
395 ;; (string-match-p "[^ ]" " a")
396 (setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text))
397 (setq text (org-freemind-escape-str-from-org text))
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))
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))
405 (setq text (replace-regexp-in-string "\n" "<br />" text))
406 (setq text (concat text "</p>"))
408 (org-freemind-convert-links-from-org text))
410 (defcustom org-freemind-node-css-style
411 "p { margin-top: 3px; margin-bottom: 3px; }"
412 "CSS style for Freemind nodes."
413 ;; Fix-me: I do not understand this. It worked to export from Freemind
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).
417 :version "24.1"
418 :group 'org-freemind)
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.
422 Convert the text part of the org node named NODE-NAME. The text
423 is in the current buffer between START and END. Drawers matching
424 DRAWERS-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))))
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 ))))
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"
458 "</richcontent>\n"))
461 ;; There is always an LF char:
462 (when (> (length text) 1)
463 (setq node-res (concat
464 "<node style=\"bubble\" background_color=\"#eeee00\">\n"
465 "<richcontent TYPE=\"NODE\"><html>\n"
466 "<head>\n"
467 (if (= 0 (length org-freemind-node-css-style))
469 (concat
470 "<style type=\"text/css\">\n"
471 "<!--\n"
472 org-freemind-node-css-style
473 "-->\n"
474 "</style>\n"))
475 "</head>\n"
476 "<body>\n"))
477 (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML"))
478 (end-html-mark (regexp-quote "#+END_HTML"))
479 head
480 end-pos
481 end-pos-match
483 ;; Take care of #+BEGIN_HTML - #+END_HTML
484 (while (string-match begin-html-mark text)
485 (setq head (substring text 0 (match-beginning 0)))
486 (setq end-pos-match (match-end 0))
487 (setq node-res (concat node-res
488 (org-freemind-convert-text-p head)))
489 (setq text (substring text end-pos-match))
490 (setq end-pos (string-match end-html-mark text))
491 (if end-pos
492 (setq end-pos-match (match-end 0))
493 (message "org-freemind: Missing #+END_HTML")
494 (setq end-pos (length text))
495 (setq end-pos-match end-pos))
496 (setq node-res (concat node-res
497 (substring text 0 end-pos)))
498 (setq text (substring text end-pos-match)))
499 (setq node-res (concat node-res
500 (org-freemind-convert-text-p text))))
501 (setq node-res (concat
502 node-res
503 "</body>\n"
504 "</html>\n"
505 "</richcontent>\n"
506 ;; Put a note that this is for the parent node
507 ;; "<richcontent TYPE=\"NOTE\"><html>"
508 ;; "<head>"
509 ;; "</head>"
510 ;; "<body>"
511 ;; "<p>"
512 ;; "-- This is more about \"" node-name "\" --"
513 ;; "</p>"
514 ;; "</body>"
515 ;; "</html>"
516 ;; "</richcontent>\n"
517 note-res
518 "</node>\n" ;; ok
520 (list node-res note-res))))
522 (defun org-freemind-write-node (mm-buffer drawers-regexp
523 num-left-nodes base-level
524 current-level next-level this-m2
525 this-node-end
526 this-children-visible
527 next-node-start
528 next-has-some-visible-child)
529 (let* (this-icons
530 this-bg-color
531 this-m2-escaped
532 this-rich-node
533 this-rich-note
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))
563 (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2))
564 (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
565 this-m2-escaped
566 this-node-end
567 (1- next-node-start)
568 drawers-regexp)))
569 (setq this-rich-node (nth 0 node-notes))
570 (setq this-rich-note (nth 1 node-notes)))
571 (with-current-buffer mm-buffer
572 (insert "<node text=\"" this-m2-escaped "\"")
573 (org-freemind-get-node-style this-m2)
574 (when (> next-level current-level)
575 (unless (or this-children-visible
576 next-has-some-visible-child)
577 (insert " folded=\"true\"")))
578 (when (and (= current-level (1+ base-level))
579 (> num-left-nodes 0))
580 (setq num-left-nodes (1- num-left-nodes))
581 (insert " position=\"left\""))
582 (when this-bg-color
583 (insert " background_color=\"" this-bg-color "\""))
584 (insert ">\n")
585 (when this-icons
586 (dolist (icon this-icons)
587 (insert "<icon builtin=\"" icon "\"/>\n")))
589 (with-current-buffer mm-buffer
590 ;;(when this-rich-note (insert this-rich-note))
591 (when this-rich-node (insert this-rich-node))))
592 num-left-nodes)
594 (defun org-freemind-check-overwrite (file interactively)
595 "Check if file FILE already exists.
596 If FILE does not exists return t.
598 If INTERACTIVELY is non-nil ask if the file should be replaced
599 and return t/nil if it should/should not be replaced.
601 Otherwise give an error say the file exists."
602 (if (file-exists-p file)
603 (if interactively
604 (y-or-n-p (format "File %s exists, replace it? " file))
605 (error "File %s already exists" file))
608 (defvar org-freemind-node-pattern
609 ;;(rx bol
610 ;; (submatch (1+ "*"))
611 ;; (1+ space)
612 ;; (submatch (*? nonl))
613 ;; eol)
614 "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$")
616 (defun org-freemind-look-for-visible-child (node-level)
617 (save-excursion
618 (save-match-data
619 (let ((found-visible-child nil))
620 (while (and (not found-visible-child)
621 (re-search-forward org-freemind-node-pattern nil t))
622 (let* ((m1 (match-string-no-properties 1))
623 (level (length m1)))
624 (if (>= node-level level)
625 (setq found-visible-child 'none)
626 (unless (get-char-property (line-beginning-position) 'invisible)
627 (setq found-visible-child 'found)))))
628 (eq found-visible-child 'found)
629 ))))
631 (defun org-freemind-goto-line (line)
632 "Go to line number LINE."
633 (save-restriction
634 (widen)
635 (goto-char (point-min))
636 (forward-line (1- line))))
638 (defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line)
639 (with-current-buffer org-buffer
640 (dolist (node-style org-freemind-node-styles)
641 (when (org-string-match-p (car node-style) buffer-file-name)
642 (setq org-freemind-node-style (cadr node-style))))
643 ;;(message "org-freemind-node-style =%s" org-freemind-node-style)
644 (save-match-data
645 (let* ((drawers (copy-sequence org-drawers))
646 drawers-regexp
647 (num-top1-nodes 0)
648 (num-top2-nodes 0)
649 num-left-nodes
650 (unclosed-nodes 0)
651 (odd-only org-odd-levels-only)
652 (first-time t)
653 (current-level 1)
654 base-level
655 prev-node-end
656 rich-text
657 unfinished-tag
658 node-at-line-level
659 node-at-line-last)
660 (with-current-buffer mm-buffer
661 (erase-buffer)
662 (setq buffer-file-coding-system 'utf-8)
663 ;; Fix-me: Currently Freemind (ver 0.9.0 RC9) does not support this:
664 ;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
665 (insert "<map version=\"0.9.0\">\n")
666 (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n"))
667 (save-excursion
668 ;; Get special buffer vars:
669 (goto-char (point-min))
670 (message "Writing Freemind file...")
671 (while (re-search-forward "^#\\+DRAWERS:" nil t)
672 (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position))))
673 (setq drawers (append drawers (split-string dr-txt) nil))))
674 (setq drawers-regexp
675 (concat "^[[:blank:]]*:"
676 (regexp-opt drawers)
677 ;;(rx ":" (0+ blank)
678 ;; "\n"
679 ;; (*? anything)
680 ;; "\n"
681 ;; (0+ blank)
682 ;; ":END:"
683 ;; (0+ blank)
684 ;; eol)
685 ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$"
688 (if node-at-line
689 ;; Get number of top nodes and last line for this node
690 (progn
691 (org-freemind-goto-line node-at-line)
692 (unless (looking-at org-freemind-node-pattern)
693 (error "No node at line %s" node-at-line))
694 (setq node-at-line-level (length (match-string-no-properties 1)))
695 (forward-line)
696 (setq node-at-line-last
697 (catch 'last-line
698 (while (re-search-forward org-freemind-node-pattern nil t)
699 (let* ((m1 (match-string-no-properties 1))
700 (level (length m1)))
701 (if (<= level node-at-line-level)
702 (progn
703 (beginning-of-line)
704 (throw 'last-line (1- (point))))
705 (if (= level (1+ node-at-line-level))
706 (setq num-top2-nodes (1+ num-top2-nodes))))))))
707 (setq current-level node-at-line-level)
708 (setq num-top1-nodes 1)
709 (org-freemind-goto-line node-at-line))
711 ;; First get number of top nodes
712 (goto-char (point-min))
713 (while (re-search-forward org-freemind-node-pattern nil t)
714 (let* ((m1 (match-string-no-properties 1))
715 (level (length m1)))
716 (if (= level 1)
717 (setq num-top1-nodes (1+ num-top1-nodes))
718 (if (= level 2)
719 (setq num-top2-nodes (1+ num-top2-nodes))))))
720 ;; If there is more than one top node we need to insert a node
721 ;; to keep them together.
722 (goto-char (point-min))
723 (when (> num-top1-nodes 1)
724 (setq num-top2-nodes num-top1-nodes)
725 (setq current-level 0)
726 (let ((orig-name (if buffer-file-name
727 (file-name-nondirectory (buffer-file-name))
728 (buffer-name))))
729 (with-current-buffer mm-buffer
730 (insert "<node text=\"" orig-name "\" background_color=\"#00bfff\">\n"
731 ;; Put a note that this is for the parent node
732 "<richcontent TYPE=\"NOTE\"><html>"
733 "<head>"
734 "</head>"
735 "<body>"
736 "<p>"
737 org-freemind-org-nfix "WHOLE FILE"
738 "</p>"
739 "</body>"
740 "</html>"
741 "</richcontent>\n")))))
743 (setq num-left-nodes (floor num-top2-nodes 2))
744 (setq base-level current-level)
745 (let (this-m2
746 this-node-end
747 this-children-visible
748 next-m2
749 next-node-start
750 next-level
751 next-has-some-visible-child
752 next-children-visible
754 (while (and
755 (re-search-forward org-freemind-node-pattern nil t)
756 (if node-at-line-last (<= (point) node-at-line-last) t)
758 (let* ((next-m1 (match-string-no-properties 1))
759 (next-node-end (match-end 0))
761 (setq next-node-start (match-beginning 0))
762 (setq next-m2 (match-string-no-properties 2))
763 (setq next-level (length next-m1))
764 (setq next-children-visible
765 (not (eq 'outline
766 (get-char-property (line-end-position) 'invisible))))
767 (setq next-has-some-visible-child
768 (if next-children-visible t
769 (org-freemind-look-for-visible-child next-level)))
770 (when this-m2
771 (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)))
772 (when (if (= num-top1-nodes 1) (> current-level base-level) t)
773 (while (>= current-level next-level)
774 (with-current-buffer mm-buffer
775 (insert "</node>\n")
776 (setq current-level
777 (- current-level (if odd-only 2 1))))))
778 (setq this-node-end (1+ next-node-end))
779 (setq this-m2 next-m2)
780 (setq current-level next-level)
781 (setq this-children-visible next-children-visible)
782 (forward-char)
784 ;;; (unless (if node-at-line-last
785 ;;; (>= (point) node-at-line-last)
786 ;;; nil)
787 ;; Write last node:
788 (setq this-m2 next-m2)
789 (setq current-level next-level)
790 (setq next-node-start (if node-at-line-last
791 (1+ node-at-line-last)
792 (point-max)))
793 (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))
794 (with-current-buffer mm-buffer (insert "</node>\n"))
797 (with-current-buffer mm-buffer
798 (while (> current-level base-level)
799 (insert "</node>\n")
800 (setq current-level
801 (- current-level (if odd-only 2 1)))
803 (with-current-buffer mm-buffer
804 (insert "</map>")
805 (delete-trailing-whitespace)
806 (goto-char (point-min))
807 ))))))
809 (defun org-freemind-get-node-style (node-name)
810 "NOT READY YET."
811 ;;<node BACKGROUND_COLOR="#eeee00" CREATED="1234668815593" MODIFIED="1234668815593" STYLE="bubble">
812 ;;<font BOLD="true" NAME="SansSerif" SIZE="12"/>
813 (let (node-styles
814 node-style)
815 (dolist (style-list org-freemind-node-style)
816 (let ((node-regexp (car style-list)))
817 (message "node-regexp=%s node-name=%s" node-regexp node-name)
818 (when (org-string-match-p node-regexp node-name)
819 ;;(setq node-style (org-freemind-do-apply-node-style style-list))
820 (setq node-style (cadr style-list))
821 (when node-style
822 (message "node-style=%s" node-style)
823 (setq node-styles (append node-styles node-style)))
824 )))))
826 (defun org-freemind-do-apply-node-style (style-list)
827 (message "style-list=%S" style-list)
828 (let ((node-style 'fork)
829 (color "red")
830 (background-color "yellow")
831 (edge-color "green")
832 (edge-style 'bezier)
833 (edge-width 'thin)
834 (italic t)
835 (bold t)
836 (font-name "SansSerif")
837 (font-size 12))
838 (dolist (style (cadr style-list))
839 (message " style=%s" style)
840 (let ((what (car style)))
841 (cond
842 ((eq what 'node-style)
843 (setq node-style (cadr style)))
844 ((eq what 'color)
845 (setq color (cadr style)))
846 ((eq what 'background-color)
847 (setq background-color (cadr style)))
849 ((eq what 'edge-color)
850 (setq edge-color (cadr style)))
852 ((eq what 'edge-style)
853 (setq edge-style (cadr style)))
855 ((eq what 'edge-width)
856 (setq edge-width (cadr style)))
858 ((eq what 'italic)
859 (setq italic (cadr style)))
861 ((eq what 'bold)
862 (setq bold (cadr style)))
864 ((eq what 'font-name)
865 (setq font-name (cadr style)))
867 ((eq what 'font-size)
868 (setq font-size (cadr style)))
870 (insert (format " style=\"%s\"" node-style))
871 (insert (format " color=\"%s\"" color))
872 (insert (format " background_color=\"%s\"" background-color))
873 (insert ">\n")
874 (insert "<edge")
875 (insert (format " color=\"%s\"" edge-color))
876 (insert (format " style=\"%s\"" edge-style))
877 (insert (format " width=\"%s\"" edge-width))
878 (insert "/>\n")
879 (insert "<font")
880 (insert (format " italic=\"%s\"" italic))
881 (insert (format " bold=\"%s\"" bold))
882 (insert (format " name=\"%s\"" font-name))
883 (insert (format " size=\"%s\"" font-size))
884 ))))
886 ;;;###autoload
887 (defun org-freemind-from-org-mode-node (node-line mm-file)
888 "Convert node at line NODE-LINE to the FreeMind file MM-FILE.
889 See `org-freemind-from-org-mode' for more information."
890 (interactive
891 (progn
892 (unless (org-back-to-heading nil)
893 (error "Can't find org-mode node start"))
894 (let* ((line (line-number-at-pos))
895 (default-mm-file (concat (if buffer-file-name
896 (file-name-nondirectory buffer-file-name)
897 "nofile")
898 "-line-" (number-to-string line)
899 ".mm"))
900 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
901 (list line mm-file))))
902 (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
903 (let ((org-buffer (current-buffer))
904 (mm-buffer (find-file-noselect mm-file)))
905 (org-freemind-write-mm-buffer org-buffer mm-buffer node-line)
906 (with-current-buffer mm-buffer
907 (basic-save-buffer)
908 (when (org-called-interactively-p 'any)
909 (switch-to-buffer-other-window mm-buffer)
910 (when (y-or-n-p "Show in FreeMind? ")
911 (org-freemind-show buffer-file-name)))))))
913 ;;;###autoload
914 (defun org-freemind-from-org-mode (org-file mm-file)
915 "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE.
916 All the nodes will be opened or closed in Freemind just as you
917 have them in `org-mode'.
919 Note that exporting to Freemind also gives you an alternative way
920 to export from `org-mode' to html. You can create a dynamic html
921 version of the your org file, by first exporting to Freemind and
922 then exporting from Freemind to html. The 'As
923 XHTML (JavaScript)' version in Freemind works very well \(and you
924 can use a CSS stylesheet to style it)."
925 ;; Fix-me: better doc, include recommendations etc.
926 (interactive
927 (let* ((org-file buffer-file-name)
928 (default-mm-file (concat
929 (if org-file
930 (file-name-nondirectory org-file)
931 "nofile")
932 ".mm"))
933 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
934 (list org-file mm-file)))
935 (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
936 (let ((org-buffer (if org-file (find-file-noselect org-file) (current-buffer)))
937 (mm-buffer (find-file-noselect mm-file)))
938 (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
939 (with-current-buffer mm-buffer
940 (basic-save-buffer)
941 (when (org-called-interactively-p 'any)
942 (switch-to-buffer-other-window mm-buffer)
943 (when (y-or-n-p "Show in FreeMind? ")
944 (org-freemind-show buffer-file-name)))))))
946 ;;;###autoload
947 (defun org-freemind-from-org-sparse-tree (org-buffer mm-file)
948 "Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE."
949 (interactive
950 (let* ((org-file buffer-file-name)
951 (default-mm-file (concat
952 (if org-file
953 (file-name-nondirectory org-file)
954 "nofile")
955 "-sparse.mm"))
956 (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
957 (list (current-buffer) mm-file)))
958 (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
959 (let (org-buffer
960 (mm-buffer (find-file-noselect mm-file)))
961 (save-window-excursion
962 (org-export-visible ?\ nil)
963 (setq org-buffer (current-buffer)))
964 (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
965 (with-current-buffer mm-buffer
966 (basic-save-buffer)
967 (when (org-called-interactively-p 'any)
968 (switch-to-buffer-other-window mm-buffer)
969 (when (y-or-n-p "Show in FreeMind? ")
970 (org-freemind-show buffer-file-name)))))))
973 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
974 ;;; FreeMind => Org
976 ;; (sort '(b a c) 'org-freemind-lt-symbols)
977 (defun org-freemind-lt-symbols (sym-a sym-b)
978 (string< (symbol-name sym-a) (symbol-name sym-b)))
979 ;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs)
980 (defun org-freemind-lt-xml-attrs (attr-a attr-b)
981 (string< (symbol-name (car attr-a)) (symbol-name (car attr-b))))
983 ;; xml-parse-region gives things like
984 ;; ((p nil "\n"
985 ;; (a
986 ;; ((href . "link"))
987 ;; "text")
988 ;; "\n"
989 ;; (b nil "hej")
990 ;; "\n"))
992 ;; '(a . nil)
994 ;; (org-freemind-symbols= 'a (car '(A B)))
995 (defsubst org-freemind-symbols= (sym-a sym-b)
996 "Return t if downcased names of SYM-A and SYM-B are equal.
997 SYM-A and SYM-B should be symbols."
998 (or (eq sym-a sym-b)
999 (string= (downcase (symbol-name sym-a))
1000 (downcase (symbol-name sym-b)))))
1002 (defun org-freemind-get-children (parent path)
1003 "Find children node to PARENT from PATH.
1004 PATH should be a list of steps, where each step has the form
1006 '(NODE-NAME (ATTR-NAME . ATTR-VALUE))"
1007 ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val
1008 ;; Fix-me: case insensitive version for children?
1009 (let* ((children (if (not (listp (car parent)))
1010 (cddr parent)
1011 (let (cs)
1012 (dolist (p parent)
1013 (dolist (c (cddr p))
1014 (add-to-list 'cs c)))
1017 (step (car path))
1018 (step-node (if (listp step) (car step) step))
1019 (step-attr-list (when (listp step) (sort (cdr step) 'org-freemind-lt-xml-attrs)))
1020 (path-tail (cdr path))
1021 path-children)
1022 (dolist (child children)
1023 ;; skip xml.el formatting nodes
1024 (unless (stringp child)
1025 ;; compare node name
1026 (when (if (not step-node)
1027 t ;; any node name
1028 (org-freemind-symbols= step-node (car child)))
1029 (if (not step-attr-list)
1030 ;;(throw 'path-child child) ;; no attr to care about
1031 (add-to-list 'path-children child)
1032 (let* ((child-attr-list (cadr child))
1033 (step-attr-copy (copy-sequence step-attr-list)))
1034 (dolist (child-attr child-attr-list)
1035 ;; Compare attr names:
1036 (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr))
1037 ;; Compare values:
1038 (let ((step-val (cdar step-attr-copy))
1039 (child-val (cdr child-attr)))
1040 (when (if (not step-val)
1041 t ;; any value
1042 (string= step-val child-val))
1043 (setq step-attr-copy (cdr step-attr-copy))))))
1044 ;; Did we find all?
1045 (unless step-attr-copy
1046 ;;(throw 'path-child child)
1047 (add-to-list 'path-children child)
1048 ))))))
1049 (if path-tail
1050 (org-freemind-get-children path-children path-tail)
1051 path-children)))
1053 (defun org-freemind-get-richcontent-node (node)
1054 (let ((rc-nodes
1055 (org-freemind-get-children node '((richcontent (type . "NODE")) html body))))
1056 (when (> (length rc-nodes) 1)
1057 (lwarn t :warning "Unexpected structure: several <richcontent type=\"NODE\" ...>"))
1058 (car rc-nodes)))
1060 (defun org-freemind-get-richcontent-note (node)
1061 (let ((rc-notes
1062 (org-freemind-get-children node '((richcontent (type . "NOTE")) html body))))
1063 (when (> (length rc-notes) 1)
1064 (lwarn t :warning "Unexpected structure: several <richcontent type=\"NOTE\" ...>"))
1065 (car rc-notes)))
1067 (defun org-freemind-test-get-tree-text ()
1068 (let ((node '(p nil "\n"
1070 ((href . "link"))
1071 "text")
1072 "\n"
1073 (b nil "hej")
1074 "\n")))
1075 (org-freemind-get-tree-text node)))
1076 ;; (org-freemind-test-get-tree-text)
1078 (defun org-freemind-get-tree-text (node)
1079 (when node
1080 (let ((ntxt "")
1081 (link nil)
1082 (lf-after nil))
1083 (dolist (n node)
1084 (case n
1085 ;;(a (setq is-link t) )
1086 ((h1 h2 h3 h4 h5 h6 p)
1087 ;;(setq ntxt (concat "\n" ntxt))
1088 (setq lf-after 2)
1091 (setq lf-after 1)
1094 (cond
1095 ((stringp n)
1096 (when (string= n "\n") (setq n ""))
1097 (if link
1098 (setq ntxt (concat ntxt
1099 "[[" link "][" n "]]"))
1100 (setq ntxt (concat ntxt n))))
1101 ((and n (listp n))
1102 (if (symbolp (car n))
1103 (setq ntxt (concat ntxt (org-freemind-get-tree-text n)))
1104 ;; This should be the attributes:
1105 (dolist (att-val n)
1106 (let ((att (car att-val))
1107 (val (cdr att-val)))
1108 (when (eq att 'href)
1109 (setq link val)))))
1110 )))))
1111 (if lf-after
1112 (setq ntxt (concat ntxt (make-string lf-after ?\n)))
1113 (setq ntxt (concat ntxt " ")))
1114 ;;(setq ntxt (concat ntxt (format "{%s}" n)))
1115 ntxt)))
1117 (defun org-freemind-get-richcontent-node-text (node)
1118 "Get the node text as from the richcontent node NODE."
1119 (save-match-data
1120 (let* ((rc (org-freemind-get-richcontent-node node))
1121 (txt (org-freemind-get-tree-text rc)))
1122 ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
1126 (defun org-freemind-get-richcontent-note-text (node)
1127 "Get the node text as from the richcontent note NODE."
1128 (save-match-data
1129 (let* ((rc (org-freemind-get-richcontent-note node))
1130 (txt (when rc (org-freemind-get-tree-text rc))))
1131 ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
1135 (defun org-freemind-get-icon-names (node)
1136 (let* ((icon-nodes (org-freemind-get-children node '((icon ))))
1137 names)
1138 (dolist (icn icon-nodes)
1139 (setq names (cons (cdr (assq 'builtin (cadr icn))) names)))
1140 ;; (icon (builtin . "full-1"))
1141 names))
1143 (defun org-freemind-node-to-org (node level skip-levels)
1144 (let ((qname (car node))
1145 (attributes (cadr node))
1146 text
1147 ;; Fix-me: note is never inserted
1148 (note (org-freemind-get-richcontent-note-text node))
1149 (mark "-- This is more about ")
1150 (icons (org-freemind-get-icon-names node))
1151 (children (cddr node)))
1152 (when (< 0 (- level skip-levels))
1153 (dolist (attrib attributes)
1154 (case (car attrib)
1155 ('TEXT (setq text (cdr attrib)))
1156 ('text (setq text (cdr attrib)))))
1157 (unless text
1158 ;; There should be a richcontent node holding the text:
1159 (setq text (org-freemind-get-richcontent-node-text node)))
1160 (when icons
1161 (when (member "full-1" icons) (setq text (concat "[#A] " text)))
1162 (when (member "full-2" icons) (setq text (concat "[#B] " text)))
1163 (when (member "full-3" icons) (setq text (concat "[#C] " text)))
1164 (when (member "full-4" icons) (setq text (concat "[#D] " text)))
1165 (when (member "full-5" icons) (setq text (concat "[#E] " text)))
1166 (when (member "full-6" icons) (setq text (concat "[#F] " text)))
1167 (when (member "full-7" icons) (setq text (concat "[#G] " text)))
1168 (when (member "button_cancel" icons) (setq text (concat "TODO " text)))
1170 (if (and note
1171 (string= mark (substring note 0 (length mark))))
1172 (progn
1173 (setq text (replace-regexp-in-string "\n $" "" text))
1174 (insert text))
1175 (case qname
1176 ('node
1177 (insert (make-string (- level skip-levels) ?*) " " text "\n")
1178 (when note
1179 (insert ":COMMENT:\n" note "\n:END:\n"))
1180 ))))
1181 (dolist (child children)
1182 (unless (or (null child)
1183 (stringp child))
1184 (org-freemind-node-to-org child (1+ level) skip-levels)))))
1186 ;; Fix-me: put back special things, like drawers that are stored in
1187 ;; the notes. Should maybe all notes contents be put in drawers?
1188 ;;;###autoload
1189 (defun org-freemind-to-org-mode (mm-file org-file)
1190 "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."
1191 (interactive
1192 (save-match-data
1193 (let* ((mm-file (buffer-file-name))
1194 (default-org-file (concat (file-name-nondirectory mm-file) ".org"))
1195 (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file)))
1196 (list mm-file org-file))))
1197 (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any))
1198 (let ((mm-buffer (find-file-noselect mm-file))
1199 (org-buffer (find-file-noselect org-file)))
1200 (with-current-buffer mm-buffer
1201 (let* ((xml-list (xml-parse-file mm-file))
1202 (top-node (cadr (cddar xml-list)))
1203 (note (org-freemind-get-richcontent-note-text top-node))
1204 (skip-levels
1205 (if (and note
1206 (string-match "^--org-mode: WHOLE FILE$" note))
1208 0)))
1209 (with-current-buffer org-buffer
1210 (erase-buffer)
1211 (org-freemind-node-to-org top-node 1 skip-levels)
1212 (goto-char (point-min))
1213 (org-set-tags t t) ;; Align all tags
1215 (switch-to-buffer-other-window org-buffer)
1216 )))))
1218 (provide 'org-freemind)
1222 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1224 ;;; org-freemind.el ends here