org-mode-mirror/contrib/lisp/ox-freemind.el

;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine

;; Copyright (C) 2013-2021  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 <https://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
  :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 "&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))
	 (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