about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--init.el5
-rw-r--r--lisp/titlecase.el197
2 files changed, 201 insertions, 1 deletions
diff --git a/init.el b/init.el index 3a39246..03eeee0 100644 --- a/init.el +++ b/init.el
@@ -856,7 +856,6 @@ See also `crux-reopen-as-root-mode'."
856 (eq system-type 'gnu/linux)) 856 (eq system-type 'gnu/linux))
857 (pdf-tools-install)) 857 (pdf-tools-install))
858 858
859
860(setup (:straight (shell-command+ 859(setup (:straight (shell-command+
861 :host nil 860 :host nil
862 :repo "https://git.sr.ht/~pkal/shell-command-plus")) 861 :repo "https://git.sr.ht/~pkal/shell-command-plus"))
@@ -910,6 +909,10 @@ See also `crux-reopen-as-root-mode'."
910 (auto-save-visited-mode -1) 909 (auto-save-visited-mode -1)
911 (super-save-mode +1)) 910 (super-save-mode +1))
912 911
912(setup (:straight (titlecase
913 :host github
914 :repo "duckwork/titlecase.el")))
915
913(setup (:straight topsy) 916(setup (:straight topsy)
914 (:hook-into prog-mode 917 (:hook-into prog-mode
915 circe-chat-mode) 918 circe-chat-mode)
diff --git a/lisp/titlecase.el b/lisp/titlecase.el new file mode 100644 index 0000000..c79f558 --- /dev/null +++ b/lisp/titlecase.el
@@ -0,0 +1,197 @@
1;;; titlecase.el --- title-case phrases -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; adapted from https://hungyi.net/posts/programmers-way-to-title-case/
6
7;;; Code:
8
9(require 'seq)
10
11(defgroup titlecase nil
12 "Customizations for titlecasing phrases."
13 :prefix "titlecase-"
14 :group 'text)
15
16;;; Lists of words /never/ to capitalize
17
18(defvar titlecase-prepositions
19 '("'thout" "'tween" "aboard" "about" "above"
20 "abreast" "absent" "abt." "across" "after" "against" "ago" "aloft" "along"
21 "alongside" "amid" "amidst" "among" "amongst" "anti" "apart" "apropos"
22 "around" "as" "aside" "aslant" "astride" "at" "atop" "away" "before"
23 "behind" "below" "beneath" "beside" "besides" "between" "beyond" "but" "by"
24 "c." "ca." "circa" "come" "concerning" "contra" "counting" "cum" "despite"
25 "down" "during" "effective" "ere" "except" "excepting" "excluding" "failing"
26 "following" "for" "from" "hence" "in" "including" "inside" "into" "less"
27 "like" "mid" "midst" "minus" "mod" "modulo" "near" "nearer" "nearest"
28 "neath" "next" "notwithstanding" "o'" "o'er" "of" "off" "offshore" "on"
29 "onto" "ontop" "opposite" "out" "outside" "over" "pace" "past" "pending"
30 "per" "plus" "post" "pre" "pro" "qua" "re" "regarding" "respecting" "round"
31 "sans" "save" "saving" "short" "since" "sub" "t'" "than" "through"
32 "throughout" "thru" "thruout" "till" "times" "to" "toward" "towards" "under"
33 "underneath" "unlike" "until" "unto" "up" "upon" "v." "versus" "via"
34 "vis-à-vis" "vs." "w." "w/" "w/i" "w/o" "wanting" "with" "within"
35 "without")
36 "List of prepositions in English.
37This list is, by necessity, incomplete, even though prepositions
38are a closed lexical group in the English language. This list
39was pulled and culled from
40https://en.wikipedia.org/wiki/List_of_English_prepositions.")
41
42(defvar titlecase-articles '("a" "an" "the")
43 "List of articles in English.")
44
45(defvar titlecase-coordinating-conjunctions '("for" "and" "nor" "but" "or"
46 "yet" "so")
47 "List of coordinating conjunctions in English.")
48
49(defvar titlecase-lowercase-chicago (append titlecase-articles
50 titlecase-prepositions
51 titlecase-coordinating-conjunctions)
52 "Words to lowercase in Chicago Style.
53Include: articles, coordinating conjunctions, prepositions, and
54\"to\" in an infinitive (though that's caught as a preposition).")
55
56(defvar titlecase-lowercase-apa (append titlecase-articles
57 (seq-filter (lambda (p)
58 (< (length p) 4))
59 titlecase-prepositions))
60 "Words to lowercase in APA Style.")
61
62(defvar titlecase-lowercase-mla (append titlecase-articles
63 titlecase-prepositions
64 titlecase-coordinating-conjunctions)
65 "Words to lowercase in MLA Style.")
66
67(defvar titlecase-lowercase-ap (append titlecase-articles
68 (seq-filter (lambda (p)
69 (< (length p) 4))
70 titlecase-prepositions)
71 (seq-filter
72 (lambda (p)
73 (< (length p) 4))
74 titlecase-coordinating-conjunctions))
75 "Words to lowercase in AP Style.")
76
77(defvar titlecase-lowercase-bluebook (append titlecase-articles
78 titlecase-coordinating-conjunctions
79 (seq-filter
80 (lambda (p)
81 (< (length p) 4))
82 titlecase-prepositions))
83 "Words to lowercase in Bluebook Style.")
84
85(defvar titlecase-lowercase-ama (append titlecase-articles
86 titlecase-coordinating-conjunctions
87 (seq-filter (lambda (p)
88 (< (length p) 4))
89 titlecase-prepositions))
90 "Words to lowercase in AMA Style.")
91
92(defvar titlecase-lowercase-nyt (append titlecase-articles
93 titlecase-prepositions
94 titlecase-coordinating-conjunctions)
95 "Words to lowercase in New York Times Style.")
96
97(defvar titlecase-lowercase-wikipedia
98 (append titlecase-articles
99 (seq-filter (lambda (p) (< (length p) 5)) titlecase-prepositions)
100 titlecase-coordinating-conjunctions)
101 "Words to lowercase in Wikipedia Style.")
102
103(defcustom titlecase-style 'chicago
104 "Which style to use when titlecasing."
105 :type '(choice (const :tag "Chicago Style" chicago)
106 (const :tag "APA Style" apa)
107 (const :tag "MLA Style" mla)
108 (const :tag "AP Style" ap)
109 (const :tag "Bluebook Style" bluebook)
110 (const :tag "AMA Style" ama)
111 (const :tag "New York Times Style" nyt)
112 (const :tag "Wikipedia Style" wikipedia)))
113
114(defun titlecase--normalize (begin end)
115 "Normalize region from BEGIN to END."
116 (goto-char begin)
117 (unless (re-search-forward "[a-z]" end :noerror)
118 (downcase-region begin end)))
119
120(defun titlecase--capitalize-first-word (begin end)
121 "Capitalize the first word of region from BEGIN to END."
122 (goto-char begin)
123 (capitalize-word 1))
124
125(defun titlecase--capitalize-last-word (begin end)
126 "Capitalize the last word of region from BEGIN to END."
127 (goto-char end)
128 (backward-word 1)
129 (when (and (>= (point) begin))
130 (capitalize-word 1)))
131
132
133
134
135(defun titlecase-region-with-style (begin end style)
136 "Titlecase the region of English text from BEGIN to END, using STYLE."
137 (interactive "*r")
138 (save-excursion
139 (goto-char begin)
140 ;; If the region is in ALL-CAPS, normalize it first
141 (unless (re-search-forward "[a-z]" end :noerror)
142 (downcase-region begin end))
143 (goto-char begin) ; gotta go back to the beginning
144 (let (;; Constants during this function's runtime
145 (case-fold-search nil)
146 (downcase-word-list (symbol-value
147 (intern (format "titlecase-lowercase-%s"
148 style))))
149 ;; State variables
150 (this-word (current-word))
151 (force-capitalize t))
152 ;; And loop over the rest
153 (while (< (point) end)
154 (setq this-word (current-word))
155 (cond
156 ;; Skip ALL-CAPS words
157 ((string-match "^[A-Z]+$" this-word) (forward-word 1))
158 ;; Force capitalization if `force-capitalize' is t
159 (force-capitalize (progn (capitalize-word 1)
160 (setq force-capitalize nil)))
161 ;; Special rules for different styles
162 ((and (memq style '(ap))
163 (> (length this-word) 3))
164 (capitalize-word 1))
165 ;; Downcase words that should be
166 ((member (downcase this-word) downcase-word-list)
167 (downcase-word 1))
168 ;; Otherwise, capitalize the word
169 (t (capitalize-word 1)))
170 ;; If the word ends with a :, ., ?, newline, or carriage-return, force
171 ;; the next word to be capitalized.
172 (when (looking-at "[:.?;\n\r]")
173 (setq force-capitalize t))
174 (skip-syntax-forward "^w" end))
175 ;; Capitalize the last word, only in some styles
176 (when (memq style '(chicago ap bluebook ama nyt wikipedia))
177 (backward-word 1)
178 (when (and (>= (point) begin))
179 (capitalize-word 1))))))
180
181;;;###autoload
182(defun titlecase-region (begin end)
183 "Titlecase the region of English text from BEGIN to END.
184Uses the style provided in `titlecase-style'."
185 (interactive "*r")
186 (titlecase-region-with-style begin end titlecase-style))
187
188;;;###autoload
189(defun titlecase-dwim ()
190 "Titlecase either the region, if active, or the current line."
191 (interactive)
192 (if (region-active-p)
193 (titlecase-region (region-beginning) (region-end))
194 (titlecase-region (point-at-bol) (point-at-eol))))
195
196(provide 'titlecase)
197;;; titlecase.el ends here