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