Exemplify-Align — Align examples' arrows (Emacs package)

Below you find the latest version of (1) the package's README and (2) its main source file.

For the git repository and issue tracker, see the project's page on sr.ht.

For more packages, see Software.

README.org

Overview

Exemplify-Align aligns the arrowheads of Exemplify-ERT–like one-lined examples.

(You can more easily create these examples with the package Exemplify-Eval.)

Here's what happens after running M-x exemplify-align-arrowheads with point in each of the regions below.

Region 1

From:

(make-vector 4 2)   => [2 2 2 2]
(vector 4 2) => [4 2]
(* 60 70) => 4200
(* 6 7)  => 42

To:

(make-vector 4 2) => [2 2 2 2]
(vector 4 2)      => [4 2]
(* 60 70)         => 4200
(* 6 7)           => 42

Region 2

From:

(exemplify-ert foo
  (take 5 (list :a :b :c :e :f :g :h))          => '(:a :b :c :e :f)
  (h<-it '(:a  . 1))   H==> (h* :a 1)
  (/ 1 0) !!> arith-error
  (* 60 700)              => 42000
  (cons 'x)       !!> wrong-number-of-arguments
  (* 6 7)                       => 42)

To:

(exemplify-ert foo
  (take 5 (list :a :b :c :e :f :g :h))   => '(:a :b :c :e :f)
  (h<-it '(:a  . 1))                   H==> (h* :a 1)
  (/ 1 0)                               !!> arith-error
  (* 60 700)                             => 42000
  (cons 'x)                             !!> wrong-number-of-arguments
  (* 6 7)                                => 42)

Region 3

From:

(exemplify-ert bar
  ;; Comment #1
  #s(hash-table size 4 data (:a 1))         H==> (h-st* 4 'eql :a 1)
  (* 6 7)     => 42
  (:a 1 :b 2)    P=> (:b 2 :a 1)
  ;; Comment #2
  (/ 42 0)   !!> arith-error
  (* 60 700) => 42000
  (string= 4 2)   !!> wrong-type-argument
  (h<-plist '(:a 1))                   H=> (h* :a 1)

To:

(exemplify-ert bar
  ;; Comment #1
  #s(hash-table size 4 data (:a 1)) H==> (h-st* 4 'eql :a 1)
  (* 6 7)                             => 42
  (:a 1 :b 2)                        P=> (:b 2 :a 1)
  ;; Comment #2
  (/ 42 0)                           !!> arith-error
  (* 60 700)                          => 42000
  (string= 4 2)                      !!> wrong-type-argument
  (h<-plist '(:a 1))                 H=> (h* :a 1)

Region 4

From:

(exemplify-ert quux
  (h* :a 1)   H=> (h* :a 1)
  #s(hash-table size 4 data (:a 1))         H==> (h-st* 4 'eql :a 1)
  (vector 4 2) => [4 2]
  (concat "a" foo "b")   !!> void-variable
  (* 6 7) => 42
  #s(hash-table size 2 test equal data (:a 1 :b 2))         H=> (h* :a 1 :b 2)
  (* 60 700)     => 42000)

To:

(exemplify-ert quux
  (h* :a 1)                                          H=> (h* :a 1)
  #s(hash-table size 4 data (:a 1))                 H==> (h-st* 4 'eql :a 1)
  (vector 4 2)                                        => [4 2]
  (concat "a" foo "b")                               !!> void-variable
  (* 6 7)                                             => 42
  #s(hash-table size 2 test equal data (:a 1 :b 2))  H=> (h* :a 1 :b 2)
  (* 60 700)                                          => 42000)

Installation

See my page Software for the most up-to-date instructions on how to download and install any of my Emacs packages.

Having downloaded and installed the package and its dependencies, adapt the configurations below to your init.el file.

(use-package exemplify-align)

Alternatively, if you don’t have use-package:

(require exemplify-align)

Contributing

See my page Software for information about how to contribute to any of my Emacs packages.

News

0.1.0

Release

License

This project follows the REUSE Specification (FAQ), which in turn is built upon SPDX.

Therefore, license and copyright information can be found in:

  • each file's comment header, or
  • an adjacent file of the same name with the additional extension .license, or
  • the .reuse/dep5 file

The full text of the licenses can be found in the LICENSES subdirectory.

exemplify-align.el

Structure

;;; exemplify-align.el --- Align examples' arrows -*- lexical-binding: t -*-
;;; Commentary:
;;;; For all the details, please do see the README
;;; Code:
;;;; Libraries
;;;; Package metadata
;;;; Customizable variables
;;;; Other variables
;;;; Functions
;;;;; Align evaluation arrows in region
;;;;; See README
;;;; Wrapping up
;;; exemplify-align.el ends here

Contents

;;; exemplify-align.el --- Align examples' arrows -*- lexical-binding: t -*-

;; SPDX-FileCopyrightText: © flandrew <https://flandrew.srht.site/listful>

;;---------------------------------------------------------------------------
;; Author:    flandrew
;; Created:   2024-09-29
;; Updated:   2025-01-02
;; Keywords:  convenience, lisp
;; Homepage:  <https://flandrew.srht.site/listful/software.html>
;;---------------------------------------------------------------------------
;; Package-Version:  0.1.0
;; Package-Requires: ((emacs "25.1"))
;;---------------------------------------------------------------------------

;; SPDX-License-Identifier: GPL-3.0-or-later

;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Exemplify-Align aligns the arrowheads of Exemplify-ERT–like examples.
;;
;; From:
;;   #s(hash-table data (:a 1 :b 2))         H==> (h-st* 65 'eql :a 1 :b 2)
;;   (* 6 7)         => 42
;;   (concat "a" foo "b")  !!> void-variable
;;
;; To:
;;   #s(hash-table data (:a 1 :b 2)) H==> (h-st* 65 'eql :a 1 :b 2)
;;   (* 6 7)                           => 42
;;   (concat "a" foo "b")             !!> void-variable
;;
;;;; For all the details, please do see the README
;;
;; Open it easily with:
;;   (find-file-read-only "README.org")   <--- C-x C-e here¹
;;
;; or from any buffer:
;;   M-x exemplify-align-see-readme
;;
;; or read it online:
;;   <https://flandrew.srht.site/listful/sw-emacs-exemplify-align.html>
;;
;; ¹ or the key that ‘eval-last-sexp’ is bound to, if not C-x C-e.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;; Code:
;;;; Libraries

(require 'align)
(require 'lisp-mnt)  ; ‘lm-summary’, ‘lm-homepage’, ‘lm-version’, ‘lm-header’


;;;; Package metadata

(defvar exemplify-align--name "Exemplify-Align")

(defvar exemplify-align--dot-el
  (format "%s.el" (file-name-sans-extension (eval-and-compile
                                              (or load-file-name
                                                  buffer-file-name)))))
(defvar exemplify-align--readme-org
  (expand-file-name "README.org" (file-name-directory exemplify-align--dot-el)))

(defvar exemplify-align--summary  (lm-summary   exemplify-align--dot-el))
(defvar exemplify-align--homepage (lm-homepage  exemplify-align--dot-el))
(defvar exemplify-align--version  (lm-with-file exemplify-align--dot-el
                                    (or (lm-header "package-version")
                                        (lm-version))))


;;;; Customizable variables

(defgroup exemplify-align nil
  (format "%s." exemplify-align--summary)
  :group 'convenience
  :link  '(emacs-library-link :tag "Lisp file" "exemplify-align.el")
  :link  `(file-link :tag "README.org" ,exemplify-align--readme-org)
  :link  `(url-link  :tag "Homepage"   ,exemplify-align--homepage))

(defcustom exemplify-align-spacing 1
  "Minimum space between evaluated sexp and arrowtail."
  :package-version '(exemplify-align "0.1.0")
  :group 'exemplify-align
  :type  'integer)


;;;; Other variables

(defvar exemplify-align--arrow-rx "\\([[:alnum:]]*=+>\\|!!>\\|~>\\)")


;;;; Functions
;;;;; Align evaluation arrows in region

;;;###autoload
(defun exemplify-align-arrowheads (&optional spacing)
  "Align examples' arrowheads in region.

Each example is expected to fit in a single line.

Region goes from the beginning of the BEG's line until the end of
END's line, where BEG and END demarcate the active region.

Pass a numeric SPACING to set up a minimal space between the end of
the evaluated sexp and the arrowtail. If SPACING is nil, it is set
to the value of ‘exemplify-align-spacing’. It this is also nil,
it is set to 1."
  (interactive "P")
  (barf-if-buffer-read-only)
  (if spacing
      (unless (natnump spacing)
        (error "Spacing must be a natural number"))
    (setq spacing (or exemplify-align-spacing 1)))
  (let (beg end lnb lne max rxs rxh rxv rxf)
    (when mark-active
      (setq beg (min (point) (mark))
            end (max (point) (mark))))
    (save-mark-and-excursion
      (if beg (goto-char beg) (backward-paragraph))
      (setq beg (line-beginning-position))
      (if end (goto-char end) (forward-paragraph))
      (setq end (line-end-position)
            lnb (line-number-at-pos beg)
            lne (line-number-at-pos end)
            max (- (exemplify-align--largest-arrow-len beg end) 2)
            rxs "\\(\\s-*\\)" ; padding spacing before
            rxh "[=!~]>"      ; acceptable head (and "neck")
            rxv (concat rxs exemplify-align--arrow-rx) ; varlen, tail-aligned
            rxf (format "%s.\\{%s\\}%s" rxs max rxh))  ; fixlen, head-aligned
      ;; Make sure the arrowtails are far enough from the sexp
      (align-regexp beg end rxv nil 2)
      ;; Then use fixed length to align arrowheads
      (goto-char (point-min))
      (forward-line (1-    lnb)) (setq beg (line-beginning-position))
      (forward-line (- lne lnb)) (setq end (line-end-position))
      (align-regexp beg end rxf nil spacing))))

(defun exemplify-align--largest-arrow-len (beg end)
  "Size of largest arrow in region from BEG to END."
  (apply #'max (mapcar #'length (exemplify-align--collect-arrows beg end))))

(defun exemplify-align--collect-arrows (beg end)
  "Collect arrows in region from BEG to END."
  (let ((str (buffer-substring-no-properties beg end))
        (res ()))
    (with-temp-buffer
      (save-excursion (insert str))
      (save-match-data
        (while (re-search-forward exemplify-align--arrow-rx nil t 1)
          (push (match-string 0) res)))
      (nreverse res))))


;;;;; See README

;;;###autoload
(defun exemplify-align-see-readme (&optional heading narrow)
  "Open exemplify-align's README.org file.
Search for the file in exemplify-align.el's directory.

If found, open it read-only.

If optional argument HEADING is passed, try to navigate to the
heading after opening it. HEADING should be a string.

If optional argument NARROW is non-nil, narrow to that heading.
This argument has no effect if HEADING is nil or not found."
  (interactive)
  (let ((readme exemplify-align--readme-org))
    (if (file-exists-p readme)
        (let ((pr (make-progress-reporter
                   (format "Opening %s ... "
                           (abbreviate-file-name readme)))))
          (find-file-read-only readme)
          (when heading
            (exemplify-align--goto-org-heading heading narrow))
          (progress-reporter-done pr))
      (message "Couldn't find %s's README.org" exemplify-align--name))))

;;;###autoload
(defun exemplify-align-see-news ()
  "See the News in exemplify-align's README.org file."
  (interactive)
  (exemplify-align-see-readme "News" 'narrow)
  (exemplify-align--display-org-subtree))

(defun exemplify-align--display-org-subtree ()
  "Selectively display org subtree."
  (let ((cmds '(outline-hide-subtree
                outline-show-children
                outline-next-heading
                outline-show-branches)))
    (and (fboundp (nth 0 cmds))
         (fboundp (nth 1 cmds))
         (fboundp (nth 2 cmds))
         (fboundp (nth 3 cmds))
         (mapc #'funcall cmds))))

(defun exemplify-align--goto-org-heading (heading &optional narrow)
  "Navigate to org HEADING and optionally NARROW to it."
  (let* ((hrx (format "^[*]+ %s" heading))
         (pos (save-match-data
                (save-excursion
                  (save-restriction
                    (widen)
                    (goto-char (point-max))
                    (re-search-backward hrx nil t 1))))))
    (when pos
      (widen)
      (goto-char pos)
      (if (and narrow (fboundp 'org-narrow-to-subtree))
          (org-narrow-to-subtree)
        (recenter-top-bottom 1))
      (when (fboundp 'outline-show-subtree)
        (outline-show-subtree))
      (when (fboundp 'org-flag-drawer)
        (save-excursion
          (forward-line 1)
          (org-flag-drawer t))))))


;;;; Wrapping up

(provide 'exemplify-align)

;; Local Variables:
;; coding:                     utf-8
;; indent-tabs-mode:           nil
;; sentence-end-double-space:  nil
;; outline-regexp:             ";;;;* "
;; End:

;;; exemplify-align.el ends here