view lisp/double.el @ 59146:9bde7721ad0f

* dispextern.h: Change HAVE_CARBON to MAC_OS. (struct glyph_string): Likewise. * emacs.c (main) [MAC_OS8]: Call mac_term_init instead of mac_initialize. * fileio.c (Fnext_read_file_uses_dialog_p, Fread_file_name): Change TARGET_API_MAC_CARBON to HAVE_CARBON. * fns.c (vector): Change MAC_OSX to MAC_OS. * frame.c (x_set_frame_parameters, x_report_frame_params) (x_set_fullscreen): Remove #ifndef HAVE_CARBON. (x_set_border_width, Vdefault_frame_scroll_bars): Change HAVE_CARBON to MAC_OS. * image.c [MAC_OS]: Include sys/stat.h. [MAC_OS && !MAC_OSX]: Include sys/param.h, ImageCompression.h, and QuickTimeComponents.h. * mac.c [!MAC_OSX] (mac_wait_next_event): Add extern. [!MAC_OSX] (select): Use mac_wait_next_event. [!MAC_OSX] (run_mac_command): Change EXEC_SUFFIXES to Vexec_suffixes. [!MAC_OSX] (select, run_mac_command): Change `#ifdef TARGET_API_MAC_CARBON' to `#if TARGET_API_MAC_CARBON'. (mac_clear_font_name_table): Add extern. (Fmac_clear_font_name_table): New defun. (syms_of_mac): Defsubr it. [MAC_OSX] (SELECT_POLLING_PERIOD_USEC): New define. [MAC_OSX] (select_and_poll_event): New function. [MAC_OSX] (sys_select): Use it. [MAC_OSX && SELECT_USE_CFSOCKET] (socket_callback): New function. [MAC_OSX && SELECT_USE_CFSOCKET] (SELECT_TIMEOUT_THRESHOLD_RUNLOOP, EVENT_CLASS_SOCK): New defines. [MAC_OSX] (sys_select) [SELECT_USE_CFSOCKET]: Use CFSocket and RunLoop for simultaneously monitoring two kinds of inputs, window events and process outputs, without periodically polling. * macfns.c (mac_initialized): Remove extern. (stricmp): Put in #if 0. All callers changed to use xstricmp in xfaces.c. (strnicmp): Decrement `n' at the end of each loop, not the beginning. (check_mac): Use the term "Mac native windows" instead of "Mac OS". (check_x_display_info, x_display_info_for_name): Sync with xfns.c. (mac_get_rdb_resource): New function (from w32reg.c). (x_get_string_resource): Use it. (install_window_handler): Add extern. (mac_window): New function. (Fx_create_frame): Use it instead of make_mac_frame. Set parameter for Qfullscreen. Call x_wm_set_size_hint. (Fx_open_connection, Fx_close_connection): New defuns. (syms_of_macfns): Defsubr them. (x_create_tip_frame) [TARGET_API_MAC_CARBON]: Add kWindowNoUpdatesAttribute to the window attribute. (x_create_tip_frame) [!TARGET_API_MAC_CARBON]: Use NewCWindow. (x_create_tip_frame): Don't call ShowWindow. (Fx_show_tip): Call ShowWindow. (Fx_file_dialog): Change `#ifdef TARGET_API_MAC_CARBON' to `#if TARGET_API_MAC_CARBON'. (mac_frame_parm_handlers): Set handlers for Qfullscreen. (syms_of_macfns) [MAC_OSX]: Initialize mac_in_use to 0. * macgui.h [!MAC_OSX]: Don't include Controls.h. Include Windows.h. (Window): Typedef to WindowPtr and move outside `#if TARGET_API_MAC_CARBON'. (XSizeHints): New struct. * macterm.c (x_update_begin, x_update_end) [TARGET_API_MAC_CARBON]: Disable screen updates during update of a frame. (x_draw_glyph_string_background, x_draw_glyph_string_foreground) [MAC_OS8]: Use XDrawImageString/XDrawImageString16. (construct_mouse_click): Put in #if 0. (x_check_fullscreen, x_check_fullscreen_move): Remove decls. (x_scroll_bar_create, x_scroll_bar_handle_click): Change `#ifdef TARGET_API_MAC_CARBON' to `#if TARGET_API_MAC_CARBON'. (activate_scroll_bars, deactivate_scroll_bars) [!TARGET_API_MAC_CARBON]: Use ActivateControl/DeactivateControl. (x_make_frame_visible) [TARGET_API_MAC_CARBON]: Reposition window if the position is neither user-specified nor program-specified. (x_free_frame_resources): Free size_hints. (x_wm_set_size_hint): Allocate size_hints if needed. Set size_hints. (mac_clear_font_name_table): New function. (mac_do_list_fonts): Initialize font_name_table if needed. (x_list_fonts): Don't initialize font_name_table. Add BLOCK_INPUT around mac_do_list_fonts. (mac_unload_font): New function. (x_load_font): Add BLOCK_INPUT around XLoadQueryFont. (init_mac_drag_n_drop, mac_do_receive_drag): Enclose declarations and definitions with #if TARGET_API_MAC_CARBON. [USE_CARBON_EVENTS] (mac_handle_window_event): Add decl. (install_window_handler): Add decl. (do_window_update): Add BeginUpdate/EndUpdate for the tooltip window. Use UpdateControls. Get the rectangle that should be updated and restrict the target of expose_frame to it. (do_grow_window): Set minimum height/width according to size_hints. (do_grow_window) [TARGET_API_MAC_CARBON]: Use ResizeWindow. (do_zoom_window): Don't use x_set_window_size. [USE_CARBON_EVENTS] (mac_handle_window_event): New function. (install_window_handler): New function. [!USE_CARBON_EVENTS] (mouse_region): New variable. [!USE_CARBON_EVENTS] (mac_wait_next_event): New function. (XTread_socket) [USE_CARBON_EVENTS]: Move call to GetEventDispatcherTarget inside BLOCK_INPUT. (XTread_socket) [!USE_CARBON_EVENTS]: Use mac_wait_next_event. Update mouse_region when mouse is moved. (make_mac_frame): Remove. (make_mac_terminal_frame): Put in #ifdef MAC_OS8. Initialize mouse pointer shapes. Change values of f->left_pos and f->top_pos. Don't use make_mac_frame. Use NewCWindow. Don't call ShowWindow. (mac_initialize_display_info) [MAC_OSX]: Create mac_id_name from Vinvocation_name and Vsystem_name. (mac_make_rdb): New function (from w32term.c). (mac_term_init): Use it. Add BLOCK_INPUT. Error if display has already been opened. Don't pass argument to mac_initialize_display_info. Don't set dpyinfo->height/width. Add entries to x_display_list and x_display_name_list. (x_delete_display): New function. (mac_initialize): Don't call mac_initialize_display_info. (syms_of_macterm) [!MAC_OSX]: Don't call Fprovide. * macterm.h (check_mac): Add extern. (struct mac_output): New member size_hints. (FRAME_SIZE_HINTS): New macro. (mac_unload_font): Add extern. * xdisp.c (expose_window, expose_frame): Remove kludges for Mac. * xfaces.c (clear_font_table) [MAC_OS]: call mac_unload_font.
author Steven Tamm <steventamm@mac.com>
date Mon, 27 Dec 2004 17:27:30 +0000
parents 695cf19ef79e
children 789a36c2bc56 375f2633d815
line wrap: on
line source

