;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine ;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Author: Jambunathan K ;; 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 . ;;; 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 . "\n") (0 . "\n\n") (1 . "\n\n\n") (2 . "\n\n\n") (3 . "\n\n") (4 . "\n")) "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 - \"...\" - 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" (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 - \"...\" - 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) ""))) (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) "")) ;;;; 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 \" \" 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 \" \" 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 => STYLE-2 => CONTENTS => will result in following node: RETURN => ." (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%s\n" type (format "\n\n%s\n\n%s\n" (or css-style "") (format "\n%s\n" 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 ((backend (org-export-create-backend :parent (org-export-backend-name (plist-get info :back-end)) :translations '(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

%s

" title) node-contents) )) (note (concat (org-freemind--richcontent 'node (format "\n

%s\n

" title)) (org-freemind--richcontent 'note node-contents))) (node (concat (org-freemind--richcontent 'node (format "\n

%s\n

" 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 "\n%s\n" (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" 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 "\n" 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 \"\" and \"\" 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