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