lisp/eshell/em-unix.el

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