Lucien Cartier-Tilet
f20fb14f8e
This commit splits graphviz-related functions into its own file, conlanging-graphviz.el. It also updates these functions since org lists through noweb no longer work like they used to. Instead, going back to good old lisp lists, this commit significantly reduces the amount of code needed. This is the update and split part. This commit also removes a lot of old code that is no longer necessary since the removal of old documents for conlanging, rendering these functions obsolete. This is the cleanup part. Lastly, this commit adds the new function conlanging-graphviz-feature-tree which is able to generate a feature tree from a much more compact Lisp list than what conlang-graphviz-list-to-graphviz needs.
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
|