lisp/eshell/em-unix.el

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