]> crepu.dev Git - config.git/blame - djavu-asus/elpa/jabber-20230715.456/jabber-console.el
Configuracion en desarrollo PC pega
[config.git] / djavu-asus / elpa / jabber-20230715.456 / jabber-console.el
CommitLineData
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.
32Set 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.
45Not 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'.
57Note that functions in this hook have no way of knowing
58what 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