blob: 784cb7dc28a5cd3ebb75af76c47669c4fe848f4a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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
|
