From: Artur Malabarba Date: Fri, 19 Dec 2014 20:25:06 +0000 (-0200) Subject: * let-alist.el (let-alist): Enable access to deeper alists X-Git-Tag: emacs-25.0.90~2635^2~16 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f447d33fdb082ce8e5d336be6034df24339b4c45;p=emacs.git * let-alist.el (let-alist): Enable access to deeper alists Acces them by using extra dots inside the dotted symbols. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 12530a997ba..b658cc1d0fa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2014-12-19 Artur Malabarba + + * let-alist.el (let-alist): Enable access to deeper alists by + using dots inside the dotted symbols. + 2014-12-19 Alan Mackenzie 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 813b8417aaa..692beba16dd 100644 --- a/lisp/let-alist.el +++ b/lisp/let-alist.el @@ -4,7 +4,7 @@ ;; Author: Artur Malabarba ;; Maintainer: Artur Malabarba -;; 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 80d2a40bc4c..7d23b3efe1c 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,6 +1,7 @@ 2014-12-19 Artur Malabarba * automated/let-alist.el: require `cl-lib' + New tests for accessing alists inside alists. 2014-12-18 Artur Malabarba diff --git a/test/automated/let-alist.el b/test/automated/let-alist.el index a700a4773ff..391ccb44a8d 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