;;; conlanging.el --- Helper functions for conlanging -*- lexical-binding: t -*-

;; Author: Lucien Cartier-Tilet
;; Maintainer: Lucien Cartier-Tilet
;; Version: 0.1.0
;; Package-Requires: ((emacs "24") (org "9") (ivy "0.13") (counsel "0.13"))
;; Homepage: https://labs.phundrak.com/phundrak/conlanging.el

;; 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/>.


;;; Commentary:
;; This package is not made in order to be used by a lot of people.
;; Actually, it is made only for me. As such, there is no chance to
;; find it on any ELPA or MELPA.
;;
;; Functions and variables in this package are just helpers for myself
;; in order to write more easily the documentation on my conlangs.
;; This includes stuff such as automatic generation of text in
;; non-latin scripts or LaTeX-specific text from transliterated text,
;; graphviz trees for some stuff like syntax and feature trees, and
;; finally functions for creating automatic phonetics of a language a
;; tad complex when it comes to its pronunciation.

;;; Code:

(require 'seq)
(require 'counsel)
(require 'ivy)
(require 'conlanging-graphviz)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                        ;          Vuepress headings          ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun conlanging--get-heading-slug ()
  "Select and return a heading and its slug."
  (let* ((settings (cdr (assq major-mode counsel-outline-settings)))
         (heading (substring-no-properties (ivy-read "Heading: " (counsel-outline-candidates settings)
                                                     :preselect (max (1- counsel-outline--preselect) 0))))
         ;; keep only lowest heading
         (heading (replace-regexp-in-string "\\`.*/" "" heading))
         (slug (downcase heading))
         ;; only keep alphanumeric characters
         (slug (replace-regexp-in-string "[^[:alnum:]]+" " " slug))
         (slug (string-trim slug))
         (slug (replace-regexp-in-string "[[:space:]]+" " " slug))
         ;; stripping diacritics off of characters
         (slug (replace-regexp-in-string "[àáâäåā]" "a" slug))
         (slug (replace-regexp-in-string "ç" "c" slug))
         (slug (replace-regexp-in-string "[èéêë]" "e" slug))
         (slug (replace-regexp-in-string "[íìîï]" "i" slug))
         (slug (replace-regexp-in-string "[óòōôö]" "o" slug))
         (slug (replace-regexp-in-string "[ńǹñ]" "n" slug))
         (slug (replace-regexp-in-string "[úùûü]" "u" slug))
         (slug (replace-regexp-in-string "ý" "y" slug))
         (slug (replace-regexp-in-string " " "-" slug)))
    `(,heading . ,slug)))

(defun conlanging--get-filename-no-ext ()
  "Get file name of current buffer without its extension."
  (file-name-sans-extension (file-name-nondirectory (buffer-file-name (buffer-base-buffer)))))

;;;###autoload
(defun conlanging-insert-heading-vuepress ()
  "Insert vuepress-compatible link to heading."
  (interactive)
  (let* ((slug-head (conlanging--get-heading-slug))
         (heading   (car slug-head))
         (slug      (cdr slug-head))
         (filename  (conlanging--get-filename-no-ext))
         (text      (completing-read "Text: " `(,heading) nil nil heading)))
    (insert (format "[[file:./%s#%s][%s]]" filename slug text))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                        ;         Text transformation         ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

                                        ; Eittlandic ;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar conlanging--eittlandic-latin-to-latex '((", *\\|\\. *" . "\\\\tripledot")
                                                (" +"          . ":")
                                                ("hv"          . "x")
                                                ("í"           . "i")
                                                ("é"           . "\\\\e")
                                                ("ę\\|æ"       . "æ")
                                                ("ý"           . "y")
                                                ("œ"           . "ø")
                                                ("ú"           . "u")
                                                ("ó"           . "o")
                                                ("á\\|ǫ"       . "a")
                                                ("j"           . "i"))
  "Eittlandic Latin script to LaTeX code.
The first element of a pair is the Latin script orthography, the
second is the Runic LaTeX code equivalent.")

(defvar conlanging--eittlandic-latin-to-runes '((", *\\|\\. *"   . "⁝")
                                                (" +\\|:"        . "᛬")
                                                ("hv"            . "ᛪ")
                                                ("i\\|í\\|j"     . "ᛁ")
                                                ("é"             . "ᛂ")
                                                ("e\\|ę\\|æ"     . "ᛅ")
                                                ("y\\|ý"         . "ᛦ")
                                                ("ø\\|œ"         . "ᚯ")
                                                ("u\\|ú\\|v\\|w" . "ᚢ")
                                                ("o\\|ó"         . "ᚮ")
                                                ("a\\|á\\|ǫ"     . "ᛆ")
                                                ("p"             . "ᛔ")
                                                ("b"             . "ᛒ")
                                                ("f"             . "ᚠ")
                                                ("t"             . "ᛐ")
                                                ("d"             . "ᛑ")
                                                ("þ"             . "ᚦ")
                                                ("ð"             . "ᚧ")
                                                ("s"             . "ᛋ")
                                                ("k"             . "ᚴ")
                                                ("g"             . "ᚵ")
                                                ("h"             . "ᚼ")
                                                ("m"             . "ᛘ")
                                                ("n"             . "ᚿ")
                                                ("r"             . "ᚱ")
                                                ("l"             . "ᛚ"))
  "Eittlandic latin orthography to runes.
The first element of a pair is the Latin script orthography, the
second is the Runic equivalent.")

(defvar conlanging-language-list `((eittlandic-runes . ,conlanging--eittlandic-latin-to-runes)
                                   (eittlandic-latex . ,conlanging--eittlandic-latin-to-latex)))

(defun conlanging--translate (text table)
  "Translate TEXT through its correspondance TABLE."
  (let ((rune-table (cdr (assoc table conlanging-language-list))))
    (dolist (elem rune-table text)
      (setq text (replace-regexp-in-string (car elem) (cdr elem) text)))))

(defun conlanging--replace-region-by-translation (table)
  "Replace region with its translation through TABLE.
See `conlanging--translate'."
  (interactive)
  (let* ((beg        (region-beginning))
         (end        (region-end))
         (region-str (buffer-substring-no-properties beg end)))
    (delete-region beg end)
    (goto-char beg)
    (insert (conlanging--translate region-str table))))

;;;###autoload
(defun conlanging-language-to-script (text language)
  "Transform TEXT or current word or region in LANGUAGE to its native script.
LANGUAGE can be one of the values found in `conlanging-language-list'."
  (interactive)
  (let* ((table (alist-get language conlanging-language-list)))
    (conlanging--translate text table)))

;;;###autoload
(defun conlanging-to-org-runes (text language)
  "Translate TEXT from LANGUAGE to LaTeX runes equivalent for org exports.

LANGUAGE must be one of the following values:
- `matter'
- `eittlandic'"
  (interactive)
  (if (org-export-derived-backend-p org-export-current-backend 'latex)
      (format "\\textarm{%s}" (conlanging--translate text
                                                     (pcase language
                                                       ('eittlandic 'eittlandic-latex)
                                                       ('matter     'matter-latex)
                                                       (otherwise   (error "Option \"%s\" not supported" otherwise)))))
    (conlanging--translate text
                           (pcase language
                             ('eittlandic 'eittlandic-runes)
                             ('matter     'matter-runes)
                             (otherwise   (error "Option \"%s\" not supported" otherwise))))))

(provide 'conlanging)

;;; conlanging.el ends here