Mercurial > hg > xemacs-beta

changeset 5801:0e9f791cc655

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Support `function-key-map' in #'read-char{,-exclusive}, sync API with GNU lisp/ChangeLog addition: 2014-07-02 Aidan Kehoe <kehoea@parhasard.net> * cmdloop.el: * cmdloop.el (read-char-1): New. * cmdloop.el (read-char, read-char-exclusive): Use #'read-char-1 in these function; sync their API with that of GNU, respect `function-key-map' where we didn't before, add initial support for Quail input methods. * keymap.el (next-key-event): Accept EVENT and PROMPT arguments, as does #'next-command-event. * keymap.el (event-apply-modifiers): Use #'functionp here, no need to exclude lambdas from `function-key-map'. * keymap.el (synthesize-keysym): Correct this function's docstring. src/ChangeLog addition: 2014-07-02 Aidan Kehoe <kehoea@parhasard.net> * event-stream.c (Fnext_command_event): Only snooze displaying keystrokes if PROMPT is nil. If prompt is non-nil, our callers want to see it.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 02 Jul 2014 16:32:19 +0100
parents be3ca9e58c92
children 236e4afc565d
files lisp/ChangeLog lisp/cmdloop.el lisp/keymap.el src/ChangeLog src/event-stream.c
diffstat 5 files changed, 148 insertions(+), 45 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu Jun 19 12:06:33 2014 +0900
+++ b/lisp/ChangeLog	Wed Jul 02 16:32:19 2014 +0100
@@ -1,3 +1,19 @@
+2014-07-02  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cmdloop.el:
+	* cmdloop.el (read-char-1): New.
+	* cmdloop.el (read-char, read-char-exclusive):
+	Use #'read-char-1 in these function; sync their API with that of
+	GNU, respect `function-key-map' where we didn't before, add
+	initial support for Quail input methods.
+	* keymap.el (next-key-event):
+	Accept EVENT and PROMPT arguments, as does #'next-command-event.
+	* keymap.el (event-apply-modifiers):
+	Use #'functionp here, no need to exclude lambdas from
+	`function-key-map'.
+	* keymap.el (synthesize-keysym):
+	Correct this function's docstring.
+
 2014-04-19  Mats Lidell  <matsl@xemacs.org>
 
 	* help.el: Sync from GNU - Link to customize if applicable and
--- a/lisp/cmdloop.el	Thu Jun 19 12:06:33 2014 +0900
+++ b/lisp/cmdloop.el	Wed Jul 02 16:32:19 2014 +0100
@@ -520,43 +520,120 @@
     (y-or-n-p-minibuf prompt)))
 
 
