From 6e9590e26c31ee3056c5abc347381ee35d49363b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 27 Jun 2012 10:39:30 -0400 Subject: [PATCH] * lisp/emacs-lisp/cl.el: Use lexical-binding. Fix flet. (cl--symbol-function): New macro. (cl--letf, cl--letf*): Use it. Fixes: debbugs:11780 --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/cl.el | 21 +++++++++++++++++---- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0de89c47990..180f87e46b0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2012-06-27 Stefan Monnier + * emacs-lisp/cl.el: Use lexical-binding. Fix flet (bug#11780). + (cl--symbol-function): New macro. + (cl--letf, cl--letf*): Use it. + * emacs-lisp/easy-mmode.el (easy-mmode-pretty-mode-name): Strip "toggle-" if any. diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index b17d6f4e671..7996af4e02d 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -1,4 +1,4 @@ -;;; cl.el --- Compatibility aliases for the old CL library. +;;; cl.el --- Compatibility aliases for the old CL library. -*- lexical-binding: t -*- ;; Copyright (C) 2012 Free Software Foundation, Inc. @@ -235,7 +235,6 @@ multiple-value-bind symbol-macrolet macrolet - flet progv psetq do-all-symbols @@ -450,6 +449,16 @@ Common Lisp. (setq body (list `(lexical-let (,(pop bindings)) ,@body)))) (car body))) +(defmacro cl--symbol-function (symbol) + "Like `symbol-function' but return `cl--unbound' if not bound." + ;; (declare (gv-setter (lambda (store) + ;; `(if (eq ,store 'cl--unbound) + ;; (fmakunbound ,symbol) (fset ,symbol ,store))))) + `(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound)) +(gv-define-setter cl--symbol-function (store symbol) + `(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store))) + + ;; This should really have some way to shadow 'byte-compile properties, etc. (defmacro flet (bindings &rest body) "Make temporary function definitions. @@ -543,6 +552,8 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard. (funcall setter vold))) binds)))) (let ((binding (car bindings))) + (if (eq (car-safe (car binding)) 'symbol-function) + (setcar (car binding) 'cl--symbol-function)) (gv-letplace (getter setter) (car binding) (macroexp-let2 nil vnew (cadr binding) (if (symbolp (car binding)) @@ -579,7 +590,9 @@ the PLACE is not modified before executing BODY. ;; Special-case for simple variables. (macroexp-let* (list (if (cdr binding) binding (list (car binding) (car binding)))) - (cl--letf* (cdr bindings) body)) + (cl--letf* (cdr bindings) body)) + (if (eq (car-safe (car binding)) 'symbol-function) + (setcar (car binding) 'cl--symbol-function)) (gv-letplace (getter setter) (car binding) (macroexp-let2 macroexp-copyable-p vnew (cadr binding) (macroexp-let2 nil vold getter @@ -736,7 +749,7 @@ from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" ;; This is just kept for compatibility with code byte-compiled by Emacs-20. ;; No idea if this might still be needed. -(defun cl-not-hash-table (x &optional y &rest z) +(defun cl-not-hash-table (x &optional y &rest _z) (declare (obsolete nil "24.2")) (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x)))) -- 2.39.2