From 1de3732868add4ae4a6f698c445bdb9e2ca638bf Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 11 Dec 2014 10:54:43 +0000 Subject: Define sx-assoc-let in terms of let-alist --- sx.el | 54 ++++++++++++++---------------------------------------- 1 file changed, 14 insertions(+), 40 deletions(-) (limited to 'sx.el') diff --git a/sx.el b/sx.el index 0bacad2..deaac98 100644 --- a/sx.el +++ b/sx.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/vermiculus/sx.el/ ;; Version: 0.1 ;; Keywords: help, hypermedia, tools -;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0")) +;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0") (let-alist "1.0")) ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -308,7 +308,7 @@ removed from the display name before it is returned." string)) -;;; Assoc-let +;;; Site (defun sx--site (data) "Get the site in which DATA belongs. DATA can be a question, answer, comment, or user (or any object @@ -321,47 +321,21 @@ DATA can also be the link itself." "^https?://\\(?:\\(?1:[^/]+\\)\\.stackexchange\\|\\(?2:[^/]+\\)\\)\\.[^.]+/.*$" "\\1\\2" link)))) -(defun sx--deep-dot-search (data) - "Find symbols somewhere inside DATA which start with a `.'. -Returns a list where each element is a cons cell. The car is the -symbol, the cdr is the 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 (listp data)) nil) - (t (apply - #'append - (remove nil (mapcar #'sx--deep-dot-search data)))))) +(defun sx--ensure-site (data) + "Add a `site' property to DATA if it doesn't have one. Return DATA. +DATA can be a question, answer, comment, or user (or any object +with a `link' property)." + (unless (assq 'site data) + (setcdr data (cons (cons 'site (sx--site data)) + (cdr data)))) + data) (defmacro sx-assoc-let (alist &rest body) - "Use dotted symbols let-bound to their values in ALIST and execute BODY. -Dotted symbol is any symbol starting with a `.'. Only those -present in BODY are letbound, which leads to optimal performance. -The .site symbol is special, it is derived from the .link symbol -using `sx--site'. - -For instance, the following code - - (sx-assoc-let alist - (list .title .body)) - -is equivalent to - - (let ((.title (cdr (assoc 'title alist))) - (.body (cdr (assoc 'body alist)))) - (list .title .body))" + "Identical to `let-alist', except `.site' has a special meaning. +If ALIST doesn't have a `site' property, one is created using the +`link' property." (declare (indent 1) (debug t)) - (let* ((symbol-alist (sx--deep-dot-search body)) - (has-site (assoc '.site symbol-alist))) - `(let ,(append - (when has-site `((.site (sx--site (cdr (assoc 'link ,alist)))))) - (mapcar (lambda (x) `(,(car x) (cdr (assoc ',(cdr x) ,alist)))) - (remove '(.site . site) (delete-dups symbol-alist)))) - ,@body))) + `(let-alist (sx--ensure-site ,alist) ,@body)) (defcustom sx-init-hook nil "Hook run when SX initializes. -- cgit v1.2.3 From 07d50dde367ebb810a01d54b41bf69406618d1f2 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 11 Dec 2014 10:55:54 +0000 Subject: Some more whitespace --- sx.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'sx.el') diff --git a/sx.el b/sx.el index deaac98..4c1581e 100644 --- a/sx.el +++ b/sx.el @@ -197,7 +197,7 @@ Anything before the (sub)domain is removed." (eval-when-compile (concat "\\1" (if (char-displayable-p ?…) "…" "..."))) ;; Remove anything before subdomain. - (replace-regexp-in-string + (replace-regexp-in-string (rx string-start (or (and (0+ word) (optional ":") "//"))) "" url))) @@ -235,7 +235,7 @@ blocks." "Overlays created by sx on this buffer.") (make-variable-buffer-local 'sx--overlays) -(defvar sx--overlay-printing-depth 0 +(defvar sx--overlay-printing-depth 0 "Track how many overlays we're printing on top of each other. Used for assigning higher priority to inner overlays.") (make-variable-buffer-local 'sx--overlay-printing-depth) @@ -264,7 +264,7 @@ Return the result of BODY." (push ov sx--overlays)) result)) -(defvar sx--ascii-replacement-list +(defvar sx--ascii-replacement-list '(("[:space:]" . "") ("àåáâäãåą" . "a") ("èéêëę" . "e") -- cgit v1.2.3 From 36ae5019aa6d1cae3cab9e3330591e227b427814 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 11 Dec 2014 11:18:32 +0000 Subject: Fix assoc-let test --- sx.el | 3 ++- test/tests.el | 16 +++++++++------- 2 files changed, 11 insertions(+), 8 deletions(-) (limited to 'sx.el') diff --git a/sx.el b/sx.el index 4c1581e..bb7eddc 100644 --- a/sx.el +++ b/sx.el @@ -335,7 +335,8 @@ with a `link' property)." If ALIST doesn't have a `site' property, one is created using the `link' property." (declare (indent 1) (debug t)) - `(let-alist (sx--ensure-site ,alist) ,@body)) + `(progn (sx--ensure-site ,alist) + (let-alist ,alist ,@body))) (defcustom sx-init-hook nil "Hook run when SX initializes. diff --git a/test/tests.el b/test/tests.el index b997c6e..8d1ba44 100644 --- a/test/tests.el +++ b/test/tests.el @@ -121,16 +121,18 @@ (ert-deftest macro-test--sx-assoc-let () "Tests macro expansion for `sx-assoc-let'" (should - (equal '(let ((.test (cdr (assoc 'test data)))) - .test) - (macroexpand + (equal '(progn (sx--ensure-site data) + (let ((.test (cdr (assq 'test data)))) + .test)) + (macroexpand-all '(sx-assoc-let data .test)))) (should - (equal '(let ((.test-one (cdr (assoc 'test-one data))) - (.test-two (cdr (assoc 'test-two data)))) - (cons .test-one .test-two)) - (macroexpand + (equal '(progn (sx--ensure-site data) + (let ((.test-one (cdr (assq 'test-one data))) + (.test-two (cdr (assq 'test-two data)))) + (cons .test-one .test-two))) + (macroexpand-all '(sx-assoc-let data (cons .test-one .test-two)))))) -- cgit v1.2.3