lisp/org-freemind.el

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