code.delx.au - gnu-emacs/blob - lisp/eshell/esh-ext.el

   1 ;;; esh-ext.el --- commands external to Eshell
   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 ;; To force a command to invoked external, either provide an explicit
  25 ;; pathname for the command argument, or prefix the command name with
  26 ;; an asterix character.  Example:
  27 ;;
  28 ;;   grep        ; make invoke `grep' Lisp function, or `eshell/grep'
  29 ;;   /bin/grep   ; will definitely invoke /bin/grep
  30 ;;   *grep        ; will also invoke /bin/grep
  31
  32 ;;; Code:
  33
  34 (provide 'esh-ext)
  35
  36 (eval-when-compile
  37   (require 'cl)
  38   (require 'esh-cmd))
  39 (require 'esh-util)
  40
  41 (defgroup eshell-ext nil
  42   "External commands are invoked when operating system executables are
  43 loaded into memory, thus beginning a new process."
  44   :tag "External commands"
  45   :group 'eshell)
  46
  47 ;;; User Variables:
  48
  49 (defcustom eshell-ext-load-hook nil
  50   "A hook that gets run when `eshell-ext' is loaded."
  51   :version "24.1"                       ; removed eshell-ext-initialize
  52   :type 'hook
  53   :group 'eshell-ext)
  54
  55 (defcustom eshell-binary-suffixes exec-suffixes
  56   "A list of suffixes used when searching for executable files."
  57   :type '(repeat string)
  58   :group 'eshell-ext)
  59
  60 (defcustom eshell-force-execution nil
  61   "If non-nil, try to execute binary files regardless of permissions.
  62 This can be useful on systems like Windows, where the operating system
  63 doesn't happen to honor the permission bits in certain cases; or in
  64 cases where you want to associate an interpreter with a particular
  65 kind of script file, but the language won't let you but a '#!'
  66 interpreter line in the file, and you don't want to make it executable
  67 since nothing else but Eshell will be able to understand
  68 `eshell-interpreter-alist'."
  69   :type 'boolean
  70   :group 'eshell-ext)
  71
  72 (defun eshell-search-path (name)
  73   "Search the environment path for NAME."
  74   (if (file-name-absolute-p name)
  75       name
  76     (let ((list (eshell-parse-colon-path eshell-path-env))
  77           suffixes n1 n2 file)
  78       (while list
  79         (setq n1 (concat (car list) name))
  80         (setq suffixes eshell-binary-suffixes)
  81         (while suffixes
  82           (setq n2 (concat n1 (car suffixes)))
  83           (if (and (or (file-executable-p n2)
  84                        (and eshell-force-execution
  85                             (file-readable-p n2)))
  86                    (not (file-directory-p n2)))
  87               (setq file n2 suffixes nil list nil))
  88           (setq suffixes (cdr suffixes)))
  89         (setq list (cdr list)))
  90       file)))
  91
  92 (defcustom eshell-windows-shell-file
  93   (if (eshell-under-windows-p)
  94       (if (string-match "\\(cmdproxy\\|sh\\)\\.\\(com\\|exe\\)"
  95                         shell-file-name)
  96           (or (eshell-search-path "cmd.exe")
  97               (eshell-search-path "command.com"))
  98         shell-file-name))
  99   "The name of the shell command to use for DOS/Windows batch files.
 100 This defaults to nil on non-Windows systems, where this variable is
 101 wholly ignored."
 102   :type '(choice file (const nil))
 103   :group 'eshell-ext)
 104
 105 (defsubst eshell-invoke-batch-file (&rest args)
 106   "Invoke a .BAT or .CMD file on DOS/Windows systems."
 107   ;; since CMD.EXE can't handle forward slashes in the initial
 108   ;; argument...
 109   (setcar args (subst-char-in-string ?/ ?\\ (car args)))
 110   (throw 'eshell-replace-command
 111          (eshell-parse-command
 112           (eshell-quote-argument eshell-windows-shell-file)
 113           (cons "/c" args))))
 114
 115 (defcustom eshell-interpreter-alist
 116   (if (eshell-under-windows-p)
 117       '(("\\.\\(bat\\|cmd\\)\\'" . eshell-invoke-batch-file)))
 118   "An alist defining interpreter substitutions.
 119 Each member is a cons cell of the form:
 120
 121   (MATCH . INTERPRETER)
 122
 123 MATCH should be a regexp, which is matched against the command name,
 124 or a function.  If either returns a non-nil value, then INTERPRETER
 125 will be used for that command.
 126
 127 If INTERPRETER is a string, it will be called as the command name,
 128 with the original command name passed as the first argument, with all
 129 subsequent arguments following.  If INTERPRETER is a function, it will
 130 be called with all of those arguments.  Note that interpreter
 131 functions should throw `eshell-replace-command' with the alternate
 132 command form, or they should return a value compatible with the
 133 possible return values of `eshell-external-command', which see."
 134   :type '(repeat (cons (choice regexp (function :tag "Predicate"))
 135                        (choice string (function :tag "Interpreter"))))
 136   :group 'eshell-ext)
 137
 138 (defcustom eshell-alternate-command-hook nil
 139   "A hook run whenever external command lookup fails.
 140 If a functions wishes to provide an alternate command, they must throw
 141 it using the tag `eshell-replace-command'.  This is done because the
 142 substituted command need not be external at all, and therefore must be
 143 passed up to a higher level for re-evaluation.
 144
 145 Or, if the function returns a filename, that filename will be invoked
 146 with the current command arguments rather than the command specified
 147 by the user on the command line."
 148   :type 'hook
 149   :group 'eshell-ext)
 150
 151 (defcustom eshell-command-interpreter-max-length 256
 152   "The maximum length of any command interpreter string, plus args."
 153   :type 'integer
 154   :group 'eshell-ext)
 155
 156 (defcustom eshell-explicit-command-char ?*
 157   "If this char occurs before a command name, call it externally.
 158 That is, although `vi' may be an alias, `\vi' will always call the
 159 external version."
 160   :type 'character
 161   :group 'eshell-ext)
 162
 163 ;;; Functions:
 164
 165 (defun eshell-ext-initialize ()
 166   "Initialize the external command handling code."
 167   (add-hook 'eshell-named-command-hook 'eshell-explicit-command nil t))
 168
 169 (defun eshell-explicit-command (command args)
 170   "If a command name begins with `*', call it externally always.
 171 This bypasses all Lisp functions and aliases."
 172   (when (and (> (length command) 1)
 173              (eq (aref command 0) eshell-explicit-command-char))
 174     (let ((cmd (eshell-search-path (substring command 1))))
 175       (if cmd
 176           (or (eshell-external-command cmd args)
 177               (error "%s: external command failed" cmd))
 178         (error "%s: external command not found"
 179                (substring command 1))))))
 180
 181 (defun eshell-remote-command (command args)
 182   "Insert output from a remote COMMAND, using ARGS.
 183 A remote command is something that executes on a different machine.
 184 An external command simply means external to Emacs.
 185
 186 Note that this function is very crude at the moment.  It gathers up
 187 all the output from the remote command, and sends it all at once,
 188 causing the user to wonder if anything's really going on..."
 189   (let ((outbuf (generate-new-buffer " *eshell remote output*"))
 190         (errbuf (generate-new-buffer " *eshell remote error*"))
 191         (exitcode 1))
 192     (unwind-protect
 193         (progn
 194           (setq exitcode
 195                 (shell-command
 196                  (mapconcat 'shell-quote-argument
 197                             (append (list command) args) " ")
 198                  outbuf errbuf))
 199           (eshell-print (with-current-buffer outbuf (buffer-string)))
 200           (eshell-error (with-current-buffer errbuf (buffer-string))))
 201       (eshell-close-handles exitcode 'nil)
 202       (kill-buffer outbuf)
 203       (kill-buffer errbuf))))
 204
 205 (defun eshell-external-command (command args)
 206   "Insert output from an external COMMAND, using ARGS."
 207   (setq args (eshell-stringify-list (eshell-flatten-list args)))
 208   (if (file-remote-p default-directory)
 209       (eshell-remote-command command args))
 210   (let ((interp (eshell-find-interpreter command)))
 211     (assert interp)
 212     (if (functionp (car interp))
 213         (apply (car interp) (append (cdr interp) args))
 214       (eshell-gather-process-output
 215        (car interp) (append (cdr interp) args)))))
 216
 217 (defun eshell/addpath (&rest args)
 218   "Add a set of paths to PATH."
 219   (eshell-eval-using-options
 220    "addpath" args
 221    '((?b "begin" nil prepend "add path element at beginning")
 222      (?h "help" nil nil  "display this usage message")
 223      :usage "[-b] PATH
 224 Adds the given PATH to $PATH.")
 225    (if args
 226        (progn
 227          (if prepend
 228              (setq args (nreverse args)))
 229          (while args
 230            (setenv "PATH"
 231                    (if prepend
 232                        (concat (car args) path-separator
 233                                (getenv "PATH"))
 234                      (concat (getenv "PATH") path-separator
 235                              (car args))))
 236            (setq args (cdr args))))
 237      (let ((paths (parse-colon-path (getenv "PATH"))))
 238        (while paths
 239          (eshell-printn (car paths))
 240          (setq paths (cdr paths)))))))
 241
 242 (put 'eshell/addpath 'eshell-no-numeric-conversions t)
 243
 244 (defun eshell-script-interpreter (file)
 245   "Extract the script to run from FILE, if it has #!<interp> in it.
 246 Return nil, or a list of the form:
 247
 248   (INTERPRETER [ARGS] FILE)"
 249   (let ((maxlen eshell-command-interpreter-max-length))
 250     (if (and (file-readable-p file)
 251              (file-regular-p file))
 252         (with-temp-buffer
 253           (insert-file-contents-literally file nil 0 maxlen)
 254           (if (looking-at "#![ \t]*\\([^ \r\t\n]+\\)\\([ \t]+\\(.+\\)\\)?")
 255               (if (match-string 3)
 256                   (list (match-string 1)
 257                         (match-string 3)
 258                         file)
 259                 (list (match-string 1)
 260                       file)))))))
 261
 262 (defun eshell-find-interpreter (file &optional no-examine-p)
 263   "Find the command interpreter with which to execute FILE.
 264 If NO-EXAMINE-P is non-nil, FILE will not be inspected for a script
 265 line of the form #!<interp>."
 266   (let ((finterp
 267          (catch 'found
 268            (ignore
 269             (dolist (possible eshell-interpreter-alist)
 270               (cond
 271                ((functionp (car possible))
 272                 (and (funcall (car possible) file)
 273                      (throw 'found (cdr possible))))
 274                ((stringp (car possible))
 275                 (and (string-match (car possible) file)
 276                      (throw 'found (cdr possible))))
 277                (t
 278                 (error "Invalid interpreter-alist test"))))))))
 279     (if finterp                         ; first check
 280         (list finterp file)
 281       (let ((fullname (if (file-name-directory file) file
 282                         (eshell-search-path file)))
 283             (suffixes eshell-binary-suffixes))
 284         (if (and fullname (not (or eshell-force-execution
 285                                    (file-executable-p fullname))))
 286             (while suffixes
 287               (let ((try (concat fullname (car suffixes))))
 288                 (if (or (file-executable-p try)
 289                         (and eshell-force-execution
 290                              (file-readable-p try)))
 291                     (setq fullname try suffixes nil)
 292                   (setq suffixes (cdr suffixes))))))
 293         (cond ((not (and fullname (file-exists-p fullname)))
 294                (let ((name (or fullname file)))
 295                  (unless (setq fullname
 296                                (run-hook-with-args-until-success
 297                                 'eshell-alternate-command-hook file))
 298                    (error "%s: command not found" name))))
 299               ((not (or eshell-force-execution
 300                         (file-executable-p fullname)))
 301                (error "%s: Permission denied" fullname)))
 302         (let (interp)
 303           (unless no-examine-p
 304             (setq interp (eshell-script-interpreter fullname))
 305             (if interp
 306                 (setq interp
 307                       (cons (car (eshell-find-interpreter (car interp) t))
 308                             (cdr interp)))))
 309           (or interp (list fullname)))))))
 310
 311 ;;; esh-ext.el ends here