529 lines
19 KiB
EmacsLisp
529 lines
19 KiB
EmacsLisp
;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine
|
||
|
||
;; Copyright (C) 2013 Free Software Foundation, Inc.
|
||
|
||
;; Author: Jambunathan K <kjambunathan at gmail dot com>
|
||
;; Keywords: outlines, hypermedia, calendar, wp
|
||
|
||
;; This file is not part of GNU Emacs.
|
||
|
||
;; 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 3 of the License, 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This library implements a Freemind Mindmap back-end for Org generic
|
||
;; exporter.
|
||
|
||
;; To test it, run:
|
||
;;
|
||
;; M-x org-freemind-export-to-freemind
|
||
;;
|
||
;; in an Org mode buffer. See ox.el for more details on how this
|
||
;; exporter works.
|
||
|
||
;;; Code:
|
||
|
||
;;; Dependencies
|
||
|
||
(require 'ox-html)
|
||
|
||
|
||
|
||
;;; Define Back-End
|
||
|
||
(org-export-define-derived-backend 'freemind 'html
|
||
:export-block "FREEMIND"
|
||
:menu-entry
|
||
'(?f "Export to Freemind Mindmap"
|
||
((?f "As Freemind Mindmap file" org-freemind-export-to-freemind)
|
||
(?o "As Freemind Mindmap file and open"
|
||
(lambda (a s v b)
|
||
(if a (org-freemind-export-to-freemind t s v b)
|
||
(org-open-file (org-freemind-export-to-freemind nil s v b)))))))
|
||
:translate-alist '((headline . org-freemind-headline)
|
||
(template . org-freemind-template)
|
||
(inner-template . org-freemind-inner-template)
|
||
(section . org-freemind-section)
|
||
(entity . org-freemind-entity))
|
||
:filters-alist '((:filter-options . org-freemind-options-function)
|
||
(:filter-final-output . org-freemind-final-function)))
|
||
|
||
|
||
|
||
;;; User Configuration Variables
|
||
|
||
(defgroup org-export-freemind nil
|
||
"Options for exporting Org mode files to Freemind Mindmap."
|
||
:tag "Org Export Freemind Mindmap"
|
||
:group 'org-export)
|
||
|
||
(defcustom org-freemind-styles
|
||
'((default . "<node>\n</node>")
|
||
(0 . "<node COLOR=\"#000000\">\n<font NAME=\"SansSerif\" SIZE=\"20\"/>\n</node>")
|
||
(1 . "<node COLOR=\"#0033ff\">\n<edge STYLE=\"sharp_bezier\" WIDTH=\"8\"/>\n<font NAME=\"SansSerif\" SIZE=\"18\"/>\n</node>")
|
||
(2 . "<node COLOR=\"#00b439\">\n<edge STYLE=\"bezier\" WIDTH=\"thin\"/>\n<font NAME=\"SansSerif\" SIZE=\"16\"/>\n</node>")
|
||
(3 . "<node COLOR=\"#990000\" FOLDED=\"true\">\n<font NAME=\"SansSerif\" SIZE=\"14\"/>\n</node>")
|
||
(4 . "<node COLOR=\"#111111\">\n</node>"))
|
||
"List of Freemind node styles.
|
||
Each entry is of the form (STYLE-NAME . STYLE-SPEC). STYLE-NAME
|
||
can be one of an integer (signifying an outline level), a string
|
||
or the symbol `default'. STYLE-SPEC, a string, is a Freemind
|
||
node style."
|
||
:type '(alist :options (default 0 1 2 3)
|
||
:key-type (choice :tag "Style tag"
|
||
(integer :tag "Outline level")
|
||
(const :tag "Default value" default)
|
||
(string :tag "Node style"))
|
||
:value-type (string :tag "Style spec"))
|
||
:group 'org-export-freemind)
|
||
|
||
(defcustom org-freemind-style-map-function 'org-freemind-style-map--automatic
|
||
"Function to map an Org element to it's node style.
|
||
The mapping function takes two arguments an Org ELEMENT and INFO.
|
||
ELEMENT can be one of the following types - `org-data',
|
||
`headline' or `section'. INFO is a plist holding contextual
|
||
information during export. The function must return a STYLE-SPEC
|
||
to be applied to ELEMENT.
|
||
|
||
See `org-freemind-style-map--automatic' for a sample style
|
||
function. See `org-freemind-styles' for a list of named styles."
|
||
:type '(radio
|
||
(function-item org-freemind-style-map--automatic)
|
||
(function-item org-freemind-style-map--default)
|
||
function)
|
||
:group 'org-export-freemind)
|
||
|
||
(defcustom org-freemind-section-format 'note
|
||
"Specify how outline sections are to be formatted.
|
||
If `inline', append it to the contents of it's heading node. If
|
||
`note', attach it as a note to it's heading node. If `node',
|
||
attach it as a separate node to it's heading node.
|
||
|
||
Use `note', if the input Org file contains large sections. Use
|
||
`node', if the Org file contains mid-sized sections that need to
|
||
stand apart. Otherwise, use `inline'."
|
||
:type '(choice
|
||
(const :tag "Append to outline title" inline)
|
||
(const :tag "Attach as a note" note)
|
||
(const :tag "Create a separate node" node))
|
||
:group 'org-export-freemind)
|
||
|
||
;;;; Debugging
|
||
|
||
(defcustom org-freemind-pretty-output nil
|
||
"Enable this to generate pretty Freemind Mindmap."
|
||
:type 'boolean
|
||
:group 'org-export-freemind)
|
||
|
||
|
||
;;; Internal Functions
|
||
|
||
;;;; XML Manipulation
|
||
|
||
(defun org-freemind--serialize (parsed-xml &optional contents)
|
||
"Convert PARSED-XML in to XML string.
|
||
PARSED-XML is a parse tree as returned by
|
||
`libxml-parse-xml-region'. CONTENTS is an optional string.
|
||
|
||
Ignore CONTENTS, if PARSED-XML is not a sole XML element.
|
||
Otherwise, append CONTENTS to the contents of top-level element
|
||
in PARSED-XML.
|
||
|
||
This is an inverse function of `libxml-parse-xml-region'.
|
||
|
||
For purposes of Freemind export, PARSED-XML is a node style
|
||
specification - \"<node ...>...</node>\" - as a parse tree."
|
||
(when contents
|
||
(assert (symbolp (car parsed-xml))))
|
||
(cond
|
||
((null parsed-xml) "")
|
||
((stringp parsed-xml) parsed-xml)
|
||
((symbolp (car parsed-xml))
|
||
(let ((attributes (mapconcat
|
||
(lambda (av)
|
||
(format "%s=\"%s\"" (car av) (cdr av)))
|
||
(cadr parsed-xml) " ")))
|
||
(if (or (cddr parsed-xml) contents)
|
||
(format "\n<%s%s>%s\n</%s>"
|
||
(car parsed-xml)
|
||
(if (string= attributes "") "" (concat " " attributes))
|
||
(concat (org-freemind--serialize (cddr parsed-xml))
|
||
contents )
|
||
(car parsed-xml))
|
||
(format "\n<%s%s/>"
|
||
(car parsed-xml)
|
||
(if (string= attributes "") "" (concat " " attributes))))))
|
||
(t (mapconcat #'org-freemind--serialize parsed-xml ""))))
|
||
|
||
(defun org-freemind--parse-xml (xml-string)
|
||
"Return parse tree for XML-STRING using `libxml-parse-xml-region'.
|
||
For purposes of Freemind export, XML-STRING is a node style
|
||
specification - \"<node ...>...</node>\" - as a string."
|
||
(with-temp-buffer
|
||
(insert (or xml-string ""))
|
||
(libxml-parse-xml-region (point-min) (point-max))))
|
||
|
||
|
||
;;;; Style mappers :: Default and Automatic layout
|
||
|
||
(defun org-freemind-style-map--automatic (element info)
|
||
"Return a node style corresponding to relative outline level of ELEMENT.
|
||
ELEMENT can be any of the following types - `org-data',
|
||
`headline' or `section'. See `org-freemind-styles' for style
|
||
mappings of different outline levels."
|
||
(let ((style-name
|
||
(case (org-element-type element)
|
||
(headline
|
||
(org-export-get-relative-level element info))
|
||
(section
|
||
(let ((parent (org-export-get-parent-headline element)))
|
||
(if (not parent) 1
|
||
(1+ (org-export-get-relative-level parent info)))))
|
||
(t 0))))
|
||
(or (assoc-default style-name org-freemind-styles)
|
||
(assoc-default 'default org-freemind-styles)
|
||
"<node></node>")))
|
||
|
||
(defun org-freemind-style-map--default (element info)
|
||
"Return the default style for all ELEMENTs.
|
||
ELEMENT can be any of the following types - `org-data',
|
||
`headline' or `section'. See `org-freemind-styles' for current
|
||
value of default style."
|
||
(or (assoc-default 'default org-freemind-styles)
|
||
"<node></node>"))
|
||
|
||
|
||
;;;; Helpers :: Retrieve, apply Freemind styles
|
||
|
||
(defun org-freemind--get-node-style (element info)
|
||
"Return Freemind node style applicable for HEADLINE.
|
||
ELEMENT is an Org element of type `org-data', `headline' or
|
||
`section'. INFO is a plist holding contextual information."
|
||
(unless (fboundp org-freemind-style-map-function)
|
||
(setq org-freemind-style-map-function 'org-freemind-style-map--default))
|
||
(let ((style (funcall org-freemind-style-map-function element info)))
|
||
;; Sanitize node style.
|
||
|
||
;; Loop through the attributes of node element and purge those
|
||
;; attributes that look suspicious. This is an extra bit of work
|
||
;; that allows one to copy verbatim node styles from an existing
|
||
;; Freemind Mindmap file without messing with the exported data.
|
||
(let* ((data (org-freemind--parse-xml style))
|
||
(attributes (cadr data))
|
||
(ignored-attrs '(POSITION FOLDED TEXT CREATED ID
|
||
MODIFIED)))
|
||
(let (attr)
|
||
(while (setq attr (pop ignored-attrs))
|
||
(setq attributes (assq-delete-all attr attributes))))
|
||
(when data (setcar (cdr data) attributes))
|
||
(org-freemind--serialize data))))
|
||
|
||
(defun org-freemind--build-stylized-node (style-1 style-2 &optional contents)
|
||
"Build a Freemind node with style STYLE-1 + STYLE-2 and add CONTENTS to it.
|
||
STYLE-1 and STYLE-2 are Freemind node styles as a string.
|
||
STYLE-1 is the base node style and STYLE-2 is the overriding
|
||
style that takes precedence over STYLE-1. CONTENTS is a string.
|
||
|
||
Return value is a Freemind node with following properties:
|
||
|
||
1. The attributes of \"<node ...> </node>\" element is the union
|
||
of corresponding attributes of STYLE-1 and STYLE-2. When
|
||
STYLE-1 and STYLE-2 specify values for the same attribute
|
||
name, choose the attribute value from STYLE-2.
|
||
|
||
2. The children of \"<node ...> </node>\" element is the union of
|
||
top-level children of STYLE-1 and STYLE-2 with CONTENTS
|
||
appended to it. When STYLE-1 and STYLE-2 share a child
|
||
element of same type, the value chosen is that from STYLE-2.
|
||
|
||
For example, merging with following parameters
|
||
|
||
STYLE-1 =>
|
||
<node COLOR=\"#00b439\" STYLE=\"Bubble\">
|
||
<edge STYLE=\"bezier\" WIDTH=\"thin\"/>
|
||
<font NAME=\"SansSerif\" SIZE=\"16\"/>
|
||
</node>
|
||
|
||
STYLE-2 =>
|
||
<node COLOR=\"#990000\" FOLDED=\"true\">
|
||
<font NAME=\"SansSerif\" SIZE=\"14\"/>
|
||
</node>
|
||
|
||
CONTENTS =>
|
||
<attribute NAME=\"ORGTAG\" VALUE=\"@home\"/>
|
||
|
||
will result in following node:
|
||
|
||
RETURN =>
|
||
<node STYLE=\"Bubble\" COLOR=\"#990000\" FOLDED=\"true\">
|
||
<edge STYLE=\"bezier\" WIDTH=\"thin\"/>
|
||
<font NAME=\"SansSerif\" SIZE=\"14\"/>
|
||
<attribute NAME=\"ORGTAG\" VALUE=\"@home\"/>
|
||
</node>."
|
||
(let* ((data1 (org-freemind--parse-xml (or style-1 "")))
|
||
(data2 (org-freemind--parse-xml (or style-2 "")))
|
||
(attr1 (cadr data1))
|
||
(attr2 (cadr data2))
|
||
(merged-attr attr2)
|
||
(children1 (cddr data1))
|
||
(children2 (cddr data2))
|
||
(merged-children children2))
|
||
(let (attr)
|
||
(while (setq attr (pop attr1))
|
||
(unless (assq (car attr) merged-attr)
|
||
(push attr merged-attr))))
|
||
(let (child)
|
||
(while (setq child (pop children1))
|
||
(when (or (stringp child) (not (assq (car child) merged-children)))
|
||
(push child merged-children))))
|
||
(let ((merged-data (nconc (list 'node merged-attr) merged-children)))
|
||
(org-freemind--serialize merged-data contents))))
|
||
|
||
|
||
;;;; Helpers :: Node contents
|
||
|
||
(defun org-freemind--richcontent (type contents &optional css-style)
|
||
(let* ((type (case type
|
||
(note "NOTE")
|
||
(node "NODE")
|
||
(t "NODE")))
|
||
(contents (org-trim contents)))
|
||
(if (string= (org-trim contents) "") ""
|
||
(format "\n<richcontent TYPE=\"%s\">%s\n</richcontent>"
|
||
type
|
||
(format "\n<html>\n<head>%s\n</head>\n%s\n</html>"
|
||
(or css-style "")
|
||
(format "<body>\n%s\n</body>" contents))))))
|
||
|
||
(defun org-freemind--build-node-contents (element contents info)
|
||
(let* ((title (case (org-element-type element)
|
||
(headline
|
||
(org-element-property :title element))
|
||
(org-data
|
||
(plist-get info :title))
|
||
(t (error "Shouldn't come here."))))
|
||
(element-contents (org-element-contents element))
|
||
(section (assq 'section element-contents))
|
||
(section-contents
|
||
(let ((backend (org-export-create-backend
|
||
:parent (org-export-backend-name
|
||
(plist-get info :back-end))
|
||
:transcoders '((section . (lambda (e c i) c))))))
|
||
(org-export-data-with-backend section backend info)))
|
||
(itemized-contents-p (let ((first-child-headline
|
||
(org-element-map element-contents
|
||
'headline 'identity info t)))
|
||
(when first-child-headline
|
||
(org-export-low-level-p first-child-headline
|
||
info))))
|
||
(node-contents (concat section-contents
|
||
(when itemized-contents-p
|
||
contents))))
|
||
(concat (let ((title (org-export-data title info)))
|
||
(case org-freemind-section-format
|
||
(inline
|
||
(org-freemind--richcontent
|
||
'node (concat (format "\n<h2>%s</h2>" title)
|
||
node-contents) ))
|
||
(note
|
||
(concat (org-freemind--richcontent
|
||
'node (format "\n<p>%s\n</p>" title))
|
||
(org-freemind--richcontent
|
||
'note node-contents)))
|
||
(node
|
||
(concat
|
||
(org-freemind--richcontent
|
||
'node (format "\n<p>%s\n</p>" title))
|
||
(when section
|
||
(org-freemind--build-stylized-node
|
||
(org-freemind--get-node-style section info) nil
|
||
(org-freemind--richcontent 'node node-contents)))))))
|
||
(unless itemized-contents-p
|
||
contents))))
|
||
|
||
|
||
|
||
;;; Template
|
||
|
||
(defun org-freemind-template (contents info)
|
||
"Return complete document string after Freemind Mindmap conversion.
|
||
CONTENTS is the transcoded contents string. RAW-DATA is the
|
||
original parsed data. INFO is a plist holding export options."
|
||
(format
|
||
"<map version=\"0.9.0\">\n%s\n</map>"
|
||
(org-freemind--build-stylized-node
|
||
(org-freemind--get-node-style nil info) nil
|
||
(let ((org-data (plist-get info :parse-tree)))
|
||
(org-freemind--build-node-contents org-data contents info)))))
|
||
|
||
(defun org-freemind-inner-template (contents info)
|
||
"Return body of document string after Freemind Mindmap conversion.
|
||
CONTENTS is the transcoded contents string. INFO is a plist
|
||
holding export options."
|
||
contents)
|
||
|
||
;;;; Tags
|
||
|
||
(defun org-freemind--tags (tags)
|
||
(mapconcat (lambda (tag)
|
||
(format "\n<attribute NAME=\"%s\" VALUE=\"%s\"/>" tag ""))
|
||
tags "\n"))
|
||
|
||
|
||
|
||
;;; Transcode Functions
|
||
|
||
;;;; Entity
|
||
|
||
(defun org-freemind-entity (entity contents info)
|
||
"Transcode an ENTITY object from Org to Freemind Mindmap.
|
||
CONTENTS are the definition itself. INFO is a plist holding
|
||
contextual information."
|
||
(org-element-property :utf-8 entity))
|
||
|
||
;;;; Headline
|
||
|
||
(defun org-freemind-headline (headline contents info)
|
||
"Transcode a HEADLINE element from Org to Freemind Mindmap.
|
||
CONTENTS holds the contents of the headline. INFO is a plist
|
||
holding contextual information."
|
||
;; Empty contents?
|
||
(setq contents (or contents ""))
|
||
(let* ((numberedp (org-export-numbered-headline-p headline info))
|
||
(level (org-export-get-relative-level headline info))
|
||
(text (org-export-data (org-element-property :title headline) info))
|
||
(todo (and (plist-get info :with-todo-keywords)
|
||
(let ((todo (org-element-property :todo-keyword headline)))
|
||
(and todo (org-export-data todo info)))))
|
||
(todo-type (and todo (org-element-property :todo-type headline)))
|
||
(tags (and (plist-get info :with-tags)
|
||
(org-export-get-tags headline info)))
|
||
(priority (and (plist-get info :with-priority)
|
||
(org-element-property :priority headline)))
|
||
(section-number (and (not (org-export-low-level-p headline info))
|
||
(org-export-numbered-headline-p headline info)
|
||
(mapconcat 'number-to-string
|
||
(org-export-get-headline-number
|
||
headline info) ".")))
|
||
;; Create the headline text.
|
||
(full-text (org-export-data (org-element-property :title headline)
|
||
info))
|
||
;; Headline order (i.e, first digit of the section number)
|
||
(headline-order (car (org-export-get-headline-number headline info))))
|
||
(cond
|
||
;; Case 1: This is a footnote section: ignore it.
|
||
((org-element-property :footnote-section-p headline) nil)
|
||
;; Case 2. This is a deep sub-tree, export it as a list item.
|
||
;; Delegate the actual export to `html' backend.
|
||
((org-export-low-level-p headline info)
|
||
(org-html-headline headline contents info))
|
||
;; Case 3. Standard headline. Export it as a section.
|
||
(t
|
||
(let* ((section-number (mapconcat 'number-to-string
|
||
(org-export-get-headline-number
|
||
headline info) "-"))
|
||
(ids (remove 'nil
|
||
(list (org-element-property :CUSTOM_ID headline)
|
||
(concat "sec-" section-number)
|
||
(org-element-property :ID headline))))
|
||
(preferred-id (car ids))
|
||
(extra-ids (cdr ids))
|
||
(left-p (zerop (% headline-order 2))))
|
||
(org-freemind--build-stylized-node
|
||
(org-freemind--get-node-style headline info)
|
||
(format "<node ID=\"%s\" POSITION=\"%s\" FOLDED=\"%s\">\n</node>"
|
||
preferred-id
|
||
(if left-p "left" "right")
|
||
(if (= level 1) "true" "false"))
|
||
(concat (org-freemind--build-node-contents headline contents info)
|
||
(org-freemind--tags tags))))))))
|
||
|
||
|
||
;;;; Section
|
||
|
||
(defun org-freemind-section (section contents info)
|
||
"Transcode a SECTION element from Org to Freemind Mindmap.
|
||
CONTENTS holds the contents of the section. INFO is a plist
|
||
holding contextual information."
|
||
(let ((parent (org-export-get-parent-headline section)))
|
||
(when (and parent (org-export-low-level-p parent info))
|
||
contents)))
|
||
|
||
|
||
|
||
;;; Filter Functions
|
||
|
||
(defun org-freemind-final-function (contents backend info)
|
||
"Return CONTENTS as pretty XML using `indent-region'."
|
||
(if (not org-freemind-pretty-output) contents
|
||
(with-temp-buffer
|
||
(nxml-mode)
|
||
(insert contents)
|
||
(indent-region (point-min) (point-max))
|
||
(buffer-substring-no-properties (point-min) (point-max)))))
|
||
|
||
(defun org-freemind-options-function (info backend)
|
||
"Install script in export options when appropriate.
|
||
EXP-PLIST is a plist containing export options. BACKEND is the
|
||
export back-end currently used."
|
||
;; Freemind/Freeplane doesn't seem to like named html entities in
|
||
;; richcontent. For now, turn off smart quote processing so that
|
||
;; entities like "’" & friends are avoided in the exported
|
||
;; output.
|
||
(plist-put info :with-smart-quotes nil))
|
||
|
||
|
||
|
||
;;; End-user functions
|
||
|
||
;;;###autoload
|
||
(defun org-freemind-export-to-freemind
|
||
(&optional async subtreep visible-only body-only ext-plist)
|
||
"Export current buffer to a Freemind Mindmap file.
|
||
|
||
If narrowing is active in the current buffer, only export its
|
||
narrowed part.
|
||
|
||
If a region is active, export that region.
|
||
|
||
A non-nil optional argument ASYNC means the process should happen
|
||
asynchronously. The resulting file should be accessible through
|
||
the `org-export-stack' interface.
|
||
|
||
When optional argument SUBTREEP is non-nil, export the sub-tree
|
||
at point, extracting information from the headline properties
|
||
first.
|
||
|
||
When optional argument VISIBLE-ONLY is non-nil, don't export
|
||
contents of hidden elements.
|
||
|
||
When optional argument BODY-ONLY is non-nil, only write code
|
||
between \"<body>\" and \"</body>\" tags.
|
||
|
||
EXT-PLIST, when provided, is a property list with external
|
||
parameters overriding Org default settings, but still inferior to
|
||
file-local settings.
|
||
|
||
Return output file's name."
|
||
(interactive)
|
||
(let* ((extension (concat ".mm" ))
|
||
(file (org-export-output-file-name extension subtreep))
|
||
(org-export-coding-system 'utf-8))
|
||
(org-export-to-file 'freemind file
|
||
async subtreep visible-only body-only ext-plist)))
|
||
|
||
(provide 'ox-freemind)
|
||
|
||
;;; ox-freemind.el ends here
|