blob: 7b2b4e3f7cb0bdef5641a19d7678f0f8e8a3aeb5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
;; jabber-console.el - XML Console mode
;; Copyright (C) 2009, 2010 - Demyan Rogozhin <demyan.rogozhin@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; Commentary:
;; Use *-jabber-console-* for sending custom XMPP code. Be careful!
;;; Code:
(require 'jabber-keymap)
(require 'jabber-util)
(require 'ewoc)
(require 'sgml-mode) ;we base on this mode to hightlight XML
(defcustom jabber-console-name-format "*-jabber-console-%s-*"
"Format for console buffer name. %s mean connection jid."
:type 'string
:group 'jabber-debug)
(defcustom jabber-console-truncate-lines 3000
"Maximum number of lines in console buffer.
Not truncate if set to 0"
:type 'integer
:group 'jabber-debug)
(defvar jabber-point-insert nil
"Position where the message being composed starts")
(defvar jabber-send-function nil
"Function for sending a message from a chat buffer.")
(defvar jabber-console-mode-hook nil
"Hook called at the end of `jabber-console-mode'.
Note that functions in this hook have no way of knowing
what kind of chat buffer is being created.")
(defvar jabber-console-ewoc nil
"The ewoc showing the XML elements of this stream buffer.")
(defvar jabber-console-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map jabber-common-keymap)
(define-key map "\r" 'jabber-chat-buffer-send)
map))
(defun jabber-console-create-buffer (jc)
(with-current-buffer
(get-buffer-create (format jabber-console-name-format (jabber-connection-bare-jid jc)))
(unless (eq major-mode 'jabber-console-mode)
(jabber-console-mode))
;; Make sure the connection variable is up to date.
(setq jabber-buffer-connection jc)
(current-buffer)))
(defun jabber-console-send (jc data)
;; Put manual string into buffers ewoc
(jabber-process-console jc "raw" data)
;; ...than sent it to server
(jabber-send-string jc data))
(defun jabber-console-comment (str)
"Insert comment into console buffer."
(let ((string (concat
comment-start str "@" (jabber-encode-time (current-time)) ":"
comment-end "\n")))
(when (stringp jabber-debug-log-xml)
(jabber-append-string-to-file string jabber-debug-log-xml))
(insert string)))
(defun jabber-console-pp (data)
"Pretty Printer for XML-sexp and raw data"
(let ((direction (car data))
(xml-list (cdr data))
(raw (cadr data)))
(jabber-console-comment direction)
(if (stringp raw)
;; raw code input
(progn
(insert raw)
(when (stringp jabber-debug-log-xml)
(jabber-append-string-to-file raw jabber-debug-log-xml)))
;; receive/sending
(progn
(xml-print xml-list)
(when (stringp jabber-debug-log-xml)
(jabber-append-string-to-file
"\n" jabber-debug-log-xml 'xml-print xml-list))))))
(define-derived-mode jabber-console-mode sgml-mode "Jabber Console"
"Major mode for debug XMPP protocol"
;; Make sure to set this variable somewhere
(make-local-variable 'jabber-send-function)
(make-local-variable 'jabber-point-insert)
(make-local-variable 'jabber-console-ewoc)
(setq jabber-send-function 'jabber-console-send)
(unless jabber-console-ewoc
(setq jabber-console-ewoc
(ewoc-create #'jabber-console-pp nil "<!-- + -->"))
(goto-char (point-max))
(put-text-property (point-min) (point) 'read-only t)
(let ((inhibit-read-only t))
(put-text-property (point-min) (point) 'front-sticky t)
(put-text-property (point-min) (point) 'rear-nonsticky t))
(setq jabber-point-insert (point-marker))))
(put 'jabber-console-mode 'mode-class 'special)
(defun jabber-console-sanitize (xml-data)
"Sanitize XML-DATA for jabber-process-console"
(if (listp xml-data)
(jabber-tree-map (lambda (x) (if (numberp x) (format "%s" x) x)) xml-data)
xml-data))
;;;###autoload
(defun jabber-process-console (jc direction xml-data)
"Log XML-DATA i/o as XML in \"*-jabber-console-JID-*\" buffer"
(let ((buffer (get-buffer-create (jabber-console-create-buffer jc))))
(with-current-buffer buffer
(progn
(ewoc-enter-last jabber-console-ewoc (list direction (jabber-console-sanitize xml-data)))
(when (< 1 jabber-console-truncate-lines)
(let ((jabber-log-lines-to-keep jabber-console-truncate-lines))
(jabber-truncate-top buffer jabber-console-ewoc)))))))
(provide 'jabber-console)
;;; jabber-console.el ends here
|
