From 4ff75149d1531fbcc48f0f60f28498811d3e9faf Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sun, 26 Dec 2021 22:48:45 -0600 Subject: Make titlecase a proper package --- lisp/titlecase.el | 197 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 197 insertions(+) create mode 100644 lisp/titlecase.el (limited to 'lisp/titlecase.el') 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 @@ +;;; titlecase.el --- title-case phrases -*- lexical-binding: t; -*- + +;;; Commentary: + +;; adapted from https://hungyi.net/posts/programmers-way-to-title-case/ + +;;; Code: + +(require 'seq) + +(defgroup titlecase nil + "Customizations for titlecasing phrases." + :prefix "titlecase-" + :group 'text) + +;;; Lists of words /never/ to capitalize + +(defvar titlecase-prepositions + '("'thout" "'tween" "aboard" "about" "above" + "abreast" "absent" "abt." "across" "after" "against" "ago" "aloft" "along" + "alongside" "amid" "amidst" "among" "amongst" "anti" "apart" "apropos" + "around" "as" "aside" "aslant" "astride" "at" "atop" "away" "before" + "behind" "below" "beneath" "beside" "besides" "between" "beyond" "but" "by" + "c." "ca." "circa" "come" "concerning" "contra" "counting" "cum" "despite" + "down" "during" "effective" "ere" "except" "excepting" "excluding" "failing" + "following" "for" "from" "hence" "in" "including" "inside" "into" "less" + "like" "mid" "midst" "minus" "mod" "modulo" "near" "nearer" "nearest" + "neath" "next" "notwithstanding" "o'" "o'er" "of" "off" "offshore" "on" + "onto" "ontop" "opposite" "out" "outside" "over" "pace" "past" "pending" + "per" "plus" "post" "pre" "pro" "qua" "re" "regarding" "respecting" "round" + "sans" "save" "saving" "short" "since" "sub" "t'" "than" "through" + "throughout" "thru" "thruout" "till" "times" "to" "toward" "towards" "under" + "underneath" "unlike" "until" "unto" "up" "upon" "v." "versus" "via" + "vis-à-vis" "vs." "w." "w/" "w/i" "w/o" "wanting" "with" "within" + "without") + "List of prepositions in English. +This list is, by necessity, incomplete, even though prepositions +are a closed lexical group in the English language. This list +was pulled and culled from +https://en.wikipedia.org/wiki/List_of_English_prepositions.") + +(defvar titlecase-articles '("a" "an" "the") + "List of articles in English.") + +(defvar titlecase-coordinating-conjunctions '("for" "and" "nor" "but" "or" + "yet" "so") + "List of coordinating conjunctions in English.") + +(defvar titlecase-lowercase-chicago (append titlecase-articles + titlecase-prepositions + titlecase-coordinating-conjunctions) + "Words to lowercase in Chicago Style. +Include: articles, coordinating conjunctions, prepositions, and +\"to\" in an infinitive (though that's caught as a preposition).") + +(defvar titlecase-lowercase-apa (append titlecase-articles + (seq-filter (lambda (p) + (< (length p) 4)) + titlecase-prepositions)) + "Words to lowercase in APA Style.") + +(defvar titlecase-lowercase-mla (append titlecase-articles + titlecase-prepositions + titlecase-coordinating-conjunctions) + "Words to lowercase in MLA Style.") + +(defvar titlecase-lowercase-ap (append titlecase-articles + (seq-filter (lambda (p) + (< (length p) 4)) + titlecase-prepositions) + (seq-filter + (lambda (p) + (< (length p) 4)) + titlecase-coordinating-conjunctions)) + "Words to lowercase in AP Style.") + +(defvar titlecase-lowercase-bluebook (append titlecase-articles + titlecase-coordinating-conjunctions + (seq-filter + (lambda (p) + (< (length p) 4)) + titlecase-prepositions)) + "Words to lowercase in Bluebook Style.") + +(defvar titlecase-lowercase-ama (append titlecase-articles + titlecase-coordinating-conjunctions + (seq-filter (lambda (p) + (< (length p) 4)) + titlecase-prepositions)) + "Words to lowercase in AMA Style.") + +(defvar titlecase-lowercase-nyt (append titlecase-articles + titlecase-prepositions + titlecase-coordinating-conjunctions) + "Words to lowercase in New York Times Style.") + +(defvar titlecase-lowercase-wikipedia + (append titlecase-articles + (seq-filter (lambda (p) (< (length p) 5)) titlecase-prepositions) + titlecase-coordinating-conjunctions) + "Words to lowercase in Wikipedia Style.") + +(defcustom titlecase-style 'chicago + "Which style to use when titlecasing." + :type '(choice (const :tag "Chicago Style" chicago) + (const :tag "APA Style" apa) + (const :tag "MLA Style" mla) + (const :tag "AP Style" ap) + (const :tag "Bluebook Style" bluebook) + (const :tag "AMA Style" ama) + (const :tag "New York Times Style" nyt) + (const :tag "Wikipedia Style" wikipedia))) + +(defun titlecase--normalize (begin end) + "Normalize region from BEGIN to END." + (goto-char begin) + (unless (re-search-forward "[a-z]" end :noerror) + (downcase-region begin end))) + +(defun titlecase--capitalize-first-word (begin end) + "Capitalize the first word of region from BEGIN to END." + (goto-char begin) + (capitalize-word 1)) + +(defun titlecase--capitalize-last-word (begin end) + "Capitalize the last word of region from BEGIN to END." + (goto-char end) + (backward-word 1) + (when (and (>= (point) begin)) + (capitalize-word 1))) + + + + +(defun titlecase-region-with-style (begin end style) + "Titlecase the region of English text from BEGIN to END, using STYLE." + (interactive "*r") + (save-excursion + (goto-char begin) + ;; If the region is in ALL-CAPS, normalize it first + (unless (re-search-forward "[a-z]" end :noerror) + (downcase-region begin end)) + (goto-char begin) ; gotta go back to the beginning + (let (;; Constants during this function's runtime + (case-fold-search nil) + (downcase-word-list (symbol-value + (intern (format "titlecase-lowercase-%s" + style)))) + ;; State variables + (this-word (current-word)) + (force-capitalize t)) + ;; And loop over the rest + (while (< (point) end) + (setq this-word (current-word)) + (cond + ;; Skip ALL-CAPS words + ((string-match "^[A-Z]+$" this-word) (forward-word 1)) + ;; Force capitalization if `force-capitalize' is t + (force-capitalize (progn (capitalize-word 1) + (setq force-capitalize nil))) + ;; Special rules for different styles + ((and (memq style '(ap)) + (> (length this-word) 3)) + (capitalize-word 1)) + ;; Downcase words that should be + ((member (downcase this-word) downcase-word-list) + (downcase-word 1)) + ;; Otherwise, capitalize the word + (t (capitalize-word 1))) + ;; If the word ends with a :, ., ?, newline, or carriage-return, force + ;; the next word to be capitalized. + (when (looking-at "[:.?;\n\r]") + (setq force-capitalize t)) + (skip-syntax-forward "^w" end)) + ;; Capitalize the last word, only in some styles + (when (memq style '(chicago ap bluebook ama nyt wikipedia)) + (backward-word 1) + (when (and (>= (point) begin)) + (capitalize-word 1)))))) + +;;;###autoload +(defun titlecase-region (begin end) + "Titlecase the region of English text from BEGIN to END. +Uses the style provided in `titlecase-style'." + (interactive "*r") + (titlecase-region-with-style begin end titlecase-style)) + +;;;###autoload +(defun titlecase-dwim () + "Titlecase either the region, if active, or the current line." + (interactive) + (if (region-active-p) + (titlecase-region (region-beginning) (region-end)) + (titlecase-region (point-at-bol) (point-at-eol)))) + +(provide 'titlecase) +;;; titlecase.el ends here -- cgit 1.4.1-21-gabe81