122 lines
5.0 KiB
EmacsLisp
122 lines
5.0 KiB
EmacsLisp
;;; conlanging-graphviz.el --- Graphviz utilities for conlanging -*- lexical-binding: t -*-
|
|
|
|
;; Author: Lucien Cartier-Tilet <lucien@phundrak.com>
|
|
;; Maintainer: Lucien Cartier-Tilet <lucien@phundrak.com>
|
|
;; Version: 0.1.0
|
|
;; Package-Requires: ((emacs "26.1"))
|
|
;; Homepage: https://labs.phundrak.com/phundrak/conlanging.el
|
|
;; Keywords: convenience
|
|
|
|
|
|
;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
|
|
;;; Code:
|
|
(require 'ox)
|
|
|
|
(defun conlanging-graphviz--node-link (node parent)
|
|
"Create a graphviz node between NODE and PARENT.
|
|
Both NODE and PARENT must be the name and not the label of the
|
|
node."
|
|
(format "\"%s\"--\"%s\";" parent node))
|
|
|
|
(defun conlanging-graphviz--node (name label)
|
|
"Create a node named NAME with the label LABEL."
|
|
(format "\"%s\"[label=\"%s\"];" name label))
|
|
|
|
(defun conlanging-graphviz--str-add-id (str)
|
|
"Append a unique id to STR."
|
|
(concat str "-" (org-id-time-to-b36)))
|
|
|
|
;;;###autoload
|
|
(defun conlanging-graphviz-list-to-graphviz (list &optional previous-node-name)
|
|
"Convert LIST into a graphviz tree.
|
|
LIST must be in the form of
|
|
|
|
(\"label\"
|
|
child1
|
|
child2
|
|
...)
|
|
|
|
with each child being either another list in the same for or a
|
|
string which is then a leaf.
|
|
|
|
PREVIOUS-NODE-NAME is the parent node of the current tree being
|
|
formed. If it is nil, then it means the current tree is the root
|
|
tree itself."
|
|
(cond
|
|
((listp list) ;; it's a node!
|
|
(let* ((tree-root-p (null previous-node-name))
|
|
(node-label (car list))
|
|
(node-name (conlanging-graphviz--str-add-id node-label))
|
|
(graph-str (if tree-root-p
|
|
"graph{graph[dpi=300,bgcolor=\"transparent\"];node[shape=plaintext];"
|
|
"")))
|
|
(setq graph-str
|
|
(concat graph-str
|
|
(conlanging-graphviz--node node-name node-label)
|
|
(if (not tree-root-p)
|
|
(conlanging-graphviz--node-link node-name previous-node-name)
|
|
"")))
|
|
(dolist (child (cdr list) graph-str)
|
|
(setf graph-str (concat graph-str
|
|
(conlanging-graphviz-list-to-graphviz child node-name))))
|
|
(concat graph-str (if tree-root-p "}" ""))))
|
|
((stringp list) ;; it's a leaf!
|
|
(let ((name (conlanging-graphviz--str-add-id list)))
|
|
(concat (conlanging-graphviz--node name list)
|
|
(conlanging-graphviz--node-link name previous-node-name))))
|
|
(t (error "Cannot handle something that isn't a string or a list!"))))
|
|
|
|
;;;###autoload
|
|
(cl-defun conlanging-graphviz-feature-tree (node &key ((:previous previous-node-name) nil) (label ""))
|
|
"Create a feature tree from NODE.
|
|
|
|
LABEL is the label of the root node.
|
|
|
|
PREVIOUS is for internal use. It refers to the parent node of
|
|
NODE if NODE is a subtree of the root tree."
|
|
(cond
|
|
((stringp node) ;; it's a leaf!
|
|
(let ((name (conlanging-graphviz--str-add-id node)))
|
|
(concat (conlanging-graphviz--node name node)
|
|
(conlanging-graphviz--node-link name previous-node-name))))
|
|
((listp node) ;; it's a node!
|
|
(let* ((tree-root-p (null previous-node-name))
|
|
(root-name (or previous-node-name
|
|
(conlanging-graphviz--str-add-id label)))
|
|
(positive-node-label (concat "+" (car node)))
|
|
(positive-node-name (conlanging-graphviz--str-add-id positive-node-label))
|
|
(negative-node-label (concat "-" (car node)))
|
|
(negative-node-name (conlanging-graphviz--str-add-id negative-node-label))
|
|
(graph-header (if tree-root-p
|
|
(concat "graph{graph[dpi=300,bgcolor=\"transparent\"];node[shape=plaintext];"
|
|
(conlanging-graphviz--node root-name label))
|
|
"")))
|
|
;; create positive label
|
|
(concat graph-header
|
|
(conlanging-graphviz--node positive-node-name positive-node-label)
|
|
(conlanging-graphviz--node-link positive-node-name root-name)
|
|
(conlanging-graphviz-feature-tree (nth 1 node) :previous positive-node-name)
|
|
(conlanging-graphviz--node negative-node-name negative-node-label)
|
|
(conlanging-graphviz--node-link negative-node-name root-name)
|
|
(conlanging-graphviz-feature-tree (nth 2 node) :previous negative-node-name)
|
|
(if tree-root-p "}" ""))))))
|
|
|
|
(provide 'conlanging-graphviz)
|
|
|
|
;;; conlanging-graphviz.el ends here
|