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
2019-09-15 03:58:20 +02:00

305 lines
14 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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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 "e")
("ó" nil nil "o")
("e" nil nil "ɛ")
("o" nil nil "ɔ")
(" " nil nil " ")
("," nil nil " ")
(";" nil nil " ")
("." nil nil " ")))
(defun conlanging//is-consonant (elem)
(nth 1 elem))
(defun conlanging//is-dorsal (elem)
(nth 2 elem))
(defun conlanging//nyqy-get-phoneme (consonant phon need-dorsal)
(let* ((is-dorsal (nth 1 phon)))
(nth (if (or (eq need-dorsal 2) (not consonant)) 3
(if (eq is-dorsal need-dorsal) 3 4))
phon)))
(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))
(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//is-consonant curr-phon-list))
(dorsal (conlanging//is-dorsal curr-phon-list))
(phon (conlanging//nyqy-get-phoneme consonant curr-phon-list need-dorsal)))
(if (eq need-dorsal 2)
(setq 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 text "" t)
()
2))
(if (org-export-derived-backend-p org-export-current-backend
'latex)
(concat text " /" phonetics "/")
(concat text " <span class=\"tooltip\">/"
phonetics "/</span>")))