- name: George
surnameatbirth: ...
bday: 2013
sex: m
father:
name: William
surnameatbirth: Arthur Philip Louis
bday: 1982
sex: m
father:
name: Charles
surnameatbirth: ...
bday: 1948
sex: m
father:
name: Philip
surnameatbirth: Mountbatten-Windsor
sex: m
bday: 1947
dday: 9 April 2021
mother:
name: Elizabeth
surnamenow: Windsor
sex: f
bday: 21 April 1926
mother:
name: Catherine
surnameatbirth: Middleton
surnamenow:
bday: 1982
sex: f
father:
name: Michael Francis
surnameatbirth: Middleton
bday: 1949
sex: m
mother:
name: Carole Elizabeth
surnamenow: Middleton
surnameatbirth: Goldsmith
sex: f(defun to-slug-- (str)
(if (not-null-- str) (s-replace-all '((" " . "_") ("." . "_" ) ("-" . "_")) str) "")
)
(defun not-null-- (v)
;; YAML parser returns :null symbol when the value is missing
(and v (not (eq v :null))))
(defun make-node-slug-- (node)
;; use 'slug' value if present in the node
(gethash 'slug node
;; otherwise generate one from name and surname at birth and surname now
(concat
(to-slug-- (gethash 'name node ""))
"_"
(to-slug-- (gethash 'surnameatbirth node ""))
"_"
(to-slug-- (gethash 'surnamenow node ""))
))
)
(defun compose-surname-- (atbirth now)
(if (not-null-- now) (format "%s (%s)" now atbirth)
atbirth))
(defun compose-lifetime-- (bday dday)
(cond
((and (not-null-- bday) (not-null-- dday)) (format "%s - %s" bday dday))
((not-null-- bday) bday)
((not-null-- dday) (format "??? - %s" dday))
(t "")
))
(defun dot/make-one-record (node)
"Make one record node in dot lanague about the person without recursive walk.
Params hashmap and returns cons cell of slug and the record as string."
(let ((slug (make-node-slug-- node)))
(cons slug (format "%s [label=\"{%s %s| %s}\"];"
slug
(gethash 'name node)
(compose-surname-- (gethash 'surnameatbirth node) (gethash 'surnamenow node))
(compose-lifetime-- (gethash 'bday node) (gethash 'dday node))
))
)
)
(defun dot/make-one-ref (from to label)
(format "%s -> %s [label=\"%s\"]" from to label))
(defun dot/make-node (node)
(let* (
(slug-to-record (dot/make-one-record node))
(node-slug (car slug-to-record))
(node-record (cdr slug-to-record)))
(cons node-slug
(mapconcat
(lambda (seq) (mapconcat 'identity seq "\n"))
(list (list node-record)
(when (gethash 'father node)
(let* (
(slug-to-record (dot/make-node (gethash 'father node)))
(parent-slug (car slug-to-record))
(parent-record (cdr slug-to-record)))
(list parent-record (dot/make-one-ref parent-slug node-slug "f"))))
(when (gethash 'mother node)
(let* (
(slug-to-record (dot/make-node (gethash 'mother node)))
(parent-slug (car slug-to-record))
(parent-record (cdr slug-to-record)))
(list parent-record (dot/make-one-ref parent-slug node-slug "m"))))
)
"\n"))
)
)
;; (format "%s" (gethash 'a (yaml-parse-string content)))
(defun make-family-tree (content)
(let ((debug-on-error t))
(message (concat "digraph {
node [
fontsize = \"12\";
shape=record;
];
"
(mapconcat (lambda (node) (cdr (make-dot-node node))) (yaml-parse-string content) "\n")
"
}
"))))
(make-family-tree example)digraph {
node [
fontsize = "12";
shape=record;
];
George_____ [label="{George ...| 2013}"]
William_Arthur_Philip_Louis_ [label="{William Arthur Philip Louis| 1982}"]
Charles_____ [label="{Charles ...| 1948}"]
Philip_Mountbatten-Windsor_ [label="{Philip Mountbatten-Windsor| }"]
Philip_Mountbatten-Windsor_ -> Charles_____ [label="f"]
Elizabeth__Windsor [label="{Elizabeth Windsor (nil)| }"]
Elizabeth__Windsor -> Charles_____ [label="m"]
Charles_____ -> William_Arthur_Philip_Louis_ [label="f"]
William_Arthur_Philip_Louis_ -> George_____ [label="f"]
Catherine_Middleton_ [label="{Catherine Middleton| 1982}"]
Michael_Francis_Middleton_ [label="{Michael Francis Middleton| 1949}"]
Michael_Francis_Middleton_ -> Catherine_Middleton_ [label="f"]
Carole_Elizabeth_Goldsmith_Middleton [label="{Carole Elizabeth Middleton (Goldsmith)| }"]
Carole_Elizabeth_Goldsmith_Middleton -> Catherine_Middleton_ [label="m"]
Catherine_Middleton_ -> George_____ [label="m"]
}
