view lisp/net/tramp-util.el @ 60092:04686828d0da

2004-11-08 Benjamin Riefenstahl <[e-mail]> * w32select.c: Summary: Thorough rework to implement Unicode clipboard operations and delayed rendering. Drop last_clipboard_text and related code, keep track of ownership via clipboard_owner instead. Drop old #if0 sections. (DEFAULT_LCID, ANSICP, OEMCP, QUNICODE, QANSICP, QOEMCP) (clipboard_owner, modifying_clipboard, cfg_coding_system) (cfg_codepage, cfg_lcid, cfg_clipboard_type, current_text) (current_coding_system, current_requires_encoding) (current_num_nls, current_clipboard_type, current_lcid): New static variables. (convert_to_handle_as_ascii, convert_to_handle_as_coded) (render, render_all, run_protected, lisp_error_handler) (owner_callback, create_owner, setup_config) (enum_locale_callback, cp_from_locale, coding_from_cp): New local functions. (term_w32select, globals_of_w32select): New global functions. (Fw32_set_clipboard_data): Ignore parameter FRAME, use clipboard_owner instead. Use delayed rendering and provide all text formats. Provide CF_LOCALE if necessary. (Fw32_get_clipboard_data): Handle CF_UNICODETEXT and CF_LOCALE. Fall back to CF_TEXT, if CF_UNICODETEXT is not available. Force DOS line-ends for decoding. (Fx_selection_exists_p): Handle CF_UNICODETEXT. (syms_of_w32select): Init and register new variables. * w32.h: Add prototypes for globals_of_w32select and term_w32select. Make the neighboring K&R declarations into prototypes, too. * emacs.c: Include w32.h to get function prototypes. (main): Call globals_of_w32select. * w32.c (term_ntproc): Call term_w32select. * mule-cmds.el (set-locale-environment): Remove call to set-selection-coding-system on Windows. * s/ms-w32.h: Guard MSC-specific #pragmas with an #ifdef.

;;; -*- coding: iso-2022-7bit; -*-
;;; tramp-util.el --- Misc utility functions to use with Tramp

;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.

;; Author: [e-mail]
;; Keywords: comm, extensions, processes

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Some misc. utility functions that might go nicely with Tramp.
;; Mostly, these are kluges awaiting real solutions later on.

;;; Code:

(eval-when-compile (require 'cl))
(require 'compile)
(require 'tramp)

;; Define a Tramp minor mode. It's intention is to redefine some keys for Tramp
;; specific functions, like compilation.
;; The key remapping works since Emacs 22.1 only. Unknown for XEmacs.

(when (fboundp 'define-minor-mode)

  (defvar tramp-minor-mode-map (make-sparse-keymap)
    "Keymap for Tramp minor mode.")

  (define-minor-mode tramp-minor-mode "Tramp minor mode for utility functions."
    :group 'tramp
    :global nil
    :init-value nil
    :lighter " Tramp"
    :keymap tramp-minor-mode-map
    (setq tramp-minor-mode
	  (and tramp-minor-mode (tramp-tramp-file-p default-directory))))

  (add-hook 'find-file-hooks 'tramp-minor-mode t)
  (add-hook 'dired-mode-hook 'tramp-minor-mode t)

  (defun tramp-remap-command (old-command new-command)
    "Replaces bindings of OLD-COMMAND by NEW-COMMAND.
If remapping functionality for keymaps is defined, this happens for all
bindings.  Otherwise, only bindings active during invocation are taken
into account.  XEmacs menubar bindings are not changed by this."
    (if (functionp 'command-remapping)
	;; Emacs 22.1
	(eval
	 `(define-key tramp-minor-mode-map [remap ,old-command] new-command))
      ;; previous Emacs 21 versions.
      (mapcar
       '(lambda (x)
	  (define-key tramp-minor-mode-map x new-command))
       (where-is-internal old-command))))

  (tramp-remap-command 'compile 'tramp-compile)
  (tramp-remap-command 'recompile 'tramp-recompile)

  ;; XEmacs has an own mimic for menu entries
  (when (fboundp 'add-menu-button)
    (funcall 'add-menu-button
     '("Tools" "Compile")
     ["Compile..."
      (command-execute (if tramp-minor-mode 'tramp-compile 'compile))
      :active (fboundp 'compile)])
    (funcall 'add-menu-button
     '("Tools" "Compile")
     ["Repeat Compilation"
      (command-execute (if tramp-minor-mode 'tramp-recompile 'recompile))
      :active (fboundp 'compile)])))

;; Utility functions.

(defun tramp-compile (command)
  "Compile on remote host."
  (interactive
   (if (or compilation-read-command current-prefix-arg)
       (list (read-from-minibuffer "Compile command: "
                                   compile-command nil nil
                                   '(compile-history . 1)))
     (list compile-command)))
  (setq compile-command command)
  (save-some-buffers (not compilation-ask-about-save) nil)
  (let ((d default-directory))
    (save-excursion
      (pop-to-buffer (get-buffer-create "*Compilation*") t)
      (erase-buffer)
      (setq default-directory d)))
  (tramp-handle-shell-command command (get-buffer "*Compilation*"))
  (pop-to-buffer (get-buffer "*Compilation*"))
  (tramp-minor-mode 1)
  (compilation-minor-mode 1))

(defun tramp-recompile ()
  "Re-compile on remote host."
  (interactive)
  (save-some-buffers (not compilation-ask-about-save) nil)
  (tramp-handle-shell-command compile-command (get-buffer "*Compilation*"))
  (pop-to-buffer (get-buffer "*Compilation*"))
  (tramp-minor-mode 1)
  (compilation-minor-mode 1))

(provide 'tramp-util)

;;; arch-tag: 500f9992-a44e-46d0-83a7-980799251808
;;; tramp-util.el ends here