Commit | Line | Data |
---|---|---|
8bfe682a CD |
1 | ;;; org-freemind.el --- Export Org files to freemind |
2 | ||
ab422c4d | 3 | ;; Copyright (C) 2009-2013 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 | |
8bfe682a CD |
8 | ;; |
9 | ;; This file is part of GNU Emacs. | |
10 | ;; | |
11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | ;; -------------------------------------------------------------------- | |
25 | ;; Features that might be required by this library: | |
26 | ;; | |
27 | ;; `backquote', `bytecomp', `cl', `easymenu', `font-lock', | |
28 | ;; `noutline', `org', `org-compat', `org-faces', `org-footnote', | |
29 | ;; `org-list', `org-macs', `org-src', `outline', `syntax', | |
30 | ;; `time-date', `xml'. | |
31 | ;; | |
32 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
33 | ;; | |
34 | ;;; Commentary: | |
35 | ;; | |
36 | ;; This file tries to implement some functions useful for | |
37 | ;; transformation between org-mode and FreeMind files. | |
38 | ;; | |
39 | ;; Here are the commands you can use: | |
40 | ;; | |
41 | ;; M-x `org-freemind-from-org-mode' | |
42 | ;; M-x `org-freemind-from-org-mode-node' | |
43 | ;; M-x `org-freemind-from-org-sparse-tree' | |
44 | ;; | |
45 | ;; M-x `org-freemind-to-org-mode' | |
46 | ;; | |
47 | ;; M-x `org-freemind-show' | |
48 | ;; | |
49 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
50 | ;; | |
51 | ;;; Change log: | |
52 | ;; | |
53 | ;; 2009-02-15: Added check for next level=current+1 | |
54 | ;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'. | |
55 | ;; 2009-10-25: Added support for `org-odd-levels-only'. | |
56 | ;; Added y/n question before showing in FreeMind. | |
57 | ;; 2009-11-04: Added support for #+BEGIN_HTML. | |
58 | ;; | |
8bfe682a CD |
59 | ;;; Code: |
60 | ||
61 | (require 'xml) | |
62 | (require 'org) | |
8223b1d2 | 63 | ;(require 'rx) |
8bfe682a CD |
64 | (require 'org-exp) |
65 | (eval-when-compile (require 'cl)) | |
66 | ||
afe98dfa CD |
67 | (defgroup org-freemind nil |
68 | "Customization group for org-freemind export/import." | |
69 | :group 'org) | |
70 | ||
8bfe682a CD |
71 | ;; Fix-me: I am not sure these are useful: |
72 | ;; | |
73 | ;; (defcustom org-freemind-main-fgcolor "black" | |
74 | ;; "Color of main node's text." | |
75 | ;; :type 'color | |
afe98dfa | 76 | ;; :group 'org-freemind) |
8bfe682a CD |
77 | |
78 | ;; (defcustom org-freemind-main-color "black" | |
79 | ;; "Background color of main node." | |
80 | ;; :type 'color | |
afe98dfa | 81 | ;; :group 'org-freemind) |
8bfe682a CD |
82 | |
83 | ;; (defcustom org-freemind-child-fgcolor "black" | |
84 | ;; "Color of child nodes' text." | |
85 | ;; :type 'color | |
afe98dfa | 86 | ;; :group 'org-freemind) |
8bfe682a CD |
87 | |
88 | ;; (defcustom org-freemind-child-color "black" | |
89 | ;; "Background color of child nodes." | |
90 | ;; :type 'color | |
afe98dfa | 91 | ;; :group 'org-freemind) |
8bfe682a CD |
92 | |
93 | (defvar org-freemind-node-style nil "Internal use.") | |
94 | ||
95 | (defcustom org-freemind-node-styles nil | |
96 | "Styles to apply to node. | |
97 | NOT READY YET." | |
98 | :type '(repeat | |
99 | (list :tag "Node styles for file" | |
100 | (regexp :tag "File name") | |
101 | (repeat | |
102 | (list :tag "Node" | |
103 | (regexp :tag "Node name regexp") | |
104 | (set :tag "Node properties" | |
105 | (list :format "%v" (const :format "" node-style) | |
106 | (choice :tag "Style" | |
107 | :value bubble | |
108 | (const bubble) | |
109 | (const fork))) | |
110 | (list :format "%v" (const :format "" color) | |
111 | (color :tag "Color" :value "red")) | |
112 | (list :format "%v" (const :format "" background-color) | |
113 | (color :tag "Background color" :value "yellow")) | |
114 | (list :format "%v" (const :format "" edge-color) | |
115 | (color :tag "Edge color" :value "green")) | |
116 | (list :format "%v" (const :format "" edge-style) | |
117 | (choice :tag "Edge style" :value bezier | |
118 | (const :tag "Linear" linear) | |
119 | (const :tag "Bezier" bezier) | |
120 | (const :tag "Sharp Linear" sharp-linear) | |
121 | (const :tag "Sharp Bezier" sharp-bezier))) | |
122 | (list :format "%v" (const :format "" edge-width) | |
123 | (choice :tag "Edge width" :value thin | |
124 | (const :tag "Parent" parent) | |
125 | (const :tag "Thin" thin) | |
126 | (const 1) | |
127 | (const 2) | |
128 | (const 4) | |
129 | (const 8))) | |
130 | (list :format "%v" (const :format "" italic) | |
131 | (const :tag "Italic font" t)) | |
132 | (list :format "%v" (const :format "" bold) | |
133 | (const :tag "Bold font" t)) | |
134 | (list :format "%v" (const :format "" font-name) | |
135 | (string :tag "Font name" :value "SansSerif")) | |
136 | (list :format "%v" (const :format "" font-size) | |
137 | (integer :tag "Font size" :value 12))))))) | |
afe98dfa | 138 | :group 'org-freemind) |
8bfe682a CD |
139 | |
140 | ;;;###autoload | |
afe98dfa | 141 | (defun org-export-as-freemind (&optional hidden ext-plist |
8223b1d2 | 142 | to-buffer body-only pub-dir) |
afe98dfa CD |
143 | "Export the current buffer as a Freemind file. |
144 | If there is an active region, export only the region. HIDDEN is | |
145 | obsolete and does nothing. EXT-PLIST is a property list with | |
146 | external parameters overriding org-mode's default settings, but | |
147 | still inferior to file-local settings. When TO-BUFFER is | |
148 | non-nil, create a buffer with that name and export to that | |
149 | buffer. If TO-BUFFER is the symbol `string', don't leave any | |
150 | buffer behind but just return the resulting HTML as a string. | |
151 | When BODY-ONLY is set, don't produce the file header and footer, | |
152 | simply return the content of the document (all top level | |
153 | sections). When PUB-DIR is set, use this as the publishing | |
154 | directory. | |
155 | ||
156 | See `org-freemind-from-org-mode' for more information." | |
8bfe682a CD |
157 | (interactive "P") |
158 | (let* ((opt-plist (org-combine-plists (org-default-export-plist) | |
159 | ext-plist | |
160 | (org-infile-export-plist))) | |
161 | (region-p (org-region-active-p)) | |
162 | (rbeg (and region-p (region-beginning))) | |
163 | (rend (and region-p (region-end))) | |
164 | (subtree-p | |
165 | (if (plist-get opt-plist :ignore-subtree-p) | |
166 | nil | |
167 | (when region-p | |
168 | (save-excursion | |
169 | (goto-char rbeg) | |
170 | (and (org-at-heading-p) | |
171 | (>= (org-end-of-subtree t t) rend)))))) | |
172 | (opt-plist (setq org-export-opt-plist | |
173 | (if subtree-p | |
174 | (org-export-add-subtree-options opt-plist rbeg) | |
175 | opt-plist))) | |
176 | (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) | |
177 | (filename (concat (file-name-as-directory | |
178 | (or pub-dir | |
179 | (org-export-directory :ascii opt-plist))) | |
180 | (file-name-sans-extension | |
181 | (or (and subtree-p | |
182 | (org-entry-get (region-beginning) | |
183 | "EXPORT_FILE_NAME" t)) | |
184 | (file-name-nondirectory bfname))) | |
185 | ".mm"))) | |
186 | (when (file-exists-p filename) | |
187 | (delete-file filename)) | |
188 | (cond | |
189 | (subtree-p | |
190 | (org-freemind-from-org-mode-node (line-number-at-pos rbeg) | |
191 | filename)) | |
192 | (t (org-freemind-from-org-mode bfname filename))))) | |
193 | ||
194 | ;;;###autoload | |
195 | (defun org-freemind-show (mm-file) | |
196 | "Show file MM-FILE in Freemind." | |
197 | (interactive | |
198 | (list | |
199 | (save-match-data | |
200 | (let ((name (read-file-name "FreeMind file: " | |
201 | nil nil nil | |
202 | (if (buffer-file-name) | |
afe98dfa CD |
203 | (let* ((name-ext (file-name-nondirectory (buffer-file-name))) |
204 | (name (file-name-sans-extension name-ext)) | |
205 | (ext (file-name-extension name-ext))) | |
206 | (cond | |
207 | ((string= "mm" ext) | |
208 | name-ext) | |
209 | ((string= "org" ext) | |
210 | (let ((name-mm (concat name ".mm"))) | |
211 | (if (file-exists-p name-mm) | |
212 | name-mm | |
213 | (message "Not exported to Freemind format yet") | |
214 | ""))) | |
215 | (t | |
216 | ""))) | |
8bfe682a CD |
217 | "") |
218 | ;; Fix-me: Is this an Emacs bug? | |
219 | ;; This predicate function is never | |
220 | ;; called. | |
221 | (lambda (fn) | |
222 | (string-match "^mm$" (file-name-extension fn)))))) | |
223 | (setq name (expand-file-name name)) | |
224 | name)))) | |
225 | (org-open-file mm-file)) | |
226 | ||
227 | (defconst org-freemind-org-nfix "--org-mode: ") | |
228 | ||
229 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
230 | ;;; Format converters | |
231 | ||
232 | (defun org-freemind-escape-str-from-org (org-str) | |
233 | "Do some html-escaping of ORG-STR and return the result. | |
234 | The characters \"&<> will be escaped." | |
235 | (let ((chars (append org-str nil)) | |
236 | (fm-str "")) | |
237 | (dolist (cc chars) | |
238 | (setq fm-str | |
239 | (concat fm-str | |
afe98dfa | 240 | (if (< cc 160) |
8bfe682a CD |
241 | (cond |
242 | ((= cc ?\") """) | |
243 | ((= cc ?\&) "&") | |
244 | ((= cc ?\<) "<") | |
245 | ((= cc ?\>) ">") | |
246 | (t (char-to-string cc))) | |
247 | ;; Formatting as &#number; is maybe needed | |
248 | ;; according to a bug report from kazuo | |
249 | ;; fujimoto, but I have now instead added a xml | |
250 | ;; processing instruction saying that the mm | |
251 | ;; file is utf-8: | |
252 | ;; | |
253 | ;; (format "&#x%x;" (- cc ;; ?\x800)) | |
ed21c5c8 | 254 | (format "&#x%x;" (encode-char cc 'ucs)) |
8bfe682a CD |
255 | )))) |
256 | fm-str)) | |
257 | ||
258 | ;;(org-freemind-unescape-str-to-org "mA≌B<C<=") | |
259 | ;;(org-freemind-unescape-str-to-org "<<") | |
260 | (defun org-freemind-unescape-str-to-org (fm-str) | |
8223b1d2 | 261 | "Do some html-unescaping of FM-STR and return the result. |
8bfe682a CD |
262 | This is the opposite of `org-freemind-escape-str-from-org' but it |
263 | will also unescape &#nn;." | |
8223b1d2 BG |
264 | (let ((org-str fm-str)) |
265 | (setq org-str (replace-regexp-in-string """ "\"" org-str)) | |
266 | (setq org-str (replace-regexp-in-string "&" "&" org-str)) | |
267 | (setq org-str (replace-regexp-in-string "<" "<" org-str)) | |
268 | (setq org-str (replace-regexp-in-string ">" ">" org-str)) | |
269 | (setq org-str (replace-regexp-in-string | |
270 | "&#x\\([a-f0-9]\\{2,4\\}\\);" | |
271 | (lambda (m) | |
272 | (char-to-string | |
273 | (+ (string-to-number (match-string 1 m) 16) | |
274 | 0 ;?\x800 ;; What is this for? Encoding? | |
275 | ))) | |
276 | org-str)))) | |
8bfe682a | 277 | |
afe98dfa CD |
278 |