Add 2011 to FSF/AIST copyright years.
[bpt/emacs.git] / lisp / eshell / em-unix.el
CommitLineData
60370d40 1;;; em-unix.el --- UNIX command aliases
affbf647 2
3146b070 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
5df4f04c 4;; 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
affbf647 5
7de5b421
GM
6;; Author: John Wiegley <johnw@gnu.org>
7
affbf647
GM
8;; This file is part of GNU Emacs.
9
4ee57b2a 10;; GNU Emacs is free software: you can redistribute it and/or modify
affbf647 11;; it under the terms of the GNU General Public License as published by
4ee57b2a
GM
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
affbf647
GM
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
4ee57b2a 21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
affbf647 22
dbba8a04
GM
23;;; Commentary:
24
25;; This file contains implementations of several UNIX command in Emacs
26;; Lisp, for several reasons:
27;;
28;; 1) it makes them available on all platforms where the Lisp
29;; functions used are available
30;;
31;; 2) it makes their functionality accessible and modified by the
32;; Lisp programmer.
33;;
34;; 3) it allows Eshell to refrain from having to invoke external
35;; processes for common operations.
36
37;;; Code:
affbf647 38
8a1b4446 39(require 'eshell)
a09dc9bf
MA
40(require 'esh-opt)
41(require 'pcomplete)
affbf647 42
3146b070
GM
43;;;###autoload
44(eshell-defgroup eshell-unix nil
affbf647
GM
45 "This module defines many of the more common UNIX utilities as
46aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If
47the user passes arguments which are too complex, or are unrecognized
48by the Lisp variant, the external version will be called (if
49available). The only reason not to use them would be because they are
50usually much slower. But in several cases their tight integration
51with Eshell makes them more versatile than their traditional cousins
52\(such as being able to use `kill' to kill Eshell background processes
53by name)."
54 :tag "UNIX commands in Lisp"
55 :group 'eshell-module)
56
affbf647
GM
57(defcustom eshell-unix-load-hook '(eshell-unix-initialize)
58 "*A list of functions to run when `eshell-unix' is loaded."
59 :type 'hook
60 :group 'eshell-unix)
61
62(defcustom eshell-plain-grep-behavior nil
63 "*If non-nil, standalone \"grep\" commands will behave normally.
64Standalone in this context means not redirected, and not on the
65receiving side of a command pipeline."
66 :type 'boolean
67 :group 'eshell-unix)
68
69(defcustom eshell-no-grep-available (not (eshell-search-path "grep"))
70 "*If non-nil, no grep is available on the current machine."
71 :type 'boolean
72 :group 'eshell-unix)
73
74(defcustom eshell-plain-diff-behavior nil
75 "*If non-nil, standalone \"diff\" commands will behave normally.
76Standalone in this context means not redirected, and not on the
77receiving side of a command pipeline."
78 :type 'boolean
79 :group 'eshell-unix)
80
a3269bc4 81(defcustom eshell-plain-locate-behavior (featurep 'xemacs)
affbf647
GM
82 "*If non-nil, standalone \"locate\" commands will behave normally.
83Standalone in this context means not redirected, and not on the
84receiving side of a command pipeline."
85 :type 'boolean
86 :group 'eshell-unix)
87
88(defcustom eshell-rm-removes-directories nil
89 "*If non-nil, `rm' will remove directory entries.
90Otherwise, `rmdir' is required."
91 :type 'boolean
92 :group 'eshell-unix)
93
94(defcustom eshell-rm-interactive-query (= (user-uid) 0)
95 "*If non-nil, `rm' will query before removing anything."
96 :type 'boolean
97 :group 'eshell-unix)
98
99(defcustom eshell-mv-interactive-query (= (user-uid) 0)
100 "*If non-nil, `mv' will query before overwriting anything."
101 :type 'boolean
102 :group 'eshell-unix)
103
104(defcustom eshell-mv-overwrite-files t
105 "*If non-nil, `mv' will overwrite files without warning."
106 :type 'boolean
107 :group 'eshell-unix)
108
109(defcustom eshell-cp-interactive-query (= (user-uid) 0)
110 "*If non-nil, `cp' will query before overwriting anything."
111 :type 'boolean
112 :group 'eshell-unix)
113
114(defcustom eshell-cp-overwrite-files t
115 "*If non-nil, `cp' will overwrite files without warning."
116 :type 'boolean
117 :group 'eshell-unix)
118
119(defcustom eshell-ln-interactive-query (= (user-uid) 0)
120 "*If non-nil, `ln' will query before overwriting anything."
121 :type 'boolean
122 :group 'eshell-unix)
123
ca7aae91 124(defcustom eshell-ln-overwrite-files nil
affbf647
GM
125 "*If non-nil, `ln' will overwrite files without warning."
126 :type 'boolean
127 :group 'eshell-unix)
128
dace60cf
JW
129(defcustom eshell-default-target-is-dot nil
130 "*If non-nil, the default destination for cp, mv or ln is `.'."
131 :type 'boolean
132 :group 'eshell-unix)
133
8c6b1d83
JW
134(defcustom eshell-du-prefer-over-ange nil
135 "*Use Eshell's du in ange-ftp remote directories.
1ef49fc6 136Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine."
8c6b1d83
JW
137 :type 'boolean
138 :group 'eshell-unix)
139
affbf647
GM
140;;; Functions:
141
142(defun eshell-unix-initialize ()
143 "Initialize the UNIX support/emulation code."
affbf647 144 (when (eshell-using-module 'eshell-cmpl)
affbf647 145 (add-hook 'pcomplete-try-first-hook
dace60cf
JW
146 'eshell-complete-host-reference nil t))
147 (make-local-variable 'eshell-complex-commands)
148 (setq eshell-complex-commands
149 (append '("grep" "egrep" "fgrep" "agrep" "glimpse" "locate"
3ba30eb8 150 "cat" "time" "cp" "mv" "make" "du" "diff" "su" "sudo")
dace60cf 151 eshell-complex-commands)))
affbf647
GM
152
153(defalias 'eshell/date 'current-time-string)
154(defalias 'eshell/basename 'file-name-nondirectory)
155(defalias 'eshell/dirname 'file-name-directory)
156
1a32899d
GM
157(defvar interactive)
158(defvar preview)
159(defvar recursive)
160(defvar verbose)
affbf647
GM
161
162(defun eshell/man (&rest args)
163 "Invoke man, flattening the arguments appropriately."
164 (funcall 'man (apply 'eshell-flatten-and-stringify args)))
165
127fd3c2
JW
166(put 'eshell/man 'eshell-no-numeric-conversions t)
167
4596901f 168(defun eshell/info (&rest args)
08011be5 169 "Run the info command in-frame with the same behavior as command-line `info', ie:
4596901f
GM
170 'info' => goes to top info window
171 'info arg1' => IF arg1 is a file, then visits arg1
172 'info arg1' => OTHERWISE goes to top info window and then menu item arg1
173 'info arg1 arg2' => does action for arg1 (either visit-file or menu-item) and then menu item arg2
174 etc."
2f42c75f 175 (eval-and-compile (require 'info))
4596901f
GM
176 (let ((file (cond
177 ((not (stringp (car args)))
178 nil)
179 ((file-exists-p (expand-file-name (car args)))
180 (expand-file-name (car args)))
181 ((file-exists-p (concat (expand-file-name (car args)) ".info"))
182 (concat (expand-file-name (car args)) ".info")))))
183
184 ;; If the first arg is a file, then go to that file's Top node
185 ;; Otherwise, go to the global directory
186 (if file
187 (progn
188 (setq args (cdr args))
189 (Info-find-node file "Top"))
190 (Info-directory))
191
192 ;; Treat all remaining args as menu references
193 (while args
194 (Info-menu (car args))
195 (setq args (cdr args)))))
196
affbf647 197(defun eshell-remove-entries (path files &optional top-level)
dace60cf 198 "From PATH, remove all of the given FILES, perhaps interactively."
affbf647
GM
199 (while files
200 (if (string-match "\\`\\.\\.?\\'"
201 (file-name-nondirectory (car files)))
202 (if top-level
203 (eshell-error "rm: cannot remove `.' or `..'\n"))
204 (if (and (file-directory-p (car files))
205 (not (file-symlink-p (car files))))
206 (let ((dir (file-name-as-directory (car files))))
207 (eshell-remove-entries dir
208 (mapcar
209 (function
210 (lambda (file)
211 (concat dir file)))
212 (directory-files dir)))
213 (if verbose
214 (eshell-printn (format "rm: removing directory `%s'"
215 (car files))))
216 (unless
217 (or preview
218 (and interactive
219 (not (y-or-n-p
220 (format "rm: remove directory `%s'? "
221 (car files))))))
222 (eshell-funcalln 'delete-directory (car files))))
223 (if verbose
224 (eshell-printn (format "rm: removing file `%s'"
225 (car files))))
226 (unless (or preview
227 (and interactive
228 (not (y-or-n-p
229 (format "rm: remove `%s'? "
230 (car files))))))
231 (eshell-funcalln 'delete-file (car files)))))
232 (setq files (cdr files))))
233
234(defun eshell/rm (&rest args)
235 "Implementation of rm in Lisp.
236This is implemented to call either `delete-file', `kill-buffer',
237`kill-process', or `unintern', depending on the nature of the
238argument."
239 (setq args (eshell-flatten-list args))
240 (eshell-eval-using-options
241 "rm" args
242 '((?h "help" nil nil "show this usage screen")
243 (?f "force" nil force-removal "force removal")
244 (?i "interactive" nil interactive "prompt before any removal")
245 (?n "preview" nil preview "don't change anything on disk")
246 (?r "recursive" nil recursive
247 "remove the contents of directories recursively")
248 (?R nil nil recursive "(same)")
249 (?v "verbose" nil verbose "explain what is being done")
250 :preserve-args
251 :external "rm"
252 :show-usage
253 :usage "[OPTION]... FILE...
254Remove (unlink) the FILE(s).")
255 (unless interactive
256 (setq interactive eshell-rm-interactive-query))
257 (if (and force-removal interactive)
258 (setq interactive nil))
259 (while args
260 (let ((entry (if (stringp (car args))
261 (directory-file-name (car args))
262 (if (numberp (car args))
263 (number-to-string (car args))
264 (car args)))))
265 (cond
266 ((bufferp entry)
267 (if verbose
268 (eshell-printn (format "rm: removing buffer `%s'" entry)))
269 (unless (or preview
270 (and interactive
271 (not (y-or-n-p (format "rm: delete buffer `%s'? "
272 entry)))))
273 (eshell-funcalln 'kill-buffer entry)))
ca7aae91 274 ((eshell-processp entry)
affbf647
GM
275 (if verbose
276 (eshell-printn (format "rm: killing process `%s'" entry)))
277 (unless (or preview
278 (and interactive
279 (not (y-or-n-p (format "rm: kill process `%s'? "
280 entry)))))
281 (eshell-funcalln 'kill-process entry)))
282 ((symbolp entry)
283 (if verbose
284 (eshell-printn (format "rm: uninterning symbol `%s'" entry)))
285 (unless
286 (or preview
287 (and interactive
288 (not (y-or-n-p (format "rm: unintern symbol `%s'? "
289 entry)))))
290 (eshell-funcalln 'unintern entry)))
291 ((stringp entry)
292 (if (and (file-directory-p entry)
293 (not (file-symlink-p entry)))
294 (if (or recursive
295 eshell-rm-removes-directories)
296 (if (or preview
297 (not interactive)
298 (y-or-n-p
299 (format "rm: descend into directory `%s'? "
300 entry)))
301 (eshell-remove-entries nil (list entry) t))
302 (eshell-error (format "rm: %s: is a directory\n" entry)))
303 (eshell-remove-entries nil (list entry) t)))))
304 (setq args (cdr args)))
305 nil))
306
127fd3c2
JW
307(put 'eshell/rm 'eshell-no-numeric-conversions t)
308
affbf647
GM
309(defun eshell/mkdir (&rest args)
310 "Implementation of mkdir in Lisp."
311 (eshell-eval-using-options
312 "mkdir" args
313 '((?h "help" nil nil "show this usage screen")
314 :external "mkdir"
315 :show-usage
316 :usage "[OPTION] DIRECTORY...
317Create the DIRECTORY(ies), if they do not already exist.")
318 (while args
319 (eshell-funcalln 'make-directory (car args))
320 (setq args (cdr args)))
321 nil))
322
127fd3c2
JW
323(put 'eshell/mkdir 'eshell-no-numeric-conversions t)
324
affbf647
GM
325(defun eshell/rmdir (&rest args)
326 "Implementation of rmdir in Lisp."
327 (eshell-eval-using-options
328 "rmdir" args
329 '((?h "help" nil nil "show this usage screen")
330 :external "rmdir"
331 :show-usage
332 :usage "[OPTION] DIRECTORY...
333Remove the DIRECTORY(ies), if they are empty.")
334 (while args
335 (eshell-funcalln 'delete-directory (car args))
336 (setq args (cdr args)))
337 nil))
338
127fd3c2
JW
339(put 'eshell/rmdir 'eshell-no-numeric-conversions t)
340
1a32899d
GM
341(defvar no-dereference)
342(defvar preview)
343(defvar verbose)
affbf647
GM
344
345(defvar eshell-warn-dot-directories t)
346
347(defun eshell-shuffle-files (command action files target func deep &rest args)
348 "Shuffle around some filesystem entries, using FUNC to do the work."
8c6b1d83 349 (let ((attr-target (eshell-file-attributes target))
affbf647
GM
350 (is-dir (or (file-directory-p target)
351 (and preview (not eshell-warn-dot-directories))))
352 attr)
353 (if (and (not preview) (not is-dir)
354 (> (length files) 1))
355 (error "%s: when %s multiple files, last argument must be a directory"
356 command action))
357 (while files
358 (setcar files (directory-file-name (car files)))
359 (cond
360 ((string-match "\\`\\.\\.?\\'"
361 (file-name-nondirectory (car files)))
362 (if eshell-warn-dot-directories
363 (eshell-error (format "%s: %s: omitting directory\n"
364 command (car files)))))
365 ((and attr-target
662cf9d7
EZ
366 (or (not (eshell-under-windows-p))
367 (eq system-type 'ms-dos))
8c6b1d83
JW
368 (setq attr (eshell-file-attributes (car files)))
369 (nth 10 attr-target) (nth 10 attr)
c3ea2deb
EZ
370 ;; Use equal, not -, since the inode and the device could
371 ;; cons cells.
1f9581b6 372 (equal (nth 10 attr-target) (nth 10 attr))
8c6b1d83 373 (nth 11 attr-target) (nth 11 attr)
c3ea2deb 374 (equal (nth 11 attr-target) (nth 11 attr)))
affbf647
GM
375 (eshell-error (format "%s: `%s' and `%s' are the same file\n"
376 command (car files) target)))
377 (t
378 (let ((source (car files))
379 (target (if is-dir
380 (expand-file-name
381 (file-name-nondirectory (car files)) target)
382 target))
383 link)
384 (if (and (file-directory-p source)
385 (or (not no-dereference)
386 (not (file-symlink-p source)))
387 (not (memq func '(make-symbolic-link
388 add-name-to-file))))
389 (if (and (eq func 'copy-file)
390 (not recursive))
391 (eshell-error (format "%s: %s: omitting directory\n"
392 command (car files)))
393 (let (eshell-warn-dot-directories)
394 (if (and (not deep)
395 (eq func 'rename-file)
c3ea2deb
EZ
396 ;; Use equal, since the device might be a
397 ;; cons cell.
398 (equal (nth 11 (eshell-file-attributes
399 (file-name-directory
400 (directory-file-name
401 (expand-file-name source)))))
402 (nth 11 (eshell-file-attributes
403 (file-name-directory
404 (directory-file-name
405 (expand-file-name target)))))))
affbf647
GM
406 (apply 'eshell-funcalln func source target args)
407 (unless (file-directory-p target)
408 (if verbose
409 (eshell-printn
410 (format "%s: making directory %s"
411 command target)))
412 (unless preview
413 (eshell-funcalln 'make-directory target)))
ca7aae91
JW
414 (apply 'eshell-shuffle-files
415 command action
416 (mapcar
417 (function
418 (lambda (file)
419 (concat source "/" file)))
420 (directory-files source))
421 target func t args)
affbf647
GM
422 (when (eq func 'rename-file)
423 (if verbose
424 (eshell-printn
425 (format "%s: deleting directory %s"
426 command source)))
427 (unless preview
428 (eshell-funcalln 'delete-directory source))))))
429 (if verbose
430 (eshell-printn (format "%s: %s -> %s" command
431 source target)))
432 (unless preview
433 (if (and no-dereference
434 (setq link (file-symlink-p source)))
435 (progn
436 (apply 'eshell-funcalln 'make-symbolic-link
437 link target args)
438 (if (eq func 'rename-file)
439 (if (and (file-directory-p source)
440 (not (file-symlink-p source)))
441 (eshell-funcalln 'delete-directory source)
442 (eshell-funcalln 'delete-file source))))
443 (apply 'eshell-funcalln func source target args)))))))
444 (setq files (cdr files)))))
445
446(defun eshell-shorthand-tar-command (command args)
447 "Rewrite `cp -v dir a.tar.gz' to `tar cvzf a.tar.gz dir'."
448 (let* ((archive (car (last args)))
449 (tar-args
450 (cond ((string-match "z2" archive) "If")
451 ((string-match "gz" archive) "zf")
452 ((string-match "\\(az\\|Z\\)" archive) "Zf")
453 (t "f"))))
454 (if (file-exists-p archive)
455 (setq tar-args (concat "u" tar-args))
456 (setq tar-args (concat "c" tar-args)))
457 (if verbose
458 (setq tar-args (concat "v" tar-args)))
459 (if (equal command "mv")
460 (setq tar-args (concat "--remove-files -" tar-args)))
461 ;; truncate the archive name from the arguments
462 (setcdr (last args 2) nil)
463 (throw 'eshell-replace-command
464 (eshell-parse-command
465 (format "tar %s %s" tar-args archive) args))))
466
467;; this is to avoid duplicating code...
dace60cf
JW
468(defmacro eshell-mvcpln-template (command action func query-var
469 force-var &optional preserve)
470 `(let ((len (length args)))
471 (if (or (= len 0)
472 (and (= len 1) (null eshell-default-target-is-dot)))
473 (error "%s: missing destination file or directory" ,command))
474 (if (= len 1)
475 (nconc args '(".")))
476 (setq args (eshell-stringify-list (eshell-flatten-list args)))
477 (if (and ,(not (equal command "ln"))
478 (string-match eshell-tar-regexp (car (last args)))
479 (or (> (length args) 2)
480 (and (file-directory-p (car args))
481 (or (not no-dereference)
482 (not (file-symlink-p (car args)))))))
483 (eshell-shorthand-tar-command ,command args)
484 (let ((target (car (last args)))
485 ange-cache)
486 (setcdr (last args 2) nil)
487 (eshell-shuffle-files
488 ,command ,action args target ,func nil
489 ,@(append
490 `((if (and (or interactive
491 ,query-var)
492 (not force))
493 1 (or force ,force-var)))
494 (if preserve
495 (list preserve)))))
496 nil)))
affbf647
GM
497
498(defun eshell/mv (&rest args)
499 "Implementation of mv in Lisp."
500 (eshell-eval-using-options
501 "mv" args
502 '((?f "force" nil force
503 "remove existing destinations, never prompt")
504 (?i "interactive" nil interactive
505 "request confirmation if target already exists")
506 (?n "preview" nil preview
507 "don't change anything on disk")
508 (?v "verbose" nil verbose
509 "explain what is being done")
510 (nil "help" nil nil "show this usage screen")
dace60cf 511 :preserve-args
affbf647
GM
512 :external "mv"
513 :show-usage
514 :usage "[OPTION]... SOURCE DEST
515 or: mv [OPTION]... SOURCE... DIRECTORY
516Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
517\[OPTION] DIRECTORY...")
518 (let ((no-dereference t))
dace60cf
JW
519 (eshell-mvcpln-template "mv" "moving" 'rename-file
520 eshell-mv-interactive-query
521 eshell-mv-overwrite-files))))
affbf647 522
127fd3c2
JW
523(put 'eshell/mv 'eshell-no-numeric-conversions t)
524
affbf647
GM
525(defun eshell/cp (&rest args)
526 "Implementation of cp in Lisp."
527 (eshell-eval-using-options
528 "cp" args
529 '((?a "archive" nil archive
530 "same as -dpR")
531 (?d "no-dereference" nil no-dereference
532 "preserve links")
533 (?f "force" nil force
534 "remove existing destinations, never prompt")
535 (?i "interactive" nil interactive
536 "request confirmation if target already exists")
537 (?n "preview" nil preview
538 "don't change anything on disk")
539 (?p "preserve" nil preserve
540 "preserve file attributes if possible")
541 (?R "recursive" nil recursive
542 "copy directories recursively")
543 (?v "verbose" nil verbose
544 "explain what is being done")
545 (nil "help" nil nil "show this usage screen")
dace60cf 546 :preserve-args
affbf647
GM
547 :external "cp"
548 :show-usage
549 :usage "[OPTION]... SOURCE DEST
550 or: cp [OPTION]... SOURCE... DIRECTORY
551Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
552 (if archive
553 (setq preserve t no-dereference t recursive t))
dace60cf
JW
554 (eshell-mvcpln-template "cp" "copying" 'copy-file
555 eshell-cp-interactive-query
556 eshell-cp-overwrite-files preserve)))
affbf647 557
127fd3c2
JW
558(put 'eshell/cp 'eshell-no-numeric-conversions t)
559
affbf647
GM
560(defun eshell/ln (&rest args)
561 "Implementation of ln in Lisp."
562 (eshell-eval-using-options
563 "ln" args
564 '((?h "help" nil nil "show this usage screen")
565 (?s "symbolic" nil symbolic
566 "make symbolic links instead of hard links")
dace60cf
JW
567 (?i "interactive" nil interactive
568 "request confirmation if target already exists")
affbf647
GM
569 (?f "force" nil force "remove existing destinations, never prompt")
570 (?n "preview" nil preview
571 "don't change anything on disk")
572 (?v "verbose" nil verbose "explain what is being done")
dace60cf 573 :preserve-args
affbf647
GM
574 :external "ln"
575 :show-usage
576 :usage "[OPTION]... TARGET [LINK_NAME]
577 or: ln [OPTION]... TARGET... DIRECTORY
578Create a link to the specified TARGET with optional LINK_NAME. If there is
579more than one TARGET, the last argument must be a directory; create links
580in DIRECTORY to each TARGET. Create hard links by default, symbolic links
581with '--symbolic'. When creating hard links, each TARGET must exist.")
dace60cf
JW
582 (let ((no-dereference t))
583 (eshell-mvcpln-template "ln" "linking"
584 (if symbolic
585 'make-symbolic-link
586 'add-name-to-file)
587 eshell-ln-interactive-query
588 eshell-ln-overwrite-files))))
affbf647 589
127fd3c2
JW
590(put 'eshell/ln 'eshell-no-numeric-conversions t)
591
affbf647 592(defun eshell/cat (&rest args)
8c6b1d83
JW
593 "Implementation of cat in Lisp.
594If in a pipeline, or the file is not a regular file, directory or
595symlink, then revert to the system's definition of cat."
dace60cf 596 (setq args (eshell-stringify-list (eshell-flatten-list args)))
8c6b1d83
JW
597 (if (or eshell-in-pipeline-p
598 (catch 'special
599 (eshell-for arg args
9f89e098
JW
600 (unless (or (and (stringp arg)
601 (> (length arg) 0)
602 (eq (aref arg 0) ?-))
603 (let ((attrs (eshell-file-attributes arg)))
604 (and attrs (memq (aref (nth 8 attrs) 0)
605 '(?d ?l ?-)))))
8c6b1d83
JW
606 (throw 'special t)))))
607 (let ((ext-cat (eshell-search-path "cat")))
608 (if ext-cat
609 (throw 'eshell-replace-command
610 (eshell-parse-command ext-cat args))
611 (if eshell-in-pipeline-p
612 (error "Eshell's `cat' does not work in pipelines")
613 (error "Eshell's `cat' cannot display one of the files given"))))
affbf647
GM
614 (eshell-init-print-buffer)
615 (eshell-eval-using-options
616 "cat" args
617 '((?h "help" nil nil "show this usage screen")
618 :external "cat"
619 :show-usage
620 :usage "[OPTION] FILE...
621Concatenate FILE(s), or standard input, to standard output.")
622 (eshell-for file args
623 (if (string= file "-")
624 (throw 'eshell-external
625 (eshell-external-command "cat" args))))
626 (let ((curbuf (current-buffer)))
627 (eshell-for file args
628 (with-temp-buffer
629 (insert-file-contents file)
630 (goto-char (point-min))
631 (while (not (eobp))
632 (let ((str (buffer-substring
633 (point) (min (1+ (line-end-position))
634 (point-max)))))
635 (with-current-buffer curbuf
636 (eshell-buffered-print str)))
637 (forward-line)))))
638 (eshell-flush)
639 ;; if the file does not end in a newline, do not emit one
640 (setq eshell-ensure-newline-p nil))))
641
127fd3c2
JW
642(put 'eshell/cat 'eshell-no-numeric-conversions t)
643
affbf647
GM
644;; special front-end functions for compilation-mode buffers
645
646(defun eshell/make (&rest args)
647 "Use `compile' to do background makes."
648 (if (and eshell-current-subjob-p
649 (eshell-interactive-output-p))
650 (let ((compilation-process-setup-function
651 (list 'lambda nil
652 (list 'setq 'process-environment
653 (list 'quote (eshell-copy-environment))))))
654 (compile (concat "make " (eshell-flatten-and-stringify args))))
655 (throw 'eshell-replace-command
dace60cf
JW
656 (eshell-parse-command "*make" (eshell-stringify-list
657 (eshell-flatten-list args))))))
affbf647 658
127fd3c2
JW
659(put 'eshell/make 'eshell-no-numeric-conversions t)
660
affbf647
GM
661(defun eshell-occur-mode-goto-occurrence ()
662 "Go to the occurrence the current line describes."
663 (interactive)
664 (let ((pos (occur-mode-find-occurrence)))
665 (pop-to-buffer (marker-buffer pos))
666 (goto-char (marker-position pos))))
667
668(defun eshell-occur-mode-mouse-goto (event)
669 "In Occur mode, go to the occurrence whose line you click on."
670 (interactive "e")
2f552813 671 (let (pos)
937e6a56 672 (with-current-buffer (window-buffer (posn-window (event-end event)))
affbf647
GM
673 (save-excursion
674 (goto-char (posn-point (event-end event)))
2f552813 675 (setq pos (occur-mode-find-occurrence))))
affbf647
GM
676 (pop-to-buffer (marker-buffer pos))
677 (goto-char (marker-position pos))))
678
679(defun eshell-poor-mans-grep (args)
680 "A poor version of grep that opens every file and uses `occur'.
681This eats up memory, since it leaves the buffers open (to speed future
682searches), and it's very slow. But, if your system has no grep
683available..."
684 (save-selected-window
685 (let ((default-dir default-directory))
686 (with-current-buffer (get-buffer-create "*grep*")
687 (let ((inhibit-read-only t)
688 (default-directory default-dir))
689 (erase-buffer)
690 (occur-mode)
dace60cf
JW
691 (let ((files (eshell-stringify-list
692 (eshell-flatten-list (cdr args))))
affbf647
GM
693 (inhibit-redisplay t)
694 string)
695 (when (car args)
696 (if (get-buffer "*Occur*")
697 (kill-buffer (get-buffer "*Occur*")))
698 (setq string nil)
699 (while files
700 (with-current-buffer (find-file-noselect (car files))
701 (save-excursion
702 (ignore-errors
703 (occur (car args))))
704 (if (get-buffer "*Occur*")
705 (with-current-buffer (get-buffer "*Occur*")
706 (setq string (buffer-string))
707 (kill-buffer (current-buffer)))))
708 (if string (insert string))
709 (setq string nil
710 files (cdr files)))))
affbf647
GM
711 (local-set-key [mouse-2] 'eshell-occur-mode-mouse-goto)
712 (local-set-key [(control ?c) (control ?c)]
713 'eshell-occur-mode-goto-occurrence)
714 (local-set-key [(control ?m)]
715 'eshell-occur-mode-goto-occurrence)
716 (local-set-key [return] 'eshell-occur-mode-goto-occurrence)
717 (pop-to-buffer (current-buffer) t)
718 (goto-char (point-min))
719 (resize-temp-buffer-window))))))
720
721(defun eshell-grep (command args &optional maybe-use-occur)
722 "Generic service function for the various grep aliases.
723It calls Emacs' grep utility if the command is not redirecting output,
724and if it's not part of a command pipeline. Otherwise, it calls the
725external command."
726 (if (and maybe-use-occur eshell-no-grep-available)
727 (eshell-poor-mans-grep args)
728 (if (or eshell-plain-grep-behavior
729 (not (and (eshell-interactive-output-p)
730 (not eshell-in-pipeline-p)
731 (not eshell-in-subcommand-p))))
732 (throw 'eshell-replace-command
ca7aae91 733 (eshell-parse-command (concat "*" command)
dace60cf
JW
734 (eshell-stringify-list
735 (eshell-flatten-list args))))
fcb5aa97 736 (let* ((args (mapconcat 'identity
affbf647 737 (mapcar 'shell-quote-argument
dace60cf
JW
738 (eshell-stringify-list
739 (eshell-flatten-list args)))
affbf647
GM
740 " "))
741 (cmd (progn
742 (set-text-properties 0 (length args)
743 '(invisible t) args)
744 (format "%s -n %s" command args)))
745 compilation-scroll-output)
746 (grep cmd)))))
747
748(defun eshell/grep (&rest args)
749 "Use Emacs grep facility instead of calling external grep."
750 (eshell-grep "grep" args t))
751
752(defun eshell/egrep (&rest args)
753 "Use Emacs grep facility instead of calling external egrep."
754 (eshell-grep "egrep" args t))
755
756(defun eshell/fgrep (&rest args)
757 "Use Emacs grep facility instead of calling external fgrep."
758 (eshell-grep "fgrep" args t))
759
760(defun eshell/agrep (&rest args)
761 "Use Emacs grep facility instead of calling external agrep."
762 (eshell-grep "agrep" args))
763
764(defun eshell/glimpse (&rest args)
765 "Use Emacs grep facility instead of calling external glimpse."
766 (let (null-device)
767 (eshell-grep "glimpse" (append '("-z" "-y") args))))
768
769;; completions rules for some common UNIX commands
770
771(defsubst eshell-complete-hostname ()
772 "Complete a command that wants a hostname for an argument."
773 (pcomplete-here (eshell-read-host-names)))
774
775(defun eshell-complete-host-reference ()
776 "If there is a host reference, complete it."
777 (let ((arg (pcomplete-actual-arg))
778 index)
779 (when (setq index (string-match "@[a-z.]*\\'" arg))
780 (setq pcomplete-stub (substring arg (1+ index))
781 pcomplete-last-completion-raw t)
782 (throw 'pcomplete-completions (eshell-read-host-names)))))
783
784(defalias 'pcomplete/ftp 'eshell-complete-hostname)
785(defalias 'pcomplete/ncftp 'eshell-complete-hostname)
786(defalias 'pcomplete/ping 'eshell-complete-hostname)
787(defalias 'pcomplete/rlogin 'eshell-complete-hostname)
788
789(defun pcomplete/telnet ()
790 (require 'pcmpl-unix)
791 (pcomplete-opt "xl(pcmpl-unix-user-names)")
792 (eshell-complete-hostname))
793
794(defun pcomplete/rsh ()
795 "Complete `rsh', which, after the user and hostname, is like xargs."
796 (require 'pcmpl-unix)
797 (pcomplete-opt "l(pcmpl-unix-user-names)")
798 (eshell-complete-hostname)
799 (pcomplete-here (funcall pcomplete-command-completion-function))
800 (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
801 pcomplete-default-completion-function)))
802
803(defalias 'pcomplete/ssh 'pcomplete/rsh)
804
1a32899d
GM
805(defvar block-size)
806(defvar by-bytes)
807(defvar dereference-links)
808(defvar grand-total)
809(defvar human-readable)
810(defvar max-depth)
811(defvar only-one-filesystem)
812(defvar show-all)
affbf647
GM
813
814(defsubst eshell-du-size-string (size)
815 (let* ((str (eshell-printable-size size human-readable block-size t))
816 (len (length str)))
817 (concat str (if (< len 8)
818 (make-string (- 8 len) ? )))))
819
820(defun eshell-du-sum-directory (path depth)
821 "Summarize PATH, and its member directories."
822 (let ((entries (eshell-directory-files-and-attributes path))
823 (size 0.0))
824 (while entries
825 (unless (string-match "\\`\\.\\.?\\'" (caar entries))
3e020e02 826 (let* ((entry (concat path "/"
affbf647
GM
827 (caar entries)))
828 (symlink (and (stringp (cadr (car entries)))
829 (cadr (car entries)))))
830 (unless (or (and symlink (not dereference-links))
831 (and only-one-filesystem
ca7aae91
JW
832 (/= only-one-filesystem
833 (nth 12 (car entries)))))
affbf647
GM
834 (if symlink
835 (setq entry symlink))
836 (setq size
837 (+ size
838 (if (eq t (cadr (car entries)))
839 (eshell-du-sum-directory entry (1+ depth))
840 (let ((file-size (nth 8 (car entries))))
841 (prog1
842 file-size
843 (if show-all
844 (eshell-print
845 (concat (eshell-du-size-string file-size)
846 entry "\n")))))))))))
847 (setq entries (cdr entries)))
848 (if (or (not max-depth)
849 (= depth max-depth)
850 (= depth 0))
851 (eshell-print (concat (eshell-du-size-string size)
852 (directory-file-name path) "\n")))
853 size))
854
855(defun eshell/du (&rest args)
ca7aae91 856 "Implementation of \"du\" in Lisp, passing ARGS."
8c6b1d83 857 (setq args (if args
dace60cf 858 (eshell-stringify-list (eshell-flatten-list args))
8c6b1d83
JW
859 '(".")))
860 (let ((ext-du (eshell-search-path "du")))
861 (if (and ext-du
862 (not (catch 'have-ange-path
863 (eshell-for arg args
605a20a9
MA
864 (if (string-equal
865 (file-remote-p (expand-file-name arg) 'method) "ftp")
8c6b1d83
JW
866 (throw 'have-ange-path t))))))
867 (throw 'eshell-replace-command
868 (eshell-parse-command ext-du args))
869 (eshell-eval-using-options
870 "du" args
871 '((?a "all" nil show-all
872 "write counts for all files, not just directories")
873 (nil "block-size" t block-size
874 "use SIZE-byte blocks (i.e., --block-size SIZE)")
875 (?b "bytes" nil by-bytes
876 "print size in bytes")
877 (?c "total" nil grand-total
878 "produce a grand total")
879 (?d "max-depth" t max-depth
880 "display data only this many levels of data")
881 (?h "human-readable" 1024 human-readable
882 "print sizes in human readable format")
883 (?H "is" 1000 human-readable
884 "likewise, but use powers of 1000 not 1024")
885 (?k "kilobytes" 1024 block-size
886 "like --block-size 1024")
887 (?L "dereference" nil dereference-links
888 "dereference all symbolic links")
889 (?m "megabytes" 1048576 block-size
890 "like --block-size 1048576")
891 (?s "summarize" 0 max-depth
892 "display only a total for each argument")
893 (?x "one-file-system" nil only-one-filesystem
894 "skip directories on different filesystems")
895 (nil "help" nil nil
896 "show this usage screen")
897 :external "du"
898 :usage "[OPTION]... FILE...
affbf647 899Summarize disk usage of each FILE, recursively for directories.")
8c6b1d83
JW
900 (unless by-bytes
901 (setq block-size (or block-size 1024)))
902 (if (and max-depth (stringp max-depth))
6b0e3e4d 903 (setq max-depth (string-to-number max-depth)))
8c6b1d83
JW
904 ;; filesystem support means nothing under Windows
905 (if (eshell-under-windows-p)
906 (setq only-one-filesystem nil))
907 (let ((size 0.0) ange-cache)
908 (while args
909 (if only-one-filesystem
910 (setq only-one-filesystem
911 (nth 11 (eshell-file-attributes
912 (file-name-as-directory (car args))))))
913 (setq size (+ size (eshell-du-sum-directory
914 (directory-file-name (car args)) 0)))
915 (setq args (cdr args)))
916 (if grand-total
917 (eshell-print (concat (eshell-du-size-string size)
918 "total\n"))))))))
affbf647
GM
919
920(defvar eshell-time-start nil)
921
922(defun eshell-show-elapsed-time ()
923 (let ((elapsed (format "%.3f secs\n"
924 (- (eshell-time-to-seconds (current-time))
925 eshell-time-start))))
926 (set-text-properties 0 (length elapsed) '(face bold) elapsed)
927 (eshell-interactive-print elapsed))
928 (remove-hook 'eshell-post-command-hook 'eshell-show-elapsed-time t))
929
930(defun eshell/time (&rest args)
931 "Implementation of \"time\" in Lisp."
932 (let ((time-args (copy-alist args))
933 (continue t)
934 last-arg)
935 (while (and continue args)
936 (if (not (string-match "^-" (car args)))
937 (progn
938 (if last-arg
939 (setcdr last-arg nil)
940 (setq args '("")))
941 (setq continue nil))
942 (setq last-arg args
943 args (cdr args))))
944 (eshell-eval-using-options
945 "time" args
946 '((?h "help" nil nil "show this usage screen")
947 :external "time"
948 :show-usage
949 :usage "COMMAND...
950Show wall-clock time elapsed during execution of COMMAND.")
951 (setq eshell-time-start (eshell-time-to-seconds (current-time)))
952 (add-hook 'eshell-post-command-hook 'eshell-show-elapsed-time nil t)
953 ;; after setting
954 (throw 'eshell-replace-command
1ffb5a86
GM
955 (eshell-parse-command (car time-args)
956;;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2007-08/msg00205.html
957 (eshell-stringify-list
958 (eshell-flatten-list (cdr time-args))))))))
affbf647 959
e7b538cd
MA
960(defun eshell/whoami (&rest args)
961 "Make \"whoami\" Tramp aware."
962 (or (file-remote-p default-directory 'user) (user-login-name)))
affbf647
GM
963
964(defvar eshell-diff-window-config nil)
965
966(defun eshell-diff-quit ()
967 "Restore the window configuration previous to diff'ing."
968 (interactive)
969 (if eshell-diff-window-config
970 (set-window-configuration eshell-diff-window-config)))
971
3ced2780
JB
972(defun nil-blank-string (string)
973 "Return STRING, or nil if STRING contains only non-blank characters."
4990598e 974 (cond
3ced2780
JB
975 ((string-match "[^[:blank:]]" string) string)
976 (nil)))
4990598e 977
affbf647
GM
978(defun eshell/diff (&rest args)
979 "Alias \"diff\" to call Emacs `diff' function."
dace60cf 980 (let ((orig-args (eshell-stringify-list (eshell-flatten-list args))))
ca7aae91
JW
981 (if (or eshell-plain-diff-behavior
982 (not (and (eshell-interactive-output-p)
983 (not eshell-in-pipeline-p)
984 (not eshell-in-subcommand-p))))
985 (throw 'eshell-replace-command
986 (eshell-parse-command "*diff" orig-args))
655e9ea9 987 (setq args (copy-sequence orig-args))
ca7aae91
JW
988 (if (< (length args) 2)
989 (throw 'eshell-replace-command
990 (eshell-parse-command "*diff" orig-args)))
991 (let ((old (car (last args 2)))
992 (new (car (last args)))
993 (config (current-window-configuration)))
994 (if (= (length args) 2)
995 (setq args nil)
996 (setcdr (last args 3) nil))
997 (with-current-buffer
998 (condition-case err
4990598e
JW
999 (diff old new
1000 (nil-blank-string (eshell-flatten-and-stringify args)))
ca7aae91
JW
1001 (error
1002 (throw 'eshell-replace-command
1003 (eshell-parse-command "*diff" orig-args))))
1004 (when (fboundp 'diff-mode)
ef59cfc6
JW
1005 (make-local-variable 'compilation-finish-functions)
1006 (add-hook
1007 'compilation-finish-functions
1008 `(lambda (buff msg)
1009 (with-current-buffer buff
1010 (diff-mode)
1011 (set (make-local-variable 'eshell-diff-window-config)
1012 ,config)
1013 (local-set-key [?q] 'eshell-diff-quit)
1014 (if (fboundp 'turn-on-font-lock-if-enabled)
1015 (turn-on-font-lock-if-enabled))
1016 (goto-char (point-min))))))
1017 (pop-to-buffer (current-buffer))))))
1018 nil)
affbf647 1019
127fd3c2
JW
1020(put 'eshell/diff 'eshell-no-numeric-conversions t)
1021
affbf647
GM
1022(defun eshell/locate (&rest args)
1023 "Alias \"locate\" to call Emacs `locate' function."
1024 (if (or eshell-plain-locate-behavior
1025 (not (and (eshell-interactive-output-p)
1026 (not eshell-in-pipeline-p)
1027 (not eshell-in-subcommand-p)))
1028 (and (stringp (car args))
1029 (string-match "^-" (car args))))
1030 (throw 'eshell-replace-command
dace60cf
JW
1031 (eshell-parse-command "*locate" (eshell-stringify-list
1032 (eshell-flatten-list args))))
affbf647
GM
1033 (save-selected-window
1034 (let ((locate-history-list (list (car args))))
1035 (locate-with-filter (car args) (cadr args))))))
1036
127fd3c2
JW
1037(put 'eshell/locate 'eshell-no-numeric-conversions t)
1038
affbf647
GM
1039(defun eshell/occur (&rest args)
1040 "Alias \"occur\" to call Emacs `occur' function."
1041 (let ((inhibit-read-only t))
219227ea
JW
1042 (if (> (length args) 2)
1043 (error "usage: occur: (REGEXP &optional NLINES)")
1044 (apply 'occur args))))
affbf647 1045
127fd3c2
JW
1046(put 'eshell/occur 'eshell-no-numeric-conversions t)
1047
3ba30eb8
MA
1048;; Pacify the byte-compiler.
1049(defvar tramp-default-proxies-alist)
1050
1051(defun eshell/su (&rest args)
1052 "Alias \"su\" to call Tramp."
a09dc9bf 1053 (require 'tramp)
e7b538cd 1054 (setq args (eshell-stringify-list (eshell-flatten-list args)))
a09dc9bf 1055 (let ((orig-args (copy-tree args)))
3ba30eb8 1056 (eshell-eval-using-options
a09dc9bf 1057 "su" args
3ba30eb8
MA
1058 '((?h "help" nil nil "show this usage screen")
1059 (?l "login" nil login "provide a login environment")
1060 (? nil nil login "provide a login environment")
1061 :usage "[- | -l | --login] [USER]
1062Become another USER during a login session.")
1063 (throw 'eshell-replace-command
1064 (let ((user "root")
1065 (host (or (file-remote-p default-directory 'host)
1066 "localhost"))
1067 (dir (or (file-remote-p default-directory 'localname)
a09dc9bf 1068 (expand-file-name default-directory))))
e7b538cd
MA
1069 (eshell-for arg args
1070 (if (string-equal arg "-") (setq login t) (setq user arg)))
a09dc9bf
MA
1071 ;; `eshell-eval-using-options' does not handle "-".
1072 (if (member "-" orig-args) (setq login t))
e7b538cd 1073 (if login (setq dir "~/"))
3ba30eb8 1074 (if (and (file-remote-p default-directory)
a09dc9bf
MA
1075 (or
1076 (not (string-equal
1077 "su" (file-remote-p default-directory 'method)))
1078 (not (string-equal
1079 user (file-remote-p default-directory 'user)))))
3ba30eb8
MA
1080 (add-to-list
1081 'tramp-default-proxies-alist
1082 (list host user (file-remote-p default-directory))))
1083 (eshell-parse-command
e7b538cd 1084 "cd" (list (format "/su:%s@%s:%s" user host dir))))))))
3ba30eb8
MA
1085
1086(put 'eshell/su 'eshell-no-numeric-conversions t)
1087
1088(defun eshell/sudo (&rest args)
1089 "Alias \"sudo\" to call Tramp."
a09dc9bf 1090 (require 'tramp)
e7b538cd 1091 (setq args (eshell-stringify-list (eshell-flatten-list args)))
a09dc9bf 1092 (let ((orig-args (copy-tree args)))
3ba30eb8
MA
1093 (eshell-eval-using-options
1094 "sudo" args
1095 '((?h "help" nil nil "show this usage screen")
1096 (?u "user" t user "execute a command as another USER")
1097 :show-usage
1098 :usage "[(-u | --user) USER] COMMAND
1099Execute a COMMAND as the superuser or another USER.")
1100 (throw 'eshell-external
a09dc9bf
MA
1101 (let ((user (or user "root"))
1102 (host (or (file-remote-p default-directory 'host)
1103 "localhost"))
1104 (dir (or (file-remote-p default-directory 'localname)
1105 (expand-file-name default-directory))))
1106 ;; `eshell-eval-using-options' reads options of COMMAND.
1107 (while (and (stringp (car orig-args))
1108 (member (car orig-args) '("-u" "--user")))
1109 (setq orig-args (cddr orig-args)))
3ba30eb8 1110 (if (and (file-remote-p default-directory)
a09dc9bf
MA
1111 (or
1112 (not (string-equal
1113 "sudo" (file-remote-p default-directory 'method)))
1114 (not (string-equal
1115 user (file-remote-p default-directory 'user)))))
3ba30eb8
MA
1116 (add-to-list
1117 'tramp-default-proxies-alist
1118 (list host user (file-remote-p default-directory))))
e7b538cd 1119 (let ((default-directory (format "/sudo:%s@%s:%s" user host dir)))
a09dc9bf 1120 (eshell-named-command (car orig-args) (cdr orig-args))))))))
3ba30eb8
MA
1121
1122(put 'eshell/sudo 'eshell-no-numeric-conversions t)
1123
dbba8a04 1124(provide 'em-unix)
affbf647 1125
3146b070
GM
1126;; Local Variables:
1127;; generated-autoload-file: "esh-groups.el"
1128;; End:
1129
cbee283d 1130;; arch-tag: 2462edd2-a76a-4cf2-897d-92e9a82ac1c9
affbf647 1131;;; em-unix.el ends here