lisp/org-freemind.el

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