lisp/eshell/em-unix.el

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