code.delx.au - gnu-emacs/blob - 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,
   5 ;;   2006, 2007 Free Software Foundation, Inc.
   6
   7 ;; Author: kai.grossjohann@gmx.net
   8 ;; Keywords: comm, extensions, processes
   9
  10 ;; This file 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 ;; This file 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
  22 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Some misc. utility functions that might go nicely with Tramp.
  28 ;; Mostly, these are kluges awaiting real solutions later on.
  29
  30 ;;; Code:
  31
  32 (require 'compile)
  33 (require 'tramp)
  34 (add-hook 'tramp-util-unload-hook
  35           '(lambda ()
  36              (when (featurep 'tramp)
  37                (unload-feature 'tramp 'force))))
  38
  39 ;; Define a Tramp minor mode. It's intention is to redefine some keys for Tramp
  40 ;; specific functions, like compilation.
  41 ;; The key remapping works since Emacs 22 only. Unknown for XEmacs.
  42
  43 ;; Pacify byte-compiler
  44 (eval-when-compile
  45   (unless (fboundp 'define-minor-mode)
  46       (defalias 'define-minor-mode 'identity)
  47       (defvar tramp-minor-mode))
  48   (unless (featurep 'xemacs)
  49     (defalias 'add-menu-button 'ignore)))
  50
  51 (defvar tramp-minor-mode-map (make-sparse-keymap)
  52   "Keymap for Tramp minor mode.")
  53
  54 (define-minor-mode tramp-minor-mode "Tramp minor mode for utility functions."
  55   :group 'tramp
  56   :global nil
  57   :init-value nil
  58   :lighter " Tramp"
  59   :keymap tramp-minor-mode-map
  60   (setq tramp-minor-mode
  61         (and tramp-minor-mode (tramp-tramp-file-p default-directory))))
  62
  63 (add-hook 'find-file-hooks 'tramp-minor-mode t)
  64 (add-hook 'tramp-util-unload-hook
  65           '(lambda ()
  66              (remove-hook 'find-file-hooks 'tramp-minor-mode)))
  67
  68 (add-hook 'dired-mode-hook 'tramp-minor-mode t)
  69 (add-hook 'tramp-util-unload-hook
  70           '(lambda ()
  71              (remove-hook 'dired-mode-hook 'tramp-minor-mode)))
  72
  73 (defun tramp-remap-command (old-command new-command)
  74   "Replaces bindings of OLD-COMMAND by NEW-COMMAND.
  75 If remapping functionality for keymaps is defined, this happens for all
  76 bindings.  Otherwise, only bindings active during invocation are taken
  77 into account.  XEmacs menubar bindings are not changed by this."
  78   (if (functionp 'command-remapping)
  79       ;; Emacs 22
  80       (eval
  81        `(define-key tramp-minor-mode-map [remap ,old-command] new-command))
  82     ;; previous Emacs versions.
  83     (mapcar
  84      '(lambda (x)
  85         (define-key tramp-minor-mode-map x new-command))
  86      (where-is-internal old-command))))
  87
  88 (tramp-remap-command 'compile 'tramp-compile)
  89 (tramp-remap-command 'recompile 'tramp-recompile)
  90
  91 ;; XEmacs has an own mimic for menu entries
  92 (when (fboundp 'add-menu-button)
  93   (funcall 'add-menu-button
  94    '("Tools" "Compile")
  95    ["Compile..."
  96     (command-execute (if tramp-minor-mode 'tramp-compile 'compile))
  97     :active (fboundp 'compile)])
  98   (funcall 'add-menu-button
  99    '("Tools" "Compile")
 100    ["Repeat Compilation"
 101     (command-execute (if tramp-minor-mode 'tramp-recompile 'recompile))
 102     :active (fboundp 'compile)]))
 103
 104 ;; Utility functions.
 105
 106 (defun tramp-compile (command)
 107   "Compile on remote host."
 108   (interactive
 109    (if (or compilation-read-command current-prefix-arg)
 110        (list (read-from-minibuffer "Compile command: "
 111                                    compile-command nil nil
 112                                    '(compile-history . 1)))
 113      (list compile-command)))
 114   (setq compile-command command)
 115   (save-some-buffers (not compilation-ask-about-save) nil)
 116   (let ((d default-directory))
 117     (save-excursion
 118       (pop-to-buffer (get-buffer-create "*Compilation*") t)
 119       (erase-buffer)
 120       (setq default-directory d)))
 121   (tramp-handle-shell-command command (get-buffer "*Compilation*"))
 122   (pop-to-buffer (get-buffer "*Compilation*"))
 123   (tramp-minor-mode 1)
 124   (compilation-minor-mode 1))
 125
 126 (defun tramp-recompile ()
 127   "Re-compile on remote host."
 128   (interactive)
 129   (save-some-buffers (not compilation-ask-about-save) nil)
 130   (tramp-handle-shell-command compile-command (get-buffer "*Compilation*"))
 131   (pop-to-buffer (get-buffer "*Compilation*"))
 132   (tramp-minor-mode 1)
 133   (compilation-minor-mode 1))
 134
 135 (provide 'tramp-util)
 136
 137 ;;; arch-tag: 500f9992-a44e-46d0-83a7-980799251808
 138 ;;; tramp-util.el ends here