lisp/org-freemind.el

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