Mercurial > hg > xemacs-beta

comparison lisp/cmdloop.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children 11054d720c21
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
128 "*Non-nil means that errors will cause the region to be deactivated." 128 "*Non-nil means that errors will cause the region to be deactivated."
129 :type 'boolean 129 :type 'boolean
130 :group 'editing-basics) 130 :group 'editing-basics)
131 131
132 (defun command-error (error-object) 132 (defun command-error (error-object)
133 (let* ((old-debug-on-error debug-on-error) 133 (let ((inhibit-quit t)
134 (inhibit-quit t) 134 (debug-on-error nil)
135 (debug-on-error nil) 135 (etype (car-safe error-object)))
136 (etype (car-safe error-object)))
137 (setq quit-flag nil) 136 (setq quit-flag nil)
138 (setq standard-output t) 137 (setq standard-output t)
139 (setq standard-input t) 138 (setq standard-input t)
140 (setq executing-kbd-macro nil) 139 (setq executing-kbd-macro nil)
141 (and errors-deactivate-region 140 (and errors-deactivate-region
160 (t 'command-error))) 159 (t 'command-error)))
161 (display-error error-object t) 160 (display-error error-object t)
162 161
163 (if (noninteractive) 162 (if (noninteractive)
164 (progn 163 (progn
165 (if old-debug-on-error 164 (message "%s exiting." emacs-program-name)
166 (progn
167 (message "Backtrace:\n\n")
168 (backtrace)
169 (message "\n")))
170 (message "%s exiting\n." emacs-program-name)
171 (kill-emacs -1))) 165 (kill-emacs -1)))
172 t)) 166 t))
173 167
174 (defun describe-last-error () 168 (defun describe-last-error ()
175 "Redisplay the last error-message. See the variable `last-error'." 169 "Redisplay the last error-message. See the variable `last-error'."
323 (t 317 (t
324 "M-x "))))) 318 "M-x ")))))
325 319
326 (if (and teach-extended-commands-p 320 (if (and teach-extended-commands-p
327 (interactive-p)) 321 (interactive-p))
328 ;; Remember the keys, run the command, and show the keys (if 322 ;; We need to fiddle with keys: remember the keys, run the
329 ;; any). The funny variable names are a poor man's guarantee 323 ;; command, and show the keys (if any).
330 ;; that we don't get tripped by this-command doing something
331 ;; funny. Quoth our forefathers: "We want lexical scope!"
332 (let ((_execute_command_keys_ (where-is-internal this-command)) 324 (let ((_execute_command_keys_ (where-is-internal this-command))
333 (_execute_command_name_ this-command)) ; the name can change 325 (_execute_command_name_ this-command)) ; the name can change
334 (command-execute this-command t) 326 (command-execute this-command t)
335 (when _execute_command_keys_ 327 (when (and _execute_command_keys_
336 ;; Normally the region is adjusted in post_command_hook; 328 ;; Wait for a while, so the user can see a message
337 ;; however, it is not called until after we finish. It 329 ;; printed, if any.
338 ;; looks ugly for the region to get updated after the 330 (sit-for 1))
339 ;; delays, so we do it now. The code below is a Lispified 331 (display-message
340 ;; copy of code in event-stream.c:post_command_hook(). 332 'no-log
341 (if (and (not zmacs-region-stays) 333 (format "Command `%s' is bound to key%s: %s"
342 (or (not (eq (selected-window) (minibuffer-window))) 334 _execute_command_name_
343 (eq (zmacs-region-buffer) (current-buffer)))) 335 (if (cdr _execute_command_keys_) "s" "")
344 (zmacs-deactivate-region) 336 (sorted-key-descriptions _execute_command_keys_)))
345 (zmacs-update-region)) 337 (sit-for teach-extended-commands-timeout)
346 ;; Wait for a while, so the user can see a message printed, 338 (clear-message 'no-log)))
347 ;; if any.
348 (when (sit-for 1)
349 (display-message
350 'no-log
351 (format (if (cdr _execute_command_keys_)
352 "Command `%s' is bound to keys: %s"
353 "Command `%s' is bound to key: %s")
354 _execute_command_name_
355 (sorted-key-descriptions _execute_command_keys_)))
356 (sit-for teach-extended-commands-timeout)
357 (clear-message 'no-log))))
358 ;; Else, just run the command. 339 ;; Else, just run the command.
359 (command-execute this-command t))) 340 (command-execute this-command t)))
360 341
361 342
362 ;;; C code calls this; the underscores in the variable names are to avoid 343 ;;; C code calls this; the underscores in the variable names are to avoid