2000-05-20 Ben Wing <ben(a)xemacs.org&gt; * event-Xt.c: * event-Xt.c (vars_of_event_Xt): move modifier-keys-are-sticky to event-stream.c. * event-msw.c: * event-msw.c (mswindows_enqueue_mouse_button_event): * event-msw.c (key_needs_default_processing_p): * event-msw.c (XEMSW_LCONTROL): * event-msw.c (mswindows_handle_sticky_modifiers): * event-msw.c (FROB): * event-msw.c (clear_sticky_modifiers): * event-msw.c (output_modifier_keyboard_state): * event-msw.c (output_alt_keyboard_state): * event-msw.c (mswindows_wnd_proc): * event-msw.c (mswindows_modifier_state): * event-msw.c (emacs_mswindows_handle_magic_event): implement sticky modifiers. * event-stream.c: * event-stream.c (vars_of_event_stream): move modifier-keys-are-sticky here. * lisp.h: add CHECK_FUNCTION. * rangetab.c: implement map-range-table. 2000-05-20 Ben Wing <ben(a)xemacs.org&gt; * font-lock.el: * font-lock.el (font-lock-message-threshold): * font-lock.el (font-lock-mode): * font-lock.el (font-lock-default-fontify-buffer): * font-lock.el (font-lock-always-fontify-immediately): * font-lock.el (font-lock-old-extent): Removed. * font-lock.el (font-lock-old-len): Removed. * font-lock.el (font-lock-fontify-glumped-region): Removed. * font-lock.el (font-lock-pending-extent-table): New. * font-lock.el (font-lock-range-table): New. * font-lock.el (font-lock-after-change-function): * font-lock.el (font-lock-after-change-function-1): Removed. * font-lock.el (font-lock-fontify-pending-extents): New. * font-lock.el ('font-lock-revert-cleanup): Removed. * font-lock.el ('font-lock-revert-setup): Removed. Rewrite deferral code to handle any number of changes, merging them properly. Remove hacked-up code for revert-buffer, now unnecessary. * menubar-items.el (default-menubar): In Options->Edit Init File, don't switch to emacs-lisp-mode unless necessary; doing this turns off font-lock. ? fixup-427-5.diff ? lib-src/etags.pdb ? lib-src/hexl.pdb ? lib-src/i.pdb ? lib-src/make-docfile.pdb ? lib-src/mmencode.pdb ? lib-src/movemail.pdb ? lib-src/run.res ? lib-src/sorted-doc.pdb ? lib-src/vc50.pdb ? lib-src/wakeup.pdb ? lisp/process2.el ? nt/obj ? src/event-msw.c.backup ? src/glyphs-msw.c.2 ? src/NEEDTODUMP ? src/runxemacs.pdb ? src/temacs.bsc ? src/temacs.map ? src/temacs.opt ? src/temacs.pdb ? src/xemacs.opt ? src/Xpm.dll cvs server: Diffing . cvs server: Diffing dynodump cvs server: Diffing dynodump/i386 cvs server: Diffing dynodump/ppc cvs server: Diffing dynodump/sparc cvs server: Diffing etc cvs server: Diffing etc/custom cvs server: Diffing etc/custom/example-themes cvs server: Diffing etc/eos cvs server: Diffing etc/idd cvs server: Diffing etc/photos cvs server: Diffing etc/sparcworks cvs server: Diffing etc/tests cvs server: Diffing etc/tests/external-widget cvs server: Diffing etc/toolbar cvs server: Diffing info cvs server: Diffing lib-src cvs server: Diffing lisp Index: lisp/font-lock.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/font-lock.el,v retrieving revision 1.7.2.15 diff -u -r1.7.2.15 font-lock.el --- font-lock.el 2000/04/03 10:22:52 1.7.2.15 +++ font-lock.el 2000/05/21 01:31:15 ＠＠ -178,8 +178,8 ＠＠ but not `font-lock-fontify-buffer'. (In other words, when you first visit a file and it gets fontified, you will see status messages no matter what size the file is. However, if you do something else like paste a -chunk of text or revert a buffer, you will see status messages only if the -changed region is large enough.) +chunk of text, you will see status messages only if the changed region is +large enough.) Note that setting `font-lock-verbose' to nil disables the status messages entirely." ＠＠ -829,11 +829,6 ＠＠ (set (make-local-variable 'font-lock-mode) on-p) (cond (on-p (font-lock-set-defaults-1) - (make-local-hook 'before-revert-hook) - (make-local-hook 'after-revert-hook) - ;; If buffer is reverted, must clean up the state. - (add-hook 'before-revert-hook 'font-lock-revert-setup nil t) - (add-hook 'after-revert-hook 'font-lock-revert-cleanup nil t) (run-hooks 'font-lock-mode-hook) (cond (font-lock-fontified nil) ＠＠ -845,13 +840,9 ＠＠ (buffer-name))))) (font-lock-fontified (setq font-lock-fontified nil) - (remove-hook 'before-revert-hook 'font-lock-revert-setup t) - (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) (font-lock-unfontify-region (point-min) (point-max)) (font-lock-thing-lock-cleanup)) (t - (remove-hook 'before-revert-hook 'font-lock-revert-setup t) - (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) (font-lock-thing-lock-cleanup))) (redraw-modeline))) ＠＠ -974,45 +965,46 ＠＠ (defun font-lock-unfontify-region (beg end &optional loudly) (funcall font-lock-unfontify-region-function beg end loudly)) -;; #### In these functions, the FSF is careful to do -;; (save-restriction -;; (widen) -;; before anything else. Should we copy? (defun font-lock-default-fontify-buffer () (interactive) - (let ((was-on font-lock-mode) - (font-lock-verbose (or font-lock-verbose (interactive-p))) - (font-lock-message-threshold 0) - (aborted nil)) - ;; Turn it on to run hooks and get the right font-lock-keywords. - (or was-on (font-lock-mode 1)) - (font-lock-unfontify-region (point-min) (point-max) t) -;; (buffer-syntactic-context-flush-cache) + ;; if we don't widen, then the C code will fail to + ;; realize that we're inside a comment. + (save-restriction + (widen) + (let ((was-on font-lock-mode) + (font-lock-verbose (or font-lock-verbose (interactive-p))) + (font-lock-message-threshold 0) + (aborted nil)) + ;; Turn it on to run hooks and get the right font-lock-keywords. + (or was-on (font-lock-mode 1)) + (font-lock-unfontify-region (point-min) (point-max) t) + ;; (buffer-syntactic-context-flush-cache) - ;; If a ^G is typed during fontification, abort the fontification, but - ;; return normally (do not signal.) This is to make it easy to abort - ;; fontification if it's taking a long time, without also causing the - ;; buffer not to pop up. If a real abort is desired, the user can ^G - ;; again. - ;; - ;; Possibly this should happen down in font-lock-fontify-region instead - ;; of here, but since that happens from the after-change-hook (meaning - ;; much more frequently) I'm afraid of the bad consequences of stealing - ;; the interrupt character at inopportune times. - ;; - (condition-case nil - (save-excursion - (font-lock-fontify-region (point-min) (point-max))) - (t - (setq aborted t))) - - (or was-on ; turn it off if it was off. - (let ((font-lock-fontified nil)) ; kludge to prevent defontification - (font-lock-mode 0))) - (set (make-local-variable 'font-lock-fontified) t) - (when (and aborted font-lock-verbose) - (lprogress-display 'font-lock "Fontifying %s... aborted." 'abort (buffer-name)))) - (run-hooks 'font-lock-after-fontify-buffer-hook)) + ;; If a ^G is typed during fontification, abort the fontification, but + ;; return normally (do not signal.) This is to make it easy to abort + ;; fontification if it's taking a long time, without also causing the + ;; buffer not to pop up. If a real abort is desired, the user can ^G + ;; again. + ;; + ;; Possibly this should happen down in font-lock-fontify-region instead + ;; of here, but since that happens from the after-change-hook (meaning + ;; much more frequently) I'm afraid of the bad consequences of stealing + ;; the interrupt character at inopportune times. + ;; + (condition-case nil + (save-excursion + (font-lock-fontify-region (point-min) (point-max))) + (t + (setq aborted t))) + + (or was-on ; turn it off if it was off. + (let ((font-lock-fontified nil)) ; kludge to prevent defontification + (font-lock-mode 0))) + (set (make-local-variable 'font-lock-fontified) t) + (when (and aborted font-lock-verbose) + (lprogress-display 'font-lock "Fontifying %s... aborted." + 'abort (buffer-name)))) + (run-hooks 'font-lock-after-fontify-buffer-hook))) (defun font-lock-default-unfontify-buffer () (font-lock-unfontify-region (point-min) (point-max)) ＠＠ -1058,10 +1050,7 ＠＠ (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))) ;; Following is the original FSF version (similar to our original -;; version, before all the crap I added below). -;; -;; Probably that crap should either be fixed up so it works better, -;; or tossed away. +;; version, before the deferred stuff was added). ;; ;; I think that lazy-lock v2 tries to do something similar. ;; Those efforts should be merged. ＠＠ -1075,111 +1064,97 ＠＠ ; (progn (goto-char beg) (beginning-of-line) (point)) ; (progn (goto-char end) (forward-line 1) (point)))))) -(defvar font-lock-old-extent nil) -(defvar font-lock-old-len 0) +(defvar font-lock-always-fontify-immediately nil + "Set this to non-nil to disable font-lock deferral. +Otherwise, changes to existing text will not be processed until the +next redisplay cycle, avoiding excessive fontification when many +buffer modifications are performed or a buffer is reverted.") -(defun font-lock-fontify-glumped-region () - ;; even if something goes wrong in the fontification, mark the glumped - ;; region as fontified; otherwise, the same error might get signaled - ;; after every command. - (unwind-protect - ;; buffer/extent may be deleted. - (if (and (extent-live-p font-lock-old-extent) - (buffer-live-p (extent-object font-lock-old-extent))) - (save-excursion - (set-buffer (extent-object font-lock-old-extent)) - (font-lock-after-change-function-1 - (extent-start-position font-lock-old-extent) - (extent-end-position font-lock-old-extent) - font-lock-old-len))) - (detach-extent font-lock-old-extent) - (setq font-lock-old-extent nil))) +(defvar font-lock-pending-extent-table (make-hash-table :weakness 'key)) +(defvar font-lock-range-table (make-range-table)) (defun font-lock-pre-idle-hook () - (condition-case nil - (if font-lock-old-extent - (font-lock-fontify-glumped-region)) - (error (warn "Error caught in `font-lock-pre-idle-hook'")))) - -(defvar font-lock-always-fontify-immediately nil - "Set this to non-nil to disable font-lock deferral.") + (condition-case font-lock-error + (if (> (hash-table-count font-lock-pending-extent-table) 0) + (font-lock-fontify-pending-extents)) + (error (warn "Error caught in `font-lock-pre-idle-hook': %s" + font-lock-error)))) ;;; called when any modification is made to buffer text. This function -;;; attempts to glump adjacent changes together so that excessive -;;; fontification is avoided. This function could easily be adapted -;;; to other after-change-functions. +;;; remembers the changed ranges until the next redisplay, at which point +;;; the extents are merged and pruned, and the resulting ranges fontified. +;;; This function could easily be adapted to other after-change-functions. (defun font-lock-after-change-function (beg end old-len) - (let ((obeg (and font-lock-old-extent - (extent-start-position font-lock-old-extent))) - (oend (and font-lock-old-extent - (extent-end-position font-lock-old-extent))) - (bc-end (+ beg old-len))) - - ;; If this change can't be merged into the glumped one, - ;; we need to fontify the glumped one right now. - (if (and font-lock-old-extent - (or (not (eq (current-buffer) - (extent-object font-lock-old-extent))) - (< bc-end obeg) - (> beg oend))) - (font-lock-fontify-glumped-region)) - - (if font-lock-old-extent - ;; Update glumped region. - (progn - ;; Any characters in the before-change region that are - ;; outside the glumped region go into the glumped - ;; before-change region. - (if (> bc-end oend) - (setq font-lock-old-len (+ font-lock-old-len (- bc-end oend)))) - (if (> obeg beg) - (setq font-lock-old-len (+ font-lock-old-len (- obeg beg)))) - ;; New glumped region is the union of the glumped region - ;; and the new region. - (set-extent-endpoints font-lock-old-extent - (min obeg beg) - (max oend end))) - - ;; No glumped region, so create one. - (setq font-lock-old-extent (make-extent beg end)) - (set-extent-property font-lock-old-extent 'detachable nil) - (set-extent-property font-lock-old-extent 'end-open nil) - (setq font-lock-old-len old-len)) - + (when font-lock-mode + (let ((ex (make-extent beg end))) + (set-extent-property ex 'detachable nil) + (set-extent-property ex 'end-open nil) + (let ((exs (gethash (current-buffer) font-lock-pending-extent-table))) + (push ex exs) + (puthash (current-buffer) exs font-lock-pending-extent-table))) (if font-lock-always-fontify-immediately - (font-lock-fontify-glumped-region)))) + (font-lock-fontify-pending-extents)))) -(defun font-lock-after-change-function-1 (beg end old-len) - (if (null font-lock-mode) - nil - (save-excursion - (save-restriction - ;; if we don't widen, then fill-paragraph (and any command that - ;; operates on a narrowed region) confuses things, because the C - ;; code will fail to realize that we're inside a comment. - (widen) - (save-match-data - (let ((zmacs-region-stays zmacs-region-stays)) ; protect from change! - (goto-char beg) - ;; Maybe flush the internal cache used by syntactically-sectionize. - ;; (It'd be nice if this was more automatic.) Any deletions mean - ;; the cache is invalid, and insertions at beginning or end of line - ;; mean that the bol cache might be invalid. -;; (if (or (> old-len 0) (bobp) (= (preceding-char) ?\n)) -;; (buffer-syntactic-context-flush-cache)) - - ;; Always recompute the whole line. - (goto-char end) - (forward-line 1) - (setq end (point)) - (goto-char beg) - (beginning-of-line) - (setq beg (point)) - ;; Rescan between start of line from `beg' and start of line after - ;; `end'. - (font-lock-fontify-region beg end))))))) - +(defun font-lock-fontify-pending-extents () + ;; ah, the beauty of mapping functions. + ;; this function is actually shorter than the old version, which handled + ;; only one buffer and one contiguous region! + (save-match-data + (maphash + #'(lambda (buffer exs) + ;; remove first, to avoid infinite reprocessing if error + (remhash buffer font-lock-pending-extent-table) + (when (buffer-live-p buffer) + (clear-range-table font-lock-range-table) + (with-current-buffer buffer + (save-excursion + (save-restriction + ;; if we don't widen, then the C code will fail to + ;; realize that we're inside a comment. + (widen) + (let ((zmacs-region-stays + zmacs-region-stays)) ; protect from change! + (mapc + #'(lambda (ex) + ;; paranoia. + (when (and (extent-live-p ex) + (not (extent-detached-p ex))) + ;; first expand the ranges to full lines, because + ;; that is what will be fontified; then use a + ;; range table to merge the ranges. + (let* ((beg (extent-start-position ex)) + (end (extent-end-position ex)) + (beg (progn (goto-char beg) + (beginning-of-line) + (point))) + (end (progn (goto-char end) + (forward-line 1) + (point)))) + (detach-extent ex) + (put-range-table beg end t + font-lock-range-table)))) + exs) + (map-range-table + #'(lambda (beg end val) + ;; Maybe flush the internal cache used by + ;; syntactically-sectionize. (It'd be nice if this + ;; was more automatic.) Any deletions mean the + ;; cache is invalid, and insertions at beginning or + ;; end of line mean that the bol cache might be + ;; invalid. + ;; #### This code has been commented out for some time + ;; now and is bit-rotting. Someone should look into + ;; this. +;; (if (or change-was-deletion (bobp) +;; (= (preceding-char) ?\n)) +;; (buffer-syntactic-context-flush-cache)) + (if (and (= beg (point-min)) + (= end (point-max))) + (font-lock-fontify-buffer) + (font-lock-fontify-region beg end))) + font-lock-range-table))))))) + font-lock-pending-extent-table))) ;; Syntactic fontification functions. ＠＠ -1567,28 +1542,6 ＠＠ ((and (boundp 'lazy-lock-mode) lazy-lock-mode) (lazy-lock-after-fontify-buffer)))) -;; If the buffer is about to be reverted, it won't be fontified afterward. -;(defun font-lock-revert-setup () -; (setq font-lock-fontified nil)) - -;; If the buffer has just been reverted, normally that turns off -;; Font Lock mode. So turn the mode back on if necessary. -;; sb 1999-03-03 -- The above comment no longer appears to be operative as -;; the first call to normal-mode *will* restore the font-lock state and -;; this call forces a second font-locking to occur when reverting a buffer, -;; which is wasteful at best. -;;(defun font-lock-revert-cleanup ()) - -;; <andy(a)xemacs.org&gt; 12-10-99. This still does not work right, I think -;; after change functions will still get us. The simplest thing to do -;; is unconditionally turn-off font-lock before revert (and thus nuke -;; all hooks) and then turn it on again afterwards. This also happens -;; to be much faster because fontifying from scratch is better than -;; trying to do incremental changes for the whole buffer. - -(defalias 'font-lock-revert-cleanup 'turn-on-font-lock) -(defalias 'font-lock-revert-setup 'turn-off-font-lock) - ;; Various functions. ＠＠ -2369,7 +2322,7 ＠＠ ;; Class names: (list (concat "\\<\\(class\\|interface\\)\\>\\s *" - java-font-lock-identifier-regexp) + java-font-lock-identifier-regexp) 2 'font-lock-function-name-face) ;; Package declarations: Index: lisp/menubar-items.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/menubar-items.el,v retrieving revision 1.6.2.28 diff -u -r1.6.2.28 menubar-items.el --- menubar-items.el 2000/05/11 10:29:30 1.6.2.28 +++ menubar-items.el 2000/05/21 01:31:16 ＠＠ -1374,7 +1374,8 ＠＠ ;; #### there should be something that holds the name that the init ;; file should be created as, when it's not present. (progn (find-file (or user-init-file "~/.emacs")) - (emacs-lisp-mode))] + (or (eq major-mode 'emacs-lisp-mode) + (emacs-lisp-mode)))] ["%_Save Options to .emacs File" customize-save-customized] ) cvs server: Diffing lisp/mule cvs server: Diffing lisp/term cvs server: Diffing lock cvs server: Diffing lwlib cvs server: Diffing man cvs server: Diffing man/internals cvs server: Diffing man/lispref cvs server: Diffing man/new-users-guide cvs server: Diffing man/xemacs cvs server: Diffing modules cvs server: Diffing modules/base64 cvs server: Diffing modules/ldap cvs server: Diffing modules/sample cvs server: Diffing modules/zlib cvs server: Diffing nt cvs server: Diffing nt/inc cvs server: Diffing nt/inc/arpa cvs server: Diffing nt/inc/netinet cvs server: Diffing nt/inc/sys cvs server: Diffing nt/installer cvs server: Diffing nt/installer/Wise cvs server: Diffing src Index: src/event-Xt.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-Xt.c,v retrieving revision 1.41.2.25 diff -u -r1.41.2.25 event-Xt.c --- event-Xt.c 2000/04/28 15:17:17 1.41.2.25 +++ event-Xt.c 2000/05/21 01:31:22 ＠＠ -86,8 +86,6 ＠＠ /* Do we accept events sent by other clients? */ int x_allow_sendevents; -int modifier_keys_are_sticky; - #ifdef DEBUG_XEMACS int x_debug_events; #endif ＠＠ -3159,15 +3157,6 ＠＠ staticpro (&dispatch_event_queue); dispatch_event_queue_tail = Qnil; pdump_wire (&dispatch_event_queue_tail); - - DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /* -*Non-nil makes modifier keys sticky. -This means that you can release the modifier key before pressing down -the key that you wish to be modified. Although this is non-standard -behavior, it is recommended because it reduces the strain on your hand, -thus reducing the incidence of the dreaded Emacs-pinky syndrome. -*/ ); - modifier_keys_are_sticky = 0; DEFVAR_BOOL ("x-allow-sendevents", &x_allow_sendevents /* *Non-nil means to allow synthetic events. Nil means they are ignored. Index: src/event-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-msw.c,v retrieving revision 1.38.2.45 diff -u -r1.38.2.45 event-msw.c --- event-msw.c 2000/05/16 09:08:27 1.38.2.45 +++ event-msw.c 2000/05/21 01:31:23 ＠＠ -1,4 +1,4 ＠＠ -/* The mswindows event_stream interface. +/* The mswindows event_stream interface. Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1996, 2000 Ben Wing. ＠＠ -100,6 +100,8 ＠＠ static void mswindows_set_chord_timer (HWND hwnd); static int mswindows_button2_near_enough (POINTS p1, POINTS p2); static int mswindows_current_layout_has_AltGr (void); +static int mswindows_handle_sticky_modifiers (WPARAM wParam, LPARAM lParam, + int downp, int keyp); static struct event_stream *mswindows_event_stream; ＠＠ -937,17 +939,21 ＠＠ } static void -mswindows_enqueue_mouse_button_event (HWND hwnd, UINT msg, POINTS where, DWORD when) +mswindows_enqueue_mouse_button_event (HWND hwnd, UINT msg, POINTS where, + DWORD when) { + int downp = (msg == WM_LBUTTONDOWN || msg == WM_MBUTTONDOWN || + msg == WM_RBUTTONDOWN); /* We always use last message time, because mouse button events may get delayed, and XEmacs double click recognition will fail */ Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - Lisp_Event* event = XEVENT(emacs_event); + Lisp_Event* event = XEVENT (emacs_event); - event->channel = mswindows_find_frame(hwnd); + mswindows_handle_sticky_modifiers (0, 0, downp, 0); + event->channel = mswindows_find_frame (hwnd); event->timestamp = when; event->event.button.button = (msg==WM_LBUTTONDOWN || msg==WM_LBUTTONUP) ? 1 : ＠＠ -956,8 +962,7 ＠＠ event->event.button.y = where.y; event->event.button.modifiers = mswindows_modifier_state (NULL, 0); - if (msg==WM_LBUTTONDOWN || msg==WM_MBUTTONDOWN || - msg==WM_RBUTTONDOWN) + if (downp) { event->event_type = button_press_event; SetCapture (hwnd); ＠＠ -1685,29 +1690,256 ＠＠ static int key_needs_default_processing_p (UINT vkey) { - if (mswindows_alt_by_itself_activates_menu && vkey == VK_MENU) + if (mswindows_alt_by_itself_activates_menu && vkey == VK_MENU + /* if we let ALT activate the menu like this, then sticky ALT-modified + keystrokes become impossible. */ + && !modifier_keys_are_sticky) return 1; return 0; } +/* key-handling code is always ugly. It just ends up working out + that way. + + #### Most of the sticky-modifier code below is copied from similar + code in event-Xt.c. They should somehow or other be merged. + + Here are some pointers: + + -- DOWN_MASK indicates which modifiers should be treated as "down" + when the corresponding upstroke happens. It gets reset for + a particular modifier when that modifier goes up, and reset + for all modifiers when a non-modifier key is pressed. Example: + + I press Control-A-Shift and then release Control-A-Shift. + I want the Shift key to be sticky but not the Control key. + + -- If a modifier key is sticky, I can unstick it by pressing + the modifier key again. */ + +static WPARAM last_downkey; +static int need_to_add_mask, down_mask; + +#define XEMSW_LCONTROL (1<<0) +#define XEMSW_RCONTROL (1<<1) +#define XEMSW_LSHIFT (1<<2) +#define XEMSW_RSHIFT (1<<3) +#define XEMSW_LMENU (1<<4) +#define XEMSW_RMENU (1<<5) + +static int +mswindows_handle_sticky_modifiers (WPARAM wParam, LPARAM lParam, + int downp, int keyp) +{ + int mods = 0; + + if (!modifier_keys_are_sticky) /* Optimize for non-sticky modifiers */ + return 0; + + if (! (keyp && + (wParam == VK_CONTROL || wParam == VK_LCONTROL || + wParam == VK_RCONTROL || + wParam == VK_MENU || wParam == VK_LMENU || + wParam == VK_RMENU || + wParam == VK_SHIFT || wParam == VK_LSHIFT || + wParam == VK_RSHIFT))) + { /* Not a modifier key */ + if (downp && keyp && !last_downkey) + last_downkey = wParam; + /* If I hold press-and-release the Control key and then press + and hold down the right arrow, I want it to auto-repeat + Control-Right. On the other hand, if I do the same but + manually press the Right arrow a bunch of times, I want + to see one Control-Right and then a bunch of Rights. + This means that we need to distinguish between an + auto-repeated key and a key pressed and released a bunch + of times. */ + else if (downp && !keyp || + (downp && keyp && last_downkey && + (wParam != last_downkey || + /* the "previous key state" bit indicates autorepeat */ + ! (lParam & (1 << 30))))) + { + need_to_add_mask = 0; + last_downkey = 0; + } + if (downp) + down_mask = 0; + + mods = need_to_add_mask; + } + else /* Modifier key pressed */ + { + /* If a non-modifier key was pressed in the middle of a bunch + of modifiers, then it unsticks all the modifiers that were + previously pressed. We cannot unstick the modifiers until + now because we want to check for auto-repeat of the + non-modifier key. */ + + if (last_downkey) + { + last_downkey = 0; + need_to_add_mask = 0; + } + +#define FROB(mask) \ +do { \ + if (downp && keyp) \ + { \ + /* If modifier key is already sticky, \ + then unstick it. Note that we do \ + not test down_mask to deal with the \ + unlikely but possible case that the \ + modifier key auto-repeats. */ \ + if (need_to_add_mask & mask) \ + { \ + need_to_add_mask &= ~mask; \ + down_mask &= ~mask; \ + } \ + else \ + down_mask |= mask; \ + } \ + else \ + { \ + if (down_mask & mask) \ + { \ + down_mask &= ~mask; \ + need_to_add_mask |= mask; \ + } \ + } \ +} while (0) + + if (wParam == VK_CONTROL && (lParam & 0x1000000) + || wParam == VK_RCONTROL) + FROB (XEMSW_RCONTROL); + if (wParam == VK_CONTROL && !(lParam & 0x1000000) + || wParam == VK_LCONTROL) + FROB (XEMSW_LCONTROL); + + if (wParam == VK_SHIFT && (lParam & 0x1000000) + || wParam == VK_RSHIFT) + FROB (XEMSW_RSHIFT); + if (wParam == VK_SHIFT && !(lParam & 0x1000000) + || wParam == VK_LSHIFT) + FROB (XEMSW_LSHIFT); + + if (wParam == VK_MENU && (lParam & 0x1000000) + || wParam == VK_RMENU) + FROB (XEMSW_RMENU); + if (wParam == VK_MENU && !(lParam & 0x1000000) + || wParam == VK_LMENU) + FROB (XEMSW_LMENU); + } +#undef FROB + + if (mods && downp) + { + BYTE keymap[256]; + + GetKeyboardState (keymap); + + if (mods & XEMSW_LCONTROL) + { + keymap [VK_CONTROL] |= 0x80; + keymap [VK_LCONTROL] |= 0x80; + } + if (mods & XEMSW_RCONTROL) + { + keymap [VK_CONTROL] |= 0x80; + keymap [VK_RCONTROL] |= 0x80; + } + + if (mods & XEMSW_LSHIFT) + { + keymap [VK_SHIFT] |= 0x80; + keymap [VK_LSHIFT] |= 0x80; + } + if (mods & XEMSW_RSHIFT) + { + keymap [VK_SHIFT] |= 0x80; + keymap [VK_RSHIFT] |= 0x80; + } + + if (mods & XEMSW_LMENU) + { + keymap [VK_MENU] |= 0x80; + keymap [VK_LMENU] |= 0x80; + } + if (mods & XEMSW_RMENU) + { + keymap [VK_MENU] |= 0x80; + keymap [VK_RMENU] |= 0x80; + } + + SetKeyboardState (keymap); + return 1; + } + + return 0; +} + +static void +clear_sticky_modifiers (void) +{ + need_to_add_mask = 0; + last_downkey = 0; + down_mask = 0; +} + #ifdef DEBUG_XEMACS + +static void +output_modifier_keyboard_state (void) +{ + BYTE keymap[256]; + + GetKeyboardState (keymap); -/* try to debug the stuck-alt-key problem. */ + stderr_out ("GetKeyboardState VK_MENU %d %d VK_LMENU %d %d VK_RMENU %d %d\n", + keymap[VK_MENU] & 0x80 ? 1 : 0, + keymap[VK_MENU] & 0x1 ? 1 : 0, + keymap[VK_LMENU] & 0x80 ? 1 : 0, + keymap[VK_LMENU] & 0x1 ? 1 : 0, + keymap[VK_RMENU] & 0x80 ? 1 : 0, + keymap[VK_RMENU] & 0x1 ? 1 : 0); + stderr_out ("GetKeyboardState VK_CONTROL %d %d VK_LCONTROL %d %d VK_RCONTROL %d %d\n", + keymap[VK_CONTROL] & 0x80 ? 1 : 0, + keymap[VK_CONTROL] & 0x1 ? 1 : 0, + keymap[VK_LCONTROL] & 0x80 ? 1 : 0, + keymap[VK_LCONTROL] & 0x1 ? 1 : 0, + keymap[VK_RCONTROL] & 0x80 ? 1 : 0, + keymap[VK_RCONTROL] & 0x1 ? 1 : 0); + stderr_out ("GetKeyboardState VK_SHIFT %d %d VK_LSHIFT %d %d VK_RSHIFT %d %d\n", + keymap[VK_SHIFT] & 0x80 ? 1 : 0, + keymap[VK_SHIFT] & 0x1 ? 1 : 0, + keymap[VK_LSHIFT] & 0x80 ? 1 : 0, + keymap[VK_LSHIFT] & 0x1 ? 1 : 0, + keymap[VK_RSHIFT] & 0x80 ? 1 : 0, + keymap[VK_RSHIFT] & 0x1 ? 1 : 0); +} + +/* try to debug the stuck-alt-key problem. + + #### this happens only inconsistently, and may only happen when using + StickyKeys in the Win2000 accessibility section of the control panel, + which is extremely broken for other reasons. */ static void output_alt_keyboard_state (void) { BYTE keymap[256]; - SHORT keystate[3], asyncstate[3]; + SHORT keystate[3]; + // SHORT asyncstate[3]; GetKeyboardState (keymap); keystate[0] = GetKeyState (VK_MENU); keystate[1] = GetKeyState (VK_LMENU); keystate[2] = GetKeyState (VK_RMENU); - asyncstate[0] = GetAsyncKeyState (VK_MENU); - asyncstate[1] = GetAsyncKeyState (VK_LMENU); - asyncstate[2] = GetAsyncKeyState (VK_RMENU); + /* Doing this interferes with key processing. */ +/* asyncstate[0] = GetAsyncKeyState (VK_MENU); */ +/* asyncstate[1] = GetAsyncKeyState (VK_LMENU); */ +/* asyncstate[2] = GetAsyncKeyState (VK_RMENU); */ stderr_out ("GetKeyboardState VK_MENU %d %d VK_LMENU %d %d VK_RMENU %d %d\n", keymap[VK_MENU] & 0x80 ? 1 : 0, ＠＠ -1723,13 +1955,13 ＠＠ keystate[1] & 0x1 ? 1 : 0, keystate[2] & 0x8000 ? 1 : 0, keystate[2] & 0x1 ? 1 : 0); - stderr_out ("GetAsyncKeyState VK_MENU %d %d VK_LMENU %d %d VK_RMENU %d %d\n", - asyncstate[0] & 0x8000 ? 1 : 0, - asyncstate[0] & 0x1 ? 1 : 0, - asyncstate[1] & 0x8000 ? 1 : 0, - asyncstate[1] & 0x1 ? 1 : 0, - asyncstate[2] & 0x8000 ? 1 : 0, - asyncstate[2] & 0x1 ? 1 : 0); +/* stderr_out ("GetAsyncKeyState VK_MENU %d %d VK_LMENU %d %d VK_RMENU %d %d\n", */ +/* asyncstate[0] & 0x8000 ? 1 : 0, */ +/* asyncstate[0] & 0x1 ? 1 : 0, */ +/* asyncstate[1] & 0x8000 ? 1 : 0, */ +/* asyncstate[1] & 0x1 ? 1 : 0, */ +/* asyncstate[2] & 0x8000 ? 1 : 0, */ +/* asyncstate[2] & 0x1 ? 1 : 0); */ } #endif /* DEBUG_XEMACS */ ＠＠ -1739,7 +1971,7 ＠＠ * The windows procedure for the window class XEMACS_CLASS */ LRESULT WINAPI -mswindows_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) +mswindows_wnd_proc (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) { /* Note: Remember to initialize emacs_event and event before use. This code calls code that can GC. You must GCPRO before calling such code. */ ＠＠ -1774,6 +2006,7 ＠＠ case WM_KEYUP: case WM_SYSKEYUP: + /* See Win95 comment under WM_KEYDOWN */ { BYTE keymap[256]; ＠＠ -1789,6 +2022,7 ＠＠ } #endif /* DEBUG_XEMACS */ + mswindows_handle_sticky_modifiers (wParam, lParam, 0, 1); if (wParam == VK_CONTROL) { GetKeyboardState (keymap); ＠＠ -1802,12 +2036,13 ＠＠ should_set_keymap = 1; } - if (should_set_keymap - && (message != WM_SYSKEYUP - || NILP (Vmenu_accelerator_enabled))) + if (should_set_keymap) + // && (message != WM_SYSKEYUP + // || NILP (Vmenu_accelerator_enabled))) SetKeyboardState (keymap); } + if (key_needs_default_processing_p (wParam)) goto defproc; else ＠＠ -1815,6 +2050,7 ＠＠ case WM_KEYDOWN: case WM_SYSKEYDOWN: + /* In some locales the right-hand Alt key is labelled AltGr. This key * should produce alternative charcaters when combined with another key. * eg on a German keyboard pressing AltGr+q should produce '＠'. ＠＠ -1824,11 +2060,14 ＠＠ * We get round this by removing all modifiers from the keymap before * calling TranslateMessage() unless AltGr is *really* down. */ { - BYTE keymap[256]; + BYTE keymap_trans[256]; + BYTE keymap_orig[256]; + BYTE keymap_sticky[256]; int has_AltGr = mswindows_current_layout_has_AltGr (); - int mods; + int mods = 0; int extendedp = lParam & 0x1000000; Lisp_Object keysym; + int sticky_changed; #ifdef DEBUG_XEMACS if (mswindows_debug_events) ＠＠ -1840,18 +2079,39 ＠＠ } #endif /* DEBUG_XEMACS */ + GetKeyboardState (keymap_orig); frame = XFRAME (mswindows_find_frame (hwnd)); - GetKeyboardState (keymap); - mods = mswindows_modifier_state (keymap, has_AltGr); + if ((sticky_changed = + mswindows_handle_sticky_modifiers (wParam, lParam, 1, 1))) + { + GetKeyboardState (keymap_sticky); + if (keymap_sticky[VK_MENU] & 0x80) + { + message = WM_SYSKEYDOWN; + /* We have to set the "context bit" so that the + TranslateMessage() call below that generates the + SYSCHAR message does its thing; see the documentation + on WM_SYSKEYDOWN */ + lParam |= 1 << 29; + } + } + else + memcpy (keymap_sticky, keymap_orig, 256); + mods = mswindows_modifier_state (keymap_sticky, has_AltGr); + /* Handle non-printables */ if (!NILP (keysym = mswindows_key_to_emacs_keysym (wParam, mods, extendedp))) - mswindows_enqueue_keypress_event (hwnd, keysym, mods); + { + mswindows_enqueue_keypress_event (hwnd, keysym, mods); + if (sticky_changed) + SetKeyboardState (keymap_orig); + } else /* Normal keys & modifiers */ { - Emchar quit_ch = CONSOLE_QUIT_CHAR (XCONSOLE (mswindows_find_console (hwnd))); - BYTE keymap_orig[256]; + Emchar quit_ch = + CONSOLE_QUIT_CHAR (XCONSOLE (mswindows_find_console (hwnd))); POINT pnt = { LOWORD (GetMessagePos()), HIWORD (GetMessagePos()) }; MSG msg, tranmsg; int potential_accelerator = 0; ＠＠ -1868,11 +2128,15 ＠＠ * to loosely track Left and Right modifiers on behalf of the OS, * without screwing up Windows NT which tracks them properly. */ if (wParam == VK_CONTROL) - keymap [extendedp ? VK_RCONTROL : VK_LCONTROL] |= 0x80; + { + keymap_orig[extendedp ? VK_RCONTROL : VK_LCONTROL] |= 0x80; + keymap_sticky[extendedp ? VK_RCONTROL : VK_LCONTROL] |= 0x80; + } else if (wParam == VK_MENU) - keymap [extendedp ? VK_RMENU : VK_LMENU] |= 0x80; - - memcpy (keymap_orig, keymap, 256); + { + keymap_orig[extendedp ? VK_RMENU : VK_LMENU] |= 0x80; + keymap_sticky[extendedp ? VK_RMENU : VK_LMENU] |= 0x80; + } if (!NILP (Vmenu_accelerator_enabled) && !(mods & XEMACS_MOD_SHIFT) && message == WM_SYSKEYDOWN) ＠＠ -1881,24 +2145,27 ＠＠ /* Remove shift modifier from an ascii character */ mods &= ~XEMACS_MOD_SHIFT; + memcpy (keymap_trans, keymap_sticky, 256); + /* Clear control and alt modifiers unless AltGr is pressed */ - keymap [VK_RCONTROL] = 0; - keymap [VK_LMENU] = 0; - if (!has_AltGr || !(keymap [VK_LCONTROL] & 0x80) - || !(keymap [VK_RMENU] & 0x80)) + keymap_trans[VK_RCONTROL] = 0; + keymap_trans[VK_LMENU] = 0; + if (!has_AltGr || !(keymap_trans[VK_LCONTROL] & 0x80) + || !(keymap_trans[VK_RMENU] & 0x80)) { - keymap [VK_LCONTROL] = 0; - keymap [VK_CONTROL] = 0; - keymap [VK_RMENU] = 0; - keymap [VK_MENU] = 0; + keymap_trans[VK_LCONTROL] = 0; + keymap_trans[VK_CONTROL] = 0; + keymap_trans[VK_RMENU] = 0; + keymap_trans[VK_MENU] = 0; } - SetKeyboardState (keymap); + SetKeyboardState (keymap_trans); /* Maybe generate some WM_[SYS]CHARs in the queue */ TranslateMessage (&msg); while (PeekMessage (&tranmsg, hwnd, WM_CHAR, WM_CHAR, PM_REMOVE) - || PeekMessage (&tranmsg, hwnd, WM_SYSCHAR, WM_SYSCHAR, PM_REMOVE)) + || PeekMessage (&tranmsg, hwnd, WM_SYSCHAR, WM_SYSCHAR, + PM_REMOVE)) { int mods1 = mods; WPARAM ch = tranmsg.wParam; ＠＠ -1908,9 +2175,12 ＠＠ upon dequeueing the event */ /* #### This might also not withstand localization, if quit character is not a latin-1 symbol */ - if (((quit_ch < ' ' && (mods & XEMACS_MOD_CONTROL) && quit_ch + 'a' - 1 == ch) - || (quit_ch >= ' ' && !(mods & XEMACS_MOD_CONTROL) && quit_ch == ch)) - && ((mods & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_SHIFT)) == 0)) + if (((quit_ch < ' ' && (mods & XEMACS_MOD_CONTROL) + && quit_ch + 'a' - 1 == ch) + || (quit_ch >= ' ' && !(mods & XEMACS_MOD_CONTROL) + && quit_ch == ch)) + && ((mods & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_SHIFT)) + == 0)) { mods1 |= FAKE_MOD_QUIT; ++mswindows_quit_chars_count; ＠＠ -1923,16 +2193,21 ＠＠ } mswindows_enqueue_keypress_event (hwnd, make_char (ch), mods1); } /* while */ - SetKeyboardState (keymap_orig); + /* This generates WM_SYSCHAR messages, which are interpreted by DefWindowProc as the menu selections. */ if (got_accelerator) { + SetKeyboardState (keymap_sticky); TranslateMessage (&msg); + SetKeyboardState (keymap_orig); goto defproc; } + + SetKeyboardState (keymap_orig); } /* else */ } + if (key_needs_default_processing_p (wParam)) goto defproc; else ＠＠ -2650,13 +2925,15 ＠＠ /* Returns the state of the modifier keys in the format expected by the * Lisp_Event key_data, button_data and motion_data modifiers member */ -int mswindows_modifier_state (BYTE* keymap, int has_AltGr) +static int +mswindows_modifier_state (BYTE* keymap, int has_AltGr) { int mods = 0; + BYTE keymap2[256]; if (keymap == NULL) { - keymap = (BYTE*) alloca(256); + keymap = keymap2; GetKeyboardState (keymap); has_AltGr = mswindows_current_layout_has_AltGr (); } ＠＠ -2907,18 +3184,19 ＠＠ struct frame *f = XFRAME (frame); int in_p = (EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event) == WM_SETFOCUS); Lisp_Object conser; + struct gcpro gcpro1; - /* struct gcpro gcpro1; */ + /* On focus change, clear all memory of sticky modifiers + to avoid non-intuitive behavior. */ + clear_sticky_modifiers (); - /* Clear sticky modifiers here (if we had any) */ - conser = Fcons (frame, Fcons (FRAME_DEVICE (f), in_p ? Qt : Qnil)); - /* GCPRO1 (conser); XXX Not necessary? */ + GCPRO1 (conser); emacs_handle_focus_change_preliminary (conser); /* Under X the stuff up to here is done in the X event handler. I Don't know why */ emacs_handle_focus_change_final (conser); - /* UNGCPRO; */ + UNGCPRO; } break; Index: src/event-stream.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-stream.c,v retrieving revision 1.45.2.26 diff -u -r1.45.2.26 event-stream.c --- event-stream.c 2000/04/14 12:35:55 1.45.2.26 +++ event-stream.c 2000/05/21 01:31:24 ＠＠ -121,6 +121,8 ＠＠ /* Control gratuitous keyboard focus throwing. */ int focus_follows_mouse; +int modifier_keys_are_sticky; + #if 0 /* FSF Emacs crap */ /* Hook run after a command if there's no more input soon. */ Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook; ＠＠ -4753,6 +4755,15 ＠＠ you should *bind* this, not set it. */ ); Vretry_undefined_key_binding_unshifted = Qt; + + DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /* +*Non-nil makes modifier keys sticky. +This means that you can release the modifier key before pressing down +the key that you wish to be modified. Although this is non-standard +behavior, it is recommended because it reduces the strain on your hand, +thus reducing the incidence of the dreaded Emacs-pinky syndrome. +*/ ); + modifier_keys_are_sticky = 0; #ifdef HAVE_XIM DEFVAR_LISP ("composed-character-default-binding", Index: src/lisp.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.38.2.63 diff -u -r1.38.2.63 lisp.h --- lisp.h 2000/05/16 09:08:30 1.38.2.63 +++ lisp.h 2000/05/21 01:31:26 ＠＠ -1545,6 +1545,12 ＠＠ extern int specpdl_depth_counter; #define specpdl_depth() specpdl_depth_counter + +#define CHECK_FUNCTION(fun) do { \ + while (NILP (Ffunctionp (fun))) \ + signal_invalid_function_error (fun); \ + } while (0) + /************************************************************************/ /* Checking for QUIT */ ＠＠ -2258,6 +2264,7 ＠＠ Lisp_Object enqueue_misc_user_event (Lisp_Object, Lisp_Object, Lisp_Object); Lisp_Object enqueue_misc_user_event_pos (Lisp_Object, Lisp_Object, Lisp_Object, int, int, int, int); +extern int modifier_keys_are_sticky; /* Defined in event-Xt.c */ void enqueue_Xt_dispatch_event (Lisp_Object event); ＠＠ -2648,6 +2655,7 ＠＠ EXFUN (Fforward_line, 2); EXFUN (Ffset, 2); EXFUN (Ffuncall, MANY); +EXFUN (Ffunctionp, 1); EXFUN (Fgeq, MANY); EXFUN (Fget, 3); EXFUN (Fget_buffer_process, 1); Index: src/rangetab.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/rangetab.c,v retrieving revision 1.6.2.7 diff -u -r1.6.2.7 rangetab.c --- rangetab.c 2000/02/21 23:06:53 1.6.2.7 +++ rangetab.c 2000/05/21 01:31:26 ＠＠ -443,10 +443,47 ＠＠ DEFUN ("map-range-table", Fmap_range_table, 2, 2, 0, /* Map FUNCTION over entries in TABLE, calling it with three args, the beginning and end of the range and the corresponding value. + +Results are guaranteed to be correct (i.e. each entry processed +exactly once) if FUNCTION modifies or deletes the current entry +(i.e. passes the current range to `put-range-table' or +`remove-range-table'), but not otherwise. */ (function, table)) { - error ("not yet implemented"); + Lisp_Range_Table *rt; + int i; + + CHECK_RANGE_TABLE (table); + CHECK_FUNCTION (function); + + rt = XRANGE_TABLE (table); + + /* Do not "optimize" by pulling out the length computation below! + FUNCTION may have changed the table. */ + for (i = 0; i < Dynarr_length (rt->entries); i++) + { + struct range_table_entry *entry = Dynarr_atp (rt->entries, i); + EMACS_INT first, last; + Lisp_Object args[4]; + int oldlen; + + again: + first = entry->first; + last = entry->last; + oldlen = Dynarr_length (rt->entries); + args[0] = function; + args[1] = make_int (first); + args[2] = make_int (last); + args[3] = entry->val; + Ffuncall (countof (args), args); + /* Has FUNCTION removed the entry? */ + if (oldlen > Dynarr_length (rt->entries) + && i < Dynarr_length (rt->entries) + && (first != entry->first || last != entry->last)) + goto again; + } + return Qnil; } cvs server: Diffing src/m cvs server: Diffing src/s cvs server: Diffing tests cvs server: Diffing tests/DLL cvs server: Diffing tests/Dnd cvs server: Diffing tests/automated cvs server: Diffing tests/mule cvs server: Diffing tests/tooltalk -- Ben In order to save my hands, I am cutting back on my mail. I also write as succinctly as possible -- please don't be offended. If you send me mail, you _will_ get a response, but please be patient, especially for XEmacs-related mail. If you need an immediate response and it is not apparent in your message, please say so. Thanks for your understanding. See also http://www.666.com/ben/chronic-pain/