diff options
-rw-r--r-- | lisp/long-s-mode.el | 67 |
1 files changed, 67 insertions, 0 deletions
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 @@ | |||
1 | ;;; long-s-mode.el --- Proper typography for Emacs -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; from Catie on #emacs | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (define-minor-mode long-s-mode | ||
10 | "Minor mode for inserting 'ſ' characters") | ||
11 | |||
12 | (defconst +long-s+ ?ſ) | ||
13 | (defconst +short-s+ ?s) | ||
14 | |||
15 | (defun long-s-p (char) | ||
16 | (char-equal char +long-s+)) | ||
17 | |||
18 | (defun short-s-p (char) | ||
19 | (or (char-equal char +short-s+))) | ||
20 | |||
21 | (defun s-char-p (char) | ||
22 | (or (long-s-p char) | ||
23 | (short-s-p char))) | ||
24 | |||
25 | (defun alpha-char-p (char) | ||
26 | (memq (get-char-code-property char 'general-category) | ||
27 | '(Ll Lu Lo Lt Lm Mn Mc Me Nl))) | ||
28 | |||
29 | (defun long-s-insert-short-s () | ||
30 | (interactive) | ||
31 | (if (long-s-p (preceding-char)) | ||
32 | (insert-char +short-s+) | ||
33 | (insert-char +long-s+))) | ||
34 | |||
35 | (defun long-s-insert-space () | ||
36 | (interactive) | ||
37 | (if (long-s-p (preceding-char)) | ||
38 | (progn (delete-backward-char 1) | ||
39 | (insert-char +short-s+)) | ||
40 | (save-excursion | ||
41 | (while (not (alpha-char-p (preceding-char))) | ||
42 | (backward-char)) | ||
43 | (when (long-s-p (preceding-char)) | ||
44 | (delete-backward-char 1) | ||
45 | (insert-char +short-s+)))) | ||
46 | (insert-char ?\ )) | ||
47 | |||
48 | (defvar long-s-mode-map | ||
49 | (let ((map (make-sparse-keymap))) | ||
50 | (set-keymap-parent map (current-global-map)) | ||
51 | (define-key map (kbd "s") #'long-s-insert-short-s) | ||
52 | (define-key map (kbd "SPC") #'long-s-insert-space) | ||
53 | map)) | ||
54 | |||
55 | (setq long-s-mode-map | ||
56 | (let ((map (make-sparse-keymap))) | ||
57 | (define-key map (kbd "s") #'long-s-insert-short-s) | ||
58 | (define-key map (kbd "SPC") #'long-s-insert-space) | ||
59 | map)) | ||
60 | |||
61 | (unless (seq-some #'(lambda (x) (eq (car x) 'long-s-mode)) | ||
62 | minor-mode-map-alist) | ||
63 | (push (cons 'long-s-mode long-s-mode-map) | ||
64 | minor-mode-map-alist)) | ||
65 | |||
66 | (provide 'long-s-mode) | ||
67 | ;;; long-s-mode.el ends here | ||