;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/emacs-init/buffer-crunch.el [version 0.3.2]
;;
;; Examples:
;;
;; (buffer-words)

(require 'cl-lib)
(require 'dwim)
(require 'thingatpt)

(defun strings-tidy (strs)
  (remove "" (cl-remove-duplicates (sort strs) :test #'string=)))

(defun wash-string (str)
  (string-trim (replace-regexp-in-string "[\n\t[:space:]]+" " " str)))

(defun buffer-paragraphs (&optional beg end)
  (interactive (use-region))
  (or beg (setq beg (point-min)))
  (or end (setq end (point-max)))
  (let ((next #'forward-paragraph)
        (read (lambda () (thing-at-point 'sentence t))))
    (buffer-crunch next read beg end)))

(defun buffer-words (&optional beg end)
  (interactive (use-region))
  (or beg (setq beg (point-min)))
  (or end (setq end (point-max)))
  (let ((next #'forward-word)
        (read (lambda () (word-at-point t))))
    (buffer-crunch next read beg end)))

(defun buffer-crunch (next &optional read beg end)
  (or beg (setq beg (point-min)))
  (or end (setq end (point-max)))
  (save-mark-and-excursion
    (goto-char beg)
    (cl-loop
      with strs
      with fst
      with otr
      with mov = t
      while (and (< (point) end) mov) do
        (setq fst (point))
        (condition-case nil
            (funcall next)
          (error (goto-char end)))
        (when (< end (point))
          (goto-char end))
        (setq otr (point))
        (if (< fst otr)
            (let ((new (if read
                           (funcall read)
                         (buffer-substring-no-properties fst otr))))
              (when new
                (push new strs)))
          (setq mov nil))
      finally return (strings-tidy (mapcar #'wash-string strs)))))

(provide 'buffer-crunch)