summaryrefslogtreecommitdiff
path: root/contrib/lisp/ox-freemind.el
diff options
context:
space:
mode:
authorSébastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:27 +0200
committerSébastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:27 +0200
commite32a45ed36d6000db4b39171149072d11b77af72 (patch)
treeb5f4a7d43022c08c3298e82b3e9fc50f68be660f /contrib/lisp/ox-freemind.el
parent7697fa4daf3ec84f85711a84035d8f0224afd4e3 (diff)
Imported Upstream version 8.0.7
Diffstat (limited to 'contrib/lisp/ox-freemind.el')
-rw-r--r--contrib/lisp/ox-freemind.el536
1 files changed, 536 insertions, 0 deletions
diff --git a/contrib/lisp/ox-freemind.el b/contrib/lisp/ox-freemind.el
new file mode 100644
index 0000000..4e90eff
--- /dev/null
+++ b/contrib/lisp/ox-freemind.el
@@ -0,0 +1,536 @@
+;;; 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 (assoc 'section element-contents))
+ (section-contents
+ (let* ((translations
+ (nconc (list (cons 'section
+ (lambda (section contents info)
+ contents)))
+ (plist-get info :translate-alist))))
+ (org-export-data-with-translations section translations 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 "&rsquo;" & 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)))
+ (if async
+ (org-export-async-start
+ (lambda (f) (org-export-add-to-stack f 'freemind))
+ (let ((org-export-coding-system 'utf-8))
+ `(expand-file-name
+ (org-export-to-file
+ 'freemind ,file ,subtreep ,visible-only ,body-only ',ext-plist))))
+ (let ((org-export-coding-system 'utf-8))
+ (org-export-to-file
+ 'freemind file subtreep visible-only body-only ext-plist)))))
+
+(provide 'ox-freemind)
+
+;;; ox-freemind.el ends here