comparison lisp/prim/cmdloop.el @ 165:5a88923fcbfe r20-3b9

Import from CVS: tag r20-3b9
author cvs
date Mon, 13 Aug 2007 09:44:42 +0200
parents 7d55a9ba150c
children 15872534500d
comparison
equal deleted inserted replaced
164:4e0740e5aab2 165:5a88923fcbfe
56 (defun keyboard-quit () 56 (defun keyboard-quit ()
57 "Signal a `quit' condition. 57 "Signal a `quit' condition.
58 If this character is typed while lisp code is executing, it will be treated 58 If this character is typed while lisp code is executing, it will be treated
59 as an interrupt. 59 as an interrupt.
60 If this character is typed at top-level, this simply beeps. 60 If this character is typed at top-level, this simply beeps.
61 If `zmacs-regions' is true, and the zmacs region is active, then this 61 If `zmacs-regions' is true, and the zmacs region is active in this buffer,
62 key deactivates the region without beeping or signalling." 62 then this key deactivates the region without beeping or signalling."
63 (interactive) 63 (interactive)
64 (if (and zmacs-regions (zmacs-deactivate-region)) 64 (if (and (region-active-p)
65 (eq (current-buffer) (zmacs-region-buffer)))
65 ;; pseudo-zmacs compatibility: don't beep if this ^G is simply 66 ;; pseudo-zmacs compatibility: don't beep if this ^G is simply
66 ;; deactivating the region. If it is inactive, beep. 67 ;; deactivating the region. If it is inactive, beep.
67 nil 68 nil
68 (signal 'quit nil))) 69 (signal 'quit nil)))
69 70
102 (etype (car-safe error-object))) 103 (etype (car-safe error-object)))
103 (setq quit-flag nil) 104 (setq quit-flag nil)
104 (setq standard-output t) 105 (setq standard-output t)
105 (setq standard-input t) 106 (setq standard-input t)
106 (setq executing-kbd-macro nil) 107 (setq executing-kbd-macro nil)
107 (zmacs-deactivate-region) 108 ; (zmacs-deactivate-region)
108 (discard-input) 109 (discard-input)
109 110
110 (setq last-error error-object) 111 (setq last-error error-object)
111 112
112 (message nil) 113 (message nil)
220 ;; #### I18N3: doesn't localize properly. 221 ;; #### I18N3: doesn't localize properly.
221 (princ (gettext " not defined.") stream) ; doo dah, doo dah. 222 (princ (gettext " not defined.") stream) ; doo dah, doo dah.
222 )) 223 ))
223 224
224 225
225 (defvar teach-extended-commands-p t 226 (defcustom teach-extended-commands-p t
226 "*If true, then `\\[execute-extended-command]' will teach you keybindings. 227 "*If true, then `\\[execute-extended-command]' will teach you keybindings.
227 Any time you execute a command with \\[execute-extended-command] which has a 228 Any time you execute a command with \\[execute-extended-command] which has a
228 shorter keybinding, you will be shown the alternate binding before the 229 shorter keybinding, you will be shown the alternate binding before the
229 command executes. There is a short pause after displaying the binding, 230 command executes. There is a short pause after displaying the binding,
230 before executing it; the length can be controlled by 231 before executing it; the length can be controlled by
231 `teach-extended-commands-timeout'.") 232 `teach-extended-commands-timeout'."
232 233 :type 'boolean
233 (defvar teach-extended-commands-timeout 2 234 :group 'keyboard)
235
236 (defcustom teach-extended-commands-timeout 4
234 "*How long to pause after displaying a keybinding before executing. 237 "*How long to pause after displaying a keybinding before executing.
235 The value is measured in seconds. This only applies if 238 The value is measured in seconds. This only applies if
236 `teach-extended-commands-p' is true.") 239 `teach-extended-commands-p' is true."
240 :type 'number
241 :group 'keyboard)
237 242
238 ;That damn RMS went off and implemented something differently, after 243 ;That damn RMS went off and implemented something differently, after
239 ;we had already implemented it. We can't support both properly until 244 ;we had already implemented it. We can't support both properly until
240 ;we have Lisp magic variables. 245 ;we have Lisp magic variables.
241 ;(defvar suggest-key-bindings t 246 ;(defvar suggest-key-bindings t
274 (integerp (car prefix-arg))) 279 (integerp (car prefix-arg)))
275 (format "%d M-x " (car prefix-arg))) 280 (format "%d M-x " (car prefix-arg)))
276 (t 281 (t
277 "M-x "))))) 282 "M-x ")))))
278 283
279 (if (and teach-extended-commands-p (interactive-p)) 284 (if (and teach-extended-commands-p
280 (let ((keys (where-is-internal this-command))) 285 (interactive-p))
281 (if keys 286 ;; We need to fiddle with keys: remember the keys, run the
282 (progn 287 ;; command, and show the keys (if any).
283 (message "M-x %s (bound to key%s: %s)" 288 (let ((_execute_command_keys_ (where-is-internal this-command))
284 this-command 289 (_execute_command_name_ this-command)) ; the name can change
285 (if (cdr keys) "s" "") 290 (command-execute this-command t)
286 (mapconcat 'key-description 291 (when (and _execute_command_keys_
287 (sort keys #'(lambda (x y) 292 ;; Wait for a while, so the user can see a message
288 (< (length x) (length y)))) 293 ;; printed, if any.
289 ", ")) 294 (sit-for 1))
290 (sit-for teach-extended-commands-timeout))))) 295 (display-message
291 296 'no-log
292 (command-execute this-command t)) 297 (format "Command `%s' is bound to key%s: %s"
298 _execute_command_name_
299 (if (cdr _execute_command_keys_) "s" "")
300 (mapconcat 'key-description
301 (sort _execute_command_keys_
302 #'(lambda (x y)
303 (< (length x) (length y))))
304 ", ")))
305 (sit-for teach-extended-commands-timeout)
306 (clear-message 'no-log)))
307 ;; Else, just run the command.
308 (command-execute this-command t)))
293 309
294 310
295 ;;; C code calls this; the underscores in the variable names are to avoid 311 ;;; C code calls this; the underscores in the variable names are to avoid
296 ;;; cluttering the specbind namespace (lexical scope! lexical scope!) 312 ;;; cluttering the specbind namespace (lexical scope! lexical scope!)
297 ;;; Putting this in Lisp instead of C slows kbd macros by 50%. 313 ;;; Putting this in Lisp instead of C slows kbd macros by 50%.