lisp/eshell/em-unix.el

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