lisp/eshell/em-unix.el

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