Re: buffer-crunch.el

[Emanuel Berg <incal@dataswamp.org>]

This is version 0.2.1, same URL. Hit the reload button until
you see it or force your cache to empty first.

I have removed a couple of complicated things and made them
into set functions.

Don't know how much faster it became but the code
looks cooler.

I also tried it against the old 'buffer-sentences' which was
dedicated `sentence-at-point' and `forward-sentence', and
inputting those as 'read' and 'next' yields the same result.

So all good! But I'm sure it can be improved still.

;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/emacs-init/buffer-crunch.el [version 0.2.1]
;;
;; All features shown as examples:
;;
;; 1. Just a forward function:
;;
;; (buffer-crunch #'forward-line)
;;
;; 2. A forward function and endpoints:
;;
;; (buffer-crunch #'forward-word nil 10 100)
;;
;; 3. A forward function and a custom read function:
;;
;; (buffer-crunch #'forward-word (lambda () (word-at-point t)))
;;
;; 4. A custom forward function and custom read function:
;;    This forward function will overflow the buffer, but
;;    that isn't a problem here.
;;
;; (buffer-crunch (lambda () (forward-char 42)) (lambda () (word-at-point t)))

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

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

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

(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 fst
      with otr
      with strs
      with mov = t
      while (and (< (point) end) mov) do
        (setq fst (point))
        (condition-case nil
            (apply next nil)
          (error (goto-char end)) )
        (setq otr (point))
        (if (< fst otr)
            (push (or (and read (apply read nil))
                      (buffer-substring-no-properties fst otr) )
                  strs)
          (setq mov nil) )
      finally return (strings-tidy (cl-map 'list #'wash-string strs)) )))

(provide 'buffer-crunch)

-- 
underground experts united
https://dataswamp.org/~incal