This repository has been archived on 2020-12-27. You can view files and clone it, but cannot push or open issues or pull requests.
conlang-layer/funcs.el

363 lines
17 KiB
EmacsLisp
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; funcs.el --- Conlanging Layer functions File for Spacemacs
;;
;; Copyright (c) 2019-2020 Lucien Cartier-Tilet
;;
;; Author: Lucien Cartier-Tilet <phundrak@phundrak.fr>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Tree ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun conlanging//declare-node (node-text node-generation)
"Declares a node in the graphviz source code. The nodes identifier will be
~node-generation~, and it will bear the label ~node-text~."
(concat (number-to-string node-generation)
"[label=\""
node-text
"\"];"))
(defun conlanging//make-link (previous-node current-node)
"This creates a link in the graphviz source code between the two nodes
bearing ~previous-node~ and ~current-node~ respectively as their node
identifier."
(concat (number-to-string previous-node) " -- "
(number-to-string current-node) ";"))
(defun conlanging//tree-to-dot-helper (tree current-generation previous-generation)
"Helper to ~tree-to-dot~ that translates an Elisp tree with any number of
children per node to a corresponding graphviz file that can be executed from
dot.
Arguments:
- tree :: tree-to-convert
- current-generation :: Generation number, incremented when changing from a node
to another node from the same generation, multiplied by 10 when going from
a node to one of its children.
- previous-generation :: generation number from previous named node"
(cond
((null tree) "")
((atom (car tree)) ;; '("text" () () ())
(concat (conlanging//declare-node (car tree) current-generation)
(conlanging//make-link previous-generation current-generation)
(conlanging//tree-to-dot-helper (cdr tree)
(+ 1 (* 10 current-generation))
current-generation)))
((listp (car tree)) ;; '(() () ())
(concat (conlanging//tree-to-dot-helper (car tree) ;; child of current node
current-generation
previous-generation)
(conlanging//tree-to-dot-helper (cdr tree)
(+ 1 current-generation)
previous-generation)))))
(defun conlanging/tree-to-dot (tree)
"Returns a graphvizs dot compatible string representing an Elisp tree"
(if (null tree) ""
(concat
"graph{graph[dpi=300];node[shape=plaintext];graph[bgcolor=\"transparent\"];"
(conlanging//declare-node (car tree) 0)
(conlanging//tree-to-dot-helper (cdr tree) 1 0)
"}")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Common ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun conlanging//replace-string-by-char (t-string t-correspondance-table)
"Return a copy of t-string converted with the correspondance
table"
(interactive)
(while t-correspondance-table
(let ((cur-from-char (car (car t-correspondance-table)))
(cur-to-char (cdr (car t-correspondance-table))))
(setq t-string (replace-regexp-in-string cur-from-char cur-to-char
t-string))
(setq t-correspondance-table (cdr t-correspondance-table))))
t-string)
(defun conlanging//get-boundary ()
"Get the boundary of either the selected region, or if there is
none the word the cursor is over"
(interactive)
(let* ((beg (region-beginning))
(end (region-end))
(boundary-word (bounds-of-thing-at-point 'word)))
(if (= beg end)
boundary-word
(cons beg end))))
(defun conlanging//replace-char-by-table (correspondance-table)
"Replaces selected texts strings according to the table passed
as argument. The table is a list of pairs, the first element of
the pair is a regex to be searched in the selected text and the
second element of the pair the string it has to be replaced
with."
(let* ((cur-boundary (conlanging//get-boundary))
(beg (car cur-boundary))
(end (cdr cur-boundary)))
(setq-local regionp
(buffer-substring-no-properties beg end))
(setq-local regionp
(conlanging//replace-string-by-char regionp
correspondance-table))
(delete-region beg end)
(goto-char beg)
(insert regionp)))
(defun conlanging//find-elem-in-list (elem list)
"In a list containing lists, returns the element of `list'
whose first element equals `elem'"
(if list
(if (string= (caar list)
elem)
(car list)
(conlanging//find-elem-in-list elem
(cdr list)))
nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Mattér ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq conlanging//matter-latin-to-runes '((", *" . "")
("\\. *" . "")
(" +" . "")
("ċ" . "")
("ch" . "")
("ae" . "")
("æ" . "")
("dh" . "")
("z" . "")
("ð" . "")
("th" . "")
("s" . "")
("þ" . "")
("w" . "")
("ƿ" . "")
("g" . "")
("" . "")
("ea" . "")
("f" . "")
("u" . "")
("o" . "")
("r" . "")
("c" . "")
("h" . "")
("n" . "")
("i" . "")
("j" . "")
("p" . "")
("v" . "")
("t" . "")
("b" . "")
("e" . "")
("m" . "")
("l" . "")
("d" . "")
("é" . "")
("a" . "")
("y" . "")))
(setq conlanging//matter-latin-to-native '((" +" . " ")
("ch" . "ċ")
("ae" . "æ")
("th" . "þ")
("s" . "þ")
("dh" . "ð")
("z" . "ð")
("w" . "ƿ")
("j" . "i")))
(setq conlanging//matter-latin-to-latex '((", *" . ":")
("\\. *" . "*")
(" +" . ".")
("ch" . "I")
("ċ" . "I")
("ae" . "æ")
("ea" . "\\\\ea")
("ƿ" . "w")
("dh" . "s")
("z" . "s")
("ð" . "s")
("th" . "þ")
("s" . "þ")
("v" . "\\\\ng")
("é " . "\\\\oe")))
(defun conlanging/matter-to-runes ()
"Replaces transliterated Mattér with its runic writing system"
(interactive)
(conlanging//replace-char-by-table conlanging//matter-latin-to-runes))
(defun conlanging/matter-to-native-latin ()
"Replaces transliterated Mattér with its corresponding native
latin writing system"
(interactive)
(conlanging//replace-char-by-table conlanging//matter-latin-to-native))
(defun conlanging/matter-to-latex ()
"Replaces transliterated Mattér with its corresponding runes"
(interactive)
(conlanging//replace-char-by-table conlanging//matter-latin-to-latex))
(defun conlanging/matter-org-export-runes (text)
"Replaces transliterated Mattér with its corresponding runes during org-mode
export"
(interactive)
(if (org-export-derived-backend-p org-export-current-backend
'latex)
(concat "\\textarm{"
(conlanging//replace-string-by-char text conlanging//matter-latin-to-latex)
"}")
(conlanging//replace-string-by-char text conlanging//matter-latin-to-runes)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Eittlanda ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq conlanging//eittlanda-latin-to-latex '((", *" . "\\\\tripledot")
("\\. *" . "\\\\tripledot")
(" +" . ":")
("hv" . "x")
("ø" . "\\\\o")
("œ" . "\\\\oO")
("v" . "w")
("ó" . "v")
("ń" . "\\\\ndot")))
(setq conlanging//eittlanda-latin-to-runes '((", *" . "")
("\\. *" . "")
(" +" . "")
(":" . "")
("hv" . "")
("i" . "")
("y" . "")
("u" . "")
("e" . "")
("ø" . "")
("o" . "")
("œ" . "")
("ó" . "")
("æ" . "")
("a" . "")
("m" . "")
("n" . "")
("ń" . "")
("p" . "")
("b" . "")
("t" . "")
("d" . "")
("k" . "")
("g" . "")
("f" . "")
("þ" . "")
("ð" . "")
("s" . "")
("h" . "")
("v" . "")
("r" . "")
("l" . "")))
(defun conlanging/eittlanda-to-runes ()
"Replaces transliterated Eittlandic with its runic writing system"
(interactive)
(conlanging//replace-char-by-table conlanging//eittlanda-latin-to-runes))
(defun conlanging/eittlanda-to-latex ()
"Replaces transliterated Eittlandic with its corresponding runes"
(interactive)
(conlanging//replace-char-by-table conlanging//eittlanda-latin-to-latex))
(defun conlanging/eittlanda-org-export-runes (text)
"Replaces transliterated Eittlandic with its corresponding
runes during org-mode export"
(interactive)
(if (org-export-derived-backend-p org-export-current-backend
'latex)
(concat "\\textarm{"
(conlanging//replace-string-by-char text conlanging//eittlanda-latin-to-latex)
"}")
(conlanging//replace-string-by-char text conlanging//eittlanda-latin-to-runes)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Ñyqy ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq conlanging//nyqy-phonetics '(("q" t t "q" "ħ")
("g" t t "ɢ" "ʢ")
("ñ" t t "ɴ" "m")
("c" t t "t͡ʃ" "ɬ")
("j" t t "d͡ʒ" "ɮ")
("w" t t "w" "l")
("p" t nil "p" "χ")
("b" t nil "b" "ʁ")
("m" t nil "m" "ʀ")
("n" t nil "n" "j")
("s" t nil "s" "x")
("z" t nil "z" "ɣ")
("y" nil nil "y")
("ú" nil nil "u")
("i" nil nil "ɪ")
("u" nil nil "ʊ")
("é" nil nil "ø")
("ó" nil nil "ɤ")
("e" nil nil "ɛ")
("o" nil nil "ɔ")
(" " nil nil " ")
("," nil nil " ")
(";" nil nil " ")
("." nil nil " ")))
(defun conlanging//nyqy-is-consonant (elem)
(nth 1 elem))
(defun conlanging//nyqy-is-dorsal (elem)
(nth 2 elem))
(defun conlanging//nyqy-get-phoneme (consonant phon need-dorsal is-dorsal)
(nth (if (or (eq need-dorsal 2)
(not consonant))
3
(if (eq is-dorsal need-dorsal)
3
4))
phon))
(defun conlanging//nyqy-convert (text phonetics need-dorsal)
"
need-dorsal: initial = 2, sinon t ou nil
"
(if (null text)
(mapconcat 'identity phonetics "")
(let* ((curr-char (car text))
(curr-phon-list (conlanging//find-elem-in-list curr-char conlanging//nyqy-phonetics))
(consonant (conlanging//nyqy-is-consonant curr-phon-list))
(dorsal (conlanging//nyqy-is-dorsal curr-phon-list))
(phon (conlanging//nyqy-get-phoneme consonant curr-phon-list
need-dorsal dorsal)))
(if (eq need-dorsal 2)
(setq-local need-dorsal dorsal))
(conlanging//nyqy-convert (cdr text)
(append phonetics
(list phon))
(if consonant
(not need-dorsal)
need-dorsal)))))
(defun conlanging/nyqy-to-phonetics (text)
"Adds to Ñyqy text its phonetics equivalent, either as a
tooltip in HTML or as plain text appended in LaTeX.
Arguments:
- text: text to convert to phonetics"
(interactive)
(setq-local phonetics
(conlanging//nyqy-convert (split-string (downcase text)
""
t)
()
2))
(concat "@@html:<span class=\"tooltip\"><i>"
text "</i><span class=\"tooltiptext\"> /" phonetics
"/</span></span>@@@@latex:\\textit{" text
"} (/" phonetics "/)@@"))