1;; jabber-console.el - XML Console mode 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-console-name-format "*-jabber-console-%s-*" 31 "Format for console buffer name. %s mean connection jid." 32 :type 'string 33 :group 'jabber-debug) 34 35(defcustom jabber-console-truncate-lines 3000 36 "Maximum number of lines in console buffer. 37Not truncate if set to 0" 38 :type 'integer 39 :group 'jabber-debug) 40 41(defvar jabber-point-insert nil 42 "Position where the message being composed starts") 43 44(defvar jabber-send-function nil 45 "Function for sending a message from a chat buffer.") 46 47(defvar jabber-console-mode-hook nil 48 "Hook called at the end of `jabber-console-mode'. 49Note that functions in this hook have no way of knowing 50what kind of chat buffer is being created.") 51 52(defvar jabber-console-ewoc nil 53 "The ewoc showing the XML elements of this stream buffer.") 54 55(defvar jabber-console-mode-map 56 (let ((map (make-sparse-keymap))) 57 (set-keymap-parent map jabber-common-keymap) 58 (define-key map "\r" 'jabber-chat-buffer-send) 59 map)) 60 61(defun jabber-console-create-buffer (jc) 62 (with-current-buffer 63 (get-buffer-create (format jabber-console-name-format (jabber-connection-bare-jid jc))) 64 (unless (eq major-mode 'jabber-console-mode) 65 (jabber-console-mode)) 66 ;; Make sure the connection variable is up to date. 67 (setq jabber-buffer-connection jc) 68 (current-buffer))) 69 70(defun jabber-console-send (jc data) 71 ;; Put manual string into buffers ewoc 72 (jabber-process-console jc "raw" data) 73 ;; ...than sent it to server 74 (jabber-send-string jc data)) 75 76(defun jabber-console-comment (str) 77 "Insert comment into console buffer." 78 (let ((string (concat 79 comment-start str "@" (jabber-encode-time (current-time)) ":" 80 comment-end "\n"))) 81 (when (stringp jabber-debug-log-xml) 82 (jabber-append-string-to-file string jabber-debug-log-xml)) 83 (insert string))) 84 85(defun jabber-console-pp (data) 86 "Pretty Printer for XML-sexp and raw data" 87 (let ((direction (car data)) 88 (xml-list (cdr data)) 89 (raw (cadr data))) 90 (jabber-console-comment direction) 91 (if (stringp raw) 92 ;; raw code input 93 (progn 94 (insert raw) 95 (when (stringp jabber-debug-log-xml) 96 (jabber-append-string-to-file raw jabber-debug-log-xml))) 97 ;; receive/sending 98 (progn 99 (xml-print xml-list) 100 (when (stringp jabber-debug-log-xml) 101 (jabber-append-string-to-file 102 "\n" jabber-debug-log-xml 'xml-print xml-list)))))) 103 104(define-derived-mode jabber-console-mode sgml-mode "Jabber Console" 105 "Major mode for debug XMPP protocol" 106 ;; Make sure to set this variable somewhere 107 (make-local-variable 'jabber-send-function) 108 (make-local-variable 'jabber-point-insert) 109 (make-local-variable 'jabber-console-ewoc) 110 111 (setq jabber-send-function 'jabber-console-send) 112 113 (unless jabber-console-ewoc 114 (setq jabber-console-ewoc 115 (ewoc-create #'jabber-console-pp nil "<!-- + -->")) 116 (goto-char (point-max)) 117 (put-text-property (point-min) (point) 'read-only t) 118 (let ((inhibit-read-only t)) 119 (put-text-property (point-min) (point) 'front-sticky t) 120 (put-text-property (point-min) (point) 'rear-nonsticky t)) 121 (setq jabber-point-insert (point-marker)))) 122 123(put 'jabber-console-mode 'mode-class 'special) 124 125(defun jabber-console-sanitize (xml-data) 126 "Sanitize XML-DATA for jabber-process-console" 127 (if (listp xml-data) 128 (jabber-tree-map (lambda (x) (if (numberp x) (format "%s" x) x)) xml-data) 129 xml-data)) 130 131;;;###autoload 132(defun jabber-process-console (jc direction xml-data) 133 "Log XML-DATA i/o as XML in \"*-jabber-console-JID-*\" buffer" 134 (let ((buffer (get-buffer-create (jabber-console-create-buffer jc)))) 135 (with-current-buffer buffer 136 (progn 137 (ewoc-enter-last jabber-console-ewoc (list direction (jabber-console-sanitize xml-data))) 138 (when (< 1 jabber-console-truncate-lines) 139 (let ((jabber-log-lines-to-keep jabber-console-truncate-lines)) 140 (jabber-truncate-top buffer jabber-console-ewoc))))))) 141 142(provide 'jabber-console) 143;;; jabber-console.el ends here 144