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