Mercurial > emacs
comparison lisp/eshell/esh-cmd.el @ 31241:3099993cba0f
See ChangeLog
author | John Wiegley <johnw@newartisans.com> |
---|---|
date | Tue, 29 Aug 2000 00:47:45 +0000 |
parents | 0179b2540cf1 |
children | 8e57189d61b4 |
comparison
equal
deleted
inserted
replaced
31240:10b1c85c0bbe | 31241:3099993cba0f |
---|---|
514 (list 'let | 514 (list 'let |
515 (list (list (intern (cadr terms)) | 515 (list (list (intern (cadr terms)) |
516 (list 'car | 516 (list 'car |
517 (list 'symbol-value | 517 (list 'symbol-value |
518 (list 'quote 'for-items))))) | 518 (list 'quote 'for-items))))) |
519 (list 'eshell-protect | 519 (list 'eshell-copy-handles |
520 (eshell-invokify-arg body t))) | 520 (eshell-invokify-arg body t))) |
521 (list 'setcar 'for-items | 521 (list 'setcar 'for-items |
522 (list 'cadr | 522 (list 'cadr |
523 (list 'symbol-value | 523 (list 'symbol-value |
524 (list 'quote 'for-items)))) | 524 (list 'quote 'for-items)))) |
525 (list 'setcdr 'for-items | 525 (list 'setcdr 'for-items |
579 (if (and (stringp (car terms)) | 579 (if (and (stringp (car terms)) |
580 (member (car terms) '("while" "until"))) | 580 (member (car terms) '("while" "until"))) |
581 (eshell-structure-basic-command | 581 (eshell-structure-basic-command |
582 'while '("while" "until") (car terms) | 582 'while '("while" "until") (car terms) |
583 (eshell-invokify-arg (cadr terms) nil t) | 583 (eshell-invokify-arg (cadr terms) nil t) |
584 (list 'eshell-protect | 584 (list 'eshell-copy-handles |
585 (eshell-invokify-arg (car (last terms)) t))))) | 585 (eshell-invokify-arg (car (last terms)) t))))) |
586 | 586 |
587 (defun eshell-rewrite-if-command (terms) | 587 (defun eshell-rewrite-if-command (terms) |
588 "Rewrite an `if' command into its equivalent Eshell command form. | 588 "Rewrite an `if' command into its equivalent Eshell command form. |
589 Because the implementation of `if' relies upon conditional | 589 Because the implementation of `if' relies upon conditional |
768 (error | 768 (error |
769 (run-hooks 'eshell-this-command-hook) | 769 (run-hooks 'eshell-this-command-hook) |
770 (eshell-errorn (error-message-string err)) | 770 (eshell-errorn (error-message-string err)) |
771 (eshell-close-handles 1))))) | 771 (eshell-close-handles 1))))) |
772 | 772 |
773 ;; (defun eshell-copy-or-protect-handles () | |
774 ;; (if (eshell-processp (car (aref eshell-current-handles | |
775 ;; eshell-output-handle))) | |
776 ;; (eshell-protect-handles eshell-current-handles) | |
777 ;; (eshell-create-handles | |
778 ;; (car (aref eshell-current-handles | |
779 ;; eshell-output-handle)) nil | |
780 ;; (car (aref eshell-current-handles | |
781 ;; eshell-error-handle)) nil))) | |
782 | |
783 ;; (defmacro eshell-copy-handles (object) | |
784 ;; "Duplicate current I/O handles, so OBJECT works with its own copy." | |
785 ;; `(let ((eshell-current-handles (eshell-copy-or-protect-handles))) | |
786 ;; ,object)) | |
787 | |
788 (defmacro eshell-copy-handles (object) | |
789 "Duplicate current I/O handles, so OBJECT works with its own copy." | |
790 `(let ((eshell-current-handles | |
791 (eshell-create-handles | |
792 (car (aref eshell-current-handles | |
793 eshell-output-handle)) nil | |
794 (car (aref eshell-current-handles | |
795 eshell-error-handle)) nil))) | |
796 ,object)) | |
797 | |
773 (defmacro eshell-protect (object) | 798 (defmacro eshell-protect (object) |
774 "Protect I/O handles, so they aren't get closed after eval'ing OBJECT." | 799 "Protect I/O handles, so they aren't get closed after eval'ing OBJECT." |
775 `(progn | 800 `(progn |
776 (eshell-protect-handles eshell-current-handles) | 801 (eshell-protect-handles eshell-current-handles) |
777 ,object)) | 802 ,object)) |
778 | 803 |
779 (defmacro eshell-do-pipelines (pipeline) | 804 (defmacro eshell-do-pipelines (pipeline) |
780 "Execute the commands in PIPELINE, connecting each to one another." | 805 "Execute the commands in PIPELINE, connecting each to one another." |
781 (when (setq pipeline (cadr pipeline)) | 806 (when (setq pipeline (cadr pipeline)) |
782 `(let ((eshell-current-handles | 807 `(eshell-copy-handles |
783 (eshell-create-handles | 808 (progn |
784 (car (aref eshell-current-handles | 809 ,(when (cdr pipeline) |
785 eshell-output-handle)) nil | 810 `(let (nextproc) |
786 (car (aref eshell-current-handles | 811 (progn |
787 eshell-error-handle)) nil))) | 812 (set 'nextproc |
813 (eshell-do-pipelines (quote ,(cdr pipeline)))) | |
814 (eshell-set-output-handle ,eshell-output-handle | |
815 'append nextproc) | |
816 (eshell-set-output-handle ,eshell-error-handle | |
817 'append nextproc) | |
818 (set 'tailproc (or tailproc nextproc))))) | |
819 ,(let ((head (car pipeline))) | |
820 (if (memq (car head) '(let progn)) | |
821 (setq head (car (last head)))) | |
822 (when (memq (car head) eshell-deferrable-commands) | |
823 (ignore | |
824 (setcar head | |
825 (intern-soft | |
826 (concat (symbol-name (car head)) "*")))))) | |
827 ,(car pipeline))))) | |
828 | |
829 (defmacro eshell-do-pipelines-synchronously (pipeline) | |
830 "Execute the commands in PIPELINE in sequence synchronously. | |
831 Output of each command is passed as input to the next one in the pipeline. | |
832 This is used on systems where `start-process' is not supported." | |
833 (when (setq pipeline (cadr pipeline)) | |
834 `(let (result) | |
788 (progn | 835 (progn |
789 ,(when (cdr pipeline) | 836 ,(when (cdr pipeline) |
790 `(let (nextproc) | 837 `(let (output-marker) |
791 (progn | 838 (progn |
792 (set 'nextproc | 839 (set 'output-marker ,(point-marker)) |
793 (eshell-do-pipelines (quote ,(cdr pipeline)))) | |
794 (eshell-set-output-handle ,eshell-output-handle | 840 (eshell-set-output-handle ,eshell-output-handle |
795 'append nextproc) | 841 'append output-marker) |
796 (eshell-set-output-handle ,eshell-error-handle | 842 (eshell-set-output-handle ,eshell-error-handle |
797 'append nextproc) | 843 'append output-marker)))) |
798 (set 'tailproc (or tailproc nextproc))))) | |
799 ,(let ((head (car pipeline))) | 844 ,(let ((head (car pipeline))) |
800 (if (memq (car head) '(let progn)) | 845 (if (memq (car head) '(let progn)) |
801 (setq head (car (last head)))) | 846 (setq head (car (last head)))) |
847 ;;; FIXME: is deferrable significant here? | |
802 (when (memq (car head) eshell-deferrable-commands) | 848 (when (memq (car head) eshell-deferrable-commands) |
803 (ignore | 849 (ignore |
804 (setcar head | 850 (setcar head |
805 (intern-soft | 851 (intern-soft |
806 (concat (symbol-name (car head)) "*")))))) | 852 (concat (symbol-name (car head)) "*")))))) |
807 ,(car pipeline))))) | 853 ;; The last process in the pipe should get its handles |
854 ;; redirected as we found them before running the pipe. | |
855 ,(if (null (cdr pipeline)) | |
856 `(progn | |
857 (set 'eshell-current-handles tail-handles) | |
858 (set 'eshell-in-pipeline-p nil))) | |
859 (set 'result ,(car pipeline)) | |
860 ;; tailproc gets the result of the last successful process in | |
861 ;; the pipeline. | |
862 (set 'tailproc (or result tailproc)) | |
863 ,(if (cdr pipeline) | |
864 `(eshell-do-pipelines-synchronously (quote ,(cdr pipeline)))) | |
865 result)))) | |
808 | 866 |
809 (defalias 'eshell-process-identity 'identity) | 867 (defalias 'eshell-process-identity 'identity) |
810 | 868 |
811 (defmacro eshell-execute-pipeline (pipeline) | 869 (defmacro eshell-execute-pipeline (pipeline) |
812 "Execute the commands in PIPELINE, connecting each to one another." | 870 "Execute the commands in PIPELINE, connecting each to one another." |
813 `(let ((eshell-in-pipeline-p t) tailproc) | 871 `(let ((eshell-in-pipeline-p t) tailproc) |
814 (progn | 872 (progn |
815 (eshell-do-pipelines ,pipeline) | 873 ,(if (fboundp 'start-process) |
874 `(eshell-do-pipelines ,pipeline) | |
875 `(let ((tail-handles (eshell-create-handles | |
876 (car (aref eshell-current-handles | |
877 ,eshell-output-handle)) nil | |
878 (car (aref eshell-current-handles | |
879 ,eshell-error-handle)) nil))) | |
880 (eshell-do-pipelines-synchronously ,pipeline))) | |
816 (eshell-process-identity tailproc)))) | 881 (eshell-process-identity tailproc)))) |
817 | 882 |
818 (defmacro eshell-as-subcommand (command) | 883 (defmacro eshell-as-subcommand (command) |
819 "Execute COMMAND using a temp buffer. | 884 "Execute COMMAND using a temp buffer. |
820 This is used so that certain Lisp commands, such as `cd', when | 885 This is used so that certain Lisp commands, such as `cd', when |
917 (let ((buf (get-buffer-create "*eshell last cmd*"))) | 982 (let ((buf (get-buffer-create "*eshell last cmd*"))) |
918 (set-buffer buf) | 983 (set-buffer buf) |
919 (erase-buffer) | 984 (erase-buffer) |
920 (insert "command: \"" input "\"\n")))) | 985 (insert "command: \"" input "\"\n")))) |
921 (setq eshell-current-command command) | 986 (setq eshell-current-command command) |
922 (eshell-resume-eval))) | 987 (let ((delim (catch 'eshell-incomplete |
988 (eshell-resume-eval)))) | |
989 (if delim | |
990 (error "Unmatched delimiter: %c" | |
991 (if (listp delim) | |
992 (car delim) | |
993 delim)))))) | |
923 | 994 |
924 (defun eshell-resume-command (proc status) | 995 (defun eshell-resume-command (proc status) |
925 "Resume the current command when a process ends." | 996 "Resume the current command when a process ends." |
926 (when proc | 997 (when proc |
927 (unless (or (string= "stopped" status) | 998 (unless (or (not (stringp status)) |
999 (string= "stopped" status) | |
928 (string-match eshell-reset-signals status)) | 1000 (string-match eshell-reset-signals status)) |
929 (if (eq proc (eshell-interactive-process)) | 1001 (if (eq proc (eshell-interactive-process)) |
930 (eshell-resume-eval))))) | 1002 (eshell-resume-eval))))) |
931 | 1003 |
932 (defun eshell-resume-eval () | 1004 (defun eshell-resume-eval () |
939 (proc (catch 'eshell-defer | 1011 (proc (catch 'eshell-defer |
940 (ignore | 1012 (ignore |
941 (setq retval | 1013 (setq retval |
942 (eshell-do-eval | 1014 (eshell-do-eval |
943 eshell-current-command)))))) | 1015 eshell-current-command)))))) |
944 (if proc | 1016 (if (eshell-processp proc) |
945 (ignore (setq eshell-last-async-proc proc)) | 1017 (ignore (setq eshell-last-async-proc proc)) |
946 (cadr retval))))) | 1018 (cadr retval))))) |
947 (error | 1019 (error |
948 (error (error-message-string err))))) | 1020 (error (error-message-string err))))) |
949 | 1021 |
1017 ;; `eshell-copy-tree' is needed here so that the test argument | 1089 ;; `eshell-copy-tree' is needed here so that the test argument |
1018 ;; doesn't get modified and thus always yield the same result. | 1090 ;; doesn't get modified and thus always yield the same result. |
1019 (when (car eshell-command-body) | 1091 (when (car eshell-command-body) |
1020 (assert (not synchronous-p)) | 1092 (assert (not synchronous-p)) |
1021 (eshell-do-eval (car eshell-command-body)) | 1093 (eshell-do-eval (car eshell-command-body)) |
1022 (setcar eshell-command-body nil)) | 1094 (setcar eshell-command-body nil) |
1095 (setcar eshell-test-body nil)) | |
1023 (unless (car eshell-test-body) | 1096 (unless (car eshell-test-body) |
1024 (setcar eshell-test-body (eshell-copy-tree (car args)))) | 1097 (setcar eshell-test-body (eshell-copy-tree (car args)))) |
1025 (if (and (car eshell-test-body) | 1098 (while (cadr (eshell-do-eval (car eshell-test-body))) |
1026 (not (eq (car eshell-test-body) 0))) | 1099 (setcar eshell-command-body (eshell-copy-tree (cadr args))) |
1027 (while (cadr (eshell-do-eval (car eshell-test-body))) | 1100 (eshell-do-eval (car eshell-command-body) synchronous-p) |
1028 (setcar eshell-test-body 0) | 1101 (setcar eshell-command-body nil) |
1029 (setcar eshell-command-body (eshell-copy-tree (cadr args))) | 1102 (setcar eshell-test-body (eshell-copy-tree (car args)))) |
1030 (eshell-do-eval (car eshell-command-body) synchronous-p) | |
1031 (setcar eshell-command-body nil) | |
1032 (setcar eshell-test-body (eshell-copy-tree (car args))))) | |
1033 (setcar eshell-command-body nil)) | 1103 (setcar eshell-command-body nil)) |
1034 ((eq (car form) 'if) | 1104 ((eq (car form) 'if) |
1035 ;; `eshell-copy-tree' is needed here so that the test argument | 1105 ;; `eshell-copy-tree' is needed here so that the test argument |
1036 ;; doesn't get modified and thus always yield the same result. | 1106 ;; doesn't get modified and thus always yield the same result. |
1037 (when (car eshell-command-body) | 1107 (if (car eshell-command-body) |
1038 (assert (not synchronous-p)) | 1108 (progn |
1039 (eshell-do-eval (car eshell-command-body)) | 1109 (assert (not synchronous-p)) |
1040 (setcar eshell-command-body nil)) | 1110 (eshell-do-eval (car eshell-command-body))) |
1041 (unless (car eshell-test-body) | 1111 (unless (car eshell-test-body) |
1042 (setcar eshell-test-body (eshell-copy-tree (car args)))) | 1112 (setcar eshell-test-body (eshell-copy-tree (car args)))) |
1043 (if (and (car eshell-test-body) | 1113 (if (cadr (eshell-do-eval (car eshell-test-body))) |
1044 (not (eq (car eshell-test-body) 0))) | 1114 (setcar eshell-command-body (eshell-copy-tree (cadr args))) |
1045 (if (cadr (eshell-do-eval (car eshell-test-body))) | 1115 (setcar eshell-command-body (eshell-copy-tree (car (cddr args))))) |
1046 (progn | 1116 (eshell-do-eval (car eshell-command-body) synchronous-p)) |
1047 (setcar eshell-test-body 0) | 1117 (setcar eshell-command-body nil) |
1048 (setcar eshell-command-body (eshell-copy-tree (cadr args))) | 1118 (setcar eshell-test-body nil)) |
1049 (eshell-do-eval (car eshell-command-body) synchronous-p)) | |
1050 (setcar eshell-test-body 0) | |
1051 (setcar eshell-command-body (eshell-copy-tree (car (cddr args)))) | |
1052 (eshell-do-eval (car eshell-command-body) synchronous-p))) | |
1053 (setcar eshell-command-body nil)) | |
1054 ((eq (car form) 'setcar) | 1119 ((eq (car form) 'setcar) |
1055 (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p)) | 1120 (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p)) |
1056 (eval form)) | 1121 (eval form)) |
1057 ((eq (car form) 'setcdr) | 1122 ((eq (car form) 'setcdr) |
1058 (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p)) | 1123 (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p)) |
1129 (setcdr form (cdr new-form))) | 1194 (setcdr form (cdr new-form))) |
1130 (eshell-do-eval form synchronous-p)) | 1195 (eshell-do-eval form synchronous-p)) |
1131 (if (and (memq (car form) eshell-deferrable-commands) | 1196 (if (and (memq (car form) eshell-deferrable-commands) |
1132 (not eshell-current-subjob-p) | 1197 (not eshell-current-subjob-p) |
1133 result | 1198 result |
1134 (processp result)) | 1199 (eshell-processp result)) |
1135 (if synchronous-p | 1200 (if synchronous-p |
1136 (eshell/wait result) | 1201 (eshell/wait result) |
1137 (eshell-manipulate "inserting ignore form" | 1202 (eshell-manipulate "inserting ignore form" |
1138 (setcar form 'ignore) | 1203 (setcar form 'ignore) |
1139 (setcdr form nil)) | 1204 (setcdr form nil)) |
1170 (describe-function sym) | 1235 (describe-function sym) |
1171 (message nil)))))) | 1236 (message nil)))))) |
1172 (setq desc (substring desc 0 | 1237 (setq desc (substring desc 0 |
1173 (1- (or (string-match "\n" desc) | 1238 (1- (or (string-match "\n" desc) |
1174 (length desc))))) | 1239 (length desc))))) |
1175 (kill-buffer "*Help*") | 1240 (if (buffer-live-p (get-buffer "*Help*")) |
1241 (kill-buffer "*Help*")) | |
1176 (setq program (or desc name)))))) | 1242 (setq program (or desc name)))))) |
1177 (if (not program) | 1243 (if (not program) |
1178 (eshell-error (format "which: no %s in (%s)\n" | 1244 (eshell-error (format "which: no %s in (%s)\n" |
1179 name (getenv "PATH"))) | 1245 name (getenv "PATH"))) |
1180 (eshell-printn program))))) | 1246 (eshell-printn program))))) |