Mercurial > hg > xemacs-beta
changeset 4575:eecd28508f4a
Add #'subr-arity, API taken from GNU, implementation our own.
lisp/ChangeLog addition:
2009-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el: Correct a comment, we now have #'syntax-after in
syntax.el.
(subr-arity): New.
Docstring and API taken initially from GNU's data.c, revision
1.275, GPLv2.
tests/ChangeLog addition:
2009-01-11 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el ():
Test #'subr-arity, recently added to subr.el.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 11 Jan 2009 13:18:42 +0000 |
parents | 302136a857ec |
children | 774e5c7522bf |
files | lisp/ChangeLog lisp/subr.el tests/ChangeLog tests/automated/lisp-tests.el |
diffstat | 4 files changed, 48 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sat Jan 03 15:41:34 2009 +0000 +++ b/lisp/ChangeLog Sun Jan 11 13:18:42 2009 +0000 @@ -1,3 +1,11 @@ +2009-01-11 Aidan Kehoe <kehoea@parhasard.net> + + * subr.el: Correct a comment, we now have #'syntax-after in + syntax.el. + (subr-arity): New. + Docstring and API taken initially from GNU's data.c, revision + 1.275, GPLv2. + 2009-01-01 Stephen J. Turnbull <stephen@xemacs.org> * descr-text.el (describe-char-unicodedata-file):
--- a/lisp/subr.el Sat Jan 03 15:41:34 2009 +0000 +++ b/lisp/subr.el Sun Jan 11 13:18:42 2009 +0000 @@ -1699,7 +1699,7 @@ ;; (defun make-syntax-table (&optional oldtable) in syntax.el. -;; (defun syntax-after (pos) #### doesn't exist. +;; (defun syntax-after (pos) in syntax.el. ;; global-set-key, local-set-key, global-unset-key, local-unset-key in ;; keymap.el. @@ -1742,4 +1742,24 @@ list (nconc list '(?\\ ?-))))) (apply #'string list))) +;; XEmacs addition to subr.el; docstring and API taken initially from GNU's +;; data.c, revision 1.275, GPLv2. +(defun subr-arity (subr) + "Return minimum and maximum number of args allowed for SUBR. +SUBR must be a built-in function (not just a symbol that refers to one). +The returned value is a pair (MIN . MAX). MIN is the minimum number +of args. MAX is the maximum number or the symbol `many', for a +function with `&rest' args, or `unevalled' for a special form. + +See also `special-form-p', `subr-min-args', `subr-max-args', +`function-allows-args'. " + (check-argument-type #'subrp subr) + (cons (subr-min-args subr) + (cond + ((special-form-p subr) + 'unevalled) + ((null (subr-max-args subr)) + 'many) + (t (subr-max-args subr))))) + ;;; subr.el ends here
--- a/tests/ChangeLog Sat Jan 03 15:41:34 2009 +0000 +++ b/tests/ChangeLog Sun Jan 11 13:18:42 2009 +0000 @@ -1,3 +1,8 @@ +2009-01-11 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el (): + Test #'subr-arity, recently added to subr.el. + 2009-01-03 Aidan Kehoe <kehoea@parhasard.net> * automated/ccl-tests.el (ccl-test-setup):
--- a/tests/automated/lisp-tests.el Sat Jan 03 15:41:34 2009 +0000 +++ b/tests/automated/lisp-tests.el Sun Jan 11 13:18:42 2009 +0000 @@ -889,6 +889,20 @@ (check-function-argcounts '(lambda ,arglist nil) ,min ,max) (check-function-argcounts (byte-compile '(lambda ,arglist nil)) ,min ,max)))) +;; Test subr-arity. +(loop for (function-name arity) in + '((let (1 . unevalled)) + (prog1 (1 . unevalled)) + (list (0 . many)) + (type-of (1 . 1)) + (garbage-collect (0 . 0))) + do (Assert (equal (subr-arity (symbol-function function-name)) arity))) + +(Check-Error wrong-type-argument (subr-arity + (lambda () (message "Hi there!")))) + +(Check-Error wrong-type-argument (subr-arity nil)) + ;;----------------------------------------------------- ;; Detection of cyclic variable indirection loops ;;-----------------------------------------------------