;;; double.el --- support for keyboard remapping with double clicking

;; Copyright (C) 1994, 1997, 1998 Free Software Foundation, Inc.

;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: i18n

;; 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:

;; This mode is intended for use with languages that adds a small
;; number of extra letters not available on the keyboard.
;;
;; Examples includes Scandinavian and German with an US keyboard.
;;
;; The idea is that certain keys are overloaded.  When you press it
;; once it will insert one string, and when you press it twice the
;; string will be replaced by another.  This can be used for mapping
;; keys on a US keyboard to generate characters according to the local
;; keyboard convention when pressed once, and according to US keyboard
;; convention when pressed twice.
;;
;; To use this mode, you must define the variable `double-map' and
;; then enable double mode with `M-x double-mode'.  Read the
;; documentation for both of them.
;;
;; The default mapping is for getting Danish/Norwegian keyboard layout
;; using ISO Latin 1 on a US keyboard.
;;
;; Important node: While I would like to hear comments, bug reports,
;; suggestions, please do @strong{not} expect me to put other mappings
;; than the default into this file.  There are billions and billions
;; of such mappings, and just supporting the most common would
;; increase the size of this nice small file manyfold.

;;; Code:

(defgroup double nil
  "Remap keyboard, but get original by typing the same key twice."
  :group 'i18n)

(defcustom double-map
  '((?\; "\346" ";")
    (?\' "\370" "'")
    (?\[ "\345" "[")
    (?\: "\306" ":")
    (?\" "\330" "\"")
    (?\{ "\305" "{"))
  "Alist of key translations activated by double mode.

Each entry is a list with three elements:
1. The key activating the translation.
2. The string to be inserted when the key is pressed once.
3. The string to be inserted when the key is pressed twice."
  :group 'double
  :type '(repeat (list (character :tag "Key")
		       (string :tag "Once")
		       (string :tag "Twice"))))

(defcustom double-prefix-only t
  "*Non-nil means that Double mode mapping only works for prefix keys.
That is, for any key `X' in `double-map', `X' alone will be mapped
but not `C-u X' or `ESC X' since the X is not the prefix key."
  :group 'double
  :type 'boolean)

;;; Read Event

(defvar double-last-event nil)
;; The last key that generated a double key event.

(defun double-read-event (prompt)
  ;; Read an event
  (if isearch-mode (isearch-update))
  (if prompt
      (prog2 (message "%s%c" prompt double-last-event)
	  (read-event)
	(message ""))
    (read-event)))

(global-set-key [ignore] '(lambda () (interactive)))

(or (boundp 'isearch-mode-map)
    (load-library "isearch"))

(define-key isearch-mode-map [ignore]
  (function (lambda () (interactive) (isearch-update))))

(defun double-translate-key (prompt)
  ;; Translate input events using double map.
  (let ((key last-input-char))
    (cond (unread-command-events
	   ;; Artificial event, ignore it.
	   (vector key))
	  ((and double-prefix-only
		(> (length (this-command-keys)) 1))
	   ;; This is not a prefix key, ignore it.
	   (vector key))
	  ((eq key 'magic-start)
	   ;; End of generated event.  See if he will repeat it...
	   (let ((new (double-read-event prompt))
		 (entry (assoc double-last-event double-map)))
	     (if (eq new double-last-event)
		 (progn
		   (setq unread-command-events
			 (append (make-list (1- (length (nth 1 entry)))
					    127)
				 (nth 2 entry)
				 '(magic-end)))
		   (vector 127))
	       (setq unread-command-events (list new))
	       [ignore])))
	  ((eq key 'magic-end)
	   ;; End of double event.  Ignore.
	   [ignore])
	  (t
	   ;; New key.
	   (let ((exp (nth 1 (assoc key double-map))))
	     (setq double-last-event key)
	     (setq unread-command-events
		   (append (substring exp 1) '(magic-start)))
	     (vector (aref exp 0)))))))

;;; Key Translation Map

(defun double-setup (enable-flag)
  (if enable-flag
      (progn
	;; Set up key-translation-map as indicated by `double-map'.
	(kill-local-variable 'key-translation-map)
	(make-local-variable 'key-translation-map)
	(setq key-translation-map (if (keymapp key-translation-map)
				      (copy-keymap key-translation-map)
				    (make-sparse-keymap)))
	(mapcar (function (lambda (entry)
			    (define-key key-translation-map
			      (vector (nth 0 entry))
			      'double-translate-key)))
		(append double-map '((magic-start) (magic-end)))))
    (kill-local-variable 'key-translation-map)))

;;; Mode

;;;###autoload
(defcustom double-mode nil
  "Toggle Double mode.
Setting this variable directly does not take effect;
use either \\[customize] or the function `double-mode'."
  :set (lambda (symbol value)
	 (double-mode (if value 1 0)))
  :initialize 'custom-initialize-default
  :link '(emacs-commentary-link "double")
  :type 'boolean
  :require 'double
  :group 'double)
(make-variable-buffer-local 'double-mode)

(or (assq 'double-mode minor-mode-alist)
    (setq minor-mode-alist
	  (cons '(double-mode " Double") minor-mode-alist)))

;; This feature seemed useless and it confused describe-mode,
;;  so I deleted it.
;;;(defvar double-mode-name "Double")
;;;;; Name of current double mode.
;;; (make-variable-buffer-local 'double-mode-name)

;;;###autoload
(defun double-mode (arg)
  "Toggle Double mode.
With prefix arg, turn Double mode on iff arg is positive.

When Double mode is on, some keys will insert different strings
when pressed twice.  See variable `double-map' for details."
  (interactive "P")
  (if (or (and (null arg) double-mode)
	  (<= (prefix-numeric-value arg) 0))
      ;; Turn it off
      (if double-mode
	  (progn
	    (let ((double-map))
	      (double-setup nil))
	    (setq double-mode nil)
	    (force-mode-line-update)))
    ;;Turn it on
    (if double-mode
	()
      (double-setup t)
      (setq double-mode t)
      (force-mode-line-update))))

(provide 'double)

;;; arch-tag: 2e170036-44cb-4493-bc32-ada0a4395221
;;; double.el ends here