diff --git a/lisp/long-s-mode.el b/lisp/long-s-mode.el new file mode 100644 index 0000000..784cb7d --- /dev/null +++ b/lisp/long-s-mode.el @@ -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