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   (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 (buffer 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         (setq buffer occur-buffer)))
 651     (pop-to-buffer (marker-buffer pos))
 652     (goto-char (marker-position pos))))
 653
 654 (defun eshell-poor-mans-grep (args)
 655   "A poor version of grep that opens every file and uses `occur'.
 656 This eats up memory, since it leaves the buffers open (to speed future
 657 searches), and it's very slow.  But, if your system has no grep
 658 available..."
 659   (save-selected-window
 660     (let ((default-dir default-directory))
 661       (with-current-buffer (get-buffer-create "*grep*")
 662         (let ((inhibit-read-only t)
 663               (default-directory default-dir))
 664           (erase-buffer)
 665           (occur-mode)
 666           (let ((files (eshell-stringify-list
 667                         (eshell-flatten-list (cdr args))))
 668                 (inhibit-redisplay t)
 669                 string)
 670             (when (car args)
 671               (if (get-buffer "*Occur*")
 672                   (kill-buffer (get-buffer "*Occur*")))
 673               (setq string nil)
 674               (while files
 675                 (with-current-buffer (find-file-noselect (car files))
 676                   (save-excursion
 677                     (ignore-errors
 678                       (occur (car args))))
 679                   (if (get-buffer "*Occur*")
 680                       (with-current-buffer (get-buffer "*Occur*")
 681                         (setq string (buffer-string))
 682                         (kill-buffer (current-buffer)))))
 683                 (if string (insert string))
 684                 (setq string nil
 685                       files (cdr files)))))
 686           (setq occur-buffer (current-buffer))
 687           (local-set-key [mouse-2] 'eshell-occur-mode-mouse-goto)
 688           (local-set-key [(control ?c) (control ?c)]
 689                          'eshell-occur-mode-goto-occurrence)
 690           (local-set-key [(control ?m)]
 691                          'eshell-occur-mode-goto-occurrence)
 692           (local-set-key [return] 'eshell-occur-mode-goto-occurrence)
 693           (pop-to-buffer (current-buffer) t)
 694           (goto-char (point-min))
 695           (resize-temp-buffer-window))))))
 696
 697 (defun eshell-grep (command args &optional maybe-use-occur)
 698   "Generic service function for the various grep aliases.
 699 It calls Emacs' grep utility if the command is not redirecting output,
 700 and if it's not part of a command pipeline.  Otherwise, it calls the
 701 external command."
 702   (if (and maybe-use-occur eshell-no-grep-available)
 703       (eshell-poor-mans-grep args)
 704     (if (or eshell-plain-grep-behavior
 705             (not (and (eshell-interactive-output-p)
 706                       (not eshell-in-pipeline-p)
 707                       (not eshell-in-subcommand-p))))
 708         (throw 'eshell-replace-command
 709                (eshell-parse-command (concat "*" command)
 710                                      (eshell-stringify-list
 711                                       (eshell-flatten-list args))))
 712       (let* ((compilation-process-setup-function
 713               (list 'lambda nil
 714                     (list 'setq 'process-environment
 715                           (list 'quote (eshell-copy-environment)))))
 716              (args (mapconcat 'identity
 717                               (mapcar 'shell-quote-argument
 718                                       (eshell-stringify-list
 719                                        (eshell-flatten-list args)))
 720                               " "))
 721              (cmd (progn
 722                     (set-text-properties 0 (length args)
 723                                          '(invisible t) args)
 724                     (format "%s -n %s" command args)))
 725              compilation-scroll-output)
 726         (grep cmd)))))
 727
 728 (defun eshell/grep (&rest args)
 729   "Use Emacs grep facility instead of calling external grep."
 730   (eshell-grep "grep" args t))
 731
 732 (defun eshell/egrep (&rest args)
 733   "Use Emacs grep facility instead of calling external egrep."
 734   (eshell-grep "egrep" args t))
 735
 736 (defun eshell/fgrep (&rest args)
 737   "Use Emacs grep facility instead of calling external fgrep."
 738   (eshell-grep "fgrep" args t))
 739
 740 (defun eshell/agrep (&rest args)
 741   "Use Emacs grep facility instead of calling external agrep."
 742   (eshell-grep "agrep" args))
 743
 744 (defun eshell/glimpse (&rest args)
 745   "Use Emacs grep facility instead of calling external glimpse."
 746   (let (null-device)
 747     (eshell-grep "glimpse" (append '("-z" "-y") args))))
 748
 749 ;; completions rules for some common UNIX commands
 750
 751 (defsubst eshell-complete-hostname ()
 752   "Complete a command that wants a hostname for an argument."
 753   (pcomplete-here (eshell-read-host-names)))
 754
 755 (defun eshell-complete-host-reference ()
 756   "If there is a host reference, complete it."
 757   (let ((arg (pcomplete-actual-arg))
 758         index)
 759     (when (setq index (string-match "@[a-z.]*\\'" arg))
 760       (setq pcomplete-stub (substring arg (1+ index))
 761             pcomplete-last-completion-raw t)
 762       (throw 'pcomplete-completions (eshell-read-host-names)))))
 763
 764 (defalias 'pcomplete/ftp    'eshell-complete-hostname)
 765 (defalias 'pcomplete/ncftp  'eshell-complete-hostname)
 766 (defalias 'pcomplete/ping   'eshell-complete-hostname)
 767 (defalias 'pcomplete/rlogin 'eshell-complete-hostname)
 768
 769 (defun pcomplete/telnet ()
 770   (require 'pcmpl-unix)
 771   (pcomplete-opt "xl(pcmpl-unix-user-names)")
 772   (eshell-complete-hostname))
 773
 774 (defun pcomplete/rsh ()
 775   "Complete `rsh', which, after the user and hostname, is like xargs."
 776   (require 'pcmpl-unix)
 777   (pcomplete-opt "l(pcmpl-unix-user-names)")
 778   (eshell-complete-hostname)
 779   (pcomplete-here (funcall pcomplete-command-completion-function))
 780   (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
 781                pcomplete-default-completion-function)))
 782
 783 (defalias 'pcomplete/ssh 'pcomplete/rsh)
 784
 785 (eval-when-compile
 786   (defvar block-size)
 787   (defvar by-bytes)
 788   (defvar dereference-links)
 789   (defvar grand-total)
 790   (defvar human-readable)
 791   (defvar max-depth)
 792   (defvar only-one-filesystem)
 793   (defvar show-all))
 794
 795 (defsubst eshell-du-size-string (size)
 796   (let* ((str (eshell-printable-size size human-readable block-size t))
 797          (len (length str)))
 798     (concat str (if (< len 8)
 799                     (make-string (- 8 len) ? )))))
 800
 801 (defun eshell-du-sum-directory (path depth)
 802   "Summarize PATH, and its member directories."
 803   (let ((entries (eshell-directory-files-and-attributes path))
 804         (size 0.0))
 805     (while entries
 806       (unless (string-match "\\`\\.\\.?\\'" (caar entries))
 807         (let* ((entry (concat path (char-to-string directory-sep-char)
 808                               (caar entries)))
 809                (symlink (and (stringp (cadr (car entries)))
 810                              (cadr (car entries)))))
 811           (unless (or (and symlink (not dereference-links))
 812                       (and only-one-filesystem
 813                            (/= only-one-filesystem
 814                                (nth 12 (car entries)))))
 815             (if symlink
 816                 (setq entry symlink))
 817             (setq size
 818                   (+ size
 819                      (if (eq t (cadr (car entries)))
 820                          (eshell-du-sum-directory entry (1+ depth))
 821                        (let ((file-size (nth 8 (car entries))))
 822                          (prog1
 823                              file-size
 824                            (if show-all
 825                                (eshell-print
 826                                 (concat (eshell-du-size-string file-size)
 827                                         entry "\n")))))))))))
 828       (setq entries (cdr entries)))
 829     (if (or (not max-depth)
 830             (= depth max-depth)
 831             (= depth 0))
 832         (eshell-print (concat (eshell-du-size-string size)
 833                               (directory-file-name path) "\n")))
 834     size))
 835
 836 (defun eshell/du (&rest args)
 837   "Implementation of \"du\" in Lisp, passing ARGS."
 838   (setq args (if args
 839                  (eshell-stringify-list (eshell-flatten-list args))
 840                '(".")))
 841   (let ((ext-du (eshell-search-path "du")))
 842     (if (and ext-du
 843              (not (catch 'have-ange-path
 844                     (eshell-for arg args
 845                       (if (eq (find-file-name-handler (expand-file-name arg)
 846                                                       'directory-files)
 847                               'ange-ftp-hook-function)
 848                           (throw 'have-ange-path t))))))
 849         (throw 'eshell-replace-command
 850                (eshell-parse-command ext-du args))
 851       (eshell-eval-using-options
 852        "du" args
 853        '((?a "all" nil show-all
 854              "write counts for all files, not just directories")
 855          (nil "block-size" t block-size
 856               "use SIZE-byte blocks (i.e., --block-size SIZE)")
 857          (?b "bytes" nil by-bytes
 858              "print size in bytes")
 859          (?c "total" nil grand-total
 860              "produce a grand total")
 861          (?d "max-depth" t max-depth
 862              "display data only this many levels of data")
 863          (?h "human-readable" 1024 human-readable
 864              "print sizes in human readable format")
 865          (?H "is" 1000 human-readable
 866              "likewise, but use powers of 1000 not 1024")
 867          (?k "kilobytes" 1024 block-size
 868              "like --block-size 1024")
 869          (?L "dereference" nil dereference-links
 870              "dereference all symbolic links")
 871          (?m "megabytes" 1048576 block-size
 872              "like --block-size 1048576")
 873          (?s "summarize" 0 max-depth
 874              "display only a total for each argument")
 875          (?x "one-file-system" nil only-one-filesystem
 876              "skip directories on different filesystems")
 877          (nil "help" nil nil
 878               "show this usage screen")
 879          :external "du"
 880          :usage "[OPTION]... FILE...
 881 Summarize disk usage of each FILE, recursively for directories.")
 882        (unless by-bytes
 883          (setq block-size (or block-size 1024)))
 884        (if (and max-depth (stringp max-depth))
 885            (setq max-depth (string-to-int max-depth)))
 886        ;; filesystem support means nothing under Windows
 887        (if (eshell-under-windows-p)
 888            (setq only-one-filesystem nil))
 889        (let ((size 0.0) ange-cache)
 890          (while args
 891            (if only-one-filesystem
 892                (setq only-one-filesystem
 893                      (nth 11 (eshell-file-attributes
 894                               (file-name-as-directory (car args))))))
 895            (setq size (+ size (eshell-du-sum-directory
 896                                (directory-file-name (car args)) 0)))
 897            (setq args (cdr args)))
 898          (if grand-total
 899              (eshell-print (concat (eshell-du-size-string size)
 900                                    "total\n"))))))))
 901
 902 (defvar eshell-time-start nil)
 903
 904 (defun eshell-show-elapsed-time ()
 905   (let ((elapsed (format "%.3f secs\n"
 906                          (- (eshell-time-to-seconds (current-time))
 907                             eshell-time-start))))
 908     (set-text-properties 0 (length elapsed) '(face bold) elapsed)
 909     (eshell-interactive-print elapsed))
 910   (remove-hook 'eshell-post-command-hook 'eshell-show-elapsed-time t))
 911
 912 (defun eshell/time (&rest args)
 913   "Implementation of \"time\" in Lisp."
 914   (let ((time-args (copy-alist args))
 915         (continue t)
 916         last-arg)
 917     (while (and continue args)
 918       (if (not (string-match "^-" (car args)))
 919           (progn
 920             (if last-arg
 921                 (setcdr last-arg nil)
 922               (setq args '("")))
 923             (setq continue nil))
 924         (setq last-arg args
 925               args (cdr args))))
 926     (eshell-eval-using-options
 927      "time" args
 928      '((?h "help" nil nil "show this usage screen")
 929        :external "time"
 930        :show-usage
 931        :usage "COMMAND...
 932 Show wall-clock time elapsed during execution of COMMAND.")
 933      (setq eshell-time-start (eshell-time-to-seconds (current-time)))
 934      (add-hook 'eshell-post-command-hook 'eshell-show-elapsed-time nil t)
 935      ;; after setting
 936      (throw 'eshell-replace-command
 937             (eshell-parse-command (car time-args) (cdr time-args))))))
 938
 939 (defalias 'eshell/whoami 'user-login-name)
 940
 941 (defvar eshell-diff-window-config nil)
 942
 943 (defun eshell-diff-quit ()
 944   "Restore the window configuration previous to diff'ing."
 945   (interactive)
 946   (if eshell-diff-window-config
 947       (set-window-configuration eshell-diff-window-config)))
 948
 949 (defun eshell/diff (&rest args)
 950   "Alias \"diff\" to call Emacs `diff' function."
 951   (let ((orig-args (eshell-stringify-list (eshell-flatten-list args))))
 952     (if (or eshell-plain-diff-behavior
 953             (not (and (eshell-interactive-output-p)
 954                       (not eshell-in-pipeline-p)
 955                       (not eshell-in-subcommand-p))))
 956         (throw 'eshell-replace-command
 957                (eshell-parse-command "*diff" orig-args))
 958       (setq args (eshell-copy-list orig-args))
 959       (if (< (length args) 2)
 960           (throw 'eshell-replace-command
 961                  (eshell-parse-command "*diff" orig-args)))
 962       (let ((old (car (last args 2)))
 963             (new (car (last args)))
 964             (config (current-window-configuration)))
 965         (if (= (length args) 2)
 966             (setq args nil)
 967           (setcdr (last args 3) nil))
 968         (with-current-buffer
 969             (condition-case err
 970                 (diff old new (eshell-flatten-and-stringify args))
 971               (error
 972                (throw 'eshell-replace-command
 973                       (eshell-parse-command "*diff" orig-args))))
 974           (when (fboundp 'diff-mode)
 975             (make-local-variable 'compilation-finish-functions)
 976             (add-hook
 977              'compilation-finish-functions
 978              `(lambda (buff msg)
 979                 (with-current-buffer buff
 980                   (diff-mode)
 981                   (set (make-local-variable 'eshell-diff-window-config)
 982                        ,config)
 983                   (local-set-key [?q] 'eshell-diff-quit)
 984                   (if (fboundp 'turn-on-font-lock-if-enabled)
 985                       (turn-on-font-lock-if-enabled))
 986                   (goto-char (point-min))))))
 987           (pop-to-buffer (current-buffer))))))
 988   nil)
 989
 990 (put 'eshell/diff 'eshell-no-numeric-conversions t)
 991
 992 (defun eshell/locate (&rest args)
 993   "Alias \"locate\" to call Emacs `locate' function."
 994   (if (or eshell-plain-locate-behavior
 995           (not (and (eshell-interactive-output-p)
 996                     (not eshell-in-pipeline-p)
 997                     (not eshell-in-subcommand-p)))
 998           (and (stringp (car args))
 999                (string-match "^-" (car args))))
1000       (throw 'eshell-replace-command
1001              (eshell-parse-command "*locate" (eshell-stringify-list
1002                                               (eshell-flatten-list args))))
1003     (save-selected-window
1004       (let ((locate-history-list (list (car args))))
1005         (locate-with-filter (car args) (cadr args))))))
1006
1007 (put 'eshell/locate 'eshell-no-numeric-conversions t)
1008
1009 (defun eshell/occur (&rest args)
1010   "Alias \"occur\" to call Emacs `occur' function."
1011   (let ((inhibit-read-only t))
1012     (if (> (length args) 2)
1013         (error "usage: occur: (REGEXP &optional NLINES)")
1014       (apply 'occur args))))
1015
1016 (put 'eshell/occur 'eshell-no-numeric-conversions t)
1017
1018 ;;; Code:
1019
1020 ;;; em-unix.el ends here