lisp/net/tramp-util.el

   1 ;;; -*- coding: iso-2022-7bit; -*-
   2 ;;; tramp-util.el --- Misc utility functions to use with Tramp
   3
   4 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
   5
   6 ;; Author: kai.grossjohann@gmx.net
   7 ;; Keywords: comm, extensions, processes
   8
   9 ;; This file 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 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This file 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; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; Some misc. utility functions that might go nicely with Tramp.
  27 ;; Mostly, these are kluges awaiting real solutions later on.
  28
  29 ;;; Code:
  30
  31 (eval-when-compile (require 'cl))
  32 (require 'compile)
  33 (require 'tramp)
  34
  35 ;; Define a Tramp minor mode. It's intention is to redefine some keys for Tramp
  36 ;; specific functions, like compilation.
  37 ;; The key remapping works since Emacs 22.1 only. Unknown for XEmacs.
  38
  39 (when (fboundp 'define-minor-mode)
  40
  41   (defvar tramp-minor-mode-map (make-sparse-keymap)
  42     "Keymap for Tramp minor mode.")
  43
  44   (define-minor-mode tramp-minor-mode "Tramp minor mode for utility functions."
  45     :group 'tramp
  46     :global nil
  47     :init-value nil
  48     :lighter " Tramp"
  49     :keymap tramp-minor-mode-map
  50     (setq tramp-minor-mode
  51           (and tramp-minor-mode (tramp-tramp-file-p default-directory))))
  52
  53   (add-hook 'find-file-hooks 'tramp-minor-mode t)
  54   (add-hook 'dired-mode-hook 'tramp-minor-mode t)
  55
  56   (defun tramp-remap-command (old-command new-command)
  57     "Replaces bindings of OLD-COMMAND by NEW-COMMAND.
  58 If remapping functionality for keymaps is defined, this happens for all
  59 bindings.  Otherwise, only bindings active during invocation are taken
  60 into account.  XEmacs menubar bindings are not changed by this."
  61     (if (functionp 'command-remapping)
  62         ;; Emacs 22.1
  63         (eval
  64          `(define-key tramp-minor-mode-map [remap ,old-command] new-command))
  65       ;; previous Emacs 21 versions.
  66       (mapcar
  67        '(lambda (x)
  68           (define-key tramp-minor-mode-map x new-command))
  69        (where-is-internal old-command))))
  70
  71   (tramp-remap-command 'compile 'tramp-compile)
  72   (tramp-remap-command 'recompile 'tramp-recompile)
  73
  74   ;; XEmacs has an own mimic for menu entries
  75   (when (fboundp 'add-menu-button)
  76     (funcall 'add-menu-button
  77      '("Tools" "Compile")
  78      ["Compile..."
  79       (command-execute (if tramp-minor-mode 'tramp-compile 'compile))
  80       :active (fboundp 'compile)])
  81     (funcall 'add-menu-button
  82      '("Tools" "Compile")
  83      ["Repeat Compilation"
  84       (command-execute (if tramp-minor-mode 'tramp-recompile 'recompile))
  85       :active (fboundp 'compile)])))
  86
  87 ;; Utility functions.
  88
  89 (defun tramp-compile (command)
  90   "Compile on remote host."
  91   (interactive
  92    (if (or compilation-read-command current-prefix-arg)
  93        (list (read-from-minibuffer "Compile command: "
  94                                    compile-command nil nil
  95                                    '(compile-history . 1)))
  96      (list compile-command)))
  97   (setq compile-command command)
  98   (save-some-buffers (not compilation-ask-about-save) nil)
  99   (let ((d default-directory))
 100     (save-excursion
 101       (pop-to-buffer (get-buffer-create "*Compilation*") t)
 102       (erase-buffer)
 103       (setq default-directory d)))
 104   (tramp-handle-shell-command command (get-buffer "*Compilation*"))
 105   (pop-to-buffer (get-buffer "*Compilation*"))
 106   (tramp-minor-mode 1)
 107   (compilation-minor-mode 1))
 108
 109 (defun tramp-recompile ()
 110   "Re-compile on remote host."
 111   (interactive)
 112   (save-some-buffers (not compilation-ask-about-save) nil)
 113   (tramp-handle-shell-command compile-command (get-buffer "*Compilation*"))
 114   (pop-to-buffer (get-buffer "*Compilation*"))
 115   (tramp-minor-mode 1)
 116   (compilation-minor-mode 1))
 117
 118 (provide 'tramp-util)
 119
 120 ;;; arch-tag: 500f9992-a44e-46d0-83a7-980799251808
 121 ;;; tramp-util.el ends here