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