Mercurial > hg > xemacs-beta
view lisp/gtk-init.el @ 5751:2b8edd304c2b
Avoid throwing an error with misc-user events in isearch-pre-command-hook.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* isearch-mode.el (isearch-pre-command-hook):
If this function is called and (this-command-keys) contains
misc-user events, #'key-binding throws an error.
Eddie Corns and Alex Belits describe this happening in tracker
issue 336, and we can avoid this by catching the error and
handling the misc-user event in the same way that #'dispatch-event
does.
I haven't reproduced the actual error they describe, and welcome
testing to make sure it's gone.
Thank you Eddie, thank you Alex!
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 05 Aug 2013 13:34:27 +0100 (2013-08-05) |
parents | 3d1f8f0e690f |
children |
line wrap: on
line source
;;; gtk-init.el --- initialization code for mswindows ;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. ;; Copyright (C) 1995 Board of Trustees, University of Illinois. ;; Copyright (C) 1995, 1996 Ben Wing. ;; Author: various ;; Rewritten for Gtk by: William Perry ;; 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/>. (globally-declare-boundp '(gtk-initial-argv-list gtk-initial-geometry)) (globally-declare-fboundp '(gtk-keysym-on-keyboard-p)) (defvar gtk-early-lisp-options-file "~/.xemacs/gtk-options.el" "Path where GTK-specific early options should be stored. This allows the user to set initial geometry without using GNOME and session management, and, since it is read before GTK is initialized, it avoids window flicker on resizing. It is normally not useful to change without recompiling XEmacs.") (defvar gtk-command-switch-alist '( ;; GNOME Options ("--disable-sound" . nil) ("--enable-sound" . nil) ("--espeaker" . t) ;; GTK Options ("--gdk-debug" . t) ("--gdk-no-debug" . t) ("--display" . t) ("--sync" . nil) ("--no-xshm" . nil) ("--name" . t) ("--class" . t) ("--gxid_host" . t) ("--gxid_port" . t) ("--xim-preedit" . t) ("--xim-status" . t) ("--gtk-debug" . t) ("--gtk-no-debug" . t) ("--gtk-module" . t) ;; Glib options ("--g-fatal-warnings" . nil) ;; Session management options ("--sm-client-id" . t) ("--sm-config-prefix" . t) ("--sm-disable" . t) ) "An assoc list of command line args that should be in gtk-initial-argv-list. This is necessary because GTK and GNOME consider it a fatal error if they receive unknown command line arguments (perfectly reasonable). But this means that if the user specifies a file name on the command line they will be unable to start. So we filter the command line and allow only items in this list in. The CDR of the assoc list is whether it accepts an argument. For the moment, all options are in GNU long form.") (defvar make-device-early-gtk-entry-point-called-p nil "Whether `make-device-early-gtk-entry-point' has been called, at least once. Much of the GTK-specific Lisp init code should only be called the first time a GTK device is created; this variable allows for that.") (defvar make-device-late-gtk-entry-point-called-p nil "Whether `make-device-late-gtk-entry-point' has been called, at least once. Much of the GTK-specific Lisp init code should only be called the first time a GTK device is created; this variable allows for that.") (defun make-device-early-gtk-entry-point () "Entry point to set up the Lisp environment before GTK device creation." (unless make-device-early-gtk-entry-point-called-p (setq initial-frame-plist (and initial-frame-unmapped-p '(initially-unmapped t)) gtk-initial-argv-list (cons (car command-line-args) (gtk-filter-arguments)) gtk-initial-geometry (nth 1 (member "-geometry" command-line-args-left)) make-device-early-gtk-entry-point-called-p t) (unless vanilla-inhibiting (load gtk-early-lisp-options-file t t t)))) (defun gtk-init-handle-geometry (arg) "Set up initial geometry info for GTK devices." (setq gtk-initial-geometry (pop command-line-args-left))) (defun make-device-late-gtk-entry-point (device) "Entry-Point to do any Lisp-level GTK device-specific initialization." (unless make-device-late-gtk-entry-point-called-p (setq make-device-late-gtk-entry-point-called-p t))) (defun gtk-filter-arguments () (let ((accepted nil) (rejected nil) (todo nil)) (setq todo (mapcar (lambda (argdesc) (if (cdr argdesc) ;; Need to look for --foo=bar (concat "^" (car argdesc) "=") ;; Just a simple arg (concat "^" (regexp-quote (car argdesc)) "$"))) gtk-command-switch-alist)) (while command-line-args-left (if (catch 'found (mapc (lambda (r) (if (string-match r (car command-line-args-left)) (throw 'found t))) todo) (mapc (lambda (argdesc) (if (cdr argdesc) ;; This time we only care about argument items ;; that take an argument. We'll check to see if ;; someone used --foo bar instead of --foo=bar (if (string-match (concat "^" (car argdesc) "$") (car command-line-args-left)) ;; Yup! Need to push (progn (push (pop command-line-args-left) accepted) (throw 'found t))))) gtk-command-switch-alist) nil) (push (pop command-line-args-left) accepted) (push (pop command-line-args-left) rejected))) (setq command-line-args-left (nreverse rejected)) (nreverse accepted))) (push '("-geometry" . gtk-init-handle-geometry) command-switch-alist)