--- /dev/null
+;;; assess-call.el --- Call and Return -*- lexical-binding: t -*-
+
+;;; Header:
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <phillip.lord@russet.org.uk>
+;; Maintainer: Phillip Lord <phillip.lord@russet.org.uk>
+
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2016, Phillip Lord
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Capture calls to functions, checking parameters and return values.
+
+;;; Code:
+
+;; ** Call Capture
+
+;; Here we provide a function for tracing calls to a particular function. This
+;; can be a direct or indirect call; parameters and return values are available
+;; for inspection afterwards. For example:
+
+;; #+begin_src elisp
+;; (assess-call-capture
+;; '+
+;; (lambda()
+;; (+ 1 1)))
+;; ;; => (((1 1) . 2))
+;; #+end_src
+
+;; The return value is a list of cons cells, one for each invocation, of the
+;; parameters and return values.
+
+
+;; #+begin_src emacs-lisp
+(defun assess-call--capture-lambda ()
+ "Return function which captures args and returns of another.
+
+The returned function takes FN the function to call, and any
+number of ARGS to call the function with. In the special case,
+that FN is equal to `:return`, then all previous args and return
+values of FN are returned instead."
+ (let ((capture-store nil))
+ (lambda (fn &rest args)
+ (if (eq fn :return)
+ capture-store
+ (let ((rtn (apply fn args)))
+ (setq capture-store
+ (cons (cons args rtn)
+ capture-store))
+ rtn)))))
+
+(defun assess-call-capture (sym-fn fn)
+ "Trace all calls to SYM-FN when FN is called with no args.
+
+The return value is a list of cons cells, with car being the
+parameters of the calls, and the cdr being the return value."
+ (let ((capture-lambda
+ (assess-call--capture-lambda)))
+ (unwind-protect
+ (progn (advice-add sym-fn :around capture-lambda)
+ (funcall fn)
+ (funcall capture-lambda :return))
+ (advice-remove sym-fn capture-lambda))))
+
+(defun assess-call--hook-capture-lambda ()
+ "Returns a function which captures all of its args.
+
+The returned function takes any number of ARGS. In the special
+case that the first arg is `:return` then it returns all previous
+args."
+ (let ((capture-store nil))
+ (lambda (&rest args)
+ (if (eq (car-safe args) :return)
+ capture-store
+ (setq capture-store
+ (cons
+ args
+ capture-store))))))
+
+(defun assess-call-capture-hook (hook-var fn &optional append local)
+ "Trace all calls to HOOK-VAR when FN is called with no args.
+APPEND and LOCAL are passed to `add-hook` and documented there."
+ (let ((capture-lambda
+ (assess-call--hook-capture-lambda)))
+ (unwind-protect
+ (progn
+ (add-hook hook-var
+ capture-lambda
+ append local)
+ (funcall fn)
+ (funcall capture-lambda :return))
+ (remove-hook hook-var
+ capture-lambda
+ local))))
+
+(provide 'assess-call)
+;;; assess-call.el ends here
+;; #+end_src
--- /dev/null
+;;; assess-discover.el --- Test support functions -*- lexical-binding: t -*-
+
+;;; Header:
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <phillip.lord@russet.org.uk>
+;; Maintainer: Phillip Lord <phillip.lord@russet.org.uk>
+
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2015, 2016, Phillip Lord
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+
+;; #+begin_src emacs-lisp
+(defun assess-discover-tests (directory)
+ "Discover tests in directory.
+
+Tests must conform to one (and only one!) of several naming
+schemes.
+
+ - End with -test.el
+ - End with -tests.el
+ - Start with test-
+ - Any .el file in a directory called test
+ - Any .el file in a directory called tests
+
+Each of these is tried until one matches. So, a top-level file
+called \"blah-test.el\" will prevent discovery of files in a
+tests directory."
+ (or
+ ;; files with
+ (directory-files directory nil ".*-test.el$")
+ (directory-files directory nil ".*-tests.el$")
+ (directory-files directory nil "test-.*.el$")
+ (let ((dir-test
+ (concat directory "test/")))
+ (when (file-exists-p dir-test)
+ (mapcar
+ (lambda (file)
+ (concat dir-test file))
+ (directory-files dir-test nil ".*.el"))))
+ (let ((dir-tests
+ (concat directory "tests/")))
+ (when (file-exists-p dir-tests)
+ (mapcar
+ (lambda (file)
+ (concat dir-tests file))
+ (directory-files dir-tests nil ".*.el"))))))
+
+(defun assess-discover--load-all-tests (directory)
+ (mapc
+ 'load
+ (assess-discover-tests directory)))
+
+(defun assess-discover-load-tests ()
+ (interactive)
+ (assess-discover--load-all-tests default-directory))
+
+;;;###autoload
+(defun assess-discover-run-batch (&optional selector)
+ (assess-discover--load-all-tests default-directory)
+ (ert-run-tests-batch selector))
+
+;;;###autoload
+(defun assess-discover-run-and-exit-batch (&optional selector)
+ (assess-discover--load-all-tests default-directory)
+ (ert-run-tests-batch-and-exit selector))
+
+(provide 'assess-discover)
+;;; assess-discover.el ends here
+;; #+end_src
--- /dev/null
+;;; assess-robot.el --- Test support functions -*- lexical-binding: t -*-
+
+;;; Header:
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <phillip.lord@russet.org.uk>
+;; Maintainer: Phillip Lord <phillip.lord@russet.org.uk>
+;; Version: 0.2
+
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2016, Phillip Lord
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+(defmacro assess-robot-with-switched-buffer (buffer &rest body)
+ "With BUFFER, evaluate BODY.
+
+This macro is rather like `with-current-buffer', except that it
+uses `switch-to-buffer'. This is generally a bad idea when used
+programmatically. But, it is necessary, for example, when using
+keyboard macros."
+ (declare (indent 1) (debug t))
+ (let ((before-buffer (make-symbol "before-buffer")))
+ `(let ((,before-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (switch-to-buffer ,buffer)
+ ,@body)
+ (switch-to-buffer ,before-buffer)))))
+
+(defmacro assess-robot-with-temp-switched-buffer (&rest body)
+ "Evaluate BODY in temporary buffer.
+
+As with `assess-robot-with-switched-buffer', `switch-to-buffer'
+is used."
+ (declare (indent 0) (debug t))
+ (let ((temp-buffer (make-symbol "temp-buffer")))
+ `(let ((,temp-buffer (generate-new-buffer " *temp*")))
+ (assess-robot-with-switched-buffer ,temp-buffer
+ (unwind-protect
+ (progn
+ ;; Enable the undo list because we want it for most robot
+ ;; situations.
+ (setq buffer-undo-list nil)
+ ,@body)
+ (and (buffer-name ,temp-buffer)
+ (kill-buffer ,temp-buffer)))))))
+
+(defmacro assess-robot-with-switched-buffer-string (&rest body)
+ "Evalate BODY in a temporary buffer and return buffer string.
+
+See also `assess-robot-with-temp-switched-buffer'."
+ (declare (debug t))
+ `(assess-robot-with-temp-switched-buffer
+ (progn
+ ,@body
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+
+(defun assess-robot-execute-kmacro (macro)
+ "Execute the MACRO.
+
+In this case, MACRO is the \"long form\" accepted by
+`edit-kdb-macro'."
+ (let ((macro (read-kbd-macro macro)))
+ ;; I wanted to add a nice way to edit the macro, but sadly
+ ;; edit-kdb-macro provides no nice entry point. So, we take the nasty step
+ ;; of setting the last-kbd-macro instead.
+ (setq last-kbd-macro macro)
+ (execute-kbd-macro
+ (read-kbd-macro macro))))
+
+(defun assess-robot-copy-and-finish ()
+ "Copy the macro in edmacro to the kill-ring."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "Macro:")
+ (forward-line)
+ (let ((string
+ (buffer-substring-no-properties
+ (point)
+ (point-max))))
+ (with-temp-buffer
+ (insert "\"")
+ (insert string)
+ (insert "\"")
+ (kill-ring-save (point-min)
+ (point-max))))
+ (edmacro-finish-edit)))
+
+(eval-after-load
+ 'edmacro
+ '(define-key edmacro-mode-map (kbd "C-c C-k") 'assess-robot-copy-and-finish))
+
+(provide 'assess-robot)
+;;; assess-robot.el ends here
--- /dev/null
+;;; assess.el --- Test support functions -*- lexical-binding: t -*-
+
+;;; Header:
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <phillip.lord@russet.org.uk>
+;; Maintainer: Phillip Lord <phillip.lord@russet.org.uk>
+;; Version: 0.4
+;; Package-Requires: ((emacs "24.1")(m-buffer "0.15"))
+
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2015, 2016, Phillip Lord
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides functions to support ert, the Emacs Regression Test
+;; framework. It includes:
+
+;; - a set of predicates for comparing strings, buffers and file contents.
+;; - explainer functions for all predicates giving useful output
+;; - macros for creating many temporary buffers at once, and for restoring the
+;; buffer list.
+;; - methods for testing indentation, by comparison or "round-tripping".
+;; - methods for testing fontification.
+
+;; Assess aims to be a stateless as possible, leaving Emacs unchanged whether
+;; the tests succeed or fail, with respect to buffers, open files and so on; this
+;; helps to keep tests independent from each other. Violations of this will be
+;; considered a bug.
+
+;; Assess aims also to be as noiseless as possible, reducing and suppressing
+;; extraneous messages where possible, to leave a clean ert output in batch mode.
+
+
+;;; Status:
+
+;; Assess is currently a work in progress; the API is not currently stable. I
+;; may also considering winding this into ert-x, because then it can be used
+;; to test core.
+
+;; Assess used to be called sisyphus which seemed like a good idea when I
+;; started, but I kept spelling it wrong.
+
+
+;;; Code:
+
+;; ** Preliminaries
+
+;; #+begin_src emacs-lisp
+(require 'pp)
+(require 'ert)
+(require 'm-buffer-at)
+(require 'm-buffer)
+(require 'seq)
+;; #+end_src
+
+;; ** Advice
+
+;; Emacs-24 insists on printing out results on a single line with escaped
+;; newlines. This does not work so well with the explainer functions in assess
+;; and, probably, does not make sense anywhere. So, we advice here. The use of
+;; nadvice.el limits this package to Emacs 24.4. Emacs 25 has this fixed.
+
+;; #+begin_src emacs-lisp
+(when (fboundp 'advice-add)
+
+ (defun assess--ert-pp-with-indentation-and-newline (orig object)
+ (let ((pp-escape-newlines nil))
+ (funcall orig object)))
+
+ (advice-add
+ 'ert--pp-with-indentation-and-newline
+ :around
+ #'assess--ert-pp-with-indentation-and-newline))
+;; #+end_src
+
+;; ** Deliberate Errors
+
+;; Sometimes during testing, we need to throw an "error" deliberately. Assess'
+;; own test cases do this to check that state is preserved with this form of
+;; non-local exit. Throwing `error' itself is a bit dangerous because we might
+;; get that for other reasons; so we create a new symbol here for general use.
+
+;; #+begin_src emacs-lisp
+(if (fboundp 'define-error)
+ (define-error 'assess-deliberate-error
+ "An error deliberately caused during testing."
+ 'error)
+ (put 'assess-deliberate-error
+ 'error-conditions
+ '(error assess-deliberate-error))
+ (put 'assess-deliberate-error
+ 'error-message
+ "A error deliberately caused during testing."))
+;; #+end_src
+
+;; ** Buffer creation
+
+;; For tests, it is often better to use temporary buffers, as it is much less
+;; affected by the existing state of Emacs, and much less likely to affect future
+;; state; this is particularly the case where tests are being developed as the
+;; developer may be trying to change or write test files at the same time as
+;; Emacs is trying to use them for testing.
+
+;; Emacs really only provides a single primitive `with-temp-buffer' for this
+;; situation, and that only creates a single temporary buffer at a time. Nesting
+;; of these forms sometimes works, but fails if we need to operate on two buffers
+;; at once.
+
+;; So, we provide an environment for restoring the buffer list. This allows any
+;; creation of buffers we need for testing, followed by clean up afterwards. For
+;; example, a trivial usage would be to remove buffers explicitly created.
+
+;; #+begin_src elisp
+;; (assess-with-preserved-buffer-list
+;; (get-buffer-create "a")
+;; (get-buffer-create "b")
+;; (get-buffer-create "c"))
+;; #+end_src
+
+;; Any buffer created in this scope is removed, whether this is as a direct or
+;; indirect result of the function. For example, this usage creates a ~*Help*~
+;; buffer which then gets removed again.
+
+;; #+begin_src elisp
+;; (assess-with-preserved-buffer-list
+;; (describe-function 'self-insert-command))
+;; #+end_src
+
+;; This does not prevent changes to existing buffers of course. If ~*Help*~ is
+;; already open before evaluation, it will remain open afterwards but with
+;; different content.
+
+;; Sometimes, it is useful to create several temporary buffers at once.
+;; `assess-with-temp-buffers' provides an easy mechanism for doing this, as
+;; well as evaluating content in these buffers. For example, this returns true
+;; (actually three killed buffers which were live when the `mapc' form runs).
+
+;; #+begin_src elisp
+;; (assess-with-temp-buffers
+;; (a b c)
+;; (mapc #'buffer-live-p (list a b c)))
+;; #+end_src
+
+;; While this creates two buffers, puts "hellogoodbye" into one and "goodbye"
+;; into the other, then compares the contents of these buffers with `assess='.
+
+;; #+begin_src elisp
+;; (assess-with-temp-buffers
+;; ((a (insert "hello")
+;; (insert "goodbye"))
+;; (b (insert "goodbye")))
+;; (assess= a b))
+;; #+end_src
+
+;; Finally, we provide a simple mechanism for converting any assess type into a
+;; buffer. The following form, for example, returns the contents of the ~.emacs~
+;; file.
+
+;; #+begin_src elisp
+;; (assess-as-temp-buffer
+;; (assess-file "~/.emacs")
+;; (buffer-string))
+;; #+end_src
+
+;; *** Implementation
+
+;; #+begin_src emacs-lisp
+(defmacro assess-with-preserved-buffer-list (&rest body)
+ "Evaluate BODY, but delete any buffers that have been created."
+ (declare (debug t))
+ `(let ((before-buffer-list
+ (buffer-list)))
+ (unwind-protect
+ (progn
+ ,@body)
+ (seq-map
+ (lambda (it)
+ (with-current-buffer it
+ (set-buffer-modified-p nil)
+ (kill-buffer)))
+ (seq-difference (buffer-list)
+ before-buffer-list)))))
+
+(defun assess--temp-buffer-let-form (item)
+ (if (not (listp item))
+ (assess--temp-buffer-let-form
+ (list item))
+ `(,(car item)
+ (with-current-buffer
+ (generate-new-buffer " *assess-with-temp-buffers*")
+ ,@(cdr item)
+ (current-buffer)))))
+;; #+end_src
+
+;; The implementation of `assess-with-temp-buffers' currently uses
+;; `assess-with-preserved-buffer-list' to remove buffers which means that it
+;; will also delete any buffers created by the user; this may be a mistake, and
+;; it might be better to delete the relevant buffers explicitly.
+
+;; #+begin_src emacs-lisp
+(defmacro assess-with-temp-buffers (varlist &rest body)
+ "Bind variables in varlist to temp buffers, then eval BODY.
+
+VARLIST is (nearly) of the same form as a `let' binding. Each
+element is a symbol or a list (symbol valueforms). Each symbol is
+bound to a buffer generated with `generate-new-buffer'.
+VALUEFORMS are evaluated with the buffer current. Any buffers
+created inside this form (and not just by this form!) are
+unconditionally killed at the end of the form.
+
+Unlike `let' there can be multiple valueforms which are,
+effectively, placed within an impicit `progn'."
+ (declare (indent 1)
+ (debug
+ ((&rest (symbolp &rest form))
+ body)))
+ (let ((let-form
+ (seq-map
+ #'assess--temp-buffer-let-form
+ varlist)))
+ `(assess-with-preserved-buffer-list
+ (let* ,let-form
+ ,@body))))
+
+(defmacro assess-as-temp-buffer (x &rest body)
+ "Insert X in a type-appropriate way into a temp buffer and eval
+BODY there.
+
+See `assess-to-string' for the meaning of type-appropriate."
+ (declare (indent 1) (debug t))
+ `(with-temp-buffer
+ (insert (assess-to-string ,x))
+ ,@body))
+;; #+end_src
+
+;; ** Types
+
+;; Many tests on files or buffers actually end up being string comparison.
+;; In many cases, we want to compare the *contents* of a buffer to, for example,
+;; the *contents* of a file.
+
+;; Emacs normally uses strings to represent files (i.e. file names) and can also
+;; use them to represent buffers (i.e. buffer names). So, here, we introduce a
+;; set of "types" where so that we can distinguish between strings, buffer names
+;; and file names, passing them at a single parameter. This will allow us to make
+;; later parts of the API use overloaded methods based on their type.
+
+;; "Types" are either a Emacs core type (as with buffers and strings), or an 2
+;; element list (I haven't used cons cells in case I want to add more elements),
+;; with a keyword at the head. This allows assess to distinguish between a
+;; simple string and a file or buffer name.
+
+;; #+begin_src elisp
+;; ;; Identify "~/.emacs" as a file name
+;; (assess-file "~/.emacs")
+
+;; ;; Identify "*Messages*" as a buffer
+;; (assess-buffer "*Messages*")
+;; #+end_src
+
+;; *** Implementation
+
+;; #+begin_src emacs-lisp
+(defun assess-to-string (x)
+ "Turn X into a string in a type appropriate way.
+
+If X is identified as a file, returns the file contents.
+If X is identified as a buffer, returns the buffer contents.
+If X is a string, returns that.
+
+See also `assess-buffer' and `assess-file' which turn a
+string into something that will identified appropriately."
+ (pcase x
+ ((pred stringp) x)
+ ((pred bufferp) (m-buffer-at-string x))
+ (`(:buffer ,b) (assess-to-string (get-buffer-create b)))
+ (`(:file ,f)
+ (with-temp-buffer
+ (insert-file-contents f)
+ (buffer-string)))
+ ;; error condition
+ (_ (error "Type not recognised"))))
+
+(defun assess-buffer (b)
+ "Add type data to the string B marking it as a buffer."
+ `(:buffer ,b))
+
+(defun assess-file (f)
+ "Add type data to the string F marking it as a file."
+ `(:file ,f))
+
+(defun assess-to-file-name (file)
+ "Return file name for FILE.
+
+FILE can be either a string, or a plist returned by
+`assess-file' or `assess-make-related-file'."
+ (pcase file
+ ((pred stringp) file)
+ (`(:file ,f) f)
+ (_ (error "Type not recognised"))))
+;; #+end_src
+
+;; ** Entity Comparison
+
+;; In this section, we provide support for comparing strings, buffer or file
+;; contents. The main entry point is `assess=', which works like `string=' but
+;; on any of the three data types, in any order.
+
+;; #+begin_src elisp
+;; ;; Compare Two Strings
+;; (assess= "hello" "goodbye")
+
+;; ;; Compare the contents of Two Buffers
+;; (assess=
+;; (assess-buffer "assess.el")
+;; (assess-buffer "assess-previous.el"))
+
+;; ;; Compare the contents of Two files
+;; (assess=
+;; (assess-file "~/.emacs")
+;; (assess-file "~/.emacs"))
+
+;; ;; We can use core Emacs types also
+;; (assess=
+;; (assess-buffer "assess.el")
+;; (get-buffer "assess-previous.el"))
+
+;; ;; And in any combination; here we compare a string and the contents of a
+;; ;; file.
+;; (assess=
+;; ";; This is an empty .emacs file"
+;; (assess-file "~/.emacs"))
+;; #+end_src
+
+;; In addition, `assess=' has an "explainer" function attached which produces a
+;; richer output when `assess=' returns false, showing diffs of the string
+;; comparison. Compare, for example, the results of running these two tests, one
+;; using `string=' and one using `assess='.
+
+;; #+BEGIN_EXAMPLE
+;; F temp
+;; (ert-test-failed
+;; ((should
+;; (string= "a" "b"))
+;; :form
+;; (string= "a" "b")
+;; :value nil))
+
+;; F test-assess=
+;; (ert-test-failed
+;; ((should
+;; (assess= "a" "b"))
+;; :form
+;; (assess= "a" "b")
+;; :value nil :explanation "Strings:
+;; a
+;; and
+;; b
+;; Differ at:*** /tmp/a935uPW 2016-01-20 13:25:47.373076381 +0000
+;; --- /tmp/b9357Zc 2016-01-20 13:25:47.437076381 +0000
+;; ***************
+;; *** 1 ****
+;; ! a
+;; \\ No newline at end of file
+;; --- 1 ----
+;; ! b
+;; \\ No newline at end of file
+
+;; "))
+;; #+END_EXAMPLE
+
+;; As `assess=' has a compatible interface with `string=' it is also possible
+;; to add this explainer function to `string=' for use with tests which do not
+;; otherwise use assess, like so:
+
+;; #+begin_src elisp
+;; (put 'string= 'ert-explainer 'assess-explain=)
+;; #+end_src
+
+;; Currently, `assess' uses the ~diff~ program to do the comparison if it is
+;; available, or falls back to just reporting a difference -- this could do with
+;; improving, but it is at least no worse than the existing behaviour for string
+;; comparison.
+
+;; *** Implementation
+
+;; We start by writing a file silently -- this is important because the
+;; ~*Messages*~ buffer should not be affected by the machinary of a failing test,
+;; as it hides what is happening from the test code.
+
+;; #+begin_src emacs-lisp
+(defun assess--write-file-silently (filename)
+ "Write current buffer into FILENAME.
+Unlike most other ways of saving a file, this should not
+print any messages!"
+ (write-region
+ (point-min) (point-max)
+ filename nil
+ 'dont-display-wrote-file-message))
+;; #+end_src
+
+;; Diff does a nicer comparison than anything in Emacs, although a lisp
+;; implementation would have been more portable. Diff is used by quite a few
+;; other tools in Emacs, so probably most people will have access to diff.
+
+;; #+begin_src emacs-lisp
+(defun assess--explainer-diff-string= (a b)
+ "Compare strings A and B using diff output.
+
+We assume that diff exists. Temporary files are left
+afterwards for cleanup by the operating system."
+ (assess-with-preserved-buffer-list
+ (let* ((diff
+ (executable-find "diff"))
+ (a-buffer
+ (generate-new-buffer "a"))
+ (b-buffer
+ (generate-new-buffer "b"))
+ (a-file
+ (make-temp-file
+ (buffer-name a-buffer)))
+ (b-file
+ (make-temp-file
+ (buffer-name b-buffer))))
+ (with-current-buffer
+ a-buffer
+ (insert a)
+ (assess--write-file-silently a-file))
+ (with-current-buffer
+ b-buffer
+ (insert b)
+ (assess--write-file-silently b-file))
+ (progn
+ (format "Strings:\n%s\nand\n%s\nDiffer at:%s\n"
+ a b
+ (with-temp-buffer
+ (call-process
+ diff
+ ;; no infile
+ nil
+ ;; dump to current buffer
+ t
+ nil
+ "-c"
+ a-file
+ b-file)
+ (buffer-string)))))))
+
+(defun assess--explainer-simple-string= (a b)
+ "Compare strings for first difference."
+ ;; We could do a bit more here.
+ (format "String :%s:%s: are not equal." a b))
+;; #+end_src
+
+;; And the actual predicate function and explainer. We do a simple string
+;; comparison on the contents of each entity.
+
+;; #+begin_src emacs-lisp
+(defun assess= (a b)
+ "Compare A and B to see if they are the same.
+
+Equality in this sense means compare the contents in a way which
+is appropriate for the type of the two arguments. So, if they are
+strings, the compare strings, if buffers, then compare the buffer
+contents and so on.
+
+Text properties in strings or buffers are ignored."
+ (string=
+ (assess-to-string a)
+ (assess-to-string b)))
+
+(defun assess-explain= (a b)
+ "Compare A and B and return an explanation.
+
+This function is called by ERT as an explainer function
+automatically. See `assess=' for more information."
+ (let ((a (assess-to-string a))
+ (b (assess-to-string b)))
+ (cond
+ ((assess= a b)
+ t)
+ ((executable-find "diff")
+ (assess--explainer-diff-string= a b))
+ (t
+ (assess--explainer-simple-string= a b)))))
+
+(put 'assess= 'ert-explainer 'assess-explain=)
+;; #+end_src
+
+;; ** Opening files
+
+;; Opening files presents a particular problem for testing, particularly if we
+;; open a file that is already open in the same or a different Emacs. For batch
+;; use of Emacs with parallelisation, the situation becomes intractable.
+
+;; A solution is to copy files before we open them, which means that they can be
+;; changed freely. Largely, the copied file will behave the same as the main file;
+;; the only notable exception to this is those features which depend on the
+;; current working directory (dir-local variables, for example).
+
+;; ~assess-make-related-file~ provides a simple method for doing this. For
+;; example, this form will return exactly the contents of ~my-test-file.el~, even
+;; if that file is current open in the current Emacs (even if the buffer has not
+;; been saved). Likewise, a test opening this file could be run in a batch Emacs
+;; without interfering with an running interactive Emacs.
+
+;; #+begin_src elisp
+;; (assess-as-temp-buffer
+;; (assess-make-related-file "dev-resources/my-test-file.el")
+;; (buffer-substring))
+;; #+end_src
+
+;; We also add support for opening a file, as if it where opened interactively,
+;; with all the appropriate hooks being run, in the form of the
+;; `assess-with-find-file' macro. Combined with `assess-make-related-file',
+;; we can write the following expression without removing our ~.emacs~.
+
+;; #+begin_src elisp
+;; (assess-with-find-file
+;; (assess-make-related-file "~/.emacs")
+;; (erase-buffer)
+;; (save-buffer))
+;; #+end_src
+
+;; #+RESULTS:
+
+;; *** Implementation
+
+;; All of the functions here support the file type introduced earlier, but
+;; interpret raw strings as a file also.
+
+;; #+begin_src emacs-lisp
+(defun assess--make-related-file-1 (file &optional directory)
+ (make-temp-file
+ (concat
+ (or directory
+ temporary-file-directory)
+ (file-name-nondirectory file))
+ nil
+ (concat "."
+ (file-name-extension file))))
+
+(defun assess-make-related-file (file &optional directory)
+ "Open a copy of FILE in DIRECTORY.
+
+FILE is copied to a temporary file in DIRECTORY or
+`temporary-file-directory'. The copy has a unique name but shares
+the same file extension.
+
+This is useful for making test changes to FILE without actually
+altering it."
+ (let* ((file (assess-to-file-name file))
+ (related-file
+ (assess--make-related-file-1 file directory)))
+ (copy-file file related-file t)
+ (assess-file
+ related-file)))
+
+(defmacro assess-with-find-file (file &rest body)
+ "Open FILE and evaluate BODY in resultant buffer.
+
+FILE is opened with `find-file-noselect' so all the normal hooks
+for file opening should occur. The buffer is killed after the
+macro exits, unless it was already open. This happens
+unconditionally, even if the buffer has changed.
+
+See also `assess-make-related-file'."
+ (declare (debug t) (indent 1))
+ (let ((temp-buffer (make-symbol "temp-buffer"))
+ (file-has-buffer-p (make-symbol "file-has-buffer-p"))
+ (file-s (make-symbol "file")))
+ `(let* ((,file-s ,file)
+ (,file-s (assess-to-file-name ,file-s))
+ (,file-has-buffer-p
+ (find-buffer-visiting ,file-s))
+ (,temp-buffer))
+ (unwind-protect
+ (with-current-buffer
+ (setq ,temp-buffer
+ (find-file-noselect ,file-s))
+ ,@body)
+ (when
+ ;; kill the buffer unless it was already open.
+ (and (not ,file-has-buffer-p)
+ (buffer-live-p ,temp-buffer))
+ ;; kill unconditionally
+ (with-current-buffer ,temp-buffer
+ (set-buffer-modified-p nil))
+ (kill-buffer ,temp-buffer))))))
+;; #+end_src
+
+;; ** Creating Files and Directories
+;; I can write some documentation here if Phil wants to merge code below.
+;; *** Implementation
+;; #+BEGIN_SRC emacs-lisp
+(defun assess-with-filesystem--make-parent (spec path)
+ "If SPEC is a file name, create its parent directory rooted at PATH."
+ (save-match-data
+ (when (string-match "\\(.*\\)/" spec)
+ (make-directory (concat path "/" (match-string 1 spec)) t))))
+
+(defun assess-with-filesystem--init (spec &optional path)
+ "Interpret the SPEC inside PATH."
+ (setq path (or path "."))
+ (cond
+ ((listp spec)
+ (cond
+ ;; non-empty file
+ ((and (stringp (car spec))
+ (stringp (cadr spec)))
+ (when (string-match-p "/\\'" (car spec))
+ (error "Invalid syntax: `%s' - cannot create a directory with text content" (car spec)))
+ (assess-with-filesystem--make-parent (car spec) path)
+ (with-temp-file (concat path "/" (car spec))
+ (insert (cadr spec))))
+ ;; directory
+ ((and (stringp (car spec))
+ (consp (cadr spec)))
+ (make-directory (concat path "/" (car spec)) t)
+ (mapc (lambda (s) (assess-with-filesystem--init
+ s (concat path "/" (car spec)))) (cadr spec)))
+ ;; recursive spec, this should probably never happen
+ (t (mapc (lambda (s) (assess-with-filesystem--init s path)) spec))))
+ ;; directory specified using a string
+ ((and (stringp spec)
+ (string-match-p "/\\'" spec))
+ (make-directory (concat path "/" spec) t))
+ ;; empty file
+ ((stringp spec)
+ (assess-with-filesystem--make-parent spec path)
+ (write-region "" nil (concat path "/" spec) nil 'no-message))
+ (t (error "Invalid syntax: `%s'" spec))))
+
+(defmacro assess-with-filesystem (spec &rest forms)
+ "Create temporary file hierarchy according to SPEC and run FORMS.
+
+SPEC is a list of specifications for file system entities which
+are to be created.
+
+File system entities are specified as follows:
+
+1. a string FILE is the name of file to be created
+ - if the string contains \"/\", parent directories are created
+ automatically
+ - if the string ends with \"/\", a directory is created
+2. a list of two elements (FILE CONTENT) specifies filename and the
+ content to put in the file
+ - the \"/\" rules apply in the same way as in 1., except you can not
+ create a directory this way
+3. a list where car is a string and cadr is a list (DIR SPEC) is a
+ recursive specification evaluated with DIR as current directory
+ - the \"/\" rules apply in the same way as in 1., except you can not
+ create a file this way, a directory is always created
+
+An example showing all the possibilities:
+
+ (\"empty_file\"
+ \"dir/empty_file\"
+ \"dir/subdir/\"
+ (\"non_empty_file\" \"content\")
+ (\"dir/anotherdir/non_empty_file\" \"tralala\")
+ (\"big_dir\" (\"empty_file\"
+ (\"non_empty_file\" \"content\")
+ \"subdir/empty_file\")))
+
+If we want to run some code in a directory with an empty file
+\"foo.txt\" present, we call:
+
+ (assess-with-filesystem '(\"foo\")
+ (code-here)
+ (and-some-more-forms))
+
+You should *not* depend on where exactly the hierarchy is created.
+By default, a new directory in `temporary-file-directory' is
+created and the specification is evaluated there, but this is up
+for change."
+ (declare (indent 1))
+ (let ((temp-root (make-symbol "temp-root"))
+ (old-dd (make-symbol "old-dd")))
+ `(let ((,temp-root (make-temp-file "temp-fs-" t))
+ (,old-dd default-directory))
+ (unwind-protect
+ (progn
+ (setq default-directory ,temp-root)
+ (mapc (lambda (s) (assess-with-filesystem--init s ".")) ,spec)
+ ,@forms)
+ (delete-directory ,temp-root t)
+ (setq default-directory ,old-dd)))))
+;; #+END_SRC
+;; ** Indentation functions
+
+;; There are two main ways to test indentation -- we can either take unindented
+;; text, indent it, and then compare it to something else; or, we can roundtrip
+;; -- take indented code, unindent it, re-indent it again and see whether we end
+;; up with what we started. Assess supports both of these.
+
+;; Additionally, there are two different ways to specific a mode -- we can either
+;; define it explicitly or, if we are opening from a file, we can use the normal
+;; `auto-mode-alist' functionality to determine the mode. Assess supports both
+;; of these also.
+
+;; The simplest function is `assess-indentation=' which we can use as follows.
+;; In this case, we have mixed a multi-line string and a single line with
+;; control-n characters; this is partly to show that we can, and partly to make
+;; sure that the code works both in an `org-mode' buffer and an ~*Org Src*~ buffer.
+
+;; #+begin_src elisp
+;; (assess-indentation=
+;; 'emacs-lisp-mode
+;; "(assess-with-find-file
+;; \"~/.emacs\"
+;; (buffer-string))"
+;; "(assess-with-find-file\n \"~/.emacs\"\n (buffer-string))")
+;; #+end_src
+
+;; #+RESULTS:
+;; : t
+
+;; Probably more useful is `assess-roundtrip-indentation=' which allows us to
+;; just specify the indented form; in this case, the string is first unindented
+;; (every line starts at the first position) and then reindented. This saves the
+;; effort of keeping the text in both the indented and unindent forms in sync
+;; (but without the indentation).
+
+;; #+begin_src elisp
+;; (assess-roundtrip-indentation=
+;; 'emacs-lisp-mode
+;; "(assess-with-find-file\n \"~/.emacs\"\n (buffer-string))")
+;; #+end_src
+
+;; #+RESULTS:
+;; : t
+
+;; While these are useful for simple forms of indentation checking, they have
+;; the significant problem of writing indented code inside an Emacs string. An
+;; easier solution for longer pieces of code is to use
+;; `assess-file-roundtrip-indentation='. This opens a file (safely using
+;; `assess-make-related-file'), unindents, and reindents. The mode must be set
+;; up automatically by the file type.
+
+;; #+begin_src elisp
+;; (assess-file-roundtrip-indentation=
+;; "assess.el")
+;; #+end_src
+
+;; #+RESULTS:
+
+;; All of these methods are fully supported with ert explainer functions -- as
+;; before they use diff where possible to compare the two forms.
+
+
+;; *** Implementation
+
+;; We start with some functionality for making Emacs quiet while indenting,
+;; otherwise we will get a large amount of spam on the command line. Emacs needs
+;; to have a better technique for shutting up `message'.
+
+;; #+begin_src emacs-lisp
+(defun assess--indent-buffer (&optional column)
+ (cond
+ (column
+ (indent-region (point-min) (point-max) column))
+ ;; if indent-region-function is set, use it, and hope that it is not
+ ;; noisy.
+ (indent-region-function
+ (funcall indent-region-function (point-min) (point-max)))
+ (t
+ (seq-map
+ (lambda (m)
+ (goto-char m)
+ (indent-according-to-mode))
+ (m-buffer-match-line-start (current-buffer))))))
+
+(defun assess--indent-in-mode (mode unindented)
+ (with-temp-buffer
+ (insert
+ (assess-to-string unindented))
+ (funcall mode)
+ (assess--indent-buffer)
+ (buffer-string)))
+;; #+end_src
+
+;; Now for the basic indentation= comparison.
+
+;; #+begin_src emacs-lisp
+(defun assess-indentation= (mode unindented indented)
+ "Return non-nil if UNINDENTED indents in MODE to INDENTED.
+Both UNINDENTED and INDENTED can be any value usable by
+`assess-to-string'. Indentation is performed using
+`indent-region', which MODE should set up appropriately.
+
+See also `assess-file-roundtrip-indentation=' for an
+alternative mechanism."
+ (assess=
+ (assess--indent-in-mode
+ mode
+ unindented)
+ indented))
+
+(defun assess-explain-indentation= (mode unindented indented)
+ "Explanation function for `assess-indentation='."
+ (assess-explain=
+ (assess--indent-in-mode
+ mode
+ unindented)
+ indented))
+
+(put 'assess-indentation= 'ert-explainer 'assess-explain-indentation=)
+;; #+end_src
+
+;; Roundtripping.
+
+;; #+begin_src emacs-lisp
+(defun assess--buffer-unindent (buffer)
+ (with-current-buffer
+ buffer
+ (assess--indent-buffer 0)))
+
+(defun assess--roundtrip-1 (comp mode indented)
+ (with-temp-buffer
+ (funcall comp
+ mode
+ (progn
+ (insert
+ (assess-to-string indented))
+ (assess--buffer-unindent (current-buffer))
+ (buffer-string))
+ indented)))
+
+(defun assess-roundtrip-indentation= (mode indented)
+ "Return t if in MODE, text in INDENTED is corrected indented.
+
+This is checked by unindenting the text, then reindenting it according
+to MODE.
+
+See also `assess-indentation=' and
+`assess-file-roundtrip-indentation=' for alternative
+mechanisms of checking indentation."
+ (assess--roundtrip-1
+ #'assess-indentation=
+ mode indented))
+
+(defun assess-explain-roundtrip-indentation= (mode indented)
+ "Explanation function for `assess-roundtrip-indentation='."
+ (assess--roundtrip-1
+ #'assess-explain-indentation=
+ mode indented))
+
+(put 'assess-roundtrip-indentation=
+ 'ert-explainer
+ 'assess-explain-roundtrip-indentation=)
+;; #+end_src
+
+;; And file based checking.
+
+;; #+begin_src emacs-lisp
+(defun assess--file-roundtrip-1 (comp file)
+ (funcall
+ comp
+ (assess-with-find-file
+ (assess-make-related-file file)
+ (assess--buffer-unindent (current-buffer))
+ (assess--indent-buffer)
+ (buffer-string))
+ file))
+
+(defun assess-file-roundtrip-indentation= (file)
+ "Return t if text in FILE is indented correctly.
+
+FILE is copied with `assess-make-related-file', so this
+function should be side-effect free whether or not FILE is
+already open. The file is opened with `find-file-noselect', so
+hooks associated with interactive visiting of a file should all
+be called, with the exception of directory local variables, as
+the copy of FILE will be in a different directory."
+ (assess--file-roundtrip-1
+ #'assess= file))
+
+(defun assess-explain-file-roundtrip-indentation= (file)
+ "Explanation function for `assess-file-roundtrip-indentation=."
+ (assess--file-roundtrip-1
+ #'assess-explain= file))
+
+(put 'assess-file-roundtrip-indentation=
+ 'ert-explainer
+ 'assess-explain-file-roundtrip-indentation=)
+;; #+end_src
+
+;; ** Font-Lock
+
+;; Here we define two predicates that can be used to checking
+;; fontification/syntax highlighting; as with indentation, one accepts strings
+;; but requires an explicit mode, while the other reads from file and depends on
+;; the normal Emacs mechanisms for defining the mode. These two are
+;; `assess-font-at=' and `assess-file-font-at='. Both of these have the same
+;; interface and have attached explainer functions. Here, we show examples with
+;; `assess-face-at='.
+
+;; The simplest use is to specify a point location and a face. This returns true
+;; if at least that face is present at the location.
+
+;; #+begin_src elisp
+;; (assess-face-at=
+;; "(defun x ())"
+;; 'emacs-lisp-mode
+;; 2
+;; 'font-lock-keyword-face)
+;; #+end_src
+
+;; It is also possible to specify several locations in a list, with a single
+;; face. This checks that the given font is present at every location.
+
+;; #+begin_src elisp
+;; (assess-face-at=
+;; "(defun x ())
+;; (defun y ())
+;; (defun z ())"
+;; 'emacs-lisp-mode
+;; '(2 15 28)
+;; 'font-lock-keyword-face)
+;; #+end_src
+
+;; Or, we can specify a list of faces in which case the locations and faces are
+;; checked in a pairwise manner.
+
+;; #+begin_src elisp
+;; (assess-face-at=
+;; "(defun x ())"
+;; 'emacs-lisp-mode
+;; '(2 8)
+;; '(font-lock-keyword-face font-lock-function-name-face))
+;; #+end_src
+
+;; It is also possible to define locations with regexps; again either one or
+;; multiple regexps can be used. With a single string, all matches are checked,
+;; with the first match to the first is checked, then the next match to the
+;; second, incrementally.
+
+;; #+begin_src elisp
+;; (assess-face-at=
+;; "(defun x ())\n(defun y ())\n(defun z ())"
+;; 'emacs-lisp-mode
+;; "defun"
+;; 'font-lock-keyword-face)
+
+;; (assess-face-at=
+;; "(defun x ())\n(defmacro y ())\n(defun z ())"
+;; 'emacs-lisp-mode
+;; '("defun" "defmacro" "defun")
+;; 'font-lock-keyword-face)
+;; #+end_src
+
+
+;; The locations can also be specified as a `lambda' which takes a single
+;; argument of a buffer. The return result can be any form of location accepted
+;; by `assess-face-at=', including a list of match data generated, as in this
+;; case, by the `m-buffer' package.
+
+;; #+begin_src elisp
+;; (assess-face-at=
+;; "(defun x ())\n(defun y ())\n(defun z ())"
+;; 'emacs-lisp-mode
+;; (lambda(buf)
+;; (m-buffer-match buf "defun"))
+;; 'font-lock-keyword-face)
+;; #+end_src
+
+
+;; *** Implementation
+
+;; First, `assess-face-at='.
+
+
+;; #+begin_src emacs-lisp
+(defun assess--face-at-location=
+ (location face property throw-on-nil)
+ ;; it's match data
+ (if (listp location)
+ ;; We need to test every point but not the last because the match is
+ ;; passed the end.
+ (let ((all nil))
+ (cl-loop for i from
+ (marker-position (car location))
+ below
+ (marker-position (cadr location))
+ do
+ (setq all
+ (cons (assess--face-at-location=
+ i face
+ property throw-on-nil)
+ all)))
+ (seq-every-p #'identity all))
+ (let* ((local-faces
+ (get-text-property location property))
+ (rtn
+ ;; for face this can be one of -- a face name (a symbol or string)
+ ;; a list of faces, or a plist of face attributes
+ (pcase local-faces
+ ;; compare directly
+ ((pred symbolp)
+ (eq face local-faces))
+ ;; give up -- we should probably be able to compare the plists here.
+ ((and `(,s . ,_)
+ (guard (keywordp s)))
+ nil)
+ ;; compare that we have at least this.
+ ((and `(,s . ,_)
+ (guard (symbolp s)))
+ (member face s)))))
+ (if (and throw-on-nil
+ (not rtn))
+ (throw
+ 'face-non-match
+ (format "Face does not match expected value
+\tExpected: %s
+\tActual: %s
+\tLocation: %s
+\tLine Context: %s
+\tbol Position: %s
+"
+ face local-faces location
+ (thing-at-point 'line)
+ (m-buffer-at-line-beginning-position
+ (current-buffer) location)))
+ rtn))))
+
+
+(defun assess--face-at=
+ (buffer locations faces property throw-on-nil)
+ (let* (
+ ;; default property
+ (property (or property 'face))
+ ;; make sure we have a list of locations
+ (locations
+ (pcase locations
+ ((pred functionp)
+ (funcall locations buffer))
+ ((pred listp)
+ locations)
+ (_ (list locations))))
+ (first-location
+ (car locations))
+ ;; make sure we have a list of markers
+ (locations
+ (cond
+ ((integerp first-location)
+ (m-buffer-pos-to-marker buffer locations))
+ ((stringp first-location)
+ (m-buffer-match-multi locations :buffer buffer))
+ ;; markers
+ ((markerp first-location)
+ locations)
+ ;; match data
+ ((and (listp first-location)
+ (markerp (car first-location)))
+ locations)))
+ ;; make sure we have a list of faces
+ (faces
+ (if (and (listp faces)
+ ;; but not nil
+ (not (eq nil faces)))
+ faces
+ (list faces)))
+ ;; make sure faces is as long as locations
+ (faces
+ (progn
+ (while (> (length locations)
+ (length faces))
+ ;; cycle faces if needed
+ (setq faces (append faces (seq-copy faces))))
+ faces)))
+ (seq-every-p
+ (lambda (it)
+ (assess--face-at-location=
+ (car it) (cdr it) property throw-on-nil))
+ (seq-mapn #'cons locations faces))))
+
+(defun assess--face-at=-1 (x mode locations faces property throw-on-nil)
+ (with-temp-buffer
+ (insert (assess-to-string x))
+ (funcall mode)
+ (font-lock-fontify-buffer)
+ (assess--face-at= (current-buffer) locations faces property throw-on-nil)))
+
+(defun assess-face-at=
+ (x mode locations faces &optional property)
+ "Return non-nil if in X with MODE at MARKERS, FACES are present on PROPERTY.
+
+This function tests if one or more faces are present at specific
+locations in some text. It operates over single or multiple
+values for both locations and faces; if there are more locations
+than faces, then faces will be cycled over. If locations are
+match data, then each the beginning and end of each match are
+tested against each face.
+
+X can be a buffer, file name or string -- see
+`assess-to-string' for details.
+
+MODE is the major mode with which to fontify X -- actually, it
+will just be a function called to initialize the buffer.
+
+LOCATIONS can be either one or a list of the following things:
+integer positions in X; markers in X (or nil!); match data in X;
+or strings which match X. If this is a list, all items in list
+should be of the same type.
+
+FACES can be one or more faces.
+
+PROPERTY is the text property on which to check the faces.
+
+See also `assess-to-string' for treatment of the parameter X.
+
+See `assess-file-face-at=' for a similar function which
+operates over files and takes the mode from that file."
+ (assess--face-at=-1 x mode locations faces property nil))
+
+(defun assess-explain-face-at=
+ (x mode locations faces &optional property)
+ (catch 'face-non-match
+ (assess--face-at=-1 x mode locations faces property t)))
+
+(put 'assess-face-at=
+ 'ert-explainer
+ 'assess-explain-face-at=)
+;; #+end_src
+
+;; Followed by `assess-file-face-at='.
+
+;; #+begin_src emacs-lisp
+(defun assess--file-face-at=-1 (file locations faces property throw-on-nil)
+ (assess-with-find-file
+ (assess-make-related-file file)
+ (font-lock-fontify-buffer)
+ (assess--face-at= (current-buffer) locations faces property throw-on-nil)))
+
+(defun assess-file-face-at= (file locations faces &optional property)
+ (assess--file-face-at=-1 file locations faces property nil))
+
+(defun assess-explain-file-face-at= (file locations faces &optional property)
+ (catch 'face-non-match
+ (assess--file-face-at=-1 file locations faces property t)))
+
+(put 'assess-file-face-at=
+ 'ert-explainer
+ 'assess-explain-file-face-at=)
+;; #+end_src
+
+
+;; #+begin_src emacs-lisp
+(defmacro assess-with-safe-user-directory (&rest body)
+ (declare (debug t))
+ `(let ((user-emacs-directory (make-temp-file "emacs-assess" t)))
+ ,@body))
+;; #+end_src
+
+
+;; #+begin_src emacs-lisp
+(provide 'assess)
+;;; assess.el ends here
+;; #+end_src
--- /dev/null
+;;; m-buffer-at.el --- Stateless point functions -*- lexical-binding: t -*-
+
+;;; Header:
+
+;; This file is not part of Emacs
+
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2014, Phillip Lord, Newcastle University
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Provides stateless equivalents to many core Emacs functions, that provide
+;; information about a buffer. Most of these functions take either a buffer as
+;; a parameter or a location, which is either a marker (with a non-nil buffer
+;; and location) or a buffer and integer.
+
+;; These functions are generally competitive with the originals in terms of
+;; speed.
+
+;;; Status:
+
+;; There are lots more to do, but the interface should be stable.
+
+;;; Code:
+
+;; #+begin_src emacs-lisp
+
+(require 'm-buffer-macro)
+
+(defun m-buffer-at-point (buffer)
+ "Return the location of point in BUFFER.
+See also `point'."
+ (with-current-buffer
+ buffer
+ (point)))
+
+(defun m-buffer-at-eolp (&rest location)
+ "Return t if LOCATION is at the end of a line.
+See also `eolp'."
+ (m-buffer-with-current-location
+ location
+ (eolp)))
+
+(defun m-buffer-at-bolp (&rest location)
+ "Return t if LOCATION is at the begining of a line.
+See also `bolp'"
+ (m-buffer-with-current-location
+ location
+ (bolp)))
+
+(defun m-buffer-at-line-beginning-position (&rest location)
+ "Return the start of the line of LOCATION."
+ (m-buffer-with-current-location
+ location
+ (line-beginning-position)))
+
+(defun m-buffer-at-line-end-position (&rest location)
+ "Return the end of the line of LOCATION."
+ (m-buffer-with-current-location
+ location
+ (line-end-position)))
+
+(defun m-buffer-at-narrowed-p (buffer)
+ (with-current-buffer
+ buffer
+ (buffer-narrowed-p)))
+
+(defun m-buffer-at-string (buffer)
+ (with-current-buffer
+ buffer
+ (buffer-string)))
+
+(provide 'm-buffer-at)
+;;; m-buffer-at.el ends here
+;; #+end_src
--- /dev/null
+;;; m-buffer-macro.el --- Create and dispose of markers -*- lexical-binding: t -*-
+
+;;; Header:
+
+;; This file is not part of Emacs
+
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2014, Phillip Lord, Newcastle University
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides some utility macros which help to support stateless
+;; operation on buffers, by restoring global state after to what it was before
+;; the macro starts.
+
+;; These macros are quite useful, but with the exception of
+;; `m-buffer-with-markers', they are mostly meant to underpin `m-buffer-at'. The
+;; aim is that all the cases where one of these macros is used with a single form
+;; from core Emacs should be provided by m-buffer-at (although this is not the
+;; case yet). These macros might be more efficient if there are a lot of calls to
+;; group together.
+
+;;; Code:
+
+;; ** Markers
+
+;; Markers are generally much nicer than integers, but needs cleaning up
+;; afterwards if a lot are created. It's possible to do this using
+;; `m-buffer-nil-marker', but it can be a bit painful. This form looks like a
+;; `let' form, but removes markers at the end.
+
+;; #+begin_src emacs-lisp
+(defmacro m-buffer-with-markers (varlist &rest body)
+ "Bind variables after VARLIST then eval BODY.
+VARLIST is of the same form as `let'. All variables should
+contain markers or collections of markers. All markers are niled
+after BODY."
+ ;; indent let part specially, and debug like let
+ (declare (indent 1)(debug let))
+ ;; so, create a rtn var with make-symbol (for hygene)
+ (let* ((rtn-var (make-symbol "rtn-var"))
+ (marker-vars
+ (mapcar 'car varlist))
+ (full-varlist
+ (append
+ varlist
+ `((,rtn-var
+ (progn
+ ,@body))))))
+ `(let* ,full-varlist
+ (m-buffer-nil-marker
+ (list ,@marker-vars))
+ ,rtn-var)))
+;; #+end_src
+
+;; ** Point and Buffer
+
+;; These macros are extensions of `with-current-buffer', and `save-excursion',
+;; which set the current buffer and location.
+
+;; #+begin_src emacs-lisp
+(defmacro m-buffer-with-current-marker
+ (marker &rest body)
+ "At MARKER location run BODY."
+ (declare (indent 1) (debug t))
+ `(with-current-buffer
+ (marker-buffer ,marker)
+ (save-excursion
+ (goto-char ,marker)
+ ,@body)))
+
+(defmacro m-buffer-with-current-position
+ (buffer location &rest body)
+ "In BUFFER at LOCATION, run BODY."
+ (declare (indent 2)
+ (debug t))
+ `(with-current-buffer
+ ,buffer
+ (save-excursion
+ (goto-char ,location)
+ ,@body)))
+;; #+end_src
+
+;; Combines the last two!
+
+;; #+begin_src emacs-lisp
+(defmacro m-buffer-with-current-location
+ (location &rest body)
+ "At LOCATION, run BODY.
+LOCATION should be a list. If a one element list, it is a marker.
+If a two element, it is a buffer and position."
+ (declare (indent 1) (debug t))
+ ;; multiple eval of location!
+ (let ((loc (make-symbol "loc")))
+ `(let ((,loc ,location))
+ (if (= 1 (length ,loc))
+ (m-buffer-with-current-marker
+ (nth 0 ,loc)
+ ,@body)
+ (if (= 2 (length ,loc))
+ (m-buffer-with-current-position
+ (nth 0 ,loc)
+ (nth 1 ,loc)
+ ,@body)
+ (error "m-buffer-with-current-location requires a list of one or two elements"))))))
+
+(provide 'm-buffer-macro)
+;;; m-buffer-macro.el ends here
+;; #+end_src
--- /dev/null
+(define-package "m-buffer" "0.4" "Buffer Manipulation Functions"
+ '((emacs "24.3")))
--- /dev/null
+;;; m-buffer.el --- List-Oriented, Functional Buffer Manipulation -*- lexical-binding: t -*-
+
+;;; Header:
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <phillip.lord@russet.org.uk>
+;; Maintainer: Phillip Lord <phillip.lord@russet.rg.uk>
+;; Version: 0.15
+;; Package-Requires: ((seq "2.14"))
+
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2014, 2015, 2016, 2017 Phillip Lord
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a set of list-oriented functions for operating over the
+;; contents of buffers, mostly revolving around regexp searching, and regions.
+;; They avoid the use of looping, manipulating global state with `match-data'.
+;; Many high-level functions exist for matching sentences, lines and so on.
+
+;; Functions are generally purish: i.e. that is those functions which do
+;; change state, by for example replacing text or adding overlays, should only
+;; change state in one way; they will not affect point, current buffer, match
+;; data or so forth.
+
+;; Likewise to protect against changes in state, markers are used rather than
+;; integer positions. This means that it is possible, for example, to search
+;; for regexp matches and then replace them all without the earlier
+;; replacements invalidating the location of the later ones. Otherwise
+;; replacements need to be made in reverse order. This can have implications
+;; for performance, so m-buffer also provides functions for making markers nil;
+;; there are also macros which help manage markers in `m-buffer-macro'.
+
+;; Where possible, functions share interfaces. So most of the match functions
+;; take a list of "match" arguments, either position or as a plist, which avoids
+;; using lots of `nil' arguments. Functions operating on matches take a list of
+;; `match-data' as returned by the match functions, making it easy to chain
+;; matches.
+
+;; This file is documented using lentic.el. Use
+;; [[http://github.com/phillord/lentic-server][lentic-server]] to view.
+
+;;; Status:
+
+;; m-buffer.el is now stable and is expected to change only in
+;; forward-compatible ways.
+
+;;; Code:
+
+;; #+begin_src emacs-lisp
+(require 'seq)
+(require 'm-buffer-macro)
+
+;; #+end_src
+
+;; ** Regexp Matching
+
+;; We first provide a single match function, `m-bufffer-match' which converts
+;; between Emacs' stateful matching and a more sequence-oriented interface.
+
+;; This function also defines the "match" arguments which are a standard set of
+;; arguments used throughout this package.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-match (&rest match)
+ "Return a list of all `match-data' for MATCH.
+MATCH may be of the forms:
+BUFFER REGEXP &optional MATCH-OPTIONS
+WINDOW REGEXP &optional MATCH-OPTIONS
+MATCH-OPTIONS
+
+If BUFFER is given, search this buffer. If WINDOW is given search
+the visible window. MATCH-OPTIONS is a plist with any of the
+following keys:
+:buffer -- the buffer to search
+:regexp -- the regexp to search with
+:begin -- the start of the region to search -- default point min
+:end -- the end of the region to search -- default point max
+:post-match -- function called after a match -- default nil
+:widen -- if true, widen buffer first -- default nil
+:case-fold-search value of `case-fold-search' during search.
+If :default accept the current buffer-local value
+:numeric -- if true, return integers not markers
+
+If options are expressed in two places, the plist form takes
+precedence over positional args. So calling with both a first
+position buffer and a :buffer arg will use the second. Likewise,
+if a window is given as first arg and :end is given, then
+the :end value will be used.
+
+REGEXP should advance point (i.e. not be zero-width) or the
+function will loop infinitely. POST-MATCH can be used to avoid
+this. The buffer is searched forward."
+ (apply 'm-buffer--match-1
+ (m-buffer--normalize-args match)))
+;; #+end_src
+
+;; The match function is actually implemented here in the `m-buffer--match-1'
+;; function, with positional arguments.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer--match-1 (buffer regexp begin end
+ post-match widen cfs
+ numeric)
+ "Return a list of `match-data'.
+
+This is an internal function: please prefer `m-buffer-match'.
+
+BUFFER -- the buffer.
+REGEXP -- the regexp.
+BEGIN -- the start of the region to search
+END -- the end of the region to search
+POST-MATCH -- function to run after each match
+POST-MATCH is useful for zero-width matches which will otherwise
+cause infinite loop. The buffer is searched forward. POST-MATCH
+return can also be used to terminate the matching by returning nil.
+WIDEN -- call widen first.
+CFS -- Non-nil if searches and matches should ignore case.
+NUMERIC -- Non-nil if we should return integers not markers."
+;; #+end_src
+
+;; We start by saving everything to ensure that we do not pollute the global
+;; state. This means match-data, point, narrowing and current buffer! Hopefully
+;; this is all the global state that exists and that we are changing.
+
+;; #+begin_src emacs-lisp
+ (with-current-buffer
+ buffer
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (when widen (widen))
+;; #+end_src
+
+;; This let form is doing a number of things. It sets up a dynamic binding for
+;; `case-fold-search' (which works even though we are using lexical binding),
+;; ensures a non-nil value for =end-bound= and defines a sentinal value that
+;; =post-match-return= can use to end early.
+
+;; #+begin_src emacs-lisp
+ (let ((rtn nil)
+ (post-match-return t)
+ (end-bound (or end (point-max)))
+ ;; over-ride default if necessary
+ (case-fold-search
+ (if (eq :default cfs)
+ case-fold-search
+ cfs)))
+;; #+end_src
+
+;; We start at the beginning. There was no particularly good reason for this, and
+;; it would have made just as much sense to go backward.
+
+;; #+begin_src emacs-lisp
+ (goto-char
+ (or begin
+ (point-min)))
+ (while
+ (and
+;; #+end_src
+
+;; The original purpose for =post-match-return= was for zero-width matches --
+;; these do not advance point beyond their end, so the while loop never
+;; terminates. Unfortunately, avoiding this depends on the regexp being called,
+;; so we provide the most general solution of all.
+
+;; As well as this, we check the return value of =post-match-return=, so as well
+;; as advancing `point' by side-effect, we can also use it to terminate the look
+;; at any point that we want; for example, we can terminate after the first match
+;; which feels more efficient than searching the whole buffer then taking the
+;; first match.
+
+;; #+begin_src emacs-lisp
+ post-match-return
+ ;; we need to check we are less than the end-bound
+ ;; or re-search-forward will break
+ (<= (point) end-bound)
+ (re-search-forward
+ regexp end-bound
+ t))
+;; #+end_src
+
+;; Store the `match-data' in a backward list, run post-match. Finally, reverse
+;; and terminate.
+
+;; #+begin_src emacs-lisp
+ (setq rtn
+ (cons
+ (if numeric
+ (m-buffer-marker-to-pos-nil
+ (match-data))
+ (match-data))
+ rtn))
+ (when post-match
+ (setq post-match-return (funcall post-match))))
+ (reverse rtn)))))))
+;; #+end_src
+
+;; This method implements the argument list processing. I find this interface
+;; fairly attractive to use since it takes the two "main" arguments -- buffer and
+;; regexp -- as positional args optionally, and everything else as keywords. The
+;; use of keywords is pretty much essential as have eight arguments most of which
+;; are not essential.
+
+;; This is fairly close to the logic provided by `cl-defun' which I wasn't aware
+;; of when I wrote this. However `cl-defun' does not allow optional arguments
+;; before keyword arguments -- all the optional arguments have to be given if we
+;; are to use keywords.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer--normalize-args (match-with)
+ "Manipulate args into a standard form and return as a list.
+MATCH-WITH are these args. This is an internal function."
+ (let* (
+ ;; split up into keyword and non keyword limits
+ (args
+ (seq-take-while
+ (lambda (x) (not (keywordp x)))
+ match-with))
+ (pargs
+ (seq-drop-while
+ (lambda (x) (not (keywordp x)))
+ match-with))
+ ;; sort actual actual parameters
+ (first (car args))
+ ;; buffer may be first
+ (buffer
+ (or (plist-get pargs :buffer)
+ (and (bufferp first) first)))
+ ;; or window may be first
+ (window
+ (or (plist-get pargs :window)
+ (and (windowp first) first)))
+ ;; regexp always comes second
+ (regexp
+ (or (plist-get pargs :regexp)
+ (nth 1 args)))
+ ;; begin depends on other arguments
+ (begin
+ (or (plist-get pargs :begin)
+ (and window (window-start window))))
+ ;; end depends on other arguments
+ (end
+ (or (plist-get pargs :end)
+ (and window (window-end window))))
+ ;; pm
+ (post-match
+ (plist-get pargs :post-match))
+
+ ;; widen
+ (widen
+ (plist-get pargs :widen))
+
+ ;; case-fold-search this needs to overwrite the buffer contents iff
+ ;; set, otherwise be ignored, so we need to distinguish a missing
+ ;; property and a nil one
+ (cfs
+ (if (plist-member pargs :case-fold-search)
+ (plist-get pargs :case-fold-search)
+ :default))
+
+ ;; numeric
+ (numeric
+ (plist-get pargs :numeric)))
+
+ (list buffer regexp begin end post-match widen cfs numeric)))
+;; #+end_src
+
+;; Finally, this function provides a link between the match function, and the
+;; match manipulation functions. We can either choose to match once against a set
+;; of arguments and then apply multiple manipulations on the returned match data.
+;; Or just use the match manipulation function directly.
+
+;; The first version of `m-buffer' did not include this but it required lots of
+;; nested calls which seem inconvenient.
+
+;; #+begin_example
+;; (m-buffer-match-manipulate
+;; (m-buffer-match (current-buffer) "hello"))
+;; #+end_example
+
+;; I think that convienience is worth the overhead.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-ensure-match (&rest match)
+ "Ensure that we have MATCH data.
+If a single arg, assume it is match data and return. If multiple
+args, assume they are of the form accepted by
+`m-buffer-match'."
+ (cond
+ ;; we have match data
+ ((= 1 (length match))
+ (car match))
+ ((< 1 (length match))
+ (apply 'm-buffer-match match))
+ (t
+ (error "Invalid arguments"))))
+;; #+end_src
+
+;; ** Match Data Manipulation Functions
+
+;; These functions manipulate lists of either match-data or match arguments in
+;; some way.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-buffer-for-match (match-data)
+ "Given some MATCH-DATA return the buffer for that data."
+ (marker-buffer (caar match-data)))
+
+(defun m-buffer-match-nth-group (n match-data)
+ "Fetch the Nth group from MATCH-DATA."
+ (seq-map
+ (lambda (m)
+ (let ((drp
+ (seq-drop m (* 2 n))))
+ (list
+ (car drp) (cadr drp))))
+ match-data))
+
+(defun m-buffer-match-begin-n (n &rest match)
+ "Return markers to the start of the Nth group in MATCH.
+MATCH may be of any form accepted by `m-buffer-ensure-match'. Use
+`m-buffer-nil-marker' after the markers have been finished with
+or they will slow future use of the buffer until garbage collected."
+ (seq-map
+ (lambda (m)
+ (nth
+ (* 2 n) m))
+ (apply 'm-buffer-ensure-match match)))
+
+(defun m-buffer-match-begin-n-pos (n &rest match)
+ "Return positions of the start of the Nth group in MATCH.
+MATCH may be of any form accepted by `m-buffer-ensure-match'. If
+`match-data' is passed markers will be set to nil after this
+function. See `m-buffer-nil-marker' for details."
+ (m-buffer-marker-to-pos-nil
+ (apply 'm-buffer-match-begin-n
+ n match)))
+
+(defun m-buffer-match-begin (&rest match)
+ "Return a list of markers to the start of MATCH.
+MATCH may of any form accepted by `m-buffer-ensure-match'. Use
+`m-buffer-nil-marker' after the markers have been used or they
+will slow future changes to the buffer."
+ (apply 'm-buffer-match-begin-n 0 match))
+
+(defun m-buffer-match-begin-pos (&rest match)
+ "Return a list of positions at the start of matcher.
+MATCH may be of any form accepted by `m-buffer-ensure-match'.
+If `match-data' is passed markers will be set to nil after this
+function. See `m-buffer-nil-marker' for details."
+ (apply 'm-buffer-match-begin-n-pos 0 match))
+
+(defun m-buffer-match-end-n (n &rest match)
+ "Return markers to the end of the match to the Nth group.
+MATCH may be of any form accepted by `m-buffer-ensure-match'.
+If `match-data' is passed markers will be set to nil after this
+function. See `m-buffer-nil-marker' for details."
+ (seq-map
+ (lambda (m)
+ (nth
+ (+ 1 (* 2 n))
+ m))
+ (apply 'm-buffer-ensure-match match)))
+
+(defun m-buffer-match-end-n-pos (n &rest match)
+ "Return positions of the end Nth group of MATCH.
+MATCH may be of any form accepted by `m-buffer-ensure-match'.
+If `match-data' is passed markers will be set to nil after this
+function. See `m-buffer-nil-marker' for details."
+ (m-buffer-marker-to-pos-nil
+ (apply 'm-buffer-match-end-n-pos
+ n match)))
+
+(defun m-buffer-match-end (&rest match)
+ "Return a list of markers to the end of MATCH to regexp in buffer.
+MATCH may be of any form accepted by `m-buffer-ensure-match'. Use
+`m-buffer-nil-marker' after the markers have been used or they
+will slow future changes to the buffer."
+ (apply 'm-buffer-match-end-n 0 match))
+
+(defun m-buffer-match-end-pos (&rest match)
+ "Return a list of positions to the end of the match.
+MATCH may be of any form accepted by `m-buffer-ensure-match'.
+If `match-data' is passed markers will be set to nil after this
+function. See `m-buffer-nil-marker' for details."
+ (m-buffer-marker-to-pos-nil
+ (apply 'm-buffer-match-end match)))
+;; #+end_src
+
+;; ** Match Utility and Predicates
+
+;; *** Subtraction
+
+;; Some predicates and the ability to subtract to lists of matches from each
+;; other. This makes up for limitations in Emacs regexp which can't do "match x
+;; but not y".
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-match-equal (m n)
+ "Return true if M and N are cover the same region.
+Matches are equal if they match the same region; subgroups are
+ignored."
+ (and
+ (equal
+ (car m)
+ (car n))
+ (equal
+ (cadr m)
+ (cadr n))))
+;; #+end_src
+
+;; A nice simple implementation for the general purpose solution.
+;; Unfortunately, performance sucks, running in quadratic time.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-match-subtract (m n)
+ "Remove from M any match in N.
+Matches are equivalent if overall they match the same
+area; subgroups are ignored.
+See also `m-buffer-match-exact-subtract' which often
+runs faster but has some restrictions."
+ (seq-remove
+ (lambda (o)
+ (seq-some
+ (lambda (p)
+ (m-buffer-match-equal o p))
+ n))
+ m))
+;; #+end_src
+
+;; The ugly and complicated and less general solution. But it runs in linear
+;; time.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-match-exact-subtract (m n)
+ "Remove from M any match in N.
+Both M and N must be fully ordered, and any element in N must be
+in M."
+ (if n
+ ;; n-eaten contains the remaining elements of n that we haven't tested
+ ;; for yet. We throw them away as we go
+ (let ((n-eaten n))
+ (seq-remove
+ (lambda (o)
+ (cond
+ ;; n-eaten has been eaten. Check here or later "<" comparison crashes.
+ ((not n-eaten)
+ ;; return nil because we always want things in m now.
+ nil
+ )
+ ;; we have a match so throw away the first element of n-eaten
+ ;; which we won't need again.
+ ((m-buffer-match-equal
+ (car n-eaten) o)
+ (progn
+ (setq n-eaten (seq-drop n-eaten 1))
+ t))
+ ;; we should discard also if n-eaten 1 is less than o because, both
+ ;; are sorted, so we will never match
+ ((<
+ ;; first half of the first match in n-eaten
+ (caar n-eaten)
+ ;; first half of match
+ (car o))
+ (progn
+ (setq n-eaten (seq-drop n-eaten 1))
+ t))))
+ m))
+ m))
+
+(defun m-buffer-in-match-p (matches position)
+ "Returns true is any of MATCHES contain POSITION."
+ (seq-some
+ (lambda (match)
+ (and
+ (<= (car match) position)
+ (<= position (cadr match))))
+ matches))
+;; #+end_src
+
+
+;; *** Partition
+
+;; Partition one set of markers by another. This is useful for finding matched
+;; pairs of markers.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer--partition-by-marker(list partition)
+ "Given LIST, split at markers in PARTITION.
+
+This is the main implementation for `m-buffer-partition-by-marker',
+but assumes that partition starts with a very low value (or nil)."
+ (let* ((p-top (car-safe partition))
+ (p-val (car-safe (cdr-safe partition)))
+ (p-fn (lambda (n)
+ (or (not p-val)
+ (< n p-val)))))
+ (when list
+ (cons
+ (cons
+ p-top
+ (seq-take-while p-fn list))
+ (m-buffer--partition-by-marker
+ (seq-drop-while p-fn list)
+ (cdr partition))))))
+
+(defun m-buffer-partition-by-marker (list partition)
+ "Given LIST of markers, split at markers in PARTITION.
+Returns a list of lists. The first element of each list is nil or
+the marker from PARTITION. The rest of the elements are those
+elements in LIST which are at the same position or later in the
+buffer than the element from PARTITION, but before the next
+element from PARTITION.
+
+Both LIST and PARTITION must be sorted."
+ ;; TODO!
+ (m-buffer--partition-by-marker list (cons nil partition)))
+;; #+end_src
+
+
+;; ** Marker manipulation functions
+
+;; These functions do things to markers rather than the areas of the buffers
+;; indicated by the markers. This includes transforming between markers and
+;; integer positions, and niling markers explicitly, which prevents slow down
+;; before garbage collection.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-nil-marker (markers)
+ "Takes a (nested) list of MARKERS and nils them all.
+Markers slow buffer movement while they are pointing at a
+specific location, until they have been garbage collected. Niling
+them prevents this. See Info node `(elisp) Overview of Markers'."
+ (seq-map
+ (lambda (marker)
+ (if (seqp marker)
+ (m-buffer-nil-marker marker)
+ (set-marker marker nil)))
+ markers))
+
+(defun m-buffer-marker-to-pos (markers &optional postnil)
+ "Transforms a list of MARKERS to a list of positions.
+If the markers are no longer needed, set POSTNIL to true, or call
+`m-buffer-nil-marker' manually after use to speed future buffer
+movement. Or use `m-buffer-marker-to-pos-nil'."
+ (seq-map
+ (lambda (marker)
+ (prog1
+ (marker-position marker)
+ (when postnil
+ (set-marker marker nil))))
+ markers))
+
+(defun m-buffer-marker-to-pos-nil (markers)
+ "Transforms a list of MARKERS to a list of positions then nils.
+See also `m-buffer-nil-markers'"
+ (m-buffer-marker-to-pos markers t))
+
+(defun m-buffer-marker-tree-to-pos (marker-tree &optional postnil)
+ "Transforms a tree of markers to equivalent positions.
+MARKER-TREE is the tree.
+POSTNIL sets markers to nil afterwards."
+ (seq-map
+ (lambda (marker)
+ (if (seqp marker)
+ (m-buffer-marker-tree-to-pos marker postnil)
+ (prog1
+ (marker-position marker)
+ (when postnil
+ (set-marker marker nil)))))
+ marker-tree))
+
+(defun m-buffer-marker-tree-to-pos-nil (marker-tree)
+ "Transforms a tree of markers to equivalent positions.
+MARKER-TREE is the tree. Markers are niled afterwards."
+ (m-buffer-marker-tree-to-pos marker-tree t))
+
+(defun m-buffer-marker-clone (marker-tree &optional type)
+ "Return a clone of MARKER-TREE.
+The optional argument TYPE specifies the insertion type. See
+`copy-marker' for details."
+ (seq-map
+ (lambda (marker)
+ (if (seqp marker)
+ (m-buffer-marker-clone marker type)
+ (copy-marker marker type)))
+ marker-tree))
+
+(defun m-buffer-pos-to-marker (buffer positions)
+ "In BUFFER translates a list of POSITIONS to markers."
+ (seq-map
+ (lambda (pos)
+ (set-marker
+ (make-marker) pos buffer))
+ positions))
+;; #+end_src
+
+;; ** Replace, Delete, Extract
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-replace-match (match-data replacement
+ &optional fixedcase literal subexp)
+ "Given a list of MATCH-DATA, replace with REPLACEMENT.
+If FIXEDCASE do not alter the case of the replacement text.
+If LITERAL insert the replacement literally.
+SUBEXP should be a number indicating the regexp group to replace.
+Returns markers to the start and end of the replacement. These
+markers are part of MATCH-DATA, so niling them will percolate backward.
+
+See also `replace-match'."
+ (save-excursion
+ (seq-map
+ (lambda (match)
+ (with-current-buffer
+ (marker-buffer (car match))
+ (save-match-data
+ (set-match-data match)
+ (replace-match
+ replacement fixedcase literal nil
+ (or subexp 0)))))
+ match-data))
+ ;; we have match-data
+ (m-buffer-match-nth-group (or subexp 0) match-data))
+
+(defun m-buffer-delete-match (match-data &optional subexp)
+ "Delete all MATCH-DATA.
+SUBEXP should be a number indicating the regexp group to delete.
+Returns markers to the start and end of the replacement. These
+markers are part of MATCH_DATA, so niling them will percolate backward."
+ (m-buffer-replace-match match-data "" subexp))
+
+(defun m-buffer-match-string (match-data &optional subexp)
+ "Return strings for MATCH-DATA optionally of group SUBEXP."
+ (seq-map
+ (lambda (match)
+ (with-current-buffer
+ (marker-buffer (car match))
+ (save-match-data
+ (set-match-data match)
+ (match-string
+ (or subexp 0)))))
+ match-data))
+
+(defun m-buffer-match-string-no-properties (match-data &optional subexp)
+ "Return strings for MATCH-DATA optionally of group SUBEXP.
+Remove all properties from return."
+ (seq-map
+ 'substring-no-properties
+ (m-buffer-match-string
+ match-data subexp)))
+;; #+end_src
+
+;; ** Match Things
+
+;; Emacs comes with a set of in-built regexps most of which we use here.
+
+;; We define `m-buffer-apply-join' first. The reason for this function is that
+;; we want to take a list of match arguments and add to with, for instance, a
+;; regular expression. We need to add these at the end because most of our
+;; functions contain some positional arguments.
+
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-apply-join (fn match &rest more-match)
+ (let*
+ ((args
+ (seq-take-while
+ (lambda (x) (not (keywordp x)))
+ match))
+ (pargs
+ (seq-drop-while
+ (lambda (x) (not (keywordp x)))
+ match))
+ (more-keywords
+ (seq-map
+ 'car
+ (seq-partition more-match 2))))
+ (when
+ (seq-find
+ (lambda (keyword)
+ (plist-member pargs keyword))
+ more-keywords)
+ (error
+ "Match arg contradicts a defined argument."))
+ (apply fn (append args more-match pargs))))
+;; #+end_src
+
+;; For the following code, we use Emacs core regexps where possible.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-match-page (&rest match)
+ "Return a list of match data to all pages in MATCH.
+MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See
+`m-buffer-match' for further details."
+ (m-buffer-apply-join 'm-buffer-match
+ match :regexp page-delimiter))
+;; #+end_src
+
+;; The `paragraph-separate' regexp can match an empty region, so we need to start
+;; each search at the beginning of the next line.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-match-paragraph-separate (&rest match)
+ "Return a list of match data to `paragraph-separate' in MATCH.
+MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See
+`m-buffer-match' for futher details."
+ (m-buffer-apply-join
+ 'm-buffer-match match :regexp paragraph-separate
+ :post-match 'm-buffer-post-match-forward-line))
+
+(defvar m-buffer--line-regexp
+ "^.*$"
+ "Regexp to match a line.")
+
+(defun m-buffer-match-line (&rest match)
+ "Return a list of match data to all lines.
+MATCH is of the form BUFFER-OR-WINDOW MATCH-OPTIONS.
+See `m-buffer-match for further details."
+ (m-buffer-apply-join
+ 'm-buffer-match
+ match :regexp m-buffer--line-regexp
+ :post-match 'm-buffer-post-match-forward-char))
+
+(defun m-buffer-match-line-start (&rest match)
+ "Return a list of match data to all line start.
+MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See
+`m-buffer-match' for further details."
+ (m-buffer-apply-join
+ 'm-buffer-match-begin
+ match :regexp "^"
+ :post-match 'm-buffer-post-match-forward-char))
+
+(defun m-buffer-match-line-end (&rest match)
+ "Return a list of match to line end.
+MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See
+`m-buffer-match' for further details."
+ (m-buffer-apply-join
+ 'm-buffer-match-begin
+ match :regexp "$"
+ :post-match 'm-buffer-post-match-forward-char))
+;; #+end_src
+
+;; This is the first use of the =post-match= to terminate the loop, and was
+;; actually the motivation for adding it. We automatically terminate after the
+;; first match by simply returning nil.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-match-first (&rest match)
+ "Return the first match to MATCH.
+This matches more efficiently than matching all matches and
+taking the car. See `m-buffer-match' for further details of
+MATCH."
+ (m-buffer-apply-join
+ #'m-buffer-match match
+ :post-match (lambda () nil)))
+
+(defun m-buffer-match-first-line (&rest match)
+ "Return a match to the first line of MATCH.
+This matches more efficiently than matching all lines and taking
+the car. See `m-buffer-match' for further details of MATCH."
+ (m-buffer-apply-join
+ 'm-buffer-match-first match
+ :regexp m-buffer--line-regexp))
+
+(defun m-buffer-match-multi (regexps &rest match)
+ "Incrementally find matches to REGEXPS in MATCH.
+Finds the first match to the first element of regexps, then
+starting from the end of this match, the first match to the
+second element of regexps and so forth. See `m-buffer-match' for
+futher details of MATCH."
+ (when regexps
+ (let ((first-match
+ (m-buffer-apply-join
+ #'m-buffer-match-first
+ match
+ :regexp (car regexps))))
+ (append
+ first-match
+ (apply
+ #'m-buffer-match-multi
+ (cdr regexps)
+ (plist-put
+ match
+ :begin (car (m-buffer-match-end first-match))))))))
+;; #+end_src
+
+;; Emacs has a rather inconsistent interface here -- suddenly, we have a function
+;; rather than a variable for accessing a regexp.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-match-sentence-end (&rest match)
+ "Return a list of match to sentence end.
+MATCH is of the form BUFFER-OR-WINDOW MATCH-OPTIONS. See
+`m-buffer-match' for further details."
+ (m-buffer-apply-join
+ 'm-buffer-match-begin
+ match :regexp (sentence-end)))
+
+(defun m-buffer-match-word (&rest match)
+ "Return a list of match to all words.
+MATCH is of the form BUFFER-OR-WINDOW MATCH-OPTIONS. See
+`m-buffer-match' for further details."
+ (m-buffer-apply-join
+ 'm-buffer-match
+ match :regexp "\\\w+"))
+
+(defun m-buffer-match-empty-line (&rest match)
+ "Return a list of match to all empty lines.
+MATCH is of the form BUFFER-OR-WINDOW MATCH-OPTIONS. See
+`m-buffer-match' for further details."
+ (m-buffer-apply-join
+ 'm-buffer-match
+ match :regexp "^$"
+ :post-match 'm-buffer-post-match-forward-line))
+
+(defun m-buffer-match-non-empty-line (&rest match)
+ "Return a list of match to all non-empty lines.
+MATCH is fo the form BUFFER-OR-WINDOW MATCH-OPTIONS. See
+`m-buffer-match' for further details."
+ (m-buffer-apply-join
+ 'm-buffer-match
+ match :regexp "^.+$"))
+
+(defun m-buffer-match-whitespace-line (&rest match)
+ "Return match data to all lines with only whitespace characters.
+Note empty lines are not included. MATCH is of form
+BUFFER-OR-WINDOW MATCH-OPTIONS. See `m-buffer-match' for
+further details."
+ (m-buffer-apply-join
+ 'm-buffer-match
+ match :regexp "^\\s-+$"))
+
+;; #+end_src
+
+;; I don't think that there is a way to do this with regexps entirely, so we use
+;; substraction.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-match-non-whitespace-line (&rest match)
+ "Return match data to all lines with at least one non-whitespace character.
+Note empty lines do not contain any non-whitespace lines.
+MATCH is of form BUFFER-OR-WINDOW MATCH-OPTIONS. See
+`m-buffer-match' for further details."
+ (seq-difference
+ (apply 'm-buffer-match-line match)
+ (apply 'm-buffer-match-whitespace-line match)))
+
+;; Useful post-match functions
+(defun m-buffer-post-match-forward-line ()
+ "Attempt to move forward one line, return true if success."
+ (= 0 (forward-line)))
+
+(defun m-buffer-post-match-forward-char ()
+ "Attempts to move forward one char.
+Returns true if succeeds."
+ (condition-case _e
+ (progn
+ (forward-char)
+ t)
+ (error 'end-of-buffer
+ nil)))
+;; #+end_src
+
+
+;; ** Apply Function to Match
+
+;; These functions apply another function to some match-data. This is pretty
+;; useful generically, but also I use it for many of the following functions.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-on-region (fn match-data)
+ "Apply FN to MATCH-DATA.
+FN should take two args, the start and stop of each region.
+MATCH-DATA can be any list of lists with two elements (or more)."
+ (m-buffer-on-region-nth-group fn 0 match-data))
+
+(defun m-buffer-on-region-nth-group (fn n match-data)
+ "Apply FN to the Nth group of MATCH-DATA.
+FN should take two args, the start and stop of each region.
+MATCH-DATA can be any list of lists with two elements (or more)."
+ (seq-map
+ (lambda (x)
+ (apply fn x))
+ (m-buffer-match-nth-group n match-data)))
+;; #+end_src
+
+;; ** Overlay and Property Functions
+
+;; Adding properties or overlays to match-data. The functionality here somewhat
+;; overlaps with [[https://github.com/ShingoFukuyama/ov.el][ov.el]], which I didn't know about when I wrote this. It generally
+;; works over overlays, or regexps, while m-buffer works over match-data.
+
+;; #+begin_src emacs-lisp
+(defun m-buffer-overlay-match (match-data &optional front-advance rear-advance)
+ "Return an overlay for all match to MATCH-DATA.
+FRONT-ADVANCE and REAR-ADVANCE controls the borders of the
+overlay as defined in `make-overlay'. Overlays do not scale that
+well, so use `m-buffer-propertize-match' if you intend to make
+and keep many of these.
+
+See Info node `(elisp) Overlays' for further information."
+ (let ((buffer (m-buffer-buffer-for-match match-data)))
+ (m-buffer-on-region
+ (lambda (beginning end)
+ (make-overlay
+ beginning end buffer
+ front-advance rear-advance))
+ match-data)))
+
+(defun m-buffer-add-text-property-match
+ (match-data properties)
+ "To MATCH-DATA add PROPERTIES.
+See `add-text-property' for details of the format of properties.
+Text properties are associated with the text and move with it. See
+Info node `(elisp) Text Properties' for further details."
+ (m-buffer-on-region
+ (lambda (beginning end)
+ (add-text-properties beginning end properties))
+ match-data))
+
+(defun m-buffer-put-text-property-match (match-data property value)
+ "To MATCH-DATA add PROPERTY wth VALUE.
+See `put-text-property' for details of the format of properties.
+Text properties are associated with the text and move with it. See
+Info node `(elisp) Text Properties' for further details."
+ (m-buffer-on-region
+ (lambda (beginning end)
+ (put-text-property beginning end property value))
+ match-data))
+
+(defun m-buffer-overlay-face-match (match-data face)
+ "To MATCH-DATA add FACE to the face property.
+This is for use in buffers which do not have function `font-lock-mode'
+enabled; otherwise use `m-buffer-overlay-font-lock-face-match'."
+ (seq-map
+ (lambda (ovly)
+ (overlay-put ovly 'face face))
+ (m-buffer-overlay-match match-data)))
+
+(defun m-buffer-overlay-font-lock-face-match (match-data face)
+ "To MATCH-DATA add FACE to the face property.
+This is for use in buffers which have variable `font-lock-mode' enabled;
+otherwise use `m-buffer-overlay-face-match'."
+ (seq-map
+ (lambda (ovly)
+ (overlay-put ovly 'face face))
+ (m-buffer-overlay-match match-data)))
+
+(defun m-buffer-text-property-face (match-data face)
+ "To MATCH-DATA apply FACE.
+This is for use in buffers which do
+not have variable `font-lock-mode' enabled; otherwise use
+`m-buffer-text-property-font-lock-face'."
+ (m-buffer-put-text-property-match match-data
+ 'face face))
+
+(defun m-buffer-text-property-font-lock-face (match-data face)
+ "To MATCH-DATA apply FACE.
+This is for use in buffers which have variable `font-lock-mode'
+enabled; otherwise use `m-buffer-text-property-face'."
+ (m-buffer-put-text-property-match match-data
+ 'font-lock-face face))
+
+(provide 'm-buffer)
+
+
+;;; m-buffer.el ends here
+;; #+end_src
--- /dev/null
+;;; tutorial-tests.el --- Test suite for tutorial -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
+
+;; Author: Phillip Lord <phillip.lord@russet.org.uk>
+;; Keywords: abbrevs
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'tutorial)
+
+(ert-deftest tutorial--open-tutorial ()
+ ;; We do not care about the return value (which happens to be nil),
+ ;; but it should not error.
+ (should-not
+ (let ((current-language-environment "English"))
+ (help-with-tutorial)))
+ (should-not
+ (let ((current-language-environment "Russian"))
+ (help-with-tutorial)))
+ (should-error
+ (let ((current-language-environment "Elvish"))
+ (help-with-tutorial))))
+
+
+(provide 'tutorial-tests)
+;;; tutorial-tests.el ends here
projects / emacs.git / commitdiff