jabber-chat.el

   1 ;; jabber-chat.el - one-to-one chats
   2
   3 ;; Copyright (C) 2005, 2007, 2008 - Magnus Henoch - mange@freemail.hu
   4
   5 ;; This file is a part of jabber.el.
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program; if not, write to the Free Software
  19 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20
  21 (require 'jabber-core)
  22 (require 'jabber-chatbuffer)
  23 (require 'jabber-history)
  24 (require 'jabber-autoloads)
  25
  26 (require 'ewoc)
  27 (eval-when-compile (require 'cl))
  28
  29 (defgroup jabber-chat nil "chat display options"
  30   :group 'jabber)
  31
  32 (defcustom jabber-chat-buffer-format "*-jabber-chat-%n-*"
  33   "The format specification for the name of chat buffers.
  34
  35 These fields are available (all are about the person you are chatting
  36 with):
  37
  38 %n   Nickname, or JID if no nickname set
  39 %j   Bare JID (without resource)
  40 %r   Resource"
  41   :type 'string
  42   :group 'jabber-chat)
  43
  44 (defcustom jabber-chat-header-line-format
  45   '("" (jabber-chat-buffer-show-avatar
  46         (:eval
  47          (let ((buddy (jabber-jid-symbol jabber-chatting-with)))
  48            (jabber-propertize " "
  49                               'display (get buddy 'avatar)))))
  50     (:eval (jabber-jid-displayname jabber-chatting-with))
  51     "\t" (:eval (let ((buddy (jabber-jid-symbol jabber-chatting-with)))
  52                   (propertize
  53                    (or
  54                     (cdr (assoc (get buddy 'show) jabber-presence-strings))
  55                     (get buddy 'show))
  56                    'face
  57                    (or (cdr (assoc (get buddy 'show) jabber-presence-faces))
  58                        'jabber-roster-user-online))))
  59     "\t" (:eval (jabber-fix-status (get (jabber-jid-symbol jabber-chatting-with) 'status)))
  60     "\t" jabber-events-message          ;see jabber-events.el
  61     "\t" jabber-chatstates-message)             ;see jabber-chatstates.el
  62   "The specification for the header line of chat buffers.
  63
  64 The format is that of `mode-line-format' and `header-line-format'."
  65   :type 'sexp
  66   :group 'jabber-chat)
  67
  68 (defcustom jabber-chat-buffer-show-avatar t
  69   "Show avatars in header line of chat buffer?
  70 This variable might not take effect if you have changed
  71 `jabber-chat-header-line-format'."
  72   :type 'boolean
  73   :group 'jabber-chat)
  74
  75 (defcustom jabber-chat-time-format "%H:%M"
  76   "The format specification for instant messages in the chat buffer.
  77 See also `jabber-chat-delayed-time-format'.
  78
  79 See `format-time-string' for valid values."
  80   :type 'string
  81   :group 'jabber-chat)
  82
  83 (defcustom jabber-chat-delayed-time-format "%Y-%m-%d %H:%M"
  84   "The format specification for delayed messages in the chat buffer.
  85 See also `jabber-chat-time-format'.
  86
  87 See `format-time-string' for valid values."
  88   :type 'string
  89   :group 'jabber-chat)
  90
  91 (defcustom jabber-print-rare-time t
  92   "Non-nil means to print \"rare time\" indications in chat buffers.
  93 The default settings tell every new hour."
  94   :type 'boolean
  95   :group 'jabber-chat)
  96
  97 (defcustom jabber-rare-time-format "%a %e %b %Y %H:00"
  98   "The format specification for the rare time information.
  99 Rare time information will be printed whenever the current time,
 100 formatted according to this string, is different to the last
 101 rare time printed."
 102   :type 'string
 103   :group 'jabber-chat)
 104
 105 (defface jabber-rare-time-face
 106   '((t (:foreground "darkgreen" :underline t)))
 107   "face for displaying the rare time info"
 108   :group 'jabber-chat)
 109
 110 (defcustom jabber-chat-local-prompt-format "[%t] %n> "
 111   "The format specification for lines you type in the chat buffer.
 112
 113 These fields are available:
 114
 115 %t   Time, formatted according to `jabber-chat-time-format'
 116      or `jabber-chat-delayed-time-format'
 117 %u   Username
 118 %n   Nickname (obsolete, same as username)
 119 %r   Resource
 120 %j   Bare JID (without resource)"
 121   :type 'string
 122   :group 'jabber-chat)
 123
 124 (defcustom jabber-chat-foreign-prompt-format "[%t] %n> "
 125   "The format specification for lines others type in the chat buffer.
 126
 127 These fields are available:
 128
 129 %t   Time, formatted according to `jabber-chat-time-format'
 130      or `jabber-chat-delayed-time-format'
 131 %n   Nickname, or JID if no nickname set
 132 %u   Username
 133 %r   Resource
 134 %j   Bare JID (without resource)"
 135   :type 'string
 136   :group 'jabber-chat)
 137
 138 (defcustom jabber-chat-system-prompt-format "[%t] *** "
 139   "The format specification for lines from the system or that are special in the chat buffer."
 140   :type 'string
 141   :group 'jabber-chat)
 142
 143 (defface jabber-chat-prompt-local
 144   '((t (:foreground "blue" :weight bold)))
 145   "face for displaying the chat prompt for what you type in"
 146   :group 'jabber-chat)
 147
 148 (defface jabber-chat-prompt-foreign
 149   '((t (:foreground "red" :weight bold)))
 150   "face for displaying the chat prompt for what they send"
 151   :group 'jabber-chat)
 152
 153 (defface jabber-chat-prompt-system
 154   '((t (:foreground "green" :weight bold)))
 155   "face used for system and special messages"
 156   :group 'jabber-chat)
 157
 158 (defface jabber-chat-text-local '((t ()))
 159   "Face used for text you write"
 160   :group 'jabber-chat)
 161
 162 (defface jabber-chat-text-foreign '((t ()))
 163   "Face used for text others write"
 164   :group 'jabber-chat)
 165
 166 (defface jabber-chat-error
 167   '((t (:foreground "red" :weight bold)))
 168   "Face used for error messages"
 169   :group 'jabber-chat)
 170
 171 ;;;###autoload
 172 (defvar jabber-chatting-with nil
 173   "JID of the person you are chatting with")
 174
 175 (defvar jabber-chat-printers '(jabber-chat-print-subject
 176                                jabber-chat-print-body
 177                                jabber-chat-print-url
 178                                jabber-chat-goto-address)
 179   "List of functions that may be able to print part of a message.
 180 Each function receives these arguments:
 181
 182 XML-DATA   The entire message stanza
 183 WHO        :local or :foreign, for sent or received stanza, respectively
 184 MODE       :insert or :printp.  For :insert, insert text at point.
 185            For :printp, return non-nil if function would insert text.")
 186
 187 (defvar jabber-body-printers '(jabber-chat-normal-body)
 188   "List of functions that may be able to print a body for a message.
 189 Each function receives these arguments:
 190
 191 XML-DATA   The entire message stanza
 192 WHO        :local, :foreign or :error
 193 MODE       :insert or :printp.  For :insert, insert text at point.
 194            For :printp, return non-nil if function would insert text.
 195
 196 These functions are called in order, until one of them returns
 197 non-nil.
 198
 199 Add a function to the beginning of this list if the tag it handles
 200 replaces the contents of the <body/> tag.")
 201
 202 (defvar jabber-chat-send-hooks nil
 203   "List of functions called when a chat message is sent.
 204 The arguments are the text to send, and the id attribute of the
 205 message.
 206
 207 The functions should return a list of XML nodes they want to be
 208 added to the outgoing message.")
 209
 210 (defvar jabber-chat-earliest-backlog nil
 211   "Float-time of earliest backlog entry inserted into buffer.
 212 nil if no backlog has been inserted.")
 213
 214 ;;;###autoload
 215 (defun jabber-chat-get-buffer (chat-with)
 216   "Return the chat buffer for chatting with CHAT-WITH (bare or full JID).
 217 Either a string or a buffer is returned, so use `get-buffer' or
 218 `get-buffer-create'."
 219   (format-spec jabber-chat-buffer-format
 220                (list
 221                 (cons ?n (jabber-jid-displayname chat-with))
 222                 (cons ?j (jabber-jid-user chat-with))
 223                 (cons ?r (or (jabber-jid-resource chat-with) "")))))
 224
 225 (defun jabber-chat-create-buffer (jc chat-with)
 226   "Prepare a buffer for chatting with CHAT-WITH.
 227 This function is idempotent."
 228   (with-current-buffer (get-buffer-create (jabber-chat-get-buffer chat-with))
 229     (unless (eq major-mode 'jabber-chat-mode)
 230       (jabber-chat-mode jc #'jabber-chat-pp))
 231     ;; Make sure the connection variable is up to date.
 232     (setq jabber-buffer-connection jc)
 233
 234     (make-local-variable 'jabber-chatting-with)
 235     (setq jabber-chatting-with chat-with)
 236     (setq jabber-send-function 'jabber-chat-send)
 237     (setq header-line-format jabber-chat-header-line-format)
 238
 239     (make-local-variable 'jabber-chat-earliest-backlog)
 240
 241     ;; insert backlog
 242     (when (null jabber-chat-earliest-backlog)
 243       (let ((backlog-entries (jabber-history-backlog chat-with)))
 244         (if (null backlog-entries)
 245             (setq jabber-chat-earliest-backlog (jabber-float-time))
 246           (setq jabber-chat-earliest-backlog
 247                 (jabber-float-time (jabber-parse-time
 248                                     (aref (car backlog-entries) 0))))
 249           (mapc 'jabber-chat-insert-backlog-entry (nreverse backlog-entries)))))
 250
 251     (current-buffer)))
 252
 253 (defun jabber-chat-insert-backlog-entry (msg)
 254   "Insert backlog entry MSG at beginning of buffer."
 255   ;; Rare timestamps are especially important in backlog.  We risk
 256   ;; having superfluous timestamps if we just add before each backlog
 257   ;; entry.
 258   (let* ((message-time (jabber-parse-time (aref msg 0)))
 259          (fake-stanza `(message ((from . ,(aref msg 2)))
 260                                 (body nil ,(aref msg 4))
 261                                 (x ((xmlns . "jabber:x:delay")
 262                                     (stamp . ,(jabber-encode-legacy-time message-time))))))
 263          (node-data (list (if (string= (aref msg 1) "in") :foreign :local)
 264                           fake-stanza :delayed t)))
 265
 266     ;; Insert after existing rare timestamp?
 267     (if (and jabber-print-rare-time
 268              (ewoc-nth jabber-chat-ewoc 0)
 269              (eq (car (ewoc-data (ewoc-nth jabber-chat-ewoc 0))) :rare-time)
 270              (not (jabber-rare-time-needed message-time (cadr (ewoc-data (ewoc-nth jabber-chat-ewoc 0))))))
 271         (ewoc-enter-after jabber-chat-ewoc (ewoc-nth jabber-chat-ewoc 0) node-data)
 272       ;; Insert first.
 273       (ewoc-enter-first jabber-chat-ewoc node-data)
 274       (when jabber-print-rare-time
 275         (ewoc-enter-first jabber-chat-ewoc (list :rare-time message-time))))))
 276
 277 (add-to-list 'jabber-jid-chat-menu
 278              (cons "Display more context" 'jabber-chat-display-more-backlog))
 279
 280 (defun jabber-chat-display-more-backlog (how-many)
 281   (interactive "nHow many more messages? ")
 282   (let* ((inhibit-read-only t)
 283          (jabber-backlog-days nil)
 284          (jabber-backlog-number how-many)
 285          (backlog-entries (jabber-history-backlog
 286                            jabber-chatting-with jabber-chat-earliest-backlog)))
 287     (when backlog-entries
 288       (setq jabber-chat-earliest-backlog
 289             (jabber-float-time (jabber-parse-time
 290                                 (aref (car backlog-entries) 0))))
 291       (save-excursion
 292         (goto-char (point-min))
 293         (mapc 'jabber-chat-insert-backlog-entry (nreverse backlog-entries))))))
 294
 295 (add-to-list 'jabber-message-chain 'jabber-process-chat)
 296
 297 (defun jabber-process-chat (jc xml-data)
 298   "If XML-DATA is a one-to-one chat message, handle it as such."
 299   ;; XXX: there's more to being a chat message than not being MUC.
 300   ;; Maybe make independent predicate.
 301   (when (not (jabber-muc-message-p xml-data))
 302     ;; Note that we handle private MUC messages here.
 303     (let ((from (jabber-xml-get-attribute xml-data 'from))
 304           (error-p (jabber-xml-get-children xml-data 'error))
 305           (body-text (car (jabber-xml-node-children
 306                            (car (jabber-xml-get-children
 307                                  xml-data 'body))))))
 308       (with-current-buffer (if (jabber-muc-sender-p from)
 309                                (jabber-muc-private-create-buffer
 310                                 jc
 311                                 (jabber-jid-user from)
 312                                 (jabber-jid-resource from))
 313                              (jabber-chat-create-buffer jc from))
 314         ;; Call alert hooks only when something is output
 315         (when (or error-p
 316                   (run-hook-with-args-until-success 'jabber-chat-printers xml-data :foreign :printp))
 317           (let ((node
 318                  (ewoc-enter-last jabber-chat-ewoc (list (if error-p :error :foreign) xml-data :time (current-time)))))
 319             (jabber-maybe-print-rare-time node))
 320
 321           (dolist (hook '(jabber-message-hooks jabber-alert-message-hooks))
 322             (run-hook-with-args hook
 323                                 from (current-buffer) body-text
 324                                 (funcall jabber-alert-message-function
 325                                          from (current-buffer) body-text))))))))
 326
 327 (defun jabber-chat-send (jc body)
 328   "Send BODY through connection JC, and display it in chat buffer."
 329   ;; Build the stanza...
 330   (let* ((id (apply 'format "emacs-msg-%d.%d.%d" (current-time)))
 331          (stanza-to-send `(message
 332                            ((to . ,jabber-chatting-with)
 333                             (type . "chat")
 334                             (id . ,id))
 335                            (body () ,body))))
 336     ;; ...add additional elements...
 337     (dolist (hook jabber-chat-send-hooks)
 338       (nconc stanza-to-send (funcall hook body id)))
 339     ;; ...display it, if it would be displayed.
 340     (when (run-hook-with-args-until-success 'jabber-chat-printers stanza-to-send :local :printp)
 341       (jabber-maybe-print-rare-time
 342        (ewoc-enter-last jabber-chat-ewoc (list :local stanza-to-send :time (current-time)))))
 343     ;; ...and send it...
 344     (jabber-send-sexp jc stanza-to-send)))
 345
 346 (defun jabber-chat-pp (data)
 347   "Pretty-print a <message/> stanza.
 348 \(car data) is either :local, :foreign, :error or :notice.
 349 \(cadr data) is the <message/> stanza.
 350 This function is used as an ewoc prettyprinter."
 351   (let* ((beg (point))
 352          (original-timestamp (when (listp (cadr data))
 353                                (jabber-xml-path (cadr data) '(("jabber:x:delay" . "x")))))
 354          (internal-time
 355           (plist-get (cddr data) :time))
 356          (body (ignore-errors (car
 357                (jabber-xml-node-children
 358                 (car
 359                  (jabber-xml-get-children (cadr data) 'body))))))
 360          (/me-p
 361           (and (> (length body) 4)
 362                (string= (substring body 0 4) "/me "))))
 363
 364     ;; Print prompt...
 365     (let ((delayed (or original-timestamp (plist-get (cddr data) :delayed))))
 366       (case (car data)
 367         (:local
 368          (jabber-chat-self-prompt (or (jabber-x-delay original-timestamp)
 369                                       internal-time)
 370                                   delayed
 371                                   /me-p))
 372         (:foreign
 373          ;; For :error and :notice, this might be a string... beware
 374          (jabber-chat-print-prompt (when (listp (cadr data)) (cadr data))
 375                                    (or (jabber-x-delay original-timestamp)
 376                                        internal-time)
 377                                    delayed
 378                                    /me-p))
 379         ((:error :notice :subscription-request)
 380          (jabber-chat-system-prompt (or (jabber-x-delay original-timestamp)
 381                                         internal-time)))
 382         (:muc-local
 383          (jabber-muc-print-prompt (cadr data) t /me-p))
 384         (:muc-foreign
 385          (jabber-muc-print-prompt (cadr data) nil /me-p))
 386         ((:muc-notice :muc-error)
 387          (jabber-muc-system-prompt))))
 388
 389     ;; ...and body
 390     (case (car data)
 391       ((:local :foreign)
 392        (run-hook-with-args 'jabber-chat-printers (cadr data) (car data) :insert))
 393       ((:muc-local :muc-foreign)
 394        (let ((printers (append jabber-muc-printers jabber-chat-printers)))
 395          (run-hook-with-args 'printers (cadr data) (car data) :insert)))
 396       ((:error :muc-error)
 397        (if (stringp (cadr data))
 398             (insert (jabber-propertize (cadr data) 'face 'jabber-chat-error))
 399          (jabber-chat-print-error (cadr data))))
 400       ((:notice :muc-notice)
 401        (insert (cadr data)))
 402       (:rare-time
 403        (insert (jabber-propertize (format-time-string jabber-rare-time-format (cadr data))
 404                                   'face 'jabber-rare-time-face)))
 405       (:subscription-request
 406        (insert "This user requests subscription to your presence.\n")
 407        (when (and (stringp (cadr data)) (not (zerop (length (cadr data)))))
 408          (insert "Message: " (cadr data) "\n"))
 409        (insert "Accept?\n\n")
 410        (flet ((button
 411                (text action)
 412                (if (fboundp 'insert-button)
 413                    (insert-button text 'action action)
 414                  ;; simple button replacement
 415                  (let ((keymap (make-keymap)))
 416                    (define-key keymap "\r" action)
 417                    (insert (jabber-propertize text 'keymap keymap 'face 'highlight))))
 418                (insert "\t")))
 419          (button "Mutual" 'jabber-subscription-accept-mutual)
 420          (button "One-way" 'jabber-subscription-accept-one-way)
 421          (button "Decline" 'jabber-subscription-decline))))
 422
 423     (when jabber-chat-fill-long-lines
 424       (save-restriction
 425         (narrow-to-region beg (point))
 426         (jabber-chat-buffer-fill-long-lines)))
 427
 428     (put-text-property beg (point) 'read-only t)
 429     (put-text-property beg (point) 'front-sticky t)
 430     (put-text-property beg (point) 'rear-nonsticky t)))
 431
 432 (defun jabber-rare-time-needed (time1 time2)
 433   "Return non-nil if a timestamp should be printed between TIME1 and TIME2."
 434   (not (string= (format-time-string jabber-rare-time-format time1)
 435                 (format-time-string jabber-rare-time-format time2))))
 436
 437 (defun jabber-message-time (entry)
 438   "Return time of ENTRY, a message in internal format."
 439   (or (when (listp (cadr entry))
 440         (jabber-x-delay (jabber-xml-path (cadr entry) '(("jabber:x:delay" . "x")))))
 441       (plist-get (cddr entry) :time)))
 442
 443 (defun jabber-maybe-print-rare-time (node)
 444   "Print rare time before NODE, if appropriate."
 445   (let* ((prev (ewoc-prev jabber-chat-ewoc node))
 446          (data (ewoc-data node))
 447          (prev-data (when prev (ewoc-data prev))))
 448     (when (and jabber-print-rare-time
 449                (or (null prev)
 450                    (jabber-rare-time-needed (jabber-message-time prev-data)
 451                                             (jabber-message-time data))))
 452       (ewoc-enter-before jabber-chat-ewoc node (list :rare-time (jabber-message-time data))))))
 453
 454 (defun jabber-chat-print-prompt (xml-data timestamp delayed dont-print-nick-p)
 455   "Print prompt for received message in XML-DATA.
 456 TIMESTAMP is the timestamp to print, or nil to get it
 457 from a jabber:x:delay element.
 458 If DELAYED is true, print long timestamp
 459 \(`jabber-chat-delayed-time-format' as opposed to
 460 `jabber-chat-time-format').
 461 If DONT-PRINT-NICK-P is true, don't include nickname."
 462   (let ((from (jabber-xml-get-attribute xml-data 'from))
 463         (timestamp (or timestamp
 464                        (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x)))))))
 465     (insert (jabber-propertize
 466              (format-spec jabber-chat-foreign-prompt-format
 467                           (list
 468                            (cons ?t (format-time-string
 469                                      (if delayed
 470                                          jabber-chat-delayed-time-format
 471                                        jabber-chat-time-format)
 472                                      timestamp))
 473                            (cons ?n (if dont-print-nick-p "" (jabber-jid-displayname from)))
 474                            (cons ?u (or (jabber-jid-username from) from))
 475                            (cons ?r (jabber-jid-resource from))
 476                            (cons ?j (jabber-jid-user from))))
 477              'face 'jabber-chat-prompt-foreign
 478              'help-echo
 479              (concat (format-time-string "On %Y-%m-%d %H:%M:%S" timestamp) " from " from)))))
 480
 481 (defun jabber-chat-system-prompt (timestamp)
 482   (insert (jabber-propertize
 483            (format-spec jabber-chat-foreign-prompt-format
 484                         (list
 485                          (cons ?t (format-time-string jabber-chat-time-format
 486                                                       timestamp))
 487                          (cons ?n "")
 488                          (cons ?u "")
 489                          (cons ?r "")
 490                          (cons ?j "")))
 491            'face 'jabber-chat-prompt-system
 492            'help-echo
 493            (concat (format-time-string "System message on %Y-%m-%d %H:%M:%S" timestamp)))))
 494
 495 (defun jabber-chat-self-prompt (timestamp delayed dont-print-nick-p)
 496   "Print prompt for sent message.
 497 TIMESTAMP is the timestamp to print, or nil for now.
 498 If DELAYED is true, print long timestamp
 499 \(`jabber-chat-delayed-time-format' as opposed to
 500 `jabber-chat-time-format').
 501 If DONT-PRINT-NICK-P is true, don't include nickname."
 502   (let* ((state-data (fsm-get-state-data jabber-buffer-connection))
 503          (username (plist-get state-data :username))
 504          (server (plist-get state-data :server))
 505          (resource (plist-get state-data :resource))
 506          (nickname username))
 507     (insert (jabber-propertize
 508              (format-spec jabber-chat-local-prompt-format
 509                           (list
 510                            (cons ?t (format-time-string
 511                                      (if delayed
 512                                          jabber-chat-delayed-time-format
 513                                        jabber-chat-time-format)
 514                                      timestamp))
 515                            (cons ?n (if dont-print-nick-p "" nickname))
 516                            (cons ?u username)
 517                            (cons ?r resource)
 518                            (cons ?j (concat username "@" server))))
 519              'face 'jabber-chat-prompt-local
 520              'help-echo
 521              (concat (format-time-string "On %Y-%m-%d %H:%M:%S" timestamp) " from you")))))
 522
 523 (defun jabber-chat-print-error (xml-data)
 524   "Print error in given <message/> in a readable way."
 525   (let ((the-error (car (jabber-xml-get-children xml-data 'error))))
 526     (insert
 527      (jabber-propertize
 528       (concat "Error: " (jabber-parse-error the-error))
 529       'face 'jabber-chat-error))))
 530
 531 (defun jabber-chat-print-subject (xml-data who mode)
 532   "Print subject of given <message/>, if any."
 533   (let ((subject (car
 534                   (jabber-xml-node-children
 535                    (car
 536                     (jabber-xml-get-children xml-data 'subject))))))
 537     (when (not (zerop (length subject)))
 538       (case mode
 539         (:printp
 540          t)
 541         (:insert
 542          (insert (jabber-propertize
 543                   "Subject: " 'face 'jabber-chat-prompt-system)
 544                  (jabber-propertize
 545                   subject
 546                   'face 'jabber-chat-text-foreign)
 547                  "\n"))))))
 548
 549 (defun jabber-chat-print-body (xml-data who mode)
 550   (run-hook-with-args-until-success 'jabber-body-printers xml-data who mode))
 551
 552 (defun jabber-chat-normal-body (xml-data who mode)
 553   "Print body for received message in XML-DATA."
 554   (let ((body (car
 555                (jabber-xml-node-children
 556                 (car
 557                  (jabber-xml-get-children xml-data 'body))))))
 558     (when body
 559
 560       (when (eql mode :insert)
 561         (if (and (> (length body) 4)
 562                  (string= (substring body 0 4) "/me "))
 563             (let ((action (substring body 4))
 564                   (nick (cond
 565                          ((eq who :local)
 566                           (plist-get (fsm-get-state-data jabber-buffer-connection) :username))
 567                          ((jabber-muc-message-p xml-data)
 568                           (jabber-jid-resource (jabber-xml-get-attribute xml-data 'from)))
 569                          (t
 570                           (jabber-jid-displayname (jabber-xml-get-attribute xml-data 'from))))))
 571               (insert (jabber-propertize
 572                        (concat nick
 573                                " "
 574                                action)
 575                        'face 'jabber-chat-prompt-system)))
 576           (insert (jabber-propertize
 577                    body
 578                    'face (case who
 579                            ((:foreign :muc-foreign) 'jabber-chat-text-foreign)
 580                            ((:local :muc-local) 'jabber-chat-text-local))))))
 581       t)))
 582
 583 (defun jabber-chat-print-url (xml-data who mode)
 584   "Print URLs provided in jabber:x:oob namespace."
 585   (let ((foundp nil))
 586     (dolist (x (jabber-xml-node-children xml-data))
 587       (when (and (listp x) (eq (jabber-xml-node-name x) 'x)
 588                  (string= (jabber-xml-get-attribute x 'xmlns) "jabber:x:oob"))
 589         (setq foundp t)
 590
 591         (when (eql mode :insert)
 592         (let ((url (car (jabber-xml-node-children
 593                          (car (jabber-xml-get-children x 'url)))))
 594               (desc (car (jabber-xml-node-children
 595                           (car (jabber-xml-get-children x 'desc))))))
 596           (insert (jabber-propertize
 597                    "URL: " 'face 'jabber-chat-prompt-system))
 598           (insert (format "%s <%s>" desc url))
 599           (insert "\n")))))
 600     foundp))
 601
 602 (defun jabber-chat-goto-address (&rest ignore)
 603   "Call `goto-address' on the newly written text."
 604   (ignore-errors
 605     (goto-address)))
 606
 607 ;; jabber-compose is autoloaded in jabber.el
 608 (add-to-list 'jabber-jid-chat-menu
 609              (cons "Compose message" 'jabber-compose))
 610
 611 (defun jabber-send-message (jc to subject body type)
 612   "send a message tag to the server"
 613   (interactive (list (jabber-read-account)
 614                      (jabber-read-jid-completing "to: ")
 615                      (jabber-read-with-input-method "subject: ")
 616                      (jabber-read-with-input-method "body: ")
 617                      (read-string "type: ")))
 618   (jabber-send-sexp jc
 619                     `(message ((to . ,to)
 620                                ,(if (> (length type) 0)
 621                                     `(type . ,type)))
 622                               ,(if (> (length subject) 0)
 623                                    `(subject () ,subject))
 624                               ,(if (> (length body) 0)
 625                                    `(body () ,body))))
 626   (if (and jabber-history-enabled (not (string= type "groupchat")))
 627       (jabber-history-log-message "out" nil to body (current-time))))
 628
 629 (add-to-list 'jabber-jid-chat-menu
 630              (cons "Start chat" 'jabber-chat-with))
 631
 632 (defun jabber-chat-with (jc jid &optional other-window)
 633   "Open an empty chat window for chatting with JID.
 634 With a prefix argument, open buffer in other window.
 635 Returns the chat buffer."
 636   (interactive (let ((jid
 637                       (jabber-read-jid-completing "chat with:"))
 638                      (account
 639                       (jabber-read-account)))
 640                  (list
 641                   account jid current-prefix-arg)))
 642   (let ((buffer (jabber-chat-create-buffer jc jid)))
 643     (if other-window
 644         (switch-to-buffer-other-window buffer)
 645       (switch-to-buffer buffer))))
 646
 647 (defun jabber-chat-with-jid-at-point (&optional other-window)
 648   "Start chat with JID at point.
 649 Signal an error if there is no JID at point.
 650 With a prefix argument, open buffer in other window."
 651   (interactive "P")
 652   (let ((jid-at-point (get-text-property (point)
 653                                          'jabber-jid))
 654         (account (get-text-property (point)
 655                                     'jabber-account)))
 656     (if (and jid-at-point account)
 657         (jabber-chat-with account jid-at-point other-window)
 658       (error "No contact at point"))))
 659
 660 (provide 'jabber-chat)
 661
 662 ;; arch-tag: f423eb92-aa87-475b-b590-48c93ccba9be