comparison lisp/eshell/esh-cmd.el @ 31241:3099993cba0f

See ChangeLog

31240:10b1c85c0bbe

	    (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

  (if (and (stringp (car terms))
	   (member (car terms) '("while" "until")))
      (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)))))

(defun eshell-rewrite-if-command (terms)
  "Rewrite an `if' command into its equivalent Eshell command form.
Because the implementation of `if' relies upon conditional

       (error
	(run-hooks 'eshell-this-command-hook)
	(eshell-errorn (error-message-string err))
	(eshell-close-handles 1)))))

(defmacro eshell-protect (object)
  "Protect I/O handles, so they aren't get closed after eval'ing OBJECT."
  `(progn
     (eshell-protect-handles eshell-current-handles)
     ,object))

(defmacro eshell-do-pipelines (pipeline)
  "Execute the commands in PIPELINE, connecting each to one another."
  (when (setq pipeline (cadr pipeline))
    `(let ((eshell-current-handles
	    (eshell-create-handles
	     (car (aref eshell-current-handles
			eshell-output-handle)) nil
	     (car (aref eshell-current-handles
			eshell-error-handle)) nil)))
       (progn
	 ,(when (cdr pipeline)
	    `(let (nextproc)
	       (progn
		 (set 'nextproc
		      (eshell-do-pipelines (quote ,(cdr pipeline))))
		 (eshell-set-output-handle ,eshell-output-handle
					   'append nextproc)
		 (eshell-set-output-handle ,eshell-error-handle
					   'append nextproc)
		 (set 'tailproc (or tailproc nextproc)))))
	 ,(let ((head (car pipeline)))
	    (if (memq (car head) '(let progn))
		(setq head (car (last head))))
	    (when (memq (car head) eshell-deferrable-commands)
	      (ignore
	       (setcar head
		       (intern-soft
			(concat (symbol-name (car head)) "*"))))))
	 ,(car pipeline)))))

(defalias 'eshell-process-identity 'identity)

(defmacro eshell-execute-pipeline (pipeline)
  "Execute the commands in PIPELINE, connecting each to one another."
  `(let ((eshell-in-pipeline-p t) tailproc)
     (progn
       (eshell-do-pipelines ,pipeline)
       (eshell-process-identity tailproc))))

(defmacro eshell-as-subcommand (command)
  "Execute COMMAND using a temp buffer.
This is used so that certain Lisp commands, such as `cd', when

	   (let ((buf (get-buffer-create "*eshell last cmd*")))
	     (set-buffer buf)
	     (erase-buffer)
	     (insert "command: \"" input "\"\n"))))
    (setq eshell-current-command command)
    (eshell-resume-eval)))

(defun eshell-resume-command (proc status)
  "Resume the current command when a process ends."
  (when proc
    (unless (or (string= "stopped" status)
		(string-match eshell-reset-signals status))
      (if (eq proc (eshell-interactive-process))
	  (eshell-resume-eval)))))

(defun eshell-resume-eval ()

		 (proc (catch 'eshell-defer
			 (ignore
			  (setq retval
				(eshell-do-eval
				 eshell-current-command))))))
	    (if proc
		(ignore (setq eshell-last-async-proc proc))
	      (cadr retval)))))
    (error
     (error (error-message-string err)))))

	;; `eshell-copy-tree' is needed here so that the test argument
	;; doesn't get modified and thus always yield the same result.
	(when (car eshell-command-body)
	  (assert (not synchronous-p))
	  (eshell-do-eval (car eshell-command-body))
	  (setcar eshell-command-body nil))
	(unless (car eshell-test-body)
	  (setcar eshell-test-body (eshell-copy-tree (car args))))
	(if (and (car eshell-test-body)
		 (not (eq (car eshell-test-body) 0)))
	    (while (cadr (eshell-do-eval (car eshell-test-body)))
	      (setcar eshell-test-body 0)
	      (setcar eshell-command-body (eshell-copy-tree (cadr args)))
	      (eshell-do-eval (car eshell-command-body) synchronous-p)
	      (setcar eshell-command-body nil)
	      (setcar eshell-test-body (eshell-copy-tree (car args)))))
	(setcar eshell-command-body nil))
       ((eq (car form) 'if)
	;; `eshell-copy-tree' is needed here so that the test argument
	;; doesn't get modified and thus always yield the same result.
	(when (car eshell-command-body)
	  (assert (not synchronous-p))
	  (eshell-do-eval (car eshell-command-body))
	  (setcar eshell-command-body nil))
	(unless (car eshell-test-body)
	  (setcar eshell-test-body (eshell-copy-tree (car args))))
	(if (and (car eshell-test-body)
		 (not (eq (car eshell-test-body) 0)))
	    (if (cadr (eshell-do-eval (car eshell-test-body)))
		(progn
		  (setcar eshell-test-body 0)
		  (setcar eshell-command-body (eshell-copy-tree (cadr args)))
		  (eshell-do-eval (car eshell-command-body) synchronous-p))
	      (setcar eshell-test-body 0)
	      (setcar eshell-command-body (eshell-copy-tree (car (cddr args))))
	      (eshell-do-eval (car eshell-command-body) synchronous-p)))
	(setcar eshell-command-body nil))
       ((eq (car form) 'setcar)
	(setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
	(eval form))
       ((eq (car form) 'setcdr)
	(setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))

		    (setcdr form (cdr new-form)))
		  (eshell-do-eval form synchronous-p))
	      (if (and (memq (car form) eshell-deferrable-commands)
		       (not eshell-current-subjob-p)
		       result
		       (processp result))
		  (if synchronous-p
		      (eshell/wait result)
		    (eshell-manipulate "inserting ignore form"
		      (setcar form 'ignore)
		      (setcdr form nil))

				  (describe-function sym)
				(message nil))))))
		(setq desc (substring desc 0
				      (1- (or (string-match "\n" desc)
					      (length desc)))))
		(kill-buffer "*Help*")
		(setq program (or desc name))))))
      (if (not program)
	  (eshell-error (format "which: no %s in (%s)\n"
				name (getenv "PATH")))
	(eshell-printn program)))))

