From 2ee3d7f0aa6c29fec22e663b016a05762eb1e0d0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 22 Jun 2012 09:42:38 -0400 Subject: =?UTF-8?q?Provide=20generalized=20variables=20in=20core=20Elisp.?= =?UTF-8?q?=20*=20lisp/emacs-lisp/gv.el:=20New=20file.=20*=20lisp/subr.el?= =?UTF-8?q?=20(push,=20pop):=20Extend=20to=20generalized=20variables.=20*?= =?UTF-8?q?=20lisp/loadup.el=20(macroexp):=20Unload=20if=20preloaded=20and?= =?UTF-8?q?=20uncompiled.=20*=20lisp/emacs-lisp/cl-lib.el=20(cl-pop,=20cl-?= =?UTF-8?q?push,=20cl--set-nthcdr):=20Remove.=20*=20lisp/emacs-lisp/cl-mac?= =?UTF-8?q?s.el:=20Require=20gv.=20=20Use=20gv-define-setter,=20gv-define-?= =?UTF-8?q?simple-setter,=20and=20gv-define-expander.=20Remove=20setf-meth?= =?UTF-8?q?ods=20defined=20in=20gv.=20=20Rename=20cl-setf=20->=20setf.=20(?= =?UTF-8?q?cl-setf,=20cl-do-pop,=20cl-get-setf-method):=20Remove.=20(cl-le?= =?UTF-8?q?tf,=20cl-letf*,=20cl-define-modify-macro,=20cl-defsetf)=20(cl-d?= =?UTF-8?q?efine-setf-expander,=20cl-struct-setf-expander):=20Move=20to=20?= =?UTF-8?q?cl.el.=20(cl-remf,=20cl-shiftf,=20cl-rotatef,=20cl-callf,=20cl-?= =?UTF-8?q?callf2):=20Rewrite=20with=20gv-letplace.=20(cl-defstruct):=20Do?= =?UTF-8?q?n't=20define=20setf-method=20any=20more.=20*=20lisp/emacs-lisp/?= =?UTF-8?q?cl.el=20(flet):=20Don't=20autoload.=20(cl--letf,=20letf,=20cl--?= =?UTF-8?q?letf*,=20letf*,=20cl--gv-adapt)=20(define-setf-expander,=20defs?= =?UTF-8?q?etf,=20define-modify-macro)=20(cl-struct-setf-expander):=20Move?= =?UTF-8?q?=20from=20cl-lib.el.=20*=20lisp/emacs-lisp/syntax.el:=20*=20lis?= =?UTF-8?q?p/emacs-lisp/ewoc.el:=20*=20lisp/emacs-lisp/smie.el:=20*=20lisp?= =?UTF-8?q?/emacs-lisp/cconv.el:=20*=20lisp/emacs-lisp/timer.el:=20Rename?= =?UTF-8?q?=20cl-setf=20->=20setf,=20cl-push=20->=20push.=20(timer--time):?= =?UTF-8?q?=20Use=20gv-define-simple-setter.=20*=20lisp/emacs-lisp/macroex?= =?UTF-8?q?p.el=20(macroexp-let2):=20Rename=20from=20macroexp-let=C2=B2=20?= =?UTF-8?q?to=20avoid=20coding-system=20problems=20in=20subr.el.=20=20Adju?= =?UTF-8?q?st=20all=20users.=20(macroexp--maxsize,=20macroexp-small-p):=20?= =?UTF-8?q?New=20functions.=20*=20lisp/emacs-lisp/bytecomp.el=20(byte-comp?= =?UTF-8?q?ile-file):=20Don't=20use=20cl-letf.=20*=20lisp/scroll-bar.el=20?= =?UTF-8?q?(scroll-bar-mode):=20*=20lisp/simple.el=20(auto-fill-mode,=20ov?= =?UTF-8?q?erwrite-mode,=20binary-overwrite-mode)=20(normal-erase-is-backs?= =?UTF-8?q?pace-mode):=20Don't=20use=20the=20`eq'=20place.=20*=20lisp/winn?= =?UTF-8?q?er.el=20(winner-configuration,=20winner-make-point-alist)=20(wi?= =?UTF-8?q?nner-set-conf,=20winner-get-point,=20winner-set):=20Don't=20abu?= =?UTF-8?q?se=20letf.=20*=20lisp/files.el=20(locate-file-completion-table)?= =?UTF-8?q?:=20Avoid=20list*.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes: debbugs:11657 --- lisp/subr.el | 50 ++++++++++++++++++++++++++++---------------------- 1 file changed, 28 insertions(+), 22 deletions(-) (limited to 'lisp/subr.el') diff --git a/lisp/subr.el b/lisp/subr.el index ba9b06d495b..5deaf71e78d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -26,6 +26,9 @@ ;;; Code: +;; Beware: while this file has tag `utf-8', before it's compiled, it gets +;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap. + (defvar custom-declare-variable-list nil "Record `defcustom' calls made before `custom.el' is loaded to handle them. Each element of this list holds the arguments to one call to `defcustom'.") @@ -144,29 +147,33 @@ was called." `(closure (t) (&rest args) (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) -(if (null (featurep 'cl)) - (progn - ;; If we reload subr.el after having loaded CL, be careful not to - ;; overwrite CL's extended definition of `dolist', `dotimes', - ;; `declare', `push' and `pop'. -(defmacro push (newelt listname) - "Add NEWELT to the list stored in the symbol LISTNAME. -This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)). -LISTNAME must be a symbol." - (declare (debug (form sexp))) - (list 'setq listname - (list 'cons newelt listname))) - -(defmacro pop (listname) - "Return the first element of LISTNAME's value, and remove it from the list. -LISTNAME must be a symbol whose value is a list. +(defmacro push (newelt place) + "Add NEWELT to the list stored in the generalized variable PLACE. +This is morally equivalent to (setf PLACE (cons NEWELT PLACE)), +except that PLACE is only evaluated once (after NEWELT)." + (declare (debug (form gv-place))) + (if (symbolp place) + ;; Important special case, to avoid triggering GV too early in + ;; the bootstrap. + (list 'setq place + (list 'cons newelt place)) + (require 'macroexp) + (macroexp-let2 macroexp-copyable-p v newelt + (gv-letplace (getter setter) place + (funcall setter `(cons ,v ,getter)))))) + +(defmacro pop (place) + "Return the first element of PLACE's value, and remove it from the list. +PLACE must be a generalized variable whose value is a list. If the value is nil, `pop' returns nil but does not actually change the list." - (declare (debug (sexp))) + (declare (debug (gv-place))) (list 'car - (list 'prog1 listname - (list 'setq listname (list 'cdr listname))))) -)) + (if (symbolp place) + ;; So we can use `pop' in the bootstrap before `gv' can be used. + (list 'prog1 place (list 'setq place (list 'cdr place))) + (gv-letplace (getter setter) place + `(prog1 ,getter ,(funcall setter `(cdr ,getter))))))) (defmacro when (cond &rest body) "If COND yields non-nil, do BODY, else return nil. @@ -189,8 +196,7 @@ value of last one, or nil if there are none. (if (null (featurep 'cl)) (progn ;; If we reload subr.el after having loaded CL, be careful not to - ;; overwrite CL's extended definition of `dolist', `dotimes', - ;; `declare', `push' and `pop'. + ;; overwrite CL's extended definition of `dolist', `dotimes', `declare'. (defmacro dolist (spec &rest body) "Loop over a list. -- cgit v1.2.1