djavu-asus/emacs/elpa/jabber-20230715.456/jabber-console.el

   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