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