lisp/eshell/em-unix.el

   1 ;;; em-unix.el --- UNIX command aliases  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 1999-2018 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 <https://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")
 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 (files &optional toplevel)
 199   "Remove all of the given FILES, perhaps interactively."
 200   (while files
 201     (if (string-match "\\`\\.\\.?\\'"
 202                       (file-name-nondirectory (car files)))
 203         (if toplevel
 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-message "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-message "rm: remove directory `%s'? "
 216                                                (car files))))))
 217               (eshell-funcalln 'delete-directory (car files) t t)))
 218         (if em-verbose
 219             (eshell-printn (format-message "rm: removing file `%s'"
 220                                            (car files))))
 221         (unless (or em-preview
 222                     (and em-interactive
 223                          (not (y-or-n-p
 224                                (format-message "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-message "rm: removing buffer `%s'" entry)))
 264          (unless (or em-preview
 265                      (and em-interactive
 266                           (not (y-or-n-p (format-message
 267                                           "rm: delete buffer `%s'? "
 268                                           entry)))))
 269            (eshell-funcalln 'kill-buffer entry)))
 270         ((eshell-processp entry)
 271          (if em-verbose
 272              (eshell-printn (format-message "rm: killing process `%s'" entry)))
 273          (unless (or em-preview
 274                      (and em-interactive
 275                           (not (y-or-n-p (format-message
 276                                           "rm: kill process `%s'? "
 277                                           entry)))))
 278            (eshell-funcalln 'kill-process entry)))
 279         ((symbolp entry)
 280          (if em-verbose
 281              (eshell-printn (format-message
 282                              "rm: uninterning symbol `%s'" entry)))
 283          (unless
 284              (or em-preview
 285                  (and em-interactive
 286                       (not (y-or-n-p (format-message
 287                                       "rm: unintern symbol `%s'? "
 288                                       entry)))))
 289            (eshell-funcalln 'unintern entry)))
 290         ((stringp entry)
 291          ;; -f should silently ignore missing files (bug#15373).
 292          (unless (and force-removal
 293                       (not (file-exists-p entry)))
 294            (if (and (file-directory-p entry)
 295                     (not (file-symlink-p entry)))
 296                (if (or em-recursive
 297                        eshell-rm-removes-directories)
 298                    (if (or em-preview
 299                            (not em-interactive)
 300                            (y-or-n-p
 301                             (format-message "rm: descend into directory `%s'? "
 302                                             entry)))
 303                      (eshell-remove-entries (list entry) t))
 304                  (eshell-error (format "rm: %s: is a directory\n" entry)))
 305              (eshell-remove-entries (list entry) t))))))
 306      (setq args (cdr args)))
 307    nil))
 308
 309 (put 'eshell/rm 'eshell-no-numeric-conversions t)
 310 (put 'eshell/rm 'eshell-filename-arguments t)
 311
 312 (defun eshell/mkdir (&rest args)
 313   "Implementation of mkdir in Lisp."
 314   (eshell-eval-using-options
 315    "mkdir" args
 316    '((?h "help" nil nil "show this usage screen")
 317      (?p "parents" nil em-parents "make parent directories as needed")
 318      :external "mkdir"
 319      :show-usage
 320      :usage "[OPTION] DIRECTORY...
 321 Create the DIRECTORY(ies), if they do not already exist.")
 322    (while args
 323      (eshell-funcalln 'make-directory (car args) em-parents)
 324      (setq args (cdr args)))
 325    nil))
 326
 327 (put 'eshell/mkdir 'eshell-no-numeric-conversions t)
 328 (put 'eshell/mkdir 'eshell-filename-arguments t)
 329
 330 (defun eshell/rmdir (&rest args)
 331   "Implementation of rmdir in Lisp."
 332   (eshell-eval-using-options
 333    "rmdir" args
 334    '((?h "help" nil nil "show this usage screen")
 335      :external "rmdir"
 336      :show-usage
 337      :usage "[OPTION] DIRECTORY...
 338 Remove the DIRECTORY(ies), if they are empty.")
 339    (while args
 340      (eshell-funcalln 'delete-directory (car args))
 341      (setq args (cdr args)))
 342    nil))
 343
 344 (put 'eshell/rmdir 'eshell-no-numeric-conversions t)
 345 (put 'eshell/rmdir 'eshell-filename-arguments t)
 346
 347 (defvar no-dereference)
 348
 349 (defvar eshell-warn-dot-directories t)
 350
 351 (defun eshell-shuffle-files (command action files target func deep &rest args)
 352   "Shuffle around some filesystem entries, using FUNC to do the work."
 353   (let ((attr-target (eshell-file-attributes target))
 354         (is-dir (or (file-directory-p target)
 355                     (and em-preview (not eshell-warn-dot-directories))))
 356         attr)
 357     (if (and (not em-preview) (not is-dir)
 358              (> (length files) 1))
 359         (error "%s: when %s multiple files, last argument must be a directory"
 360                command action))
 361     (while files
 362       (setcar files (directory-file-name (car files)))
 363       (cond
 364        ((string-match "\\`\\.\\.?\\'"
 365                       (file-name-nondirectory (car files)))
 366         (if eshell-warn-dot-directories
 367             (eshell-error (format "%s: %s: omitting directory\n"
 368                                   command (car files)))))
 369        ((and attr-target
 370              (or (not (eshell-under-windows-p))
 371                  (eq system-type 'ms-dos))
 372              (setq attr (eshell-file-attributes (car files)))
 373              (file-attribute-inode-number attr-target)
 374              (file-attribute-inode-number attr)
 375              (equal (file-attribute-inode-number attr-target)
 376                     (file-attribute-inode-number attr))
 377              (file-attribute-device-number attr-target)
 378              (file-attribute-device-number attr)
 379              (equal (file-attribute-device-number attr-target)
 380                     (file-attribute-device-number attr)))
 381         (eshell-error (format-message "%s: `%s' and `%s' are the same file\n"
 382                                       command (car files) target)))
 383        (t
 384         (let ((source (car files))
 385               (target (if is-dir
 386                           (expand-file-name
 387                            (file-name-nondirectory (car files)) target)
 388                         target))
 389               link)
 390           (if (and (file-directory-p source)
 391                    (or (not no-dereference)
 392                        (not (file-symlink-p source)))
 393                    (not (memq func '(make-symbolic-link
 394                                      add-name-to-file))))
 395               (if (and (eq func 'copy-file)
 396                        (not em-recursive))
 397                   (eshell-error (format "%s: %s: omitting directory\n"
 398                                         command (car files)))
 399                 (let (eshell-warn-dot-directories)
 400                   (if (and (not deep)
 401                            (eq func 'rename-file)
 402                            (equal (file-attribute-device-number
 403                                    (eshell-file-attributes
 404                                     (file-name-directory
 405                                      (directory-file-name
 406                                       (expand-file-name source)))))
 407                                   (file-attribute-device-number
 408                                    (eshell-file-attributes
 409                                     (file-name-directory
 410                                      (directory-file-name
 411                                       (expand-file-name target)))))))
 412                       (apply 'eshell-funcalln func source target args)
 413                   (unless (file-directory-p target)
 414                     (if em-verbose
 415                         (eshell-printn
 416                          (format "%s: making directory %s"
 417                                  command target)))
 418                     (unless em-preview
 419                       (eshell-funcalln 'make-directory target)))
 420                   (apply 'eshell-shuffle-files
 421                          command action
 422                          (mapcar
 423                           (function
 424                            (lambda (file)
 425                              (concat source "/" file)))
 426                           (directory-files source))
 427                          target func t args)
 428                   (when (eq func 'rename-file)
 429                     (if em-verbose
 430                         (eshell-printn
 431                          (format "%s: deleting directory %s"
 432                                  command source)))
 433                     (unless em-preview
 434                       (eshell-funcalln 'delete-directory source))))))
 435             (if em-verbose
 436                 (eshell-printn (format "%s: %s -> %s" command
 437                                        source target)))
 438             (unless em-preview
 439               (if (and no-dereference
 440                        (setq link (file-symlink-p source)))
 441                   (progn
 442                     (apply 'eshell-funcalln 'make-symbolic-link
 443                            link target args)
 444                     (if (eq func 'rename-file)
 445                         (if (and (file-directory-p source)
 446                                  (not (file-symlink-p source)))
 447                             (eshell-funcalln 'delete-directory source)
 448                           (eshell-funcalln 'delete-file source))))
 449                 (apply 'eshell-funcalln func source target args)))))))
 450       (setq files (cdr files)))))
 451
 452 (defun eshell-shorthand-tar-command (command args)
 453   "Rewrite `cp -v dir a.tar.gz' to `tar cvzf a.tar.gz dir'."
 454   (let* ((archive (car (last args)))
 455          (tar-args
 456           (cond ((string-match "z2" archive) "If")
 457                 ((string-match "gz" archive) "zf")
 458                 ((string-match "\\(az\\|Z\\)" archive) "Zf")
 459                 (t "f"))))
 460     (if (file-exists-p archive)
 461         (setq tar-args (concat "u" tar-args))
 462       (setq tar-args (concat "c" tar-args)))
 463     (if em-verbose
 464         (setq tar-args (concat "v" tar-args)))
 465     (if (equal command "mv")
 466         (setq tar-args (concat "--remove-files -" tar-args)))
 467     ;; truncate the archive name from the arguments
 468     (setcdr (last args 2) nil)
 469     (throw 'eshell-replace-command
 470            (eshell-parse-command
 471             (format "tar %s %s" tar-args archive) args))))
 472
 473 (defvar ange-cache)                     ; XEmacs?  See esh-util
 474
 475 ;; this is to avoid duplicating code...
 476 (defmacro eshell-mvcpln-template (command action func query-var
 477                                           force-var &optional preserve)
 478   `(let ((len (length args)))
 479      (if (or (= len 0)
 480              (and (= len 1) (null eshell-default-target-is-dot)))
 481          (error "%s: missing destination file or directory" ,command))
 482      (if (= len 1)
 483          (nconc args '(".")))
 484      (setq args (eshell-stringify-list (eshell-flatten-list args)))
 485      (if (and ,(not (equal command "ln"))
 486               (string-match eshell-tar-regexp (car (last args)))
 487               (or (> (length args) 2)
 488                   (and (file-directory-p (car args))
 489                        (or (not no-dereference)
 490                            (not (file-symlink-p (car args)))))))
 491          (eshell-shorthand-tar-command ,command args)
 492        (let ((target (car (last args)))
 493              ange-cache)
 494          (setcdr (last args 2) nil)
 495          (eshell-shuffle-files
 496           ,command ,action args target ,func nil
 497           ,@(append
 498              `((if (and (or em-interactive
 499                             ,query-var)
 500                         (not force))
 501                    1 (or force ,force-var)))
 502              (if preserve
 503                  (list preserve)))))
 504        nil)))
 505
 506 (defun eshell/mv (&rest args)
 507   "Implementation of mv in Lisp."
 508   (eshell-eval-using-options
 509    "mv" args
 510    '((?f "force" nil force
 511          "remove existing destinations, never prompt")
 512      (?i "interactive" nil em-interactive
 513          "request confirmation if target already exists")
 514      (?n "preview" nil em-preview
 515          "don't change anything on disk")
 516      (?v "verbose" nil em-verbose
 517          "explain what is being done")
 518      (nil "help" nil nil "show this usage screen")
 519      :preserve-args
 520      :external "mv"
 521      :show-usage
 522      :usage "[OPTION]... SOURCE DEST
 523    or: mv [OPTION]... SOURCE... DIRECTORY
 524 Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
 525 [OPTION] DIRECTORY...")
 526    (let ((no-dereference t))
 527      (eshell-mvcpln-template "mv" "moving" 'rename-file
 528                              eshell-mv-interactive-query
 529                              eshell-mv-overwrite-files))))
 530
 531 (put 'eshell/mv 'eshell-no-numeric-conversions t)
 532 (put 'eshell/mv 'eshell-filename-arguments t)
 533
 534 (defun eshell/cp (&rest args)
 535   "Implementation of cp in Lisp."
 536   (eshell-eval-using-options
 537    "cp" args
 538    '((?a "archive" nil archive
 539          "same as -dpR")
 540      (?d "no-dereference" nil no-dereference
 541          "preserve links")
 542      (?f "force" nil force
 543          "remove existing destinations, never prompt")
 544      (?i "interactive" nil em-interactive
 545          "request confirmation if target already exists")
 546      (?n "preview" nil em-preview
 547          "don't change anything on disk")
 548      (?p "preserve" nil preserve
 549          "preserve file attributes if possible")
 550      (?r "recursive" nil em-recursive
 551          "copy directories recursively")
 552      (?R nil nil em-recursive
 553          "as for -r")
 554      (?v "verbose" nil em-verbose
 555          "explain what is being done")
 556      (nil "help" nil nil "show this usage screen")
 557      :preserve-args
 558      :external "cp"
 559      :show-usage
 560      :usage "[OPTION]... SOURCE DEST
 561    or:  cp [OPTION]... SOURCE... DIRECTORY
 562 Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
 563    (if archive
 564        (setq preserve t no-dereference t em-recursive t))
 565    (eshell-mvcpln-template "cp" "copying" 'copy-file
 566                            eshell-cp-interactive-query
 567                            eshell-cp-overwrite-files preserve)))
 568
 569 (put 'eshell/cp 'eshell-no-numeric-conversions t)
 570 (put 'eshell/cp 'eshell-filename-arguments t)
 571
 572 (defun eshell/ln (&rest args)
 573   "Implementation of ln in Lisp."
 574   (eshell-eval-using-options
 575    "ln" args
 576    '((?h "help" nil nil "show this usage screen")
 577      (?s "symbolic" nil symbolic
 578          "make symbolic links instead of hard links")
 579      (?i "interactive" nil em-interactive
 580          "request confirmation if target already exists")
 581      (?f "force" nil force "remove existing destinations, never prompt")
 582      (?n "preview" nil em-preview
 583          "don't change anything on disk")
 584      (?v "verbose" nil em-verbose "explain what is being done")
 585      :preserve-args
 586      :external "ln"
 587      :show-usage
 588      :usage "[OPTION]... TARGET [LINK_NAME]
 589    or:  ln [OPTION]... TARGET... DIRECTORY
 590 Create a link to the specified TARGET with optional LINK_NAME.  If there is
 591 more than one TARGET, the last argument must be a directory;  create links
 592 in DIRECTORY to each TARGET.  Create hard links by default, symbolic links
 593 with `--symbolic'.  When creating hard links, each TARGET must exist.")
 594    (let ((no-dereference t))
 595      (eshell-mvcpln-template "ln" "linking"
 596                              (if symbolic
 597                                  'make-symbolic-link
 598                                'add-name-to-file)
 599                              eshell-ln-interactive-query
 600                              eshell-ln-overwrite-files))))
 601
 602 (put 'eshell/ln 'eshell-no-numeric-conversions t)
 603 (put 'eshell/ln 'eshell-filename-arguments t)
 604
 605 (defun eshell/cat (&rest args)
 606   "Implementation of cat in Lisp.
 607 If in a pipeline, or the file is not a regular file, directory or
 608 symlink, then revert to the system's definition of cat."
 609   (setq args (eshell-stringify-list (eshell-flatten-list args)))
 610   (if (or eshell-in-pipeline-p
 611           (catch 'special
 612             (dolist (arg args)
 613               (unless (or (and (stringp arg)
 614                                (> (length arg) 0)
 615                                (eq (aref arg 0) ?-))
 616                           (let ((attrs (eshell-file-attributes arg)))
 617                             (and attrs
 618                                  (memq (aref (file-attribute-modes attrs) 0)
 619                                              '(?d ?l ?-)))))
 620                 (throw 'special t)))))
 621       (let ((ext-cat (eshell-search-path "cat")))
 622         (if ext-cat
 623             (throw 'eshell-replace-command
 624                    (eshell-parse-command (eshell-quote-argument ext-cat) args))
 625           (if eshell-in-pipeline-p
 626               (error "Eshell's `cat' does not work in pipelines")
 627             (error "Eshell's `cat' cannot display one of the files given"))))
 628     (eshell-init-print-buffer)
 629     (eshell-eval-using-options
 630      "cat" args
 631      '((?h "help" nil nil "show this usage screen")
 632        :external "cat"
 633        :show-usage
 634        :usage "[OPTION] FILE...
 635 Concatenate FILE(s), or standard input, to standard output.")
 636      (dolist (file args)
 637        (if (string= file "-")
 638            (throw 'eshell-external
 639                   (eshell-external-command "cat" args))))
 640      (let ((curbuf (current-buffer)))
 641        (dolist (file args)
 642          (with-temp-buffer
 643            (insert-file-contents file)
 644            (goto-char (point-min))
 645            (while (not (eobp))
 646              (let ((str (buffer-substring
 647                          (point) (min (1+ (line-end-position))
 648                                       (point-max)))))
 649                (with-current-buffer curbuf
 650                  (eshell-buffered-print str)))
 651              (forward-line)))))
 652      (eshell-flush)
 653      ;; if the file does not end in a newline, do not emit one
 654      (setq eshell-ensure-newline-p nil))))
 655
 656 (put 'eshell/cat 'eshell-no-numeric-conversions t)
 657 (put 'eshell/cat 'eshell-filename-arguments t)
 658
 659 ;; special front-end functions for compilation-mode buffers
 660
 661 (defun eshell/make (&rest args)
 662   "Use `compile' to do background makes.
 663 Fallback to standard make when called synchronously."
 664   (if (and eshell-current-subjob-p
 665            (eshell-interactive-output-p))
 666       (let ((compilation-process-setup-function
 667              (list 'lambda nil
 668                    (list 'setq 'process-environment
 669                          (list 'quote (eshell-copy-environment))))))
 670         (compile (concat "make " (eshell-flatten-and-stringify args))))
 671     (throw 'eshell-replace-command
 672            (eshell-parse-command "*make" (eshell-stringify-list
 673                                           (eshell-flatten-list args))))))
 674
 675 (put 'eshell/make 'eshell-no-numeric-conversions t)
 676
 677 (defun eshell-occur-mode-goto-occurrence ()
 678   "Go to the occurrence the current line describes."
 679   (interactive)
 680   (let ((pos (occur-mode-find-occurrence)))
 681     (pop-to-buffer (marker-buffer pos))
 682     (goto-char (marker-position pos))))
 683
 684 (defun eshell-occur-mode-mouse-goto (event)
 685   "In Occur mode, go to the occurrence whose line you click on."
 686   (interactive "e")
 687   (let (pos)
 688     (with-current-buffer (window-buffer (posn-window (event-end event)))
 689       (save-excursion
 690         (goto-char (posn-point (event-end event)))
 691         (setq pos (occur-mode-find-occurrence))))
 692     (pop-to-buffer (marker-buffer pos))
 693     (goto-char (marker-position pos))))
 694
 695 (defun eshell-poor-mans-grep (args)
 696   "A poor version of grep that opens every file and uses `occur'.
 697 This eats up memory, since it leaves the buffers open (to speed future
 698 searches), and it's very slow.  But, if your system has no grep
 699 available..."
 700   (save-selected-window
 701     (let ((default-dir default-directory))
 702       (with-current-buffer (get-buffer-create "*grep*")
 703         (let ((inhibit-read-only t)
 704               (default-directory default-dir))
 705           (erase-buffer)
 706           (occur-mode)
 707           (let ((files (eshell-stringify-list
 708                         (eshell-flatten-list (cdr args))))
 709                 (inhibit-redisplay t)
 710                 string)
 711             (when (car args)
 712               (if (get-buffer "*Occur*")
 713                   (kill-buffer (get-buffer "*Occur*")))
 714               (setq string nil)
 715               (while files
 716                 (with-current-buffer (find-file-noselect (car files))
 717                   (save-excursion
 718                     (ignore-errors
 719                       (occur (car args))))
 720                   (if (get-buffer "*Occur*")
 721                       (with-current-buffer (get-buffer "*Occur*")
 722                         (setq string (buffer-string))
 723                         (kill-buffer (current-buffer)))))
 724                 (if string (insert string))
 725                 (setq string nil
 726                       files (cdr files)))))
 727           (local-set-key [mouse-2] 'eshell-occur-mode-mouse-goto)
 728           (local-set-key [(control ?c) (control ?c)]
 729                          'eshell-occur-mode-goto-occurrence)
 730           (local-set-key [(control ?m)]
 731                          'eshell-occur-mode-goto-occurrence)
 732           (local-set-key [return] 'eshell-occur-mode-goto-occurrence)
 733           (pop-to-buffer (current-buffer) t)
 734           (goto-char (point-min))
 735           (resize-temp-buffer-window))))))
 736
 737 (defvar compilation-scroll-output)
 738
 739 (defun eshell-grep (command args &optional maybe-use-occur)
 740   "Generic service function for the various grep aliases.
 741 It calls Emacs's grep utility if the command is not redirecting output,
 742 and if it's not part of a command pipeline.  Otherwise, it calls the
 743 external command."
 744   (if (and maybe-use-occur eshell-no-grep-available)
 745       (eshell-poor-mans-grep args)
 746     (if (or eshell-plain-grep-behavior
 747             (not (and (eshell-interactive-output-p)
 748                       (not eshell-in-pipeline-p)
 749                       (not eshell-in-subcommand-p))))
 750         (throw 'eshell-replace-command
 751                (eshell-parse-command (concat "*" command)
 752                                      (eshell-stringify-list
 753                                       (eshell-flatten-list args))))
 754       (let* ((args (mapconcat 'identity
 755                               (mapcar 'shell-quote-argument
 756                                       (eshell-stringify-list
 757                                        (eshell-flatten-list args)))
 758                               " "))
 759              (cmd (progn
 760                     (set-text-properties 0 (length args)
 761                                          '(invisible t) args)
 762                     (format "%s -n %s"
 763                             (pcase command
 764                               ("egrep" "grep -E")
 765                               ("fgrep" "grep -F")
 766                               (x x))
 767                             args)))
 768              compilation-scroll-output)
 769         (grep cmd)))))
 770
 771 (defun eshell/grep (&rest args)
 772   "Use Emacs grep facility instead of calling external grep."
 773   (eshell-grep "grep" args t))
 774
 775 (defun eshell/egrep (&rest args)
 776   "Use Emacs grep facility instead of calling external grep -E."
 777   (eshell-grep "egrep" args t))
 778
 779 (defun eshell/fgrep (&rest args)
 780   "Use Emacs grep facility instead of calling external grep -F."
 781   (eshell-grep "fgrep" args t))
 782
 783 (defun eshell/agrep (&rest args)
 784   "Use Emacs grep facility instead of calling external agrep."
 785   (eshell-grep "agrep" args))
 786
 787 (defun eshell/glimpse (&rest args)
 788   "Use Emacs grep facility instead of calling external glimpse."
 789   (let (null-device)
 790     (eshell-grep "glimpse" (append '("-z" "-y") args))))
 791
 792 ;; completions rules for some common UNIX commands
 793
 794 (defsubst eshell-complete-hostname ()
 795   "Complete a command that wants a hostname for an argument."
 796   (pcomplete-here (eshell-read-host-names)))
 797
 798 (defun eshell-complete-host-reference ()
 799   "If there is a host reference, complete it."
 800   (let ((arg (pcomplete-actual-arg))
 801         index)
 802     (when (setq index (string-match "@[a-z.]*\\'" arg))
 803       (setq pcomplete-stub (substring arg (1+ index))
 804             pcomplete-last-completion-raw t)
 805       (throw 'pcomplete-completions (eshell-read-host-names)))))
 806
 807 (defalias 'pcomplete/ftp    'eshell-complete-hostname)
 808 (defalias 'pcomplete/ncftp  'eshell-complete-hostname)
 809 (defalias 'pcomplete/ping   'eshell-complete-hostname)
 810 (defalias 'pcomplete/rlogin 'eshell-complete-hostname)
 811
 812 (defun pcomplete/telnet ()
 813   (require 'pcmpl-unix)
 814   (pcomplete-opt "xl(pcmpl-unix-user-names)")
 815   (eshell-complete-hostname))
 816
 817 (defun pcomplete/rsh ()
 818   "Complete `rsh', which, after the user and hostname, is like xargs."
 819   (require 'pcmpl-unix)
 820   (pcomplete-opt "l(pcmpl-unix-user-names)")
 821   (eshell-complete-hostname)
 822   (pcomplete-here (funcall pcomplete-command-completion-function))
 823   (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
 824                pcomplete-default-completion-function)))
 825
 826 (defvar block-size)
 827 (defvar by-bytes)
 828 (defvar dereference-links)
 829 (defvar grand-total)
 830 (defvar human-readable)
 831 (defvar max-depth)
 832 (defvar only-one-filesystem)
 833 (defvar show-all)
 834
 835 (defsubst eshell-du-size-string (size)
 836   (let* ((str (eshell-printable-size size human-readable block-size t))
 837          (len (length str)))
 838     (concat str (if (< len 8)
 839                     (make-string (- 8 len) ? )))))
 840
 841 (defun eshell-du-sum-directory (path depth)
 842   "Summarize PATH, and its member directories."
 843   (let ((entries (eshell-directory-files-and-attributes path))
 844         (size 0.0))
 845     (while entries
 846       (unless (string-match "\\`\\.\\.?\\'" (caar entries))
 847         (let* ((entry (concat path "/"
 848                               (caar entries)))
 849                (symlink (and (stringp (file-attribute-type (cdar entries)))
 850                              (file-attribute-type (cdar entries)))))
 851           (unless (or (and symlink (not dereference-links))
 852                       (and only-one-filesystem
 853                            (/= only-one-filesystem
 854                                (file-attribute-device-number (cdar entries)))))
 855             (if symlink
 856                 (setq entry symlink))
 857             (setq size
 858                   (+ size
 859                      (if (eq t (car (cdar entries)))
 860                          (eshell-du-sum-directory entry (1+ depth))
 861                        (let ((file-size (file-attribute-size (cdar entries))))
 862                          (prog1
 863                              file-size
 864                            (if show-all
 865                                (eshell-print
 866                                 (concat (eshell-du-size-string file-size)
 867                                         entry "\n")))))))))))
 868       (setq entries (cdr entries)))
 869     (if (or (not max-depth)
 870             (= depth max-depth)
 871             (= depth 0))
 872         (eshell-print (concat (eshell-du-size-string size)
 873                               (directory-file-name path) "\n")))
 874     size))
 875
 876 (defun eshell/du (&rest args)
 877   "Implementation of \"du\" in Lisp, passing ARGS."
 878   (setq args (if args
 879                  (eshell-stringify-list (eshell-flatten-list args))
 880                '(".")))
 881   (let ((ext-du (eshell-search-path "du")))
 882     (if (and ext-du
 883              (not (catch 'have-ange-path
 884                     (dolist (arg args)
 885                       (if (string-equal
 886                            (file-remote-p (expand-file-name arg) 'method) "ftp")
 887                           (throw 'have-ange-path t))))))
 888         (throw 'eshell-replace-command
 889                (eshell-parse-command (eshell-quote-argument ext-du) args))
 890       (eshell-eval-using-options
 891        "du" args
 892        '((?a "all" nil show-all
 893              "write counts for all files, not just directories")
 894          (nil "block-size" t block-size
 895               "use SIZE-byte blocks (i.e., --block-size SIZE)")
 896          (?b "bytes" nil by-bytes
 897              "print size in bytes")
 898          (?c "total" nil grand-total
 899              "produce a grand total")
 900          (?d "max-depth" t max-depth
 901              "display data only this many levels of data")
 902          (?h "human-readable" 1024 human-readable
 903              "print sizes in human readable format")
 904          (?H "is" 1000 human-readable
 905              "likewise, but use powers of 1000 not 1024")
 906          (?k "kilobytes" 1024 block-size
 907              "like --block-size 1024")
 908          (?L "dereference" nil dereference-links
 909              "dereference all symbolic links")
 910          (?m "megabytes" 1048576 block-size
 911              "like --block-size 1048576")
 912          (?s "summarize" 0 max-depth
 913              "display only a total for each argument")
 914          (?x "one-file-system" nil only-one-filesystem
 915              "skip directories on different filesystems")
 916          (nil "help" nil nil
 917               "show this usage screen")
 918          :external "du"
 919          :usage "[OPTION]... FILE...
 920 Summarize disk usage of each FILE, recursively for directories.")
 921        (unless by-bytes
 922          (setq block-size (or block-size 1024)))
 923        (if (and max-depth (stringp max-depth))
 924            (setq max-depth (string-to-number max-depth)))
 925        ;; filesystem support means nothing under Windows
 926        (if (eshell-under-windows-p)
 927            (setq only-one-filesystem nil))
 928        (let ((size 0.0) ange-cache)
 929          (while args
 930            (if only-one-filesystem
 931                (setq only-one-filesystem
 932                      (file-attribute-device-number (eshell-file-attributes
 933                               (file-name-as-directory (car args))))))
 934            (setq size (+ size (eshell-du-sum-directory
 935                                (directory-file-name (car args)) 0)))
 936            (setq args (cdr args)))
 937          (if grand-total
 938              (eshell-print (concat (eshell-du-size-string size)
 939                                    "total\n"))))))))
 940
 941 (put 'eshell/du 'eshell-filename-arguments t)
 942
 943 (defvar eshell-time-start nil)
 944
 945 (defun eshell-show-elapsed-time ()
 946   (let ((elapsed (format "%.3f secs\n" (- (float-time) eshell-time-start))))
 947     (set-text-properties 0 (length elapsed) '(face bold) elapsed)
 948     (eshell-interactive-print elapsed))
 949   (remove-hook 'eshell-post-command-hook 'eshell-show-elapsed-time t))
 950
 951 (defun eshell/time (&rest args)
 952   "Implementation of \"time\" in Lisp."
 953   (let ((time-args (copy-alist args))
 954         (continue t)
 955         last-arg)
 956     (while (and continue args)
 957       (if (not (string-match "^-" (car args)))
 958           (progn
 959             (if last-arg
 960                 (setcdr last-arg nil)
 961               (setq args '("")))
 962             (setq continue nil))
 963         (setq last-arg args
 964               args (cdr args))))
 965     (eshell-eval-using-options
 966      "time" args
 967      '((?h "help" nil nil "show this usage screen")
 968        :external "time"
 969        :show-usage
 970        :usage "COMMAND...
 971 Show wall-clock time elapsed during execution of COMMAND.")
 972      (setq eshell-time-start (float-time))
 973      (add-hook 'eshell-post-command-hook 'eshell-show-elapsed-time nil t)
 974      ;; after setting
 975      (throw 'eshell-replace-command
 976             (eshell-parse-command (car time-args)
 977 ;;; https://lists.gnu.org/r/bug-gnu-emacs/2007-08/msg00205.html
 978                                   (eshell-stringify-list
 979                                    (eshell-flatten-list (cdr time-args))))))))
 980
 981 (defun eshell/whoami (&rest _args)
 982   "Make \"whoami\" Tramp aware."
 983   (or (file-remote-p default-directory 'user) (user-login-name)))
 984
 985 (defvar eshell-diff-window-config nil)
 986
 987 (defun eshell-diff-quit ()
 988   "Restore the window configuration previous to diff'ing."
 989   (interactive)
 990   (if eshell-diff-window-config
 991       (set-window-configuration eshell-diff-window-config)))
 992
 993 (defun nil-blank-string (string)
 994   "Return STRING, or nil if STRING contains only non-blank characters."
 995   (cond
 996     ((string-match "[^[:blank:]]" string) string)
 997     (nil)))
 998
 999 (autoload 'diff-no-select "diff")
1000
1001 (defun eshell/diff (&rest args)
1002   "Alias \"diff\" to call Emacs `diff' function."
1003   (let ((orig-args (eshell-stringify-list (eshell-flatten-list args))))
1004     (if (or eshell-plain-diff-behavior
1005             (not (and (eshell-interactive-output-p)
1006                       (not eshell-in-pipeline-p)
1007                       (not eshell-in-subcommand-p))))
1008         (throw 'eshell-replace-command
1009                (eshell-parse-command "*diff" orig-args))
1010       (setq args (copy-sequence orig-args))
1011       (if (< (length args) 2)
1012           (throw 'eshell-replace-command
1013                  (eshell-parse-command "*diff" orig-args)))
1014       (let ((old (car (last args 2)))
1015             (new (car (last args)))
1016             (config (current-window-configuration)))
1017         (if (= (length args) 2)
1018             (setq args nil)
1019           (setcdr (last args 3) nil))
1020         (with-current-buffer
1021             (condition-case nil
1022                 (diff-no-select
1023                  old new
1024                  (nil-blank-string (eshell-flatten-and-stringify args)))
1025               (error
1026                (throw 'eshell-replace-command
1027                       (eshell-parse-command "*diff" orig-args))))
1028           (when (fboundp 'diff-mode)
1029             (make-local-variable 'compilation-finish-functions)
1030             (add-hook
1031              'compilation-finish-functions
1032              `(lambda (buff msg)
1033                 (with-current-buffer buff
1034                   (diff-mode)
1035                   (set (make-local-variable 'eshell-diff-window-config)
1036                        ,config)
1037                   (local-set-key [?q] 'eshell-diff-quit)
1038                   (if (fboundp 'turn-on-font-lock-if-enabled)
1039                       (turn-on-font-lock-if-enabled))
1040                   (goto-char (point-min))))))
1041           (pop-to-buffer (current-buffer))))))
1042   nil)
1043
1044 (put 'eshell/diff 'eshell-no-numeric-conversions t)
1045 (put 'eshell/diff 'eshell-filename-arguments t)
1046
1047 (defvar locate-history-list)
1048
1049 (defun eshell/locate (&rest args)
1050   "Alias \"locate\" to call Emacs `locate' function."
1051   (if (or eshell-plain-locate-behavior
1052           (not (and (eshell-interactive-output-p)
1053                     (not eshell-in-pipeline-p)
1054                     (not eshell-in-subcommand-p)))
1055           (and (stringp (car args))
1056                (string-match "^-" (car args))))
1057       (throw 'eshell-replace-command
1058              (eshell-parse-command "*locate" (eshell-stringify-list
1059                                               (eshell-flatten-list args))))
1060     (save-selected-window
1061       (let ((locate-history-list (list (car args))))
1062         (locate-with-filter (car args) (cadr args))))))
1063
1064 (put 'eshell/locate 'eshell-no-numeric-conversions t)
1065
1066 (defun eshell/occur (&rest args)
1067   "Alias \"occur\" to call Emacs `occur' function."
1068   (let ((inhibit-read-only t))
1069     (if (> (length args) 2)
1070         (error "usage: occur: (REGEXP &optional NLINES)")
1071       (apply 'occur args))))
1072
1073 (put 'eshell/occur 'eshell-no-numeric-conversions t)
1074
1075 (provide 'em-unix)
1076
1077 ;; Local Variables:
1078 ;; generated-autoload-file: "esh-groups.el"
1079 ;; End:
1080
1081 ;;; em-unix.el ends here