aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2011-12-25 18:46:49 +0800
committerChong Yidong2011-12-25 18:46:49 +0800
commit2170cb536dd1b4860618bf4ab7f1311c0d35e5a3 (patch)
tree38a6a6757c77db08d2a1faeaaef015b6dcada820
parent28796b3a4a606e835300ce853c17a24e90da9bf0 (diff)
downloademacs-2170cb536dd1b4860618bf4ab7f1311c0d35e5a3.tar.gz
emacs-2170cb536dd1b4860618bf4ab7f1311c0d35e5a3.zip
Fix GDB/MI inline completion.
* progmodes/gdb-mi.el (gdb-input): Accept command and handler function as separate arguments. (gdb-init-1, gdb-non-stop-handler, gdb-check-target-async) (gdb-tooltip-print-1, gud-watch, gdb-speedbar-update) (gdb-var-list-children, gdb-var-set-format, gdb-var-delete-1) (gdb-var-delete-children, gdb-edit-value, gdb-var-update) (gdb-stopped, def-gdb-auto-update-trigger) (gdb-place-breakpoints, gdb-select-thread, gdb-select-frame) (gdb-get-changed-registers, gdb-get-main-selected-frame): Callers changed. (gud-gdbmi-completions): New function. (gdb): Use it for generating the completion table. * progmodes/gud.el (gud-gdb-fetch-lines-filter): Just use gud-gdb-marker-filter without taking it as an argument. (gud-gdb-run-command-fetch-lines): Caller changed. (gud-gdb-completion-function): New variable. (gud-gdb-completion-at-point): Use it. (gud-gdb-completions-1): Split from gud-gdb-completions.
-rw-r--r--lisp/ChangeLog22
-rw-r--r--lisp/progmodes/gdb-mi.el214
-rw-r--r--lisp/progmodes/gud.el104
3 files changed, 187 insertions, 153 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8c368473871..f5b3c92f8c2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,25 @@
12011-12-25 Chong Yidong <cyd@gnu.org>
2
3 * progmodes/gud.el (gud-gdb-fetch-lines-filter): Just use
4 gud-gdb-marker-filter without taking it as an argument.
5 (gud-gdb-run-command-fetch-lines): Caller changed.
6 (gud-gdb-completion-function): New variable.
7 (gud-gdb-completion-at-point): Use it.
8 (gud-gdb-completions-1): Split from gud-gdb-completions.
9
10 * progmodes/gdb-mi.el (gdb-input): Accept command and handler
11 function as separate arguments.
12 (gdb-init-1, gdb-non-stop-handler, gdb-check-target-async)
13 (gdb-tooltip-print-1, gud-watch, gdb-speedbar-update)
14 (gdb-var-list-children, gdb-var-set-format, gdb-var-delete-1)
15 (gdb-var-delete-children, gdb-edit-value, gdb-var-update)
16 (gdb-stopped, def-gdb-auto-update-trigger)
17 (gdb-place-breakpoints, gdb-select-thread, gdb-select-frame)
18 (gdb-get-changed-registers, gdb-get-main-selected-frame): Callers
19 changed.
20 (gud-gdbmi-completions): New function.
21 (gdb): Use it for generating the completion table.
22
12011-12-24 Alan Mackenzie <acm@muc.de> 232011-12-24 Alan Mackenzie <acm@muc.de>
2 24
3 Introduce a mechanism to widen the region used in context font 25 Introduce a mechanism to widen the region used in context font
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 9ad76f2cfec..128ff4bb143 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -811,8 +811,8 @@ detailed description of this mode.
811 (define-key gud-minor-mode-map [left-margin C-mouse-3] 811 (define-key gud-minor-mode-map [left-margin C-mouse-3]
812 'gdb-mouse-jump) 812 'gdb-mouse-jump)
813 813
814 (set (make-local-variable 'comint-prompt-regexp) 814 (set (make-local-variable 'gud-gdb-completion-function)
815 "^(.*gdb[+]?) *") 815 'gud-gdbmi-completions)
816 816
817 (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point 817 (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
818 nil 'local) 818 nil 'local)
@@ -862,31 +862,28 @@ detailed description of this mode.
862 (set-process-filter (get-process "gdb-inferior") 'gdb-inferior-filter) 862 (set-process-filter (get-process "gdb-inferior") 'gdb-inferior-filter)
863 (gdb-input 863 (gdb-input
864 ;; Needs GDB 6.4 onwards 864 ;; Needs GDB 6.4 onwards
865 (list (concat "-inferior-tty-set " 865 (concat "-inferior-tty-set "
866 (or 866 (or
867 ;; The process can run on a remote host. 867 ;; The process can run on a remote host.
868 (process-get (get-process "gdb-inferior") 'remote-tty) 868 (process-get (get-process "gdb-inferior") 'remote-tty)
869 (process-tty-name (get-process "gdb-inferior")))) 869 (process-tty-name (get-process "gdb-inferior"))))
870 'ignore)) 870 'ignore)
871 (if (eq window-system 'w32) 871 (if (eq window-system 'w32)
872 (gdb-input (list "-gdb-set new-console off" 'ignore))) 872 (gdb-input "-gdb-set new-console off" 'ignore))
873 (gdb-input (list "-gdb-set height 0" 'ignore)) 873 (gdb-input "-gdb-set height 0" 'ignore)
874 874
875 (when gdb-non-stop 875 (when gdb-non-stop
876 (gdb-input (list "-gdb-set non-stop 1" 'gdb-non-stop-handler))) 876 (gdb-input "-gdb-set non-stop 1" 'gdb-non-stop-handler))
877 877
878 (gdb-input (list "-enable-pretty-printing" 'ignore)) 878 (gdb-input "-enable-pretty-printing" 'ignore)
879 879
880 ;; find source file and compilation directory here 880 ;; find source file and compilation directory here
881 (if gdb-create-source-file-list 881 (if gdb-create-source-file-list
882 (gdb-input 882 ;; Needs GDB 6.2 onwards.
883 ; Needs GDB 6.2 onwards. 883 (gdb-input "-file-list-exec-source-files" 'gdb-get-source-file-list))
884 (list "-file-list-exec-source-files" 'gdb-get-source-file-list))) 884 ;; Needs GDB 6.0 onwards.
885 (gdb-input 885 (gdb-input "-file-list-exec-source-file" 'gdb-get-source-file)
886 ; Needs GDB 6.0 onwards. 886 (gdb-input "-gdb-show prompt" 'gdb-get-prompt))
887 (list "-file-list-exec-source-file" 'gdb-get-source-file))
888 (gdb-input
889 (list "-gdb-show prompt" 'gdb-get-prompt)))
890 887
891(defun gdb-non-stop-handler () 888(defun gdb-non-stop-handler ()
892 (goto-char (point-min)) 889 (goto-char (point-min))
@@ -897,8 +894,8 @@ detailed description of this mode.
897 (setq gdb-non-stop nil) 894 (setq gdb-non-stop nil)
898 (setq gdb-supports-non-stop nil)) 895 (setq gdb-supports-non-stop nil))
899 (setq gdb-supports-non-stop t) 896 (setq gdb-supports-non-stop t)
900 (gdb-input (list "-gdb-set target-async 1" 'ignore)) 897 (gdb-input "-gdb-set target-async 1" 'ignore)
901 (gdb-input (list "-list-target-features" 'gdb-check-target-async)))) 898 (gdb-input "-list-target-features" 'gdb-check-target-async)))
902 899
903(defun gdb-check-target-async () 900(defun gdb-check-target-async ()
904 (goto-char (point-min)) 901 (goto-char (point-min))
@@ -906,7 +903,7 @@ detailed description of this mode.
906 (message 903 (message
907 "Target doesn't support non-stop mode. Turning it off.") 904 "Target doesn't support non-stop mode. Turning it off.")
908 (setq gdb-non-stop nil) 905 (setq gdb-non-stop nil)
909 (gdb-input (list "-gdb-set non-stop 0" 'ignore)))) 906 (gdb-input "-gdb-set non-stop 0" 'ignore)))
910 907
911(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.") 908(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")
912 909
@@ -951,9 +948,8 @@ detailed description of this mode.
951 (goto-char (point-min)) 948 (goto-char (point-min))
952 (if (search-forward "expands to: " nil t) 949 (if (search-forward "expands to: " nil t)
953 (unless (looking-at "\\S-+.*(.*).*") 950 (unless (looking-at "\\S-+.*(.*).*")
954 (gdb-input 951 (gdb-input (concat "-data-evaluate-expression " expr)
955 (list (concat "-data-evaluate-expression " expr) 952 `(lambda () (gdb-tooltip-print ,expr)))))))
956 `(lambda () (gdb-tooltip-print ,expr))))))))
957 953
958(defun gdb-init-buffer () 954(defun gdb-init-buffer ()
959 (set (make-local-variable 'gud-minor-mode) 'gdbmi) 955 (set (make-local-variable 'gud-minor-mode) 'gdbmi)
@@ -1083,9 +1079,8 @@ With arg, enter name of variable to be watched in the minibuffer."
1083 (concat (if (derived-mode-p 'gdb-registers-mode) "$") 1079 (concat (if (derived-mode-p 'gdb-registers-mode) "$")
1084 (tooltip-identifier-from-point (point))))))) 1080 (tooltip-identifier-from-point (point)))))))
1085 (set-text-properties 0 (length expr) nil expr) 1081 (set-text-properties 0 (length expr) nil expr)
1086 (gdb-input 1082 (gdb-input (concat "-var-create - * " expr "")
1087 (list (concat "-var-create - * " expr "") 1083 `(lambda () (gdb-var-create-handler ,expr))))))
1088 `(lambda () (gdb-var-create-handler ,expr)))))))
1089 (message "gud-watch is a no-op in this mode.")))) 1084 (message "gud-watch is a no-op in this mode."))))
1090 1085
1091(defun gdb-var-create-handler (expr) 1086(defun gdb-var-create-handler (expr)
@@ -1114,7 +1109,7 @@ With arg, enter name of variable to be watched in the minibuffer."
1114 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame) 1109 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
1115 (not (gdb-pending-p 'gdb-speedbar-timer))) 1110 (not (gdb-pending-p 'gdb-speedbar-timer)))
1116 ;; Dummy command to update speedbar even when idle. 1111 ;; Dummy command to update speedbar even when idle.
1117 (gdb-input (list "-environment-pwd" 'gdb-speedbar-timer-fn)) 1112 (gdb-input "-environment-pwd" 'gdb-speedbar-timer-fn)
1118 ;; Keep gdb-pending-triggers non-nil till end. 1113 ;; Keep gdb-pending-triggers non-nil till end.
1119 (gdb-add-pending 'gdb-speedbar-timer))) 1114 (gdb-add-pending 'gdb-speedbar-timer)))
1120 1115
@@ -1135,12 +1130,9 @@ With arg, enter name of variable to be watched in the minibuffer."
1135 1130
1136 ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. 1131 ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
1137(defun gdb-var-list-children (varnum) 1132(defun gdb-var-list-children (varnum)
1138 (gdb-input 1133 (gdb-input (concat "-var-update " varnum) 'ignore)
1139 (list (concat "-var-update " varnum) 'ignore)) 1134 (gdb-input (concat "-var-list-children --all-values " varnum)
1140 (gdb-input 1135 `(lambda () (gdb-var-list-children-handler ,varnum))))
1141 (list (concat "-var-list-children --all-values "
1142 varnum)
1143 `(lambda () (gdb-var-list-children-handler ,varnum)))))
1144 1136
1145(defun gdb-var-list-children-handler (varnum) 1137(defun gdb-var-list-children-handler (varnum)
1146 (let* ((var-list nil) 1138 (let* ((var-list nil)
@@ -1172,13 +1164,11 @@ With arg, enter name of variable to be watched in the minibuffer."
1172 "Set the output format for a variable displayed in the speedbar." 1164 "Set the output format for a variable displayed in the speedbar."
1173 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) 1165 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
1174 (varnum (car var))) 1166 (varnum (car var)))
1175 (gdb-input 1167 (gdb-input (concat "-var-set-format " varnum " " format) 'ignore)
1176 (list (concat "-var-set-format " varnum " " format) 'ignore))
1177 (gdb-var-update))) 1168 (gdb-var-update)))
1178 1169
1179(defun gdb-var-delete-1 (var varnum) 1170(defun gdb-var-delete-1 (var varnum)
1180 (gdb-input 1171 (gdb-input (concat "-var-delete " varnum) 'ignore)
1181 (list (concat "-var-delete " varnum) 'ignore))
1182 (setq gdb-var-list (delq var gdb-var-list)) 1172 (setq gdb-var-list (delq var gdb-var-list))
1183 (dolist (varchild gdb-var-list) 1173 (dolist (varchild gdb-var-list)
1184 (if (string-match (concat (car var) "\\.") (car varchild)) 1174 (if (string-match (concat (car var) "\\.") (car varchild))
@@ -1197,17 +1187,15 @@ With arg, enter name of variable to be watched in the minibuffer."
1197 1187
1198(defun gdb-var-delete-children (varnum) 1188(defun gdb-var-delete-children (varnum)
1199 "Delete children of variable object at point from the speedbar." 1189 "Delete children of variable object at point from the speedbar."
1200 (gdb-input 1190 (gdb-input (concat "-var-delete -c " varnum) 'ignore))
1201 (list (concat "-var-delete -c " varnum) 'ignore)))
1202 1191
1203(defun gdb-edit-value (_text _token _indent) 1192(defun gdb-edit-value (_text _token _indent)
1204 "Assign a value to a variable displayed in the speedbar." 1193 "Assign a value to a variable displayed in the speedbar."
1205 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) 1194 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
1206 (varnum (car var)) (value)) 1195 (varnum (car var)) (value))
1207 (setq value (read-string "New value: ")) 1196 (setq value (read-string "New value: "))
1208 (gdb-input 1197 (gdb-input (concat "-var-assign " varnum " " value)
1209 (list (concat "-var-assign " varnum " " value) 1198 `(lambda () (gdb-edit-value-handler ,value)))))
1210 `(lambda () (gdb-edit-value-handler ,value))))))
1211 1199
1212(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)") 1200(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)")
1213 1201
@@ -1219,8 +1207,7 @@ With arg, enter name of variable to be watched in the minibuffer."
1219 ; Uses "-var-update --all-values". Needs GDB 6.4 onwards. 1207 ; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
1220(defun gdb-var-update () 1208(defun gdb-var-update ()
1221 (if (not (gdb-pending-p 'gdb-var-update)) 1209 (if (not (gdb-pending-p 'gdb-var-update))
1222 (gdb-input 1210 (gdb-input "-var-update --all-values *" 'gdb-var-update-handler))
1223 (list "-var-update --all-values *" 'gdb-var-update-handler)))
1224 (gdb-add-pending 'gdb-var-update)) 1211 (gdb-add-pending 'gdb-var-update))
1225 1212
1226(defun gdb-var-update-handler () 1213(defun gdb-var-update-handler ()
@@ -1700,13 +1687,17 @@ static char *magick[] = {
1700 gdb-continuation string "\"\n")) 1687 gdb-continuation string "\"\n"))
1701 (setq gdb-continuation nil)))) 1688 (setq gdb-continuation nil))))
1702 1689
1703(defun gdb-input (item) 1690(defun gdb-input (command handler-function)
1704 (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log)) 1691 "Send COMMAND to GDB via the MI interface.
1692Run the function HANDLER-FUNCTION, with no arguments, once the command is
1693complete."
1694 (if gdb-enable-debug (push (list 'send-item command handler-function)
1695 gdb-debug-log))
1705 (setq gdb-token-number (1+ gdb-token-number)) 1696 (setq gdb-token-number (1+ gdb-token-number))
1706 (setcar item (concat (number-to-string gdb-token-number) (car item))) 1697 (setq command (concat (number-to-string gdb-token-number) command))
1707 (push (cons gdb-token-number (car (cdr item))) gdb-handler-alist) 1698 (push (cons gdb-token-number handler-function) gdb-handler-alist)
1708 (process-send-string (get-buffer-process gud-comint-buffer) 1699 (process-send-string (get-buffer-process gud-comint-buffer)
1709 (concat (car item) "\n"))) 1700 (concat command "\n")))
1710 1701
1711;; NOFRAME is used for gud execution control commands 1702;; NOFRAME is used for gud execution control commands
1712(defun gdb-current-context-command (command) 1703(defun gdb-current-context-command (command)
@@ -1893,15 +1884,16 @@ is running."
1893 (let ((record-type (cadr output-record)) 1884 (let ((record-type (cadr output-record))
1894 (arg1 (nth 2 output-record)) 1885 (arg1 (nth 2 output-record))
1895 (arg2 (nth 3 output-record))) 1886 (arg2 (nth 3 output-record)))
1896 (if (eq record-type 'gdb-error) 1887 (cond ((eq record-type 'gdb-error)
1897 (gdb-done-or-error arg2 arg1 'error) 1888 (gdb-done-or-error arg2 arg1 'error))
1898 (if (eq record-type 'gdb-done) 1889 ((eq record-type 'gdb-done)
1899 (gdb-done-or-error arg2 arg1 'done) 1890 (gdb-done-or-error arg2 arg1 'done))
1900 ;; Suppress "No registers." since GDB 6.8 and earlier duplicates MI 1891 ;; Suppress "No registers." GDB 6.8 and earlier
1901 ;; error message on internal stream. Don't print to GUD buffer. 1892 ;; duplicates MI error message on internal stream.
1902 (unless (and (eq record-type 'gdb-internals) 1893 ;; Don't print to GUD buffer.
1903 (string-equal (read arg1) "No registers.\n")) 1894 ((not (and (eq record-type 'gdb-internals)
1904 (funcall record-type arg1)))))) 1895 (string-equal (read arg1) "No registers.\n")))
1896 (funcall record-type arg1)))))
1905 1897
1906 (setq gdb-output-sink 'user) 1898 (setq gdb-output-sink 'user)
1907 ;; Remove padding. 1899 ;; Remove padding.
@@ -1994,11 +1986,10 @@ current thread and update GDB buffers."
1994 ;; -data-list-register-names needs to be issued for any stopped 1986 ;; -data-list-register-names needs to be issued for any stopped
1995 ;; thread 1987 ;; thread
1996 (when (not gdb-register-names) 1988 (when (not gdb-register-names)
1997 (gdb-input 1989 (gdb-input (concat "-data-list-register-names"
1998 (list (concat "-data-list-register-names" 1990 (if gdb-supports-non-stop
1999 (if gdb-supports-non-stop 1991 (concat " --thread " thread-id)))
2000 (concat " --thread " thread-id))) 1992 'gdb-register-names-handler))
2001 'gdb-register-names-handler)))
2002 1993
2003;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler 1994;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler
2004;;; because synchronous GDB doesn't give these fields with CLI. 1995;;; because synchronous GDB doesn't give these fields with CLI.
@@ -2065,9 +2056,7 @@ current thread and update GDB buffers."
2065;; (frontend MI commands should not print to this stream) 2056;; (frontend MI commands should not print to this stream)
2066(defun gdb-console (output-field) 2057(defun gdb-console (output-field)
2067 (setq gdb-filter-output 2058 (setq gdb-filter-output
2068 (gdb-concat-output 2059 (gdb-concat-output gdb-filter-output (read output-field))))
2069 gdb-filter-output
2070 (read output-field))))
2071 2060
2072(defun gdb-done-or-error (output-field token-number type) 2061(defun gdb-done-or-error (output-field token-number type)
2073 (if (string-equal token-number "") 2062 (if (string-equal token-number "")
@@ -2105,12 +2094,11 @@ current thread and update GDB buffers."
2105 (assq-delete-all token-number gdb-handler-alist))))) 2094 (assq-delete-all token-number gdb-handler-alist)))))
2106 2095
2107(defun gdb-concat-output (so-far new) 2096(defun gdb-concat-output (so-far new)
2108 (let ((sink gdb-output-sink)) 2097 (cond
2109 (cond 2098 ((eq gdb-output-sink 'user) (concat so-far new))
2110 ((eq sink 'user) (concat so-far new)) 2099 ((eq gdb-output-sink 'emacs)
2111 ((eq sink 'emacs) 2100 (gdb-append-to-partial-output new)
2112 (gdb-append-to-partial-output new) 2101 so-far)))
2113 so-far))))
2114 2102
2115(defun gdb-append-to-partial-output (string) 2103(defun gdb-append-to-partial-output (string)
2116 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) 2104 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
@@ -2320,9 +2308,8 @@ trigger argument when describing buffer types with
2320 (memq signal ,signal-list)) 2308 (memq signal ,signal-list))
2321 (when (not (gdb-pending-p 2309 (when (not (gdb-pending-p
2322 (cons (current-buffer) ',trigger-name))) 2310 (cons (current-buffer) ',trigger-name)))
2323 (gdb-input 2311 (gdb-input ,gdb-command
2324 (list ,gdb-command 2312 (gdb-bind-function-to-buffer ',handler-name (current-buffer)))
2325 (gdb-bind-function-to-buffer ',handler-name (current-buffer))))
2326 (gdb-add-pending (cons (current-buffer) ',trigger-name)))))) 2313 (gdb-add-pending (cons (current-buffer) ',trigger-name))))))
2327 2314
2328;; Used by disassembly buffer only, the rest use 2315;; Used by disassembly buffer only, the rest use
@@ -2449,13 +2436,10 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
2449 ;; Only want one breakpoint icon at each location. 2436 ;; Only want one breakpoint icon at each location.
2450 (gdb-put-breakpoint-icon (string-equal flag "y") bptno 2437 (gdb-put-breakpoint-icon (string-equal flag "y") bptno
2451 (string-to-number line))) 2438 (string-to-number line)))
2452 (gdb-input 2439 (gdb-input (concat "list " file ":1") 'ignore)
2453 (list (concat "list " file ":1") 2440 (gdb-input "-file-list-exec-source-file"
2454 'ignore)) 2441 `(lambda () (gdb-get-location
2455 (gdb-input 2442 ,bptno ,line ,flag)))))))))
2456 (list "-file-list-exec-source-file"
2457 `(lambda () (gdb-get-location
2458 ,bptno ,line ,flag))))))))))
2459 2443
2460(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") 2444(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
2461 2445
@@ -2785,7 +2769,7 @@ on the current line."
2785(def-gdb-thread-buffer-command gdb-select-thread 2769(def-gdb-thread-buffer-command gdb-select-thread
2786 (let ((new-id (bindat-get-field thread 'id))) 2770 (let ((new-id (bindat-get-field thread 'id)))
2787 (gdb-setq-thread-number new-id) 2771 (gdb-setq-thread-number new-id)
2788 (gdb-input (list (concat "-thread-select " new-id) 'ignore)) 2772 (gdb-input (concat "-thread-select " new-id) 'ignore)
2789 (gdb-update)) 2773 (gdb-update))
2790 "Select the thread at current line of threads buffer.") 2774 "Select the thread at current line of threads buffer.")
2791 2775
@@ -3541,8 +3525,8 @@ member."
3541 (if (gdb-buffer-shows-main-thread-p) 3525 (if (gdb-buffer-shows-main-thread-p)
3542 (let ((new-level (bindat-get-field frame 'level))) 3526 (let ((new-level (bindat-get-field frame 'level)))
3543 (setq gdb-frame-number new-level) 3527 (setq gdb-frame-number new-level)
3544 (gdb-input (list (concat "-stack-select-frame " new-level) 3528 (gdb-input (concat "-stack-select-frame " new-level)
3545 'ignore)) 3529 'ignore)
3546 (gdb-update)) 3530 (gdb-update))
3547 (error "Could not select frame for non-current thread")) 3531 (error "Could not select frame for non-current thread"))
3548 (error "Not recognized as frame line")))) 3532 (error "Not recognized as frame line"))))
@@ -3770,14 +3754,11 @@ member."
3770 3754
3771;; Needs GDB 6.4 onwards (used to fail with no stack). 3755;; Needs GDB 6.4 onwards (used to fail with no stack).
3772(defun gdb-get-changed-registers () 3756(defun gdb-get-changed-registers ()
3773 (if (and (gdb-get-buffer 'gdb-registers-buffer) 3757 (when (and (gdb-get-buffer 'gdb-registers-buffer)
3774 (not (gdb-pending-p 'gdb-get-changed-registers))) 3758 (not (gdb-pending-p 'gdb-get-changed-registers)))
3775 (progn 3759 (gdb-input "-data-list-changed-registers"
3776 (gdb-input 3760 'gdb-changed-registers-handler)
3777 (list 3761 (gdb-add-pending 'gdb-get-changed-registers)))
3778 "-data-list-changed-registers"
3779 'gdb-changed-registers-handler))
3780 (gdb-add-pending 'gdb-get-changed-registers))))
3781 3762
3782(defun gdb-changed-registers-handler () 3763(defun gdb-changed-registers-handler ()
3783 (gdb-delete-pending 'gdb-get-changed-registers) 3764 (gdb-delete-pending 'gdb-get-changed-registers)
@@ -3815,9 +3796,8 @@ is set in them."
3815thread. Called from `gdb-update'." 3796thread. Called from `gdb-update'."
3816 (if (not (gdb-pending-p 'gdb-get-main-selected-frame)) 3797 (if (not (gdb-pending-p 'gdb-get-main-selected-frame))
3817 (progn 3798 (progn
3818 (gdb-input 3799 (gdb-input (gdb-current-context-command "-stack-info-frame")
3819 (list (gdb-current-context-command "-stack-info-frame") 3800 'gdb-frame-handler)
3820 'gdb-frame-handler))
3821 (gdb-add-pending 'gdb-get-main-selected-frame)))) 3801 (gdb-add-pending 'gdb-get-main-selected-frame))))
3822 3802
3823(defun gdb-frame-handler () 3803(defun gdb-frame-handler ()
@@ -4259,6 +4239,42 @@ BUFFER nil or omitted means use the current buffer."
4259 (set-window-margins 4239 (set-window-margins
4260 window left-margin-width right-margin-width))))) 4240 window left-margin-width right-margin-width)))))
4261 4241
4242
4243;;; Functions for inline completion.
4244
4245(defvar gud-gdb-fetch-lines-in-progress)
4246(defvar gud-gdb-fetch-lines-string)
4247(defvar gud-gdb-fetch-lines-break)
4248(defvar gud-gdb-fetched-lines)
4249
4250(defun gud-gdbmi-completions (context command)
4251 "Completion table for GDB/MI commands.
4252COMMAND is the prefix for which we seek completion.
4253CONTEXT is the text before COMMAND on the line."
4254 (let ((gud-gdb-fetch-lines-in-progress t)
4255 (gud-gdb-fetch-lines-string nil)
4256 (gud-gdb-fetch-lines-break (length context))
4257 (gud-gdb-fetched-lines nil)
4258 ;; This filter dumps output lines to `gud-gdb-fetched-lines'.
4259 (gud-marker-filter #'gud-gdbmi-fetch-lines-filter)
4260 complete-list)
4261 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
4262 (gdb-input (concat "complete " context command)
4263 (lambda () (setq gud-gdb-fetch-lines-in-progress nil)))
4264 (while gud-gdb-fetch-lines-in-progress
4265 (accept-process-output (get-buffer-process gud-comint-buffer))))
4266 (gud-gdb-completions-1 gud-gdb-fetched-lines)))
4267
4268(defun gud-gdbmi-fetch-lines-filter (string)
4269 "Custom filter function for `gud-gdbmi-completions'."
4270 (setq string (concat gud-gdb-fetch-lines-string
4271 (gud-gdbmi-marker-filter string)))
4272 (while (string-match "\n" string)
4273 (push (substring string gud-gdb-fetch-lines-break (match-beginning 0))
4274 gud-gdb-fetched-lines)
4275 (setq string (substring string (match-end 0))))
4276 "")
4277
4262(provide 'gdb-mi) 4278(provide 'gdb-mi)
4263 4279
4264;;; gdb-mi.el ends here 4280;;; gdb-mi.el ends here
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index de8da09768d..7215ac4ea73 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -756,6 +756,8 @@ directory and source-file directory for your debugger."
756 756
757 (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point 757 (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
758 nil 'local) 758 nil 'local)
759 (set (make-local-variable 'gud-gdb-completion-function) 'gud-gdb-completions)
760
759 (local-set-key "\C-i" 'completion-at-point) 761 (local-set-key "\C-i" 'completion-at-point)
760 (setq comint-prompt-regexp "^(.*gdb[+]?) *") 762 (setq comint-prompt-regexp "^(.*gdb[+]?) *")
761 (setq paragraph-start comint-prompt-regexp) 763 (setq paragraph-start comint-prompt-regexp)
@@ -768,6 +770,12 @@ directory and source-file directory for your debugger."
768;; context-sensitive command completion. We preserve that feature 770;; context-sensitive command completion. We preserve that feature
769;; in the GUD buffer by using a GDB command designed just for Emacs. 771;; in the GUD buffer by using a GDB command designed just for Emacs.
770 772
773(defvar gud-gdb-completion-function nil
774 "Completion function for GDB commands.
775It receives two arguments: COMMAND, the prefix for which we seek
776completion; and CONTEXT, the text before COMMAND on the line.
777It should return a list of completion strings.")
778
771;; The completion process filter indicates when it is finished. 779;; The completion process filter indicates when it is finished.
772(defvar gud-gdb-fetch-lines-in-progress) 780(defvar gud-gdb-fetch-lines-in-progress)
773 781
@@ -806,28 +814,32 @@ CONTEXT is the text before COMMAND on the line."
806 (and complete-list 814 (and complete-list
807 (string-match "^Undefined command: \"complete\"" (car complete-list)) 815 (string-match "^Undefined command: \"complete\"" (car complete-list))
808 (error "This version of GDB doesn't support the `complete' command")) 816 (error "This version of GDB doesn't support the `complete' command"))
809 ;; Sort the list like readline. 817 (gud-gdb-completions-1 complete-list)))
810 (setq complete-list (sort complete-list (function string-lessp))) 818
811 ;; Remove duplicates. 819;; This function is also used by `gud-gdbmi-completions'.
812 (let ((first complete-list) 820(defun gud-gdb-completions-1 (complete-list)
813 (second (cdr complete-list))) 821 ;; Sort the list like readline.
814 (while second 822 (setq complete-list (sort complete-list (function string-lessp)))
815 (if (string-equal (car first) (car second)) 823 ;; Remove duplicates.
816 (setcdr first (setq second (cdr second))) 824 (let ((first complete-list)
817 (setq first second 825 (second (cdr complete-list)))
818 second (cdr second))))) 826 (while second
819 ;; Add a trailing single quote if there is a unique completion 827 (if (string-equal (car first) (car second))
820 ;; and it contains an odd number of unquoted single quotes. 828 (setcdr first (setq second (cdr second)))
821 (and (= (length complete-list) 1) 829 (setq first second
822 (let ((str (car complete-list)) 830 second (cdr second)))))
823 (pos 0) 831 ;; Add a trailing single quote if there is a unique completion
824 (count 0)) 832 ;; and it contains an odd number of unquoted single quotes.
825 (while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos) 833 (and (= (length complete-list) 1)
826 (setq count (1+ count) 834 (let ((str (car complete-list))
827 pos (match-end 0))) 835 (pos 0)
828 (and (= (mod count 2) 1) 836 (count 0))
829 (setq complete-list (list (concat str "'")))))) 837 (while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos)
830 complete-list)) 838 (setq count (1+ count)
839 pos (match-end 0)))
840 (and (= (mod count 2) 1)
841 (setq complete-list (list (concat str "'"))))))
842 complete-list)
831 843
832(defun gud-gdb-completion-at-point () 844(defun gud-gdb-completion-at-point ()
833 "Return the data to complete the GDB command before point." 845 "Return the data to complete the GDB command before point."
@@ -838,7 +850,7 @@ CONTEXT is the text before COMMAND on the line."
838 (point)))) 850 (point))))
839 (list start end 851 (list start end
840 (completion-table-dynamic 852 (completion-table-dynamic
841 (apply-partially #'gud-gdb-completions 853 (apply-partially gud-gdb-completion-function
842 (buffer-substring (comint-line-beginning-position) 854 (buffer-substring (comint-line-beginning-position)
843 start)))))) 855 start))))))
844 856
@@ -851,11 +863,11 @@ CONTEXT is the text before COMMAND on the line."
851 863
852;; The completion process filter is installed temporarily to slurp the 864;; The completion process filter is installed temporarily to slurp the
853;; output of GDB up to the next prompt and build the completion list. 865;; output of GDB up to the next prompt and build the completion list.
854(defun gud-gdb-fetch-lines-filter (string filter) 866(defun gud-gdb-fetch-lines-filter (string)
855 "Filter used to read the list of lines output by a command. 867 "Filter used to read the list of lines output by a command.
856STRING is the output to filter. 868STRING is the output to filter.
857It is passed through FILTER before we look at it." 869It is passed through `gud-gdb-marker-filter' before we look at it."
858 (setq string (funcall filter string)) 870 (setq string (gud-gdb-marker-filter string))
859 (setq string (concat gud-gdb-fetch-lines-string string)) 871 (setq string (concat gud-gdb-fetch-lines-string string))
860 (while (string-match "\n" string) 872 (while (string-match "\n" string)
861 (push (substring string gud-gdb-fetch-lines-break (match-beginning 0)) 873 (push (substring string gud-gdb-fetch-lines-break (match-beginning 0))
@@ -880,17 +892,6 @@ It is passed through FILTER before we look at it."
880(defvar gud-gdb-fetched-stack-frame nil 892(defvar gud-gdb-fetched-stack-frame nil
881 "Stack frames we are fetching from GDB.") 893 "Stack frames we are fetching from GDB.")
882 894
883;(defun gud-gdb-get-scope-data (text token indent)
884; ;; checkdoc-params: (indent)
885; "Fetch data associated with a stack frame, and expand/contract it.
886;Data to do this is retrieved from TEXT and TOKEN."
887; (let ((args nil) (scope nil))
888; (gud-gdb-run-command-fetch-lines "info args")
889;
890; (gud-gdb-run-command-fetch-lines "info local")
891;
892; ))
893
894(defun gud-gdb-get-stackframe (buffer) 895(defun gud-gdb-get-stackframe (buffer)
895 "Extract the current stack frame out of the GUD GDB BUFFER." 896 "Extract the current stack frame out of the GUD GDB BUFFER."
896 (let ((newlst nil) 897 (let ((newlst nil)
@@ -934,21 +935,16 @@ It is passed through FILTER before we look at it."
934BUFFER is the current buffer which may be the GUD buffer in which to run. 935BUFFER is the current buffer which may be the GUD buffer in which to run.
935SKIP is the number of chars to skip on each line, it defaults to 0." 936SKIP is the number of chars to skip on each line, it defaults to 0."
936 (with-current-buffer gud-comint-buffer 937 (with-current-buffer gud-comint-buffer
937 (if (and (eq gud-comint-buffer buffer) 938 (unless (and (eq gud-comint-buffer buffer)
938 (save-excursion 939 (save-excursion
939 (goto-char (point-max)) 940 (goto-char (point-max))
940 (forward-line 0) 941 (forward-line 0)
941 (not (looking-at comint-prompt-regexp)))) 942 (not (looking-at comint-prompt-regexp))))
942 nil
943 ;; Much of this copied from GDB complete, but I'm grabbing the stack
944 ;; frame instead.
945 (let ((gud-gdb-fetch-lines-in-progress t) 943 (let ((gud-gdb-fetch-lines-in-progress t)
946 (gud-gdb-fetched-lines nil) 944 (gud-gdb-fetched-lines nil)
947 (gud-gdb-fetch-lines-string nil) 945 (gud-gdb-fetch-lines-string nil)
948 (gud-gdb-fetch-lines-break (or skip 0)) 946 (gud-gdb-fetch-lines-break (or skip 0))
949 (gud-marker-filter 947 (gud-marker-filter #'gud-gdb-fetch-lines-filter))
950 `(lambda (string)
951 (gud-gdb-fetch-lines-filter string ',gud-marker-filter))))
952 ;; Issue the command to GDB. 948 ;; Issue the command to GDB.
953 (gud-basic-call command) 949 (gud-basic-call command)
954 ;; Slurp the output. 950 ;; Slurp the output.
@@ -3422,7 +3418,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference."
3422 ((xdb pdb) (concat "p " expr)) 3418 ((xdb pdb) (concat "p " expr))
3423 (sdb (concat expr "/")))) 3419 (sdb (concat expr "/"))))
3424 3420
3425(declare-function gdb-input "gdb-mi" (item)) 3421(declare-function gdb-input "gdb-mi" (command handler))
3426(declare-function tooltip-expr-to-print "tooltip" (event)) 3422(declare-function tooltip-expr-to-print "tooltip" (event))
3427(declare-function tooltip-event-buffer "tooltip" (event)) 3423(declare-function tooltip-event-buffer "tooltip" (event))
3428 3424
@@ -3468,12 +3464,12 @@ so they have been disabled."))
3468 (if (eq gud-minor-mode 'gdbmi) 3464 (if (eq gud-minor-mode 'gdbmi)
3469 (if gdb-macro-info 3465 (if gdb-macro-info
3470 (gdb-input 3466 (gdb-input
3471 (list (concat 3467 (concat
3472 "server macro expand " expr "\n") 3468 "server macro expand " expr "\n")
3473 `(lambda () (gdb-tooltip-print-1 ,expr)))) 3469 `(lambda () (gdb-tooltip-print-1 ,expr)))
3474 (gdb-input 3470 (gdb-input
3475 (list (concat cmd "\n") 3471 (concat cmd "\n")
3476 `(lambda () (gdb-tooltip-print ,expr))))) 3472 `(lambda () (gdb-tooltip-print ,expr))))
3477 (setq gud-tooltip-original-filter (process-filter process)) 3473 (setq gud-tooltip-original-filter (process-filter process))
3478 (set-process-filter process 'gud-tooltip-process-output) 3474 (set-process-filter process 'gud-tooltip-process-output)
3479 (gud-basic-call cmd)) 3475 (gud-basic-call cmd))