Mercurial > hg > xemacs-beta

diff lisp/simple.el @ 4869:e533a9912ef1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Eliminate funcalls, #'handle-pre-motion-command-current-command-is-motion 2010-01-20 Aidan Kehoe <kehoea@parhasard.net> * simple.el (handle-pre-motion-command-current-command-is-motion): This function is called a *lot*, make it faster, making keysyms-equal inline, calling #'characterp (which doesn't have a bytecode) much more rarely, and not throwing and catching. This won't make much difference in practice, but does eliminate losts of noise from profiling, e.g. at startup.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 20 Jan 2010 17:30:29 +0000
parents e29fcfd8df5f
children 6772ce4d982b 9b5d4b35f8d7
line wrap: on
line diff
--- a/lisp/simple.el	Mon Jan 18 08:48:09 2010 +0100
+++ b/lisp/simple.el	Wed Jan 20 17:30:29 2010 +0000
@@ -2086,25 +2086,35 @@
 
 (defun handle-pre-motion-command-current-command-is-motion ()
   (and (key-press-event-p last-input-event)
-       (let ((key (event-key last-input-event))
-	     (mods (delq 'shift (event-modifiers last-input-event))))
-	 ;(princ (format "key: %s mods: %s\n" key mods) 'external-debugging-output)
-	 (catch 'handle-pre-motion-command-current-command-is-motion
-	   (flet ((keysyms-equal (a b)
-		    (if (characterp b)
-			(setq b (intern (char-to-string (downcase b)))))
-		    (eq a b)))
-             (setq key (if (characterp key)
-                           (intern (char-to-string (downcase key)))
-                         key))
-	     (dolist (keysym motion-keys-for-shifted-motion)
-	       (when (if (listp keysym)
-		         (and (equal mods (butlast keysym))
-			      (keysyms-equal key (car (last keysym))))
-	                (keysyms-equal key keysym))
-		 (throw 'handle-pre-motion-command-current-command-is-motion
-			t)))
-	     nil)))))
+       (macrolet
+	   ((keysyms-equal (&rest args)
+	      `((lambda (a b)
+		  (when (and
+			 ;; As of now, none of the elements of
+			 ;; motion-keys-for-shifted-motion are non-symbols;
+			 ;; this redundant check saves a few hundred
+			 ;; funcalls on startup.
+			 (not (symbolp b)) 
+			 (characterp b))
+		    (setf (car char-list) b
+			  b (intern (concat char-list nil))))
+		  (eq a b))
+		,@args)))
+         (loop
+           for keysym in motion-keys-for-shifted-motion
+           with key = (event-key last-input-event)
+           with mods = (delq 'shift (event-modifiers last-input-event))
+           with char-list = '(?a) ;; Some random character; the list will be
+				  ;; modified in the constants vector over
+				  ;; time.
+           initially (if (and (not (symbolp key)) (characterp key))
+			 (setf (car char-list) key
+			       key (intern (concat char-list nil))))
+           thereis (if (listp keysym)
+		       (and (equal mods (butlast keysym))
+			    (keysyms-equal
+			     key (car (last keysym))))
+		     (keysyms-equal key keysym))))))
 
 (defun handle-pre-motion-command ()
   (if (and