;;; guile-emacs.scm --- Guile Emacs interface
-;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
+;; Copyright (C) 2001, 2010 Keisuke Nishida <kxn30@po.cwru.edu>
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;
(define (guile-emacs-export-procedure name proc docs)
- (define (procedure-arity proc)
- (assq-ref (procedure-properties proc) 'arity))
-
(define (procedure-args proc)
(let ((source (procedure-source proc)))
(if source
((symbol? formals) `(&rest ,formals))
(else (cons (car formals) (loop (cdr formals))))))
;; arity -> emacs args
- (let* ((arity (procedure-arity proc))
+ (let* ((arity (procedure-minimum-arity proc))
(nreqs (car arity))
(nopts (cadr arity))
(restp (caddr arity)))
# include <config.h>
#endif
+#define SCM_BUILDING_DEPRECATED_CODE
+
#include "libguile/_scm.h"
#include "libguile/alist.h"
+#include "libguile/deprecation.h"
+#include "libguile/deprecated.h"
#include "libguile/eval.h"
#include "libguile/procs.h"
#include "libguile/gsubr.h"
\f
SCM_GLOBAL_SYMBOL (scm_sym_system_procedure, "system-procedure");
+#if (SCM_ENABLE_DEPRECATED == 1)
SCM_GLOBAL_SYMBOL (scm_sym_arity, "arity");
+#endif
SCM_GLOBAL_SYMBOL (scm_sym_name, "name");
static SCM overrides;
#define FUNC_NAME s_scm_procedure_properties
{
SCM ret;
- int req, opt, rest;
SCM_VALIDATE_PROC (1, proc);
ret = SCM_EOL;
}
- scm_i_procedure_arity (proc, &req, &opt, &rest);
+#if (SCM_ENABLE_DEPRECATED == 1)
+ ret = scm_acons (scm_sym_arity, scm_procedure_minimum_arity (proc), ret);
+#endif
- return scm_acons (scm_sym_arity,
- scm_list_3 (scm_from_int (req),
- scm_from_int (opt),
- scm_from_bool (rest)),
- ret);
+ return ret;
}
#undef FUNC_NAME
{
SCM_VALIDATE_PROC (1, proc);
+#if (SCM_ENABLE_DEPRECATED == 1)
if (scm_assq (alist, scm_sym_arity))
SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
+#endif
scm_i_pthread_mutex_lock (&overrides_lock);
scm_hashq_set_x (overrides, proc, alist);
{
SCM_VALIDATE_PROC (1, proc);
+#if (SCM_ENABLE_DEPRECATED == 1)
if (scm_is_eq (key, scm_sym_arity))
- /* avoid a cons in this case */
- {
- int req, opt, rest;
- scm_i_procedure_arity (proc, &req, &opt, &rest);
- return scm_list_3 (scm_from_int (req),
- scm_from_int (opt),
- scm_from_bool (rest));
- }
- else
- return scm_assq_ref (scm_procedure_properties (proc), key);
+ scm_c_issue_deprecation_warning
+ ("Accessing a procedure's arity via `procedure-property' is deprecated.\n"
+ "Use `procedure-minimum-arity instead.");
+#endif
+
+ return scm_assq_ref (scm_procedure_properties (proc), key);
}
#undef FUNC_NAME
SCM props;
SCM_VALIDATE_PROC (1, proc);
+
+#if (SCM_ENABLE_DEPRECATED == 1)
if (scm_is_eq (key, scm_sym_arity))
- SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
+ SCM_MISC_ERROR ("arity is a deprecated read-only property", SCM_EOL);
+#endif
props = scm_procedure_properties (proc);
+
+#if (SCM_ENABLE_DEPRECATED == 1)
+ /* cdr past the consed-on arity. */
+ props = scm_cdr (props);
+#endif
+
scm_i_pthread_mutex_lock (&overrides_lock);
scm_hashq_set_x (overrides, proc, scm_assq_set_x (props, key, val));
scm_i_pthread_mutex_unlock (&overrides_lock);