X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fcmdloop.el;h=6d972de44652f3c60f4058d79310d843f92ebc48;hb=6b6f8be0854598dbcdabe46e4d36b13f880361fe;hp=e5b4be0f8fbf4b89b61f6bd4ebec14503a21373c;hpb=a5f466de30a3e927ed1146b0c7e3870e71465c8f;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/cmdloop.el b/lisp/cmdloop.el index e5b4be0..6d972de 100644 --- a/lisp/cmdloop.el +++ b/lisp/cmdloop.el @@ -70,8 +70,7 @@ If this character is typed at top-level, this simply beeps. If `zmacs-regions' is true, and the zmacs region is active in this buffer, then this key deactivates the region without beeping or signalling." (interactive) - (if (and (region-active-p) - (eq (current-buffer) (zmacs-region-buffer))) + (if (region-active-p) ;; pseudo-zmacs compatibility: don't beep if this ^G is simply ;; deactivating the region. If it is inactive, beep. nil @@ -130,9 +129,10 @@ or go back to just one window (by deleting all but the selected window)." :group 'editing-basics) (defun command-error (error-object) - (let ((inhibit-quit t) - (debug-on-error nil) - (etype (car-safe error-object))) + (let* ((old-debug-on-error debug-on-error) + (inhibit-quit t) + (debug-on-error nil) + (etype (car-safe error-object))) (setq quit-flag nil) (setq standard-output t) (setq standard-input t) @@ -161,7 +161,12 @@ or go back to just one window (by deleting all but the selected window)." (if (noninteractive) (progn - (message "%s exiting." emacs-program-name) + (if old-debug-on-error + (progn + (message "Backtrace:\n\n") + (backtrace) + (message "\n"))) + (message "%s exiting\n." emacs-program-name) (kill-emacs -1))) t)) @@ -181,11 +186,26 @@ or go back to just one window (by deleting all but the selected window)." (defun truncate-command-history-for-gc () - (let ((tail (nthcdr 30 command-history))) - (if tail (setcdr tail nil))) - (let ((tail (nthcdr 30 values))) - (if tail (setcdr tail nil))) - ) + ;; We should try to avoid accessing any bindings to speak of in this + ;; function; as this hook is called asynchronously, the search for + ;; those bindings might search local bindings from essentially + ;; arbitrary functions. We force the body of the function to run at + ;; command-loop level, where the danger of local bindings is much + ;; reduced; the code can still do its job because the command history + ;; and values list will not grow before then anyway. + ;; + ;; Nothing is done in batch mode, both because it is a waste of time + ;; (there is no command loop!) and because this any GCs during dumping + ;; will invoke this code, and if it were to enqueue an eval event, + ;; the portable dumper would try to dump it and fail. + (if (not (noninteractive)) + (enqueue-eval-event + #'(lambda (arg) + (let ((tail (nthcdr 30 command-history))) + (if tail (setcdr tail nil))) + (let ((tail (nthcdr 30 values))) + (if tail (setcdr tail nil)))) + nil))) (add-hook 'pre-gc-hook 'truncate-command-history-for-gc) @@ -319,23 +339,36 @@ when called from Lisp." (if (and teach-extended-commands-p (interactive-p)) - ;; We need to fiddle with keys: remember the keys, run the - ;; command, and show the keys (if any). + ;; Remember the keys, run the command, and show the keys (if + ;; any). The funny variable names are a poor man's guarantee + ;; that we don't get tripped by this-command doing something + ;; funny. Quoth our forefathers: "We want lexical scope!" (let ((_execute_command_keys_ (where-is-internal this-command)) (_execute_command_name_ this-command)) ; the name can change (command-execute this-command t) - (when (and _execute_command_keys_ - ;; Wait for a while, so the user can see a message - ;; printed, if any. - (sit-for 1)) - (display-message - 'no-log - (format "Command `%s' is bound to key%s: %s" - _execute_command_name_ - (if (cdr _execute_command_keys_) "s" "") - (sorted-key-descriptions _execute_command_keys_))) - (sit-for teach-extended-commands-timeout) - (clear-message 'no-log))) + (when _execute_command_keys_ + ;; Normally the region is adjusted in post_command_hook; + ;; however, it is not called until after we finish. It + ;; looks ugly for the region to get updated after the + ;; delays, so we do it now. The code below is a Lispified + ;; copy of code in event-stream.c:post_command_hook(). + (if (and (not zmacs-region-stays) + (or (not (eq (selected-window) (minibuffer-window))) + (eq (zmacs-region-buffer) (current-buffer)))) + (zmacs-deactivate-region) + (zmacs-update-region)) + ;; Wait for a while, so the user can see a message printed, + ;; if any. + (when (sit-for 1) + (display-message + 'no-log + (format (if (cdr _execute_command_keys_) + "Command `%s' is bound to keys: %s" + "Command `%s' is bound to key: %s") + _execute_command_name_ + (sorted-key-descriptions _execute_command_keys_))) + (sit-for teach-extended-commands-timeout) + (clear-message 'no-log)))) ;; Else, just run the command. (command-execute this-command t))) @@ -372,7 +405,7 @@ when called from Lisp." ; (call-interactively _command _record-flag))))) (defun y-or-n-p-minibuf (prompt) - "Ask user a \"y or n\" question. Return t if answer is \"y\". + "Ask user a \"y or n\" question. Return t if answer is \"y\", nil if \"n\". Takes one argument, which is the string to display to ask the question. It should end in a space; `y-or-n-p' adds `(y or n) ' to it. No confirmation of the answer is requested; a single character is enough. @@ -443,9 +476,28 @@ and can edit it until it has been confirmed." (sleep-for 2)))) ans))) -;; these may be redefined later, but make the original def easily encapsulable -(define-function 'yes-or-no-p 'yes-or-no-p-minibuf) -(define-function 'y-or-n-p 'y-or-n-p-minibuf) +(defun yes-or-no-p (prompt) + "Ask user a yes-or-no question. Return t if answer is yes. +The question is asked with a dialog box or the minibuffer, as appropriate. +Takes one argument, which is the string to display to ask the question. +It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it. +The user must confirm the answer with RET, +and can edit it until it as been confirmed." + (if (should-use-dialog-box-p) + (yes-or-no-p-dialog-box prompt) + (yes-or-no-p-minibuf prompt))) + +(defun y-or-n-p (prompt) + "Ask user a \"y or n\" question. Return t if answer is \"y\", nil if \"n\". +Takes one argument, which is the string to display to ask the question. +The question is asked with a dialog box or the minibuffer, as appropriate. +It should end in a space; `y-or-n-p' adds `(y or n) ' to it. +No confirmation of the answer is requested; a single character is enough. +Also accepts Space to mean yes, or Delete to mean no." + (if (should-use-dialog-box-p) + (yes-or-no-p-dialog-box prompt) + (y-or-n-p-minibuf prompt))) + (defun read-char ()