Emacs: Input Method Generator

;;; input-method-generator.el --- Input Method Generator

;; Copyright (C) 2021 by Jean Louis

;; Author: Jean Louis <bugs@gnu.support>
;; Version: 0.1
;; Package-Requires: ()
;; Keywords: convenience
;; URL: https://hyperscope.link/3/7/7/4/1/Emacs-Input-Method-Generator-37741.html

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:
;;;
;;; Run M-x rcd-input-method-generator RET to generate 𝓯𝓪𝓷𝓬𝔂 input
;;; methods.
;;;
;;; CIRCLED LATIN: ⓐⓑⓒⓓⓔⓕⓗⓘⓙⓚⓛⓜⓝⓞⓟⓠⓡⓢⓣⓦⓧⓨⓩ
;;; FULLWIDTH LATIN: ＦＵＬＬＷＩＤＴＨ ＬＡＴＩＮ
;;; ʟᴀᴛɪɴ ʟᴇᴛᴛᴇʀ ꜱᴍᴀʟʟ ᴠᴇʀʏ ɴɪᴄᴇ ꜰᴏʀ ꜱᴏᴄɪᴀʟ ᴍᴇᴅɪᴀ
;;; 𝕸𝖆𝖙𝖍𝖊𝖒𝖆𝖙𝖎𝖈𝖆𝖑 𝕭𝖔𝖑𝖉 𝕱𝖗𝖆𝖐𝖙𝖚𝖗
;;; 𝑴𝒂𝒕𝒉𝒆𝒎𝒂𝒕𝒊𝒄𝒂𝒍 𝑩𝒐𝒍𝒅 𝑰𝒕𝒂𝒍𝒊𝒄
;;; 𝐌𝐚𝐭𝐡𝐞𝐦𝐚𝐭𝐢𝐜𝐚𝐥 𝐁𝐨𝐥𝐝
;;; 𝔻𝕆𝕌𝔹𝕃𝔼 𝕊𝕋R𝕌C𝕂
;;; 𝑀𝐴𝑇𝐻𝐸𝑀𝐴𝑇𝐼𝐶𝐴𝐿 𝐼𝑇𝐴𝐿𝐼𝐶
;;; 𝓂𝒶𝓉𝒽e𝓂𝒶𝓉𝒾𝒸𝒶𝓁 𝓈𝒸𝓇𝒾𝓅𝓉
;;; 𝓪𝓷𝓭 𝓼𝓮𝓿𝓮𝓻𝓪𝓵 𝓸𝓽𝓱𝓮𝓻𝓼
;;;
;;; customize place to save the in variable `rcd-input-method-directory'
;;;
;;; Change Log:

;;; Code:

(defcustom rcd-input-method-directory "~/"
  "Define the directory to generated input method files."
  :group 'rcd
  :type 'string)

(defun string-to-file-force (string file)
  "Print STRING into file, matters not if file exists.
Return FILE as file name."
  (with-temp-file file
    (insert string))
  file)

(defvar rcd-input-methods '(
			    "CIRCLED LATIN@"
			    "FULLWIDTH LATIN@"
			    "LATIN LETTER SMALL"
			    "MATHEMATICAL FRAKTUR"
			    "MATHEMATICAL BOLD FRAKTUR"
			    "MATHEMATICAL BOLD ITALIC"
			    "MATHEMATICAL BOLD SCRIPT"
			    "MATHEMATICAL BOLD"
			    "MATHEMATICAL DOUBLE-STRUCK"
			    "MATHEMATICAL ITALIC"
			    "MATHEMATICAL MONOSPACE"
			    "MATHEMATICAL SANS-SERIF BOLD ITALIC"
			    "MATHEMATICAL SANS-SERIF BOLD"
			    "MATHEMATICAL SANS-SERIF ITALIC"
			    "MATHEMATICAL SANS-SERIF"
			    "MATHEMATICAL SCRIPT"
			    )
  "The input methods that this package can generate and load.")

(defun rcd-input-method-generator ()
  "Generate 𝓯𝓪𝓷𝓬𝔂 input method.

Activate it with \\[toggle-input-method] or set it with \\[set-input-method]"
  (interactive)
  (let* ((completion-ignore-case t)
	 (input-method (completing-read"Input method: " rcd-input-methods))
	 (unicode-part (upcase (string-trim input-method)))
	 (name (string-replace "@" "" (downcase input-method)))
	 (name (string-replace " " "-" name))
	 (title (capitalize input-method))
	 (description (concat title " Input Method"))
	 (file (concat "input-method-" name ".el")))
    (string-to-file-force
     (rcd-input-method-generate input-method unicode-part name title description)
     file)
    (load-file file)))

(defun rcd-input-method-generate (input-method unicode-part name title description)
  "Generate INPUT-METHOD.

Uses UNICODE-PART, NAME, TITLE and DESCRIPTION."
  (let* ((mode-1 (when (string-match "@" unicode-part) t))
	 (unicode-part (replace-regexp-in-string "@" "" unicode-part))
	 (unicode-part-capital (if mode-1 (concat unicode-part " CAPITAL LETTER ")
				 (concat unicode-part " CAPITAL ")))
	 (unicode-part-small (if mode-1 (concat unicode-part " SMALL LETTER ")
			       (concat unicode-part " SMALL "))))
    (with-temp-buffer
      (insert (format ";;;; Input method: %s\n\n" title))
      (insert "(quail-define-package\n")
      (insert (format " \"%s\" \"Unicode\" \"%s\" t\n" name title))
      (insert (format " \"%s\"\n" description))
      (insert (format " nil t nil nil nil nil nil nil nil nil t)\n\n"))
      (insert "(quail-define-rules")
      (let ((num 65))
	(while (< num 91)
	  (let* ((name (concat unicode-part-capital (char-to-string num)))
		 (char-from-name (condition-case nil
				    (char-from-name name)
				  (error ""))))
	    (when char-from-name
	      (insert (format "\n (\"%s\" %d)" (char-to-string num) char-from-name))))
	  (setq num (1+ num))))
      (let ((num 97))
	(while (< num (+ 97 26))
	  (let* ((name (concat unicode-part-small (upcase (char-to-string num))))
		 (char-from-name (condition-case nil
				     (char-from-name name)
				   (error ""))))
	    (when char-from-name
	      (insert (format "\n (\"%s\" %d)" (char-to-string num) char-from-name))))
	  (setq num (1+ num))))
      (insert ")\n\n")
      (buffer-string))))

;;; input-method-generator.el ends here