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