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