From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#9907: 24.0.90; eshell:for command destructivly modifies list variables Date: Sat, 29 Oct 2011 23:59:42 -0400 Message-ID: References: <87ehxv5ral.fsf@luca.i-did-not-set--mail-host-address--so-tickle-me> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1319947270 28644 80.91.229.12 (30 Oct 2011 04:01:10 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sun, 30 Oct 2011 04:01:10 +0000 (UTC) Cc: 9907@debbugs.gnu.org To: Andreas Politz Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Oct 30 05:01:05 2011 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1RKMa1-0003yO-0E for geb-bug-gnu-emacs@m.gmane.org; Sun, 30 Oct 2011 05:01:05 +0100 Original-Received: from localhost ([::1]:39794 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RKMa0-0004U4-Hy for geb-bug-gnu-emacs@m.gmane.org; Sun, 30 Oct 2011 00:01:04 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:42794) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RKMZx-0004SZ-9n for bug-gnu-emacs@gnu.org; Sun, 30 Oct 2011 00:01:03 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RKMZu-0003Dc-Tl for bug-gnu-emacs@gnu.org; Sun, 30 Oct 2011 00:01:01 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:45545) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RKMZu-0003DY-Qb for bug-gnu-emacs@gnu.org; Sun, 30 Oct 2011 00:00:58 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.69) (envelope-from ) id 1RKMbt-0004ZW-KI for bug-gnu-emacs@gnu.org; Sun, 30 Oct 2011 00:03:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 30 Oct 2011 04:03:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 9907 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 9907-submit@debbugs.gnu.org id=B9907.131994733817524 (code B ref 9907); Sun, 30 Oct 2011 04:03:01 +0000 Original-Received: (at 9907) by debbugs.gnu.org; 30 Oct 2011 04:02:18 +0000 Original-Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RKMbB-0004YZ-1v for submit@debbugs.gnu.org; Sun, 30 Oct 2011 00:02:18 -0400 Original-Received: from ironport2-out.teksavvy.com ([206.248.154.183] helo=ironport2-out.pppoe.ca) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RKMb4-0004YO-VV for 9907@debbugs.gnu.org; Sun, 30 Oct 2011 00:02:13 -0400 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: Av0EAGvLrE5FxK2K/2dsb2JhbAA5CalpgQaBcgEBBAFWIwULCzQSFBgNJBMbh2excIVUgy4EoUSERQ X-IronPort-AV: E=Sophos;i="4.69,425,1315195200"; d="scan'208";a="145148844" Original-Received: from 69-196-173-138.dsl.teksavvy.com (HELO pastel.home) ([69.196.173.138]) by ironport2-out.pppoe.ca with ESMTP/TLS/ADH-AES256-SHA; 29 Oct 2011 23:59:43 -0400 Original-Received: by pastel.home (Postfix, from userid 20848) id D15B158E17; Sat, 29 Oct 2011 23:59:42 -0400 (EDT) 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") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.90 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list Resent-Date: Sun, 30 Oct 2011 00:03:01 -0400 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:53316 Archived-At: > 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 + + * 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 * 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