Merge from origin/emacs-24

[gnu-emacs] / lisp / let-alist.el

diff --git a/lisp/let-alist.el b/lisp/let-alist.el
index 8f02404cbdfd7513b119c421f8504893e2ce148a..80b72d37ac980530fe55fe4a670ec7f88c136cbe 100644 (file)
--- a/lisp/let-alist.el
+++ b/lisp/let-alist.el
@@ -1,10 +1,10 @@
 ;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
 
 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
 ;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com>
-;; Version: 1.0.1
+;; Version: 1.0.3
 ;; Keywords: extensions lisp
 ;; Prefix: let-alist
 ;; Separator: -
@@ -39,21 +39,25 @@
 ;;   (let-alist alist
 ;;     (if (and .title .body)
 ;;         .body
-;;       .site))
+;;       .site
+;;       .site.contents))
 ;;
-;; expands to
+;; essentially expands to
 ;;
 ;;   (let ((.title (cdr (assq 'title alist)))
-;;         (.body (cdr (assq 'body alist)))
-;;         (.site (cdr (assq 'site 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
+;;       .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'.
 ;;
-;; Note that only one level is supported.  If you nest `let-alist'
-;; invocations, the inner one can't access the variables of the outer
-;; one.
-
 ;;; Code:
 \f
 
@@ -70,8 +74,33 @@ symbol, and each cdr is the same symbol without the `.'."
         (list (cons data (intern (replace-match "" nil nil name)))))))
    ((not (listp data)) nil)
    (t (apply #'append
-        (remove nil (mapcar #'let-alist--deep-dot-search data))))))
+        (mapcar #'let-alist--deep-dot-search 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)))
 
+\f
+;;; The actual macro.
 ;;;###autoload
 (defmacro let-alist (alist &rest body)
   "Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
@@ -83,22 +112,30 @@ For instance, the following code
   (let-alist alist
     (if (and .title .body)
         .body
-      .site))
+      .site
+      .site.contents))
 
-expands to
+essentially expands to
 
   (let ((.title (cdr (assq 'title alist)))
-        (.body (cdr (assq 'body alist)))
-        (.site (cdr (assq 'site 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
+      .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 (gensym "let-alist")))
-    `(let ((,var ,alist)
-           (let ,(mapcar (lambda (x) `(,(car x) (cdr (assq ',(cdr x) ,var))))
-                   (delete-dups (let-alist--deep-dot-search body)))
-             ,@body)))))
+  (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))))
 
 (provide 'let-alist)