31241:3099993cba0f

	    (list 'let
		  (list (list (intern (cadr terms))
			      (list 'car
				    (list 'symbol-value
					  (list 'quote 'for-items)))))
		  (list 'eshell-copy-handles
			 (eshell-invokify-arg body t)))
	    (list 'setcar 'for-items
		  (list 'cadr
			(list 'symbol-value
			      (list 'quote 'for-items))))
	    (list 'setcdr 'for-items

  (if (and (stringp (car terms))
	   (member (car terms) '("while" "until")))
      (eshell-structure-basic-command
       'while '("while" "until") (car terms)
       (eshell-invokify-arg (cadr terms) nil t)
       (list 'eshell-copy-handles
	     (eshell-invokify-arg (car (last terms)) t)))))

(defun eshell-rewrite-if-command (terms)
  "Rewrite an `if' command into its equivalent Eshell command form.
Because the implementation of `if' relies upon conditional

       (error
	(run-hooks 'eshell-this-command-hook)
	(eshell-errorn (error-message-string err))
	(eshell-close-handles 1)))))

;; (defun eshell-copy-or-protect-handles ()
;;   (if (eshell-processp (car (aref eshell-current-handles
;; 				  eshell-output-handle)))
;;       (eshell-protect-handles eshell-current-handles)
;;     (eshell-create-handles
;;      (car (aref eshell-current-handles
;; 		eshell-output-handle)) nil
;;      (car (aref eshell-current-handles
;; 		eshell-error-handle)) nil)))

;; (defmacro eshell-copy-handles (object)
;;   "Duplicate current I/O handles, so OBJECT works with its own copy."
;;   `(let ((eshell-current-handles (eshell-copy-or-protect-handles)))
;;      ,object))

(defmacro eshell-copy-handles (object)
  "Duplicate current I/O handles, so OBJECT works with its own copy."
  `(let ((eshell-current-handles
	  (eshell-create-handles
	   (car (aref eshell-current-handles
		      eshell-output-handle)) nil
	   (car (aref eshell-current-handles
		      eshell-error-handle)) nil)))
     ,object))

(defmacro eshell-protect (object)
  "Protect I/O handles, so they aren't get closed after eval'ing OBJECT."
  `(progn
     (eshell-protect-handles eshell-current-handles)
     ,object))

(defmacro eshell-do-pipelines (pipeline)
  "Execute the commands in PIPELINE, connecting each to one another."
  (when (setq pipeline (cadr pipeline))
    `(eshell-copy-handles
      (progn
	,(when (cdr pipeline)
	   `(let (nextproc)
	      (progn
		(set 'nextproc
		     (eshell-do-pipelines (quote ,(cdr pipeline))))
		(eshell-set-output-handle ,eshell-output-handle
					  'append nextproc)
		(eshell-set-output-handle ,eshell-error-handle
					  'append nextproc)
		(set 'tailproc (or tailproc nextproc)))))
	,(let ((head (car pipeline)))
	   (if (memq (car head) '(let progn))
	       (setq head (car (last head))))
	   (when (memq (car head) eshell-deferrable-commands)
	     (ignore
	      (setcar head
		      (intern-soft
		       (concat (symbol-name (car head)) "*"))))))
	,(car pipeline)))))

(defmacro eshell-do-pipelines-synchronously (pipeline)
  "Execute the commands in PIPELINE in sequence synchronously.
Output of each command is passed as input to the next one in the pipeline.
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))
		 (eshell-set-output-handle ,eshell-output-handle
					   'append output-marker)
		 (eshell-set-output-handle ,eshell-error-handle
					   'append output-marker))))
	 ,(let ((head (car pipeline)))
	    (if (memq (car head) '(let progn))
		(setq head (car (last head))))
	    ;;; FIXME: is deferrable significant here?
	    (when (memq (car head) eshell-deferrable-commands)
	      (ignore
	       (setcar head
		       (intern-soft
			(concat (symbol-name (car head)) "*"))))))
	 ;; The last process in the pipe should get its handles
	 ;; 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))
	 ;; tailproc gets the result of the last successful process in
	 ;; the pipeline.
	 (set 'tailproc (or result tailproc))
	 ,(if (cdr pipeline)
	      `(eshell-do-pipelines-synchronously (quote ,(cdr pipeline))))
	 result))))

(defalias 'eshell-process-identity 'identity)

(defmacro eshell-execute-pipeline (pipeline)
  "Execute the commands in PIPELINE, connecting each to one another."
  `(let ((eshell-in-pipeline-p t) tailproc)
     (progn
       ,(if (fboundp 'start-process)
	    `(eshell-do-pipelines ,pipeline)
	  `(let ((tail-handles (eshell-create-handles
				(car (aref eshell-current-handles
					   ,eshell-output-handle)) nil
				(car (aref eshell-current-handles
					   ,eshell-error-handle)) nil)))
	     (eshell-do-pipelines-synchronously ,pipeline)))
       (eshell-process-identity tailproc))))

(defmacro eshell-as-subcommand (command)
  "Execute COMMAND using a temp buffer.
This is used so that certain Lisp commands, such as `cd', when

	   (let ((buf (get-buffer-create "*eshell last cmd*")))
	     (set-buffer buf)
	     (erase-buffer)
	     (insert "command: \"" input "\"\n"))))
    (setq eshell-current-command command)
    (let ((delim (catch 'eshell-incomplete
		   (eshell-resume-eval))))
      (if delim
	  (error "Unmatched delimiter: %c"
		 (if (listp delim)
		     (car delim)
		   delim))))))

(defun eshell-resume-command (proc status)
  "Resume the current command when a process ends."
  (when proc
    (unless (or (not (stringp status))
		(string= "stopped" status)
		(string-match eshell-reset-signals status))
      (if (eq proc (eshell-interactive-process))
	  (eshell-resume-eval)))))

(defun eshell-resume-eval ()

		 (proc (catch 'eshell-defer
			 (ignore
			  (setq retval
				(eshell-do-eval
				 eshell-current-command))))))
	    (if (eshell-processp proc)
		(ignore (setq eshell-last-async-proc proc))
	      (cadr retval)))))
    (error
     (error (error-message-string err)))))

	;; `eshell-copy-tree' is needed here so that the test argument
	;; doesn't get modified and thus always yield the same result.
	(when (car eshell-command-body)
	  (assert (not synchronous-p))
	  (eshell-do-eval (car eshell-command-body))
	  (setcar eshell-command-body nil)
	  (setcar eshell-test-body nil))
	(unless (car eshell-test-body)
	  (setcar eshell-test-body (eshell-copy-tree (car args))))
	(while (cadr (eshell-do-eval (car eshell-test-body)))
	  (setcar eshell-command-body (eshell-copy-tree (cadr args)))
	  (eshell-do-eval (car eshell-command-body) synchronous-p)
	  (setcar eshell-command-body nil)
	  (setcar eshell-test-body (eshell-copy-tree (car args))))
	(setcar eshell-command-body nil))
       ((eq (car form) 'if)
	;; `eshell-copy-tree' is needed here so that the test argument
	;; doesn't get modified and thus always yield the same result.
	(if (car eshell-command-body)
	    (progn
	      (assert (not synchronous-p))
	      (eshell-do-eval (car eshell-command-body)))
	  (unless (car eshell-test-body)
	    (setcar eshell-test-body (eshell-copy-tree (car args))))
	  (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)))))
	  (eshell-do-eval (car eshell-command-body) synchronous-p))
	(setcar eshell-command-body nil)
	(setcar eshell-test-body nil))
       ((eq (car form) 'setcar)
	(setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
	(eval form))
       ((eq (car form) 'setcdr)
	(setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))

		    (setcdr form (cdr new-form)))
		  (eshell-do-eval form synchronous-p))
	      (if (and (memq (car form) eshell-deferrable-commands)
		       (not eshell-current-subjob-p)
		       result
		       (eshell-processp result))
		  (if synchronous-p
		      (eshell/wait result)
		    (eshell-manipulate "inserting ignore form"
		      (setcar form 'ignore)
		      (setcdr form nil))

				  (describe-function sym)
				(message nil))))))
		(setq desc (substring desc 0
				      (1- (or (string-match "\n" desc)
					      (length desc)))))
		(if (buffer-live-p (get-buffer "*Help*"))
		    (kill-buffer "*Help*"))
		(setq program (or desc name))))))
      (if (not program)
	  (eshell-error (format "which: no %s in (%s)\n"
				name (getenv "PATH")))
	(eshell-printn program)))))