From: Stefan Monnier <monnier@iro.umontreal.ca>
To: Andreas Politz <politza@fh-trier.de>
Cc: 9907@debbugs.gnu.org
Subject: bug#9907: 24.0.90; eshell:for command destructivly modifies list variables
Date: Sat, 29 Oct 2011 23:59:42 -0400 [thread overview]
Message-ID: <jwv1utvnrn6.fsf-monnier+emacs@gnu.org> (raw)
In-Reply-To: <87ehxv5ral.fsf@luca.i-did-not-set--mail-host-address--so-tickle-me> (Andreas Politz's message of "Sun, 30 Oct 2011 01:09:06 +0200")
> Do this two times. After the first time the value of `load-path' is
> gone, because the lisp code implementing the loop destructively modifies
> this list. Idea of the following solution: Copy it.
Thanks. I've installed the patch below instead, which uses backquotes
to clarify the code and simply avoids the in-place modification instead
of copying the list.
Stefan
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog 2011-10-30 03:39:11 +0000
+++ lisp/ChangeLog 2011-10-30 03:51:01 +0000
@@ -1,3 +1,18 @@
+2011-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell/esh-cmd.el (eshell-rewrite-for-command): Don't modify the list
+ in place (bug#9907).
+ (eshell-subcommand-arg-values, eshell-rewrite-named-command)
+ (eshell-rewrite-if-command, eshell-rewrite-for-command)
+ (eshell-structure-basic-command, eshell-rewrite-while-command)
+ (eshell-invokify-arg, eshell-parse-pipeline, eshell-parse-command)
+ (eshell-parse-subcommand-argument, eshell-parse-lisp-argument)
+ (eshell-trap-errors, eshell-do-pipelines, eshell-do-eval)
+ (eshell-do-pipelines-synchronously, eshell-eval-command):
+ Use backquotes and prefer setq to set.
+ (eshell-lookup-function, function-p-func, eshell-functionp): Remove.
+ (eshell-macrop): Use functionp.
+
2011-10-30 Chong Yidong <cyd@gnu.org>
* emulation/viper-cmd.el (viper-exec-change): Use push-mark
=== modified file 'lisp/eshell/esh-cmd.el'
--- lisp/eshell/esh-cmd.el 2011-03-05 20:07:27 +0000
+++ lisp/eshell/esh-cmd.el 2011-10-30 03:57:59 +0000
@@ -356,35 +356,32 @@
(mapcar
(function
(lambda (cmd)
+ (setq cmd
(if (or (not (car sep-terms))
(string= (car sep-terms) ";"))
- (setq cmd
- (eshell-parse-pipeline cmd (not (car sep-terms))))
- (setq cmd
- (list 'eshell-do-subjob
- (list 'list (eshell-parse-pipeline cmd)))))
+ (eshell-parse-pipeline cmd (not (car sep-terms)))
+ `(eshell-do-subjob
+ (list ,(eshell-parse-pipeline cmd)))))
(setq sep-terms (cdr sep-terms))
(if eshell-in-pipeline-p
cmd
- (list 'eshell-trap-errors cmd))))
+ `(eshell-trap-errors ,cmd))))
(eshell-separate-commands terms "[&;]" nil 'sep-terms))))
(let ((cmd commands))
(while cmd
(if (cdr cmd)
- (setcar cmd (list 'eshell-commands (car cmd))))
+ (setcar cmd `(eshell-commands ,(car cmd))))
(setq cmd (cdr cmd))))
(setq commands
- (append (list 'progn)
- (if top-level
- (list '(run-hooks 'eshell-pre-command-hook)))
- (if (not top-level)
+ `(progn
+ ,@(if top-level
+ '((run-hooks 'eshell-pre-command-hook)))
+ ,@(if (not top-level)
commands
- (list
- (list 'catch (quote 'top-level)
- (append (list 'progn) commands))
- '(run-hooks 'eshell-post-command-hook)))))
+ `((catch 'top-level (progn ,@commands))
+ (run-hooks 'eshell-post-command-hook)))))
(if top-level
- (list 'eshell-commands commands)
+ `(eshell-commands ,commands)
commands)))
(defun eshell-debug-command (tag subform)
@@ -417,9 +414,8 @@
(while terms
(if (and (listp (car terms))
(eq (caar terms) 'eshell-as-subcommand))
- (setcar terms (list 'eshell-convert
- (list 'eshell-command-to-value
- (car terms)))))
+ (setcar terms `(eshell-convert
+ (eshell-command-to-value ,(car terms)))))
(setq terms (cdr terms))))
(defun eshell-rewrite-sexp-command (terms)
@@ -443,7 +439,7 @@
(cmd (car terms))
(args (cdr terms)))
(if args
- (list sym cmd (append (list 'list) (cdr terms)))
+ (list sym cmd `(list ,@(cdr terms)))
(list sym cmd))))
(defvar eshell-command-body)
@@ -469,62 +465,37 @@
(eq (car (cadr arg)) 'eshell-command-to-value))
(if share-output
(cadr (cadr arg))
- (list 'eshell-commands (cadr (cadr arg))
- silent))
+ `(eshell-commands ,(cadr (cadr arg)) ,silent))
arg))
+(defvar eshell-last-command-status) ;Define in esh-io.el.
+
(defun eshell-rewrite-for-command (terms)
"Rewrite a `for' command into its equivalent Eshell command form.
Because the implementation of `for' relies upon conditional evaluation
of its argument (i.e., use of a Lisp special form), it must be
implemented via rewriting, rather than as a function."
- (if (and (stringp (car terms))
- (string= (car terms) "for")
- (stringp (nth 2 terms))
- (string= (nth 2 terms) "in"))
+ (if (and (equal (car terms) "for")
+ (equal (nth 2 terms) "in"))
(let ((body (car (last terms))))
(setcdr (last terms 2) nil)
- (list
- 'let (list (list 'for-items
+ `(let ((for-items
(append
- (list 'append)
- (mapcar
- (function
+ ,@(mapcar
(lambda (elem)
(if (listp elem)
elem
- (list 'list elem))))
+ `(list ,elem)))
(cdr (cddr terms)))))
- (list 'eshell-command-body
- (list 'quote (list nil)))
- (list 'eshell-test-body
- (list 'quote (list nil))))
- (list
- 'progn
- (list
- 'while (list 'car (list 'symbol-value
- (list 'quote 'for-items)))
- (list
- 'progn
- (list 'let
- (list (list (intern (cadr terms))
- (list 'car
- (list 'symbol-value
- (list 'quote 'for-items)))))
- (list 'eshell-protect
- (eshell-invokify-arg body t)))
- (list 'setcar 'for-items
- (list 'cadr
- (list 'symbol-value
- (list 'quote 'for-items))))
- (list 'setcdr 'for-items
- (list 'cddr
- (list 'symbol-value
- (list 'quote 'for-items))))))
- (list 'eshell-close-handles
- 'eshell-last-command-status
- (list 'list (quote 'quote)
- 'eshell-last-command-result)))))))
+ (eshell-command-body '(nil))
+ (eshell-test-body '(nil)))
+ (while (consp for-items)
+ (let ((,(intern (cadr terms)) (car for-items)))
+ (eshell-protect ,(eshell-invokify-arg body t)))
+ (setq for-items (cdr for-items)))
+ (eshell-close-handles
+ eshell-last-command-status
+ (list 'quote eshell-last-command-result))))))
(defun eshell-structure-basic-command (func names keyword test body
&optional else vocal-test)
@@ -540,8 +511,8 @@
;; that determine the truth of the statement.
(unless (eq (car test) 'eshell-convert)
(setq test
- (list 'progn test
- (list 'eshell-exit-success-p))))
+ `(progn ,test
+ (eshell-exit-success-p))))
;; should we reverse the sense of the test? This depends
;; on the `names' parameter. If it's the symbol nil, yes.
@@ -551,20 +522,16 @@
(if (or (eq names nil)
(and (listp names)
(string= keyword (cadr names))))
- (setq test (list 'not test)))
+ (setq test `(not ,test)))
;; finally, create the form that represents this structured
;; command
- (list
- 'let (list (list 'eshell-command-body
- (list 'quote (list nil)))
- (list 'eshell-test-body
- (list 'quote (list nil))))
- (list func test body else)
- (list 'eshell-close-handles
- 'eshell-last-command-status
- (list 'list (quote 'quote)
- 'eshell-last-command-result))))
+ `(let ((eshell-command-body '(nil))
+ (eshell-test-body '(nil)))
+ (,func ,test ,body ,else)
+ (eshell-close-handles
+ eshell-last-command-status
+ (list 'quote eshell-last-command-result))))
(defun eshell-rewrite-while-command (terms)
"Rewrite a `while' command into its equivalent Eshell command form.
@@ -576,8 +543,8 @@
(eshell-structure-basic-command
'while '("while" "until") (car terms)
(eshell-invokify-arg (cadr terms) nil t)
- (list 'eshell-protect
- (eshell-invokify-arg (car (last terms)) t)))))
+ `(eshell-protect
+ ,(eshell-invokify-arg (car (last terms)) t)))))
(defun eshell-rewrite-if-command (terms)
"Rewrite an `if' command into its equivalent Eshell command form.
@@ -589,15 +556,14 @@
(eshell-structure-basic-command
'if '("if" "unless") (car terms)
(eshell-invokify-arg (cadr terms) nil t)
- (list 'eshell-protect
- (eshell-invokify-arg
- (if (= (length terms) 4)
- (car (last terms 2))
- (car (last terms))) t))
+ `(eshell-protect
+ ,(eshell-invokify-arg (car (last terms (if (= (length terms) 4) 2)))
+ t))
(if (= (length terms) 4)
- (list 'eshell-protect
- (eshell-invokify-arg
- (car (last terms)))) t))))
+ `(eshell-protect
+ ,(eshell-invokify-arg (car (last terms)))) t))))
+
+(defvar eshell-last-command-result) ;Defined in esh-io.el.
(defun eshell-exit-success-p ()
"Return non-nil if the last command was \"successful\".
@@ -634,8 +600,7 @@
(if (<= (length pieces) 1)
(car pieces)
(assert (not eshell-in-pipeline-p))
- (list 'eshell-execute-pipeline
- (list 'quote pieces))))))
+ `(eshell-execute-pipeline (quote ,pieces))))))
(setq bp (cdr bp))))
;; `results' might be empty; this happens in the case of
;; multi-line input
@@ -648,8 +613,8 @@
(assert (car sep-terms))
(setq final (eshell-structure-basic-command
'if (string= (car sep-terms) "&&") "if"
- (list 'eshell-protect (car results))
- (list 'eshell-protect final)
+ `(eshell-protect ,(car results))
+ `(eshell-protect ,final)
nil t)
results (cdr results)
sep-terms (cdr sep-terms)))
@@ -667,8 +632,8 @@
(throw 'eshell-incomplete ?\{)
(when (eshell-arg-delimiter (1+ end))
(prog1
- (list 'eshell-as-subcommand
- (eshell-parse-command (cons (1+ (point)) end)))
+ `(eshell-as-subcommand
+ ,(eshell-parse-command (cons (1+ (point)) end)))
(goto-char (1+ end))))))))
(defun eshell-parse-lisp-argument ()
@@ -683,8 +648,8 @@
(end-of-file
(throw 'eshell-incomplete ?\()))))
(if (eshell-arg-delimiter)
- (list 'eshell-command-to-value
- (list 'eshell-lisp-command (list 'quote obj)))
+ `(eshell-command-to-value
+ (eshell-lisp-command (quote ,obj)))
(ignore (goto-char here))))))
(defun eshell-separate-commands (terms separator &optional
@@ -759,7 +724,7 @@
Someday, when Scheme will become the dominant Emacs language, all of
this grossness will be made to disappear by using `call/cc'..."
- `(let ((eshell-this-command-hook (list 'ignore)))
+ `(let ((eshell-this-command-hook '(ignore)))
(eshell-condition-case err
(prog1
,object
@@ -769,6 +734,9 @@
(eshell-errorn (error-message-string err))
(eshell-close-handles 1)))))
+(defvar eshell-output-handle) ;Defined in esh-io.el.
+(defvar eshell-error-handle) ;Defined in esh-io.el.
+
(defmacro eshell-copy-handles (object)
"Duplicate current I/O handles, so OBJECT works with its own copy."
`(let ((eshell-current-handles
@@ -793,14 +761,13 @@
(progn
,(when (cdr pipeline)
`(let (nextproc)
- (progn
- (set 'nextproc
+ (setq nextproc
(eshell-do-pipelines (quote ,(cdr pipeline)) t))
(eshell-set-output-handle ,eshell-output-handle
'append nextproc)
(eshell-set-output-handle ,eshell-error-handle
'append nextproc)
- (set 'tailproc (or tailproc nextproc)))))
+ (setq tailproc (or tailproc nextproc))))
,(let ((head (car pipeline)))
(if (memq (car head) '(let progn))
(setq head (car (last head))))
@@ -824,19 +791,17 @@
This is used on systems where `start-process' is not supported."
(when (setq pipeline (cadr pipeline))
`(let (result)
- (progn
,(when (cdr pipeline)
`(let (output-marker)
- (progn
- (set 'output-marker ,(point-marker))
+ (setq output-marker ,(point-marker))
(eshell-set-output-handle ,eshell-output-handle
'append output-marker)
(eshell-set-output-handle ,eshell-error-handle
- 'append output-marker))))
+ 'append output-marker)))
,(let ((head (car pipeline)))
(if (memq (car head) '(let progn))
(setq head (car (last head))))
- ;;; FIXME: is deferrable significant here?
+ ;; FIXME: is deferrable significant here?
(when (memq (car head) eshell-deferrable-commands)
(ignore
(setcar head
@@ -846,15 +811,15 @@
;; redirected as we found them before running the pipe.
,(if (null (cdr pipeline))
`(progn
- (set 'eshell-current-handles tail-handles)
- (set 'eshell-in-pipeline-p nil)))
- (set 'result ,(car pipeline))
+ (setq eshell-current-handles tail-handles)
+ (setq eshell-in-pipeline-p nil)))
+ (setq result ,(car pipeline))
;; tailproc gets the result of the last successful process in
;; the pipeline.
- (set 'tailproc (or result tailproc))
+ (setq tailproc (or result tailproc))
,(if (cdr pipeline)
`(eshell-do-pipelines-synchronously (quote ,(cdr pipeline))))
- result))))
+ result)))
(defalias 'eshell-process-identity 'identity)
@@ -965,14 +930,12 @@
;; we can just stick the new command at the end of the current
;; one, and everything will happen as it should
(setcdr (last (cdr eshell-current-command))
- (list (list 'let '((here (and (eobp) (point))))
- (and input
- (list 'insert-and-inherit
- (concat input "\n")))
- '(if here
+ (list `(let ((here (and (eobp) (point))))
+ ,(and input
+ `(insert-and-inherit ,(concat input "\n")))
+ (if here
(eshell-update-markers here))
- (list 'eshell-do-eval
- (list 'quote command)))))
+ (eshell-do-eval ',command))))
(and eshell-debug-command
(with-current-buffer (get-buffer-create "*eshell last cmd*")
(erase-buffer)
@@ -1016,6 +979,7 @@
(defmacro eshell-manipulate (tag &rest commands)
"Manipulate a COMMAND form, with TAG as a debug identifier."
+ (declare (indent 1))
;; Check `bound'ness since at compile time the code until here has not
;; executed yet.
(if (not (and (boundp 'eshell-debug-command) eshell-debug-command))
@@ -1025,39 +989,13 @@
,@commands
(eshell-debug-command ,(concat "done " (eval tag)) form))))
-(put 'eshell-manipulate 'lisp-indent-function 1)
-
-;; eshell-lookup-function, eshell-functionp, and eshell-macrop taken
-;; from edebug
-
-(defsubst eshell-lookup-function (object)
- "Return the ultimate function definition of OBJECT."
- (while (and (symbolp object) (fboundp object))
- (setq object (symbol-function object)))
- object)
-
-(defconst function-p-func
- (if (fboundp 'compiled-function-p)
- 'compiled-function-p
- 'byte-code-function-p))
-
-(defsubst eshell-functionp (object)
- "Returns the function named by OBJECT, or nil if it is not a function."
- (setq object (eshell-lookup-function object))
- (if (or (subrp object)
- (funcall function-p-func object)
- (and (listp object)
- (eq (car object) 'lambda)
- (listp (car (cdr object)))))
- object))
-
(defsubst eshell-macrop (object)
"Return t if OBJECT is a macro or nil otherwise."
- (setq object (eshell-lookup-function object))
- (if (and (listp object)
+ (and (symbolp object) (fboundp object)
+ (setq object (indirect-function object))
+ (listp object)
(eq 'macro (car object))
- (eshell-functionp (cdr object)))
- t))
+ (functionp (cdr object))))
(defun eshell-do-eval (form &optional synchronous-p)
"Evaluate form, simplifying it as we go.
@@ -1107,9 +1045,11 @@
(eshell-do-eval (car eshell-command-body)))
(unless (car eshell-test-body)
(setcar eshell-test-body (eshell-copy-tree (car args))))
+ (setcar eshell-command-body
+ (eshell-copy-tree
(if (cadr (eshell-do-eval (car eshell-test-body)))
- (setcar eshell-command-body (eshell-copy-tree (cadr args)))
- (setcar eshell-command-body (eshell-copy-tree (car (cddr args)))))
+ (cadr args)
+ (car (cddr args)))))
(eshell-do-eval (car eshell-command-body) synchronous-p))
(setcar eshell-command-body nil)
(setcar eshell-test-body nil))
@@ -1140,9 +1080,7 @@
(setq args (cdr args)))
(unless (eq (caar args) 'eshell-do-eval)
(eshell-manipulate "handling special form"
- (setcar args (list 'eshell-do-eval
- (list 'quote (car args))
- synchronous-p))))
+ (setcar args `(eshell-do-eval ',(car args) ,synchronous-p))))
(eval form))
(t
(if (and args (not (memq (car form) '(run-hooks))))
@@ -1362,6 +1300,8 @@
"Evaluate FORM, trapping errors and returning them."
(eshell-eval* 'eshell-printn 'eshell-errorn form))
+(defvar eshell-last-output-end) ;Defined in esh-mode.el.
+
(defun eshell-lisp-command (object &optional args)
"Insert Lisp OBJECT, using ARGS if a function."
(catch 'eshell-external ; deferred to an external command
next prev parent reply other threads:[~2011-10-30 3:59 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-10-29 23:09 bug#9907: 24.0.90; eshell:for command destructivly modifies list variables Andreas Politz
2011-10-30 3:59 ` Stefan Monnier [this message]
2011-10-30 5:43 ` Thierry Volpiatto
2011-10-30 8:00 ` Stefan Monnier
2011-10-30 18:37 ` Thierry Volpiatto
2011-11-18 2:05 ` Glenn Morris
2011-11-18 14:49 ` Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=jwv1utvnrn6.fsf-monnier+emacs@gnu.org \
--to=monnier@iro.umontreal.ca \
--cc=9907@debbugs.gnu.org \
--cc=politza@fh-trier.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).