buffer-crunch.el

buffer-crunch.el

[Emanuel Berg]

In the thread `buffer-sentences' some 5 days ago I wrote:

  Here, one can also think of a general buffer parsing
  function, where you could submit what unit you would like it
  to be split up into.

Here is an attempt at doing just that!

The examples just below show most of the features.
There is a 'next' function to go forward, an optional explicit
'read' function - that is, not doing that based on 'next'
movements - there is also optional endpoints, and more.

Enjoy, I'll see if I can improve it with your help.

;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/emacs-init/buffer-crunch.el
;;
;; 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 0 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-make-tidy (strs)
  (let ((tst #'string=))
    (cl-remove "" (cl-remove-duplicates (sort strs) :test tst) :test tst) ))

(defun wash-part (str &optional end)
  (when (numberp str)
    (setq str (buffer-substring-no-properties str end)) )
  (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 (wash-part (or (and read (apply read nil)) fst) otr) strs)
          (setq mov nil) )
      finally return (strings-make-tidy strs) )))

(provide 'buffer-crunch)

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

Re: buffer-crunch.el

[Emanuel Berg]

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

Re: buffer-crunch.el

[Emanuel Berg]

OK, look for version 0.3.2.

I removed a bunch of cl-stuff that was fine with just stuff -
I hope.

Also replaced `apply' with `funcall' to not have the trailing
nil argument - ugly - IIRC those were both harmless, right, it
was `eval' one should avoid?

Now the code looks pretty clean! But looks can be deceiving ...

The next step is just to add a bunch of specific interfaces to
call it.

;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/emacs-init/buffer-crunch.el [version 0.3.2]
;;
;; 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)
  (remove "" (cl-remove-duplicates (sort strs) :test #'string=)) )

(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 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)) )
        (setq otr (point))
        (if (< fst otr)
            (push (or (and read (funcall read))
                      (buffer-substring-no-properties fst otr) )
                  strs)
          (setq mov nil) )
      finally return (strings-tidy (mapcar #'wash-string strs)) )))

(provide 'buffer-crunch)

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