em-unix.el 35 KB

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