Mercurial > hg > xemacs-beta

comparison 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
comparison
equal deleted inserted replaced
4868:0dd76c7b7846 4869:e533a9912ef1
2084 symbol)) 2084 symbol))
2085 :group 'editing-basics) 2085 :group 'editing-basics)
2086 2086
2087 (defun handle-pre-motion-command-current-command-is-motion () 2087 (defun handle-pre-motion-command-current-command-is-motion ()
2088 (and (key-press-event-p last-input-event) 2088 (and (key-press-event-p last-input-event)
2089 (let ((key (event-key last-input-event)) 2089 (macrolet
2090 (mods (delq 'shift (event-modifiers last-input-event)))) 2090 ((keysyms-equal (&rest args)
2091 ;(princ (format "key: %s mods: %s\n" key mods) 'external-debugging-output) 2091 `((lambda (a b)
2092 (catch 'handle-pre-motion-command-current-command-is-motion 2092 (when (and
2093 (flet ((keysyms-equal (a b) 2093 ;; As of now, none of the elements of
2094 (if (characterp b) 2094 ;; motion-keys-for-shifted-motion are non-symbols;
2095 (setq b (intern (char-to-string (downcase b))))) 2095 ;; this redundant check saves a few hundred
2096 (eq a b))) 2096 ;; funcalls on startup.
2097 (setq key (if (characterp key) 2097 (not (symbolp b))
2098 (intern (char-to-string (downcase key))) 2098 (characterp b))
2099 key)) 2099 (setf (car char-list) b
2100 (dolist (keysym motion-keys-for-shifted-motion) 2100 b (intern (concat char-list nil))))
2101 (when (if (listp keysym) 2101 (eq a b))
2102 (and (equal mods (butlast keysym)) 2102 ,@args)))
2103 (keysyms-equal key (car (last keysym)))) 2103 (loop
2104 (keysyms-equal key keysym)) 2104 for keysym in motion-keys-for-shifted-motion
2105 (throw 'handle-pre-motion-command-current-command-is-motion 2105 with key = (event-key last-input-event)
2106 t))) 2106 with mods = (delq 'shift (event-modifiers last-input-event))
2107 nil))))) 2107 with char-list = '(?a) ;; Some random character; the list will be
2108 ;; modified in the constants vector over
2109 ;; time.
2110 initially (if (and (not (symbolp key)) (characterp key))
2111 (setf (car char-list) key
2112 key (intern (concat char-list nil))))
2113 thereis (if (listp keysym)
2114 (and (equal mods (butlast keysym))
2115 (keysyms-equal
2116 key (car (last keysym))))
2117 (keysyms-equal key keysym))))))
2108 2118
2109 (defun handle-pre-motion-command () 2119 (defun handle-pre-motion-command ()
2110 (if (and 2120 (if (and
2111 (handle-pre-motion-command-current-command-is-motion) 2121 (handle-pre-motion-command-current-command-is-motion)
2112 zmacs-regions 2122 zmacs-regions