├── .gitignore
├── README.org
├── makefile
├── test.org
├── yodel-elpaca.el
└── yodel.el


/.gitignore:
--------------------------------------------------------------------------------
1 | *.elc
2 | \#*#
3 | .#*
4 | *~
5 | 


--------------------------------------------------------------------------------
/README.org:
--------------------------------------------------------------------------------
 1 | * Yodel: Communicable Elisp ⛰🎶⛰
 2 | ** Yodel-ay-hee-why?
 3 | The purpose of this package is to make it easier to reproduce elisp bugs.
 4 | Bug reproduction cases often follow this pattern:
 5 | 
 6 | #+begin_example
 7 | Given file "foo" with the following contents:
 8 | 
 9 | --8<---------------cut here---------------start------------->8---
10 | foo bar baz
11 | --8<---------------cut here---------------end--------------->8---
12 | 
13 | Execute the following:
14 | 1. do this
15 | 2. do that
16 | 3. do this
17 | #+end_example
18 | 
19 | This is error prone and inefficient. It requires anyone on the other end to
20 | prepare the test environment and manually execute the reproduction steps. One
21 | also has to ensure their elisp environment is clean (ideally only having the
22 | minimal set of packages needed installed and freshly loaded).
23 | 
24 | ** Yodel-ay-hee-what?
25 | Yodel allows one to send a declarative form which describes
26 | the elisp environment and a program to execute within that environment. Others may
27 | execute the form on their system and compare results easily via consistently
28 | formatted reports.
29 | 
30 | For example, evaluating the following:
31 | 
32 | #+begin_src emacs-lisp :lexical t :results silent
33 | (yodel
34 |   :post*
35 |   (yodel-file
36 |     :point "|"
37 |     :with* "test: |fail"
38 |     :then*
39 |     (kill-word 1)
40 |     (insert "pass")
41 |     (message "%s" (buffer-string))))
42 | #+end_src
43 | 
44 | results in the following report when using the org report formatter:
45 | 
46 | #+begin_src org
47 | ,* YODEL REPORT [2021-09-08 17:51]
48 | 
49 | ,#+begin_src emacs-lisp :lexical t
50 | (yodel
51 |   :post*
52 |   (yodel-file
53 |     :point "|"
54 |     :with* "test: |fail"
55 |     :then*
56 |     (kill-word 1)
57 |     (insert "pass")
58 |     (message "%s"
59 |              (buffer-string))))
60 | ,#+end_src
61 | 
62 | ,** STDOUT:
63 | 
64 | ,#+begin_src emacs-lisp :lexical t
65 | test: pass
66 | ,#+end_src
67 | 
68 | ,** Environment
69 | 
70 | - =emacs version=: GNU Emacs 28.0.50 (build 1, x86_64-pc-linux-gnu, X toolkit, cairo version 1.17.4, Xaw3d scroll bars)
71 |  of 2021-09-04
72 | - =system type=: gnu/linux
73 | #+end_src
74 | 
75 | Reformatting reports is as easy as =M-x yodel-reformat=.
76 | Yodel offers out-of-the-box formatters for:
77 | 
78 | - Github
79 | - Reddit
80 | - Org
81 | - Mailing lists
82 | 
83 | ** Yodel-ay-hee-how?
84 | Yodel is currently only available via this repository.
85 | *** Install with [[https://github.com/raxod502/straight.el][straight.el]]
86 | #+begin_src emacs-lisp :lexical t
87 | (straight-use-package '(yodel :host github :repo "progfolio/yodel"))
88 | #+end_src
89 | (side note: The inspiration for yodel is straight.el's =straight-bug-report=)
90 | *** Install manually
91 | - Clone this repository
92 | - Add it to your load-path
93 | - =(require 'yodel)=
94 | ** NOTICE
95 | Yodel is still in early development.
96 | API is experimental at this time.
97 | 


--------------------------------------------------------------------------------
/makefile:
--------------------------------------------------------------------------------
 1 | .POSIX:
 2 | #To test with a different Emacs version run:
 3 | #$ export EMACS=<desired Emacs executable>
 4 | #$ make -e
 5 | EMACS = emacs
 6 | PKG = yodel
 7 | 
 8 | #Point to path of your local emacs-buttercup install
 9 | BUTTERCUP = ../emacs-buttercup/
10 | 
11 | .PHONY: all
12 | all: clean compile check
13 | 
14 | compile: $(PKG).elc
15 | check: $(PKG).elc
16 | 	$(EMACS) -Q --batch -L . -L $(BUTTERCUP) -l buttercup -f buttercup-run-discover
17 | clean:
18 | 	rm -f $(PKG).elc
19 | .SUFFIXES: .el .elc
20 | .el.elc:
21 | 	$(EMACS) -Q --batch -L . -f batch-byte-compile $<
22 | 


--------------------------------------------------------------------------------
/test.org:
--------------------------------------------------------------------------------
 1 | YODEL REPORT (2021-09-07 22:14:00):
 2 | 
 3 | #+begin_src emacs-lisp :lexical t :results silent
 4 | (yodel
 5 |   :post*
 6 |   ;;adding something to the report...
 7 |   ;;@TODO: should this should be a macro
 8 |   ;; which captures the free variable yodel-args?
 9 |   ;; e.g. (yodel-put :test "Pass")?
10 |   (setq yodel-args (plist-put yodel-args :test "PASS"))
11 |   (yodel-file
12 |     :contents "test: |fail"
13 |     :then*
14 |     (kill-word 1)
15 |     (insert "pass")
16 |     (message "%s" (buffer-string))))
17 | #+end_src
18 | 
19 | STDOUT:
20 | 
21 | #+begin_src emacs-lisp :lexical t
22 | hi
23 | #+end_src
24 | 
25 | STDERR:
26 | 
27 | #+begin_src emacs-lisp :lexical t
28 | (void-function oops)
29 | #+end_src
30 | 
31 | - emacs vesrion: GNU Emacs 28.0.50 (build 1, x86_64-pc-linux-gnu, X toolkit, cairo version 1.17.4, Xaw3d scroll bars)
32 |   of 2021-09-04
33 | - system type: gnu/linux
34 | 


--------------------------------------------------------------------------------
/yodel-elpaca.el:
--------------------------------------------------------------------------------
  1 | ;;; yodel-elpaca.el --- Yodel Elpaca integration     -*- lexical-binding: t; -*-
  2 | 
  3 | ;; Copyright (C) 2023-2025  Nicholas Vollmer
  4 | 
  5 | ;; Author: Nicholas Vollmer
  6 | ;; Keywords: convenience
  7 | 
  8 | ;; This program is free software; you can redistribute it and/or modify
  9 | ;; it under the terms of the GNU General Public License as published by
 10 | ;; the Free Software Foundation, either version 3 of the License, or
 11 | ;; (at your option) any later version.
 12 | 
 13 | ;; This program is distributed in the hope that it will be useful,
 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 16 | ;; GNU General Public License for more details.
 17 | 
 18 | ;; You should have received a copy of the GNU General Public License
 19 | ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 20 | 
 21 | ;;; Commentary:
 22 | 
 23 | ;;
 24 | 
 25 | ;;; Code:
 26 | (require 'yodel)
 27 | 
 28 | (declare-function elpaca-generate-autoloads "elpaca")
 29 | (declare-function elpaca-process-queues "elpaca")
 30 | (declare-function elpaca "elpaca")
 31 | (declare-function elpaca-wait "elpaca")
 32 | (declare-function elpaca-get "elpaca")
 33 | (declare-function elpaca--queued "elpaca")
 34 | (declare-function elpaca-menu-item "elpaca")
 35 | (declare-function elpaca<-repo-dir "elpaca")
 36 | (declare-function elpaca<-recipe "elpaca")
 37 | (declare-function elpaca-process-output "elpaca-process")
 38 | 
 39 | (defvar yodel-elpaca--bootstrap
 40 |   '(progn
 41 |      (defvar elpaca-installer-version 0.5)
 42 |      (defvar elpaca-directory (expand-file-name "elpaca/" user-emacs-directory))
 43 |      (defvar elpaca-builds-directory (expand-file-name "builds/" elpaca-directory))
 44 |      (defvar elpaca-repos-directory (expand-file-name "repos/" elpaca-directory))
 45 |      (defvar elpaca-order '(elpaca :repo "https://github.com/progfolio/elpaca.git"
 46 |                                    :ref nil
 47 |                                    :files (:defaults (:exclude "extensions"))
 48 |                                    :build (:not elpaca--activate-package)))
 49 |      (let* ((repo  (expand-file-name "elpaca/" elpaca-repos-directory))
 50 |             (build (expand-file-name "elpaca/" elpaca-builds-directory))
 51 |             (order (cdr elpaca-order))
 52 |             (default-directory repo))
 53 |        (add-to-list 'load-path (if (file-exists-p build) build repo))
 54 |        (unless (file-exists-p repo)
 55 |          (make-directory repo t)
 56 |          (when (< emacs-major-version 28) (require 'subr-x))
 57 |          (condition-case-unless-debug err
 58 |              (if-let ((buffer (pop-to-buffer-same-window "*elpaca-bootstrap*"))
 59 |                       ((zerop (call-process "git" nil buffer t "clone"
 60 |                                             (plist-get order :repo) repo)))
 61 |                       ((zerop (call-process "git" nil buffer t "checkout"
 62 |                                             (or (plist-get order :ref) "--"))))
 63 |                       (emacs (concat invocation-directory invocation-name))
 64 |                       ((zerop (call-process emacs nil buffer nil "-Q" "-L" "." "--batch"
 65 |                                             "--eval" "(byte-recompile-directory \".\" 0 'force)")))
 66 |                       ((require 'elpaca))
 67 |                       ((elpaca-generate-autoloads "elpaca" repo)))
 68 |                  (progn (message "%s" (buffer-string)) (kill-buffer buffer))
 69 |                (error "%s" (with-current-buffer buffer (buffer-string))))
 70 |            ((error) (warn "%s" err) (delete-directory repo 'recursive))))
 71 |        (unless (require 'elpaca-autoloads nil t)
 72 |          (require 'elpaca)
 73 |          (elpaca-generate-autoloads "elpaca" repo)
 74 |          (load "./elpaca-autoloads")))
 75 |      (add-hook 'after-init-hook #'elpaca-process-queues)
 76 |      (elpaca `(,@elpaca-order))))
 77 | 
 78 | (defvar yodel-args)
 79 | (defun yodel-elpaca--install (&rest packages)
 80 |   "Install PACKAGES via Elpaca."
 81 |   (eval yodel-elpaca--bootstrap t)
 82 |   (mapc (lambda (declaration) (eval `(elpaca ,declaration) t)) packages)
 83 |   (unless (plist-get yodel-args :interactive) (elpaca-wait)))
 84 | 
 85 | (declare-function elpaca<-package "elpaca")
 86 | (defun yodel-elpaca--repo-info (e)
 87 |   "Return plist with branch, commit, commit date info for E."
 88 |   (if-let ((default-directory (elpaca<-repo-dir e))
 89 |            ((file-exists-p default-directory))
 90 |            (info (split-string (string-trim (elpaca-process-output "git" "show" "-s"
 91 |                                                                    "--format=%H %cs")
 92 |                                             " ")))
 93 |            (commit (car info)))
 94 |       (list :branch (string-trim (elpaca-process-output "git" "rev-parse" "--abbrev-ref" "HEAD"))
 95 |             :commit commit
 96 |             :date   (cadr info))
 97 |     (message "No repo info for %S" (elpaca<-package e))))
 98 | 
 99 | (defun yodel-elpaca--package-info ()
100 |   "Return pacakge info plist for use with yodel."
101 |   (cl-loop for (id . e) in (elpaca--queued)
102 |            for recipe = (elpaca<-recipe e)
103 |            for repo = (plist-get recipe :repo)
104 |            for local-repo = (or (plist-get recipe :local-repo) repo)
105 |            for host = (or (plist-get recipe :host) (plist-get recipe :fetcher))
106 |            for version = (yodel-elpaca--repo-info e)
107 |            for urls = (when repo (yodel--format-urls repo
108 |                                                      (plist-get version :commit)
109 |                                                      host))
110 |            for url = (car urls)
111 |            for menu-item = (elpaca-menu-item id)
112 |            for menu-props = (cdr menu-item)
113 |            collect
114 |            (progn
115 |              (setq version (plist-put version :commit-url (cdr urls)))
116 |              (list :name (symbol-name id) :url (or url (plist-get menu-props :url))
117 |                    :version version :repo repo :local-repo local-repo :host host
118 |                    :source (plist-get menu-props :source)))))
119 | 
120 | (provide 'yodel-elpaca)
121 | ;;; yodel-elpaca.el ends here
122 | 


--------------------------------------------------------------------------------
/yodel.el:
--------------------------------------------------------------------------------
  1 | ;;; yodel.el --- Communicable Elisp                    -*- lexical-binding: t; -*-
  2 | 
  3 | ;; Copyright (C) 2021-2025 Nicholas Vollmer
  4 | 
  5 | ;; Author:  Nicholas Vollmer
  6 | ;; URL: https://github.com/progfolio/yodel
  7 | ;; Created: August 30, 2021
  8 | ;; Keywords: convenience
  9 | ;; Package-Requires: ((emacs "26.1"))
 10 | ;; Version: 0.0.0
 11 | 
 12 | ;; This program is free software; you can redistribute it and/or modify
 13 | ;; it under the terms of the GNU General Public License as published by
 14 | ;; the Free Software Foundation, either version 3 of the License, or
 15 | ;; (at your option) any later version.
 16 | 
 17 | ;; This program is distributed in the hope that it will be useful,
 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 20 | ;; GNU General Public License for more details.
 21 | 
 22 | ;; You should have received a copy of the GNU General Public License
 23 | ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 24 | 
 25 | ;;; Commentary:
 26 | ;; The purpose of this package is to make it easier to reproduce elisp bugs.
 27 | ;; Often on a mailing list or forge issue, I see people type out a series
 28 | ;; of instructions which follow a common pattern:
 29 | ;;
 30 | ;; Given file "foo" with the following contents:
 31 | ;;
 32 | ;;--8<---------------cut here---------------start------------->8---
 33 | ;; foo bar baz
 34 | ;;--8<---------------cut here---------------end--------------->8---
 35 | ;;
 36 | ;; Execute the following:
 37 | ;; 1. do this
 38 | ;; 2. do that
 39 | ;; 3. do this
 40 | ;;
 41 | ;; This is error prone and inefficient. It requires anyone on the other end to
 42 | ;; prepare the environment (in this case a file) and manually execute the
 43 | ;; reproduction steps. Yodel allows one to send a declarative form which describes
 44 | ;; the environment and a program to execute within that environment. Others may
 45 | ;; execute the form on their system and compare results easily via a consistently
 46 | ;; formatted report.
 47 | 
 48 | ;;; Code:
 49 | (require 'cl-lib)
 50 | (require 'pp)
 51 | (eval-when-compile (require 'subr-x))
 52 | 
 53 | (defgroup yodel nil
 54 |   "Communicable Elisp."
 55 |   :group 'yodel
 56 |   :prefix "yodel-")
 57 | 
 58 | (defconst yodel--process-end-text "YODEL--PROCESS-END"
 59 |   "String denoting end of process output and start of report form.")
 60 | 
 61 | (defvar yodel--default-args `("-Q" "--eval" "(setq debug-on-error t)" "-L" ,(file-name-directory (locate-library "yodel")) "--eval")
 62 |   "Arguments passed to the Emacs executable when testing.")
 63 | 
 64 | (defvar yodel-process-buffer "*yodel*"
 65 |   "Name of the yodel subprocess buffer.")
 66 | 
 67 | (eval-and-compile
 68 |   (defvar yodel-formatters nil
 69 |     "List of yodel report formatting functions."))
 70 | 
 71 | (defvar-local yodel--report nil
 72 |   "Report data structure.
 73 | Used for reformatting the report.")
 74 | 
 75 | (defvar-local yodel-args nil)
 76 | 
 77 | (defun yodel--pretty-print (form)
 78 |   "Convert elisp FORM into formatted string."
 79 |   (let* ((print-level nil)
 80 |          (print-length nil)
 81 |          (print-quoted t)
 82 |          (pp-escape-newlines nil))
 83 |     (with-temp-buffer
 84 |       (insert (pp-to-string form))
 85 |       (goto-char (point-min))
 86 |       (emacs-lisp-mode)
 87 |       (font-lock-mode 1)
 88 |       (font-lock-ensure)
 89 |       (mapc (lambda (target)
 90 |               (save-excursion
 91 |                 (while (re-search-forward (car target) nil 'no-error)
 92 |                   (funcall (cdr target)))))
 93 |             '(("\\(?: \\(:[^z-a]*?\\) \\)";; keywords
 94 |                . (lambda ()
 95 |                    (when (eq (get-text-property (match-beginning 1) 'face)
 96 |                              'font-lock-builtin-face)
 97 |                      (replace-match
 98 |                       (concat "\n\\1" (if (string-suffix-p "*" (match-string 1)) "\n" " "))))))))
 99 |       ;; Remove empty lines.
100 |       (goto-char (point-min))
101 |       (flush-lines "\\(?:^[[:space:]]*$\\)")
102 |       (let ((inhibit-message t))
103 |         (indent-region (point-min) (point-max)))
104 |       (string-trim (buffer-substring-no-properties (point-min) (point-max))))))
105 | 
106 | (defmacro yodel-formatter (name description &rest body)
107 |   "Create a yodel formatting function with BODY and NAME.
108 | Add the function to `yodel-formatters'.
109 | Each function should accept a report plist as its sole argument.
110 | DESCRIPTION is used as the docstring, and when prompting via `yodel-reformat'.
111 | BODY will be executed in the context of an empty `yodel-process-buffer'.
112 | `buffer-string' is returned after BODY is executed.
113 | The following anaphoric bindings are available during BODY:
114 | 
115 | - stdout: The standard output of the subprocess.
116 | - stderr: The errors output by the subprocess.
117 | - report: The report form."
118 |   (declare (indent defun))
119 |   (let ((fn (intern (format "yodel-format-as-%s" name))))
120 |     (when (fboundp fn) (makunbound fn))
121 |     `(cl-pushnew
122 |       (defun ,fn (report)
123 |         ,(replace-regexp-in-string "report" #'upcase description)
124 |         (cl-destructuring-bind (&key stdout stderr report) report
125 |           (ignore report stdout stderr) ;no-op here to satisfy byte compiler.
126 |           (erase-buffer)
127 |           (goto-char (point-min))
128 |           ,@body
129 |           (buffer-string)))
130 |       yodel-formatters)))
131 | 
132 | (defun yodel--format-link (format-string name url)
133 |   "Replace NAME and URL in FORMAT-STRING."
134 |   (replace-regexp-in-string
135 |    "%url" url
136 |    (replace-regexp-in-string "%name" name format-string)))
137 | 
138 | (defvar yodel--host-url-formatters
139 |   '(("github.com" identity (lambda (url commit)
140 |                              (concat (replace-regexp-in-string "\\.git$" "" url) "/commit/" commit)))
141 |     ("gitlab.com" identity (lambda (url commit) (concat url "/-/commit/" commit)))
142 |     ("git.sr.ht"  identity (lambda (url commit) (concat url "/commit/" commit)))
143 |     ("\\(git.savannah.gnu.org/\\)\\(git\\)" "\\1c\\2"
144 |      (lambda (url commit) (concat url "/commit/?id=" commit))))
145 |   "List of URL formatters for various hosts.
146 | Each entry is a list form: (URL-REGEXP, URL-REPLACEMENT, COMMIT-URL-FORMATTER).")
147 | 
148 | (defun yodel--format-urls (repo commit &optional host)
149 |   "Return pair of URLS of form (REPO . COMMIT) considering HOST."
150 |   (when host (setq repo (format "https://%s.com/%s"
151 |                                 (alist-get host '((github . "github")
152 |                                                   (gitlab . "gitlab")))
153 |                                 repo)))
154 |   (if (string-match-p "https?:" repo)
155 |       (cl-some (lambda (formatter)
156 |                  (when (string-match-p (car formatter) repo)
157 |                    (let ((formatted
158 |                           (replace-regexp-in-string (car formatter)
159 |                                                     (cadr formatter) repo)))
160 |                      (cons formatted (funcall (caddr formatter) formatted commit)))))
161 |                yodel--host-url-formatters)))
162 | 
163 | (defun yodel--package-table-row (package &optional link-format short)
164 |   "Return formatted table row for PACKAGE.
165 | LINK-FORMAT is used to format links within the table row.
166 | It must contain two substitution strings: %name and %url.
167 | If SHORT is non-nil, abbreviated commits are used in links."
168 |   (cl-destructuring-bind
169 |       ( &key version url name source &allow-other-keys
170 |         &aux
171 |         ;;@TODO: link directly to branch
172 |         (link-format (or link-format "[%name](%url)"))
173 |         (name (if (and version url) (yodel--format-link link-format name url) name))
174 |         (vc-info
175 |          (apply #'format
176 |                 `("%-10s|%-10s|%s"
177 |                   ,@(if version
178 |                         (cl-destructuring-bind
179 |                             ( &key commit ((:commit-url url)) date branch
180 |                               &allow-other-keys
181 |                               &aux
182 |                               (abbrev (substring commit 0 10))
183 |                               (commit
184 |                                (if url
185 |                                    (if (and
186 |                                         (not short)
187 |                                         (string-match-p "github.com" url))
188 |                                        url
189 |                                      (yodel--format-link link-format abbrev url))
190 |                                  abbrev)))
191 |                             version
192 |                           (list branch commit date))
193 |                       '("nil" "nil" "nil"))))))
194 |       package
195 |     (format "|%s|%s|%s|" name vc-info source)))
196 | 
197 | (eval-and-compile
198 |   (yodel-formatter raw
199 |     "Format report as a raw, readable plist."
200 |     (insert (let (print-level print-length)
201 |               (pp-to-string report)))))
202 | 
203 | (eval-and-compile
204 |   (yodel-formatter mailing-list-message
205 |     "Format report as a plain text email message."
206 |     (message-mode)
207 |     (cl-flet ((quoted (s)
208 |                 (with-temp-buffer
209 |                   (with-silent-modifications ;otherwise we're prompted to save modified buffer
210 |                     (message-mode)
211 |                     (insert s)
212 |                     (comment-region (point-min) (point-max))
213 |                     (buffer-string))))
214 |               (underline ()
215 |                 (insert (make-string (save-excursion (forward-line -1)
216 |                                                      (- (line-end-position)
217 |                                                         (line-beginning-position)))
218 |                                      ?=))))
219 |       (insert (format "Yodel[1] Report %s\n"
220 |                       (format-time-string "%Y-%m-%d %H:%M:%S"
221 |                                           (plist-get report :yodel-time))))
222 |       (underline)
223 |       (insert "\n\n"
224 |               (with-temp-buffer
225 |                 (insert (plist-get report :yodel-form) "\n")
226 |                 (when (fboundp 'message-mark-inserted-region)
227 |                   (message-mark-inserted-region (point-min) (point-max)))
228 |                 (buffer-string)))
229 |       (when stdout
230 |         (insert "\nSTDOUT\n")
231 |         (underline)
232 |         (insert "\n\n" (quoted stdout) "\n"))
233 |       (when stderr
234 |         (insert "\nSTDERR\n")
235 |         (underline)
236 |         (insert "\n\n" (quoted stderr) "\n"))
237 |       (insert "\nEnvironment\n")
238 |       (underline)
239 |       (insert
240 |        "\n\n"
241 |        (mapconcat (lambda (el) (format "- %s: %s" (car el) (cdr el)))
242 |                   (list (cons "emacs version" (emacs-version))
243 |                         (cons "system type" system-type))
244 |                   "\n"))
245 |       (when-let ((packages (plist-get report :packages)))
246 |         (insert "\n\nPackages\n")
247 |         (underline)
248 |         (insert "\n")
249 |         (mapc (lambda (package)
250 |                 (let ((longest (number-to-string
251 |                                 (length (plist-get
252 |                                          (car (cl-sort (copy-tree packages)
253 |                                                        #'string>
254 |                                                        :key (lambda (p) (plist-get p :name))))
255 |                                          :name)))))
256 |                   (insert (format (concat "\n- %-" longest "s %s")
257 |                                   (plist-get package :name)
258 |                                   (or (plist-get (plist-get package :version) :commit-url)
259 |                                       (plist-get package :url))))))
260 |               (cl-sort (copy-tree packages) #'string< :key (lambda (p) (plist-get  p :name))))
261 |         "\n\n")
262 |       (insert "\n\n[1] https://www.github.com/progfolio/yodel"))
263 |     (set-buffer-modified-p nil)))
264 | 
265 | (eval-and-compile
266 |   (yodel-formatter org
267 |     "Format REPORT in Org syntax."
268 |     (when (fboundp 'org-mode) (org-mode))
269 |     (let ((src-start "#+begin_src emacs-lisp :lexical t :results silent\n")
270 |           (src-end "\n#+end_src")
271 |           (packages (plist-get report :packages)))
272 |       (insert
273 |        (string-join
274 |         `(,(format "* Yodel Report [%s]"
275 |                    (format-time-string "%Y-%m-%d %H:%M:%S"
276 |                                        (seconds-to-time (plist-get report :yodel-time))))
277 |           ,(concat src-start (plist-get report :yodel-form) src-end)
278 |           ,@(when stdout (list "** STDOUT:" (concat src-start stdout src-end)))
279 |           ,@(when stderr (list "** STDERR:" (concat src-start stderr src-end)))
280 |           "** Environment"
281 |           ,(mapconcat (lambda (el) (format "- %s: %s" (car el) (cdr el)))
282 |                       (list (cons "=emacs version=" (emacs-version))
283 |                             (cons "=system type=" system-type))
284 |                       "\n")
285 |           ,@(when packages
286 |               (list (concat
287 |                      "*** Packages\n\n"
288 |                      "| Name    | Branch  | Commit  | Date    | Source |\n"
289 |                      "|---------|---------|---------|---------|--------|\n"
290 |                      (mapconcat (lambda (p) (yodel--package-table-row p "[[%url][%name]]" 'short))
291 |                                 (cl-sort (copy-tree packages) #'string<
292 |                                          :key (lambda (p) (plist-get p :name)))
293 |                                 "\n")))))
294 |         "\n\n"))
295 |       (when packages
296 |         (when (fboundp 'org-cycle)
297 |           (goto-char (point-max))
298 |           (re-search-backward "^|")
299 |           (org-cycle))
300 |         (goto-char (point-min))))))
301 | 
302 | (eval-and-compile
303 |   (yodel-formatter reddit-markdown
304 |     "Format REPORT in reddit flavored markdown."
305 |     (when (fboundp 'markdown-mode) (markdown-mode))
306 |     (cl-flet ((indent (s) (with-temp-buffer
307 |                             (insert s)
308 |                             (let ((inhibit-message t))
309 |                               (indent-rigidly (point-min) (point-max) 4))
310 |                             (buffer-string))))
311 |       (insert
312 |        (string-join
313 |         `(,(format "# [Yodel](https://github.com/progfolio/yodel) Report (%s):"
314 |                    (format-time-string "%Y-%m-%d %H:%M:%S"
315 |                                        (seconds-to-time (plist-get report :yodel-time))))
316 |           ;;use four spaces because old reddit doesn't render code fences
317 |           ,(indent (plist-get report :yodel-form))
318 |           ,@(when stdout (list "## STDOUT:" (indent stdout)))
319 |           ,@(when stderr (list "## STDERR:" (indent stderr)))
320 |           "## Environment"
321 |           ,(mapconcat (lambda (el) (format "- %s: %s" (car el) (cdr el)))
322 |                       (list (cons "**emacs version**" (emacs-version))
323 |                             (cons "**system type**" system-type))
324 |                       "\n")
325 |           ,(when-let ((packages (plist-get report :packages)))
326 |              (concat
327 |               "### Packages\n\n"
328 |               "| Name    | Branch  | Commit  | Date    | Source |\n"
329 |               "|---------|---------|---------|---------|--------|\n"
330 |               (mapconcat (lambda (p) (yodel--package-table-row p nil 'short))
331 |                          (cl-sort (copy-tree (plist-get report :packages))
332 |                                   #'string<
333 |                                   :key (lambda (it) (plist-get it :name)))
334 |                          "\n"))))
335 |         "\n\n")))
336 |     (when (plist-get report :packages)
337 |       (when (fboundp 'markdown-cycle)
338 |         (goto-char (point-max))
339 |         (re-search-backward "^|")
340 |         (markdown-cycle))
341 |       (goto-char (point-min)))))
342 | 
343 | (eval-and-compile
344 |   (yodel-formatter github-markdown
345 |     "Format REPORT in github flavored markdown."
346 |     (when (fboundp 'markdown-mode) (markdown-mode))
347 |     (let ((fence-start "\n```emacs-lisp\n")
348 |           (fence-end "\n```\n")
349 |           (packages (plist-get report :packages)))
350 |       (insert
351 |        (string-join
352 |         `(,(format "[Yodel](https://github.com/progfolio/yodel) Report (%s):"
353 |                    (format-time-string "%Y-%m-%d %H:%M:%S"
354 |                                        (seconds-to-time (plist-get report :yodel-time))))
355 |           ,(concat fence-start (or (plist-get report :yodel-form) "(yodel)") fence-end)
356 |           ,@(when stdout (list "<details><summary>STDOUT:</summary>"
357 |                                (concat fence-start stdout fence-end)
358 |                                "</details>"))
359 |           ,@(when stderr (list "<details><summary>STDERR:</summary>"
360 |                                (concat fence-start stderr fence-end)
361 |                                "</details>"))
362 |           "<details><summary>Environment</summary>\n"
363 |           ,(mapconcat (lambda (el) (format "- %s: %s" (car el) (cdr el)))
364 |                       (list (cons "**emacs version**" (emacs-version))
365 |                             (cons "**system type**" system-type))
366 |                       "\n")
367 |           ,@(when packages
368 |               (list
369 |                "\n<details open><summary>Packages</summary>\n"
370 |                "| Name    | Branch  | Commit  | Date    | Source |"
371 |                "|---------|---------|---------|---------|--------|"
372 |                (mapconcat #'yodel--package-table-row (plist-get report :packages) "\n")
373 |                "\n</details>"))
374 |           "\n</details>")
375 |         "\n"))
376 |       (when (and packages (fboundp 'markdown-cycle))
377 |         (goto-char (point-max))
378 |         (re-search-backward "^|")
379 |         (markdown-cycle))
380 |       (goto-char (point-min)))))
381 | 
382 | (defcustom yodel-default-formatter #'yodel-format-as-org
383 |   "Default report formatting function."
384 |   :type 'function)
385 | 
386 | ;; A variadic plist is a strict subset of a plist.
387 | ;; Its keys must be keywords, its values may not be keywords. Empty keys are ignored.
388 | ;; If a key is declared multiple times, it's last declaration is returned.
389 | ;; Keywords suffixed with "*" pack all values until the next keyword in a list.
390 | (defun yodel-plist*-to-plist (plist*)
391 |   "Convert PLIST* to plist."
392 |   (when plist*
393 |     (let (plist variadic keyword last)
394 |       (unless (keywordp (car plist*))
395 |         (signal 'wrong-type-argument `(keywordp ,(car plist*))))
396 |       (dolist (el plist* plist)
397 |         (if (keywordp el)
398 |             (setq variadic (string-suffix-p "*" (symbol-name el))
399 |                   keyword el)
400 |           (setq plist
401 |                 (plist-put
402 |                  plist keyword
403 |                  (if variadic
404 |                      (append (plist-get plist keyword) (list el))
405 |                    (unless (keywordp last)
406 |                      (error "Non-variadic key \"%S\" passed more than one value" keyword))
407 |                    el))))
408 |         (setq last el)))))
409 | 
410 | (defun yodel--position-point (indicator)
411 |   "Replace point INDICATOR with actual point."
412 |   (goto-char (point-min))
413 |   (if (re-search-forward indicator nil 'noerror)
414 |       (replace-match "")
415 |     (goto-char (point-min))))
416 | 
417 | ;;@TODO: Needs to be more robust when we encounter a read error.
418 | (defun yodel--report (buffer)
419 |   "Read the report from BUFFER."
420 |   (if (get-buffer buffer)
421 |       (with-current-buffer buffer
422 |         (goto-char (point-min))
423 |         (list
424 |          :stdout (let ((stdout
425 |                         (string-trim
426 |                          (buffer-substring
427 |                           (point-min)
428 |                           (and (re-search-forward yodel--process-end-text)
429 |                                (line-beginning-position))))))
430 |                    (unless (string-empty-p stdout) stdout))
431 |          :report (and (forward-line) (read (current-buffer)))
432 |          :stderr (let ((stderr (string-trim
433 |                                 (buffer-substring (1+ (point)) (point-max)))))
434 |                    (unless (string-empty-p stderr) stderr))))
435 |     (error "Report process buffer no longer live")))
436 | 
437 | ;;@HACK:
438 | ;; Because we can't rely on the report buffer having lexical binding enabled
439 | ;; we store buffer-local variables in the process buffer prior to calling the sentinel.
440 | ;; ~ NV 2021-09-16
441 | (defvar-local yodel--interactive nil)
442 | (defvar-local yodel--raw nil)
443 | (defvar-local yodel--save nil)
444 | (defvar-local yodel--formatter nil)
445 | (defvar-local yodel--emacs.d nil)
446 | 
447 | (defun yodel-reformat (formatter)
448 |   "Reformat report with FORMATTER function."
449 |   (interactive (progn
450 |                  (or yodel--report
451 |                      (user-error "No report associated with current buffer"))
452 |                  (list
453 |                   (let* ((candidates
454 |                           (mapcar
455 |                            (lambda (fn) (cons
456 |                                          (format "%s -> %s"
457 |                                                  (replace-regexp-in-string
458 |                                                   "yodel-format-as-" ""
459 |                                                   (symbol-name fn))
460 |                                                  (car (split-string (documentation fn) "\n")))
461 |                                          fn))
462 |                            (cl-remove-if (lambda (formatter)
463 |                                            (eq formatter
464 |                                                (or yodel--formatter yodel-default-formatter)))
465 |                                          yodel-formatters)))
466 |                          (selection
467 |                           (completing-read "formatter: "
468 |                                            (setq candidates
469 |                                                  (cl-sort candidates #'string< :key #'car))
470 |                                            nil 'require-match)))
471 |                     (alist-get selection candidates nil nil #'equal)))))
472 |   (funcall formatter yodel--report)
473 |   (setq yodel--formatter formatter))
474 | 
475 | (defun yodel--sentinel (process _event)
476 |   "Pass PROCESS report to formatter."
477 |   (when (memq (process-status process) '(exit signal))
478 |     (let ((buffer (process-buffer process)))
479 |       (with-current-buffer buffer
480 |         ;;Bound to prevent buffer-local var wipe if formatter changes major mode.
481 |         (let ((save yodel--save)
482 |               (emacs.d yodel--emacs.d))
483 |           (unless yodel--interactive
484 |             (unless yodel--raw
485 |               (setq yodel--report (yodel--report buffer))
486 |               ;;Necessary to preserve in case formatter changes major mode
487 |               (put 'yodel--report 'permanent-local t)
488 |               (funcall yodel--formatter yodel--report)))
489 |           (display-buffer buffer '(display-buffer-reuse-window))
490 |           (unless save
491 |             (when (file-exists-p emacs.d) (delete-directory emacs.d 'recursive))))))))
492 | 
493 | ;;;###autoload
494 | (defmacro yodel-file (path &rest args)
495 |   "Create file at PATH and manipulate it according to ARGS.
496 | If PATH is nil, a temporary file is created via `make-temp-file'.
497 | Otherwise it is expanded relative to `default-directory'.
498 | ARGS must be a plist* with any of the following keys:
499 | 
500 | :point
501 | 
502 | A regexp representing the initial point position in file's buffer.
503 | An explicitly nil value will prevent the point from being searched for.
504 | 
505 | :with*
506 | 
507 | Contents which is converted into a string and inserted into file's buffer.
508 | The first :point indicator is replaced and point is positioned there.
509 | If no :point indicator is found, point is positioned at `point-min'.
510 | 
511 | :then*
512 | 
513 | Any number of forms which will be executed within the buffer.
514 | The file's initial contents have been written at this point.
515 | The result of the last form is returned.
516 | 
517 | :save
518 | 
519 | If this is non-nil, the file is saved to PATH.
520 | Otherwise it is deleted after `yodel-file' finishes running.
521 | 
522 | :overwrite
523 | 
524 | If this is non-nil, allow overwriting PATH.
525 | Otherwise throw an error if PATH exists."
526 |   (declare (indent defun))
527 |   (let ((file     (make-symbol "file"))
528 |         (return   (make-symbol "return"))
529 |         (buffer   (make-symbol "buffer"))
530 |         (a        (make-symbol "args"))
531 |         (with*    (make-symbol "with*"))
532 |         (point    (make-symbol "point"))
533 |         (then*    (make-symbol "then*"))
534 |         (p        (make-symbol "path")))
535 |     `(let* ((,p     ,path)
536 |             (,a     (yodel-plist*-to-plist (if (or (stringp ,p) (null ,p))
537 |                                                ',args
538 |                                              (prog1
539 |                                                  (append (list ,p) ',args)
540 |                                                (setq ,p nil)))))
541 |             (,point (plist-get ,a :point))
542 |             (,then* (plist-get ,a :then*))
543 |             (,file  (expand-file-name (or ,p (make-temp-name "yodel-"))
544 |                                       (if ,p default-directory
545 |                                         (temporary-file-directory))))
546 |             ,return)
547 |        (unless (plist-get ,a :overwrite)
548 |          (when (file-exists-p ,file)
549 |            (user-error "Cannot overwrite existing file: %S" ,file)))
550 |        ;;create the dir if necessary
551 |        ;;@TODO: keep track of what we're creating so that we can properly clean up
552 |        (let ((dir (file-name-directory ,file)))
553 |          (unless (file-exists-p dir) (make-directory dir t)))
554 |        (let ((,buffer (find-file-noselect ,file)))
555 |          (with-current-buffer ,buffer
556 |            (when-let ((,with* (plist-get ,a :with*)))
557 |              (erase-buffer)
558 |              (insert (mapconcat (lambda (el) (if (stringp el) el
559 |                                                ;;@TODO: abstract into macro?
560 |                                                ;;(yodel--without-print-limits ....)
561 |                                                (let (print-level
562 |                                                      print-length
563 |                                                      print-circle)
564 |                                                  (prin1-to-string el))))
565 |                                 ,with* "\n")))
566 |            (when ,point (yodel--position-point ,point))
567 |            (when ,then* (setq ,return (eval `(progn ,@,then*) t))))
568 |          (with-current-buffer ,buffer ;;rebound in case :then* chagned it
569 |            (set-buffer-modified-p nil)
570 |            ;;Avoiding write-file because it will add a final newline
571 |            (with-file-modes #o0666
572 |              (write-region (point-min) (point-max) ,file))
573 |            (kill-buffer ,buffer)
574 |            (unless (plist-get ,a :save) (delete-file ,file)))
575 |          ,return))))
576 | 
577 | ;;;###autoload
578 | (defmacro yodel (&rest declaration)
579 |   "Test elisp in a clean environment.
580 | DECLARATION may be any of the following keywords and their respective values:
581 |   - :pre* (Form)...
582 |       Forms evaluated before launching Emacs.
583 | 
584 |   - :post* (Form)...
585 |       Forms evaluated in the testing environment after bootstrapping.
586 | 
587 |   - :interactive Boolean
588 |       If nil, the subprocess will immediately exit after the test.
589 |       Output will be printed to `yodel-process-buffer'
590 |       Otherwise, the subprocess will be interactive.
591 | 
592 |   - :save Boolean or String
593 |       If a string, use that string as the :user-dir argument and save.
594 |       If otherwise non-nil, the :user-dir is not deleted after exiting.
595 |       Otherwise, it is immediately removed after the test is run.
596 | 
597 |   - :executable String
598 |       Indicate the Emacs executable to launch.
599 |       Defaults to the path of the current Emacs executable.
600 | 
601 |   - :raw Boolean
602 |       If non-nil, the raw process output is sent to
603 |       `yodel-process-buffer'. Otherwise, it is
604 |       passed to the :formatter function.
605 | 
606 |   - :user-dir String
607 |       If non-nil, the test is run with `user-emacs-directory' set to STRING.
608 |       Otherwise, a temporary directory is created and used.
609 |       Unless absolute, paths are expanded relative to the variable
610 |       `temporary-file-directory'.
611 |   - :clargs*
612 |       Command line args for the child process.
613 | 
614 |   - :packages*
615 |       Packages which are installed in the test enviornment.
616 |       Packages are installed via elpaca.el, which see for recipe format.
617 | 
618 | DECLARATION is accessible within the :post* phase via the `yodel-args' plist."
619 |   (declare (indent 0))
620 |   (let* ((declaration (yodel-plist*-to-plist
621 |                        (append declaration
622 |                                (list :yodel-form
623 |                                      (yodel--pretty-print (append '(yodel) declaration))))))
624 |          (pre* (plist-get declaration :pre*)))
625 |     `(let ((yodel-args ',declaration))
626 |        (cl-destructuring-bind
627 |            ( &key clargs* formatter interactive pre* post* raw save user-dir
628 |              ((:executable emacs) (concat invocation-directory invocation-name))
629 |              &allow-other-keys
630 |              &aux
631 |              (clargs (append (unless interactive '("--batch")) (or clargs* yodel--default-args)))
632 |              (formatter (or formatter yodel-default-formatter #'yodel-format-as-raw))
633 |              (emacs.d (expand-file-name
634 |                        (or user-dir (and (stringp save) save)
635 |                            (make-temp-file "yodel-" 'directory))
636 |                        temporary-file-directory))
637 |              program)
638 |            yodel-args
639 |          (unless (file-exists-p emacs.d)
640 |            (make-directory emacs.d 'parents))
641 |          (let ((default-directory emacs.d))
642 |            (progn
643 |              ,@pre*
644 |              ;; Bind program after :pre* in case yodel-args has been modified.
645 |              (setq program
646 |                    (let ((print-level  nil)
647 |                          (print-length nil)
648 |                          (print-circle nil))
649 |                      ;; Ensure default values are present even if not specified.
650 |                      (setq yodel-args (plist-put yodel-args :user-dir emacs.d)
651 |                            yodel-args (plist-put yodel-args :executable emacs))
652 |                      (pp-to-string
653 |                       ;; The top-level `let' is an intentional local
654 |                       ;; variable binding. We want users of
655 |                       ;; `yodel' to have access to their
656 |                       ;; args within :pre*/:post* programs. Since
657 |                       ;; we are binding with the package namespace, this
658 |                       ;; should not overwrite other user bindings.
659 |                       `(with-demoted-errors "%S"
660 |                          (require 'yodel)
661 |                          (setq yodel-args           ',yodel-args
662 |                                user-emacs-directory ,emacs.d
663 |                                default-directory    ,emacs.d
664 |                                server-name          ,emacs.d
665 |                                package-user-dir     (expand-file-name "elpa" ,emacs.d))
666 |                          (unwind-protect (progn
667 |                                            ;;@TOOD: simplify by moving to yodel-args?
668 |                                            ,@',(when-let ((packages (plist-get declaration :packages*)))
669 |                                                  `((require 'yodel-elpaca)
670 |                                                    (apply #'yodel-elpaca--install ',packages)))
671 |                                            ,@post*)
672 |                            (plist-put yodel-args :yodel-time
673 |                                       (string-to-number (format-time-string "%s")))
674 |                            (message "%s" ,yodel--process-end-text)
675 |                            (when (and (not ,interactive) (plist-get yodel-args :packages*))
676 |                              (setq yodel-args (plist-put yodel-args :packages
677 |                                                          (yodel-elpaca--package-info))))
678 |                            (message "%S" yodel-args))))))))
679 |          ;; Reset process buffer.
680 |          (with-current-buffer (get-buffer-create yodel-process-buffer)
681 |            (fundamental-mode) ; We want this to wipe out buffer local vars here
682 |            (erase-buffer)
683 |            (setq-local yodel--interactive interactive
684 |                        yodel--raw raw
685 |                        yodel--save save
686 |                        yodel--formatter formatter
687 |                        yodel--emacs.d emacs.d))
688 |          (make-process
689 |           :name    yodel-process-buffer
690 |           :buffer  yodel-process-buffer
691 |           :command `(,emacs ,@clargs ,program)
692 |           :sentinel #'yodel--sentinel)
693 |          (message "Running yodel in directory: %s" emacs.d)))))
694 | 
695 | ;;@TODO: Ensure unique user-dir for each test?
696 | ;;;###autoload
697 | (defmacro yodel-parallel (&rest args)
698 |   "Test in parallel, reporting differences in output.
699 | ARGS should be of the following form: (TEST... COMMON...)
700 | 
701 | Each TEST is a list of keywords and their values, which are passed to `yodel'.
702 | COMMON are remaining keyword val pairs which are appened to each TEST.
703 | e.g.
704 | 
705 | \\=(yodel-parallel
706 |   (:user-dir \"A\" :packages* (example :branch \"develop\"))
707 |   (:user-dir \"B\" :packages* (example :branch \"bugfix-example\"))
708 |   :post*
709 |   (example program))
710 | 
711 | Will run test A and B with the same :post* program."
712 |   (let ((tests (let (forms)
713 |                  (while (and (car args) (not (keywordp (car args))))
714 |                    (push (append '(yodel) (pop args)) forms))
715 |                  (nreverse forms))))
716 |     `(progn ,@(mapcar (lambda (test)
717 |                         `(let ((yodel-process-buffer
718 |                                 ,(let ((plist (yodel-plist*-to-plist (cdr test))))
719 |                                    (or (plist-get plist :user-dir)
720 |                                        (when-let ((save (plist-get plist :save)))
721 |                                          (and (stringp save) save))))))
722 |                            ,(append test args)))
723 |                       tests))))
724 | 
725 | (provide 'yodel)
726 | ;;; LocalWords:  subprocess MERCHANTABILITY Vollmer elisp Elisp elpa emacs variadic baz eval plist ARGS args dir src formatter pre namespace metaprogram reddit
727 | ;;; yodel.el ends here
728 | 


--------------------------------------------------------------------------------