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