;;; custom-case.el --- Custom Functions Handling Text Case -*- coding: utf-8; lexical-binding: t; -*-

;;; Commentary:
;;
;; Utilities for changing text case.
;; - cj/title-case-region: Title-cases the active region, or the current line if
;;   no region. Follows common English rules: major words capitalized; minor words
;;   (a, an, and, as, at, but, by, for, if, in, is, nor, of, on, or, so, the, to, yet)
;;   lowercased except at the start or after :, !, or ?. Avoids capitalizing
;;   immediately after separators like -, \, ' or .; downcases first, then fixes caps.
;; - cj/upcase-dwim / cj/downcase-dwim: operate on the region, or on the symbol at
;;   point when no region is active.
;;
;; Integration: remaps capitalize-region to cj/title-case-region and exposes a case
;; submenu on cj/custom-keymap under "c": t (title), u (upcase), l (downcase).
;;
;;; Code:

(eval-when-compile (defvar cj/custom-keymap)) ;; cj/custom-keymap defined in keybindings.el

(defun cj/upcase-dwim ()
  "Upcase the active region, or upcase the symbol at point if no region."
  (interactive)
  (if (use-region-p)
	  (upcase-region (region-beginning) (region-end))
	(let ((bounds (bounds-of-thing-at-point 'symbol)))
	  (if bounds
		  (upcase-region (car bounds) (cdr bounds))
		(user-error "No symbol at point")))))

(defun cj/downcase-dwim ()
  "Downcase the active region, or downcase the symbol at point if no region."
  (interactive)
  (if (use-region-p)
	  (downcase-region (region-beginning) (region-end))
	(let ((bounds (bounds-of-thing-at-point 'symbol)))
	  (if bounds
		  (downcase-region (car bounds) (cdr bounds))
		(user-error "No symbol at point")))))

(defun cj/title-case-region ()
  "Capitalize the region in title case format.
Title case is a capitalization convention where major words are capitalized,
and most minor words are lowercase.  Nouns, verbs (including linking verbs),
adjectives, adverbs,pronouns, and all words of four letters or more are
considered major words. Short (i.e., three letters or fewer) conjunctions,
short prepositions, and all articles are considered minor words."
  (interactive)
  (let ((beg nil)
		(end nil)
		(prev-word-end nil)
		;; Allow capitals for skip characters after this, so:
		;;   Warning: An Example
		;; Capitalizes the `An'.
		(chars-skip-reset '(?: ?! ??))
		;; Don't capitalize characters directly after these. e.g.
		;; "Foo-bar" or "Foo\bar" or "Foo's".

		(chars-separator '(?\\ ?- ?' ?.))

		(word-chars "[:alnum:]")
		(word-skip
		 (list "a" "an" "and" "as" "at" "but" "by"
			   "for" "if" "in" "is" "nor" "of"
			   "on" "or" "so" "the" "to" "yet"))
		(is-first t))
	(cond
	 ((region-active-p)
	  (setq beg (region-beginning))
	  (setq end (region-end)))
	 (t
	  (setq beg (line-beginning-position))
	  (setq end (line-end-position))))
	(save-excursion
	  ;; work on uppercased text (e.g., headlines) by downcasing first
	  (downcase-region beg end)
	  (goto-char beg)

	  (while (< (point) end)
		(setq prev-word-end (point))
		(skip-chars-forward (concat "^" word-chars) end)
		(let ((word-end
			   (save-excursion
				 (skip-chars-forward word-chars end)
				 (point))))

		  (unless (memq (char-before (point)) chars-separator)
			(let* ((c-orig (char-to-string (char-after (point))))
				   (c-up (capitalize c-orig)))
			  (unless (string-equal c-orig c-up)
				(let ((word (buffer-substring-no-properties (point) word-end)))
				  (when
					  (or
					   ;; Always allow capitalization.
					   is-first
					   ;; If it's not a skip word, allow.
					   (not (member word word-skip))
					   ;; Check the beginning of the previous word doesn't reset first.
					   (save-excursion
						 (and
						  (not (zerop
								(skip-chars-backward "[:blank:]" prev-word-end)))
						  (memq (char-before (point)) chars-skip-reset))))
					(delete-region (point) (1+ (point)))
					(insert c-up))))))
		  (goto-char word-end)
		  (setq is-first nil))))))

;; replace the capitalize-region keybinding to call title-case
(keymap-global-set "<remap> <capitalize-region>" #'cj/title-case-region)

;; Case-change operations prefix and keymap
(defvar-keymap cj/case-map
  :doc "Keymap for case-change operations"
  "t" #'cj/title-case-region
  "u" #'cj/upcase-dwim
  "l" #'cj/downcase-dwim)
(keymap-set cj/custom-keymap "c" cj/case-map)

(with-eval-after-load 'which-key
  (which-key-add-key-based-replacements "C-; c" "case change menu"))

(provide 'custom-case)
;;; custom-case.el ends here.