mirror of https://tildegit.org/ben/dotfiles
183 lines
6.0 KiB
EmacsLisp
183 lines
6.0 KiB
EmacsLisp
;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
|
||
|
||
;; Author: Artur Malabarba <emacs@endlessparentheses.com>
|
||
;; Package-Requires: ((emacs "24.1"))
|
||
;; Version: 1.0.5
|
||
;; Keywords: extensions lisp
|
||
;; Prefix: let-alist
|
||
;; Separator: -
|
||
|
||
;; This is an Elpa :core package. Don't use functionality that is not
|
||
;; compatible with Emacs 24.1.
|
||
|
||
;; 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/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This package offers a single macro, `let-alist'. This macro takes a
|
||
;; first argument (whose value must be an alist) and a body.
|
||
;;
|
||
;; The macro expands to a let form containing body, where each dotted
|
||
;; symbol inside body is let-bound to their cdrs in the alist. Dotted
|
||
;; symbol is any symbol starting with a `.'. Only those present in
|
||
;; the body are let-bound and this search is done at compile time.
|
||
;;
|
||
;; For instance, the following code
|
||
;;
|
||
;; (let-alist alist
|
||
;; (if (and .title .body)
|
||
;; .body
|
||
;; .site
|
||
;; .site.contents))
|
||
;;
|
||
;; essentially expands to
|
||
;;
|
||
;; (let ((.title (cdr (assq 'title alist)))
|
||
;; (.body (cdr (assq 'body alist)))
|
||
;; (.site (cdr (assq 'site alist)))
|
||
;; (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
|
||
;; (if (and .title .body)
|
||
;; .body
|
||
;; .site
|
||
;; .site.contents))
|
||
;;
|
||
;; If you nest `let-alist' invocations, the inner one can't access
|
||
;; the variables of the outer one. You can, however, access alists
|
||
;; inside the original alist by using dots inside the symbol, as
|
||
;; displayed in the example above by the `.site.contents'.
|
||
;;
|
||
;;; Code:
|
||
|
||
|
||
(defun let-alist--deep-dot-search (data)
|
||
"Return alist of symbols inside DATA that start with a `.'.
|
||
Perform a deep search and return an alist where each car is the
|
||
symbol, and each cdr is the same symbol without the `.'."
|
||
(cond
|
||
((symbolp data)
|
||
(let ((name (symbol-name data)))
|
||
(when (string-match "\\`\\." name)
|
||
;; Return the cons cell inside a list, so it can be appended
|
||
;; with other results in the clause below.
|
||
(list (cons data (intern (replace-match "" nil nil name)))))))
|
||
((not (consp data)) nil)
|
||
((eq (car data) 'let-alist)
|
||
;; For nested ‘let-alist’ forms, ignore symbols appearing in the
|
||
;; inner body because they don’t refer to the alist currently
|
||
;; being processed. See Bug#24641.
|
||
(let-alist--deep-dot-search (cadr data)))
|
||
(t (append (let-alist--deep-dot-search (car data))
|
||
(let-alist--deep-dot-search (cdr data))))))
|
||
|
||
(defun let-alist--access-sexp (symbol variable)
|
||
"Return a sexp used to access SYMBOL inside VARIABLE."
|
||
(let* ((clean (let-alist--remove-dot symbol))
|
||
(name (symbol-name clean)))
|
||
(if (string-match "\\`\\." name)
|
||
clean
|
||
(let-alist--list-to-sexp
|
||
(mapcar #'intern (nreverse (split-string name "\\.")))
|
||
variable))))
|
||
|
||
(defun let-alist--list-to-sexp (list var)
|
||
"Turn symbols LIST into recursive calls to `cdr' `assq' on VAR."
|
||
`(cdr (assq ',(car list)
|
||
,(if (cdr list) (let-alist--list-to-sexp (cdr list) var)
|
||
var))))
|
||
|
||
(defun let-alist--remove-dot (symbol)
|
||
"Return SYMBOL, sans an initial dot."
|
||
(let ((name (symbol-name symbol)))
|
||
(if (string-match "\\`\\." name)
|
||
(intern (replace-match "" nil nil name))
|
||
symbol)))
|
||
|
||
|
||
;;; The actual macro.
|
||
;;;###autoload
|
||
(defmacro let-alist (alist &rest body)
|
||
"Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
|
||
Dotted symbol is any symbol starting with a `.'. Only those present
|
||
in BODY are let-bound and this search is done at compile time.
|
||
|
||
For instance, the following code
|
||
|
||
(let-alist alist
|
||
(if (and .title .body)
|
||
.body
|
||
.site
|
||
.site.contents))
|
||
|
||
essentially expands to
|
||
|
||
(let ((.title (cdr (assq \\='title alist)))
|
||
(.body (cdr (assq \\='body alist)))
|
||
(.site (cdr (assq \\='site alist)))
|
||
(.site.contents (cdr (assq \\='contents (cdr (assq \\='site alist))))))
|
||
(if (and .title .body)
|
||
.body
|
||
.site
|
||
.site.contents))
|
||
|
||
If you nest `let-alist' invocations, the inner one can't access
|
||
the variables of the outer one. You can, however, access alists
|
||
inside the original alist by using dots inside the symbol, as
|
||
displayed in the example above."
|
||
(declare (indent 1) (debug t))
|
||
(let ((var (make-symbol "alist")))
|
||
`(let ((,var ,alist))
|
||
(let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var)))
|
||
(delete-dups (let-alist--deep-dot-search body)))
|
||
,@body))))
|
||
|
||
;;;; ChangeLog:
|
||
|
||
;; 2015-12-01 Artur Malabarba <bruce.connor.am@gmail.com>
|
||
;;
|
||
;; packages/let-alist: Define it as a :core package
|
||
;;
|
||
;; 2015-06-11 Artur Malabarba <bruce.connor.am@gmail.com>
|
||
;;
|
||
;; * let-alist (let-alist--deep-dot-search): Fix cons
|
||
;;
|
||
;; 2015-03-07 Artur Malabarba <bruce.connor.am@gmail.com>
|
||
;;
|
||
;; let-alist: Update copyright
|
||
;;
|
||
;; 2014-12-22 Artur Malabarba <bruce.connor.am@gmail.com>
|
||
;;
|
||
;; packages/let-alist: Use `make-symbol' instead of `gensym'.
|
||
;;
|
||
;; 2014-12-20 Artur Malabarba <bruce.connor.am@gmail.com>
|
||
;;
|
||
;; packages/let-alist: Enable access to deeper alists
|
||
;;
|
||
;; 2014-12-14 Artur Malabarba <bruce.connor.am@gmail.com>
|
||
;;
|
||
;; let-alist.el: Add lexical binding. Version bump.
|
||
;;
|
||
;; 2014-12-11 Artur Malabarba <bruce.connor.am@gmail.com>
|
||
;;
|
||
;; let-alist: New package
|
||
;;
|
||
|
||
|
||
(provide 'let-alist)
|
||
|
||
;;; let-alist.el ends here
|