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