aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-05-25 10:47:57 -0400
committerStefan Monnier2012-05-25 10:47:57 -0400
commite7e85dc0a0781fdaf1cc83d7f476046a49852022 (patch)
treefcf1a306b2ca111e7301bf8dc49e3c79b7972b35
parentb51d2e5a656eab4019916cce3a142c6e4d56ec88 (diff)
downloademacs-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/ChangeLog10
-rw-r--r--lisp/progmodes/gdb-mi.el172
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 @@
12012-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
12012-05-25 Eli Zaretskii <eliz@gnu.org> 112012-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 464The log is stored in `gdb-debug-log' as an alist with elements
465whose cons is send, send-item or recv and whose cdr is the string
466being transferred. This list may grow up to a size of
467`gdb-debug-log-max' after which the oldest element (at the end of
468the 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.
517The log is stored in `gdb-debug-log' as an alist with elements
518whose cons is send, send-item or recv and whose cdr is the string
519being transferred. This list may grow up to a size of
520`gdb-debug-log-max' after which the oldest element (at the end of
521the 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." 1045With prefix argument ARG, automatically raise speedbar if ARG is
1056 :type 'boolean 1046positive, 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.
1068With prefix argument ARG, automatically raise speedbar if ARG is
1069positive, 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.
4139In this case it starts with two windows: one displaying the GUD 4119In this case it starts with two windows: one displaying the GUD
4140buffer and the other with the source file with the main routine 4120buffer and the other with the source file with the main routine
4141of the debugged program. Non-nil means display the layout shown for 4121of 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.
4149With 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.