[bpt/emacs.git] / lisp / org / org-freemind.el

;;; org-freemind.el --- Export Org files to freemind

;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.

;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 6.35i
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;; --------------------------------------------------------------------
;; Features that might be required by this library:
;;
;; `backquote', `bytecomp', `cl', `easymenu', `font-lock',
;; `noutline', `org', `org-compat', `org-faces', `org-footnote',
;; `org-list', `org-macs', `org-src', `outline', `syntax',
;; `time-date', `xml'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; This file tries to implement some functions useful for
;; transformation between org-mode and FreeMind files.
;;
;; Here are the commands you can use:
;;
;;    M-x `org-freemind-from-org-mode'
;;    M-x `org-freemind-from-org-mode-node'
;;    M-x `org-freemind-from-org-sparse-tree'
;;
;;    M-x `org-freemind-to-org-mode'
;;
;;    M-x `org-freemind-show'
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2009-02-15: Added check for next level=current+1
;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'.
;; 2009-10-25: Added support for `org-odd-levels-only'.
;;             Added y/n question before showing in FreeMind.
;; 2009-11-04: Added support for #+BEGIN_HTML.
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:

(require 'xml)
(require 'org)
(require 'rx)
(require 'org-exp)
(eval-when-compile (require 'cl))

;; Fix-me: I am not sure these are useful:
;;
;; (defcustom org-freemind-main-fgcolor "black"
;;   "Color of main node's text."
;;   :type 'color
;;   :group 'freemind)

;; (defcustom org-freemind-main-color "black"
;;   "Background color of main node."
;;   :type 'color
;;   :group 'freemind)

;; (defcustom org-freemind-child-fgcolor "black"
;;   "Color of child nodes' text."
;;   :type 'color
;;   :group 'freemind)

;; (defcustom org-freemind-child-color "black"
;;   "Background color of child nodes."
;;   :type 'color
;;   :group 'freemind)

(defvar org-freemind-node-style nil "Internal use.")

(defcustom org-freemind-node-styles nil
  "Styles to apply to node.
NOT READY YET."
  :type '(repeat
          (list :tag "Node styles for file"
                (regexp :tag "File name")
                (repeat
                 (list :tag "Node"
                       (regexp :tag "Node name regexp")
                       (set :tag "Node properties"
                            (list :format "%v" (const :format "" node-style)
                                  (choice :tag "Style"
                                          :value bubble
                                          (const bubble)
                                          (const fork)))
                            (list :format "%v" (const :format "" color)
                                  (color :tag "Color" :value "red"))
                            (list :format "%v" (const :format "" background-color)
                                  (color :tag "Background color" :value "yellow"))
                            (list :format "%v" (const :format "" edge-color)
                                  (color :tag "Edge color" :value "green"))
                            (list :format "%v" (const :format "" edge-style)
                                  (choice :tag "Edge style" :value bezier
                                          (const :tag "Linear" linear)
                                          (const :tag "Bezier" bezier)
                                          (const :tag "Sharp Linear" sharp-linear)
                                          (const :tag "Sharp Bezier" sharp-bezier)))
                            (list :format "%v" (const :format "" edge-width)
                                  (choice :tag "Edge width" :value thin
                                          (const :tag "Parent" parent)
                                          (const :tag "Thin" thin)
                                          (const 1)
                                          (const 2)
                                          (const 4)
                                          (const 8)))
                            (list :format "%v" (const :format "" italic)
                                  (const :tag "Italic font" t))
                            (list :format "%v" (const :format "" bold)
                                  (const :tag "Bold font" t))
                            (list :format "%v" (const :format "" font-name)
                                  (string :tag "Font name" :value "SansSerif"))
                            (list :format "%v" (const :format "" font-size)
                                  (integer :tag "Font size" :value 12)))))))
  :group 'freemind)

;;;###autoload
(defun org-export-as-freemind (arg &optional hidden ext-plist
				   to-buffer body-only pub-dir)
  (interactive "P")
  (let* ((opt-plist (org-combine-plists (org-default-export-plist)
					ext-plist
					(org-infile-export-plist)))
	 (region-p (org-region-active-p))
	 (rbeg (and region-p (region-beginning)))
	 (rend (and region-p (region-end)))
	 (subtree-p
	  (if (plist-get opt-plist :ignore-subtree-p)
	      nil
	    (when region-p
	      (save-excursion
		(goto-char rbeg)
		(and (org-at-heading-p)
		     (>= (org-end-of-subtree t t) rend))))))
	 (opt-plist (setq org-export-opt-plist
			  (if subtree-p
			      (org-export-add-subtree-options opt-plist rbeg)
			    opt-plist)))
	 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
	 (filename (concat (file-name-as-directory
			    (or pub-dir
				(org-export-directory :ascii opt-plist)))
			   (file-name-sans-extension
			    (or (and subtree-p
				     (org-entry-get (region-beginning)
						    "EXPORT_FILE_NAME" t))
				(file-name-nondirectory bfname)))
			   ".mm")))
    (when (file-exists-p filename)
      (delete-file filename))
    (cond
     (subtree-p
      (org-freemind-from-org-mode-node (line-number-at-pos rbeg)
				       filename))
     (t (org-freemind-from-org-mode bfname filename)))))

;;;###autoload
(defun org-freemind-show (mm-file)
  "Show file MM-FILE in Freemind."
  (interactive
   (list
    (save-match-data
      (let ((name (read-file-name "FreeMind file: "
                                  nil nil nil
                                  (if (buffer-file-name)
                                      (file-name-nondirectory (buffer-file-name))
                                    "")
                                  ;; Fix-me: Is this an Emacs bug?
                                  ;; This predicate function is never
                                  ;; called.
                                  (lambda (fn)
                                    (string-match "^mm$" (file-name-extension fn))))))
        (setq name (expand-file-name name))
        name))))
  (org-open-file mm-file))

(defconst org-freemind-org-nfix "--org-mode: ")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Format converters

(defun org-freemind-escape-str-from-org (org-str)
  "Do some html-escaping of ORG-STR and return the result.
The characters \"&<> will be escaped."
  (let ((chars (append org-str nil))
        (fm-str ""))
    (dolist (cc chars)
      (setq fm-str
            (concat fm-str
                    (if (< cc 256)
                        (cond
                         ((= cc ?\") "&quot;")
                         ((= cc ?\&) "&amp;")
                         ((= cc ?\<) "&lt;")
                         ((= cc ?\>) "&gt;")
                         (t (char-to-string cc)))
                      ;; Formatting as &#number; is maybe needed
                      ;; according to a bug report from kazuo
                      ;; fujimoto, but I have now instead added a xml
                      ;; processing instruction saying that the mm
                      ;; file is utf-8:
                      ;;
                      ;; (format "&#x%x;" (- cc ;; ?\x800))
		      (format "&#x%x;" (encode-char cc 'ucs))
                      ))))
    fm-str))

;;(org-freemind-unescape-str-to-org "&#x6d;A&#x224C;B&lt;C&#x3C;&#x3D;")
;;(org-freemind-unescape-str-to-org "&#x3C;&lt;")
(defun org-freemind-unescape-str-to-org (fm-str)
 "Do some html-unescaping of FM-STR and return the result.
This is the opposite of `org-freemind-escape-str-from-org' but it
will also unescape &#nn;."
 (let ((org-str fm-str))
   (setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
   (setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
   (setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
   (setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
   (setq org-str (replace-regexp-in-string
                  "&#x\\([a-f0-9]\\{2,4\\}\\);"
                  (lambda (m)
                    (char-to-string
                     (+ (string-to-number (match-string 1 m) 16)
                        0 ;?\x800 ;; What is this for? Encoding?
                        )))
                  org-str))))

;; (org-freemind-test-escape)
(defun org-freemind-test-escape ()
Commit	Line	Data
8bfe682a CD	1	;;; org-freemind.el --- Export Org files to freemind
8bfe682a CD	2
114f9c96	3	;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
8bfe682a CD	4
	5	;; Author: Lennart Borgman (lennart O borgman A gmail O com)
	6	;; Keywords: outlines, hypermedia, calendar, wp
	7	;; Homepage: http://orgmode.org
ed21c5c8	8	;; Version: 6.35i
8bfe682a CD	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)
ed21c5c8	84	(require 'rx)
8bfe682a CD	85	(require 'org-exp)
	86	(eval-when-compile (require 'cl))
	87
	88	;; Fix-me: I am not sure these are useful:
	89	;;
	90	;; (defcustom org-freemind-main-fgcolor "black"
	91	;; "Color of main node's text."
	92	;; :type 'color
	93	;; :group 'freemind)
	94
	95	;; (defcustom org-freemind-main-color "black"
	96	;; "Background color of main node."
	97	;; :type 'color
	98	;; :group 'freemind)
	99
	100	;; (defcustom org-freemind-child-fgcolor "black"
	101	;; "Color of child nodes' text."
	102	;; :type 'color
	103	;; :group 'freemind)
	104
	105	;; (defcustom org-freemind-child-color "black"
	106	;; "Background color of child nodes."
	107	;; :type 'color
	108	;; :group 'freemind)
	109
	110	(defvar org-freemind-node-style nil "Internal use.")
	111
	112	(defcustom org-freemind-node-styles nil
	113	"Styles to apply to node.
	114	NOT READY YET."
	115	:type '(repeat
	116	(list :tag "Node styles for file"
	117	(regexp :tag "File name")
	118	(repeat
	119	(list :tag "Node"
	120	(regexp :tag "Node name regexp")
	121	(set :tag "Node properties"
	122	(list :format "%v" (const :format "" node-style)
	123	(choice :tag "Style"
	124	:value bubble
	125	(const bubble)
	126	(const fork)))
	127	(list :format "%v" (const :format "" color)
	128	(color :tag "Color" :value "red"))
	129	(list :format "%v" (const :format "" background-color)
	130	(color :tag "Background color" :value "yellow"))
	131	(list :format "%v" (const :format "" edge-color)
	132	(color :tag "Edge color" :value "green"))
	133	(list :format "%v" (const :format "" edge-style)
	134	(choice :tag "Edge style" :value bezier
	135	(const :tag "Linear" linear)
	136	(const :tag "Bezier" bezier)
	137	(const :tag "Sharp Linear" sharp-linear)
	138	(const :tag "Sharp Bezier" sharp-bezier)))
	139	(list :format "%v" (const :format "" edge-width)
	140	(choice :tag "Edge width" :value thin
	141	(const :tag "Parent" parent)
	142	(const :tag "Thin" thin)
	143	(const 1)
	144	(const 2)
	145	(const 4)
	146	(const 8)))
	147	(list :format "%v" (const :format "" italic)
	148	(const :tag "Italic font" t))
149	(list :format "%v" (const :format "" bold)
150	(const :tag "Bold font" t))
151	(list :format "%v" (const :format "" font-name)
152	(string :tag "Font name" :value "SansSerif"))
153	(list :format "%v" (const :format "" font-size)
154	(integer :tag "Font size" :value 12)))))))
155	:group 'freemind)
156
157	;;;###autoload
158	(defun org-export-as-freemind (arg &optional hidden ext-plist
159	to-buffer body-only pub-dir)
160	(interactive "P")
161	(let* ((opt-plist (org-combine-plists (org-default-export-plist)
162	ext-plist
163	(org-infile-export-plist)))
164	(region-p (org-region-active-p))
165	(rbeg (and region-p (region-beginning)))
166	(rend (and region-p (region-end)))
167	(subtree-p
168	(if (plist-get opt-plist :ignore-subtree-p)
169	nil
170	(when region-p
171	(save-excursion
172	(goto-char rbeg)
173	(and (org-at-heading-p)
174	(>= (org-end-of-subtree t t) rend))))))
175	(opt-plist (setq org-export-opt-plist
176	(if subtree-p
177	(org-export-add-subtree-options opt-plist rbeg)
178	opt-plist)))
179	(bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
180	(filename (concat (file-name-as-directory
181	(or pub-dir
182	(org-export-directory :ascii opt-plist)))
183	(file-name-sans-extension
184	(or (and subtree-p
185	(org-entry-get (region-beginning)
186	"EXPORT_FILE_NAME" t))
187	(file-name-nondirectory bfname)))
188	".mm")))
189	(when (file-exists-p filename)
190	(delete-file filename))
191	(cond
192	(subtree-p
193	(org-freemind-from-org-mode-node (line-number-at-pos rbeg)
194	filename))
195	(t (org-freemind-from-org-mode bfname filename)))))
196
197	;;;###autoload
198	(defun org-freemind-show (mm-file)
199	"Show file MM-FILE in Freemind."
200	(interactive
201	(list
202	(save-match-data
203	(let ((name (read-file-name "FreeMind file: "
204	nil nil nil
205	(if (buffer-file-name)
206	(file-name-nondirectory (buffer-file-name))
207	"")
208	;; Fix-me: Is this an Emacs bug?
209	;; This predicate function is never
210	;; called.
211	(lambda (fn)
212	(string-match "^mm$" (file-name-extension fn))))))
213	(setq name (expand-file-name name))
214	name))))
215	(org-open-file mm-file))
216
217	(defconst org-freemind-org-nfix "--org-mode: ")
218
219	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
220	;;; Format converters
221
222	(defun org-freemind-escape-str-from-org (org-str)
223	"Do some html-escaping of ORG-STR and return the result.
224	The characters \"&<> will be escaped."
225	(let ((chars (append org-str nil))
226	(fm-str ""))
227	(dolist (cc chars)
228	(setq fm-str
229	(concat fm-str
230	(if (< cc 256)
231	(cond
232	((= cc ?\") """)
233	((= cc ?\&) "&")
234	((= cc ?\<) "<")
235	((= cc ?\>) ">")
236	(t (char-to-string cc)))
237	;; Formatting as &#number; is maybe needed
238	;; according to a bug report from kazuo
239	;; fujimoto, but I have now instead added a xml
240	;; processing instruction saying that the mm
241	;; file is utf-8:
242	;;
243	;; (format "&#x%x;" (- cc ;; ?\x800))
ed21c5c8	244	(format "&#x%x;" (encode-char cc 'ucs))
8bfe682a CD	245	))))
	246	fm-str))
	247
	248	;;(org-freemind-unescape-str-to-org "mA≌B<C<=")
	249	;;(org-freemind-unescape-str-to-org "<<")
	250	(defun org-freemind-unescape-str-to-org (fm-str)
	251	"Do some html-unescaping of FM-STR and return the result.
	252	This is the opposite of `org-freemind-escape-str-from-org' but it
	253	will also unescape &#nn;."
	254	(let ((org-str fm-str))
	255	(setq org-str (replace-regexp-in-string """ "\"" org-str))
	256	(setq org-str (replace-regexp-in-string "&" "&" org-str))
	257	(setq org-str (replace-regexp-in-string "<" "<" org-str))
	258	(setq org-str (replace-regexp-in-string ">" ">" org-str))
	259	(setq org-str (replace-regexp-in-string
	260	"&#x\\([a-f0-9]\\{2,4\\}\\);"
	261	(lambda (m)
	262	(char-to-string
	263	(+ (string-to-number (match-string 1 m) 16)
	264	0 ;?\x800 ;; What is this for? Encoding?
	265	)))
	266	org-str))))
	267
	268	;; (org-freemind-test-escape)
	269	(defun org-freemind-test-escape ()
	270