# HG changeset patch
# User Aidan Kehoe <kehoea@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@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.

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@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):
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@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): 
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
 ;;-----------------------------------------------------