[elpa] master d75791d 11/11: Merge commit 'b1da26d96cbe8308d0988f6b92737819f98f20fd'

[Artur Malabarba]

branch: master
commit d75791d74e92fac5ab8c757276a048c4d029180c
Merge: 951b5e3 b1da26d
Author: Artur Malabarba <address@hidden>
Commit: Artur Malabarba <address@hidden>

    Merge commit 'b1da26d96cbe8308d0988f6b92737819f98f20fd'
---
 packages/names/TheNittyGritty.org |   35 +++++++++++++++
 packages/names/UsageExample.org   |    5 ++-
 packages/names/names-dev.el       |   48 ++++++++++++++-------
 packages/names/names.el           |   86 +++++++++++++++++++++++-------------
 4 files changed, 126 insertions(+), 48 deletions(-)

diff --git a/packages/names/TheNittyGritty.org 
b/packages/names/TheNittyGritty.org
index 78bf88b..84bf6b8 100644
--- a/packages/names/TheNittyGritty.org
+++ b/packages/names/TheNittyGritty.org
@@ -139,6 +139,41 @@ need to worry about, it should just do what you expect 
from it.
 
 This is only relevant if you write your own macros. If you do,
 remember to add a debug declaration in them.
+
+*** The theading macros (~->~ and ~-->~)
+
+The threading macros would require special treatment to namespace
+correctly. However, you can use the ~:functionlike-macros~ keyword to
+tell *Names* to treat them as regular functions.
+
+For example, in the following snippet:
+#+BEGIN_SRC emacs-lisp
+(require 'dash)
+(define-namespace foo-
+:functionlike-macros (-> ->>)
+
+(defvar var nil)
+(defun fun (x &optional y)
+  (concat x y))
+
+(-> "some string"
+    (fun var)
+    fun)
+)
+#+END_SRC
+the ~(fun var)~ part would be namespaced prefectly fine (~fun~ and
+~var~ will be identified as a function and variable respectively),
+because it looks like a regular function call. However, the second use
+of ~fun~ will not be correctly namespaced, because that ~fun~ looks
+like a variable.
+
+In other words, you should use these macros like this instead:
+#+BEGIN_SRC emacs-lisp
+(-> "some string"
+    (fun var)
+    (fun))
+#+END_SRC
+
 ** Accessing Global Symbols
 If one of your definitions shadows a global definition, you can still
 access it by prefixing it with =::=.
diff --git a/packages/names/UsageExample.org b/packages/names/UsageExample.org
index b27160e..5730966 100644
--- a/packages/names/UsageExample.org
+++ b/packages/names/UsageExample.org
@@ -14,7 +14,10 @@ The important items are already listed in the Readme:
 
 ;;; Code:
 
-;; `define-namespace' is autoloaded, so there's no need to require `names'.
+;; `define-namespace' is autoloaded, so there's no need to require
+;; `names'. However, requiring it here means it will also work for
+;; people who don't install through package.el.
+(eval-when-compile (require 'names))
 
 ;;;###autoload
 (define-namespace example-
diff --git a/packages/names/names-dev.el b/packages/names/names-dev.el
index 0133604..0c2dc20 100644
--- a/packages/names/names-dev.el
+++ b/packages/names/names-dev.el
@@ -62,11 +62,11 @@
 (defmacro names-print (name &rest forms)
   "Return the expanded results of (namespace NAME :global :verbose FORMS).
 Ideal for determining why a specific form isn't being parsed
-correctly."
+correctly. You may need to set `eval-expression-print-level' and
+`eval-expression-print-length' to nil in order to see your full
+expansion."
   (declare (indent (lambda (&rest x) 0)) (debug 0))
-  `(let ((eval-expression-print-level (max eval-expression-print-level 300))
-         (eval-expression-print-length (max eval-expression-print-length 300)))
-     (macroexpand '(define-namespace ,name :global :verbose ,@forms))))
+  `(define-namespace ,name :global :verbose ,@forms))
 
 (defvar names-font-lock
   '(("^:autoload\\_>" 0 'font-lock-warning-face prepend)
@@ -152,12 +152,17 @@ If KILL is non-nil, kill the temp buffer afterwards."
            (kill-buffer b))))))
 
 (defun names--top-of-namespace ()
-  ""
-  (progn
-    (beginning-of-defun)
-    (ignore-errors
-      (backward-up-list)
-      (names--looking-at-namespace))))
+  "Move to the top of current namespace, and return non-nil.
+If not inside a namespace, return nil and don't move point."
+  (let ((top (save-excursion
+               (beginning-of-defun)
+               (ignore-errors
+                 (backward-up-list))
+               (when (names--looking-at-namespace)
+                 (point)))))
+    (when top
+      (goto-char top)
+      t)))
 
 (defun names-eval-defun (edebug-it)
   "Identical to `eval-defun', except it works for forms inside namespaces.
@@ -176,7 +181,9 @@ to be edebugged."
 
 ;;; eval-last-sexp
 (defalias 'names--preceding-sexp-original
-  (symbol-function 'elisp--preceding-sexp))
+  (if (fboundp 'elisp--preceding-sexp)
+      (symbol-function 'elisp--preceding-sexp)
+    (symbol-function 'preceding-sexp)))
 
 (defun names--preceding-sexp ()
   "Like `elisp--preceding-sexp', but expand namespaces."
@@ -188,19 +195,28 @@ to be edebugged."
   "Identical to `eval-last-sexp', except it works for forms inside namespaces.
 Argument EVAL-LAST-SEXP-ARG-INTERNAL is the same as `eval-last-sexp'."
   (interactive "P")
-  (cl-letf (((symbol-function 'elisp--preceding-sexp)
-             #'names--preceding-sexp))
+  (cl-letf (((symbol-function 'elisp--preceding-sexp) #'names--preceding-sexp)
+            ((symbol-function 'preceding-sexp) #'names--preceding-sexp))
     (eval-last-sexp eval-last-sexp-arg-internal)))
 
 (defun names-eval-print-last-sexp (eval-last-sexp-arg-internal)
   "Identical to `eval-print-last-sexp', except it works for forms inside 
namespaces.
 Argument EVAL-LAST-SEXP-ARG-INTERNAL is the same as `eval-print-last-sexp'."
   (interactive "P")
-  (cl-letf (((symbol-function 'elisp--preceding-sexp)
-             #'names--preceding-sexp))
+  (cl-letf (((symbol-function 'elisp--preceding-sexp) #'names--preceding-sexp)
+            ((symbol-function 'preceding-sexp) #'names--preceding-sexp))
     (eval-print-last-sexp eval-last-sexp-arg-internal)))
 
-;; (pp (symbol-function 'names-eval-defun) (current-buffer))
+;; (pp (symbol-function 'names--preceding-sexp-original) (current-buffer))
+
+(defun names-pprint ()
+  "Pretty-print an expansion of the namespace around point."
+  (interactive)
+  (save-excursion
+    (when (names--top-of-namespace)
+      (let ((ns (cdr (read (current-buffer)))))
+        (pp-macroexpand-expression
+         (macroexpand (cons 'names-print ns)))))))
 
 
 ;;; Find stuff
diff --git a/packages/names/names.el b/packages/names/names.el
index ee8768c..71bd0d1 100644
--- a/packages/names/names.el
+++ b/packages/names/names.el
@@ -5,7 +5,7 @@
 ;; Author: Artur Malabarba <address@hidden>
 ;; Maintainer: Artur Malabarba <address@hidden>
 ;; URL: http://github.com/Bruce-Connor/names
-;; Version: 20150115.1
+;; Version: 20150618.0
 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
 ;; Keywords: extensions lisp
 ;; Prefix: names
@@ -86,7 +86,8 @@ it will set PROP."
   (if (fboundp 'macrop) #'macrop
     (lambda (object)
       "Non-nil if and only if OBJECT is a macro."
-      (let ((def (indirect-function object t)))
+      (let ((def (or (ignore-errors (indirect-function object t))
+                     (ignore-errors (indirect-function object)))))
         (when (consp def)
           (or (eq 'macro (car def))
               (and (names--autoloadp def) (memq (nth 4 def) '(macro t)))))))))
@@ -124,7 +125,7 @@ it will set PROP."
 
 ;;; ---------------------------------------------------------------
 ;;; Variables
-(defconst names-version "20150115.1" "Version of the names.el package.")
+(defconst names-version "20150618.0" "Version of the names.el package.")
 
 (defvar names--name nil
   "Name of the current namespace inside the `define-namespace' macro.")
@@ -186,6 +187,22 @@ Is only non-nil if the :group keyword is passed to 
`define-namespace'.")
   "The version number given by :version.
 Used to define a constant and a command.")
 
+(defvar names--functionlike-macros nil
+  "Function-like macros, even if their debug-spec says otherwise.
+When expanding the namespace, these macros will be treated
+exactly like functions. This means that their contents will be
+namespaced like regular function arguments.
+
+To add macros to this list, pass the :functionlike-macros keyword
+to your namespace along with a list of macro names (as unquoted
+symbols).
+Example:
+
+    (define-namespace foo-
+    :functionlike-macros (-> ->> thread-first thread-last)
+    ;; Rest of code
+    )")
+
 (defconst names--keyword-list
   `((:group
      1 ,(lambda (x)
@@ -244,6 +261,12 @@ needed by the :version and :group keywords.")
                 (format "\\`%s" (regexp-quote val)))))
      "Change the value of the `names--protection' variable.")
 
+    (:functionlike-macros
+     1
+     ,(lambda (x) (setq names--functionlike-macros
+                   (append x names--functionlike-macros)))
+     "A list of values to be appended to `names--functionlike-macros'.")
+
     (:no-let-vars
      0 nil
      "Indicates variables assigned in let-bind are NOT candidates for 
namespacing.")
@@ -296,8 +319,8 @@ behaviour.")
      (remove
       nil
       (mapcar (lambda (x) (when (funcall (or ,pred #'identity) (or (car-safe 
x) x))
-                (or (car-safe x) x)))
-          ,var))))
+                            (or (car-safe x) x)))
+              ,var))))
 
 (defmacro names--next-keyword (body)
   "If car of BODY is a known keyword, `pop' it (and its arguments) from body.
@@ -411,6 +434,7 @@ See `define-namespace' for more information."
               (names--remove-namespace-from-list
                (names--filter-if-bound byte-compile-macro-environment (lambda 
(x) (not (names--compat-macrop x))))
                (names--filter-if-bound byte-compile-function-environment 
(lambda (x) (not (names--compat-macrop x))))))
+             (names--functionlike-macros names--functionlike-macros)
              names--keywords names--local-vars key-and-args
              names--version names--package names--group-parent)
         ;; Read keywords
@@ -597,28 +621,29 @@ Also adds `version' to `names--fbound' and 
`names--bound'."
                                byte-compile-macro-environment))))))))
 
 ;;;###autoload
-(defadvice find-function-search-for-symbol
-    (around names-around-find-function-search-for-symbol-advice
-            (symbol type library) activate)
-  "Make sure `find-function-search-for-symbol' understands namespaces."
-  ad-do-it
-  (ignore-errors
-    (unless (cdr ad-return-value)
-      (with-current-buffer (car ad-return-value)
-        (search-forward-regexp "^(define-namespace\\_>")
-        (skip-chars-forward "\r\n[:blank:]")
-        (let* ((names--regexp
-                (concat "\\`" (regexp-quote
-                               (symbol-name (read (current-buffer))))))
-               (short-symbol
-                ;; We manually implement `names--remove-namespace'
-                ;; because it might not be loaded.
-                (let ((name (symbol-name symbol)))
-                  (when (string-match names--regexp name)
-                    (intern (replace-match "" nil nil name))))))
-          (when short-symbol
-            (ad-set-arg 0 short-symbol)
-            ad-do-it))))))
+(eval-after-load 'find-func
+  '(defadvice find-function-search-for-symbol
+       (around names-around-find-function-search-for-symbol-advice
+               (symbol type library) activate)
+     "Make sure `find-function-search-for-symbol' understands namespaces."
+     ad-do-it
+     (ignore-errors
+       (unless (cdr ad-return-value)
+         (with-current-buffer (car ad-return-value)
+           (search-forward-regexp "^(define-namespace\\_>")
+           (skip-chars-forward "\r\n[:blank:]")
+           (let* ((names--regexp
+                   (concat "\\`" (regexp-quote
+                                  (symbol-name (read (current-buffer))))))
+                  (short-symbol
+                   ;; We manually implement `names--remove-namespace'
+                   ;; because it might not be loaded.
+                   (let ((name (symbol-name symbol)))
+                     (when (string-match names--regexp name)
+                       (intern (replace-match "" nil nil name))))))
+             (when short-symbol
+               (ad-set-arg 0 short-symbol)
+               ad-do-it)))))))
 
 (defun names--extract-autoloads (body)
   "Return a list of the forms in BODY preceded by :autoload."
@@ -749,7 +774,6 @@ returns nil."
   "If non-nil, verbose message are printed regardless of the :verbose keyword.
 Use this to easily turn on verbosity during tests.")
 
-;; This is calling edebug even on `when' and `unless'
 (defun names--args-of-function-or-macro (function args macro)
   "Namespace FUNCTION's arguments ARGS, with special treatment if MACRO is 
non-nil."
   (if macro
@@ -757,7 +781,8 @@ Use this to easily turn on verbosity during tests.")
             (names--verbose (eq function 'push)))
         (names--message "Edebug-spec of `%s' is %s" function it)
         ;; Macros where we evaluate all arguments are like functions.
-        (if (equal it t)
+        (if (or (equal it t)
+                (memq function names--functionlike-macros))
             (names--args-of-function-or-macro function args nil)
           ;; Macros where nothing is evaluated we can just return.
           (if (equal it 0)
@@ -953,8 +978,7 @@ the keyword arguments, if any."
 ;; Defun, defmacro, and defsubst macros are pretty predictable.
 (defun names--convert-defmacro (form)
   "Special treatment for `defmacro' FORM."
-  (let* (;; (names--name-already-prefixed t) ;FIXME: Unused?!
-         (name (cadr form))
+  (let* ((name (cadr form))
          (spaced-name (names--prepend name))
          decl)
     (add-to-list 'names--macro name)