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
: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)
(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))
(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)
(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)))
; (call-interactively _command _record-flag)))))
\f
(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.
(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)))
+
\f
(defun read-char ()
projects / chise / xemacs-chise.git.1 / blobdiff