org-freemind.el 50 KB

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