diff options
author | Paul Eggert <eggert@cs.ucla.edu> | 2011-04-26 10:50:51 -0700 |
---|---|---|
committer | Paul Eggert <eggert@cs.ucla.edu> | 2011-04-26 10:50:51 -0700 |
commit | b5f869a7d838121b17493ad66958309c0d6031e5 (patch) | |
tree | 6b84bb3fe253d717db02f0b82f65d13e0069cefd | |
parent | 847ab9d19cefe485965a8b6f8b154e065a79b867 (diff) | |
parent | bd0d2ee23380c98e8d41645b0d45574c83c7a393 (diff) | |
download | emacs-b5f869a7d838121b17493ad66958309c0d6031e5.tar.gz |
Merge from mainline.
-rw-r--r-- | etc/ChangeLog | 5 | ||||
-rw-r--r-- | etc/DEBUG | 5 | ||||
-rw-r--r-- | lib-src/ChangeLog | 2 | ||||
-rw-r--r-- | lisp/ChangeLog | 15 | ||||
-rw-r--r-- | lisp/cus-start.el | 5 | ||||
-rw-r--r-- | lisp/erc/ChangeLog | 15 | ||||
-rw-r--r-- | lisp/erc/erc-button.el | 35 | ||||
-rw-r--r-- | lisp/erc/erc-dcc.el | 5 | ||||
-rw-r--r-- | lisp/erc/erc-pcomplete.el | 10 | ||||
-rw-r--r-- | lisp/erc/erc.el | 14 | ||||
-rw-r--r-- | lisp/subr.el | 70 | ||||
-rw-r--r-- | nt/ChangeLog | 5 | ||||
-rw-r--r-- | nt/cmdproxy.c | 112 | ||||
-rw-r--r-- | src/ChangeLog | 27 | ||||
-rw-r--r-- | src/eval.c | 2 | ||||
-rw-r--r-- | src/gnutls.c | 6 | ||||
-rw-r--r-- | src/keyboard.c | 36 | ||||
-rw-r--r-- | src/lisp.h | 2 |
18 files changed, 285 insertions, 86 deletions
diff --git a/etc/ChangeLog b/etc/ChangeLog index 24f44b9d0e8..48324a6be90 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,8 @@ +2011-04-26 Daniel Colascione <dan.colascione@gmail.com> + + * DEBUG: Document debug-on-event default behavior and utility for + debugging. + 2011-04-22 Noah Friedman <friedman@splode.com> * emacs-buffer.gdb: Add trailing underscores to appropriate member diff --git a/etc/DEBUG b/etc/DEBUG index c8fd48c6bfa..625a76ac952 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -405,6 +405,11 @@ stepping, you will see where the loop starts and ends. Also, examine the data being used in the loop and try to determine why the loop does not exit when it should. +You can also trying sending Emacs SIGUSR2, which, if `debug-on-event' +has its default value, will cause Emacs to attempt to break it out of +its current loop and into the Lisp debugger. This feature is useful +when a C-level debugger is not conveniently available. + ** If certain operations in Emacs are slower than they used to be, here is some advice for how to find out why. diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index cd6c8d2b955..c4a2df5bdbf 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,6 +1,6 @@ 2011-04-24 Teodor Zlatanov <tzz@lifelogs.com> - * makefile.w32-in (obj): Added gnutls.o. + * makefile.w32-in (obj): Add gnutls.o. 2011-04-16 Paul Eggert <eggert@cs.ucla.edu> diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 35f663ee3e5..3aae7e5b678 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2011-04-26 Daniel Colascione <dan.colascione@gmail.com> + + * cus-start.el (all): Define customization for debug-on-event. + +2011-04-26 Daniel Colascione <dan.colascione@gmail.com> + + * subr.el (shell-quote-argument): Escape correctly under Windows. + 2011-04-25 Stefan Monnier <monnier@iro.umontreal.ca> * emulation/cua-base.el (cua-selection-mode): Make it toggle again. @@ -50,6 +58,7 @@ * net/network-stream.el (network-stream-open-starttls): Give host parameter to `gnutls-negotiate'. (gnutls-negotiate): Adjust `gnutls-negotiate' declaration. + * subr.el (shell-quote-argument): Escape correctly under Windows. 2011-04-24 Daniel Colascione <dan.colascione@gmail.com> @@ -540,7 +549,7 @@ * delim-col.el (delimit-columns-max): Move defvar before first use. * descr-text.el (describe-char-categories): Don't quote `lambda'. - (describe-char): Don't quote `lambda'. Mark unused parameter. + (describe-char): Don't quote `lambda'. Mark unused parameter. * desktop.el (desktop-save-buffer-p): Mark unused parameter. (auto-insert): Declare. @@ -608,7 +617,7 @@ (modify-file-local-variable-prop-line): Remove unused variable `val'. * find-lisp.el (find-lisp-find-dired-internal): Remove unused - variable `buf'. Mark unused parameter. + variable `buf'. Mark unused parameter. (find-lisp-insert-directory): Mark unused parameter. * format.el (format-decode-run-method): Mark unused parameter; doc fix. @@ -810,7 +819,7 @@ (widget-color-action): Remove unused variables `value' and `start'. * windmove.el (windmove-wrap-loc-for-movement): Remove unused - variable `dir'. Doc fix. + variable `dir'. Doc fix. (windmove-find-other-window): Don't pass it. * window.el (count-windows): Mark unused parameter. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 1188d37150a..6113a4321c5 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -259,6 +259,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (suggest-key-bindings keyboard (choice (const :tag "off" nil) (integer :tag "time" 2) (other :tag "on"))) + (debug-on-event debug + (choice (const :tag "None" nil) + (const :tag "When sent SIGUSR1" sigusr1) + (const :tag "When sent SIGUSR2" sigusr2)) + "24.1") ;; This is not good news because it will use the wrong ;; version-specific directories when you upgrade. We need diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 6ff50756f1b..b5b36693dd2 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,18 @@ +2011-04-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * erc.el (erc-mode-map): Use completion-at-point. + (erc-mode): Tell completion-at-point to obey erc-complete-functions. + (erc-complete-word-at-point): New function. + (erc-complete-word): Make it obsolete. + * erc-pcomplete.el (erc-pcompletions-at-point): New function. + (pcomplete): Use it. + * erc-dcc.el (erc-dcc-chat-mode-map): Use completion-at-point. + (erc-dcc-chat-mode): Tell completion-at-point to obey + erc-complete-functions. + * erc-button.el (erc-button-next-function): New function extracted from + erc-button-next. + (button, erc-button-next): Use it. + 2011-03-07 Chong Yidong <cyd@stupidchicken.com> * Version 23.3 released. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 0b11c3bee2d..3a897347dea 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -53,11 +53,11 @@ "This mode buttonizes all messages according to `erc-button-alist'." ((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append) (add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append) - (add-hook 'erc-complete-functions 'erc-button-next) + (add-hook 'erc-complete-functions 'erc-button-next-function) (add-hook 'erc-mode-hook 'erc-button-setup)) ((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons) (remove-hook 'erc-send-modify-hook 'erc-button-add-buttons) - (remove-hook 'erc-complete-functions 'erc-button-next) + (remove-hook 'erc-complete-functions 'erc-button-next-function) (remove-hook 'erc-mode-hook 'erc-button-setup) (when (featurep 'xemacs) (dolist (buffer (erc-buffer-list)) @@ -427,21 +427,28 @@ call it with the value of the `erc-data' text property." (error "Function %S is not bound" fun)) (apply fun data))) +(defun erc-button-next-function () + "Pseudo completion function that actually jumps to the next button. +For use on `completion-at-point-functions'." + (let ((here (point))) + (when (< here (erc-beg-of-input-line)) + (lambda () + (while (and (get-text-property here 'erc-callback) + (not (= here (point-max)))) + (setq here (1+ here))) + (while (and (not (get-text-property here 'erc-callback)) + (not (= here (point-max)))) + (setq here (1+ here))) + (if (< here (point-max)) + (goto-char here) + (error "No next button")) + t)))) + (defun erc-button-next () "Go to the next button in this buffer." (interactive) - (let ((here (point))) - (when (< here (erc-beg-of-input-line)) - (while (and (get-text-property here 'erc-callback) - (not (= here (point-max)))) - (setq here (1+ here))) - (while (and (not (get-text-property here 'erc-callback)) - (not (= here (point-max)))) - (setq here (1+ here))) - (if (< here (point-max)) - (goto-char here) - (error "No next button")) - t))) + (let ((f (erc-button-next-function))) + (if f (funcall f)))) (defun erc-button-previous () "Go to the previous button in this buffer." diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 88f0fe605f8..19e1801e03c 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1094,7 +1094,7 @@ Possible values are: ask, auto, ignore." (defvar erc-dcc-chat-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'erc-send-current-line) - (define-key map "\t" 'erc-complete-word) + (define-key map "\t" 'completion-at-point) map) "Keymap for `erc-dcc-mode'.") @@ -1102,7 +1102,8 @@ Possible values are: ask, auto, ignore." "Major mode for wasting time via DCC chat." (setq mode-line-process '(":%s") erc-send-input-line-function 'erc-dcc-chat-send-input-line - erc-default-recipients '(dcc))) + erc-default-recipients '(dcc)) + (add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t)) (defun erc-dcc-chat-send-input-line (recipient line &optional force) "Send LINE to the remote end. diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 355770c5dcc..48c260c19fc 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -64,10 +64,16 @@ the most recent speakers are listed first." (define-erc-module pcomplete Completion "In ERC Completion mode, the TAB key does completion whenever possible." ((add-hook 'erc-mode-hook 'pcomplete-erc-setup) - (add-hook 'erc-complete-functions 'erc-pcomplete) + (add-hook 'erc-complete-functions 'erc-pcompletions-at-point) (erc-buffer-list #'pcomplete-erc-setup)) ((remove-hook 'erc-mode-hook 'pcomplete-erc-setup) - (remove-hook 'erc-complete-functions 'erc-pcomplete))) + (remove-hook 'erc-complete-functions 'erc-pcompletions-at-point))) + +(defun erc-pcompletions-at-point () + "ERC completion data from pcomplete. +for use on `completion-at-point-function'." + (when (> (point) (erc-beg-of-input-line)) + (pcomplete-completions-at-point))) (defun erc-pcomplete () "Complete the nick before point." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 110ee8d1c3f..e2228a43303 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1110,7 +1110,7 @@ which the local user typed." (define-key map "\C-c\C-u" 'erc-kill-input) (define-key map "\C-c\C-x" 'erc-quit-server) (define-key map "\M-\t" 'ispell-complete-word) - (define-key map "\t" 'erc-complete-word) + (define-key map "\t" 'completion-at-point) ;; Suppress `font-lock-fontify-block' key binding since it ;; destroys face properties. @@ -1447,7 +1447,8 @@ Defaults to the server buffer." (set (make-local-variable 'paragraph-separate) (concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)")) (set (make-local-variable 'paragraph-start) - (concat "\\(" (regexp-quote (erc-prompt)) "\\)"))) + (concat "\\(" (regexp-quote (erc-prompt)) "\\)")) + (add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t)) ;; activation @@ -3803,13 +3804,10 @@ This places `point' just after the prompt, or at the beginning of the line." (setq erc-input-ring-index nil)) (kill-line))) -(defun erc-complete-word () - "Complete the word before point. +(defun erc-complete-word-at-point () + (run-hook-with-args-until-success 'erc-complete-functions)) -This function uses `erc-complete-functions'." - (interactive) - (unless (run-hook-with-args-until-success 'erc-complete-functions) - (beep))) +(define-obsolete-function-alias 'erc-complete-word 'completion-at-point "24.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/lisp/subr.el b/lisp/subr.el index cb1fdb7f608..2b6a5404060 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2505,27 +2505,63 @@ Note: :data and :device are currently not supported on Windows." (defun shell-quote-argument (argument) "Quote ARGUMENT for passing as argument to an inferior shell." - (if (or (eq system-type 'ms-dos) - (and (eq system-type 'windows-nt) (w32-shell-dos-semantics))) - ;; Quote using double quotes, but escape any existing quotes in - ;; the argument with backslashes. - (let ((result "") - (start 0) - end) - (if (or (null (string-match "[^\"]" argument)) - (< (match-end 0) (length argument))) - (while (string-match "[\"]" argument start) - (setq end (match-beginning 0) - result (concat result (substring argument start end) - "\\" (substring argument end (1+ end))) - start (1+ end)))) - (concat "\"" result (substring argument start) "\"")) + (cond + ((eq system-type 'ms-dos) + ;; Quote using double quotes, but escape any existing quotes in + ;; the argument with backslashes. + (let ((result "") + (start 0) + end) + (if (or (null (string-match "[^\"]" argument)) + (< (match-end 0) (length argument))) + (while (string-match "[\"]" argument start) + (setq end (match-beginning 0) + result (concat result (substring argument start end) + "\\" (substring argument end (1+ end))) + start (1+ end)))) + (concat "\"" result (substring argument start) "\""))) + + ((and (eq system-type 'windows-nt) (w32-shell-dos-semantics)) + + ;; First, quote argument so that CommandLineToArgvW will + ;; understand it. See + ;; http://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx + ;; After we perform that level of quoting, escape shell + ;; metacharacters so that cmd won't mangle our argument. If the + ;; argument contains no double quote characters, we can just + ;; surround it with double quotes. Otherwise, we need to prefix + ;; each shell metacharacter with a caret. + + (setq argument + ;; escape backslashes at end of string + (replace-regexp-in-string + "\\(\\\\*\\)$" + "\\1\\1" + ;; escape backslashes and quotes in string body + (replace-regexp-in-string + "\\(\\\\*\\)\"" + "\\1\\1\\\\\"" + argument))) + + (if (string-match "\"" argument) + (concat + "^\"" + (replace-regexp-in-string + "\\([%!()\"<>&|^]\\)" + "^\\1" + argument) + "^\"") + (concat "\"" argument "\""))) + + (t (if (equal argument "") "''" ;; Quote everything except POSIX filename characters. ;; This should be safe enough even for really weird shells. - (replace-regexp-in-string "\n" "'\n'" - (replace-regexp-in-string "[^-0-9a-zA-Z_./\n]" "\\\\\\&" argument))))) + (replace-regexp-in-string + "\n" "'\n'" + (replace-regexp-in-string "[^-0-9a-zA-Z_./\n]" "\\\\\\&" argument)))) + )) (defun string-or-null-p (object) "Return t if OBJECT is a string or nil. diff --git a/nt/ChangeLog b/nt/ChangeLog index 255c2fd479d..2d6f8b61e19 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,8 @@ +2011-04-26 Daniel Colascione <dan.colascione@gmail.com> + + * cmdproxy.c (try_dequote_cmdline): New function. + (main): Use it. + 2011-04-24 Teodor Zlatanov <tzz@lifelogs.com> * configure.bat: New options --without-gnutls and --lib, new build diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index b9572570c5f..fe128fd17c4 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c @@ -309,6 +309,74 @@ make_absolute (const char *prog) return NULL; } +/* Try to decode the given command line the way cmd would do it. On + success, return 1 with cmdline dequoted. Otherwise, when we've + found constructs only cmd can properly interpret, return 0 and + leave cmdline unchanged. */ +int +try_dequote_cmdline (char* cmdline) +{ + /* Dequoting can only subtract characters, so the length of the + original command line is a bound on the amount of scratch space + we need. This length, in turn, is bounded by the 32k + CreateProces limit. */ + char * old_pos = cmdline; + char * new_cmdline = alloca (strlen(cmdline)); + char * new_pos = new_cmdline; + char c; + + enum { + NORMAL, + AFTER_CARET, + INSIDE_QUOTE + } state = NORMAL; + + while ((c = *old_pos++)) + { + switch (state) + { + case NORMAL: + switch(c) + { + case '"': + *new_pos++ = c; + state = INSIDE_QUOTE; + break; + case '^': + state = AFTER_CARET; + break; + case '<': case '>': + case '&': case '|': + case '(': case ')': + case '%': case '!': + /* We saw an unquoted shell metacharacter and we don't + understand it. Bail out. */ + return 0; + default: + *new_pos++ = c; + break; + } + break; + case AFTER_CARET: + *new_pos++ = c; + state = NORMAL; + break; + case INSIDE_QUOTE: + *new_pos++ = c; + if (c == '"') + state = NORMAL; + + break; + } + } + + /* We were able to dequote the entire string. Copy our scratch + buffer on top of the original buffer and return success. */ + memcpy (cmdline, new_cmdline, new_pos - new_cmdline); + cmdline[new_pos - new_cmdline] = '\0'; + return 1; +} + /*****************************************************************/ #if 0 @@ -574,30 +642,26 @@ main (int argc, char ** argv) execute the command directly ourself. */ if (cmdline) { - /* If no redirection or piping, and if program can be found, then - run program directly. Otherwise invoke a real shell. */ - - static char copout_chars[] = "|<>&"; - - if (strpbrk (cmdline, copout_chars) == NULL) - { - const char *args; - - /* The program name is the first token of cmdline. Since - filenames cannot legally contain embedded quotes, the value - of escape_char doesn't matter. */ - args = cmdline; - if (!get_next_token (path, &args)) - fail ("error: no program name specified.\n"); - - canon_filename (path); - progname = make_absolute (path); - - /* If we found the program, run it directly (if not found it - might be an internal shell command, so don't fail). */ - if (progname != NULL) - need_shell = FALSE; - } + const char *args; + + /* The program name is the first token of cmdline. Since + filenames cannot legally contain embedded quotes, the value + of escape_char doesn't matter. */ + args = cmdline; + if (!get_next_token (path, &args)) + fail ("error: no program name specified.\n"); + + canon_filename (path); + progname = make_absolute (path); + + /* If we found the program and the rest of the command line does + not contain unquoted shell metacharacters, run the program + directly (if not found it might be an internal shell command, + so don't fail). */ + if (progname != NULL && try_dequote_cmdline (cmdline)) + need_shell = FALSE; + else + progname = NULL; } pass_to_shell: diff --git a/src/ChangeLog b/src/ChangeLog index 912a0ae8674..c6bb161ec84 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,11 +1,6 @@ 2011-04-26 Paul Eggert <eggert@cs.ucla.edu> - * gnutls.c (emacs_gnutls_handshake): Don't return a garbage value. - Expect the caller to check whether GNUTLS_STAGE_HANDSHAKE_CANDO <= - proc->gnutls_initstage, if the check is needed. The check isn't - needed for one caller, Fgnutls_boot. (Bug#8556) - (emacs_gnutls_read): Do that check. This is the other caller. - (emacs_gnutls_handle_error): Remove unused local. + * gnutls.c (emacs_gnutls_handle_error): Remove unused local. (Fgnutls_boot): gnutls_certificate_verify_peers2 wants unsigned *. Remove unused local. (emacs_gnutls_write): Don't use uninitialized rtnval if nbyte <= 0. @@ -192,6 +187,24 @@ alignof(EMACS_INT) < sizeof (EMACS_INT). (check_sblock, check_string_bytes, check_string_free_list): Protoize. +2011-04-26 Juanma Barranquero <lekktu@gmail.com> + + * keyboard.c (QCrtl): Rename from Qrtl. All uses changed. + +2011-04-26 Teodor Zlatanov <tzz@lifelogs.com> + + * gnutls.c (emacs_gnutls_handshake): Return an error if we're not + supposed to be handshaking. (Bug#8556) + Reported by Paul Eggert <eggert@cs.ucla.edu>. + +2011-04-26 Daniel Colascione <dan.colascione@gmail.com> + + * lisp.h (Qdebug): List symbol. + * eval.c (Qdebug): Restore global linkage. + * keyboard.c (debug-on-event): New variable. + (handle_user_signal): Break into debugger when debug-on-event + matches the current signal symbol. + 2011-04-25 Dan Nicolaescu <dann@ics.uci.edu> * alloc.c (check_sblock, check_string_bytes) @@ -2710,7 +2723,7 @@ Call gdk_x11_window_lookup_for_display. (xg_set_widget_bg): New function. (delete_cb): New function. - (xg_create_frame_widgets): connect delete-event to delete_cb. + (xg_create_frame_widgets): Connect delete-event to delete_cb. Call xg_set_widget_bg. Only set backgrund pixmap for ! HAVE_GTK3 (xg_set_background_color): Call xg_set_widget_bg. (xg_set_frame_icon): Call xg_get_pixbuf_from_pix_and_mask. diff --git a/src/eval.c b/src/eval.c index d1f327021e6..8716ad78468 100644 --- a/src/eval.c +++ b/src/eval.c @@ -88,7 +88,7 @@ static Lisp_Object Qdebug_on_error; static Lisp_Object Qdeclare; Lisp_Object Qinternal_interpreter_environment, Qclosure; -static Lisp_Object Qdebug; +Lisp_Object Qdebug; /* This holds either the symbol `run-hooks' or nil. It is nil at an early stage of startup, and when Emacs diff --git a/src/gnutls.c b/src/gnutls.c index 1abccbbfbee..16a459bd62f 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -73,6 +73,9 @@ emacs_gnutls_handshake (struct Lisp_Process *proc) gnutls_session_t state = proc->gnutls_state; int ret; + if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO) + return -1; + if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET) { #ifdef WINDOWSNT @@ -176,8 +179,7 @@ emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf, if (proc->gnutls_initstage != GNUTLS_STAGE_READY) { - if (GNUTLS_STAGE_HANDSHAKE_CANDO <= proc->gnutls_initstage) - emacs_gnutls_handshake (proc); + emacs_gnutls_handshake (proc); return -1; } rtnval = gnutls_read (state, buf, nbyte); diff --git a/src/keyboard.c b/src/keyboard.c index 86b1afc86ab..6236c42e976 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -7228,12 +7228,29 @@ handle_user_signal (int sig) { int old_errno = errno; struct user_signal_info *p; + const char* special_event_name = NULL; SIGNAL_THREAD_CHECK (sig); - + + if (SYMBOLP (Vdebug_on_event)) + special_event_name = SDATA (SYMBOL_NAME (Vdebug_on_event)); + for (p = user_signals; p; p = p->next) if (p->sig == sig) { + if (special_event_name && + strcmp (special_event_name, p->name) == 0) + { + /* Enter the debugger in many ways. */ + debug_on_next_call = 1; + debug_on_quit = 1; + Vquit_flag = Qt; + Vinhibit_quit = Qnil; + + /* Eat the event. */ + break; + } + p->npending++; #ifdef SIGIO if (interrupt_input) @@ -7906,7 +7923,7 @@ static int ntool_bar_items; /* The symbols `:image' and `:rtl'. */ static Lisp_Object QCimage; -static Lisp_Object Qrtl; +static Lisp_Object QCrtl; /* Function prototypes. */ @@ -8223,7 +8240,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) /* Value is either a single image specification or a vector of 4 such specifications for the different button states. */ PROP (TOOL_BAR_ITEM_IMAGES) = value; - else if (EQ (ikey, Qrtl)) + else if (EQ (ikey, QCrtl)) /* ':rtl STRING' */ PROP (TOOL_BAR_ITEM_RTL_IMAGE) = value; } @@ -11458,7 +11475,7 @@ syms_of_keyboard (void) /* Tool-bars. */ DEFSYM (QCimage, ":image"); DEFSYM (Qhelp_echo, "help-echo"); - DEFSYM (Qrtl, ":rtl"); + DEFSYM (QCrtl, ":rtl"); staticpro (&item_properties); item_properties = Qnil; @@ -12165,6 +12182,17 @@ text in the region before modifying the buffer. The next `deactivate-mark' call uses this to set the window selection. */); Vsaved_region_selection = Qnil; + DEFVAR_LISP ("debug-on-event", + Vdebug_on_event, + doc: /* Enter debugger on this event. When Emacs +receives the special event specifed by this variable, it will try to +break into the debugger as soon as possible instead of processing the +event normally through `special-event-map'. + +Currently, the only supported values for this +variable are `sigusr1' and `sigusr2'. */); + Vdebug_on_event = intern_c_string ("sigusr2"); + /* Create the initial keyboard. */ initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (initial_kboard); diff --git a/src/lisp.h b/src/lisp.h index 4b7973939ef..65b783f7b46 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2818,7 +2818,7 @@ extern void syms_of_lread (void); /* Defined in eval.c. */ extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; -extern Lisp_Object Qinhibit_quit, Qclosure; +extern Lisp_Object Qinhibit_quit, Qclosure, Qdebug; extern Lisp_Object Qand_rest; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vsignaling_function; |