changeset: 4575:eecd28508f4ad62d51fe5144021a20f9d8594d0a tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Sun Jan 11 13:18:42 2009 +0000 files: lisp/ChangeLog lisp/subr.el tests/ChangeLog tests/automated/lisp-tests.el description: Add #'subr-arity, API taken from GNU, implementation our own. lisp/ChangeLog addition: 2009-01-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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&gt; * automated/lisp-tests.el (): Test #'subr-arity, recently added to subr.el. diff -r 302136a857ecc128b6e4d6824ddab892e88ea6a0 -r eecd28508f4ad62d51fe5144021a20f9d8594d0a 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-01 Stephen J. Turnbull <stephe +2009-01-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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&gt; * descr-text.el (describe-char-unicodedata-file): diff -r 302136a857ecc128b6e4d6824ddab892e88ea6a0 -r eecd28508f4ad62d51fe5144021a20f9d8594d0a 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 ＠＠ one is kept." ;; (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 ＠＠ in Lisp; do not use it in performance-cr 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 302136a857ecc128b6e4d6824ddab892e88ea6a0 -r eecd28508f4ad62d51fe5144021a20f9d8594d0a 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-03 Aidan Kehoe <kehoea＠parhasa +2009-01-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el (): + Test #'subr-arity, recently added to subr.el. + 2009-01-03 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/ccl-tests.el (ccl-test-setup): diff -r 302136a857ecc128b6e4d6824ddab892e88ea6a0 -r eecd28508f4ad62d51fe5144021a20f9d8594d0a 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 ＠＠ -888,6 +888,20 ＠＠ (defun test-fun ,arglist nil) (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 _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches