lisp/org/org-freemind.el

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