diff options
| author | Chong Yidong | 2011-12-25 18:46:49 +0800 |
|---|---|---|
| committer | Chong Yidong | 2011-12-25 18:46:49 +0800 |
| commit | 2170cb536dd1b4860618bf4ab7f1311c0d35e5a3 (patch) | |
| tree | 38a6a6757c77db08d2a1faeaaef015b6dcada820 | |
| parent | 28796b3a4a606e835300ce853c17a24e90da9bf0 (diff) | |
| download | emacs-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/ChangeLog | 22 | ||||
| -rw-r--r-- | lisp/progmodes/gdb-mi.el | 214 | ||||
| -rw-r--r-- | lisp/progmodes/gud.el | 104 |
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 @@ | |||
| 1 | 2011-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 | |||
| 1 | 2011-12-24 Alan Mackenzie <acm@muc.de> | 23 | 2011-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. |
| 1692 | Run the function HANDLER-FUNCTION, with no arguments, once the command is | ||
| 1693 | complete." | ||
| 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." | |||
| 3815 | thread. Called from `gdb-update'." | 3796 | thread. 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. | ||
| 4252 | COMMAND is the prefix for which we seek completion. | ||
| 4253 | CONTEXT 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. | ||
| 775 | It receives two arguments: COMMAND, the prefix for which we seek | ||
| 776 | completion; and CONTEXT, the text before COMMAND on the line. | ||
| 777 | It 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. |
| 856 | STRING is the output to filter. | 868 | STRING is the output to filter. |
| 857 | It is passed through FILTER before we look at it." | 869 | It 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." | |||
| 934 | BUFFER is the current buffer which may be the GUD buffer in which to run. | 935 | BUFFER is the current buffer which may be the GUD buffer in which to run. |
| 935 | SKIP is the number of chars to skip on each line, it defaults to 0." | 936 | SKIP 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)) |