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