+(labels
+    ((read-char-1 (errorp prompt inherit-input-method seconds)
+       "Return a character from command input or the current macro.
+Look up said input in `function-key-map' as appropriate.
 
-(defun read-char ()
-  "Read a character from the command input (keyboard or macro).
-If a mouse click or non-ASCII character is detected, an error is
-signalled.  The character typed is returned as an ASCII value.  This
-is most likely the wrong thing for you to be using: consider using
-the `next-command-event' function instead."
-  (save-excursion
-    (let ((event (next-command-event)))
-      (or inhibit-quit
-	  (and (event-matches-key-specifier-p event (quit-char))
-	       (signal 'quit nil)))
-      (prog1 (or (event-to-character event)
-                 ;; Kludge.  If the event we read was a mouse-release,
-                 ;; discard it and read the next one.
-                 (if (button-release-event-p event)
-                     (event-to-character (next-command-event event)))
-                 (error "Key read has no ASCII equivalent %S" event))
-        ;; this is not necessary, but is marginally more efficient than GC.
-        (deallocate-event event)))))
+PROMPT is a prompt for `next-command-event', which see.
+
+If ERRORP is non-nil, error if the key sequence has no character equivalent.
+Otherwise, loop, discarding non-character keystrokes or mouse movements.
+
+If INHERIT-INPUT-METHOD is non-nil, and a Quail input method is active in
+the current buffer, use its translation when choosing a character to return.
 
-(defun read-char-exclusive ()
-  "Read a character from the command input (keyboard or macro).
-If a mouse click or non-ASCII character is detected, it is discarded.
-The character typed is returned as an ASCII value.  This is most likely
-the wrong thing for you to be using: consider using the
-`next-command-event' function instead."
-  (let (event ch)
-    (while (progn
-	     (setq event (next-command-event))
-	     (or inhibit-quit
-		 (and (event-matches-key-specifier-p event (quit-char))
-		      (signal 'quit nil)))
-	     (setq ch (event-to-character event))
-	     (deallocate-event event)
-	     (null ch)))
-    ch))
+If SECONDS is non-nil, only wait that number of seconds for input. If no
+input is received in that time, return nil."
+       (let ((timeout
+              (if seconds
+                  (add-timeout seconds #'(lambda (ignore)
+                                           (return-from read-char-1 nil))
+                               nil)))
+             (events []) binding character)
+         (unwind-protect
+              (while t
+                ;; Read keystrokes scanning `function-key-map'.
+                (while (keymapp
+                        (setq binding
+                              (lookup-key
+                               function-key-map
+                               (setq events
+                                     (vconcat events (list
+                                                      (next-key-event
+                                                       nil prompt))))))))
+                (when binding
+                  ;; Found something in function-key-map. If it's a function
+                  ;; (e.g. synthesize-keysym), call it.
+                  (if (functionp binding)
+                      (setq binding (funcall binding nil)))
+                  (setq events (map 'vector #'character-to-event binding)))
+                ;; Put the remaining keystrokes back on the input queue.
+                (setq unread-command-events
+                      (nconc (reduce #'cons events :start 1 :from-end t
+                                     :initial-value nil)
+                             unread-command-events))
+                (unless inhibit-quit
+                  (and (event-matches-key-specifier-p (aref events 0)
+                                                      (quit-char))
+                       (signal 'quit nil)))
+                (if (setq character (event-to-character (aref events 0)))
+                    (progn
+                      ;; If we have a character (the usual case), deallocate
+                      ;; the event and return the character.
+                      (deallocate-event (aref events 0))
+                      ;; Handle quail, if we've been asked to (maybe we
+                      ;; should default to this).
+                      (if (and inherit-input-method (and-boundp 'quail-mode
+                                                      quail-mode))
+                          (with-fboundp
+                              '(quail-map-definition quail-lookup-key)
+                            (let ((binding
+                                   (quail-map-definition
+                                    (quail-lookup-key (string character)))))
+                              (if (characterp binding)
+                                  (return-from read-char-1 binding))
+                              ;; #### Bug, we don't allow users to select from
+                              ;; among multiple characters that may be input
+                              ;; with the same key sequence.
+                              (if (and (consp binding)
+                                       (characterp
+                                        (aref (cdr binding) (caar binding))))
+                                  (return-from read-char-1
+                                    (aref (cdr binding) (caar binding)))))))
+                      (return-from read-char-1 character)))
+                (if errorp
+                    (error 'invalid-key-binding "Not a character keystroke"
+                           (aref events 0)))
+                ;; If we're not erroring, loop until we get a character
+                (setq events []))
+           (if timeout (disable-timeout timeout))))))
+  ;; Because of byte compiler limitations, each function has its own copy of
+  ;; #'read-char-1, so why not inline it.
+  (declare (inline read-char-1))
+
+  (defun read-char (&optional prompt inherit-input-method seconds)
+    "Read a character from the command input (keyboard or macro).
+If a mouse click or non-character keystroke is detected, signal an error.
+The character typed is returned as a Lisp object.  This is most likely the
+wrong thing for you to be using: consider using the `next-command-event'
+function instead.
+
+PROMPT is a prompt, as used by `next-command-event'.
+
+If INHERIT-INPUT-METHOD is non-nil, and a Quail input method is active in
+the current buffer, use its translation for the character returned.
+
+If SECONDS is non-nil, only wait that number of seconds for input. If no
+input is received in that time, return nil."
+    (read-char-1 t prompt inherit-input-method seconds))
+
+  (defun read-char-exclusive (&optional prompt inherit-input-method seconds)
+    "Read a character from the command input (keyboard or macro).
+
+If a mouse click or a non-character keystroke is detected, it is discarded.
+The character typed is returned as a Lisp object. This is most likely the
+wrong thing for you to be using: consider using the `next-command-event'
+function instead.
+
+PROMPT is a prompt, as used by `next-command-event'.
+
+If INHERIT-INPUT-METHOD is non-nil, and a Quail input method is active in
+the current buffer, use its translation for the character returned.
+
+If SECONDS is non-nil, only wait that number of seconds for input. If no
+input is received in that time, return nil."
+    (read-char-1 nil prompt inherit-input-method seconds)))
 
 ;;;; Input and display facilities.
 
--- a/lisp/keymap.el	Thu Jun 19 12:06:33 2014 +0900
+++ b/lisp/keymap.el	Wed Jul 02 16:32:19 2014 +0100
@@ -381,12 +381,12 @@
             (setq i (1+ i)))
           new))))
 
-(defun next-key-event ()
+(defun next-key-event (&optional event prompt)
   "Return the next available keyboard event."
-  (let (event)
-    (while (not (key-press-event-p (setq event (next-command-event))))
-      (dispatch-event event))
-    event))
+  (while (not (key-press-event-p
+               (setq event (next-command-event event prompt))))
+    (dispatch-event event))
+  event)
 
 (defun key-sequence-list-description (keys)
   "Convert a key sequence KEYS to the full [(modifiers... key)...] form.
@@ -457,7 +457,7 @@
     (if binding				; found a binding
 	(progn
 	  ;; allow for several modifiers
-	  (if (and (symbolp binding) (fboundp binding))
+	  (if (functionp binding)
 	      (setq binding (funcall binding nil)))
 	  (setq events (append binding nil))
 	  ;; put remaining keystrokes back into input queue
@@ -477,9 +477,9 @@
   (event-apply-modifiers (list symbol)))
 
 (defun synthesize-keysym (ignore-prompt)
-  "Read a sequence of keys, and returned the corresponding key symbol.
-The characters must be from the [-_a-zA-Z0-9].  Reading is terminated
- by RET (which is discarded)."
+  "Read a sequence of characters, and return the corresponding keysym.
+The characters must be ?-, or ?_, or have word syntax.  Reading is
+terminated by RET (which is discarded)."
   (let ((continuep t)
 	event char list)
     (while continuep
--- a/src/ChangeLog	Thu Jun 19 12:06:33 2014 +0900
+++ b/src/ChangeLog	Wed Jul 02 16:32:19 2014 +0100
@@ -1,3 +1,9 @@
+2014-07-02  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* event-stream.c (Fnext_command_event):
+	Only snooze displaying keystrokes if PROMPT is nil. If prompt is
+	non-nil, our callers want to see it.
+
 2014-06-19  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* buffer.c (case_fold_search): Improve docstring.
--- a/src/event-stream.c	Thu Jun 19 12:06:33 2014 +0900
+++ b/src/event-stream.c	Wed Jul 02 16:32:19 2014 +0100
@@ -2436,7 +2436,11 @@
    
   maybe_echo_keys (XCOMMAND_BUILDER
 		   (XCONSOLE (Vselected_console)->
-		    command_builder), 0); /* #### This sucks bigtime */
+		    command_builder),
+                   /* Only snooze displaying keystrokes if we don't have a
+                      prompt. (If we have a prompt, our callers want us to
+                      show it!) */
+                   !NILP (prompt));
 
   for (;;)
     {