Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 402 lines (328 sloc) 10.595 kb
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
1 ;;; rudel-debug.el --- Debugging functions for Rudel
2 ;;
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
3 ;; Copyright (C) 2009, 2010 Jan Moringen
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
4 ;;
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
5 ;; Author: Jan Moringen <scymtym@users.sourceforge.net>
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
6 ;; Keywords: rudel, debugging
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
7 ;; X-RCS: $Id:$
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
8 ;;
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
9 ;; This file is part of Rudel.
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
10 ;;
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
11 ;; Rudel is free software: you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15 ;;
16 ;; Rudel is distributed in the hope that it will be useful, but
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
20 ;;
21 ;; You should have received a copy of the GNU General Public License
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
22 ;; along with rudel. If not, see <http://www.gnu.org/licenses>.
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
23
24
25 ;;; Commentary:
26 ;;
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
27 ;; This file contains debugging functions for Rudel. The most
28 ;; important aspects are functions to data-debug central Rudel objects
29 ;; and tracing support for basic Rudel objects.
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
30
31
32 ;;; History:
33 ;;
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
34 ;; 0.2 - New tracing framework
35 ;;
36 ;; 0.1 - Initial version
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
37
38
39 ;;; Code:
40 ;;
41
f765378 @scymtym * rudel-debug.el (require eieio): silence byte-compiler
scymtym authored
42 (require 'eieio)
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
43 (require 'data-debug)
44 (require 'eieio-datadebug)
45
46 (require 'rudel-util)
2db34da * rudel-debug.el (require rudel-state-machine): required since state
Jan Moringen authored
47 (require 'rudel-state-machine)
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
48 (require 'rudel-transport-util)
49 (require 'rudel-socket)
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
50
51
52 ;;; Customization
53 ;;
54
55 (defgroup rudel-debug nil
56 "Customization options related to Rudel's debugging functions."
57 :group 'rudel)
58
59 (defface rudel-debug-sent-data-face
60 '((default (:background "orange")))
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
61 "Face used for sent data."
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
62 :group 'rudel-debug)
63
64 (defface rudel-debug-received-data-face
65 '((default (:background "light sky blue")))
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
66 "Face used for received (but not yet processed) data."
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
67 :group 'rudel-debug)
68
69 (defface rudel-debug-state-face
70 '((default (:background "light gray")))
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
71 "Face used when indicating state changes."
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
72 :group 'rudel-debug)
73
74 (defface rudel-debug-special-face
75 '((default (:background "light sea green")))
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
76 "Face used for additional information."
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
77 :group 'rudel-debug)
78
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
79 (defvar rudel-debug-tag-faces
80 '((:sent . (rudel-debug-sent-data-face "< "))
81 (:received . (rudel-debug-received-data-face "> "))
82 (:state . (rudel-debug-state-face "| "))
83 (:special . (rudel-debug-special-face "; ")))
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
84 "Associate tag to faces and prefixes.")
85
86
87 ;;; Data debug functions
88 ;;
89
9fb197f @scymtym Added rudel-adebug-discover to rudel-debug.el
scymtym authored
90 (defun rudel-adebug-discover ()
91 "Analyze list of discoverable sessions in data debug buffer."
92 (interactive)
93
94 (with-current-buffer (data-debug-new-buffer "RUDEL-DISCOVERED-SESSIONS")
95 (data-debug-insert-stuff-list (rudel-session-initiation-discover) "# ")))
96
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
97 (defun rudel-adebug-session ()
98 "Analyze current session in data debug buffer."
99 (interactive)
100
101 ;; Make sure we have a session.
102 (unless rudel-current-session
103 (error "No active Rudel session"))
104
105 (with-current-buffer (data-debug-new-buffer "RUDEL-SESSION")
106 (data-debug-insert-thing rudel-current-session "# " "")))
107
108 (defun rudel-adebug-server (server)
109 "Analyze server in data debug buffer."
110 (interactive)
111
112 (with-current-buffer (data-debug-new-buffer "RUDEL-SERVER")
113 (data-debug-insert-thing server "# " "")))
114
115
116 ;;; Advice stuff
117 ;;
118
119 (defadvice rudel-join-session (after rudel-debug last activate)
120 "Run data-debug inspection on newly created session objects."
121 (require 'rudel-debug)
122 (rudel-adebug-session))
123
124 (defadvice rudel-host-session (after rudel-debug last activate)
125 "Run data-debug inspection on newly created server objects."
126 (require 'rudel-debug)
127 (rudel-adebug-server ad-return-value))
128
129
130 ;;; Network functions
131 ;;
132
133 (defun rudel-suspend-session-socket ()
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
134 "Suspend the socket associated to the current session."
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
135 (interactive)
136
137 ;; Make sure we have a session.
138 (unless rudel-current-session
139 (error "No active Rudel session"))
140
141 (with-slots (connection) rudel-current-session
142 (with-slots (socket) connection
143 (stop-process socket))))
144
145 (defun rudel-resume-session-socket ()
b092ee3 * rudel-debug.el (header): fixed meta-data and license
jan authored
146 "Resume the socket associated to the current session."
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
147 (interactive)
148
149 ;; Make sure we have a session.
150 (unless rudel-current-session
151 (error "No active Rudel session"))
152
153 (with-slots (connection) rudel-current-session
154 (with-slots (socket) connection
155 (continue-process socket))))
156
157
158 ;;; Reset functions
159 ;;
160
161 (defun rudel-kill-processes ()
162 "TODO"
163 (interactive)
164 (mapc #'delete-process (process-list)))
165
166 (defun rudel-reset ()
167 "TODO"
168 (interactive)
169 (dolist (buffer (buffer-list))
170 (with-current-buffer buffer
171 (when rudel-buffer-document
172 (setq rudel-buffer-document nil))))
173 (rudel-kill-processes)
174 (setq rudel-current-session nil))
175
176
177 ;;; Utility functions
178 ;;
179
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
180 (defgeneric rudel-debug-target (object)
181 "Return debug stream name for OBJECT.")
182
183 (defmethod rudel-debug-target ((this eieio-default-superclass))
184 "Default implementation simply uses the object name of THIS."
185 (object-name-string this))
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
186
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
187 (defun rudel-debug-write-to-stream (stream tag label data
188 &optional object)
189 "Insert DATA and maybe OBJECT into stream using TAG, LABEL as style."
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
190 (let* ((buffer-name (format "*%s stream*" stream))
191 (buffer (or (get-buffer buffer-name)
192 (data-debug-new-buffer buffer-name)))
f765378 @scymtym * rudel-debug.el (require eieio): silence byte-compiler
scymtym authored
193 (appearance (cdr (assoc tag rudel-debug-tag-faces)))
194 (face (when appearance
195 (or (nth 0 appearance)
196 'default)))
197 (prefix (or (nth 1 appearance)
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
198 ""))
199 (string (cond
200 ((stringp data)
201 data)
202 ((object-p data)
b9c90ac @scymtym Handle all object types when writing to debug streams
scymtym authored
203 (object-print data))
204 (t
205 (prin1-to-string data)))))
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
206 (save-excursion
207 (set-buffer buffer)
208 (goto-char 0)
209 (insert prefix
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
210 (if label
211 (format
212 "%-8s"
213 (propertize label 'face 'font-lock-type-face))
214 " ")
215 " "
216 (propertize string 'face face)
217 (if (and (>= (length string) 1)
218 (string= (substring string -1) "\n"))
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
219 "" "\n"))
220 (when object
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
221 (data-debug-insert-thing
222 object
223 (concat prefix
224 (propertize "OBJECT " 'face 'font-lock-type-face))
225 ""))))
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
226 )
227
6d9c9ca @scymtym Integrated new debugging framework
scymtym authored
228 (defun rudel-debug-write (source tag label data &optional object)
229 "Write DATA and OBJECT to debug stream associated to SOURCE.
230 TAG and LABEL determine the logging style."
231 (rudel-debug-write-to-stream
232 (rudel-debug-target source) tag label data object))
233
234
235 ;;; State machine debugging
236 ;;
237
238 (defvar rudel-debug-old-state nil
239 "Saves state of state machines across one function call.")
240
241 (defmethod rudel-switch :before
242 ((this rudel-state-machine) state &rest arguments)
243 "Store name of STATE for later printing."
244 (with-slots (state) this
245 (setq rudel-debug-old-state
246 (if state (object-name-string state) "#start")))
247 )
248
249 (defmethod rudel-switch :after
250 ((this rudel-state-machine) state &rest arguments)
251 "Log STATE and ARGUMENTS to debug stream."
252 (with-slots (state) this
253 (let ((old-state rudel-debug-old-state)
254 (new-state (object-name-string state)))
255 (unless (string= old-state new-state)
256 (rudel-debug-write
257 this
258 :special
259 "FSM"
260 (if arguments
261 (format "%s -> %s %s" old-state new-state arguments)
262 (format "%s -> %s" old-state new-state))))))
263 )
264
265
266 ;;; Debugging functions for `rudel-transport-filter'
267 ;;
268
269 (defmethod rudel-debug-target ((this rudel-transport-filter))
270 "Find target of filter THIS by looking at underlying transport."
271 (with-slots (transport) this
272 (rudel-debug-target transport)))
273
274
275 ;;; Debugging functions for `rudel-assembling-transport-filter'
276 ;;
277
278 (defmethod rudel-set-assembly-function :before
279 ((this rudel-assembling-transport-filter) function)
280 "Log change of assembly function to FUNCTION."
281 (with-slots (socket assembly-function) this
282 (rudel-debug-write
283 this
284 :special
285 "ASSEMBLE"
286 (format "%s -> %s"
287 (symbol-name assembly-function)
288 (symbol-name function))))
289 )
290
291 (defmethod rudel-set-filter ((this rudel-assembling-transport-filter)
292 filter1)
293 "Log DATA as it goes through THIS."
294 (with-slots (filter) this
295 (lexical-let ((this1 this)
296 (filter2 filter1))
297 (setq filter (lambda (data)
298 (rudel-debug-write
299 this1
300 :received
301 "ASSEMBLE"
302 data)
303 (funcall filter2 data)))))
304 )
305
306 (defmethod rudel-send :before
307 ((this rudel-assembling-transport-filter) data)
308 "Log DATA as it goes through THIS."
309 (rudel-debug-write this :sent "RAW" data nil))
310
311
312 ;;; Debugging function `rudel-parsing-transport-filter'
313 ;;
314
315 (defmethod rudel-set-parse-function :before
316 ((this rudel-parsing-transport-filter) function)
317 "Log parse function change to FUNCTION."
318 (with-slots (parse-function) this
319 (rudel-debug-write
320 this
321 :special
322 "PARSE"
323 (format "%s -> %s"
324 (symbol-name parse-function)
325 (symbol-name function))))
326 )
327
328 (defmethod rudel-set-generate-function :before
329 ((this rudel-parsing-transport-filter) function)
330 "Log generate function change to FUNCTION."
331 (with-slots (generate-function) this
332 (rudel-debug-write
333 this
334 :special
335 "GENERATE"
336 (format "%s -> %s"
337 (symbol-name generate-function)
338 (symbol-name function))))
339 )
340
341 (defmethod rudel-set-filter ((this rudel-parsing-transport-filter)
342 filter1)
343 "Log DATA as it goes through THIS."
344 (with-slots (filter) this
345 (lexical-let ((this1 this)
346 (filter2 filter1))
347 (setq filter (lambda (data)
348 (rudel-debug-write
349 this1
350 :received
351 "PARSE"
352 (format "%s" data) data)
353 (funcall filter2 data)))))
354 )
355
356 (defmethod rudel-send :before
357 ((this rudel-parsing-transport-filter) string-or-data)
358 "Log STRING-OR-DATA as it goes through THIS."
359 (let ((formatted (cond
360 ((stringp string-or-data)
361 string-or-data)
362
363 ((object-p string-or-data)
364 (object-print string-or-data))
365
366 (t
367 (format "%s" string-or-data)))))
368 (rudel-debug-write
369 this
370 :sent
371 "GENERATE"
372 formatted (unless (stringp string-or-data)
373 string-or-data)))
374 )
375
376
377 ;;; Socket transport debugging
378 ;;
379
380 (defmethod rudel-set-filter ((this rudel-socket-transport)
381 filter)
382 "Log DATA as it goes through THIS."
383 (lexical-let ((this1 this)
384 (filter1 filter))
385 (oset
386 this :filter
387 (lambda (data)
388 (rudel-debug-write this1 :received "SOCKET" data)
389 (funcall filter1 data))))
390 )
391
392 (defmethod rudel-send :before ((this rudel-socket-transport)
393 data)
394 "Log DATA verbatim as it is sent through the socket of THIS."
395 (rudel-debug-write this :sent "SOCKET" data nil))
396
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
397 (provide 'rudel-debug)
259bfca @scymtym * rudel-debug.el (local variables): prevent byte-compilation
scymtym authored
398 ;; Local Variables:
399 ;; no-byte-compile: t
400 ;; End:
cb8f45f * obby/rudel-obby-debug.el (whole file): new file; debugging functions
jan authored
401 ;;; rudel-debug.el ends here
Something went wrong with that request. Please try again.