view lisp/x-misc.el @ 5679:a81a739181dc

Add command remapping, a more robust alternative to #'substitute-key-definition src/ChangeLog addition: 2012-09-02 Aidan Kehoe <kehoea@parhasard.net> * keymap.c: Add command remapping, a more robust equivalent to #'substitute-key-definition. * keymap.c (CHECK_REMAPPING_POSITION): New. * keymap.c (keymap_equal): Correct a comment here. * keymap.c (Fdefine_key): Document the command remapping syntax. * keymap.c (Fremap_command): New. * keymap.c (command_remapping): New. * keymap.c (Fcommand_remapping): New. * keymap.c (commands_remapped_to_mapper): New. * keymap.c (commands_remapped_to_traverser): New. * keymap.c (Fcommands_remapped_to): New. * keymap.c (get_relevant_keymaps): Take a new POSITION argument. * keymap.c (Fcurrent_keymaps, event_binding): Supply the new POSITION argument to get_relevant_keymaps. * keymap.c (Fkey_binding): Add new arguments, NO-REMAP and POSITION. * keymap.c (map_keymap_mapper): * keymap.c (Fwhere_is_internal): * keymap.c (where_is_to_char): * keymap.c (where_is_recursive_mapper): Don't expose the key remapping in these functions. This conflicts with GNU, but is more sane for our callers. Access to command remapping is with the functions #'command-remapping, #'commands-remapped-to, and #'remap-command, not with the general keymap functions, apart from the compatibility hack in #'define-key. * keymap.c (syms_of_keymap): * keymap.c (vars_of_keymap): * keymap.c (complex_vars_of_keymap): * lisp.h: New CHECK_COMMAND macro. man/ChangeLog addition: 2012-09-02 Aidan Kehoe <kehoea@parhasard.net> * lispref/keymaps.texi (Keymaps): * lispref/keymaps.texi (Changing Key Bindings): * lispref/keymaps.texi (Scanning Keymaps): * lispref/keymaps.texi (Remapping commands): * lispref/keymaps.texi (XEmacs): New. * lispref/keymaps.texi (Other Keymap Functions): Document the new command remapping functionality in this file. lisp/ChangeLog addition: 2012-09-02 Aidan Kehoe <kehoea@parhasard.net> * help.el (describe-function-1): Document any command remapping that has been done in this function. tests/ChangeLog addition: 2012-09-02 Aidan Kehoe <kehoea@parhasard.net> * automated/keymap-tests.el: Test the new command remapping functionality.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 02 Sep 2012 14:31:40 +0100
parents 6506fcb40fcf
children
line wrap: on
line source

;;; x-misc.el --- miscellaneous X functions.

;; Copyright (C) 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995 Sun Microsystems.
;; Copyright (C) 1995, 1996 Ben Wing.

;; Author: Ben Wing <ben@xemacs.org>
;; Maintainer: XEmacs Development Team
;; Keywords: extensions, dumped

;; This file is part of XEmacs.

;; XEmacs 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 3 of the License, or (at your
;; option) any later version.

;; XEmacs 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 XEmacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file is dumped with XEmacs (when X support is compiled in).

;;; Code:

(globally-declare-fboundp
 '(x-get-resource))

(defun x-bogosity-check-resource (name class type)
  "Check for a bogus resource specification."
  (let ((bogus (x-get-resource
		(concat "__no-such-friggin-locale__." name)
		(concat "__No-such-friggin-widget__." class)
		type 'global nil t)))
    (if bogus
	(display-warning
	 'resource
	 (format "Bad resource specification encountered: something like
     Emacs*%s: %s
You should replace the * with a . in order to get proper behavior when
you use the specifier and/or `set-face-*' functions." name bogus)))))

(defun x-init-specifier-from-resources (specifier type locale
						  &rest resource-list)
  "Initialize a specifier from the resource database.
LOCALE specifies the locale that is to be initialized and should be
a frame, a device, or 'global.  TYPE is the type of the resource and
should be one of 'string, 'boolean, 'integer, or 'natnum.  The
remaining args should be conses of names and classes of resources
to be examined.  The first resource with a value specified becomes
the spec for SPECIFIER in LOCALE. (However, if SPECIFIER already
has a spec in LOCALE, nothing is done.) Finally, if LOCALE is 'global,
a check is done for bogus resource specifications."
  (if (eq locale 'global)
      (mapc #'(lambda (x)
                (x-bogosity-check-resource (car x) (cdr x) type))
            resource-list))
  (if (not (specifier-spec-list specifier locale))
      (catch 'done
	(while resource-list
	  (let* ((name (caar resource-list))
		 (class (cdar resource-list))
		 (resource
		  (x-get-resource name class type locale nil 'warn)))
	    (if resource
		(progn
		  (add-spec-to-specifier specifier resource locale)
		  (throw 'done t))))
	  (setq resource-list (cdr resource-list))))))

(defun x-get-resource-and-bogosity-check (name class type &optional locale)
  (x-bogosity-check-resource name class type)
  (x-get-resource name class type locale nil 'warn))

(defun x-get-resource-and-maybe-bogosity-check (name class type &optional
						     locale)
  (if (eq locale 'global)
      (x-bogosity-check-resource name class type))
  (x-get-resource name class type locale nil 'warn))

(defun device-x-display (&optional device)
  "If DEVICE is an X11 device, return its DISPLAY.

DEVICE defaults to the selected device."
  (and (eq 'x (device-type device)) (device-connection device)))

;;; x-misc.el ends here