[COMMIT] Add #'subr-arity, API taken from GNU, implementation our own.
APPROVE COMMIT
NOTE; this patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1231679922 0
# Node ID eecd28508f4ad62d51fe5144021a20f9d8594d0a
# Parent 302136a857ecc128b6e4d6824ddab892e88ea6a0
Add #'subr-arity, API taken from GNU, implementation our own.
lisp/ChangeLog addition:
2009-01-11 Aidan Kehoe <kehoea(a)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(a)parhasard.net>
* automated/lisp-tests.el ():
Test #'subr-arity, recently added to subr.el.
diff -r 302136a857ec -r eecd28508f4a lisp/ChangeLog
--- 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(a)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(a)xemacs.org>
* descr-text.el (describe-char-unicodedata-file):
diff -r 302136a857ec -r eecd28508f4a lisp/subr.el
--- 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
diff -r 302136a857ec -r eecd28508f4a tests/ChangeLog
--- 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(a)parhasard.net>
+
+ * automated/lisp-tests.el ():
+ Test #'subr-arity, recently added to subr.el.
+
2009-01-03 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/ccl-tests.el (ccl-test-setup):
diff -r 302136a857ec -r eecd28508f4a tests/automated/lisp-tests.el
--- 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
;;-----------------------------------------------------
--
¿Dónde estará ahora mi sobrino Yoghurtu Nghe, que tuvo que huir
precipitadamente de la aldea por culpa de la escasez de rinocerontes?
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches