contrib/oldexp/org-freemind.el

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