code.delx.au - gnu-emacs/blob - lisp/eshell/em-unix.el

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