Add long-s-mode

1 files changed, 67 insertions, 0 deletions

@@ -0,0 +1,67 @@
+;;; long-s-mode.el --- Proper typography for Emacs -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; from Catie on #emacs
+
+;;; Code:
+
+(define-minor-mode long-s-mode
+  "Minor mode for inserting 'ſ' characters")
+
+(defconst +long-s+ ?ſ)
+(defconst +short-s+ ?s)
+
+(defun long-s-p (char)
+  (char-equal char +long-s+))
+
+(defun short-s-p (char)
+  (or (char-equal char +short-s+)))
+
+(defun s-char-p (char)
+  (or (long-s-p char)
+      (short-s-p char)))
+
+(defun alpha-char-p (char)
+  (memq (get-char-code-property char 'general-category)
+        '(Ll Lu Lo Lt Lm Mn Mc Me Nl)))
+
+(defun long-s-insert-short-s ()
+  (interactive)
+  (if (long-s-p (preceding-char))
+      (insert-char +short-s+)
+    (insert-char +long-s+)))
+
+(defun long-s-insert-space ()
+  (interactive)
+  (if (long-s-p (preceding-char))
+      (progn (delete-backward-char 1)
+             (insert-char +short-s+))
+    (save-excursion
+      (while (not (alpha-char-p (preceding-char)))
+        (backward-char))
+      (when (long-s-p (preceding-char))
+        (delete-backward-char 1)
+        (insert-char +short-s+))))
+  (insert-char ?\ ))
+
+(defvar long-s-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map (current-global-map))
+    (define-key map (kbd "s") #'long-s-insert-short-s)
+    (define-key map (kbd "SPC") #'long-s-insert-space)
+    map))
+
+(setq long-s-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "s") #'long-s-insert-short-s)
+    (define-key map (kbd "SPC") #'long-s-insert-space)
+    map))
+
+(unless (seq-some #'(lambda (x) (eq (car x) 'long-s-mode))
+                 minor-mode-map-alist)
+  (push (cons 'long-s-mode long-s-mode-map)
+        minor-mode-map-alist))
+
+(provide 'long-s-mode)
+;;; long-s-mode.el ends here