├── dev ├── .nosearch ├── Makefile ├── doc-gen.el ├── README.txt └── fudge-discover.el ├── test ├── case-match.txt ├── with-temp-buffer.txt ├── line-start.txt ├── nth.txt ├── one-two-three.txt ├── match-data.txt ├── sentence-end.txt ├── Makefile ├── m-buffer-init.el ├── m-buffer-at-test.el └── m-buffer-test.el ├── .ert-runner ├── .dir-locals.el ├── .gitignore ├── Cask ├── .travis.yml ├── Makefile ├── m-buffer-at.el ├── m-buffer-doc.org ├── m-buffer-benchmark.els ├── m-buffer-macro.el ├── README.md └── m-buffer.el /dev/.nosearch: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /test/case-match.txt: -------------------------------------------------------------------------------- 1 | A 2 | a 3 | A 4 | a 5 | -------------------------------------------------------------------------------- /test/with-temp-buffer.txt: -------------------------------------------------------------------------------- 1 | one 2 | two 3 | three 4 | -------------------------------------------------------------------------------- /test/line-start.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 1 4 | 1 5 | 22 6 | 22 7 | -------------------------------------------------------------------------------- /test/nth.txt: -------------------------------------------------------------------------------- 1 | onetwo 2 | onetwo 3 | onetwo 4 | onetwo 5 | -------------------------------------------------------------------------------- /test/one-two-three.txt: -------------------------------------------------------------------------------- 1 | one 2 | two 3 | one 4 | three 5 | -------------------------------------------------------------------------------- /.ert-runner: -------------------------------------------------------------------------------- 1 | --load m-buffer-macro.el m-buffer.el m-buffer-at.el -------------------------------------------------------------------------------- /test/match-data.txt: -------------------------------------------------------------------------------- 1 | one 2 | two 3 | one 4 | two 5 | one 6 | two 7 | -------------------------------------------------------------------------------- /test/sentence-end.txt: -------------------------------------------------------------------------------- 1 | First sentence. 2 | Second sentence. 3 | Third sentence. 4 | -------------------------------------------------------------------------------- /test/Makefile: -------------------------------------------------------------------------------- 1 | ## what ever we called, don't do it here 2 | $(MAKECMDGOALS): 3 | $(MAKE) -C .. $(MAKECMDGOALS) 4 | -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ;;; Directory Local Variables 2 | ;;; For more information see (info "(emacs) Directory Variables") 3 | 4 | ((emacs-lisp-mode 5 | (lentic-init . lentic-orgel-org-init))) 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.cask/ 2 | m-buffer*org 3 | !m-buffer-doc.org 4 | m-buffer-doc.texi 5 | *html 6 | *elc 7 | /dist/ 8 | /org/ 9 | 10 | # ELPA-generated files 11 | /m-buffer-pkg.el 12 | /m-buffer-autoloads.el 13 | -------------------------------------------------------------------------------- /test/m-buffer-init.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. 4 | 5 | (defvar m-buffer-init-path 6 | (directory-file-name 7 | (file-name-directory load-file-name))) 8 | 9 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source gnu) 2 | (source melpa-stable) 3 | 4 | (package-file "m-buffer.el") 5 | (files "m-buffer*el" "m-buffer*els" "m-buffer-doc.org" "m-buffer-doc.css") 6 | 7 | (development 8 | (depends-on "htmlize") 9 | (depends-on "lentic") 10 | (depends-on "load-relative")) 11 | -------------------------------------------------------------------------------- /dev/Makefile: -------------------------------------------------------------------------------- 1 | 2 | gen-discover: 3 | ## This obviously depends on assess being available and in the 4 | ## right location 5 | cp ../../assess/assess-discover.el . 6 | perl -i -pe 's/assess-discover/fudge-discover/g' assess-discover.el 7 | mv assess-discover.el fudge-discover.el 8 | -------------------------------------------------------------------------------- /dev/doc-gen.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022-2024 Free Software Foundation, Inc. 4 | 5 | (require 'm-buffer-macro) 6 | (require 'm-buffer) 7 | (require 'm-buffer-at) 8 | 9 | (require 'lentic-doc nil t) 10 | 11 | (defun doc-gen () 12 | (lentic-doc-htmlify-package 'm-buffer)) 13 | -------------------------------------------------------------------------------- /dev/README.txt: -------------------------------------------------------------------------------- 1 | fudge-discover.el is a subset of my http://github.com/phillord/assess 2 | package, with the namespace, erm, fudged to something else. 3 | 4 | If you wish to use my assess package, you do not need to go to such 5 | lengths. I need to do such hackery here because (the rest of) assess 6 | uses m-buffer, and introducing a circular dependency at this point 7 | makes life really complicated. 8 | 9 | https://github.com/phillord/m-buffer-el/pull/6 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: generic 2 | sudo: no 3 | env: 4 | - EVM_EMACS=emacs-24.1-travis 5 | - EVM_EMACS=emacs-24.2-travis 6 | - EVM_EMACS=emacs-24.3-travis 7 | - EVM_EMACS=emacs-24.4-travis 8 | - EVM_EMACS=emacs-24.5-travis 9 | - EVM_EMACS=emacs-25.1-travis 10 | install: 11 | - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > travis.sh && source ./travis.sh 12 | - evm install $EVM_EMACS --use --skip 13 | - cask 14 | script: 15 | - emacs --version 16 | - make -------------------------------------------------------------------------------- /test/m-buffer-at-test.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. 4 | 5 | (require 'm-buffer-at) 6 | 7 | (ert-deftest m-buffer-at-eolp-1() 8 | (should 9 | (with-temp-buffer 10 | (insert "hello") 11 | (m-buffer-at-eolp (point-marker))))) 12 | 13 | (ert-deftest m-buffer-at-eolp-2 () 14 | (should 15 | (with-temp-buffer 16 | (insert "hello") 17 | (m-buffer-at-eolp 18 | (current-buffer) 19 | (point))))) 20 | 21 | (ert-deftest m-buffer-at-eolp-3 () 22 | (should-not 23 | (with-temp-buffer 24 | (insert "hello") 25 | (goto-char (point-min)) 26 | (m-buffer-at-eolp (point-marker))))) 27 | 28 | (ert-deftest m-buffer-at-eolp-4 () 29 | (should-not 30 | (with-temp-buffer 31 | (insert "hello") 32 | (goto-char (point-min)) 33 | (m-buffer-at-eolp 34 | (current-buffer) 35 | (point))))) 36 | 37 | (ert-deftest m-buffer-string () 38 | (should 39 | (string= 40 | "hello" 41 | (with-temp-buffer 42 | (insert "hello") 43 | (m-buffer-at-string (current-buffer)))))) 44 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | CASK ?= cask 3 | 4 | EMACSES=there-is-no-sensible-default-here 5 | 6 | -include makefile-local 7 | 8 | ifdef EMACS 9 | EMACS_ENV=EMACS="$(EMACS)" 10 | endif 11 | 12 | 13 | all: test 14 | 15 | install: 16 | $(EMACS_ENV) $(CASK) install 17 | 18 | just-test: 19 | $(EMACS_ENV) $(CASK) $(EMACS) --batch \ 20 | --directory="$(PWD)" \ 21 | --load "dev/fudge-discover" \ 22 | --funcall fudge-discover-run-and-exit-batch 23 | 24 | test: install just-test 25 | 26 | package: 27 | $(EMACS_ENV) $(CASK) package 28 | 29 | doc-gen: 30 | $(EMACS_ENV) $(CASK) $(EMACS) --batch \ 31 | --directory="$(PWD)" \ 32 | -l dev/doc-gen.el -f doc-gen 33 | 34 | publish-doc: ../m-buffer-pages/index.html ../m-buffer-pages/m-buffer-doc.css 35 | 36 | ../m-buffer-pages/m-buffer-doc.css: m-buffer-doc.css 37 | cp $< $@ 38 | 39 | ../m-buffer-pages/index.html: m-buffer-doc.html 40 | perl -p -e 's#["]http://orgmode.org/org-info.js#"./org-info.js#' \ 41 | $< > $@ 42 | 43 | m-buffer-doc.html: m-buffer-doc.org m-buffer.el m-buffer-at.el m-buffer-macro.el 44 | $(MAKE) doc-gen 45 | 46 | clean: 47 | find . -name "m-buffer*org" -not -name "m-buffer-doc.org" \ 48 | -exec rm {} \; 49 | - rm m-buffer-doc.html 50 | 51 | multi-test: 52 | make EMACS=$(EMACSES)/master/src/emacs test 53 | make EMACS=$(EMACSES)/emacs-25/src/emacs test 54 | make EMACS=$(EMACSES)/emacs-25.1/src/emacs test 55 | make EMACS=$(EMACSES)/emacs-24.5/src/emacs test 56 | make EMACS=$(EMACSES)/emacs-24.4/src/emacs test 57 | make EMACS=$(EMACSES)/emacs-24.3/src/emacs test 58 | make EMACS=$(EMACSES)/emacs-24.2/src/emacs test 59 | make EMACS=$(EMACSES)/emacs-24.1/src/emacs test 60 | 61 | .PHONY: test 62 | -------------------------------------------------------------------------------- /m-buffer-at.el: -------------------------------------------------------------------------------- 1 | ;;; m-buffer-at.el --- Stateless point functions -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; This file is not part of Emacs 6 | 7 | ;; The contents of this file are subject to the GPL License, Version 3.0. 8 | 9 | ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. 10 | 11 | ;; This program is free software: you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;; Provides stateless equivalents to many core Emacs functions, that provide 27 | ;; information about a buffer. Most of these functions take either a buffer as 28 | ;; a parameter or a location, which is either a marker (with a non-nil buffer 29 | ;; and location) or a buffer and integer. 30 | 31 | ;; These functions are generally competitive with the originals in terms of 32 | ;; speed. 33 | 34 | ;;; Status: 35 | 36 | ;; There are lots more to do, but the interface should be stable. 37 | 38 | ;;; Code: 39 | 40 | ;; #+begin_src emacs-lisp 41 | 42 | (require 'm-buffer-macro) 43 | 44 | (defun m-buffer-at-point (buffer) 45 | "Return the location of point in BUFFER. 46 | See also `point'." 47 | (with-current-buffer 48 | buffer 49 | (point))) 50 | 51 | (defun m-buffer-at-eolp (&rest location) 52 | "Return t if LOCATION is at the end of a line. 53 | See also `eolp'." 54 | (m-buffer-with-current-location 55 | location 56 | (eolp))) 57 | 58 | (defun m-buffer-at-bolp (&rest location) 59 | "Return t if LOCATION is at the begining of a line. 60 | See also `bolp'" 61 | (m-buffer-with-current-location 62 | location 63 | (bolp))) 64 | 65 | (defun m-buffer-at-line-beginning-position (&rest location) 66 | "Return the start of the line of LOCATION." 67 | (m-buffer-with-current-location 68 | location 69 | (line-beginning-position))) 70 | 71 | (defun m-buffer-at-line-end-position (&rest location) 72 | "Return the end of the line of LOCATION." 73 | (m-buffer-with-current-location 74 | location 75 | (line-end-position))) 76 | 77 | (defun m-buffer-at-narrowed-p (buffer) 78 | (with-current-buffer 79 | buffer 80 | (buffer-narrowed-p))) 81 | 82 | (defun m-buffer-at-string (buffer) 83 | (with-current-buffer 84 | buffer 85 | (buffer-string))) 86 | 87 | (provide 'm-buffer-at) 88 | ;;; m-buffer-at.el ends here 89 | ;; #+end_src 90 | -------------------------------------------------------------------------------- /dev/fudge-discover.el: -------------------------------------------------------------------------------- 1 | ;;; fudge-discover.el --- Test support functions -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; This file is not part of Emacs 6 | 7 | ;; Author: Phillip Lord 8 | ;; Maintainer: Phillip Lord 9 | 10 | ;; The contents of this file are subject to the GPL License, Version 3.0. 11 | 12 | ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. 13 | 14 | ;; This program is free software: you can redistribute it and/or modify 15 | ;; it under the terms of the GNU General Public License as published by 16 | ;; the Free Software Foundation, either version 3 of the License, or 17 | ;; (at your option) any later version. 18 | 19 | ;; This program is distributed in the hope that it will be useful, 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 | ;; GNU General Public License for more details. 23 | 24 | ;; You should have received a copy of the GNU General Public License 25 | ;; along with this program. If not, see . 26 | 27 | ;;; Code: 28 | 29 | 30 | ;; #+begin_src emacs-lisp 31 | (defun fudge-discover-tests (directory) 32 | "Discover tests in directory. 33 | 34 | Tests must conform to one (and only one!) of several naming 35 | schemes. 36 | 37 | - End with -test.el 38 | - End with -tests.el 39 | - Start with test- 40 | - Any .el file in a directory called test 41 | - Any .el file in a directory called tests 42 | 43 | Each of these is tried until one matches. So, a top-level file 44 | called \"blah-test.el\" will prevent discovery of files in a 45 | tests directory." 46 | (or 47 | ;; files with 48 | (directory-files directory nil ".*-test.el$") 49 | (directory-files directory nil ".*-tests.el$") 50 | (directory-files directory nil "test-.*.el$") 51 | (let ((dir-test 52 | (concat directory "test/"))) 53 | (when (file-exists-p dir-test) 54 | (mapcar 55 | (lambda (file) 56 | (concat dir-test file)) 57 | (directory-files dir-test nil ".*.el")))) 58 | (let ((dir-tests 59 | (concat directory "tests/"))) 60 | (when (file-exists-p dir-tests) 61 | (mapcar 62 | (lambda (file) 63 | (concat dir-tests file)) 64 | (directory-files dir-tests nil ".*.el")))))) 65 | 66 | (defun fudge-discover--load-all-tests (directory) 67 | (mapc 68 | #'load 69 | (fudge-discover-tests directory))) 70 | 71 | (defun fudge-discover-load-tests () 72 | (interactive) 73 | (fudge-discover--load-all-tests default-directory)) 74 | 75 | ;;;###autoload 76 | (defun fudge-discover-run-batch (&optional selector) 77 | (fudge-discover--load-all-tests default-directory) 78 | (ert-run-tests-batch selector)) 79 | 80 | ;;;###autoload 81 | (defun fudge-discover-run-and-exit-batch (&optional selector) 82 | (fudge-discover--load-all-tests default-directory) 83 | (ert-run-tests-batch-and-exit selector)) 84 | 85 | (provide 'fudge-discover) 86 | ;;; fudge-discover.el ends here 87 | ;; #+end_src 88 | -------------------------------------------------------------------------------- /m-buffer-doc.org: -------------------------------------------------------------------------------- 1 | 2 | #+TITLE: Manipulate the Contents of Emacs Buffers 3 | #+AUTHOR: Phillip Lord 4 | 5 | # FIXME: In Emacs≥30, we could drop most of this. 6 | #+TEXINFO_DIR_CATEGORY: Emacs 7 | #+TEXINFO_DIR_TITLE: * m-buffer: (m-buffer-doc). 8 | #+TEXINFO_DIR_DESC: Manipulate the Contents of Emacs Buffers 9 | 10 | #+INFOJS_OPT: view:info toc:nil 11 | 12 | 13 | * Introduction 14 | 15 | m-buffer provides functions for accessing and manipulating the contents of an 16 | Emacs buffer. While Emacs already provides these features, m-buffer provides a 17 | higher-level interaction. It achieves this in several ways: many of the 18 | functions are list-orientated, so avoiding the need for iteration; it avoids 19 | the use of global emacs state whenever it can be avoided, so avoiding 20 | side-effects; and it provides a large library of functions supporting common 21 | operations. 22 | 23 | Core usage of buffer m-buffer is simple. For example, the following code 24 | returns a list of all matches to the /regexp/ "m-buffer" in the 25 | `current-buffer`. 26 | 27 | #+BEGIN_SRC elisp 28 | (m-buffer-match 29 | (current-buffer) 30 | "m-buffer") 31 | #+END_SRC 32 | 33 | m-buffer is also expanding. Other parts of m-buffer provide stateless 34 | interaction with the existing buffer; for example, we can use the following to 35 | fetch the point of any buffer: 36 | 37 | #+BEGIN_SRC elisp 38 | (m-buffer-at-point buffer) 39 | #+END_SRC 40 | 41 | These functions can help greatly when writing code which operates on two or 42 | more buffers. It is also possible to check whether the status of a location -- 43 | either a buffer and position or a marker. For example, these calls are 44 | equivalent to `eolp`. 45 | 46 | #+BEGIN_SRC elisp 47 | (m-buffer-at-eolp buffer position) 48 | (m-buffer-at-eolp marker) 49 | #+END_SRC 50 | 51 | 52 | 53 | ** Status 54 | 55 | `m-buffer' is a work in progress, but much of it is now stable and the 56 | interface should change only in forward-compatible ways for 1.0 release. 57 | The individual files have statements about their stability. 58 | 59 | 60 | 61 | * m-buffer 62 | 63 | m-buffer.el provides list-orientated search both for any regexp and standard 64 | regexps, as well as the ability to do things with these matches: replace, add 65 | overlays or text-properties or, most generically of all, call any function on 66 | matches. 67 | 68 | #+include: "m-buffer.org" :minlevel 2 69 | 70 | 71 | * m-buffer-at 72 | 73 | m-buffer-at.el provides a set of stateless functions which for accessing data 74 | about buffers, without requiring changing the `current-buffer'. 75 | 76 | #+include: "m-buffer-at.org" :minlevel 2 77 | 78 | 79 | * m-buffer-macro 80 | 81 | m-buffer-macro.el provides some general purpose macros for: 82 | 83 | - dealing with markers and their cleanup 84 | - running code at a specific location 85 | 86 | #+include: "m-buffer-macro.org" :minlevel 2 87 | 88 | 89 | * m-buffer-benchmark 90 | 91 | m-buffer-benchmark.el provides no functions, but is a set of benchmarks to 92 | give some idea of how much overhead various m-buffer functions entail. 93 | 94 | #+include: "m-buffer-benchmark.org" :minlevel 2 95 | 96 | 97 | * Roadmap 98 | 99 | ** 0.11 100 | 101 | Full lentic documentation using lentic-server 102 | 103 | 104 | ** 0.12 105 | 106 | Completion of m-buffer-at with all the core buffer functions. 107 | -------------------------------------------------------------------------------- /m-buffer-benchmark.els: -------------------------------------------------------------------------------- 1 | ;;; -*- mode: emacs-lisp; lexical-binding:t -*- 2 | 3 | ;; 4 | 5 | ;;; Benchmarking: 6 | 7 | ;; This file is not meant a emacs package, but for benchmarking m-buffer. 8 | ;; To hide Emacs' there are lots of places where m-buffer saves, changes and then 9 | ;; restores this global state. One obvious question is what impact does this have 10 | ;; on performance. We check this here. 11 | 12 | ;; ** Evaluation 13 | 14 | ;; The results of running these forms are "pre-evaluated", because this file 15 | ;; forms part of the lentic documentation for m-buffer. We could evaluate 16 | ;; these at export time but, by default, this form of evaluation is blocked. 17 | ;; Moreover, it can be quite slow which would be less than ideal with 18 | ;; lentic-server. 19 | 20 | ;; To evaluate on the local machine use `org-babel-execute-buffer', probably 21 | ;; after setting `org-confirm-babel-evaluate' to nil. 22 | 23 | ;; ** Support 24 | 25 | ;; Build a nice simple bench macro. 26 | 27 | ;; #+begin_src emacs-lisp 28 | (defmacro bench 29 | (&rest body) 30 | `(format "%e" 31 | (car 32 | (benchmark-run-compiled 33 | 1000000 34 | (progn 35 | ,@body))))) 36 | ;; #+end_src 37 | 38 | ;; #+RESULTS: 39 | ;; : bench 40 | 41 | ;; ** How Long does it take to change current-buffer 42 | 43 | ;; *** Entering and Restoring 44 | 45 | ;; There are lots of places where we set the current buffer, do something, then 46 | ;; get the result again, so understanding how long this takes is important. 47 | ;; So, how long does it take to set and restore the current buffer. 48 | 49 | ;; It's quite a bit slower -- about an order of magnitude. 50 | 51 | ;; **** Implementation 52 | 53 | ;; We get the `current-buffer' and `point'. In the first case, we also do 54 | ;; this inside a `with-current-buffer'. 55 | 56 | ;; #+begin_src emacs-lisp 57 | (bench 58 | (with-current-buffer 59 | (current-buffer) 60 | (point))) 61 | ;; #+end_src 62 | 63 | ;; #+RESULTS: 64 | ;; : 3.371566e-02 65 | 66 | 67 | ;; #+begin_src emacs-lisp 68 | (bench 69 | (current-buffer) 70 | (point)) 71 | ;; #+end_src 72 | 73 | ;; #+RESULTS: 74 | ;; : 2.120534e-03 75 | 76 | 77 | ;; *** Does buffer context help 78 | 79 | ;; Is `with-current-buffer' quicker if we are already in the current-buffer? 80 | ;; This is interesting to know because if it is, grouping several commands 81 | ;; that operate on a single would run much faster. 82 | 83 | ;; We test this by entering having two `with-current-buffer' calls which do 84 | ;; nothing, one nested and one not. Our conclusion is, no, it makes not 85 | ;; difference, so there is little pointing in putting a grouping construct in, 86 | ;; unless we do something intelligent. 87 | ;; 88 | 89 | ;; #+BEGIN_SRC emacs-lisp 90 | (bench 91 | (with-current-buffer 92 | (current-buffer) 93 | (with-current-buffer 94 | (current-buffer)))) 95 | ;; #+END_SRC 96 | 97 | ;; #+RESULTS: 98 | ;; : 1.001554e-01 99 | 100 | 101 | ;; #+BEGIN_SRC emacs-lisp 102 | (bench 103 | (with-current-buffer 104 | (current-buffer)) 105 | (with-current-buffer 106 | (current-buffer))) 107 | ;; #+END_SRC 108 | 109 | ;; #+RESULTS: 110 | ;; : 1.205835e-01 111 | 112 | ;; *** How fast is point 113 | 114 | ;; m-buffer-at provides stateless functions, but how much overhead does this 115 | ;; introduce. We try this with the simplest function I can think of, which is 116 | ;; point. The various forms look different here -- because we have a 117 | ;; `current-buffer' call in, but not with `point'. But then, effectively, 118 | ;; `point' must call `current-buffer' somewhere as part of its implementation, 119 | ;; so this difference is fair. 120 | 121 | ;; We conclude that m-buffer is about 100x slower for calling `point', even 122 | ;; when the buffer does not actually need to be changed. So, a lot slower. 123 | 124 | ;; #+BEGIN_SRC emacs-lisp 125 | (bench 126 | (point)) 127 | ;; #+END_SRC 128 | 129 | ;; #+RESULTS: 130 | ;; : -1.722546e-03 131 | 132 | ;; #+BEGIN_SRC emacs-lisp 133 | (bench 134 | (with-current-buffer 135 | (current-buffer) 136 | (point))) 137 | ;; #+END_SRC 138 | 139 | ;; #+RESULTS: 140 | ;; : 3.669245e-02 141 | 142 | ;; #+BEGIN_SRC emacs-lisp 143 | (bench 144 | (m-buffer-at-point 145 | (current-buffer))) 146 | ;; #+END_SRC 147 | 148 | ;; #+RESULTS: 149 | ;; : 1.011448e-01 150 | 151 | 152 | ;; # Local Variables: 153 | ;; # lentic-init: lentic-el-org-init 154 | ;; # End: 155 | -------------------------------------------------------------------------------- /m-buffer-macro.el: -------------------------------------------------------------------------------- 1 | ;;; m-buffer-macro.el --- Create and dispose of markers -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; This file is not part of Emacs 6 | 7 | ;; The contents of this file are subject to the GPL License, Version 3.0. 8 | 9 | ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. 10 | 11 | ;; This program is free software: you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;; This file provides some utility macros which help to support stateless 27 | ;; operation on buffers, by restoring global state after to what it was before 28 | ;; the macro starts. 29 | 30 | ;; These macros are quite useful, but with the exception of 31 | ;; `m-buffer-with-markers', they are mostly meant to underpin `m-buffer-at'. The 32 | ;; aim is that all the cases where one of these macros is used with a single form 33 | ;; from core Emacs should be provided by m-buffer-at (although this is not the 34 | ;; case yet). These macros might be more efficient if there are a lot of calls to 35 | ;; group together. 36 | 37 | ;;; Code: 38 | 39 | ;; ** Markers 40 | 41 | ;; Markers are generally much nicer than integers, but needs cleaning up 42 | ;; afterwards if a lot are created. It's possible to do this using 43 | ;; `m-buffer-nil-marker', but it can be a bit painful. This form looks like a 44 | ;; `let' form, but removes markers at the end. 45 | 46 | ;; #+begin_src emacs-lisp 47 | (defmacro m-buffer-with-markers (varlist &rest body) 48 | "Bind variables after VARLIST then eval BODY. 49 | VARLIST is of the same form as `let'. All variables should 50 | contain markers or collections of markers. All markers are niled 51 | after BODY." 52 | ;; indent let part specially, and debug like let 53 | (declare (indent 1)(debug let)) 54 | ;; so, create a rtn var with make-symbol (for hygene) 55 | (let* ((rtn-var (make-symbol "rtn-var")) 56 | (marker-vars 57 | (mapcar #'car varlist)) 58 | (full-varlist 59 | (append 60 | varlist 61 | `((,rtn-var 62 | (progn 63 | ,@body)))))) 64 | `(let* ,full-varlist 65 | (m-buffer-nil-marker 66 | (list ,@marker-vars)) 67 | ,rtn-var))) 68 | ;; #+end_src 69 | 70 | ;; ** Point and Buffer 71 | 72 | ;; These macros are extensions of `with-current-buffer', and `save-excursion', 73 | ;; which set the current buffer and location. 74 | 75 | ;; #+begin_src emacs-lisp 76 | (defmacro m-buffer-with-current-marker 77 | (marker &rest body) 78 | "At MARKER location run BODY." 79 | (declare (indent 1) (debug t)) 80 | `(with-current-buffer 81 | (marker-buffer ,marker) 82 | (save-excursion 83 | (goto-char ,marker) 84 | ,@body))) 85 | 86 | (defmacro m-buffer-with-current-position 87 | (buffer location &rest body) 88 | "In BUFFER at LOCATION, run BODY." 89 | (declare (indent 2) 90 | (debug t)) 91 | `(with-current-buffer 92 | ,buffer 93 | (save-excursion 94 | (goto-char ,location) 95 | ,@body))) 96 | ;; #+end_src 97 | 98 | ;; Combines the last two! 99 | 100 | ;; #+begin_src emacs-lisp 101 | (defmacro m-buffer-with-current-location 102 | (location &rest body) 103 | "At LOCATION, run BODY. 104 | LOCATION should be a list. If a one element list, it is a marker. 105 | If a two element, it is a buffer and position." 106 | (declare (indent 1) (debug t)) 107 | ;; multiple eval of location! 108 | (let ((loc (make-symbol "loc"))) 109 | `(let ((,loc ,location)) 110 | (if (= 1 (length ,loc)) 111 | (m-buffer-with-current-marker 112 | (nth 0 ,loc) 113 | ,@body) 114 | (if (= 2 (length ,loc)) 115 | (m-buffer-with-current-position 116 | (nth 0 ,loc) 117 | (nth 1 ,loc) 118 | ,@body) 119 | (error "m-buffer-with-current-location requires a list of one or two elements")))))) 120 | 121 | (provide 'm-buffer-macro) 122 | ;;; m-buffer-macro.el ends here 123 | ;; #+end_src 124 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | m-buffer.el 2 | =========== 3 | [![Build Status](https://travis-ci.org/phillord/m-buffer-el.png?branch=master)](https://travis-ci.org/phillord/m-buffer-el) 4 | 5 | ## Introduction 6 | 7 | This package provides a set of list-orientated functions for operating over 8 | the contents of Emacs buffers. Functions are generally purish: i.e. they may 9 | change the state of one buffer by side-effect, but should not affect point, 10 | current buffer, match data or so forth. Generally, markers are preferred over 11 | point locations so that it is possible, for example, to search for regexp 12 | matches and then replace them all without the early replacement invalidating 13 | the location of the later ones. 14 | 15 | m-buffer is now documented at http://phillord.github.io/m-buffer-el/ or live 16 | in Emacs with [Lentic Server](https://github.com/phillord/lentic-server). 17 | 18 | 19 | ## Status 20 | 21 | The code is now in active use. APIs are open to change, but I am not intending 22 | to. 23 | 24 | Version 0.14 did not support Emacs-24, which unintentionally broke assess.el 25 | which needs to work on these platforms. Emacs-24 is now supported again. 26 | 27 | ## Contributions 28 | 29 | Contributions are welcome. However, I would like to keep the option of hosting 30 | m-buffer.el on ELPA, therefore, contributors should have 31 | [Copyright Assignment papers](https://www.gnu.org/prep/maintain/html_node/Copyright-Papers.html) 32 | with the FSF. 33 | 34 | 35 | ## Change Log 36 | 37 | ### 0.15 38 | 39 | Support Emacs-24 again 40 | 41 | ### 0.14 42 | 43 | New function added `m-buffer-match-multi` 44 | 45 | ### 0.13 46 | 47 | New function added `m-buffer-at-string` 48 | 49 | #### Bug Fixes 50 | 51 | - m-buffer was actually moving point, because the state was saved before 52 | changing buffer. 53 | - The benchmark documentation file was being compiled and run on installation, 54 | when it is supposed to serve as static documentation. 55 | 56 | ### 0.12 57 | 58 | New funtion added: `m-buffer-partition-by-marker` 59 | 60 | ### 0.11 61 | 62 | This release mostly includes considerably improved documentation. 63 | 64 | There is one change which is half-way between a breaking change and a bug fix. 65 | Previously, in the m-buffer-match-* functions "match" arguments could take any 66 | keyword argument and these would over-ride any arguments already set. This 67 | means that a call such as: 68 | 69 | (m-buffer-match-page (current-buffer) :regexp "this") 70 | 71 | would behave the same as: 72 | 73 | (m-buffer-match (current-buffer) :regexp "this") 74 | 75 | rather than matching pages. Alternatively, this call: 76 | 77 | (m-buffer-match-line 78 | (current-buffer) 79 | :post-match (lambda () t)) 80 | 81 | never terminates. Both of these now throw an error instead. 82 | 83 | #### Breaking Changes 84 | 85 | - m-buffer-match-* functions now error on conflicting arguments 86 | 87 | ### 0.10 88 | 89 | #### Bug Fixes 90 | 91 | - m-buffer-replace-match no longer moves point 92 | 93 | ### 0.9 94 | 95 | #### Bug Fixes 96 | 97 | - Now byte-compiles without errors/warning 98 | 99 | #### Breaking Changes 100 | 101 | - `m-buffer-point' renamed to `m-buffer-at-point' 102 | 103 | ### 0.8 104 | 105 | - New macros for marker usage. 106 | - m-buffer-at added. New stateless functions for information about Emacs buffers. 107 | 108 | #### Breaking Changes 109 | 110 | - File organisation has been refactored with some macros moved out of m-buffer.el 111 | 112 | ### 0.7 113 | - `m-buffer-match-first-line' added. 114 | 115 | ### 0.6 116 | 117 | - All match functions now take a :numeric argument which forces the 118 | return of numbers rather than markers. 119 | - Two new functions for subtracting one set of matches from another: 120 | `m-buffer-match-subtract` and `m-buffer-match-exact-subtract` 121 | - `m-buffer-with-markers` is a `let*` like macro which autonils markers after 122 | use. 123 | - `m-buffer-with-current-location` is like `with-current-buffer` but also 124 | takes a location. 125 | - `m-buffer-with-current-marker` is like `with-current-buffer` but takes a 126 | marker. 127 | 128 | ### 0.5 129 | - Automated Testing with Cask 130 | 131 | #### Breaking Changes 132 | - m-buffer-replace-match optional arguments now expanded to match 133 | replace-match. This means the 3rd argument has changed meaning. 134 | 135 | ### 0.4 136 | 137 | - m-buffer-match-data has become m-buffer-match 138 | - Testing is now via Cask 139 | 140 | 141 | #### New Functions 142 | 143 | - m-buffer-delete-match 144 | 145 | ### 0.3 146 | 147 | - Various functions for colourising/adding faces 148 | - Documentation improvements. 149 | - m-buffer-nil-markers has been depluralised to m-buffer-nil-marker 150 | - m-buffer-replace-match now returns start end markers 151 | - m-buffer-clone-markers added. 152 | 153 | 154 | ### 0.2 155 | 156 | #### New Functions 157 | - Functions for matching block things -- line start and end, sentence end, 158 | paragraph separators, words. 159 | - `m-buffer-match-string` and `m-buffer-match-substring` for extracting 160 | match-strings. 161 | 162 | 163 | #### Name changes 164 | - Functions now use singular rather than plural -- so `m-buffer-matches-data` 165 | has become `m-buffer-match-data`. 166 | - All uses of `beginning` have been changed to `begin` -- it is shorter and 167 | matches `end` 168 | 169 | #### Matchers 170 | - Regexp functions are now overloaded and take either a buffer and regexp or 171 | match-data (except for `m-buffer-match-data` for which it makes no sense to 172 | pass in match-data). This allows easy chaining of methods. 173 | - Matchers now also overloaded for windows -- searching in the visible 174 | portion of window. `m-buffer-match-data-visible-window` access this feature 175 | directly. 176 | - Match Options are now keyword rather than positional which considerably 177 | simplifies the implementation, especially with an eye to future expansion. 178 | 179 | #### Build and Test 180 | - Reworked tests and build scripts. 181 | -------------------------------------------------------------------------------- /test/m-buffer-test.el: -------------------------------------------------------------------------------- 1 | ;;; m-buffer-test.el --- Tests for m-buffer -*- lexical-binding: t; -*- 2 | 3 | ;; The contents of this file are subject to the GPL License, Version 3.0. 4 | ;; 5 | ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. 6 | ;; 7 | ;; This program is free software: you can redistribute it and/or modify 8 | ;; it under the terms of the GNU General Public License as published by 9 | ;; the Free Software Foundation, either version 3 of the License, or 10 | ;; (at your option) any later version. 11 | ;; 12 | ;; This program is distributed in the hope that it will be useful, 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;; GNU General Public License for more details. 16 | ;; 17 | ;; You should have received a copy of the GNU General Public License 18 | ;; along with this program. If not, see . 19 | 20 | ;;; Code: 21 | (require 'm-buffer) 22 | 23 | (defvar m-buffer-test-path 24 | (directory-file-name 25 | (file-name-directory 26 | (or load-file-name 27 | (buffer-file-name 28 | (get-buffer "m-buffer-test.el")))))) 29 | 30 | (defmacro m-buffer-wtb-of-file (file &rest body) 31 | "Run BODY in a temp buffer with the contents of FILE inserted." 32 | `(with-temp-buffer 33 | (insert-file-contents 34 | (concat m-buffer-test-path "/" 35 | ,file)) 36 | ,@body)) 37 | 38 | 39 | (ert-deftest m-with-temp-buffer-of-file () 40 | "Test my test macro." 41 | (should 42 | (equal 43 | "one\ntwo\nthree\n" 44 | (m-buffer-wtb-of-file 45 | "with-temp-buffer.txt" 46 | (buffer-string))))) 47 | 48 | (ert-deftest m-buffer-loaded () 49 | "Has m-buffer loaded at all?" 50 | (should 51 | (fboundp 'm-buffer-match))) 52 | 53 | 54 | (ert-deftest normalize-args () 55 | "Normalize Region" 56 | ;; just buffer and regexp 57 | (should 58 | (equal 59 | (list (current-buffer) "regexp" nil nil nil nil :default nil) 60 | (m-buffer--normalize-args 61 | (list (current-buffer) "regexp")))) 62 | 63 | (should 64 | (equal 65 | (list (current-buffer) "regexp" nil nil nil nil :default nil) 66 | (m-buffer--normalize-args 67 | (list (current-buffer) :regexp "regexp")))) 68 | 69 | (should 70 | (equal 71 | (list (current-buffer) "regexp" 1 2 3 4 :default nil) 72 | (m-buffer--normalize-args 73 | (list (current-buffer) "regexp" :begin 1 :end 2 :post-match 3 :widen 4)))) 74 | 75 | (should 76 | (equal 77 | (list (current-buffer) "regexp" 1 2 3 4 5 nil) 78 | (m-buffer--normalize-args 79 | (list (current-buffer) "regexp" :begin 1 :end 2 :post-match 3 80 | :widen 4 :case-fold-search 5)))) 81 | 82 | (should 83 | (equal 84 | (list (current-buffer) "regexp" 1 2 3 4 5 6) 85 | (m-buffer--normalize-args 86 | (list (current-buffer) "regexp" :begin 1 :end 2 :post-match 3 87 | :widen 4 :case-fold-search 5 :numeric 6))))) 88 | 89 | 90 | (defun m-buffer--flatten (l) 91 | (if (listp l) 92 | (apply #'append 93 | (seq-map 94 | #'m-buffer--flatten l)) 95 | (list l))) 96 | 97 | (ert-deftest m-buffer-matches () 98 | (should 99 | (= 3 100 | (length 101 | (m-buffer-wtb-of-file 102 | "match-data.txt" 103 | (m-buffer-match 104 | (current-buffer) 105 | "^one$"))))) 106 | (should 107 | (seq-every-p 108 | #'markerp 109 | (m-buffer--flatten 110 | (m-buffer-wtb-of-file 111 | "match-data.txt" 112 | (m-buffer-match 113 | (current-buffer) 114 | "^one$")))))) 115 | 116 | (ert-deftest m-buffer-match-begin () 117 | (should 118 | (seq-every-p 119 | #'markerp 120 | (m-buffer-wtb-of-file 121 | "match-data.txt" 122 | (m-buffer-match-begin 123 | (current-buffer) 124 | "^one$"))))) 125 | 126 | 127 | (ert-deftest marker-to-pos () 128 | (should 129 | (equal '(1 1 1) 130 | (m-buffer-marker-to-pos-nil 131 | (list 132 | (copy-marker 1) 133 | (copy-marker 1) 134 | (copy-marker 1)))))) 135 | 136 | (ert-deftest m-buffer-match-begin-pos () 137 | (should 138 | (equal 139 | '(1 9 17) 140 | (m-buffer-wtb-of-file 141 | "match-data.txt" 142 | (m-buffer-match-begin-pos 143 | (current-buffer) 144 | "^one$"))))) 145 | 146 | (ert-deftest m-buffer-nil-marker () 147 | (should 148 | (m-buffer-wtb-of-file 149 | "match-data.txt" 150 | (seq-every-p 151 | (lambda (marker) 152 | (and 153 | (marker-position marker) 154 | (marker-buffer marker))) 155 | (m-buffer-match-begin (current-buffer) "^one$")))) 156 | (should 157 | (m-buffer-wtb-of-file 158 | "match-data.txt" 159 | (seq-every-p 160 | (lambda (marker) 161 | (and 162 | (not (marker-position marker)) 163 | (not (marker-buffer marker)))) 164 | (m-buffer-nil-marker 165 | (m-buffer-match-begin (current-buffer) "^one$")))))) 166 | 167 | (ert-deftest replace-matches () 168 | (should 169 | (equal 170 | '((1 6) (11 16) (21 26)) 171 | (m-buffer-wtb-of-file 172 | "match-data.txt" 173 | (m-buffer-marker-tree-to-pos 174 | (m-buffer-replace-match 175 | (m-buffer-match 176 | (current-buffer) "^one$") "three"))))) 177 | 178 | (should 179 | (equal 180 | "three\ntwo\nthree\ntwo\nthree\ntwo\n" 181 | (m-buffer-wtb-of-file 182 | "match-data.txt" 183 | (m-buffer-replace-match 184 | (m-buffer-match 185 | (current-buffer) "^one$") "three") 186 | (buffer-string))))) 187 | 188 | (ert-deftest page-matches () 189 | (should 190 | (not 191 | (m-buffer-wtb-of-file 192 | "match-data.txt" 193 | (m-buffer-match-page (current-buffer)))))) 194 | 195 | (ert-deftest paragraph-separate () 196 | (should 197 | (m-buffer-match-paragraph-separate (current-buffer)))) 198 | 199 | (ert-deftest line-start () 200 | (should 201 | (equal 202 | '(1 2 3 5 7 10 13) 203 | (m-buffer-wtb-of-file 204 | "line-start.txt" 205 | (m-buffer-marker-to-pos 206 | (m-buffer-match-line-start (current-buffer))))))) 207 | 208 | (ert-deftest line-end () 209 | (should 210 | (equal 211 | '(1 2 4 6 9 12 13) 212 | (m-buffer-wtb-of-file 213 | "line-start.txt" 214 | (m-buffer-marker-to-pos 215 | (m-buffer-match-line-end (current-buffer))))))) 216 | 217 | (ert-deftest first-line () 218 | (should 219 | (equal 220 | '((1 1)) 221 | (m-buffer-wtb-of-file 222 | "line-start.txt" 223 | (m-buffer-marker-tree-to-pos 224 | (m-buffer-match-first-line 225 | (current-buffer))))))) 226 | 227 | (ert-deftest multi-match () 228 | (should 229 | (equal 230 | '((1 4) (5 8) (13 18)) 231 | (m-buffer-wtb-of-file 232 | "one-two-three.txt" 233 | (m-buffer-marker-tree-to-pos 234 | (m-buffer-match-multi 235 | '("one" "two" "three") 236 | :buffer (current-buffer)))))) 237 | ) 238 | 239 | (ert-deftest sentence-end () 240 | (should 241 | (equal 242 | '(15 32 48) 243 | (m-buffer-wtb-of-file 244 | "sentence-end.txt" 245 | (m-buffer-marker-to-pos 246 | (m-buffer-match-sentence-end (current-buffer))))))) 247 | 248 | (ert-deftest buffer-for-match () 249 | (should 250 | (with-temp-buffer 251 | (progn 252 | (insert "a") 253 | (equal 254 | (current-buffer) 255 | (m-buffer-buffer-for-match 256 | (m-buffer-match (current-buffer) "a"))))))) 257 | 258 | (ert-deftest match-n () 259 | (should 260 | (equal 261 | '((1 7 1 4 4 7) (8 14 8 11 11 14) (15 21 15 18 18 21) (22 28 22 25 25 28)) 262 | (m-buffer-wtb-of-file 263 | "nth.txt" 264 | (m-buffer-marker-tree-to-pos 265 | (m-buffer-match 266 | (current-buffer) 267 | "\\(one\\)\\(two\\)"))))) 268 | 269 | (should 270 | (equal 271 | '((1 7)(8 14)(15 21)(22 28)) 272 | (m-buffer-wtb-of-file 273 | "nth.txt" 274 | (m-buffer-marker-tree-to-pos 275 | (m-buffer-match-nth-group 276 | 0 (m-buffer-match 277 | (current-buffer) 278 | "\\(one\\)\\(two\\)")))))) 279 | 280 | (should 281 | (equal 282 | '((1 4) (8 11) (15 18) (22 25)) 283 | (m-buffer-wtb-of-file 284 | "nth.txt" 285 | (m-buffer-marker-tree-to-pos 286 | (m-buffer-match-nth-group 287 | 1 (m-buffer-match 288 | (current-buffer) 289 | "\\(one\\)\\(two\\)"))))))) 290 | 291 | 292 | (ert-deftest apply-functions () 293 | (should 294 | (equal 295 | '("onetwo" "onetwo" "onetwo" "onetwo" "") 296 | (m-buffer-wtb-of-file 297 | "nth.txt" 298 | (m-buffer-on-region 299 | (lambda (from to) 300 | (buffer-substring-no-properties from to)) 301 | (m-buffer-match-line 302 | (current-buffer))))))) 303 | 304 | (ert-deftest case-fold-search () 305 | ;; match everything -- technically this is dependent on the buffer-local 306 | ;; value of case-fold-search 307 | (should 308 | (equal 309 | '((1 2) (3 4) (5 6) (7 8)) 310 | (m-buffer-wtb-of-file 311 | "case-match.txt" 312 | (m-buffer-marker-tree-to-pos 313 | (m-buffer-match 314 | (current-buffer) 315 | "A"))))) 316 | ;; match just upper case (i.e. cfs nil) 317 | (should 318 | (equal 319 | '((1 2)(5 6)) 320 | (m-buffer-wtb-of-file 321 | "case-match.txt" 322 | (m-buffer-marker-tree-to-pos 323 | (m-buffer-match 324 | (current-buffer) 325 | "A" 326 | :case-fold-search nil))))) 327 | ;; match all again 328 | (should 329 | (equal 330 | '((1 2) (3 4) (5 6) (7 8)) 331 | (m-buffer-wtb-of-file 332 | "case-match.txt" 333 | (m-buffer-marker-tree-to-pos 334 | (m-buffer-match 335 | (current-buffer) 336 | "A" 337 | :case-fold-search t)))))) 338 | 339 | 340 | (ert-deftest subtract () 341 | (should 342 | (equal 343 | '((1 6) (17 23) (34 39)) 344 | (m-buffer-wtb-of-file 345 | "sentence-end.txt" 346 | (m-buffer-marker-tree-to-pos 347 | (m-buffer-match-subtract 348 | (m-buffer-match-word 349 | (current-buffer)) 350 | (m-buffer-match 351 | (current-buffer) "sentence"))))))) 352 | 353 | (ert-deftest exact-subtract () 354 | (should 355 | (equal 356 | '((1 1)(2 2)(3 3)) 357 | (m-buffer-match-exact-subtract 358 | '((0 0) (1 1) (2 2) (3 3) (4 4)) 359 | '((0 0) (4 4))))) 360 | 361 | (should 362 | (equal 363 | '((1 1)(2 2)(3 3)) 364 | (m-buffer-match-exact-subtract 365 | '((0 0) (1 1) (2 2) (3 3) (4 4)) 366 | '((-1 -1) (4 4))))) 367 | 368 | (should 369 | (equal 370 | '((1 6) (17 23) (34 39)) 371 | (m-buffer-wtb-of-file 372 | "sentence-end.txt" 373 | (m-buffer-marker-tree-to-pos 374 | (m-buffer-match-exact-subtract 375 | (m-buffer-match-word 376 | (current-buffer)) 377 | (m-buffer-match 378 | (current-buffer) "sentence"))))))) 379 | 380 | (ert-deftest exact-subtract-with-nil () 381 | (should 382 | (equal 383 | '((1 1)) 384 | (m-buffer-match-exact-subtract 385 | '((1 1)) 386 | nil)))) 387 | 388 | (ert-deftest exact-subtract-error-simplified () 389 | (should 390 | (equal 391 | '((2 2)) 392 | (m-buffer-match-exact-subtract 393 | '((1 1) (2 2)) 394 | '((1 1)))))) 395 | 396 | (ert-deftest exact-subtract-error () 397 | "This is a test case for a bug found from linked-buffer." 398 | (should 399 | (equal 400 | '((19 31 19 19)) 401 | (m-buffer-match-exact-subtract 402 | '((1 18 1 1) 403 | (19 31 19 19)) 404 | '((1 18)))))) 405 | 406 | 407 | (ert-deftest replace-point-unmoved () 408 | "After a replace-match has happened point 409 | should not have moved." 410 | (should 411 | (equal 412 | (m-buffer-wtb-of-file 413 | "match-data.txt" 414 | (point-min)) 415 | (m-buffer-wtb-of-file 416 | "match-data.txt" 417 | (m-buffer-replace-match 418 | (m-buffer-match 419 | (current-buffer) "two") 420 | "one") 421 | (point))))) 422 | 423 | (ert-deftest match-error () 424 | "Should error because we try to override existing args." 425 | (should-error 426 | (m-buffer-match-word 427 | (current-buffer) :regexp "notword"))) 428 | 429 | 430 | (ert-deftest partition-by-markers () 431 | (should 432 | (equal 433 | '((nil 1) 434 | (2 2 3 4) 435 | (5 5 6 7) 436 | (8 8 9)) 437 | (m-buffer-partition-by-marker 438 | '(1 2 3 4 5 6 7 8 9) 439 | '(2 5 8) 440 | )))) 441 | 442 | 443 | (ert-deftest point-stationionary-with-current () 444 | "This test addresses a bug where m-buffer did not correctly 445 | protect global state when the buffer being operated on was not 446 | current -- in this case, a match could move point. 447 | 448 | The two clauses are identical, one changing the current buffer 449 | and one changing a buffer which is not current." 450 | (should 451 | (let ((out) (out-point)) 452 | (with-temp-buffer 453 | (insert "one\ntwo\nthree\n") 454 | (setq out (current-buffer)) 455 | (setq out-point (point)) 456 | (m-buffer-match-first-line out) 457 | (= (point) out-point)))) 458 | 459 | (should 460 | (let ((out) (out-point)) 461 | (with-temp-buffer 462 | (insert "one\ntwo\nthree\n") 463 | (setq out (current-buffer)) 464 | (setq out-point (point)) 465 | (with-temp-buffer 466 | (m-buffer-match-first-line out)) 467 | (= (point) out-point))))) 468 | 469 | ;;; m-buffer-test.el ends here 470 | -------------------------------------------------------------------------------- /m-buffer.el: -------------------------------------------------------------------------------- 1 | ;;; m-buffer.el --- List-Oriented, Functional Buffer Manipulation -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; This file is not part of Emacs 6 | 7 | ;; Author: Phillip Lord 8 | ;; Maintainer: Phillip Lord 9 | ;; Version: 0.16.1 10 | ;; Package-Requires: ((seq "2.14")) 11 | 12 | ;; The contents of this file are subject to the GPL License, Version 3.0. 13 | 14 | ;; Copyright (C) 2014-2024 Free Software Foundation, Inc. 15 | 16 | ;; This program is free software: you can redistribute it and/or modify 17 | ;; it under the terms of the GNU General Public License as published by 18 | ;; the Free Software Foundation, either version 3 of the License, or 19 | ;; (at your option) any later version 20 | 21 | ;; This program is distributed in the hope that it will be useful, 22 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ;; GNU General Public License for more details. 25 | 26 | ;; You should have received a copy of the GNU General Public License 27 | ;; along with this program. If not, see . 28 | 29 | ;;; Commentary: 30 | 31 | ;; This file provides a set of list-oriented functions for operating over the 32 | ;; contents of buffers, mostly revolving around regexp searching, and regions. 33 | ;; They avoid the use of looping, manipulating global state with `match-data'. 34 | ;; Many high-level functions exist for matching sentences, lines and so on. 35 | 36 | ;; Functions are generally purish: i.e. that is those functions which do 37 | ;; change state, by for example replacing text or adding overlays, should only 38 | ;; change state in one way; they will not affect point, current buffer, match 39 | ;; data or so forth. 40 | 41 | ;; Likewise to protect against changes in state, markers are used rather than 42 | ;; integer positions. This means that it is possible, for example, to search 43 | ;; for regexp matches and then replace them all without the earlier 44 | ;; replacements invalidating the location of the later ones. Otherwise 45 | ;; replacements need to be made in reverse order. This can have implications 46 | ;; for performance, so m-buffer also provides functions for making markers nil; 47 | ;; there are also macros which help manage markers in `m-buffer-macro'. 48 | 49 | ;; Where possible, functions share interfaces. So most of the match functions 50 | ;; take a list of "match" arguments, either position or as a plist, which avoids 51 | ;; using lots of `nil' arguments. Functions operating on matches take a list of 52 | ;; `match-data' as returned by the match functions, making it easy to chain 53 | ;; matches. 54 | 55 | ;; This file is documented using lentic.el. Use 56 | ;; [[http://github.com/phillord/lentic-server][lentic-server]] to view. 57 | 58 | ;;; Status: 59 | 60 | ;; m-buffer.el is now stable and is expected to change only in 61 | ;; forward-compatible ways. 62 | 63 | ;;; Code: 64 | 65 | ;; #+begin_src emacs-lisp 66 | (require 'seq) 67 | (require 'm-buffer-macro) 68 | 69 | ;; #+end_src 70 | 71 | ;; ** Regexp Matching 72 | 73 | ;; We first provide a single match function, `m-bufffer-match' which converts 74 | ;; between Emacs' stateful matching and a more sequence-oriented interface. 75 | 76 | ;; This function also defines the "match" arguments which are a standard set of 77 | ;; arguments used throughout this package. 78 | 79 | ;; #+begin_src emacs-lisp 80 | (defun m-buffer-match (&rest match) 81 | "Return a list of all `match-data' for MATCH. 82 | MATCH may be of the forms: 83 | BUFFER REGEXP &optional MATCH-OPTIONS 84 | WINDOW REGEXP &optional MATCH-OPTIONS 85 | MATCH-OPTIONS 86 | 87 | If BUFFER is given, search this buffer. If WINDOW is given search 88 | the visible window. MATCH-OPTIONS is a plist with any of the 89 | following keys: 90 | :buffer -- the buffer to search 91 | :regexp -- the regexp to search with 92 | :begin -- the start of the region to search -- default point min 93 | :end -- the end of the region to search -- default point max 94 | :post-match -- function called after a match -- default nil 95 | :widen -- if true, widen buffer first -- default nil 96 | :case-fold-search value of `case-fold-search' during search. 97 | If :default accept the current buffer-local value 98 | :numeric -- if true, return integers not markers 99 | 100 | If options are expressed in two places, the plist form takes 101 | precedence over positional args. So calling with both a first 102 | position buffer and a :buffer arg will use the second. Likewise, 103 | if a window is given as first arg and :end is given, then 104 | the :end value will be used. 105 | 106 | REGEXP should advance point (i.e. not be zero-width) or the 107 | function will loop infinitely. POST-MATCH can be used to avoid 108 | this. The buffer is searched forward." 109 | (apply #'m-buffer--match-1 110 | (m-buffer--normalize-args match))) 111 | ;; #+end_src 112 | 113 | ;; The match function is actually implemented here in the `m-buffer--match-1' 114 | ;; function, with positional arguments. 115 | 116 | ;; #+begin_src emacs-lisp 117 | (defun m-buffer--match-1 (buffer regexp begin end 118 | post-match widen cfs 119 | numeric) 120 | "Return a list of `match-data'. 121 | 122 | This is an internal function: please prefer `m-buffer-match'. 123 | 124 | BUFFER -- the buffer. 125 | REGEXP -- the regexp. 126 | BEGIN -- the start of the region to search 127 | END -- the end of the region to search 128 | POST-MATCH -- function to run after each match 129 | POST-MATCH is useful for zero-width matches which will otherwise 130 | cause infinite loop. The buffer is searched forward. POST-MATCH 131 | return can also be used to terminate the matching by returning nil. 132 | WIDEN -- call widen first. 133 | CFS -- Non-nil if searches and matches should ignore case. 134 | NUMERIC -- Non-nil if we should return integers not markers." 135 | ;; #+end_src 136 | 137 | ;; We start by saving everything to ensure that we do not pollute the global 138 | ;; state. This means match-data, point, narrowing and current buffer! Hopefully 139 | ;; this is all the global state that exists and that we are changing. 140 | 141 | ;; #+begin_src emacs-lisp 142 | (with-current-buffer 143 | buffer 144 | (save-match-data 145 | (save-excursion 146 | (save-restriction 147 | (when widen (widen)) 148 | ;; #+end_src 149 | 150 | ;; This let form is doing a number of things. It sets up a dynamic binding for 151 | ;; `case-fold-search' (which works even though we are using lexical binding), 152 | ;; ensures a non-nil value for =end-bound= and defines a sentinal value that 153 | ;; =post-match-return= can use to end early. 154 | 155 | ;; #+begin_src emacs-lisp 156 | (let ((rtn nil) 157 | (post-match-return t) 158 | (end-bound (or end (point-max))) 159 | ;; over-ride default if necessary 160 | (case-fold-search 161 | (if (eq :default cfs) 162 | case-fold-search 163 | cfs))) 164 | ;; #+end_src 165 | 166 | ;; We start at the beginning. There was no particularly good reason for this, and 167 | ;; it would have made just as much sense to go backward. 168 | 169 | ;; #+begin_src emacs-lisp 170 | (goto-char 171 | (or begin 172 | (point-min))) 173 | (while 174 | (and 175 | ;; #+end_src 176 | 177 | ;; The original purpose for =post-match-return= was for zero-width matches -- 178 | ;; these do not advance point beyond their end, so the while loop never 179 | ;; terminates. Unfortunately, avoiding this depends on the regexp being called, 180 | ;; so we provide the most general solution of all. 181 | 182 | ;; As well as this, we check the return value of =post-match-return=, so as well 183 | ;; as advancing `point' by side-effect, we can also use it to terminate the look 184 | ;; at any point that we want; for example, we can terminate after the first match 185 | ;; which feels more efficient than searching the whole buffer then taking the 186 | ;; first match. 187 | 188 | ;; #+begin_src emacs-lisp 189 | post-match-return 190 | ;; we need to check we are less than the end-bound 191 | ;; or re-search-forward will break 192 | (<= (point) end-bound) 193 | (re-search-forward 194 | regexp end-bound 195 | t)) 196 | ;; #+end_src 197 | 198 | ;; Store the `match-data' in a backward list, run post-match. Finally, reverse 199 | ;; and terminate. 200 | 201 | ;; #+begin_src emacs-lisp 202 | (setq rtn 203 | (cons 204 | (if numeric 205 | (m-buffer-marker-to-pos-nil 206 | (match-data)) 207 | (match-data)) 208 | rtn)) 209 | (when post-match 210 | (setq post-match-return (funcall post-match)))) 211 | (reverse rtn))))))) 212 | ;; #+end_src 213 | 214 | ;; This method implements the argument list processing. I find this interface 215 | ;; fairly attractive to use since it takes the two "main" arguments -- buffer and 216 | ;; regexp -- as positional args optionally, and everything else as keywords. The 217 | ;; use of keywords is pretty much essential as have eight arguments most of which 218 | ;; are not essential. 219 | 220 | ;; This is fairly close to the logic provided by `cl-defun' which I wasn't aware 221 | ;; of when I wrote this. However `cl-defun' does not allow optional arguments 222 | ;; before keyword arguments -- all the optional arguments have to be given if we 223 | ;; are to use keywords. 224 | 225 | ;; #+begin_src emacs-lisp 226 | (defun m-buffer--normalize-args (match-with) 227 | "Manipulate args into a standard form and return as a list. 228 | MATCH-WITH are these args. This is an internal function." 229 | (let* ( 230 | ;; split up into keyword and non keyword limits 231 | (args 232 | (seq-take-while 233 | (lambda (x) (not (keywordp x))) 234 | match-with)) 235 | (pargs 236 | (seq-drop-while 237 | (lambda (x) (not (keywordp x))) 238 | match-with)) 239 | ;; sort actual actual parameters 240 | (first (car args)) 241 | ;; buffer may be first 242 | (buffer 243 | (or (plist-get pargs :buffer) 244 | (and (bufferp first) first))) 245 | ;; or window may be first 246 | (window 247 | (or (plist-get pargs :window) 248 | (and (windowp first) first))) 249 | ;; regexp always comes second 250 | (regexp 251 | (or (plist-get pargs :regexp) 252 | (nth 1 args))) 253 | ;; begin depends on other arguments 254 | (begin 255 | (or (plist-get pargs :begin) 256 | (and window (window-start window)))) 257 | ;; end depends on other arguments 258 | (end 259 | (or (plist-get pargs :end) 260 | (and window (window-end window)))) 261 | ;; pm 262 | (post-match 263 | (plist-get pargs :post-match)) 264 | 265 | ;; widen 266 | (widen 267 | (plist-get pargs :widen)) 268 | 269 | ;; case-fold-search this needs to overwrite the buffer contents iff 270 | ;; set, otherwise be ignored, so we need to distinguish a missing 271 | ;; property and a nil one 272 | (cfs 273 | (if (plist-member pargs :case-fold-search) 274 | (plist-get pargs :case-fold-search) 275 | :default)) 276 | 277 | ;; numeric 278 | (numeric 279 | (plist-get pargs :numeric))) 280 | 281 | (list buffer regexp begin end post-match widen cfs numeric))) 282 | ;; #+end_src 283 | 284 | ;; Finally, this function provides a link between the match function, and the 285 | ;; match manipulation functions. We can either choose to match once against a set 286 | ;; of arguments and then apply multiple manipulations on the returned match data. 287 | ;; Or just use the match manipulation function directly. 288 | 289 | ;; The first version of `m-buffer' did not include this but it required lots of 290 | ;; nested calls which seem inconvenient. 291 | 292 | ;; #+begin_example 293 | ;; (m-buffer-match-manipulate 294 | ;; (m-buffer-match (current-buffer) "hello")) 295 | ;; #+end_example 296 | 297 | ;; I think that convienience is worth the overhead. 298 | 299 | ;; #+begin_src emacs-lisp 300 | (defun m-buffer-ensure-match (&rest match) 301 | "Ensure that we have MATCH data. 302 | If a single arg, assume it is match data and return. If multiple 303 | args, assume they are of the form accepted by 304 | `m-buffer-match'." 305 | (cond 306 | ;; we have match data 307 | ((= 1 (length match)) 308 | (car match)) 309 | ((< 1 (length match)) 310 | (apply #'m-buffer-match match)) 311 | (t 312 | (error "Invalid arguments")))) 313 | ;; #+end_src 314 | 315 | ;; ** Match Data Manipulation Functions 316 | 317 | ;; These functions manipulate lists of either match-data or match arguments in 318 | ;; some way. 319 | 320 | ;; #+begin_src emacs-lisp 321 | (defun m-buffer-buffer-for-match (match-data) 322 | "Given some MATCH-DATA return the buffer for that data." 323 | (marker-buffer (caar match-data))) 324 | 325 | (defun m-buffer-match-nth-group (n match-data) 326 | "Fetch the Nth group from MATCH-DATA." 327 | (seq-map 328 | (lambda (m) 329 | (let ((drp 330 | (seq-drop m (* 2 n)))) 331 | (list 332 | (car drp) (cadr drp)))) 333 | match-data)) 334 | 335 | (defun m-buffer-match-begin-n (n &rest match) 336 | "Return markers to the start of the Nth group in MATCH. 337 | MATCH may be of any form accepted by `m-buffer-ensure-match'. Use 338 | `m-buffer-nil-marker' after the markers have been finished with 339 | or they will slow future use of the buffer until garbage collected." 340 | (seq-map 341 | (lambda (m) 342 | (nth 343 | (* 2 n) m)) 344 | (apply #'m-buffer-ensure-match match))) 345 | 346 | (defun m-buffer-match-begin-n-pos (n &rest match) 347 | "Return positions of the start of the Nth group in MATCH. 348 | MATCH may be of any form accepted by `m-buffer-ensure-match'. If 349 | `match-data' is passed markers will be set to nil after this 350 | function. See `m-buffer-nil-marker' for details." 351 | (m-buffer-marker-to-pos-nil 352 | (apply #'m-buffer-match-begin-n 353 | n match))) 354 | 355 | (defun m-buffer-match-begin (&rest match) 356 | "Return a list of markers to the start of MATCH. 357 | MATCH may of any form accepted by `m-buffer-ensure-match'. Use 358 | `m-buffer-nil-marker' after the markers have been used or they 359 | will slow future changes to the buffer." 360 | (apply #'m-buffer-match-begin-n 0 match)) 361 | 362 | (defun m-buffer-match-begin-pos (&rest match) 363 | "Return a list of positions at the start of matcher. 364 | MATCH may be of any form accepted by `m-buffer-ensure-match'. 365 | If `match-data' is passed markers will be set to nil after this 366 | function. See `m-buffer-nil-marker' for details." 367 | (apply #'m-buffer-match-begin-n-pos 0 match)) 368 | 369 | (defun m-buffer-match-end-n (n &rest match) 370 | "Return markers to the end of the match to the Nth group. 371 | MATCH may be of any form accepted by `m-buffer-ensure-match'. 372 | If `match-data' is passed markers will be set to nil after this 373 | function. See `m-buffer-nil-marker' for details." 374 | (seq-map 375 | (lambda (m) 376 | (nth 377 | (+ 1 (* 2 n)) 378 | m)) 379 | (apply #'m-buffer-ensure-match match))) 380 | 381 | (defun m-buffer-match-end-n-pos (n &rest match) 382 | "Return positions of the end Nth group of MATCH. 383 | MATCH may be of any form accepted by `m-buffer-ensure-match'. 384 | If `match-data' is passed markers will be set to nil after this 385 | function. See `m-buffer-nil-marker' for details." 386 | (m-buffer-marker-to-pos-nil 387 | (apply #'m-buffer-match-end-n-pos 388 | n match))) 389 | 390 | (defun m-buffer-match-end (&rest match) 391 | "Return a list of markers to the end of MATCH to regexp in buffer. 392 | MATCH may be of any form accepted by `m-buffer-ensure-match'. Use 393 | `m-buffer-nil-marker' after the markers have been used or they 394 | will slow future changes to the buffer." 395 | (apply #'m-buffer-match-end-n 0 match)) 396 | 397 | (defun m-buffer-match-end-pos (&rest match) 398 | "Return a list of positions to the end of the match. 399 | MATCH may be of any form accepted by `m-buffer-ensure-match'. 400 | If `match-data' is passed markers will be set to nil after this 401 | function. See `m-buffer-nil-marker' for details." 402 | (m-buffer-marker-to-pos-nil 403 | (apply #'m-buffer-match-end match))) 404 | ;; #+end_src 405 | 406 | ;; ** Match Utility and Predicates 407 | 408 | ;; *** Subtraction 409 | 410 | ;; Some predicates and the ability to subtract to lists of matches from each 411 | ;; other. This makes up for limitations in Emacs regexp which can't do "match x 412 | ;; but not y". 413 | 414 | ;; #+begin_src emacs-lisp 415 | (defun m-buffer-match-equal (m n) 416 | "Return true if M and N are cover the same region. 417 | Matches are equal if they match the same region; subgroups are 418 | ignored." 419 | (and 420 | (equal 421 | (car m) 422 | (car n)) 423 | (equal 424 | (cadr m) 425 | (cadr n)))) 426 | ;; #+end_src 427 | 428 | ;; A nice simple implementation for the general purpose solution. 429 | ;; Unfortunately, performance sucks, running in quadratic time. 430 | 431 | ;; #+begin_src emacs-lisp 432 | (defun m-buffer-match-subtract (m n) 433 | "Remove from M any match in N. 434 | Matches are equivalent if overall they match the same 435 | area; subgroups are ignored. 436 | See also `m-buffer-match-exact-subtract' which often 437 | runs faster but has some restrictions." 438 | (seq-remove 439 | (lambda (o) 440 | (seq-some 441 | (lambda (p) 442 | (m-buffer-match-equal o p)) 443 | n)) 444 | m)) 445 | ;; #+end_src 446 | 447 | ;; The ugly and complicated and less general solution. But it runs in linear 448 | ;; time. 449 | 450 | ;; #+begin_src emacs-lisp 451 | (defun m-buffer-match-exact-subtract (m n) 452 | "Remove from M any match in N. 453 | Both M and N must be fully ordered, and any element in N must be 454 | in M." 455 | (if n 456 | ;; n-eaten contains the remaining elements of n that we haven't tested 457 | ;; for yet. We throw them away as we go 458 | (let ((n-eaten n)) 459 | (seq-remove 460 | (lambda (o) 461 | (cond 462 | ;; n-eaten has been eaten. Check here or later "<" comparison crashes. 463 | ((not n-eaten) 464 | ;; return nil because we always want things in m now. 465 | nil 466 | ) 467 | ;; we have a match so throw away the first element of n-eaten 468 | ;; which we won't need again. 469 | ((m-buffer-match-equal 470 | (car n-eaten) o) 471 | (progn 472 | (setq n-eaten (seq-drop n-eaten 1)) 473 | t)) 474 | ;; we should discard also if n-eaten 1 is less than o because, both 475 | ;; are sorted, so we will never match 476 | ((< 477 | ;; first half of the first match in n-eaten 478 | (caar n-eaten) 479 | ;; first half of match 480 | (car o)) 481 | (progn 482 | (setq n-eaten (seq-drop n-eaten 1)) 483 | t)))) 484 | m)) 485 | m)) 486 | 487 | (defun m-buffer-in-match-p (matches position) 488 | "Returns true is any of MATCHES contain POSITION." 489 | (seq-some 490 | (lambda (match) 491 | (and 492 | (<= (car match) position) 493 | (<= position (cadr match)))) 494 | matches)) 495 | ;; #+end_src 496 | 497 | 498 | ;; *** Partition 499 | 500 | ;; Partition one set of markers by another. This is useful for finding matched 501 | ;; pairs of markers. 502 | 503 | ;; #+begin_src emacs-lisp 504 | (defun m-buffer--partition-by-marker(list partition) 505 | "Given LIST, split at markers in PARTITION. 506 | 507 | This is the main implementation for `m-buffer-partition-by-marker', 508 | but assumes that partition starts with a very low value (or nil)." 509 | (let* ((p-top (car-safe partition)) 510 | (p-val (car-safe (cdr-safe partition))) 511 | (p-fn (lambda (n) 512 | (or (not p-val) 513 | (< n p-val))))) 514 | (when list 515 | (cons 516 | (cons 517 | p-top 518 | (seq-take-while p-fn list)) 519 | (m-buffer--partition-by-marker 520 | (seq-drop-while p-fn list) 521 | (cdr partition)))))) 522 | 523 | (defun m-buffer-partition-by-marker (list partition) 524 | "Given LIST of markers, split at markers in PARTITION. 525 | Returns a list of lists. The first element of each list is nil or 526 | the marker from PARTITION. The rest of the elements are those 527 | elements in LIST which are at the same position or later in the 528 | buffer than the element from PARTITION, but before the next 529 | element from PARTITION. 530 | 531 | Both LIST and PARTITION must be sorted." 532 | ;; TODO! 533 | (m-buffer--partition-by-marker list (cons nil partition))) 534 | ;; #+end_src 535 | 536 | 537 | ;; ** Marker manipulation functions 538 | 539 | ;; These functions do things to markers rather than the areas of the buffers 540 | ;; indicated by the markers. This includes transforming between markers and 541 | ;; integer positions, and niling markers explicitly, which prevents slow down 542 | ;; before garbage collection. 543 | 544 | ;; #+begin_src emacs-lisp 545 | (defun m-buffer-nil-marker (markers) 546 | "Takes a (nested) list of MARKERS and nils them all. 547 | Markers slow buffer movement while they are pointing at a 548 | specific location, until they have been garbage collected. Niling 549 | them prevents this. See Info node `(elisp) Overview of Markers'." 550 | (seq-map 551 | (lambda (marker) 552 | (if (seqp marker) 553 | (m-buffer-nil-marker marker) 554 | (set-marker marker nil))) 555 | markers)) 556 | 557 | (defun m-buffer-marker-to-pos (markers &optional postnil) 558 | "Transforms a list of MARKERS to a list of positions. 559 | If the markers are no longer needed, set POSTNIL to true, or call 560 | `m-buffer-nil-marker' manually after use to speed future buffer 561 | movement. Or use `m-buffer-marker-to-pos-nil'." 562 | (seq-map 563 | (lambda (marker) 564 | (prog1 565 | (marker-position marker) 566 | (when postnil 567 | (set-marker marker nil)))) 568 | markers)) 569 | 570 | (defun m-buffer-marker-to-pos-nil (markers) 571 | "Transforms a list of MARKERS to a list of positions then nils. 572 | See also `m-buffer-nil-markers'" 573 | (m-buffer-marker-to-pos markers t)) 574 | 575 | (defun m-buffer-marker-tree-to-pos (marker-tree &optional postnil) 576 | "Transforms a tree of markers to equivalent positions. 577 | MARKER-TREE is the tree. 578 | POSTNIL sets markers to nil afterwards." 579 | (seq-map 580 | (lambda (marker) 581 | (if (seqp marker) 582 | (m-buffer-marker-tree-to-pos marker postnil) 583 | (prog1 584 | (marker-position marker) 585 | (when postnil 586 | (set-marker marker nil))))) 587 | marker-tree)) 588 | 589 | (defun m-buffer-marker-tree-to-pos-nil (marker-tree) 590 | "Transforms a tree of markers to equivalent positions. 591 | MARKER-TREE is the tree. Markers are niled afterwards." 592 | (m-buffer-marker-tree-to-pos marker-tree t)) 593 | 594 | (defun m-buffer-marker-clone (marker-tree &optional type) 595 | "Return a clone of MARKER-TREE. 596 | The optional argument TYPE specifies the insertion type. See 597 | `copy-marker' for details." 598 | (seq-map 599 | (lambda (marker) 600 | (if (seqp marker) 601 | (m-buffer-marker-clone marker type) 602 | (copy-marker marker type))) 603 | marker-tree)) 604 | 605 | (defun m-buffer-pos-to-marker (buffer positions) 606 | "In BUFFER translates a list of POSITIONS to markers." 607 | (seq-map 608 | (lambda (pos) 609 | (set-marker 610 | (make-marker) pos buffer)) 611 | positions)) 612 | ;; #+end_src 613 | 614 | ;; ** Replace, Delete, Extract 615 | 616 | ;; #+begin_src emacs-lisp 617 | (defun m-buffer-replace-match (match-data replacement 618 | &optional fixedcase literal subexp) 619 | "Given a list of MATCH-DATA, replace with REPLACEMENT. 620 | If FIXEDCASE do not alter the case of the replacement text. 621 | If LITERAL insert the replacement literally. 622 | SUBEXP should be a number indicating the regexp group to replace. 623 | Returns markers to the start and end of the replacement. These 624 | markers are part of MATCH-DATA, so niling them will percolate backward. 625 | 626 | See also `replace-match'." 627 | (save-excursion 628 | (seq-map 629 | (lambda (match) 630 | (with-current-buffer 631 | (marker-buffer (car match)) 632 | (save-match-data 633 | (set-match-data match) 634 | (replace-match 635 | replacement fixedcase literal nil 636 | (or subexp 0))))) 637 | match-data)) 638 | ;; we have match-data 639 | (m-buffer-match-nth-group (or subexp 0) match-data)) 640 | 641 | (defun m-buffer-delete-match (match-data &optional subexp) 642 | "Delete all MATCH-DATA. 643 | SUBEXP should be a number indicating the regexp group to delete. 644 | Returns markers to the start and end of the replacement. These 645 | markers are part of MATCH_DATA, so niling them will percolate backward." 646 | (m-buffer-replace-match match-data "" subexp)) 647 | 648 | (defun m-buffer-match-string (match-data &optional subexp) 649 | "Return strings for MATCH-DATA optionally of group SUBEXP." 650 | (seq-map 651 | (lambda (match) 652 | (with-current-buffer 653 | (marker-buffer (car match)) 654 | (save-match-data 655 | (set-match-data match) 656 | (match-string 657 | (or subexp 0))))) 658 | match-data)) 659 | 660 | (defun m-buffer-match-string-no-properties (match-data &optional subexp) 661 | "Return strings for MATCH-DATA optionally of group SUBEXP. 662 | Remove all properties from return." 663 | (seq-map 664 | #'substring-no-properties 665 | (m-buffer-match-string 666 | match-data subexp))) 667 | ;; #+end_src 668 | 669 | ;; ** Match Things 670 | 671 | ;; Emacs comes with a set of in-built regexps most of which we use here. 672 | 673 | ;; We define `m-buffer-apply-join' first. The reason for this function is that 674 | ;; we want to take a list of match arguments and add to with, for instance, a 675 | ;; regular expression. We need to add these at the end because most of our 676 | ;; functions contain some positional arguments. 677 | 678 | 679 | ;; #+begin_src emacs-lisp 680 | (defun m-buffer-apply-join (fn match &rest more-match) 681 | (let* 682 | ((args 683 | (seq-take-while 684 | (lambda (x) (not (keywordp x))) 685 | match)) 686 | (pargs 687 | (seq-drop-while 688 | (lambda (x) (not (keywordp x))) 689 | match)) 690 | (more-keywords 691 | (seq-map 692 | #'car 693 | (seq-partition more-match 2)))) 694 | (when 695 | (seq-find 696 | (lambda (keyword) 697 | (plist-member pargs keyword)) 698 | more-keywords) 699 | (error 700 | "Match arg contradicts a defined argument.")) 701 | (apply fn (append args more-match pargs)))) 702 | ;; #+end_src 703 | 704 | ;; For the following code, we use Emacs core regexps where possible. 705 | 706 | ;; #+begin_src emacs-lisp 707 | (defun m-buffer-match-page (&rest match) 708 | "Return a list of match data to all pages in MATCH. 709 | MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See 710 | `m-buffer-match' for further details." 711 | (m-buffer-apply-join 'm-buffer-match 712 | match :regexp page-delimiter)) 713 | ;; #+end_src 714 | 715 | ;; The `paragraph-separate' regexp can match an empty region, so we need to start 716 | ;; each search at the beginning of the next line. 717 | 718 | ;; #+begin_src emacs-lisp 719 | (defun m-buffer-match-paragraph-separate (&rest match) 720 | "Return a list of match data to `paragraph-separate' in MATCH. 721 | MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See 722 | `m-buffer-match' for futher details." 723 | (m-buffer-apply-join 724 | 'm-buffer-match match :regexp paragraph-separate 725 | :post-match 'm-buffer-post-match-forward-line)) 726 | 727 | (defvar m-buffer--line-regexp 728 | "^.*$" 729 | "Regexp to match a line.") 730 | 731 | (defun m-buffer-match-line (&rest match) 732 | "Return a list of match data to all lines. 733 | MATCH is of the form BUFFER-OR-WINDOW MATCH-OPTIONS. 734 | See `m-buffer-match for further details." 735 | (m-buffer-apply-join 736 | 'm-buffer-match 737 | match :regexp m-buffer--line-regexp 738 | :post-match 'm-buffer-post-match-forward-char)) 739 | 740 | (defun m-buffer-match-line-start (&rest match) 741 | "Return a list of match data to all line start. 742 | MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See 743 | `m-buffer-match' for further details." 744 | (m-buffer-apply-join 745 | 'm-buffer-match-begin 746 | match :regexp "^" 747 | :post-match 'm-buffer-post-match-forward-char)) 748 | 749 | (defun m-buffer-match-line-end (&rest match) 750 | "Return a list of match to line end. 751 | MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See 752 | `m-buffer-match' for further details." 753 | (m-buffer-apply-join 754 | 'm-buffer-match-begin 755 | match :regexp "$" 756 | :post-match 'm-buffer-post-match-forward-char)) 757 | ;; #+end_src 758 | 759 | ;; This is the first use of the =post-match= to terminate the loop, and was 760 | ;; actually the motivation for adding it. We automatically terminate after the 761 | ;; first match by simply returning nil. 762 | 763 | ;; #+begin_src emacs-lisp 764 | (defun m-buffer-match-first (&rest match) 765 | "Return the first match to MATCH. 766 | This matches more efficiently than matching all matches and 767 | taking the car. See `m-buffer-match' for further details of 768 | MATCH." 769 | (m-buffer-apply-join 770 | #'m-buffer-match match 771 | :post-match (lambda () nil))) 772 | 773 | (defun m-buffer-match-first-line (&rest match) 774 | "Return a match to the first line of MATCH. 775 | This matches more efficiently than matching all lines and taking 776 | the car. See `m-buffer-match' for further details of MATCH." 777 | (m-buffer-apply-join 778 | 'm-buffer-match-first match 779 | :regexp m-buffer--line-regexp)) 780 | 781 | (defun m-buffer-match-multi (regexps &rest match) 782 | "Incrementally find matches to REGEXPS in MATCH. 783 | Finds the first match to the first element of regexps, then 784 | starting from the end of this match, the first match to the 785 | second element of regexps and so forth. See `m-buffer-match' for 786 | futher details of MATCH." 787 | (when regexps 788 | (let ((first-match 789 | (m-buffer-apply-join 790 | #'m-buffer-match-first 791 | match 792 | :regexp (car regexps)))) 793 | (append 794 | first-match 795 | (apply 796 | #'m-buffer-match-multi 797 | (cdr regexps) 798 | (plist-put 799 | match 800 | :begin (car (m-buffer-match-end first-match)))))))) 801 | ;; #+end_src 802 | 803 | ;; Emacs has a rather inconsistent interface here -- suddenly, we have a function 804 | ;; rather than a variable for accessing a regexp. 805 | 806 | ;; #+begin_src emacs-lisp 807 | (defun m-buffer-match-sentence-end (&rest match) 808 | "Return a list of match to sentence end. 809 | MATCH is of the form BUFFER-OR-WINDOW MATCH-OPTIONS. See 810 | `m-buffer-match' for further details." 811 | (m-buffer-apply-join 812 | 'm-buffer-match-begin 813 | match :regexp (sentence-end))) 814 | 815 | (defun m-buffer-match-word (&rest match) 816 | "Return a list of match to all words. 817 | MATCH is of the form BUFFER-OR-WINDOW MATCH-OPTIONS. See 818 | `m-buffer-match' for further details." 819 | (m-buffer-apply-join 820 | 'm-buffer-match 821 | match :regexp "\\\w+")) 822 | 823 | (defun m-buffer-match-empty-line (&rest match) 824 | "Return a list of match to all empty lines. 825 | MATCH is of the form BUFFER-OR-WINDOW MATCH-OPTIONS. See 826 | `m-buffer-match' for further details." 827 | (m-buffer-apply-join 828 | 'm-buffer-match 829 | match :regexp "^$" 830 | :post-match 'm-buffer-post-match-forward-line)) 831 | 832 | (defun m-buffer-match-non-empty-line (&rest match) 833 | "Return a list of match to all non-empty lines. 834 | MATCH is fo the form BUFFER-OR-WINDOW MATCH-OPTIONS. See 835 | `m-buffer-match' for further details." 836 | (m-buffer-apply-join 837 | 'm-buffer-match 838 | match :regexp "^.+$")) 839 | 840 | (defun m-buffer-match-whitespace-line (&rest match) 841 | "Return match data to all lines with only whitespace characters. 842 | Note empty lines are not included. MATCH is of form 843 | BUFFER-OR-WINDOW MATCH-OPTIONS. See `m-buffer-match' for 844 | further details." 845 | (m-buffer-apply-join 846 | 'm-buffer-match 847 | match :regexp "^\\s-+$")) 848 | 849 | ;; #+end_src 850 | 851 | ;; I don't think that there is a way to do this with regexps entirely, so we use 852 | ;; substraction. 853 | 854 | ;; #+begin_src emacs-lisp 855 | (defun m-buffer-match-non-whitespace-line (&rest match) 856 | "Return match data to all lines with at least one non-whitespace character. 857 | Note empty lines do not contain any non-whitespace lines. 858 | MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See 859 | `m-buffer-match' for further details." 860 | (seq-difference 861 | (apply #'m-buffer-match-line match) 862 | (apply #'m-buffer-match-whitespace-line match))) 863 | 864 | ;; Useful post-match functions 865 | (defun m-buffer-post-match-forward-line () 866 | "Attempt to move forward one line, return true if success." 867 | (= 0 (forward-line))) 868 | 869 | (defun m-buffer-post-match-forward-char () 870 | "Attempts to move forward one char. 871 | Returns true if succeeds." 872 | (condition-case _e 873 | (progn 874 | (forward-char) 875 | t) 876 | (error 'end-of-buffer 877 | nil))) 878 | ;; #+end_src 879 | 880 | 881 | ;; ** Apply Function to Match 882 | 883 | ;; These functions apply another function to some match-data. This is pretty 884 | ;; useful generically, but also I use it for many of the following functions. 885 | 886 | ;; #+begin_src emacs-lisp 887 | (defun m-buffer-on-region (fn match-data) 888 | "Apply FN to MATCH-DATA. 889 | FN should take two args, the start and stop of each region. 890 | MATCH-DATA can be any list of lists with two elements (or more)." 891 | (m-buffer-on-region-nth-group fn 0 match-data)) 892 | 893 | (defun m-buffer-on-region-nth-group (fn n match-data) 894 | "Apply FN to the Nth group of MATCH-DATA. 895 | FN should take two args, the start and stop of each region. 896 | MATCH-DATA can be any list of lists with two elements (or more)." 897 | (seq-map 898 | (lambda (x) 899 | (apply fn x)) 900 | (m-buffer-match-nth-group n match-data))) 901 | ;; #+end_src 902 | 903 | ;; ** Overlay and Property Functions 904 | 905 | ;; Adding properties or overlays to match-data. The functionality here somewhat 906 | ;; overlaps with [[https://github.com/ShingoFukuyama/ov.el][ov.el]], which I didn't know about when I wrote this. It generally 907 | ;; works over overlays, or regexps, while m-buffer works over match-data. 908 | 909 | ;; #+begin_src emacs-lisp 910 | (defun m-buffer-overlay-match (match-data &optional front-advance rear-advance) 911 | "Return an overlay for all match to MATCH-DATA. 912 | FRONT-ADVANCE and REAR-ADVANCE controls the borders of the 913 | overlay as defined in `make-overlay'. Overlays do not scale that 914 | well, so use `m-buffer-propertize-match' if you intend to make 915 | and keep many of these. 916 | 917 | See Info node `(elisp) Overlays' for further information." 918 | (let ((buffer (m-buffer-buffer-for-match match-data))) 919 | (m-buffer-on-region 920 | (lambda (beginning end) 921 | (make-overlay 922 | beginning end buffer 923 | front-advance rear-advance)) 924 | match-data))) 925 | 926 | (defun m-buffer-add-text-property-match 927 | (match-data properties) 928 | "To MATCH-DATA add PROPERTIES. 929 | See `add-text-property' for details of the format of properties. 930 | Text properties are associated with the text and move with it. See 931 | Info node `(elisp) Text Properties' for further details." 932 | (m-buffer-on-region 933 | (lambda (beginning end) 934 | (add-text-properties beginning end properties)) 935 | match-data)) 936 | 937 | (defun m-buffer-put-text-property-match (match-data property value) 938 | "To MATCH-DATA add PROPERTY wth VALUE. 939 | See `put-text-property' for details of the format of properties. 940 | Text properties are associated with the text and move with it. See 941 | Info node `(elisp) Text Properties' for further details." 942 | (m-buffer-on-region 943 | (lambda (beginning end) 944 | (put-text-property beginning end property value)) 945 | match-data)) 946 | 947 | (defun m-buffer-overlay-face-match (match-data face) 948 | "To MATCH-DATA add FACE to the face property. 949 | This is for use in buffers which do not have function `font-lock-mode' 950 | enabled; otherwise use `m-buffer-overlay-font-lock-face-match'." 951 | (seq-map 952 | (lambda (ovly) 953 | (overlay-put ovly 'face face)) 954 | (m-buffer-overlay-match match-data))) 955 | 956 | (defun m-buffer-overlay-font-lock-face-match (match-data face) 957 | "To MATCH-DATA add FACE to the face property. 958 | This is for use in buffers which have variable `font-lock-mode' enabled; 959 | otherwise use `m-buffer-overlay-face-match'." 960 | (seq-map 961 | (lambda (ovly) 962 | (overlay-put ovly 'face face)) 963 | (m-buffer-overlay-match match-data))) 964 | 965 | (defun m-buffer-text-property-face (match-data face) 966 | "To MATCH-DATA apply FACE. 967 | This is for use in buffers which do 968 | not have variable `font-lock-mode' enabled; otherwise use 969 | `m-buffer-text-property-font-lock-face'." 970 | (m-buffer-put-text-property-match match-data 971 | 'face face)) 972 | 973 | (defun m-buffer-text-property-font-lock-face (match-data face) 974 | "To MATCH-DATA apply FACE. 975 | This is for use in buffers which have variable `font-lock-mode' 976 | enabled; otherwise use `m-buffer-text-property-face'." 977 | (m-buffer-put-text-property-match match-data 978 | 'font-lock-face face)) 979 | 980 | (provide 'm-buffer) 981 | 982 | 983 | ;;; m-buffer.el ends here 984 | ;; #+end_src 985 | --------------------------------------------------------------------------------