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