From: Stefan Monnier Date: Thu, 1 Oct 2009 16:54:21 +0000 (+0000) Subject: * emacs-lisp/byte-run.el (advertised-signature-table): New var. X-Git-Tag: emacs-pretest-23.1.90~1005 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ced10a4c9f0030e4e554d6ca3f96c6e366dba8db;p=emacs.git * emacs-lisp/byte-run.el (advertised-signature-table): New var. (set-advertised-calling-convention): New function. (make-obsolete, define-obsolete-function-alias) (make-obsolete-variable, define-obsolete-variable-alias): Make the optional-ness of `when' obsolete. (define-obsolete-face-alias): Make `when' non-optional. * help-fns.el (help-function-arglist): * emacs-lisp/bytecomp.el (byte-compile-fdefinition): Use advertised-signature-table. --- diff --git a/etc/NEWS b/etc/NEWS index 9003f42ee96..1f39f8171e0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -246,6 +246,8 @@ Command*'. * Lisp changes in Emacs 23.2 +** New function set-advertised-calling-convention makes it possible +to obsolete arguments as well as make some arguments mandatory. ** eval-next-after-load is obsolete. ** New hook `after-load-functions' run after loading an Elisp file. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3bfd9c70ff4..505f9b847c6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2009-10-01 Stefan Monnier + + * emacs-lisp/byte-run.el (advertised-signature-table): New var. + (set-advertised-calling-convention): New function. + (make-obsolete, define-obsolete-function-alias) + (make-obsolete-variable, define-obsolete-variable-alias): + Make the optional-ness of `when' obsolete. + (define-obsolete-face-alias): Make `when' non-optional. + * help-fns.el (help-function-arglist): + * emacs-lisp/bytecomp.el (byte-compile-fdefinition): + Use advertised-signature-table. + 2009-10-01 Michael Albinus * files.el (delete-directory): New defun. The original function @@ -11,16 +23,15 @@ * net/tramp.el (tramp-handle-make-directory): Flush upper directory's file properties. - (tramp-handle-delete-directory): Handle optional parameter - RECURSIVE. + (tramp-handle-delete-directory): Handle optional parameter RECURSIVE. (tramp-handle-dired-recursive-delete-directory): Flush directory properties after the remove command only. - * net/tramp-fish.el (tramp-fish-handle-delete-directory): Handle - optional parameter RECURSIVE. + * net/tramp-fish.el (tramp-fish-handle-delete-directory): + Handle optional parameter RECURSIVE. - * net/tramp-gvfs.el (tramp-gvfs-handle-delete-directory): Handle - optional parameter RECURSIVE. + * net/tramp-gvfs.el (tramp-gvfs-handle-delete-directory): + Handle optional parameter RECURSIVE. * net/tramp-smb.el (tramp-smb-errors): Add error message for connection timeout. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index b6408f2c14c..7c3ea62f3ec 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -106,6 +106,15 @@ The return value of this function is not used." (eval-and-compile (put ',name 'byte-optimizer 'byte-compile-inline-expand)))) +(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key)) + +(defun set-advertised-calling-convention (function signature) + "Set the advertised SIGNATURE of FUNCTION. +This will allow the byte-compiler to warn the programmer when she uses +an obsolete calling convention." + (puthash (indirect-function function) signature + advertised-signature-table)) + (defun make-obsolete (obsolete-name current-name &optional when) "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. The warning will say that CURRENT-NAME should be used instead. @@ -120,6 +129,9 @@ was first made obsolete, for example a date or a release number." (put obsolete-name 'byte-compile 'byte-compile-obsolete)) (put obsolete-name 'byte-obsolete-info (list current-name handler when))) obsolete-name) +(set-advertised-calling-convention + ;; New code should always provide the `when' argument. + 'make-obsolete '(obsolete-name current-name when)) (defmacro define-obsolete-function-alias (obsolete-name current-name &optional when docstring) @@ -137,6 +149,10 @@ See the docstrings of `defalias' and `make-obsolete' for more details." `(progn (defalias ,obsolete-name ,current-name ,docstring) (make-obsolete ,obsolete-name ,current-name ,when))) +(set-advertised-calling-convention + ;; New code should always provide the `when' argument. + 'define-obsolete-function-alias + '(obsolete-name current-name when &optional docstring)) (defun make-obsolete-variable (obsolete-name current-name &optional when) "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. @@ -152,6 +168,9 @@ was first made obsolete, for example a date or a release number." (car (read-from-string (read-string "Obsoletion replacement: "))))) (put obsolete-name 'byte-obsolete-variable (cons current-name when)) obsolete-name) +(set-advertised-calling-convention + ;; New code should always provide the `when' argument. + 'make-obsolete-variable '(obsolete-name current-name when)) (defmacro define-obsolete-variable-alias (obsolete-name current-name &optional when docstring) @@ -179,14 +198,17 @@ Info node `(elisp)Variable Aliases' for more details." `(progn (defvaralias ,obsolete-name ,current-name ,docstring) (make-obsolete-variable ,obsolete-name ,current-name ,when))) +(set-advertised-calling-convention + ;; New code should always provide the `when' argument. + 'define-obsolete-variable-alias + '(obsolete-name current-name when &optional docstring)) ;; FIXME This is only defined in this file because the variable- and ;; function- versions are too. Unlike those two, this one is not used ;; by the byte-compiler (would be nice if it could warn about obsolete ;; faces, but it doesn't really do anything special with faces). ;; It only really affects M-x describe-face output. -(defmacro define-obsolete-face-alias (obsolete-face current-face - &optional when) +(defmacro define-obsolete-face-alias (obsolete-face current-face when) "Make OBSOLETE-FACE a face alias for CURRENT-FACE and mark it obsolete. The optional string WHEN gives the Emacs version where OBSOLETE-FACE became obsolete." diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 79e0885137b..f411576c883 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1230,11 +1230,11 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." ;;; sanity-checking arglists -;; If a function has an entry saying (FUNCTION . t). -;; that means we know it is defined but we don't know how. -;; If a function has an entry saying (FUNCTION . nil), -;; that means treat it as not defined. (defun byte-compile-fdefinition (name macro-p) + ;; If a function has an entry saying (FUNCTION . t). + ;; that means we know it is defined but we don't know how. + ;; If a function has an entry saying (FUNCTION . nil), + ;; that means treat it as not defined. (let* ((list (if macro-p byte-compile-macro-environment byte-compile-function-environment)) @@ -1248,16 +1248,18 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (and (not macro-p) (byte-code-function-p (symbol-function fn))))) (setq fn (symbol-function fn))) - (if (and (not macro-p) (byte-code-function-p fn)) - fn - (and (consp fn) - (if (eq 'macro (car fn)) - (cdr fn) - (if macro-p - nil - (if (eq 'autoload (car fn)) - nil - fn))))))))) + (let ((advertised (gethash fn advertised-signature-table t))) + (cond + ((listp advertised) + (if macro-p + `(macro lambda ,advertised) + `(lambda ,advertised))) + ((and (not macro-p) (byte-code-function-p fn)) fn) + ((not (consp fn)) nil) + ((eq 'macro (car fn)) (cdr fn)) + (macro-p nil) + ((eq 'autoload (car fn)) nil) + (t fn))))))) (defun byte-compile-arglist-signature (arglist) (let ((args 0) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 7608e9f24e9..53663d1aeeb 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -100,13 +100,15 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." ;; Handle symbols aliased to other symbols. (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) ;; If definition is a macro, find the function inside it. - (if (eq (car-safe def) 'macro) (setq def (cdr def))) - (cond - ((byte-code-function-p def) (aref def 0)) - ((eq (car-safe def) 'lambda) (nth 1 def)) - ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) - "[Arg list not available until function definition is loaded.]") - (t t))) + (let ((advertised (gethash def advertised-signature-table t))) + (if (listp advertised) advertised + (if (eq (car-safe def) 'macro) (setq def (cdr def))) + (cond + ((byte-code-function-p def) (aref def 0)) + ((eq (car-safe def) 'lambda) (nth 1 def)) + ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) + "[Arg list not available until function definition is loaded.]") + (t t))))) (defun help-make-usage (function arglist) (cons (if (symbolp function) function 'anonymous)