;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/emacs-init/pos.el
;;
;; segments:
;;   buff-
;;   para-
;;   sent-
;;   word-
;;   char-
;;
;; supports:
;;   -reg
;;   -beg -end
;;   -bop -eop
;;   -cur
;;   -len
;;   goto-*-beg goto-*-end
;;   -next -prev
;;
;; also:
;;   (pos--all-in SEG_SMALL SEG_BIG)

(require 'cl-lib)

(defun pos--wash-str (str)
  (string-trim
    (replace-regexp-in-string "%" "%%"
      (replace-regexp-in-string "[\n[:blank:]]+" " " str))))

;; -----------------------------------------------------------------------

(defun pos--all-in-f (goto-beg end cur next)
  (when (cl-every #'functionp (list goto-beg end cur next))
    (funcall goto-beg)
    (let ((end (funcall end))
          (res))
      (while (< (point) end)
        (push (funcall cur) res)
        (funcall next))
      (nreverse res))))

(defmacro pos--all-in (seg in)
  (let ( (goto-beg (intern (format "goto-%s-beg" in)))
         (end      (intern (format "%s-end"      in)))
         (cur      (intern (format "%s-cur"      seg)))
         (next     (intern (format "%s-next"     seg))) )
    `(pos--all-in-f (quote ,goto-beg)
                    (quote ,end)
                    (quote ,cur)
                    (quote ,next))))

;; -----------------------------------------------------------------------

(defmacro pos--def (name spn)
  (let ((reg (intern (format "%s-reg" name)))
        (beg (intern (format "%s-beg" name)))
        (end (intern (format "%s-end" name)))
        (cur (intern (format "%s-cur" name)))
        (len (intern (format "%s-len" name)))
        (bop (intern (format "%s-bop" name)))
        (eop (intern (format "%s-eop" name)))
        (goto-beg (intern (format "goto-%s-beg" name)))
        (goto-end (intern (format "goto-%s-end" name)))
        (next (intern (format "%s-next" name)))
        (prev (intern (format "%s-prev" name))))
    `(progn
       (defun ,reg () (pos--reg ,spn))
       (defun ,beg () (pos--beg ,spn))
       (defun ,end () (pos--end ,spn))
       (defun ,cur () (pos--cur ,spn))
       (defun ,len () (pos--len ,spn))
       (defun ,bop () (pos--bop ,spn))
       (defun ,eop () (pos--eop ,spn))
       (defun ,goto-beg () (interactive) (pos--goto-beg ,spn))
       (defun ,goto-end () (interactive) (pos--goto-end ,spn))
       (when (= 3 (length ,spn))
         (defun ,next (&optional n) (interactive "p") (pos--next ,spn n))
         (defun ,prev (&optional n) (interactive "p") (pos--prev ,spn n))))))

(defun pos--reg (spn &optional def)
  (pcase-let* ((`(,beg ,end ,next) spn))
    (if def
        (list beg end next)
      (list beg end))))

(defun pos--beg (spn)
  (car (pos--reg spn)))

(defun pos--end (spn)
  (cadr (pos--reg spn)))

(defun pos--cur (spn)
  (pcase-let* ((`(,beg ,end) (pos--reg spn))
               (cur (pos--wash-str (buffer-substring-no-properties beg end))))
    cur))

(defun pos--len (spn)
  (- (pos--end spn) (pos--beg spn)))

(defun pos--bop (spn)
  (= (point) (pos--beg spn)))

(defun pos--eop (spn)
  (= (point) (pos--end spn)))

(defun pos--goto-beg (spn)
  (goto-char (pos--beg spn)))

(defun pos--goto-end (spn)
  (goto-char (pos--end spn)))

(defun pos--next (spn &optional n)
  (or n (setq n 1))
  (pcase-let* ((`(,_beg ,_end ,next) (pos--reg spn t)))
    (when (functionp next)
      (funcall next n))))

(defun pos--prev (spn &optional n)
  (or n (setq n 1))
  (pcase-let* ((`(,_beg ,_end ,next) (pos--reg spn t)))
    (when (functionp next)
      (funcall next (* -1 n)))))

;; -----------------------------------------------------------------------

(defun pos--buff ()
  (list (point-min) (point-max)))

(defun pos--para ()
  (save-mark-and-excursion
    (let ((end (progn (end-of-paragraph-text)   (point)))
          (beg (progn (start-of-paragraph-text) (point))))
      (list beg end #'forward-paragraph))))

(defun pos--sent ()
  (save-mark-and-excursion
    (let ((end (forward-sentence))
          (beg (forward-sentence -1)))
      (list beg end #'forward-sentence))))

(defun pos--word ()
  (save-mark-and-excursion
    (let ((end (progn (forward-word)    (point)))
          (beg (progn (forward-word -1) (point))))
      (list beg end #'forward-word))))

(defun pos--char ()
  (save-mark-and-excursion
    (let ((beg (point))
          (end (progn (forward-char) (point))))
      (list beg end #'forward-char))))

;; -----------------------------------------------------------------------

(when nil
  (pos--def "buff" (pos--buff))
  (pos--def "para" (pos--para))
  (pos--def "sent" (pos--sent))
  (pos--def "word" (pos--word))
  (pos--def "char" (pos--char))
  )

(when nil
  ;; for buff-, para-, sent-, word-, and char-
  (word-reg)
  (word-beg)
  (word-end)
  (word-cur)
  (word-len)
  (word-bop)
  (word-eop)

  ;; M-x
  (goto-word-beg)
  (goto-word-end)

  ;; for para-, sent-, word-, char-
  ;; with C-u M-x and C-u n M-x
  (word-next)
  (word-next 5)
  (word-prev)
  (word-prev 5)
  (pos--all-in word sent) ; all combinations
)

(provide 'pos)