In display-buffer-record-window record selected window if necessary.
[emacs.git] / lisp / let-alist.el
blob80b72d37ac980530fe55fe4a670ec7f88c136cbe
1 ;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
5 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
6 ;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com>
7 ;; Version: 1.0.3
8 ;; Keywords: extensions lisp
9 ;; Prefix: let-alist
10 ;; Separator: -
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;;; Commentary:
29 ;; This package offers a single macro, `let-alist'. This macro takes a
30 ;; first argument (whose value must be an alist) and a body.
32 ;; The macro expands to a let form containing body, where each dotted
33 ;; symbol inside body is let-bound to their cdrs in the alist. Dotted
34 ;; symbol is any symbol starting with a `.'. Only those present in
35 ;; the body are let-bound and this search is done at compile time.
37 ;; For instance, the following code
39 ;; (let-alist alist
40 ;; (if (and .title .body)
41 ;; .body
42 ;; .site
43 ;; .site.contents))
45 ;; essentially expands to
47 ;; (let ((.title (cdr (assq 'title alist)))
48 ;; (.body (cdr (assq 'body alist)))
49 ;; (.site (cdr (assq 'site alist)))
50 ;; (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
51 ;; (if (and .title .body)
52 ;; .body
53 ;; .site
54 ;; .site.contents))
56 ;; If you nest `let-alist' invocations, the inner one can't access
57 ;; the variables of the outer one. You can, however, access alists
58 ;; inside the original alist by using dots inside the symbol, as
59 ;; displayed in the example above by the `.site.contents'.
61 ;;; Code:
64 (defun let-alist--deep-dot-search (data)
65 "Return alist of symbols inside DATA that start with a `.'.
66 Perform a deep search and return an alist where each car is the
67 symbol, and each cdr is the same symbol without the `.'."
68 (cond
69 ((symbolp data)
70 (let ((name (symbol-name data)))
71 (when (string-match "\\`\\." name)
72 ;; Return the cons cell inside a list, so it can be appended
73 ;; with other results in the clause below.
74 (list (cons data (intern (replace-match "" nil nil name)))))))
75 ((not (listp data)) nil)
76 (t (apply #'append
77 (mapcar #'let-alist--deep-dot-search data)))))
79 (defun let-alist--access-sexp (symbol variable)
80 "Return a sexp used to access SYMBOL inside VARIABLE."
81 (let* ((clean (let-alist--remove-dot symbol))
82 (name (symbol-name clean)))
83 (if (string-match "\\`\\." name)
84 clean
85 (let-alist--list-to-sexp
86 (mapcar #'intern (nreverse (split-string name "\\.")))
87 variable))))
89 (defun let-alist--list-to-sexp (list var)
90 "Turn symbols LIST into recursive calls to `cdr' `assq' on VAR."
91 `(cdr (assq ',(car list)
92 ,(if (cdr list) (let-alist--list-to-sexp (cdr list) var)
93 var))))
95 (defun let-alist--remove-dot (symbol)
96 "Return SYMBOL, sans an initial dot."
97 (let ((name (symbol-name symbol)))
98 (if (string-match "\\`\\." name)
99 (intern (replace-match "" nil nil name))
100 symbol)))
103 ;;; The actual macro.
104 ;;;###autoload
105 (defmacro let-alist (alist &rest body)
106 "Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
107 Dotted symbol is any symbol starting with a `.'. Only those present
108 in BODY are let-bound and this search is done at compile time.
110 For instance, the following code
112 (let-alist alist
113 (if (and .title .body)
114 .body
115 .site
116 .site.contents))
118 essentially expands to
120 (let ((.title (cdr (assq 'title alist)))
121 (.body (cdr (assq 'body alist)))
122 (.site (cdr (assq 'site alist)))
123 (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
124 (if (and .title .body)
125 .body
126 .site
127 .site.contents))
129 If you nest `let-alist' invocations, the inner one can't access
130 the variables of the outer one. You can, however, access alists
131 inside the original alist by using dots inside the symbol, as
132 displayed in the example above."
133 (declare (indent 1) (debug t))
134 (let ((var (make-symbol "alist")))
135 `(let ((,var ,alist))
136 (let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var)))
137 (delete-dups (let-alist--deep-dot-search body)))
138 ,@body))))
140 (provide 'let-alist)
142 ;;; let-alist.el ends here