Commit | Line | Data |
---|---|---|
8bfe682a CD |
1 | ;;; org-freemind.el --- Export Org files to freemind |
2 | ||
73b0cd50 | 3 | ;; Copyright (C) 2009-2011 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 | |
acedf35c | 8 | ;; Version: 7.4 |
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) | |
afe98dfa | 84 | ;(require 'rx) |
8bfe682a CD |
85 | (require 'org-exp) |
86 | (eval-when-compile (require 'cl)) | |
87 | ||
afe98dfa CD |
88 | (defgroup org-freemind nil |
89 | "Customization group for org-freemind export/import." | |
90 | :group 'org) | |
91 | ||
8bfe682a CD |
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 | |
afe98dfa | 97 | ;; :group 'org-freemind) |
8bfe682a CD |
98 | |
99 | ;; (defcustom org-freemind-main-color "black" | |
100 | ;; "Background color of main node." | |
101 | ;; :type 'color | |
afe98dfa | 102 | ;; :group 'org-freemind) |
8bfe682a CD |
103 | |
104 | ;; (defcustom org-freemind-child-fgcolor "black" | |
105 | ;; "Color of child nodes' text." | |
106 | ;; :type 'color | |
afe98dfa | 107 | ;; :group 'org-freemind) |
8bfe682a CD |
108 | |
109 | ;; (defcustom org-freemind-child-color "black" | |
110 | ;; "Background color of child nodes." | |
111 | ;; :type 'color | |
afe98dfa | 112 | ;; :group 'org-freemind) |
8bfe682a CD |
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))))))) | |
afe98dfa | 159 | :group 'org-freemind) |
8bfe682a CD |
160 | |
161 | ;;;###autoload | |
afe98dfa | 162 | (defun org-export-as-freemind (&optional hidden ext-plist |
8bfe682a | 163 | to-buffer body-only pub-dir) |
afe98dfa CD |
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." | |
8bfe682a CD |
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) | |
afe98dfa CD |
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 | ""))) | |
8bfe682a CD |
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 | |
afe98dfa | 261 | (if (< cc 160) |
8bfe682a CD |
262 | (cond |
263 | ((= cc ?\") """) | |
264 | ((= cc ?\&) "&") | |
265 | ((= cc ?\<) "<") | |
266 | ((= cc ?\>) ">") | |
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)) | |
ed21c5c8 | 275 | (format "&#x%x;" (encode-char cc 'ucs)) |
8bfe682a CD |
276 | )))) |
277 | fm-str)) | |
278 | ||
279 | ;;(org-freemind-unescape-str-to-org "mA≌B<C<=") | |
280 | ;;(org-freemind-unescape-str-to-org "<<") | |
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 """ "\"" org-str)) | |
287 | (setq org-str (replace-regexp-in-string "&" "&" org-str)) | |
288 | (setq org-str (replace-regexp-in-string "<" "<" org-str)) | |
289 | (setq org-str (replace-regexp-in-string ">" ">" 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 | ||
afe98dfa CD |
299 |