diff options
| author | Stefan Monnier | 2012-05-25 10:47:57 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-05-25 10:47:57 -0400 |
| commit | e7e85dc0a0781fdaf1cc83d7f476046a49852022 (patch) | |
| tree | fcf1a306b2ca111e7301bf8dc49e3c79b7972b35 | |
| parent | b51d2e5a656eab4019916cce3a142c6e4d56ec88 (diff) | |
| download | emacs-e7e85dc0a0781fdaf1cc83d7f476046a49852022.tar.gz emacs-e7e85dc0a0781fdaf1cc83d7f476046a49852022.zip | |
* lisp/progmodes/gdb-mi.el: Minor style changes.
(gdb-enable-debug, gdb-speedbar-auto-raise, gdb-many-windows):
Turn into minor modes.
(gdb--if-arrow): Rename from gdb-if-arrow, make it hygienic.
(gdb-mouse-until, gdb-mouse-jump): Adjust uses accordingly.
(gdb-shell): Remove unneeded let-binding.
(gdb-get-many-fields): Eliminate O(n²) behavior.
| -rw-r--r-- | lisp/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/progmodes/gdb-mi.el | 172 |
2 files changed, 80 insertions, 102 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2883420778f..132a18f7204 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,13 @@ | |||
| 1 | 2012-05-25 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * progmodes/gdb-mi.el: Minor style changes. | ||
| 4 | (gdb-enable-debug, gdb-speedbar-auto-raise, gdb-many-windows): | ||
| 5 | Turn into minor modes. | ||
| 6 | (gdb--if-arrow): Rename from gdb-if-arrow, make it hygienic. | ||
| 7 | (gdb-mouse-until, gdb-mouse-jump): Adjust uses accordingly. | ||
| 8 | (gdb-shell): Remove unneeded let-binding. | ||
| 9 | (gdb-get-many-fields): Eliminate O(n²) behavior. | ||
| 10 | |||
| 1 | 2012-05-25 Eli Zaretskii <eliz@gnu.org> | 11 | 2012-05-25 Eli Zaretskii <eliz@gnu.org> |
| 2 | 12 | ||
| 3 | * cus-start.el <vertical-centering-font-regexp>: Avoid warning on | 13 | * cus-start.el <vertical-centering-font-regexp>: Avoid warning on |
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 0cc5de90573..5ea0f6a3fd2 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el | |||
| @@ -459,9 +459,14 @@ Most recent commands are listed first. This list stores only the last | |||
| 459 | `gdb-debug-log-max' values. This variable is used to debug GDB-MI.") | 459 | `gdb-debug-log-max' values. This variable is used to debug GDB-MI.") |
| 460 | 460 | ||
| 461 | ;;;###autoload | 461 | ;;;###autoload |
| 462 | (defcustom gdb-enable-debug nil | 462 | (define-minor-mode gdb-enable-debug |
| 463 | "Non-nil means record the process input and output in `gdb-debug-log'." | 463 | "Toggle logging of transaction between Emacs and Gdb. |
| 464 | :type 'boolean | 464 | The log is stored in `gdb-debug-log' as an alist with elements |
| 465 | whose cons is send, send-item or recv and whose cdr is the string | ||
| 466 | being transferred. This list may grow up to a size of | ||
| 467 | `gdb-debug-log-max' after which the oldest element (at the end of | ||
| 468 | the list) is deleted every time a new one is added (at the front)." | ||
| 469 | :global t | ||
| 465 | :group 'gdb | 470 | :group 'gdb |
| 466 | :version "22.1") | 471 | :version "22.1") |
| 467 | 472 | ||
| @@ -512,21 +517,6 @@ Also display the main routine in the disassembly buffer if present." | |||
| 512 | ;; Force mode line redisplay soon. | 517 | ;; Force mode line redisplay soon. |
| 513 | (force-mode-line-update))))) | 518 | (force-mode-line-update))))) |
| 514 | 519 | ||
| 515 | (defun gdb-enable-debug (arg) | ||
| 516 | "Toggle logging of transaction between Emacs and Gdb. | ||
| 517 | The log is stored in `gdb-debug-log' as an alist with elements | ||
| 518 | whose cons is send, send-item or recv and whose cdr is the string | ||
| 519 | being transferred. This list may grow up to a size of | ||
| 520 | `gdb-debug-log-max' after which the oldest element (at the end of | ||
| 521 | the list) is deleted every time a new one is added (at the front)." | ||
| 522 | (interactive "P") | ||
| 523 | (setq gdb-enable-debug | ||
| 524 | (if (null arg) | ||
| 525 | (not gdb-enable-debug) | ||
| 526 | (> (prefix-numeric-value arg) 0))) | ||
| 527 | (message (format "Logging of transaction %sabled" | ||
| 528 | (if gdb-enable-debug "en" "dis")))) | ||
| 529 | |||
| 530 | ;; These two are used for menu and toolbar | 520 | ;; These two are used for menu and toolbar |
| 531 | (defun gdb-control-all-threads () | 521 | (defun gdb-control-all-threads () |
| 532 | "Switch to non-stop/A mode." | 522 | "Switch to non-stop/A mode." |
| @@ -830,7 +820,7 @@ detailed description of this mode. | |||
| 830 | (run-hooks 'gdb-mode-hook)) | 820 | (run-hooks 'gdb-mode-hook)) |
| 831 | 821 | ||
| 832 | (defun gdb-init-1 () | 822 | (defun gdb-init-1 () |
| 833 | ;; (re-)initialize | 823 | ;; (Re-)initialize. |
| 834 | (setq gdb-selected-frame nil | 824 | (setq gdb-selected-frame nil |
| 835 | gdb-frame-number nil | 825 | gdb-frame-number nil |
| 836 | gdb-thread-number nil | 826 | gdb-thread-number nil |
| @@ -879,7 +869,7 @@ detailed description of this mode. | |||
| 879 | 869 | ||
| 880 | (gdb-input "-enable-pretty-printing" 'ignore) | 870 | (gdb-input "-enable-pretty-printing" 'ignore) |
| 881 | 871 | ||
| 882 | ;; find source file and compilation directory here | 872 | ;; Find source file and compilation directory here. |
| 883 | (if gdb-create-source-file-list | 873 | (if gdb-create-source-file-list |
| 884 | ;; Needs GDB 6.2 onwards. | 874 | ;; Needs GDB 6.2 onwards. |
| 885 | (gdb-input "-file-list-exec-source-files" 'gdb-get-source-file-list)) | 875 | (gdb-input "-file-list-exec-source-files" 'gdb-get-source-file-list)) |
| @@ -979,15 +969,17 @@ no input, and GDB is waiting for input." | |||
| 979 | (gdb-create-define-alist) | 969 | (gdb-create-define-alist) |
| 980 | (add-hook 'after-save-hook 'gdb-create-define-alist nil t))) | 970 | (add-hook 'after-save-hook 'gdb-create-define-alist nil t))) |
| 981 | 971 | ||
| 982 | (defmacro gdb-if-arrow (arrow-position &rest body) | 972 | (defmacro gdb--if-arrow (arrow-position start-posn end-posn &rest body) |
| 983 | `(if ,arrow-position | 973 | (declare (indent 3)) |
| 984 | (let ((buffer (marker-buffer ,arrow-position)) (line)) | 974 | (let ((buffer (make-symbol "buffer"))) |
| 985 | (if (equal buffer (window-buffer (posn-window end))) | 975 | `(if ,arrow-position |
| 986 | (with-current-buffer buffer | 976 | (let ((,buffer (marker-buffer ,arrow-position))) |
| 987 | (when (or (equal start end) | 977 | (if (equal ,buffer (window-buffer (posn-window ,end-posn))) |
| 988 | (equal (posn-point start) | 978 | (with-current-buffer ,buffer |
| 989 | (marker-position ,arrow-position))) | 979 | (when (or (equal ,start-posn ,end-posn) |
| 990 | ,@body)))))) | 980 | (equal (posn-point ,start-posn) |
| 981 | (marker-position ,arrow-position))) | ||
| 982 | ,@body))))))) | ||
| 991 | 983 | ||
| 992 | (defun gdb-mouse-until (event) | 984 | (defun gdb-mouse-until (event) |
| 993 | "Continue running until a source line past the current line. | 985 | "Continue running until a source line past the current line. |
| @@ -997,15 +989,15 @@ with mouse-1 (default bindings)." | |||
| 997 | (interactive "e") | 989 | (interactive "e") |
| 998 | (let ((start (event-start event)) | 990 | (let ((start (event-start event)) |
| 999 | (end (event-end event))) | 991 | (end (event-end event))) |
| 1000 | (gdb-if-arrow gud-overlay-arrow-position | 992 | (gdb--if-arrow gud-overlay-arrow-position start end |
| 1001 | (setq line (line-number-at-pos (posn-point end))) | 993 | (let ((line (line-number-at-pos (posn-point end)))) |
| 1002 | (gud-call (concat "until " (number-to-string line)))) | 994 | (gud-call (concat "until " (number-to-string line))))) |
| 1003 | (gdb-if-arrow gdb-disassembly-position | 995 | (gdb--if-arrow gdb-disassembly-position start end |
| 1004 | (save-excursion | 996 | (save-excursion |
| 1005 | (goto-char (point-min)) | 997 | (goto-char (point-min)) |
| 1006 | (forward-line (1- (line-number-at-pos (posn-point end)))) | 998 | (forward-line (1- (line-number-at-pos (posn-point end)))) |
| 1007 | (forward-char 2) | 999 | (forward-char 2) |
| 1008 | (gud-call (concat "until *%a")))))) | 1000 | (gud-call (concat "until *%a")))))) |
| 1009 | 1001 | ||
| 1010 | (defun gdb-mouse-jump (event) | 1002 | (defun gdb-mouse-jump (event) |
| 1011 | "Set execution address/line. | 1003 | "Set execution address/line. |
| @@ -1016,19 +1008,17 @@ line, and no execution takes place." | |||
| 1016 | (interactive "e") | 1008 | (interactive "e") |
| 1017 | (let ((start (event-start event)) | 1009 | (let ((start (event-start event)) |
| 1018 | (end (event-end event))) | 1010 | (end (event-end event))) |
| 1019 | (gdb-if-arrow gud-overlay-arrow-position | 1011 | (gdb--if-arrow gud-overlay-arrow-position start end |
| 1020 | (setq line (line-number-at-pos (posn-point end))) | 1012 | (let ((line (line-number-at-pos (posn-point end)))) |
| 1021 | (progn | 1013 | (gud-call (concat "tbreak " (number-to-string line))) |
| 1022 | (gud-call (concat "tbreak " (number-to-string line))) | 1014 | (gud-call (concat "jump " (number-to-string line))))) |
| 1023 | (gud-call (concat "jump " (number-to-string line))))) | 1015 | (gdb--if-arrow gdb-disassembly-position start end |
| 1024 | (gdb-if-arrow gdb-disassembly-position | 1016 | (save-excursion |
| 1025 | (save-excursion | 1017 | (goto-char (point-min)) |
| 1026 | (goto-char (point-min)) | 1018 | (forward-line (1- (line-number-at-pos (posn-point end)))) |
| 1027 | (forward-line (1- (line-number-at-pos (posn-point end)))) | 1019 | (forward-char 2) |
| 1028 | (forward-char 2) | 1020 | (gud-call (concat "tbreak *%a")) |
| 1029 | (progn | 1021 | (gud-call (concat "jump *%a")))))) |
| 1030 | (gud-call (concat "tbreak *%a")) | ||
| 1031 | (gud-call (concat "jump *%a"))))))) | ||
| 1032 | 1022 | ||
| 1033 | (defcustom gdb-show-changed-values t | 1023 | (defcustom gdb-show-changed-values t |
| 1034 | "If non-nil change the face of out of scope variables and changed values. | 1024 | "If non-nil change the face of out of scope variables and changed values. |
| @@ -1050,10 +1040,11 @@ Changed values are highlighted with the face `font-lock-warning-face'." | |||
| 1050 | :group 'gdb | 1040 | :group 'gdb |
| 1051 | :version "22.2") | 1041 | :version "22.2") |
| 1052 | 1042 | ||
| 1053 | (defcustom gdb-speedbar-auto-raise nil | 1043 | (define-minor-mode gdb-speedbar-auto-raise |
| 1054 | "If non-nil raise speedbar every time display of watch expressions is\ | 1044 | "Minor mode to automatically raise the speedbar for watch expressions. |
| 1055 | updated." | 1045 | With prefix argument ARG, automatically raise speedbar if ARG is |
| 1056 | :type 'boolean | 1046 | positive, otherwise don't automatically raise it." |
| 1047 | :global t | ||
| 1057 | :group 'gdb | 1048 | :group 'gdb |
| 1058 | :version "22.1") | 1049 | :version "22.1") |
| 1059 | 1050 | ||
| @@ -1063,18 +1054,6 @@ Changed values are highlighted with the face `font-lock-warning-face'." | |||
| 1063 | :group 'gdb | 1054 | :group 'gdb |
| 1064 | :version "22.1") | 1055 | :version "22.1") |
| 1065 | 1056 | ||
| 1066 | (defun gdb-speedbar-auto-raise (arg) | ||
| 1067 | "Toggle automatic raising of the speedbar for watch expressions. | ||
| 1068 | With prefix argument ARG, automatically raise speedbar if ARG is | ||
| 1069 | positive, otherwise don't automatically raise it." | ||
| 1070 | (interactive "P") | ||
| 1071 | (setq gdb-speedbar-auto-raise | ||
| 1072 | (if (null arg) | ||
| 1073 | (not gdb-speedbar-auto-raise) | ||
| 1074 | (> (prefix-numeric-value arg) 0))) | ||
| 1075 | (message (format "Auto raising %sabled" | ||
| 1076 | (if gdb-speedbar-auto-raise "en" "dis")))) | ||
| 1077 | |||
| 1078 | (define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch) | 1057 | (define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch) |
| 1079 | (define-key global-map (vconcat gud-key-prefix "\C-w") 'gud-watch) | 1058 | (define-key global-map (vconcat gud-key-prefix "\C-w") 'gud-watch) |
| 1080 | 1059 | ||
| @@ -1212,8 +1191,8 @@ With arg, enter name of variable to be watched in the minibuffer." | |||
| 1212 | (defun gdb-edit-value (_text _token _indent) | 1191 | (defun gdb-edit-value (_text _token _indent) |
| 1213 | "Assign a value to a variable displayed in the speedbar." | 1192 | "Assign a value to a variable displayed in the speedbar." |
| 1214 | (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) | 1193 | (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) |
| 1215 | (varnum (car var)) (value)) | 1194 | (varnum (car var)) |
| 1216 | (setq value (read-string "New value: ")) | 1195 | (value (read-string "New value: "))) |
| 1217 | (gdb-input (concat "-var-assign " varnum " " value) | 1196 | (gdb-input (concat "-var-assign " varnum " " value) |
| 1218 | `(lambda () (gdb-edit-value-handler ,value))))) | 1197 | `(lambda () (gdb-edit-value-handler ,value))))) |
| 1219 | 1198 | ||
| @@ -1865,7 +1844,7 @@ is running." | |||
| 1865 | (setq gud-running | 1844 | (setq gud-running |
| 1866 | (string= (bindat-get-field (gdb-current-buffer-thread) 'state) | 1845 | (string= (bindat-get-field (gdb-current-buffer-thread) 'state) |
| 1867 | "running")) | 1846 | "running")) |
| 1868 | ;; Set frame number to "0" when _current_ threads stops | 1847 | ;; Set frame number to "0" when _current_ threads stops. |
| 1869 | (when (and (gdb-current-buffer-thread) | 1848 | (when (and (gdb-current-buffer-thread) |
| 1870 | (not (eq gud-running old-value))) | 1849 | (not (eq gud-running old-value))) |
| 1871 | (setq gdb-frame-number "0")))) | 1850 | (setq gdb-frame-number "0")))) |
| @@ -1933,10 +1912,10 @@ is running." | |||
| 1933 | (> (length gdb-debug-log) gdb-debug-log-max)) | 1912 | (> (length gdb-debug-log) gdb-debug-log-max)) |
| 1934 | (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil))) | 1913 | (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil))) |
| 1935 | 1914 | ||
| 1936 | ;; Recall the left over gud-marker-acc from last time | 1915 | ;; Recall the left over gud-marker-acc from last time. |
| 1937 | (setq gud-marker-acc (concat gud-marker-acc string)) | 1916 | (setq gud-marker-acc (concat gud-marker-acc string)) |
| 1938 | 1917 | ||
| 1939 | ;; Start accumulating output for the GUD buffer | 1918 | ;; Start accumulating output for the GUD buffer. |
| 1940 | (setq gdb-filter-output "") | 1919 | (setq gdb-filter-output "") |
| 1941 | (let (output-record-list) | 1920 | (let (output-record-list) |
| 1942 | 1921 | ||
| @@ -1982,9 +1961,8 @@ is running." | |||
| 1982 | (defun gdb-gdb (_output-field)) | 1961 | (defun gdb-gdb (_output-field)) |
| 1983 | 1962 | ||
| 1984 | (defun gdb-shell (output-field) | 1963 | (defun gdb-shell (output-field) |
| 1985 | (let ((gdb-output-sink gdb-output-sink)) | 1964 | (setq gdb-filter-output |
| 1986 | (setq gdb-filter-output | 1965 | (concat output-field gdb-filter-output))) |
| 1987 | (concat output-field gdb-filter-output)))) | ||
| 1988 | 1966 | ||
| 1989 | (defun gdb-ignored-notification (_output-field)) | 1967 | (defun gdb-ignored-notification (_output-field)) |
| 1990 | 1968 | ||
| @@ -2068,14 +2046,15 @@ current thread and update GDB buffers." | |||
| 2068 | (concat " --thread " thread-id))) | 2046 | (concat " --thread " thread-id))) |
| 2069 | 'gdb-register-names-handler)) | 2047 | 'gdb-register-names-handler)) |
| 2070 | 2048 | ||
| 2071 | ;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler | 2049 | ;; Don't set gud-last-frame here as it's currently done in |
| 2072 | ;;; because synchronous GDB doesn't give these fields with CLI. | 2050 | ;; gdb-frame-handler because synchronous GDB doesn't give these fields |
| 2073 | ;;; (when file | 2051 | ;; with CLI. |
| 2074 | ;;; (setq | 2052 | ;;(when file |
| 2075 | ;;; ;; Extract the frame position from the marker. | 2053 | ;; (setq |
| 2076 | ;;; gud-last-frame (cons file | 2054 | ;; ;; Extract the frame position from the marker. |
| 2077 | ;;; (string-to-number | 2055 | ;; gud-last-frame (cons file |
| 2078 | ;;; (match-string 6 gud-marker-acc))))) | 2056 | ;; (string-to-number |
| 2057 | ;; (match-string 6 gud-marker-acc))))) | ||
| 2079 | 2058 | ||
| 2080 | (setq gdb-inferior-status (or reason "unknown")) | 2059 | (setq gdb-inferior-status (or reason "unknown")) |
| 2081 | (gdb-force-mode-line-update | 2060 | (gdb-force-mode-line-update |
| @@ -2359,8 +2338,9 @@ calling `gdb-table-string'." | |||
| 2359 | (defun gdb-get-many-fields (struct &rest fields) | 2338 | (defun gdb-get-many-fields (struct &rest fields) |
| 2360 | "Return a list of FIELDS values from STRUCT." | 2339 | "Return a list of FIELDS values from STRUCT." |
| 2361 | (let ((values)) | 2340 | (let ((values)) |
| 2362 | (dolist (field fields values) | 2341 | (dolist (field fields) |
| 2363 | (setq values (append values (list (bindat-get-field struct field))))))) | 2342 | (push (bindat-get-field struct field) values)) |
| 2343 | (nreverse values))) | ||
| 2364 | 2344 | ||
| 2365 | (defmacro def-gdb-auto-update-trigger (trigger-name gdb-command | 2345 | (defmacro def-gdb-auto-update-trigger (trigger-name gdb-command |
| 2366 | handler-name | 2346 | handler-name |
| @@ -4134,31 +4114,19 @@ window is dedicated." | |||
| 4134 | nil win5)) | 4114 | nil win5)) |
| 4135 | (select-window win0))) | 4115 | (select-window win0))) |
| 4136 | 4116 | ||
| 4137 | (defcustom gdb-many-windows nil | 4117 | (define-minor-mode gdb-many-windows |
| 4138 | "If nil just pop up the GUD buffer unless `gdb-show-main' is t. | 4118 | "If nil just pop up the GUD buffer unless `gdb-show-main' is t. |
| 4139 | In this case it starts with two windows: one displaying the GUD | 4119 | In this case it starts with two windows: one displaying the GUD |
| 4140 | buffer and the other with the source file with the main routine | 4120 | buffer and the other with the source file with the main routine |
| 4141 | of the debugged program. Non-nil means display the layout shown for | 4121 | of the debugged program. Non-nil means display the layout shown for |
| 4142 | `gdb'." | 4122 | `gdb'." |
| 4143 | :type 'boolean | 4123 | :global t |
| 4144 | :group 'gdb | 4124 | :group 'gdb |
| 4145 | :version "22.1") | 4125 | :version "22.1" |
| 4146 | |||
| 4147 | (defun gdb-many-windows (arg) | ||
| 4148 | "Toggle the number of windows in the basic arrangement. | ||
| 4149 | With arg, display additional buffers iff arg is positive." | ||
| 4150 | (interactive "P") | ||
| 4151 | (setq gdb-many-windows | ||
| 4152 | (if (null arg) | ||
| 4153 | (not gdb-many-windows) | ||
| 4154 | (> (prefix-numeric-value arg) 0))) | ||
| 4155 | (message (format "Display of other windows %sabled" | ||
| 4156 | (if gdb-many-windows "en" "dis"))) | ||
| 4157 | (if (and gud-comint-buffer | 4126 | (if (and gud-comint-buffer |
| 4158 | (buffer-name gud-comint-buffer)) | 4127 | (buffer-name gud-comint-buffer)) |
| 4159 | (condition-case nil | 4128 | (ignore-errors |
| 4160 | (gdb-restore-windows) | 4129 | (gdb-restore-windows)))) |
| 4161 | (error nil)))) | ||
| 4162 | 4130 | ||
| 4163 | (defun gdb-restore-windows () | 4131 | (defun gdb-restore-windows () |
| 4164 | "Restore the basic arrangement of windows used by gdb. | 4132 | "Restore the basic arrangement of windows used by gdb. |