Update Github username

[gnu-emacs-elpa] / names-dev.el

diff --git a/names-dev.el b/names-dev.el
index bc9552bbe124bdee5ad79da5abd800dcb009a9f7..0c2dc20254ae5af4b0364334097adf40b247bb6d 100644 (file)
--- a/names-dev.el
+++ b/names-dev.el
@@ -1,8 +1,9 @@
 ;;; names-dev.el --- Developer Functions to facilitate use of names.el with your package.
 
-;; Copyright (C) 2014 Artur Malabarba <bruce.connor.am@gmail.com>
+;; Copyright (C) 2014 Free Software Foundation, Inc.
 
 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
+;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com>
 ;; URL: http://github.com/Bruce-Connor/names
 ;; Prefix: names
 ;; Separator: -
@@ -61,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)
@@ -117,12 +118,7 @@ If KILL is non-nil, kill the temp buffer afterwards."
               command))
          (entire-namespace
           (save-excursion
-            (when (progn
-                    (end-of-defun)
-                    (beginning-of-defun)
-                    (ignore-errors
-                      (backward-up-list)
-                      (names--looking-at-namespace)))
+            (when (names--top-of-namespace)
               (cdr (read (current-buffer))))))
          b keylist spec name expanded-form)
 
@@ -155,6 +151,19 @@ If KILL is non-nil, kill the temp buffer afterwards."
          (when (and ,kill (buffer-live-p b))
            (kill-buffer b))))))
 
+(defun names--top-of-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.
 Argument EDEBUG-IT is the same as `eval-defun', causes the form
@@ -172,7 +181,9 @@ to be edebugged."
 \f
 ;;; 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."
@@ -184,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)))))))
 
 \f
 ;;; Find stuff
@@ -207,9 +227,7 @@ Argument EVAL-LAST-SEXP-ARG-INTERNAL is the same as `eval-print-last-sexp'."
 (defalias 'find-function-read 'names--find-function-read)
 
 (defun names--find-function-read (&optional type)
-  "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")
+  "Identical to `find-function-read', except it works inside namespaces."
   (let ((buf (current-buffer)))
     (names--wrapped-in-namespace
       (names--find-function-read-original type) nil t