1 ;;; names.el --- Namespaces for emacs-lisp. Avoid name clobbering without hiding symbols. -*- lexical-binding:t -*-
3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
5 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
6 ;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com>
7 ;; URL: http://github.com/Bruce-Connor/names
9 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
10 ;; Keywords: extensions lisp
16 ;; The description is way too large to sanely write here, below is a
17 ;; summary. For a complete description, please visit the package's
18 ;; frontpage with `M-x names-view-manual', or see the Readme file on
19 ;; https://raw.githubusercontent.com/Bruce-Connor/names/master/Readme.org
23 ;; This file is part of GNU Emacs.
25 ;; GNU Emacs is free software: you can redistribute it and/or modify
26 ;; it under the terms of the GNU General Public License as published by
27 ;; the Free Software Foundation, either version 3 of the License, or
28 ;; (at your option) any later version.
30 ;; GNU Emacs is distributed in the hope that it will be useful,
31 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
32 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
33 ;; GNU General Public License for more details.
35 ;; You should have received a copy of the GNU General Public License
36 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
43 ;;; This is a patch because edebug binds under `C-x'.
44 ;; If `C-x' is not a prefix.
45 (unless (consp (key-binding "\C-x"))
46 ;; Disable the `C-xC-a' binds.
47 (defvar edebug-inhibit-emacs-lisp-mode-bindings)
48 (setq edebug-inhibit-emacs-lisp-mode-bindings t)
49 ;; And the `C-xX' binds.
50 (defvar global-edebug-prefix)
52 (or (null (boundp 'global-edebug-prefix))
53 (eq ?\C-x (elt global-edebug-prefix 0))))
54 (setq global-edebug-prefix "")))
60 (declare-function names--autoload-do-load "names" 2)
61 (defalias 'names--function-get
62 (if (fboundp 'function-get) #'function-get
64 (defun names--autoload-do-load (def name)
65 "Load autoloaded definition DEF from function named NAME."
66 (unless (load (cadr def) 'noerror)
67 (error "Macro `%s' is autoloaded, but its file (%s) couldn't be loaded"
69 (symbol-function name))
71 (lambda (f prop &rest _)
72 "Return the value of property PROP of function F.
73 If F is an autoloaded macro, try to autoload it in the hope that
76 (while (and (symbolp f)
77 (null (setq val (get f prop)))
79 (let ((fundef (symbol-function f)))
80 (if (and (names--autoloadp fundef)
81 (not (equal fundef (names--autoload-do-load fundef f))))
82 nil ;Re-try `get' on the same `f'.
86 (defalias 'names--compat-macrop
87 (if (fboundp 'macrop) #'macrop
89 "Non-nil if and only if OBJECT is a macro."
90 (let ((def (or (ignore-errors (indirect-function object t))
91 (ignore-errors (indirect-function object)))))
93 (or (eq 'macro (car def))
94 (and (names--autoloadp def) (memq (nth 4 def) '(macro t)))))))))
96 (defalias 'names--autoloadp
97 (if (fboundp 'autoloadp) #'autoloadp
99 "Non-nil if OBJECT is an autoload."
100 (eq 'autoload (car-safe object)))))
102 (unless (get-edebug-spec 'cl-defun)
103 (def-edebug-spec cl-defun defun*))
104 (unless (get-edebug-spec 'cl-defmacro)
105 (def-edebug-spec cl-defmacro defmacro*))
106 (unless (get-edebug-spec 'setq-local)
107 (def-edebug-spec setq-local setq))
108 (unless (get-edebug-spec 'loop)
109 (def-edebug-spec loop
111 ;; These are usually followed by a symbol, but it can
112 ;; actually be any destructuring-bind pattern, which
113 ;; would erroneously match `form'.
114 [[&or "for" "as" "with" "and"] sexp]
115 ;; These are followed by expressions which could
116 ;; erroneously match `symbolp'.
117 [[&or "from" "upfrom" "downfrom" "to" "upto" "downto"
118 "above" "below" "by" "in" "on" "=" "across"
119 "repeat" "while" "until" "always" "never"
120 "thereis" "collect" "append" "nconc" "sum"
121 "count" "maximize" "minimize" "if" "unless"
123 ;; Simple default, which covers 99% of the cases.
127 ;;; ---------------------------------------------------------------
129 (defconst names-version "20150723.0" "Version of the names.el package.")
131 (defvar names--name nil
132 "Name of the current namespace inside the `define-namespace' macro.")
133 (defvar names--regexp nil "Regexp matching `names--name'.")
135 (defvar names--load-file (and load-file-name (expand-file-name load-file-name))
136 "The file where the current version of Names was loaded.
137 This is used by `names--check-for-update' to check if a new
138 version has been installed.")
140 (defvar names--bound nil
141 "List of variables defined in this namespace.")
142 (defvar names--fbound nil
143 "List of functions defined in this namespace.")
144 (defvar names--macro nil
145 "List of macros defined in this namespace.")
147 (defvar names--keywords nil
148 "Keywords that were passed to the current namespace.
149 See `names--keyword-list' for a list and description of possible
152 (defvar names--local-vars nil
153 "Non-global vars that are let/lambda bound at the moment.
154 These won't be namespaced, as local takes priority over namespace.")
156 (defvar names--protection nil
157 "Leading chars used to identify protected symbols.
158 Don't customise this.
159 Instead use the :protection keyword when defining the
162 (defvar names--current-run nil
163 "Either 1 or 2, depending on which runthrough we're in.")
165 (defvar names--var-list
166 '(names--name names--regexp names--bound
168 names--package names--group-parent
169 names--macro names--current-run
170 names--fbound names--keywords
171 names--local-vars names--protection)
172 "List of variables the user shouldn't touch.")
175 (defvar names--inside-make-autoload nil
176 "Used in `make-autoload' to indicate we're making autoloads.")
178 (defvar names--package nil
179 "Package, name to be used by the :group and :version keywords.
180 Is derived from `load-file-name', unless the :package keyword is
181 passed to `define-namespace'.")
183 (defvar names--group-parent nil
184 "The name of the parent to be given to `defgroup'.
185 Is only non-nil if the :group keyword is passed to `define-namespace'.")
187 (defvar names--version nil
188 "The version number given by :version.
189 Used to define a constant and a command.")
191 (defvar names--functionlike-macros nil
192 "Function-like macros, even if their debug-spec says otherwise.
193 When expanding the namespace, these macros will be treated
194 exactly like functions. This means that their contents will be
195 namespaced like regular function arguments.
197 To add macros to this list, pass the :functionlike-macros keyword
198 to your namespace along with a list of macro names (as unquoted
202 (define-namespace foo-
203 :functionlike-macros (-> ->> thread-first thread-last)
207 (defconst names--keyword-list
210 (if (or (symbolp x) (listp x))
211 (setq names--group-parent x)
213 "Argument given to :group is not a symbol: %s" x)))
214 "Indicate `define-namespace' should make a `defgroup' for you.
215 The name of the group is the package name (see :package keyword).
216 This keyword should be given one argument, the name of the PARENT
217 group as an unquoted symbol.
219 Alternatively, the argument can be a list, in which case it is a
220 list of arguments to be passed to `defgroup' (essentially, a full
221 group definition without the leading `defgroup').
223 If this keyword is provided, besides including a defgroup, Names
224 will also include a :group keyword in every `defcustom' (and
225 similar forms) that don't already contain one.")
231 (setq names--version x)
233 "Argument given to :version is not a string: %s" x)))
234 "Indicate `define-namespace' should define the version number.
235 This keyword should be given one argument, a string describing
236 the package's version number.
238 With this, Names will generate a `defconst' and an interactive
239 `defun', each named `PACKAGE-NAME-version'. The function messages
240 and returns the version number. See the :package keyword.")
246 (setq names--package x)
248 "Argument given to :package is not a symbol: %s" x)))
249 "Set the name of this package to the given symbol.
250 This keyword should be given one argument, a symbol corresponding
251 to the name of this package.
253 If this keyword isn't used, the package name is taken as the the
254 file's basename, but only if its actually needed. This name is
255 needed by the :version and :group keywords.")
260 (let ((val (symbol-name x)))
261 (setq names--protection
262 (format "\\`%s" (regexp-quote val)))))
263 "Change the value of the `names--protection' variable.")
265 (:functionlike-macros
267 ,(lambda (x) (setq names--functionlike-macros
268 (append x names--functionlike-macros)))
269 "A list of values to be appended to `names--functionlike-macros'.")
273 "Indicates variables assigned in let-bind are NOT candidates for namespacing.")
277 "Cause a message to be called on each special form.")
281 "Accept namespaced names from outside current namespace definition.")
285 "Indicate symbols quoted with `quote' should be considered variable names.")
287 (:dont-assume-function-quote
289 "Indicate symbols quoted with `function' should NOT be considered function names.")
293 "Indicate only forms actually inside the namespace should be present in the output.
294 This is for internal use. It is used by `names-eval-defun' to
295 prevent `define-namespace' from adding things like `defgroup' or
296 `defconst's to the output."))
297 "List of keywords used by `define-namespace'.
298 Each element is a list containing
299 (KEYWORD N DEFINITION DOCUMENTATION)
302 - KEYWORD is the keyword's name, a symbol satifying `keywordp'.
303 - N is the number of arguments it takes, an integer.
304 - DEFINITION is a function (symbol or lambda) that takes N
305 arguments and does whatever you need for implementing the
307 - DOCUMENTATION is a string explaining the keyword's
310 (defmacro names--prepend (sbl)
311 "Return namespace+SBL."
312 (declare (debug (symbolp)))
313 `(intern (format "%s%s" names--name ,sbl)))
316 (defmacro names--filter-if-bound (var &optional pred)
317 "If VAR is bound and is a list, take the car of its elements which satify PRED."
318 (declare (debug (symbolp &optional function-form)))
319 `(when (boundp ',var)
322 (mapcar (lambda (x) (when (funcall (or ,pred #'identity) (or (car-safe x) x))
323 (or (car-safe x) x)))
326 (defmacro names--next-keyword (body)
327 "If car of BODY is a known keyword, `pop' it (and its arguments) from body.
328 Returns a list (KEYWORD . ARGUMENTLIST)."
329 (declare (debug sexp))
330 `(let ((kar (car-safe ,body))
334 (setq n (assoc kar names--keyword-list))
336 (dotimes (_ (1+ n) out)
337 (push (pop ,body) out))
340 (defvar names--has-reloaded nil
341 "Whether `names--reload-if-upgraded' has already been called in this run.")
344 ;;; ---------------------------------------------------------------
345 ;;; The Main Macro and Main Function.
347 (defmacro define-namespace (name &rest body)
348 "Inside the namespace NAME, execute BODY.
349 NAME can be any symbol (not quoted), but it's highly recommended
350 to use some form of separator (such as :, /, or -). For a
351 complete description of this macro, please visit the frontpage
352 with \\[names-view-manual].
354 In summary, this macro has two main effects:
356 1. Any definitions inside BODY will have NAME prepended to the
359 (define-namespace foo-
360 (defvar bar 1 \"docs\")
365 (defvar foo-bar 1 \"docs\")
368 2. Any function calls and variable names get NAME prepended to
369 them if such a variable or function exists. Ex:
371 (define-namespace foo:
372 (defun message (x y) nil)
373 (message \"%s\" my-var)
378 (defun foo:message (x y) nil)
379 (foo:message \"%s\" my-var)
381 Note how `message' is expanded to `foo:message' in the second
382 form, because that function exists. Meanwhile, `bar' is left
383 untouched because `foo:bar' is not a known variable name.
385 ===============================
389 In order for `define-namespace' to work with \";;;###autoload\"
390 comments must replace all instances of \";;;###autoload\" inside
391 your `define-namespace' with `:autoload'.
392 Afterwards, add an \";;;###autoload\" comment just above your
395 ===============================
399 Immediately after NAME you may add keywords which customize the
400 behaviour of `define-namespace'. For a list of possible keywords
401 and a description of their effects, see the variable
402 `names--keyword-list'.
404 \(fn NAME [KEYWORD ...] BODY)"
405 (declare (indent (lambda (&rest x) 0))
406 (debug (&define name [&rest keywordp &optional [&or symbolp (symbolp . symbolp)]] body)))
407 (let ((names--has-reloaded names--has-reloaded))
408 ;; This was to avoid an infinite recursion, but the bug turned out
409 ;; to be somewhere else. Still, I see no reason to erase this.
410 (unless names--has-reloaded
411 (setq names--has-reloaded t)
412 (names--reload-if-upgraded))
413 (names--error-if-using-vars)
414 (names--define-namespace-implementation name body)))
416 (defun names--define-namespace-implementation (name body)
417 "Namespace BODY using NAME.
418 See `define-namespace' for more information."
420 (let* ((names--name name)
422 (concat "\\`" (regexp-quote (symbol-name name))))
423 (names--current-run 0)
424 ;; Use the :protection keyword to change this.
425 (names--protection "\\`::")
427 (names--remove-namespace-from-list
428 (names--filter-if-bound byte-compile-bound-variables)
429 (names--filter-if-bound byte-compile-variables)))
431 (names--remove-namespace-from-list
432 (names--filter-if-bound byte-compile-macro-environment 'names--compat-macrop)
433 (names--filter-if-bound byte-compile-function-environment 'names--compat-macrop)))
435 (names--remove-namespace-from-list
436 (names--filter-if-bound byte-compile-macro-environment (lambda (x) (not (names--compat-macrop x))))
437 (names--filter-if-bound byte-compile-function-environment (lambda (x) (not (names--compat-macrop x))))))
438 (names--functionlike-macros names--functionlike-macros)
439 names--keywords names--local-vars key-and-args
440 names--version names--package names--group-parent)
442 (while (setq key-and-args (names--next-keyword body))
443 (names--handle-keyword key-and-args)
444 (push key-and-args names--keywords))
446 ;; First have to populate the bound and fbound lists. So we read
447 ;; the entire form (without return it).
448 (if names--inside-make-autoload
449 ;; Dependencies haven't been loaded during autoload
450 ;; generation, so we better ignore errors here. Ideally we
451 ;; would only go through the forms marked for autoloading,
452 ;; but then we wouldn't know what symbols are var/function
454 (mapc (lambda (form) (ignore-errors (names-convert-form form))) body)
455 (mapc #'names-convert-form body))
456 (setq names--current-run (1+ names--current-run))
458 ;; Then we go back and actually namespace the entire form, which
459 ;; we'll later return so that it can be evaluated.
464 (when (and names--group-parent
465 (null (names--keyword :clean-output)))
466 (list (names--generate-defgroup)))
467 (when (and names--version
468 (null (names--keyword :clean-output)))
469 ;; `names--generate-version' returns a list.
470 (names--generate-version))
471 (mapcar 'names-convert-form
472 ;; Unless we're in `make-autoload', then just return autoloads.
473 (if names--inside-make-autoload
474 (names--extract-autoloads body)
477 ;; On emacs-version < 24.4, the byte-compiler cannot expand a
478 ;; macro if it is being called in the same top-level form as
479 ;; it was defined. That's a problem for us, since the entire
480 ;; namespace is a single top-level form (we return a `progn').
481 ;; The solution is for us to add the macros to
482 ;; `byte-compile-macro-environment' ourselves.
483 (if (and (boundp 'byte-compile-current-buffer)
484 byte-compile-current-buffer
485 (null names--inside-make-autoload)
486 (version< emacs-version "24.4"))
487 (let ((byte-compile-macro-environment
488 (when (boundp 'byte-compile-macro-environment)
489 byte-compile-macro-environment)))
490 (mapc #'names--add-macro-to-environment (cdr body))
491 (macroexpand-all body byte-compile-macro-environment))
494 ;; Exiting the `unwind-protect'.
495 (mapc (lambda (x) (set x nil)) names--var-list)))
497 (defun names--reload-if-upgraded ()
498 "Verify if there's a more recent version of Names in the `load-path'.
502 (let ((lp (expand-file-name (find-library-name "names")))
505 (not (string= lp names--load-file))
506 (file-readable-p lp))
508 (insert-file-contents-literally lp)
509 (goto-char (point-min))
512 (when (search-forward-regexp
513 "(defconst\\s-+names-version\\s-+\"\\([^\"]+\\)\"" nil t)
514 (match-string-no-properties 1))))
515 (when (and new-version (version< names-version new-version))
516 (eval-buffer nil lp)))))))
518 (defun names-convert-form (form)
519 "Do namespace conversion on FORM.
520 FORM is any legal elisp form.
521 Namespace name is defined by the global variable `names--name'.
523 See macro `namespace' for more information."
528 (let ((kar (car form))
531 ;; If symbol is protected, clean it.
533 (setq func (names--remove-protection kar)))
534 (names--message "Protected: %s" kar)
535 ;; And decide what to do with it.
536 (names--handle-args func (cdr form)))
538 ;; If kar is a list, either 1) it's a lambda form, 2) it's a
539 ;; macro we don't know about yet, 3) we have a bug.
541 (when (and (null (functionp kar))
542 (> names--current-run 1))
543 (names--warn "Ran into the following strange form.
544 Either it's an undefined macro, a macro with a bad debug declaration, or we have a bug.\n%s" form))
545 (mapcar 'names-convert-form form))
547 ;; Namespaced Functions/Macros
548 ((names--fboundp kar)
549 (names--message "Namespaced: %s" kar)
550 (names--args-of-function-or-macro
551 (names--prepend kar) (cdr form) (names--macrop kar)))
553 ;; General functions/macros/special-forms
554 (t (names--handle-args kar (cdr form))))))
557 (names--message "Symbol handling: %s" form)
558 ;; If symbol is protected, clean it and don't namespace it.
559 (or (names--remove-protection form)
560 ;; Otherwise, namespace if possible.
561 (if (names--boundp form)
562 (names--prepend form)
568 ;;; ---------------------------------------------------------------
569 ;;; Some auxiliary functions
570 (defun names-view-manual ()
571 "Call `browse-url' to view the manual of the Names package."
573 (browse-url "http://github.com/Bruce-Connor/names"))
575 (defun names--package-name ()
576 "Return the package name as a symbol.
577 Decide package name based on several factors. In order:
578 1. The :package keyword,
579 2. The namespace NAME, removing the final char."
581 (let ((package (symbol-name names--name)))
582 (prog1 (setq names--package
583 (intern (substring package 0 -1)))
584 (names--warn "No :package given. Guessing `%s'"
587 (defun names--generate-defgroup ()
588 "Return a `defgroup' form for the current namespace."
589 (if (listp names--group-parent)
590 (cons 'defgroup names--group-parent)
591 (list 'defgroup (names--package-name) nil
592 (format "Customization group for %s." (names--package-name))
593 :prefix (symbol-name names--name)
594 :group `',names--group-parent)))
596 (defun names--generate-version ()
597 "Return a `defun' and a `defconst' forms declaring the package version.
598 Also adds `version' to `names--fbound' and `names--bound'."
599 (add-to-list 'names--fbound 'version)
600 (add-to-list 'names--bound 'version)
602 (list 'defconst (names--prepend 'version)
604 (format "Version of the %s package." (names--package-name)))
605 (list 'defun (names--prepend 'version) nil
606 (format "Version of the %s package." (names--package-name))
609 ,(format "%s version: %s" (names--package-name) names--version))
612 (defun names--add-macro-to-environment (form)
613 "If FORM declares a macro, add it to `byte-compile-macro-environment'."
614 (let ((expansion form))
615 (while (names--compat-macrop (car-safe expansion))
617 (ignore-errors (macroexpand
618 expansion byte-compile-macro-environment))))
621 (or (and (memq (car-safe expansion) '(progn prog1 prog2))
622 (mapc #'names--add-macro-to-environment (cdr expansion)))
623 (and (eq 'defalias (car-safe expansion))
624 (let ((def (ignore-errors (eval (nth 2 expansion)))))
625 (and (names--compat-macrop def)
626 (push (cons (ignore-errors
627 (eval (nth 1 expansion)))
629 byte-compile-macro-environment))))))))
632 (eval-after-load 'find-func
633 '(defadvice find-function-search-for-symbol
634 (around names-around-find-function-search-for-symbol-advice
635 (symbol type library) activate)
636 "Make sure `find-function-search-for-symbol' understands namespaces."
639 (unless (cdr ad-return-value)
640 (with-current-buffer (car ad-return-value)
641 (search-forward-regexp "^(define-namespace\\_>")
642 (skip-chars-forward "\r\n[:blank:]")
643 (let* ((names--regexp
644 (concat "\\`" (regexp-quote
645 (symbol-name (read (current-buffer))))))
647 ;; We manually implement `names--remove-namespace'
648 ;; because it might not be loaded.
649 (let ((name (symbol-name symbol)))
650 (when (string-match names--regexp name)
651 (intern (replace-match "" nil nil name))))))
653 (ad-set-arg 0 short-symbol)
656 (defun names--extract-autoloads (body)
657 "Return a list of the forms in BODY preceded by :autoload."
659 (when (setq acons (memq :autoload body))
662 (names--extract-autoloads (cdr (cdr acons)))))))
665 (defadvice make-autoload (around names-before-make-autoload-advice
666 (form file &optional expansion) activate)
667 "Make sure `make-autoload' understands `define-namespace'.
668 Use the `names--inside-make-autoload' variable to indicate to
669 `define-namespace' that we're generating autoloads."
670 ;; We used to have a letbind here, but this was causing a void
671 ;; variable bug on Emacs 24.3.
673 (if (null (eq (car-safe form) 'define-namespace))
675 (setq names--inside-make-autoload t)
676 (setq form (macroexpand form))
677 (setq names--inside-make-autoload nil)
678 ;; Up to 24.2 `make-autoload' couldn't handle `progn's.
679 (if (version< emacs-version "24.3")
680 (setq ad-return-value
682 (mapcar (lambda (x) (names--make-autoload-compat x file))
684 (ad-set-arg 2 'expansion)
688 (defun names--make-autoload-compat (form file)
689 (if (eq (car-safe form) 'defalias)
691 (make-autoload form file)))
693 (defvar names--ignored-forms '(declare)
694 "The name of functions/macros/special-forms which we return without reading.")
696 (defun names--handle-args (func args)
697 "Generic handling for the form (FUNC . ARGS), without namespacing FUNC."
698 (if (memq func names--ignored-forms)
700 ;; TODO: Speed this up. Just change it to an alist or a hash-table.
701 (let ((handler (intern-soft (format "names--convert-%s" func))))
702 ;; Some function-like forms get special handling.
703 ;; That's anything with a names--convert-%s function defined.
704 (if (fboundp handler)
705 (progn (names--message "Special handling: %s" handler)
706 (funcall handler (cons func args)))
707 ;; If it isn't special, it's either a function or a macro.
708 (names--args-of-function-or-macro func args (names--compat-macrop func))))))
710 (defun names--message (f &rest rest)
711 "If :verbose is on, pass F and REST to `message'."
712 (when (names--keyword :verbose)
713 (apply #'message (concat "[names] " f) rest)))
715 (defun names--warn (f &rest rest)
716 "Pass F and REST to `message', unless byte-compiling or non-interactive."
717 (unless (and (null (names--keyword :verbose))
718 (and (boundp 'byte-compile-function-environment)
719 byte-compile-function-environment))
720 (apply #'message (concat "[names] " f) rest)))
722 (defun names--error-if-using-vars ()
723 "Remind the developer that variables are not customizable."
727 (error "[names] Global value of variable %s should be nil! %s"
728 x "Set it using keywords instead")))
731 (defun names--remove-namespace-from-list (&rest lists)
732 "Return a concatenated un-namespaced version of LISTS.
733 Symbols in LISTS that aren't namespaced are removed, symbols that
734 are namespaced become un-namespaced."
735 (delq nil (mapcar 'names--remove-namespace (apply #'append lists))))
737 (defun names--remove-namespace (symbol)
738 "Return SYMBOL with namespace removed, or nil if it wasn't namespaced."
739 (names--remove-regexp symbol names--regexp))
741 (defun names--remove-protection (symbol)
742 "Remove the leading :: from SYMBOL if possible, otherwise return nil."
743 (names--remove-regexp symbol names--protection))
745 (defun names--remove-regexp (s r)
746 "Return S with regexp R removed, or nil if S didn't match."
747 (let ((name (symbol-name s)))
748 (when (string-match r name)
749 (intern (replace-match "" nil nil name)))))
751 (defun names--quote-p (sbl)
752 "Is SBL a function which quotes its argument?"
753 (memq sbl '(quote function)))
755 (defun names--fboundp (sbl)
756 "Is namespace+SBL a fboundp symbol?"
757 (or (memq sbl names--fbound)
758 (memq sbl names--macro)
759 (and (names--keyword :global)
760 (fboundp (names--prepend sbl)))))
762 (defun names--macrop (sbl)
763 "Is namespace+SBL a fboundp symbol?"
764 (or (memq sbl names--macro)
765 (and (names--keyword :global)
766 (names--compat-macrop (names--prepend sbl)))))
768 (defun names--keyword (keyword)
769 "Was KEYWORD one of the keywords passed to the `namespace' macro?"
770 (assoc keyword names--keywords))
772 (defun names--boundp (sbl)
773 "Is namespace+SBL a boundp symbol?
774 If SBL has a let binding, that takes precendence so this also
776 (and (null (memq sbl names--local-vars))
777 (or (memq sbl names--bound)
778 (and (names--keyword :global)
779 (boundp (names--prepend sbl))))))
781 (defvar names--verbose nil
782 "If non-nil, verbose message are printed regardless of the :verbose keyword.
783 Use this to easily turn on verbosity during tests.")
785 (defun names--args-of-function-or-macro (function args macro)
786 "Namespace FUNCTION's arguments ARGS, with special treatment if MACRO is non-nil."
788 (let ((it (names--get-edebug-spec function))
789 (names--verbose (eq function 'push)))
790 (names--message "Edebug-spec of `%s' is %s" function it)
791 ;; Macros where we evaluate all arguments are like functions.
793 (memq function names--functionlike-macros))
794 (names--args-of-function-or-macro function args nil)
795 ;; Macros where nothing is evaluated we can just return.
798 ;; Other macros are complicated. Ask edebug for help.
799 (names--macro-args-using-edebug (cons function args)))))
800 ;; We just convert the arguments of functions.
801 (cons function (mapcar 'names-convert-form args))))
803 (defun names--get-edebug-spec (name)
804 "Get 'edebug-form-spec property of symbol NAME."
805 ;; Get the spec of symbol resolving all indirection.
809 (and (symbolp indirect)
812 indirect 'edebug-form-spec 'macro))))
813 ;; (edebug-trace "indirection: %s" edebug-form-spec)
814 (setq spec indirect))
817 (defvar names--is-inside-macro nil
818 "Auxiliary var used in `names--macro-args-using-edebug'.")
820 (defvar names--gensym-counter 0
821 "Counter used to uniquify symbols generated `names--gensym'.")
823 (defun names--macro-args-using-edebug (form)
824 "Namespace the arguments of macro FORM by hacking into edebug.
825 This takes advantage of the fact that macros (should) declare a
826 `debug' specification which tells us which arguments are actually
829 Ideally, we would read this specification ourselves and see how
830 it matches (cdr FORM), but that would take a lot of work and
831 we'd be reimplementing something that edebug already does
832 phenomenally. So we hack into edebug instead."
836 ((max-lisp-eval-depth 3000)
839 (names--is-inside-macro form)
840 ;; Prevent excessive messaging.
841 ;; TODO: Don't do this if `message' is advised.
842 ((symbol-function 'message) #'names--edebug-message)
843 ;; Older edebugs have poor `get-edebug-spec'.
844 ((symbol-function 'get-edebug-spec) #'names--get-edebug-spec)
845 ;; Give symbols our own name.
846 ((symbol-function 'cl-gensym) #'names--gensym)
847 ;; Stop at one level deep.
848 ((symbol-function 'edebug-form) #'names--edebug-form)
849 ;; Don't actually wrap anything.
850 ((symbol-function 'edebug-make-enter-wrapper)
851 #'names--edebug-make-enter-wrapper))
855 (goto-char (point-min))
857 (edebug-read-top-level-form))
860 "Couldn't namespace this macro using its (debug ...) declaration: %s"
864 (when (equal (car-safe (cdr-safe er))
865 "Lisp nesting exceeds `max-lisp-eval-depth'")
867 "Lisp nesting exceeded `max-lisp-eval-depth' at the following form: %s"
871 (defvar names--message-backup
872 (if (ad-is-advised 'message)
873 (ad-get-orig-definition 'message)
874 (symbol-function 'message))
875 "Where names stores `message's definition while overriding it.")
877 (defun names--edebug-message (&rest args)
878 (if (or (names--keyword :verbose) names--verbose)
879 (apply names--message-backup args)
880 (when args (apply #'format args))))
882 (defun names--edebug-make-enter-wrapper (forms)
883 (setq edebug-def-name
886 (names--gensym "edebug-anon")))
889 (defun names--gensym (prefix)
890 "Generate a new uninterned symbol.
891 The name is made by appending a number to PREFIX and preppending \"names\", default \"G\"."
892 (let ((num (prog1 names--gensym-counter
893 (setq names--gensym-counter
894 (1+ names--gensym-counter)))))
895 (make-symbol (format "names-%s%d" (if (stringp prefix) prefix "G") num))))
897 (defun names--edebug-form (cursor)
898 "Parse form given by CURSOR using edebug, and namespace it if necessary."
900 ;; Return the instrumented form for the following form.
901 ;; Add the point offsets to the edebug-offset-list for the form.
902 (let* ((form (edebug-top-element-required cursor "Expected form"))
903 (offset (edebug-top-offset cursor))
904 ;; We don't want to convert the entire form that was passed
905 ;; to `names--macro-args-using-edebug', since the head of
906 ;; that was already converted and it would lead to an
908 ;; So we check for (equal names--is-inside-macro form)
909 ;; Simply incrementing a depth counter didn't work, for a
910 ;; reason I can no longer remember.
912 ;; We DO want to convert the arguments that edebug identifies
913 ;; as forms (level-1). And we do that ourselves, don't pass
915 (func (if (or (eq names--is-inside-macro t)
916 (equal names--is-inside-macro form))
917 'identity 'names-convert-form))
918 (names--is-inside-macro
919 (if (eq func 'names-convert-form)
920 t names--is-inside-macro)))
921 (names--message " [Edebug] Ran into this: %S" form)
922 (names--message " Cursor: %S" cursor)
925 ((consp form) ;; The first offset for a list form is for the list form itself.
926 (if (eq func 'names-convert-form)
927 (names-convert-form form)
928 (let* ((head (car form))
929 (spec (and (symbolp head) (get-edebug-spec head)))
930 (new-cursor (edebug-new-cursor form offset)))
931 ;; Find out if this is a defining form from first symbol.
932 ;; An indirect spec would not work here, yet.
933 (if (and (consp spec) (eq '&define (car spec)))
934 (edebug-defining-form
936 (car offset) ;; before the form
937 (edebug-after-offset cursor)
938 (cons (symbol-name head) (cdr spec)))
939 ;; Wrap a regular form.
940 (edebug-list-form new-cursor)))))
945 ;; Anything else is self-evaluating.
947 (edebug-move-cursor cursor))))
949 (defun names--maybe-append-group (form)
950 "Append (:group `names--package') to FORM.
951 Only if the :group keyword was passed to `define-namespace' and
952 if the form doesn't already have a :group."
953 (if (or (null names--group-parent) (memq :group form))
955 (append form `(:group ',(names--package-name)))))
958 ;;; ---------------------------------------------------------------
959 ;;; Interpreting keywords passed to the main macro.
960 (defun names--handle-keyword (body)
961 "Call the function that handles the keyword at the car of BODY.
962 Such function must be listed in `names--keyword-list'. If it is
963 nil, this function just returns.
965 Regardless of whether a function was called, the keyword is added
966 to the variable `names--keywords'.
968 The car of BODY is the keyword itself and the other elements are
969 the keyword arguments, if any."
970 (let ((func (nth 2 (assoc (car body) names--keyword-list))))
972 (apply func (cdr body))
976 ;;; ---------------------------------------------------------------
977 ;;; Interpreting the actual forms found in BODY of the main macro.
979 ;; This is where the heavy work is done.
981 ;; If you'd like to implement support for some special form, simply
982 ;; define a function called `names--convert-FORM-NAME' along the
983 ;; lines of the functions defined below. It will be automatically used
984 ;; whenever that form is found.
986 ;; Defun, defmacro, and defsubst macros are pretty predictable.
987 (defun names--convert-defmacro (form)
988 "Special treatment for `defmacro' FORM."
989 (let* ((name (cadr form))
990 (spaced-name (names--prepend name))
992 (add-to-list 'names--macro name)
993 (add-to-list 'names--fbound name)
994 ;; Set the macros debug spec if possible. It will be relevant on
996 (when (setq decl (ignore-errors (cond
997 ((eq (car-safe (nth 3 form)) 'declare)
999 ((and (stringp (nth 3 form))
1000 (eq (car-safe (nth 4 form)) 'declare))
1003 (setq decl (car (cdr-safe (assoc 'debug (cdr decl)))))
1004 (when decl (put spaced-name 'edebug-form-spec decl)))
1005 ;; Then convert the macro as a defalias.
1008 (names--convert-lambda
1009 (cons spaced-name (cddr form))))))
1010 (defalias 'names--convert-defmacro* 'names--convert-defmacro)
1012 (defun names--convert-defvaralias (form)
1013 "Special treatment for `defvaralias' FORM."
1014 (let ((form (cons (car form)
1015 (mapcar #'names-convert-form (cdr form))))
1017 (setq name (names--remove-namespace
1018 (ignore-errors (eval (cadr form)))))
1020 (add-to-list 'names--bound name))
1023 (defun names--convert-defalias (form)
1024 "Special treatment for `defalias' FORM."
1025 (let ((form (cons (car form)
1026 (mapcar #'names-convert-form (cdr form))))
1028 (setq name (names--remove-namespace
1029 (ignore-errors (eval (cadr form)))))
1031 (add-to-list 'names--fbound name))
1034 (defun names--convert-defvar (form &optional dont-add)
1035 "Special treatment for `defvar' FORM.
1036 If DONT-ADD is nil, the FORM's `cadr' is added to `names--bound'."
1037 (let ((name (cadr form)))
1039 (add-to-list 'names--bound name))
1043 (names--prepend name))
1044 (mapcar 'names-convert-form (cdr (cdr form))))))
1046 (defalias 'names--convert-defconst 'names--convert-defvar
1047 "Special treatment for `defconst' FORM.")
1049 (defun names--convert-defcustom (form)
1050 "Special treatment for `defcustom' FORM."
1051 (names--maybe-append-group
1052 (names--convert-defvar form)))
1054 (defun names--convert-custom-declare-variable (form)
1055 "Special treatment for `custom-declare-variable' FORM."
1056 (let ((name (eval (cadr form))) ;;ignore-errors
1057 (val (car (cddr form))))
1058 (add-to-list 'names--bound name)
1062 (list 'quote (names--prepend name)) ;cadr
1063 ;; The DEFAULT argument is explicitly evaluated by
1064 ;; `custom-declare-variable', so it should be safe to namespace
1065 ;; even when quoted. Plus, we need to do this because
1066 ;; defcustom quotes this part.
1067 (if (names--quote-p (car-safe val))
1068 (list (car val) (names-convert-form (cadr val)))
1069 (names-convert-form val))
1070 (names-convert-form (car (cdr (cdr (cdr form))))))
1071 (mapcar 'names-convert-form (cdr (cdr (cdr (cdr form))))))))
1073 (defun names--convert-defface (form)
1074 "Special treatment for `defface' FORM.
1075 Identical to defvar, just doesn't add the symbol to the boundp
1076 list. And maybe use a :group."
1077 (names--maybe-append-group
1078 (names--convert-defvar form :dont-add)))
1080 (defun names--convert-define-derived-mode (form)
1081 "Special treatment for `define-derived-mode' FORM."
1082 (let ((name (cadr form)))
1083 (add-to-list 'names--fbound name)
1084 (add-to-list 'names--bound name)
1085 (add-to-list 'names--bound
1086 (intern (format "%s-map" name)))
1087 (add-to-list 'names--bound
1088 (intern (format "%s-hook" name)))
1090 (names--maybe-append-group
1091 ;; And here we namespace it.
1094 (names--prepend name)
1096 (names-convert-form (nth 3 form))
1097 (names-convert-form (nth 4 form))))
1098 (mapcar #'names-convert-form (cddr (cl-cdddr form))))))
1100 (defun names--convert-define-minor-mode (form)
1101 "Special treatment for `define-minor-mode' FORM."
1102 (let ((name (cadr form))
1103 (keymap (nth 5 form)))
1104 ;; Register the mode name
1105 (add-to-list 'names--fbound name)
1106 (add-to-list 'names--bound name)
1107 (add-to-list 'names--bound (intern (format "%s-hook" name)))
1108 ;; Register the keymap
1109 (if (or (null keymap) (null (symbolp keymap)))
1110 (add-to-list 'names--bound (intern (format "%s-map" name)))
1111 (when (setq keymap (names--remove-namespace keymap))
1112 (add-to-list 'names--bound keymap)))
1114 (names--maybe-append-group
1115 ;; And here we namespace it.
1118 (names--prepend name)
1120 (names-convert-form (nth 3 form))
1121 (names-convert-form (nth 4 form))
1122 (names-convert-form (nth 5 form))
1123 (names-convert-form (nth 6 form))))
1124 (mapcar #'names-convert-form (cddr form)))))
1126 (defun names--convert-define-globalized-minor-mode (form)
1127 "Special treatment for `define-globalized-minor-mode' FORM.
1128 The NAME of the global mode will NOT be namespaced, despite being
1129 a definition. It is kept verbatim.
1130 This is because people tend to name their global modes as
1131 `global-foo-mode', and namespacing would make this impossible.
1133 The MODE and TURN-ON arguments are converted as function names.
1134 Everything else is converted as regular forms (which usually
1135 means no conversion will happen since it's usually keywords and
1137 (let ((name (names--remove-namespace (cadr form)))
1138 (copy (cl-copy-list form)))
1139 ;; Register the mode name
1141 (add-to-list 'names--fbound name)
1142 (add-to-list 'names--bound name)
1143 (add-to-list 'names--bound (intern (format "%s-hook" name))))
1144 (names--maybe-append-group
1145 ;; And here we namespace it.
1150 (names--handle-symbol-as-function (pop copy))
1151 (names--handle-symbol-as-function (pop copy)))
1152 (mapcar #'names-convert-form copy)))))
1153 (defalias 'names--convert-define-global-minor-mode
1154 #'names--convert-define-globalized-minor-mode)
1155 (defalias 'names--convert-easy-mmode-define-global-mode
1156 #'names--convert-define-globalized-minor-mode)
1158 (defun names--convert-quote (form)
1159 "Special treatment for `quote' FORM.
1160 When FORM is (quote argument), argument too arbitrary to be
1161 logically namespaced and is never parsed for namespacing
1162 (but see :assume-var-quote in `names--keyword-list').
1164 When FORM is (function form), a symbol is namespaced as a
1165 function name, a list is namespaced as a lambda form."
1166 (let ((kadr (cadr form))
1167 (this-name (car form)))
1168 (if (and (eq this-name 'function)
1170 (list this-name (names-convert-form kadr))
1173 ;; A symbol inside a function quote should be a function,
1174 ;; unless the user disabled that.
1175 ((and (eq this-name 'function)
1176 (null (names--keyword :dont-assume-function-quote)))
1178 (names--handle-symbol-as-function kadr)))
1180 ;; A symbol inside a regular quote should be a function, if
1181 ;; the user asked for that.
1182 ((and (eq this-name 'quote)
1183 (names--keyword :assume-var-quote))
1185 (or (names--remove-protection kadr)
1186 (if (names--boundp kadr)
1187 (names--prepend kadr)
1193 (defun names--handle-symbol-as-function (s)
1194 "Namespace symbol S as a function name."
1195 (or (names--remove-protection s)
1196 (if (names--fboundp s) (names--prepend s) s)))
1198 (defalias 'names--convert-function 'names--convert-quote)
1200 (defun names--convert-macro (form)
1201 "Special treatment for `macro' form.
1202 Return (macro . (names-convert-form (cdr FORM)))."
1203 (cons 'macro (names-convert-form (cdr form))))
1205 (defun names--convert-lambda (form)
1206 "Special treatment for `lambda' FORM."
1207 (let ((names--local-vars
1208 (append (names--vars-from-arglist (cadr form))
1210 (forms (cdr (cdr form))))
1214 (when (stringp (car forms))
1217 (setq forms (cdr forms))))
1218 (when (eq 'interactive (car-safe (car forms)))
1220 (list (list (car (car forms))
1221 (names-convert-form (cadr (car forms)))))
1222 (setq forms (cdr forms))))
1224 ;; (message "%S" forms)
1225 (mapcar 'names-convert-form forms)))))
1227 (defun names--convert-clojure (form)
1228 "Special treatment for `clojure' FORM."
1229 (names--warn "Found a `closure'! You should use `lambda's instead")
1230 (let ((names--local-vars
1231 (append (names--vars-from-arglist (cadr form))
1232 names--local-vars)))
1235 (names--convert-lambda (cdr form)))))
1237 (defun names--vars-from-arglist (args)
1238 "Get a list of local variables from a generalized arglist ARGS."
1243 (let ((symb (or (cdr-safe (car-safe x)) (car-safe x) x)))
1244 (when (and (symbolp symb)
1245 (null (string-match "^&" (symbol-name symb)))
1250 (defun names--convert-defun (form)
1251 "Special treatment for `defun' FORM."
1252 (let* ((name (cadr form)))
1253 (add-to-list 'names--fbound name)
1255 (names--convert-lambda
1256 (cons (names--prepend name) (cddr form))))))
1257 (defalias 'names--convert-defun* 'names--convert-defun)
1258 (defalias 'names--convert-defsubst 'names--convert-defun)
1259 (defalias 'names--convert-defsubst* 'names--convert-defun)
1261 (defun names--let-var-convert-then-add (sym add)
1262 "Try to convert SYM unless :no-let-vars is in use.
1263 If ADD is non-nil, add resulting symbol to `names--local-vars'."
1264 (let ((name (if (null (names--keyword :no-let-vars))
1265 (names-convert-form sym)
1267 (when add (add-to-list 'names--local-vars name))
1270 (defun names--convert-let (form &optional star)
1271 "Special treatment for `let' FORM.
1272 If STAR is non-nil, parse as a `let*'."
1273 (let* ((names--local-vars names--local-vars)
1278 (list (names--let-var-convert-then-add (car x) star)
1279 (names-convert-form (cadr x)))
1280 (names--let-var-convert-then-add x star)))
1282 ;; Each var defined in a regular `let' only becomes protected after
1283 ;; all others have been defined.
1285 (setq names--local-vars
1287 (mapcar (lambda (x) (or (car-safe x) x)) vars)
1288 names--local-vars)))
1290 (list (car form) vars)
1291 (mapcar 'names-convert-form (cddr form)))))
1293 (defun names--convert-let* (form)
1294 "Special treatment for `let' FORM."
1295 (names--convert-let form t))
1297 (defun names--convert-cond (form)
1298 "Special treatment for `cond' FORM."
1302 (lambda (x) (mapcar #'names-convert-form x))
1305 (defun names--convert-condition-case (form)
1306 "Special treatment for `condition-case' FORM."
1311 (names-convert-form (cadr (cdr form))))
1315 (mapcar 'names-convert-form (cdr x))))
1316 (cddr (cdr form)))))
1319 ;;; names.el ends here