;; -*- lexical-binding: t; -*- ;; A proof of concept for Unicode font support in LaTeX export, using ;; babel and fontspec, with luatex as the default compiler. ;; Use example: ;; It is not necessary to load languages with non-Latin alphabet in babel options: ;; #+LaTeX_Header: \usepackage[AUTO]{babel} ;; Languages and fonts (there may be multiple lines): ;; #+LaTeX_Header: % !enable-fonts-for ancientgreek:Linux Libertine O(Scale=MatchLowercase) ;; #+LaTeX_Header: % !enable-fonts-for russian:FreeSerif(Numbers=Lowercase,Color=blue) :: arabic ;; Explanation: ;; - lang = enable default font for lang ;; - lang:font = enable font for lang in current document ;; - lanf:font(options) = enable font for lang in this document with options ;; - :: = separator ;; code ;; This is supposed to be a defcustom. (setq org-latex-uc-fonts-support t) ;; A mini version of `org-latex-language-alist', for this proof of ;; concept. Babel uses various names for languages. The ones that ;; interest us here are those collected in `:babel-alt', which is ;; always a list. The names sometimes match the `classic' babel name ;; and other times they don't. And in the case of "el-polyton" there ;; are two possible names. For a list of these names see: ;; [[https://CTAN/macros/latex/required/babel/base/babel.pdf]], ;; p. 22. (defconst org-latex-language-alist '(("en" :babel "american" :babel-alt ("english-unitedstates") :polyglossia "english" :polyglossia-variant "usmax" :lang-name "English" :script "latin" :code "latn") ("ar" :babel "arabic" :babel-alt ("arabic") :polyglossia "arabic" :lang-name "Arabic" :script "arabic" :code "arab") ("el" :babel "greek" :babel-alt ("greek") :polyglossia "greek" :lang-name "Greek" :script "greek" :code "grk") ("el-polyton" :babel "polutonikogreek" :babel-alt ("ancientgreek" "polytonicgreek") :polyglossia "greek" :polyglossia-variant "polytonic" :lang-name "Polytonic Greek" :script "greek" :code "grk") ("ru" :babel "russian" :babel-alt ("russian") :polyglossia "russian" :lang-name "Russian" :script "cyrillic" :code "cyrl")) "TODO") ;; This is supposed to be a defcustom for the main fonts. `'default' ;; means 'use the main default fonts'. Otherwise, the value must be ;; a plist. Valid props. are: ;; - :main = roman font ;; - :sans = sans font ;; - :mono = mono font ;; - :math = math font ;; - :...-options = font options ;; For the font options and the fontspec package syntax, see ;; [[https://CTAN/macros/unicodetex/latex/fontspec/fontspec.pdf]] (setq org-latex-uc-fonts-support-default-main-fonts '(:main "FreeSerif" :mono "inconsolatan" :mono-options "Scale=0.95")) ;; This is supposed to be a defcustom. Each element has the structure: ;; script - font - (optional) font options (setq org-latex-uc-fonts-support-default-scripts-fonts '(("greek" "Linux Libertine") ("cyrillic" "Old Standard") ("arabic" "FreeSerif"))) ;; Get main fonts (declared in ;; `org-latex-uc-fonts-support-default-main-fonts') (defun org-latex-uc-fonts-support-get-main-fonts (plist prop) (let ((format)) (if (not (plist-member plist prop)) (ignore) (let* ((value (plist-get plist prop)) (prop-name (replace-regexp-in-string ":" "" (symbol-name prop))) (options (plist-get plist (intern (format ":%s-options" prop-name))))) (setq format (format "\\\\set%sfont{%s}[%s]" prop-name value (if options options "") )))) format)) ;; get non latin fonts explicitly added (defun org-latex-uc-fonts-support-get-fonts-other-languages (header) (interactive) (let ((format-str) (lines)) (with-temp-buffer (insert header) (save-excursion (goto-char (point-min)) (while (re-search-forward "%\s+!enable-fonts-for\s+\\(.+\\)" nil t) (add-to-list 'lines (match-string 1))))) (let* ((lines-list (mapcar (lambda (x) (split-string x "::")) lines)) (flat (flatten-list lines-list)) (format-list (mapcar (lambda (x) (org-latex-uc-fonts-support-format-font-for-language (string-trim x))) flat))) (setq format-str (mapconcat #'identity format-list "\n\n"))) format-str)) ;; format each lang/font (defun org-latex-uc-fonts-support-format-font-for-language (lang) (let* ((regexp "\\([^:]+\\):*\\([^()]*\\)(*\\([^()]*\\))*") (lang-name (when (string-match regexp lang) (match-string 1 lang))) (lang-explicit-font (when (string-match regexp lang) (match-string 2 lang))) (lang-explicit-font-opts (when (string-match regexp lang) (match-string 3 lang))) (lang-alias (let ((candidato)) (mapc (lambda (x) (when (member :babel-alt x) (let* ((plist (cdr x)) (babel-alt (plist-get plist :babel-alt))) (when (member lang-name babel-alt) (setq candidato (car x)))))) org-latex-language-alist) candidato)) (plist (cdr (assoc lang-alias org-latex-language-alist))) (script (plist-get plist :script)) (default-script-font (assoc script org-latex-uc-fonts-support-default-scripts-fonts)) (default-font (nth 1 default-script-font)) (default-font-options (nth 2 default-script-font)) (default-font-options? (if default-font-options default-font-options ""))) (format "\\\\babelprovide[onchar=ids fonts]{%s}\n \\\\babelfont[%s]{rm}[%s]{%s}\n" lang-name lang-name (if (not (equal lang-explicit-font-opts "")) lang-explicit-font-opts default-font-options?) (if (not (equal lang-explicit-font "")) lang-explicit-font default-font)))) ;; make preamble definitions. This is supposed to be part of ;; `org-latex-guess-babel-language', as in the modified version below (defun org-latex-uc-fonts-support-make-preamble (header) (let* ((main-fonts (unless (eq 'org-latex-uc-fonts-support-default-main-fonts 'default) (mapconcat #'identity (cl-remove-if-not #'identity (mapcar (lambda (elt) (let ((str (org-latex-uc-fonts-support-get-main-fonts org-latex-uc-fonts-support-default-main-fonts elt))) (when str str))) (list :main :sans :mono :math))) "\n"))) (other-fonts-per-language (org-latex-uc-fonts-support-get-fonts-other-languages header)) (preamble (with-temp-buffer (insert "\n\n") (when main-fonts (insert main-fonts)) (insert "\n\n") (when other-fonts-per-language (insert other-fonts-per-language)) (buffer-string)))) preamble)) (defun org-latex-guess-babel-language (header info) "Modified version for this proof of concept" (let* ((language-code (plist-get info :language)) (plist (cdr (assoc language-code org-latex-language-alist))) (language (plist-get plist :babel)) (language-ini-only (plist-get plist :babel-ini-only)) ;; If no language is set, or Babel package is not loaded, or ;; LANGUAGE keyword value is a language served by Babel ;; exclusively through ini files, return HEADER as-is. (header (if (or language-ini-only (not (stringp language-code)) (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header))) header (let ((options (save-match-data (org-split-string (match-string 1 header) ",[ \t]*")))) ;; If LANGUAGE is already loaded, return header ;; without AUTO. Otherwise, replace AUTO with language or ;; append language if AUTO is not present. Languages that are ;; served in Babel exclusively through ini files are not added ;; to the babel argument, and must be loaded using ;; `\babelprovide'. (replace-match (mapconcat (lambda (option) (if (equal "AUTO" option) language option)) (cond ((member language options) (delete "AUTO" options)) ((member "AUTO" options) options) (t (append options (list language)))) ", ") t nil header 1))))) ;;; adition: (when org-latex-uc-fonts-support (setq header (let ((form (org-latex-uc-fonts-support-make-preamble header))) (replace-regexp-in-string "\\(\\\\usepackage\\[?.*\\]?{babel}\\)" (format "\n\\\\usepackage{fontspec}\n\n\\1\n%s" form) header)))) ;;; ;; If `\babelprovide[args]{AUTO}' is present, AUTO is ;; replaced by LANGUAGE. (if (not (string-match "\\\\babelprovide\\[.*\\]{\\(.+\\)}" header)) header (let ((prov (match-string 1 header))) (if (equal "AUTO" prov) (replace-regexp-in-string (format "\\(\\\\babelprovide\\[.*\\]\\)\\({\\)%s}" prov) (format "\\1\\2%s}" (or language language-ini-only)) header t) header)))))