Commit e0f57e65 authored by Stefan Monnier's avatar Stefan Monnier

* lisp/subr.el (save-window-excursion): New macro, moved from C.

* lisp/emacs-lisp/lisp-mode.el (save-window-excursion): Don't touch.
* lisp/emacs-lisp/cconv.el (cconv-closure-convert-rec, cconv-analyse-form):
Don't handle save-window-excursion any more.
* lisp/emacs-lisp/bytecomp.el (interactive-p, save-window-excursion):
Don't use the byte-code any more.
(byte-compile-form): Check macro expansion was done.
(byte-compile-save-window-excursion): Remove.
* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
Ignore save-window-excursion.  Don't macroepand any more.

* src/window.c (Fsave_window_excursion): Remove.  Moved to Lisp.
(syms_of_window): Don't defsubr it.
* src/window.h (Fsave_window_excursion): Don't declare it.
* src/bytecode.c (exec_byte_code): Inline Fsave_window_excursion.
parent 9a05edc4
2011-02-19 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (save-window-excursion): New macro, moved from C.
* emacs-lisp/lisp-mode.el (save-window-excursion): Don't touch.
* emacs-lisp/cconv.el (cconv-closure-convert-rec, cconv-analyse-form):
Don't handle save-window-excursion any more.
* emacs-lisp/bytecomp.el (interactive-p, save-window-excursion):
Don't use the byte-code any more.
(byte-compile-form): Check macro expansion was done.
(byte-compile-save-window-excursion): Remove.
* emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
Ignore save-window-excursion. Don't macroepand any more.
2011-02-18 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/pcase.el (pcase--expand, pcase--u, pcase--u1, pcase--q1):
......
......@@ -498,8 +498,7 @@
(prin1-to-string form))
nil)
((memq fn '(defun defmacro function
condition-case save-window-excursion))
((memq fn '(defun defmacro function condition-case))
;; These forms are compiled as constants or by breaking out
;; all the subexpressions and compiling them separately.
form)
......@@ -530,24 +529,6 @@
;; However, don't actually bother calling `ignore'.
`(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
;; If optimization is on, this is the only place that macros are
;; expanded. If optimization is off, then macroexpansion happens
;; in byte-compile-form. Otherwise, the macros are already expanded
;; by the time that is reached.
((not (eq form
(setq form (macroexpand form
byte-compile-macro-environment))))
(byte-optimize-form form for-effect))
;; Support compiler macros as in cl.el.
((and (fboundp 'compiler-macroexpand)
(symbolp (car-safe form))
(get (car-safe form) 'cl-compiler-macro)
(not (eq form
(with-no-warnings
(setq form (compiler-macroexpand form))))))
(byte-optimize-form form for-effect))
((not (symbolp fn))
(byte-compile-warn "`%s' is a malformed function"
(prin1-to-string fn))
......
......@@ -586,7 +586,6 @@ Each element is (INDEX . VALUE)")
(byte-defop 114 0 byte-save-current-buffer
"To make a binding to record the current buffer")
(byte-defop 115 0 byte-set-mark-OBSOLETE)
(byte-defop 116 1 byte-interactive-p)
;; These ops are new to v19
(byte-defop 117 0 byte-forward-char)
......@@ -622,8 +621,6 @@ otherwise pop it")
(byte-defop 138 0 byte-save-excursion
"to make a binding to record the buffer, point and mark")
(byte-defop 139 0 byte-save-window-excursion
"to make a binding to record entire window configuration")
(byte-defop 140 0 byte-save-restriction
"to make a binding to record the current buffer clipping restrictions")
(byte-defop 141 -1 byte-catch
......@@ -2955,6 +2952,10 @@ That command is designed for interactive use only" bytecomp-fn))
custom-declare-face))
(byte-compile-nogroup-warn form))
(byte-compile-callargs-warn form))
(if (and (fboundp (car form))
(eq (car-safe (indirect-function (car form))) 'macro))
(byte-compile-report-error
(format "Forgot to expand macro %s" (car form))))
(if (and bytecomp-handler
;; Make sure that function exists. This is important
;; for CL compiler macros since the symbol may be
......@@ -3167,7 +3168,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(byte-defop-compiler bobp 0)
(byte-defop-compiler current-buffer 0)
;;(byte-defop-compiler read-char 0) ;; obsolete
(byte-defop-compiler interactive-p 0)
(byte-defop-compiler widen 0)
(byte-defop-compiler end-of-line 0-1)
(byte-defop-compiler forward-char 0-1)
......@@ -3946,7 +3946,6 @@ binding slots have been popped."
(byte-defop-compiler-1 save-excursion)
(byte-defop-compiler-1 save-current-buffer)
(byte-defop-compiler-1 save-restriction)
(byte-defop-compiler-1 save-window-excursion)
(byte-defop-compiler-1 with-output-to-temp-buffer)
(byte-defop-compiler-1 track-mouse)
......@@ -4047,15 +4046,6 @@ binding slots have been popped."
(byte-compile-body-do-effect (cdr form))
(byte-compile-out 'byte-unbind 1))
(defun byte-compile-save-window-excursion (form)
(pcase (cdr form)
(`(:fun-body ,f)
(byte-compile-form `(list (list 'funcall ,f))))
(body
(byte-compile-push-constant
(byte-compile-top-level-body body for-effect))))
(byte-compile-out 'byte-save-window-excursion 0))
(defun byte-compile-with-output-to-temp-buffer (form)
(byte-compile-form (car (cdr form)))
(byte-compile-out 'byte-temp-output-buffer-setup 0)
......
......@@ -635,8 +635,8 @@ Returns a form where all lambdas don't have any free variables."
,(cconv-closure-convert-rec `(function (lambda () ,@body))
emvrs fvrs envs lmenvs)))
(`(,(and head (or `save-window-excursion `track-mouse)) . ,body)
`(,head
(`(track-mouse . ,body)
`(track-mouse
:fun-body
,(cconv-closure-convert-rec `(function (lambda () ,@body))
emvrs fvrs envs lmenvs)))
......@@ -827,7 +827,7 @@ lambdas if they are suitable for lambda lifting.
;; FIXME: The bytecode for save-window-excursion and the lack of
;; bytecode for track-mouse forces us to wrap the body.
(`(,(or `save-window-excursion `track-mouse) . ,body)
(`(track-mouse . ,body)
(setq inclosure (1+ inclosure))
(dolist (form body)
(cconv-analyse-form form env inclosure)))
......
......@@ -1209,7 +1209,6 @@ This function also returns nil meaning don't specify the indentation."
(put 'prog1 'lisp-indent-function 1)
(put 'prog2 'lisp-indent-function 2)
(put 'save-excursion 'lisp-indent-function 0)
(put 'save-window-excursion 'lisp-indent-function 0)
(put 'save-restriction 'lisp-indent-function 0)
(put 'save-match-data 'lisp-indent-function 0)
(put 'save-current-buffer 'lisp-indent-function 0)
......
......@@ -2767,6 +2767,25 @@ nor the buffer list."
(when (buffer-live-p ,old-buffer)
(set-buffer ,old-buffer))))))
(defmacro save-window-excursion (&rest body)
"Execute BODY, preserving window sizes and contents.
Return the value of the last form in BODY.
Restore which buffer appears in which window, where display starts,
and the value of point and mark for each window.
Also restore the choice of selected window.
Also restore which buffer is current.
Does not restore the value of point in current buffer.
BEWARE: Most uses of this macro introduce bugs.
E.g. it should not be used to try and prevent some code from opening
a new window, since that window may sometimes appear in another frame,
in which case `save-window-excursion' cannot help."
(declare (indent 0) (debug t))
(let ((c (make-symbol "wconfig")))
`(let ((,c (current-window-configuration)))
(unwind-protect (progn ,@body)
(set-window-configuration ,c)))))
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
The value returned is the value of the last form in BODY.
......
2011-02-19 Stefan Monnier <monnier@iro.umontreal.ca>
* window.c (Fsave_window_excursion): Remove. Moved to Lisp.
(syms_of_window): Don't defsubr it.
* window.h (Fsave_window_excursion): Don't declare it.
* bytecode.c (exec_byte_code): Inline Fsave_window_excursion.
2011-02-17 Stefan Monnier <monnier@iro.umontreal.ca>
* eval.c (Vinternal_interpreter_environment): Remove.
......
......@@ -138,7 +138,7 @@ extern Lisp_Object Qand_optional, Qand_rest;
#define Bpoint 0140
/* Was Bmark in v17. */
#define Bsave_current_buffer 0141
#define Bsave_current_buffer 0141 /* Obsolete. */
#define Bgoto_char 0142
#define Binsert 0143
#define Bpoint_max 0144
......@@ -158,7 +158,7 @@ extern Lisp_Object Qand_optional, Qand_rest;
#define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */
#define Bread_char 0162 /* No longer generated as of v19 */
#define Bset_mark 0163 /* this loser is no longer generated as of v18 */
#define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
#define Binteractive_p 0164 /* Obsolete. */
#define Bforward_char 0165
#define Bforward_word 0166
......@@ -183,7 +183,7 @@ extern Lisp_Object Qand_optional, Qand_rest;
#define Bdup 0211
#define Bsave_excursion 0212
#define Bsave_window_excursion 0213
#define Bsave_window_excursion 0213 /* Obsolete. */
#define Bsave_restriction 0214
#define Bcatch 0215
......@@ -192,7 +192,7 @@ extern Lisp_Object Qand_optional, Qand_rest;
#define Btemp_output_buffer_setup 0220
#define Btemp_output_buffer_show 0221
#define Bunbind_all 0222
#define Bunbind_all 0222 /* Obsolete. */
#define Bset_marker 0223
#define Bmatch_beginning 0224
......@@ -763,7 +763,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
AFTER_POTENTIAL_GC ();
break;
case Bunbind_all:
case Bunbind_all: /* Obsolete. */
/* To unbind back to the beginning of this frame. Not used yet,
but will be needed for tail-recursion elimination. */
BEFORE_POTENTIAL_GC ();
......@@ -891,16 +891,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
save_excursion_save ());
break;
case Bsave_current_buffer:
case Bsave_current_buffer: /* Obsolete. */
case Bsave_current_buffer_1:
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
break;
case Bsave_window_excursion:
BEFORE_POTENTIAL_GC ();
TOP = Fsave_window_excursion (TOP); /* FIXME: lexbind */
AFTER_POTENTIAL_GC ();
break;
case Bsave_window_excursion: /* Obsolete. */
{
register Lisp_Object val;
register int count = SPECPDL_INDEX ();
record_unwind_protect (Fset_window_configuration,
Fcurrent_window_configuration (Qnil));
BEFORE_POTENTIAL_GC ();
TOP = Fprogn (TOP);
unbind_to (count, TOP);
AFTER_POTENTIAL_GC ();
break;
}
case Bsave_restriction:
record_unwind_protect (save_restriction_restore,
......@@ -1412,7 +1420,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
AFTER_POTENTIAL_GC ();
break;
case Binteractive_p:
case Binteractive_p: /* Obsolete. */
PUSH (Finteractive_p ());
break;
......
......@@ -6400,28 +6400,6 @@ redirection (see `redirect-frame-focus'). */)
return (tem);
}
DEFUN ("save-window-excursion", Fsave_window_excursion, Ssave_window_excursion,
0, UNEVALLED, 0,
doc: /* Execute BODY, preserving window sizes and contents.
Return the value of the last form in BODY.
Restore which buffer appears in which window, where display starts,
and the value of point and mark for each window.
Also restore the choice of selected window.
Also restore which buffer is current.
Does not restore the value of point in current buffer.
usage: (save-window-excursion BODY...) */)
(Lisp_Object args)
{
register Lisp_Object val;
register int count = SPECPDL_INDEX ();
record_unwind_protect (Fset_window_configuration,
Fcurrent_window_configuration (Qnil));
val = Fprogn (args);
return unbind_to (count, val);
}
/***********************************************************************
Window Split Tree
......@@ -7195,7 +7173,6 @@ frame to be redrawn only if it is a tty frame. */);
defsubr (&Swindow_configuration_frame);
defsubr (&Sset_window_configuration);
defsubr (&Scurrent_window_configuration);
defsubr (&Ssave_window_excursion);
defsubr (&Swindow_tree);
defsubr (&Sset_window_margins);
defsubr (&Swindow_margins);
......
......@@ -860,7 +860,6 @@ EXFUN (Fwindow_minibuffer_p, 1);
EXFUN (Fdelete_window, 1);
EXFUN (Fwindow_buffer, 1);
EXFUN (Fget_buffer_window, 2);
EXFUN (Fsave_window_excursion, UNEVALLED);
EXFUN (Fset_window_configuration, 1);
EXFUN (Fcurrent_window_configuration, 1);
extern int compare_window_configurations (Lisp_Object, Lisp_Object, int);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment