Mercurial > emacs
view lisp/net/eudc-hotlist.el @ 60092:04686828d0da
2004-11-08 Benjamin Riefenstahl <Benjamin.Riefenstahl@epost.de>
* 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.
author | Jason Rumney <jasonr@gnu.org> |
---|---|
date | Tue, 15 Feb 2005 23:19:26 +0000 |
parents | 695cf19ef79e |
children | 7aa95a2ceedc 375f2633d815 |
line wrap: on
line source
;;; eudc-hotlist.el --- hotlist management for EUDC ;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> ;; Keywords: comm ;; This file is part of GNU Emacs. ;; GNU Emacs 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. ;; GNU Emacs 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: ;;; Usage: ;; See the corresponding info file ;;; Code: (require 'eudc) (defvar eudc-hotlist-menu nil) (defvar eudc-hotlist-mode-map nil) (defvar eudc-hotlist-list-beginning nil) (defun eudc-hotlist-mode () "Major mode used to edit the hotlist of servers. These are the special commands of this mode: a -- Add a new server to the list. d -- Delete the server at point from the list. s -- Select the server at point. t -- Transpose the server at point and the previous one q -- Commit the changes and quit. x -- Quit without commiting the changes." (interactive) (kill-all-local-variables) (setq major-mode 'eudc-hotlist-mode) (setq mode-name "EUDC-Servers") (use-local-map eudc-hotlist-mode-map) (setq mode-popup-menu eudc-hotlist-menu) (when (and eudc-xemacs-p (featurep 'menubar)) (set-buffer-menubar current-menubar) (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu))))) (setq buffer-read-only t)) ;;;###autoload (defun eudc-edit-hotlist () "Edit the hotlist of directory servers in a specialized buffer." (interactive) (let ((proto-col 10) gap) (switch-to-buffer (get-buffer-create "*EUDC Servers*")) (setq buffer-read-only nil) (erase-buffer) (mapcar (function (lambda (entry) (setq proto-col (max (length (car entry)) proto-col)))) eudc-server-hotlist) (setq proto-col (+ 3 proto-col)) (setq gap (make-string (- proto-col 6) ?\ )) (insert " EUDC Servers\n" " ============\n" "\n" "Server" gap "Protocol\n" "------" gap "--------\n" "\n") (setq eudc-hotlist-list-beginning (point)) (mapcar '(lambda (entry) (insert (car entry)) (indent-to proto-col) (insert (symbol-name (cdr entry)) "\n")) eudc-server-hotlist) (eudc-hotlist-mode))) (defun eudc-hotlist-add-server () "Add a new server to the list after current one." (interactive) (if (not (eq major-mode 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (let ((server (read-from-minibuffer "Server: ")) (protocol (completing-read "Protocol: " (mapcar '(lambda (elt) (cons (symbol-name elt) elt)) eudc-known-protocols))) (buffer-read-only nil)) (if (not (eobp)) (forward-line 1)) (insert server) (indent-to 30) (insert protocol "\n"))) (defun eudc-hotlist-delete-server () "Delete the server at point from the list." (interactive) (if (not (eq major-mode 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (let ((buffer-read-only nil)) (save-excursion (beginning-of-line) (if (and (>= (point) eudc-hotlist-list-beginning) (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")) (kill-line 1) (error "No server on this line"))))) (defun eudc-hotlist-quit-edit () "Quit the hotlist editing mode and save changes to the hotlist." (interactive) (if (not (eq major-mode 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (let (hotlist) (goto-char eudc-hotlist-list-beginning) (while (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)") (setq hotlist (cons (cons (match-string 1) (intern (match-string 2))) hotlist)) (forward-line 1)) (if (not (looking-at "^[ \t]*$")) (error "Malformed entry in hotlist, discarding edits")) (setq eudc-server-hotlist (nreverse hotlist)) (eudc-install-menu) (eudc-save-options) (kill-this-buffer))) (defun eudc-hotlist-select-server () "Select the server at point as the current server." (interactive) (if (not (eq major-mode 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (save-excursion (beginning-of-line) (if (and (>= (point) eudc-hotlist-list-beginning) (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")) (progn (eudc-set-server (match-string 1) (intern (match-string 2))) (message "Current directory server is %s (%s)" eudc-server eudc-protocol)) (error "No server on this line")))) (defun eudc-hotlist-transpose-servers () "Swap the order of the server with the previous one in the list." (interactive) (if (not (eq major-mode 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (let ((buffer-read-only nil)) (save-excursion (beginning-of-line) (if (and (>= (point) eudc-hotlist-list-beginning) (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)") (progn (forward-line -1) (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))) (progn (forward-line 1) (transpose-lines 1)))))) (setq eudc-hotlist-mode-map (let ((map (make-sparse-keymap))) (define-key map "a" 'eudc-hotlist-add-server) (define-key map "d" 'eudc-hotlist-delete-server) (define-key map "s" 'eudc-hotlist-select-server) (define-key map "t" 'eudc-hotlist-transpose-servers) (define-key map "q" 'eudc-hotlist-quit-edit) (define-key map "x" 'kill-this-buffer) map)) (defconst eudc-hotlist-menu '("EUDC Hotlist Edit" ["---" nil nil] ["Add New Server" eudc-hotlist-add-server t] ["Delete Server" eudc-hotlist-delete-server t] ["Select Server" eudc-hotlist-select-server t] ["Transpose Servers" eudc-hotlist-transpose-servers t] ["Save and Quit" eudc-hotlist-quit-edit t] ["Exit without Saving" kill-this-buffer t])) (if eudc-emacs-p (easy-menu-define eudc-hotlist-emacs-menu eudc-hotlist-mode-map "" eudc-hotlist-menu)) ;;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8 ;;; eudc-hotlist.el ends here