=== modified file 'lisp/ChangeLog' *** lisp/ChangeLog 2013-04-30 16:27:36 +0000 --- lisp/ChangeLog 2013-05-01 01:43:33 +0000 *************** *** 1,3 **** --- 1,29 ---- + 2013-04-28 Jean-Philippe Gravel + + * progmodes/gdb-mi.el: Fix non-responsive gud commands (bug#13845) + (gdb-handler-alist, gdb-handler-number): Remove variables. + (gdb-handler-list): New variable. + (gdb-add-handler, gdb-delete-handler, gdb-get-handler-function) + (gdb-pending-handler-p, gdb-handle-reply) + (gdb-remove-all-pending-triggers): New functions. + (gdb-discard-unordered-replies): New defcustom. + (gdb-handler): New defstruct. + (gdb-wait-for-pending): Fix invalid backquote. Use gdb-handler-list. + instead of gdb-pending-triggers. Update docstring. + (gdb-init-1): Remove dead variables. Initialize gdb-handler-list. + (gdb-speedbar-update, gdb-speedbar-timer-fn, gdb-var-update) + (gdb-var-update-handler, def-gdb-auto-update-trigger) + (def-gdb-auto-update-handler, gdb-get-changed-registers) + (gdb-changed-registers-handler, gdb-get-main-selected-frame) + (gdb-frame-handler): Pending triggers are now automatically managed. + (def-gdb-trigger-and-handler, def-gdb-auto-update-handler): + Remove argument. + (gdb-input): Automatically handles pending triggers. Update docstring. + (gdb-resync): Replaced gdb-pending-triggers by gdb-handler-list. + (gdb-thread-exited, gdb-thread-selected, gdb-register-names-handler): + Update comments. + (gdb-done-or-error): Now use gdb-handle-reply. + 2013-04-30 Leo Liu * progmodes/octave.el (inferior-octave-prompt-read-only): Fix last === modified file 'lisp/progmodes/gdb-mi.el' *** lisp/progmodes/gdb-mi.el 2013-04-20 16:24:04 +0000 --- lisp/progmodes/gdb-mi.el 2013-05-01 01:51:19 +0000 *************** *** 91,97 **** (require 'gud) (require 'json) (require 'bindat) ! (eval-when-compile (require 'cl-lib)) (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) --- 91,97 ---- (require 'gud) (require 'json) (require 'bindat) ! (require 'cl-lib) (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) *************** *** 206,213 **** (defvar gdb-last-command nil) (defvar gdb-prompt-name nil) (defvar gdb-token-number 0) ! (defvar gdb-handler-alist '()) ! (defvar gdb-handler-number nil) (defvar gdb-source-file-list nil "List of source files for the current executable.") (defvar gdb-first-done-or-error t) --- 206,213 ---- (defvar gdb-last-command nil) (defvar gdb-prompt-name nil) (defvar gdb-token-number 0) ! (defvar gdb-handler-list '() ! "List of gdb-handler keeping track of all pending GDB commands.") (defvar gdb-source-file-list nil "List of source files for the current executable.") (defvar gdb-first-done-or-error t) *************** *** 242,274 **** disposition of output generated by commands that gdb mode sends to gdb on its own behalf.") ! ;; Pending triggers prevent congestion: Emacs won't send two similar ! ;; consecutive requests. ! ! (defvar gdb-pending-triggers '() ! "A list of trigger functions which have not yet been handled. ! ! Elements are either function names or pairs (buffer . function)") ! (defmacro gdb-add-pending (item) ! `(push ,item gdb-pending-triggers)) ! (defmacro gdb-pending-p (item) ! `(member ,item gdb-pending-triggers)) ! (defmacro gdb-delete-pending (item) ! `(setq gdb-pending-triggers ! (delete ,item gdb-pending-triggers))) (defmacro gdb-wait-for-pending (&rest body) ! "Wait until `gdb-pending-triggers' is empty and evaluate FORM. ! This function checks `gdb-pending-triggers' value every ! `gdb-wait-for-pending' seconds." ! (run-with-timer ! 0.5 nil ! `(lambda () ! (if (not gdb-pending-triggers) ! (progn ,@body) ! (gdb-wait-for-pending ,@body))))) ;; Publish-subscribe --- 242,355 ---- disposition of output generated by commands that gdb mode sends to gdb on its own behalf.") ! (defcustom gdb-discard-unordered-replies t ! "When non-nil, any out-of-order GDB replies are discarded. ! This mechanism is provided as a protection against lost GDB replies, ! assuming that GDB always replies in the same order Emacs is sending ! commands. When receiving a reply with a given token-number, any ! pending messages with a lower token-number are considered out-of-order." ! :type 'boolean ! :group 'gud ! :version "24.4") ! (cl-defstruct gdb-handler ! "Structure used to keep track of the commands sent to GDB and ! handle the replies received." ! ;; Prefix of the command sent to GDB. The GDB reply for this command ! ;; will be prefixed with this same TOKEN-NUMBER ! (token-number nil :read-only t) ! ;; Callback to invoke when the reply is received from GDB ! (function nil :read-only t) ! ;; PENDING-TRIGGER is used to prevent congestion: Emacs won't send ! ;; two requests with the same PENDING-TRIGGER until a reply is received ! ;; for the first one." ! (pending-trigger nil)) ! ! (defun gdb-add-handler (token-number handler-function &optional pending-trigger) ! "Insert a new GDB command handler in `gdb-handler-list'. ! Handlers are used to keep track the commands sent to GDB and to handle the ! replies received. TOKEN-NUMBER is the number used as prefix of the GDB/mi ! command sent. Upon reception of a reply prefixed with the same TOKEN-NUMBER, ! the callback HANDLER-FUNCTION is invoked. If PENDING-TRIGGER is specified, ! no new GDB commands will be sent with this same PENDING-TRIGGER until a reply is ! received for this handler." ! ! (push (make-gdb-handler :token-number token-number ! :function handler-function ! :pending-trigger pending-trigger) ! gdb-handler-list)) ! ! (defun gdb-delete-handler (token-number) ! "Remove the handler TOKEN-NUMBER from `gdb-handler-list'. ! Additionally, if `gdb-discard-unordered-replies' is non-nil, all handlers ! having a token number less than TOKEN-NUMBER are discarded." ! (if gdb-discard-unordered-replies ! ! (setq gdb-handler-list ! (cl-delete-if ! (lambda (handler) ! "Discard any HANDLER with a token number `<=' than TOKEN-NUMBER." ! (when (< (gdb-handler-token-number handler) token-number) ! (message (format ! "WARNING! Discarding GDB handler with token #%d\n" ! (gdb-handler-token-number handler)))) ! (<= (gdb-handler-token-number handler) token-number)) ! gdb-handler-list)) ! ! (setq gdb-handler-list ! (cl-delete-if ! (lambda (handler) ! "Discard any HANDLER with a token number `eq' to TOKEN-NUMBER." ! (eq (gdb-handler-token-number handler) token-number)) ! gdb-handler-list)))) ! ! (defun gdb-get-handler-function (token-number) ! "Return the function callback registered with the handler TOKEN-NUMBER." ! (gdb-handler-function ! (cl-find-if (lambda (handler) (eq (gdb-handler-token-number handler) ! token-number)) ! gdb-handler-list))) ! ! ! (defun gdb-pending-handler-p (pending-trigger) ! "Return non-nil if a command handler is pending with trigger PENDING-TRIGGER." ! (cl-find-if (lambda (handler) (eq (gdb-handler-pending-trigger handler) ! pending-trigger)) ! gdb-handler-list)) ! ! ! (defun gdb-handle-reply (token-number) ! "Handle the GDB reply TOKEN-NUMBER. ! This involves invoking the callback registered with this token number ! in `gdb-handler-list' and clearing all pending handlers invalidated ! by the reception of this reply." ! (let ((handler-function (gdb-get-handler-function token-number))) ! (when handler-function ! (funcall handler-function) ! (gdb-delete-handler token-number)))) ! ! (defun gdb-remove-all-pending-triggers () ! "Remove all pending triggers from gdb-handler-list. ! The handlers are left in gdb-handler-list so that replies received ! from GDB could still be handled. However, removing the pending triggers ! allows Emacs to send new commands even if replies of previous commands ! were not yet received." ! (dolist (handler gdb-handler-list) ! (setf (gdb-handler-pending-trigger handler) nil))) (defmacro gdb-wait-for-pending (&rest body) ! "Wait for all pending GDB commands to finish and evaluate BODY. ! This function checks every 0.5 seconds if there are any pending ! triggers in `gdb-handler-list'." ! `(run-with-timer ! 0.5 nil ! '(lambda () ! (if (not (gdb-find-if (lambda (handler) ! (gdb-handler-pending-trigger handler)) ! gdb-handler-list)) ! (progn ,@body) ! (gdb-wait-for-pending ,@body))))) ;; Publish-subscribe *************** *** 820,833 **** gdb-frame-number nil gdb-thread-number nil gdb-var-list nil - gdb-pending-triggers nil gdb-output-sink 'user gdb-location-alist nil gdb-source-file-list nil gdb-last-command nil gdb-token-number 0 ! gdb-handler-alist '() ! gdb-handler-number nil gdb-prompt-name nil gdb-first-done-or-error t gdb-buffer-fringe-width (car (window-fringes)) --- 901,912 ---- gdb-frame-number nil gdb-thread-number nil gdb-var-list nil gdb-output-sink 'user gdb-location-alist nil gdb-source-file-list nil gdb-last-command nil gdb-token-number 0 ! gdb-handler-list '() gdb-prompt-name nil gdb-first-done-or-error t gdb-buffer-fringe-width (car (window-fringes)) *************** *** 1107,1123 **** (message-box "No symbol \"%s\" in current context." expr)))) (defun gdb-speedbar-update () ! (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame) ! (not (gdb-pending-p 'gdb-speedbar-timer))) ;; Dummy command to update speedbar even when idle. ! (gdb-input "-environment-pwd" 'gdb-speedbar-timer-fn) ! ;; Keep gdb-pending-triggers non-nil till end. ! (gdb-add-pending 'gdb-speedbar-timer))) (defun gdb-speedbar-timer-fn () (if gdb-speedbar-auto-raise (raise-frame speedbar-frame)) - (gdb-delete-pending 'gdb-speedbar-timer) (speedbar-timer-fn)) (defun gdb-var-evaluate-expression-handler (varnum changed) --- 1186,1200 ---- (message-box "No symbol \"%s\" in current context." expr)))) (defun gdb-speedbar-update () ! (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) ;; Dummy command to update speedbar even when idle. ! (gdb-input "-environment-pwd" ! 'gdb-speedbar-timer-fn ! 'gdb-speedbar-update))) (defun gdb-speedbar-timer-fn () (if gdb-speedbar-auto-raise (raise-frame speedbar-frame)) (speedbar-timer-fn)) (defun gdb-var-evaluate-expression-handler (varnum changed) *************** *** 1207,1215 **** ; Uses "-var-update --all-values". Needs GDB 6.4 onwards. (defun gdb-var-update () ! (if (not (gdb-pending-p 'gdb-var-update)) ! (gdb-input "-var-update --all-values *" 'gdb-var-update-handler)) ! (gdb-add-pending 'gdb-var-update)) (defun gdb-var-update-handler () (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) --- 1284,1292 ---- ; Uses "-var-update --all-values". Needs GDB 6.4 onwards. (defun gdb-var-update () ! (gdb-input "-var-update --all-values *" ! 'gdb-var-update-handler ! 'gdb-var-update)) (defun gdb-var-update-handler () (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) *************** *** 1272,1279 **** (push var1 var-list)) (setq var1 (pop temp-var-list))) (setq gdb-var-list (nreverse var-list)))))))) - (setq gdb-pending-triggers - (delq 'gdb-var-update gdb-pending-triggers)) (gdb-speedbar-update)) (defun gdb-speedbar-expand-node (text token indent) --- 1349,1354 ---- *************** *** 1727,1744 **** (setq string (replace-regexp-in-string "\n" "\\n" string t t)) (concat "\"" string "\"")) ! (defun gdb-input (command handler-function) "Send COMMAND to GDB via the MI interface. Run the function HANDLER-FUNCTION, with no arguments, once the command is ! complete." ! (if gdb-enable-debug (push (list 'send-item command handler-function) ! gdb-debug-log)) ! (setq gdb-token-number (1+ gdb-token-number)) ! (setq command (concat (number-to-string gdb-token-number) command)) ! (push (cons gdb-token-number handler-function) gdb-handler-alist) ! (if gdbmi-debug-mode (message "gdb-input: %s" command)) ! (process-send-string (get-buffer-process gud-comint-buffer) ! (concat command "\n"))) ;; NOFRAME is used for gud execution control commands (defun gdb-current-context-command (command) --- 1802,1826 ---- (setq string (replace-regexp-in-string "\n" "\\n" string t t)) (concat "\"" string "\"")) ! (defun gdb-input (command handler-function &optional trigger-name) "Send COMMAND to GDB via the MI interface. Run the function HANDLER-FUNCTION, with no arguments, once the command is ! complete. If TRIGGER-NAME is non-nil, the COMMAND will not be sent to GDB ! if Emacs is still waiting for a reply from another command was previously ! sent with the same TRIGGER-NAME." ! (when (or (not trigger-name) ! (not (gdb-pending-handler-p trigger-name))) ! ! (if gdb-enable-debug (push (list 'send-item command handler-function) ! gdb-debug-log)) ! (setq gdb-token-number (1+ gdb-token-number)) ! (setq command (concat (number-to-string gdb-token-number) command)) ! ! (gdb-add-handler gdb-token-number handler-function trigger-name) ! ! (if gdbmi-debug-mode (message "gdb-input: %s" command)) ! (process-send-string (get-buffer-process gud-comint-buffer) ! (concat command "\n")))) ;; NOFRAME is used for gud execution control commands (defun gdb-current-context-command (command) *************** *** 1774,1780 **** (defun gdb-resync() (setq gud-running nil) (setq gdb-output-sink 'user) ! (setq gdb-pending-triggers nil)) (defun gdb-update (&optional no-proc) "Update buffers showing status of debug session. --- 1856,1862 ---- (defun gdb-resync() (setq gud-running nil) (setq gdb-output-sink 'user) ! (gdb-remove-all-pending-triggers)) (defun gdb-update (&optional no-proc) "Update buffers showing status of debug session. *************** *** 2255,2263 **** (if (string= gdb-thread-number thread-id) (gdb-setq-thread-number nil)) ;; When we continue current thread and it quickly exits, ! ;; gdb-pending-triggers left after gdb-running disallow us to ! ;; properly call -thread-info without --thread option. Thus we ! ;; need to use gdb-wait-for-pending. (gdb-wait-for-pending (gdb-emit-signal gdb-buf-publisher 'update-threads)))) --- 2337,2345 ---- (if (string= gdb-thread-number thread-id) (gdb-setq-thread-number nil)) ;; When we continue current thread and it quickly exits, ! ;; the pending triggers in gdb-handler-list left after gdb-running ! ;; disallow us to properly call -thread-info without --thread option. ! ;; Thus we need to use gdb-wait-for-pending. (gdb-wait-for-pending (gdb-emit-signal gdb-buf-publisher 'update-threads)))) *************** *** 2272,2280 **** ;; by `=thread-selected` notification. `^done` causes `gdb-update` ;; as usually. Things happen to fast and second call (from ;; gdb-thread-selected handler) gets cut off by our beloved ! ;; gdb-pending-triggers. ! ;; Solution is `gdb-wait-for-pending` macro: it guarantees that its ! ;; body will get executed when `gdb-pending-triggers` is empty. (gdb-wait-for-pending (gdb-update)))) --- 2354,2363 ---- ;; by `=thread-selected` notification. `^done` causes `gdb-update` ;; as usually. Things happen to fast and second call (from ;; gdb-thread-selected handler) gets cut off by our beloved ! ;; pending triggers. ! ;; Solution is `gdb-wait-for-pending' macro: it guarantees that its ! ;; body will get executed when `gdb-handler-list' if free of ! ;; pending triggers. (gdb-wait-for-pending (gdb-update)))) *************** *** 2438,2447 **** (when (and token-number is-complete) (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) ! (funcall ! (cdr (assoc (string-to-number token-number) gdb-handler-alist)))) ! (setq gdb-handler-alist ! (assq-delete-all token-number gdb-handler-alist))) (when is-complete (gdb-clear-partial-output)))) --- 2521,2527 ---- (when (and token-number is-complete) (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) ! (gdb-handle-reply (string-to-number token-number)))) (when is-complete (gdb-clear-partial-output)))) *************** *** 2659,2685 **** (when (or (not ,signal-list) (memq signal ,signal-list)) ! (when (not (gdb-pending-p ! (cons (current-buffer) ',trigger-name))) ! (gdb-input ,gdb-command ! (gdb-bind-function-to-buffer ',handler-name (current-buffer))) ! (gdb-add-pending (cons (current-buffer) ',trigger-name)))))) ;; Used by disassembly buffer only, the rest use ;; def-gdb-trigger-and-handler ! (defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun &optional nopreserve) ! "Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN. Handlers are normally called from the buffers they put output in. ! Delete ((current-buffer) . TRIGGER-NAME) from ! `gdb-pending-triggers', erase current buffer and evaluate ! CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called. If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." `(defun ,handler-name () - (gdb-delete-pending (cons (current-buffer) ',trigger-name)) (let* ((inhibit-read-only t) ,@(unless nopreserve '((window (get-buffer-window (current-buffer) 0)) --- 2739,2761 ---- (when (or (not ,signal-list) (memq signal ,signal-list)) ! (gdb-input ,gdb-command ! (gdb-bind-function-to-buffer ',handler-name (current-buffer)) ! (cons (current-buffer) ',trigger-name))))) ;; Used by disassembly buffer only, the rest use ;; def-gdb-trigger-and-handler ! (defmacro def-gdb-auto-update-handler (handler-name custom-defun &optional nopreserve) ! "Define a handler HANDLER-NAME calling CUSTOM-DEFUN. Handlers are normally called from the buffers they put output in. ! Erase current buffer and evaluate CUSTOM-DEFUN. ! Then `gdb-update-buffer-name' is called. If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." `(defun ,handler-name () (let* ((inhibit-read-only t) ,@(unless nopreserve '((window (get-buffer-window (current-buffer) 0)) *************** *** 2707,2713 **** ,gdb-command ,handler-name ,signal-list) (def-gdb-auto-update-handler ,handler-name ! ,trigger-name ,custom-defun))) --- 2783,2789 ---- ,gdb-command ,handler-name ,signal-list) (def-gdb-auto-update-handler ,handler-name ! ,custom-defun))) *************** *** 3624,3630 **** (def-gdb-auto-update-handler gdb-disassembly-handler - gdb-invalidate-disassembly gdb-disassembly-handler-custom t) --- 3700,3705 ---- *************** *** 4116,4136 **** ;; Needs GDB 6.4 onwards (used to fail with no stack). (defun gdb-get-changed-registers () ! (when (and (gdb-get-buffer 'gdb-registers-buffer) ! (not (gdb-pending-p 'gdb-get-changed-registers))) (gdb-input "-data-list-changed-registers" ! 'gdb-changed-registers-handler) ! (gdb-add-pending 'gdb-get-changed-registers))) (defun gdb-changed-registers-handler () - (gdb-delete-pending 'gdb-get-changed-registers) (setq gdb-changed-registers nil) (dolist (register-number (bindat-get-field (gdb-json-partial-output) 'changed-registers)) (push register-number gdb-changed-registers))) (defun gdb-register-names-handler () ! ;; Don't use gdb-pending-triggers because this handler is called ;; only once (in gdb-init-1) (setq gdb-register-names nil) (dolist (register-name --- 4191,4209 ---- ;; Needs GDB 6.4 onwards (used to fail with no stack). (defun gdb-get-changed-registers () ! (when (gdb-get-buffer 'gdb-registers-buffer) (gdb-input "-data-list-changed-registers" ! 'gdb-changed-registers-handler ! 'gdb-get-changed-registers))) (defun gdb-changed-registers-handler () (setq gdb-changed-registers nil) (dolist (register-number (bindat-get-field (gdb-json-partial-output) 'changed-registers)) (push register-number gdb-changed-registers))) (defun gdb-register-names-handler () ! ;; Don't use pending triggers because this handler is called ;; only once (in gdb-init-1) (setq gdb-register-names nil) (dolist (register-name *************** *** 4154,4169 **** (defun gdb-get-main-selected-frame () "Trigger for `gdb-frame-handler' which uses main current thread. Called from `gdb-update'." ! (if (not (gdb-pending-p 'gdb-get-main-selected-frame)) ! (progn ! (gdb-input (gdb-current-context-command "-stack-info-frame") ! 'gdb-frame-handler) ! (gdb-add-pending 'gdb-get-main-selected-frame)))) (defun gdb-frame-handler () "Set `gdb-selected-frame' and `gdb-selected-file' to show overlay arrow in source buffer." - (gdb-delete-pending 'gdb-get-main-selected-frame) (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame))) (when frame (setq gdb-selected-frame (bindat-get-field frame 'func)) --- 4227,4239 ---- (defun gdb-get-main-selected-frame () "Trigger for `gdb-frame-handler' which uses main current thread. Called from `gdb-update'." ! (gdb-input (gdb-current-context-command "-stack-info-frame") ! 'gdb-frame-handler ! 'gdb-get-main-selected-frame)) (defun gdb-frame-handler () "Set `gdb-selected-frame' and `gdb-selected-file' to show overlay arrow in source buffer." (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame))) (when frame (setq gdb-selected-frame (bindat-get-field frame 'func))