Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

add rollup.el

  • Loading branch information...
commit 7d1d28782144872e40f1a5e6991f767450d147c2 1 parent 9440f38
Jonathan Rockway authored

Showing 1 changed file with 67 additions and 0 deletions. Show diff stats Hide diff stats

  1. +67 0 _local/rollup.el
67 _local/rollup.el
... ... @@ -0,0 +1,67 @@
  1 +;;; rollup.el --- roll multiple levels of indentation into a single statement
  2 +
  3 +;; Copyright (C) 2012 Jonathan Rockway
  4 +
  5 +;; Author: Jonathan Rockway <jon@jrock.us>
  6 +;; Keywords: lisp
  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 <http://www.gnu.org/licenses/>.
  20 +
  21 +;;; Commentary:
  22 +
  23 +;; Sometimes you end up nested pretty deeply for implementation
  24 +;; reasons rather than for semantic clarity:
  25 +;;
  26 +;; (with-current-buffer (buf)
  27 +;; (save-excursion
  28 +;; (save-match-data
  29 +;; (save-restriction
  30 +;; (let ((foo 42))
  31 +;; (code-goes-here))))))
  32 +;;
  33 +;; This module lets you write this with one level of indentation:
  34 +;;
  35 +;; (rollup ((with-current-buffer (buf))
  36 +;; save-excursion
  37 +;; save-match-data
  38 +;; save-restriction
  39 +;; (let ((foo 42))))
  40 +;; code-goes-here)
  41 +
  42 +;;; Code:
  43 +
  44 +(defmacro rollup (wrappers &rest body)
  45 + "Expand WRAPPERS to wrap around the code block BODY."
  46 + (declare (indent defun))
  47 + (labels ((nest (x y) (append x (list y)))
  48 + (ensure-list (x) (if (listp x) x (list x)))
  49 + (to-progn (forms) (list (cons 'progn forms)))
  50 + (right-fold (f xs) (reduce f xs :from-end t)))
  51 + (right-fold #'nest (append (mapcar #'ensure-list wrappers)
  52 + (to-progn body)))))
  53 +
  54 +;; Example / test:
  55 +;;
  56 +;; (defmacro fixup-y (&rest body)
  57 +;; `(let ((y -40)) ,@body))
  58 +
  59 +;; (defun test-rollup ()
  60 +;; (rollup ((let ((x 42)))
  61 +;; (let ((y 123)))
  62 +;; fixup-y
  63 +;; (message "result is %s")) ;; 2
  64 +;; (+ x y)))
  65 +
  66 +(provide 'rollup)
  67 +;;; rollup.el ends here

0 comments on commit 7d1d287

Please sign in to comment.
Something went wrong with that request. Please try again.