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