[Emacs-diffs] master f447d33: * let-alist.el (let-alist): Enable access to deeper alists

[Artur Malabarba]

branch: master
commit f447d33fdb082ce8e5d336be6034df24339b4c45
Author: Artur Malabarba <address@hidden>
Commit: Artur Malabarba <address@hidden>

    * let-alist.el (let-alist): Enable access to deeper alists
    
    Acces them by using extra dots inside the dotted symbols.
---
 lisp/ChangeLog              |    5 +++
 lisp/let-alist.el           |   71 ++++++++++++++++++++++++++++++++----------
 test/ChangeLog              |    1 +
 test/automated/let-alist.el |   26 +++++++++++++++-
 4 files changed, 85 insertions(+), 18 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 12530a9..b658cc1 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2014-12-19  Artur Malabarba  <address@hidden>
+
+       * let-alist.el (let-alist): Enable access to deeper alists by
+       using dots inside the dotted symbols.
+
 2014-12-19  Alan Mackenzie  <address@hidden>
 
        Make C++11 uniform init syntax work.  New keywords "final" and 
"override"
diff --git a/lisp/let-alist.el b/lisp/let-alist.el
index 813b841..692beba 100644
--- a/lisp/let-alist.el
+++ b/lisp/let-alist.el
@@ -4,7 +4,7 @@
 
 ;; Author: Artur Malabarba <address@hidden>
 ;; Maintainer: Artur Malabarba <address@hidden>
-;; Version: 1.0.1
+;; Version: 1.0.2
 ;; 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:
 
 
@@ -72,6 +76,31 @@ symbol, and each cdr is the same symbol without the `.'."
    (t (apply #'append
         (mapcar #'let-alist--deep-dot-search data)))))
 
+(defun let-alist--access-sexp (symbol variable)
+  "Return a sexp used to acess 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.
@@ -83,20 +112,28 @@ 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 (gensym "alist")))
     `(let ((,var ,alist))
-       (let ,(mapcar (lambda (x) `(,(car x) (cdr (assq ',(cdr x) ,var))))
+       (let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) 
var)))
                (delete-dups (let-alist--deep-dot-search body)))
          ,@body))))
 
diff --git a/test/ChangeLog b/test/ChangeLog
index 80d2a40..7d23b3e 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,6 +1,7 @@
 2014-12-19  Artur Malabarba  <address@hidden>
 
        * automated/let-alist.el: require `cl-lib'
+       New tests for accessing alists inside alists.
 
 2014-12-18  Artur Malabarba  <address@hidden>
 
diff --git a/test/automated/let-alist.el b/test/automated/let-alist.el
index a700a47..391ccb4 100644
--- a/test/automated/let-alist.el
+++ b/test/automated/let-alist.el
@@ -33,7 +33,19 @@
           (cl-letf (((symbol-function #'gensym) (lambda (x) 'symbol)))
             (macroexpand
              '(let-alist data (list .test-one .test-two
-                                    .test-two .test-two)))))))
+                                    .test-two .test-two))))))
+  (should
+   (equal
+    (let ((.external "ext")
+          (.external.too "et"))
+      (let-alist '((test-two . 0)
+                   (test-three . 1)
+                   (sublist . ((foo . 2)
+                               (bar . 3))))
+        (list .test-one .test-two .test-three
+              .sublist.foo .sublist.bar
+              ..external ..external.too)))
+    (list nil 0 1 2 3 "ext" "et"))))
 
 (defvar let-alist--test-counter 0
   "Used to count number of times a function is called.")
@@ -49,5 +61,17 @@
         (list .test-one .test-two .test-two .test-three .cl-incf))
       '(nil 1 1 2 nil)))))
 
+(ert-deftest let-alist-remove-dot ()
+  "Remove firt dot from symbol."
+  (should (equal (let-alist--remove-dot 'hi) 'hi))
+  (should (equal (let-alist--remove-dot '.hi) 'hi))
+  (should (equal (let-alist--remove-dot '..hi) '.hi)))
+
+(ert-deftest let-alist-list-to-sexp ()
+  "Check that multiple dots are handled correctly."
+  (should (= 1 (eval (let-alist--list-to-sexp '(a b c d) ''((d (c (b (a . 
1)))))))))
+  (should (equal (let-alist--access-sexp '.foo.bar.baz 'var)
+                 '(cdr (assq 'baz (cdr (assq 'bar (cdr (assq 'foo var))))))))
+  (should (equal (let-alist--access-sexp '..foo.bar.baz 'var) '.foo.bar.baz)))
 
 ;;; let-alist.el ends here