-;;; names.el --- Namespaces for emacs-lisp. Avoid name clobbering without hiding symbols.
+;;; names.el --- Namespaces for emacs-lisp. Avoid name clobbering without hiding symbols. -*- lexical-binding:t -*-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 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
-;; Version: 0
+;; Version: 20150115.1
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
;; Keywords: extensions lisp
;; Prefix: names
\f
(require 'cl-lib)
+;;; This is a patch because edebug binds under `C-x'.
+;; If `C-x' is not a prefix.
+(unless (consp (key-binding "\C-x"))
+ ;; Disable the `C-xC-a' binds.
+ (defvar edebug-inhibit-emacs-lisp-mode-bindings)
+ (setq edebug-inhibit-emacs-lisp-mode-bindings t)
+ ;; And the `C-xX' binds.
+ (defvar global-edebug-prefix)
+ (when (or (null (boundp 'global-edebug-prefix))
+ (eq ?\C-x (elt global-edebug-prefix 0)))
+ (setq global-edebug-prefix "")))
(require 'edebug)
(require 'bytecomp)
(require 'advice)
;;; Support
(declare-function names--autoload-do-load "names" 2)
-(if (fboundp 'function-get)
- (defalias 'names--function-get #'function-get)
- (defun names--function-get (f prop &rest _)
- "Return the value of property PROP of function F.
+(defalias 'names--function-get
+ (if (fboundp 'function-get) #'function-get
+
+ (defun names--autoload-do-load (def name)
+ "Load autoloaded definition DEF from function named NAME."
+ (unless (load (cadr def) 'noerror)
+ (error "Macro `%s' is autoloaded, but its file (%s) couldn't be loaded"
+ name (cadr def)))
+ (symbol-function name))
+
+ (lambda (f prop &rest _)
+ "Return the value of property PROP of function F.
If F is an autoloaded macro, try to autoload it in the hope that
it will set PROP."
- (let ((val nil))
- (while (and (symbolp f)
- (null (setq val (get f prop)))
- (fboundp f))
- (let ((fundef (symbol-function f)))
- (if (and (names--autoloadp fundef)
- (not (equal fundef (names--autoload-do-load fundef f))))
- nil ;Re-try `get' on the same `f'.
- (setq f fundef))))
- val))
- (defun names--autoload-do-load (def name)
- "Load autoloaded definition DEF from function named NAME."
- (unless (load (cadr def) 'noerror)
- (error "Macro `%s' is autoloaded, but its file (%s) couldn't be loaded"
- name (cadr def)))
- (symbol-function name)))
-
-(if (fboundp 'macrop)
- (defalias 'names--compat-macrop #'macrop)
- (defun names--compat-macrop (object)
- "Non-nil if and only if OBJECT is a macro."
- (let ((def (indirect-function object t)))
- (when (consp def)
- (or (eq 'macro (car def))
- (and (names--autoloadp def) (memq (nth 4 def) '(macro t))))))))
-
-(if (fboundp 'autoloadp)
- (defalias 'names--autoloadp #'autoloadp)
- (defsubst names--autoloadp (object)
- "Non-nil if OBJECT is an autoload."
- (eq 'autoload (car-safe object))))
+ (let ((val nil))
+ (while (and (symbolp f)
+ (null (setq val (get f prop)))
+ (fboundp f))
+ (let ((fundef (symbol-function f)))
+ (if (and (names--autoloadp fundef)
+ (not (equal fundef (names--autoload-do-load fundef f))))
+ nil ;Re-try `get' on the same `f'.
+ (setq f fundef))))
+ val))))
+
+(defalias 'names--compat-macrop
+ (if (fboundp 'macrop) #'macrop
+ (lambda (object)
+ "Non-nil if and only if OBJECT is a macro."
+ (let ((def (indirect-function object t)))
+ (when (consp def)
+ (or (eq 'macro (car def))
+ (and (names--autoloadp def) (memq (nth 4 def) '(macro t)))))))))
+
+(defalias 'names--autoloadp
+ (if (fboundp 'autoloadp) #'autoloadp
+ (lambda (object)
+ "Non-nil if OBJECT is an autoload."
+ (eq 'autoload (car-safe object)))))
(unless (get-edebug-spec 'cl-defun)
(def-edebug-spec cl-defun defun*))
\f
;;; ---------------------------------------------------------------
;;; Variables
-(defconst names-version "0.5.5" "Version of the names.el package.")
+(defconst names-version "20150115.1" "Version of the names.el package.")
(defvar names--name nil
"Name of the current namespace inside the `define-namespace' macro.")
Used to define a constant and a command.")
(defconst names--keyword-list
- '((:group
- 1 (lambda (x)
- (if (symbolp x)
- (setq names--group-parent x)
- (names--warn
- "Argument given to :group is not a symbol: %s" x)))
+ `((:group
+ 1 ,(lambda (x)
+ (if (or (symbolp x) (listp x))
+ (setq names--group-parent x)
+ (names--warn
+ "Argument given to :group is not a symbol: %s" x)))
"Indicate `define-namespace' should make a `defgroup' for you.
The name of the group is the package name (see :package keyword).
This keyword should be given one argument, the name of the PARENT
group as an unquoted symbol.
+Alternatively, the argument can be a list, in which case it is a
+list of arguments to be passed to `defgroup' (essentially, a full
+group definition without the leading `defgroup').
+
If this keyword is provided, besides including a defgroup, Names
will also include a :group keyword in every `defcustom' (and
similar forms) that don't already contain one.")
(:version
1
- (lambda (x)
- (if (stringp x)
- (setq names--version x)
- (names--warn
- "Argument given to :version is not a string: %s" x)))
+ ,(lambda (x)
+ (if (stringp x)
+ (setq names--version x)
+ (names--warn
+ "Argument given to :version is not a string: %s" x)))
"Indicate `define-namespace' should define the version number.
This keyword should be given one argument, a string describing
the package's version number.
(:package
1
- (lambda (x)
- (if (symbolp x)
- (setq names--package x)
- (names--warn
- "Argument given to :package is not a symbol: %s" x)))
+ ,(lambda (x)
+ (if (symbolp x)
+ (setq names--package x)
+ (names--warn
+ "Argument given to :package is not a symbol: %s" x)))
"Set the name of this package to the given symbol.
This keyword should be given one argument, a symbol corresponding
to the name of this package.
(:protection
1
- (lambda (x)
- (let ((val (symbol-name x)))
- (setq names--protection
- (format "\\`%s" (regexp-quote val)))))
+ ,(lambda (x)
+ (let ((val (symbol-name x)))
+ (setq names--protection
+ (format "\\`%s" (regexp-quote val)))))
"Change the value of the `names--protection' variable.")
(:no-let-vars
`(when (boundp ',var)
(remove
nil
- (mapcar (lambda (x) (when (funcall (or ,pred 'identity) (or (car-safe x) x))
+ (mapcar (lambda (x) (when (funcall (or ,pred #'identity) (or (car-safe x) x))
(or (car-safe x) x)))
,var))))
(keywordp kar)
(setq n (assoc kar names--keyword-list))
(setq n (cadr n))
- (dotimes (it (1+ n) out)
+ (dotimes (_ (1+ n) out)
(push (pop ,body) out))
(nreverse out))))
(defun names--generate-defgroup ()
"Return a `defgroup' form for the current namespace."
- (list 'defgroup (names--package-name) nil
- (format "Customization group for %s." (names--package-name))
- :prefix (symbol-name names--name)
- :group `',names--group-parent))
+ (if (listp names--group-parent)
+ (cons 'defgroup names--group-parent)
+ (list 'defgroup (names--package-name) nil
+ (format "Customization group for %s." (names--package-name))
+ :prefix (symbol-name names--name)
+ :group `',names--group-parent)))
(defun names--generate-version ()
"Return a `defun' and a `defconst' forms declaring the package version.
(list 'defun (names--prepend 'version) nil
(format "Version of the %s package." (names--package-name))
'(interactive)
+ `(message
+ ,(format "%s version: %s" (names--package-name) names--version))
names--version)))
(defun names--add-macro-to-environment (form)
(cdr-safe def))
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))))))
+
(defun names--extract-autoloads (body)
"Return a list of the forms in BODY preceded by :autoload."
(let (acons)
(defun names--message (f &rest rest)
"If :verbose is on, pass F and REST to `message'."
(when (names--keyword :verbose)
- (apply 'message (concat "[names] " f) rest)))
+ (apply #'message (concat "[names] " f) rest)))
(defun names--warn (f &rest rest)
"Pass F and REST to `message', unless byte-compiling or non-interactive."
(unless (and (null (names--keyword :verbose))
(and (boundp 'byte-compile-function-environment)
byte-compile-function-environment))
- (apply 'message (concat "[names] " f) rest)))
+ (apply #'message (concat "[names] " f) rest)))
(defun names--error-if-using-vars ()
"Remind the developer that variables are not customizable."
"Return a concatenated un-namespaced version of LISTS.
Symbols in LISTS that aren't namespaced are removed, symbols that
are namespaced become un-namespaced."
- (delq nil (mapcar 'names--remove-namespace (apply 'append lists))))
+ (delq nil (mapcar 'names--remove-namespace (apply #'append lists))))
(defun names--remove-namespace (symbol)
- "Return SYMBOL with namespace removed, or nil if S wasn't namespaced."
+ "Return SYMBOL with namespace removed, or nil if it wasn't namespaced."
(names--remove-regexp symbol names--regexp))
(defun names--remove-protection (symbol)
(and (names--keyword :global)
(boundp (names--prepend sbl))))))
-;;; This is calling edebug even on `when' and `unless'
+(defvar names--verbose 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
(symbol-function 'message))
"Where names stores `message's definition while overriding it.")
-(defvar names--verbose nil
- "If non-nil, verbose message are printed regardless of the :verbose keyword.
-Use this to easily turn on verbosity during tests.")
-
-(defun names--edebug-message (&rest _)
+(defun names--edebug-message (&rest args)
(if (or (names--keyword :verbose) names--verbose)
- (apply names--message-backup _)
- (when _ (apply 'format _))))
+ (apply names--message-backup args)
+ (when args (apply #'format args))))
(defun names--edebug-make-enter-wrapper (forms)
(setq edebug-def-name
;; lines of the functions defined below. It will be automatically used
;; whenever that form is found.
-;;; Defun, defmacro, and defsubst macros are pretty predictable.
+;; Defun, defmacro, and defsubst macros are pretty predictable.
(defun names--convert-defmacro (form)
"Special treatment for `defmacro' FORM."
- (let* ((names--name-already-prefixed t)
+ (let* (;; (names--name-already-prefixed t) ;FIXME: Unused?!
(name (cadr form))
(spaced-name (names--prepend name))
decl)
(nth 2 form)
(names-convert-form (nth 3 form))
(names-convert-form (nth 4 form))))
- (mapcar #'names-convert-form (cddr form)))))
+ (mapcar #'names-convert-form (cddr (cl-cdddr form))))))
(defun names--convert-define-minor-mode (form)
"Special treatment for `define-minor-mode' FORM."
(names--handle-symbol-as-function (pop copy))
(names--handle-symbol-as-function (pop copy)))
(mapcar #'names-convert-form copy)))))
-(defalias #'names--convert-define-global-minor-mode
+(defalias 'names--convert-define-global-minor-mode
#'names--convert-define-globalized-minor-mode)
-(defalias #'names--convert-easy-mmode-define-global-mode
+(defalias 'names--convert-easy-mmode-define-global-mode
#'names--convert-define-globalized-minor-mode)
(defun names--convert-quote (form)
When FORM is (function form), a symbol is namespaced as a
function name, a list is namespaced as a lambda form."
(let ((kadr (cadr form))
- (this-name (car form))
- func)
+ (this-name (car form)))
(if (and (eq this-name 'function)
(listp kadr))
(list this-name (names-convert-form kadr))
(names--warn "Found a `closure'! You should use `lambda's instead")
(let ((names--local-vars
(append (names--vars-from-arglist (cadr form))
- names--local-vars))
- (forms (cdr (cdr form))))
+ names--local-vars)))
(cons
(car form)
(names--convert-lambda (cdr form)))))