lisp/eshell/esh-ext.el

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