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 (require 'jabber-menu)                  ;we need jabber-jid-chat-menu
  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   "Display more context. HOW-MANY is number of messages. Specify 0 to display all messages."
 282   (interactive "nHow many more messages (Specify 0 to display all)? ")
 283   (let* ((inhibit-read-only t)
 284          (jabber-backlog-days nil)
 285          (jabber-backlog-number (if (= how-many 0) t how-many))
 286          (backlog-entries (jabber-history-backlog
 287                            jabber-chatting-with jabber-chat-earliest-backlog)))
 288     (when backlog-entries
 289       (setq jabber-chat-earliest-backlog
 290             (jabber-float-time (jabber-parse-time
 291                                 (aref (car backlog-entries) 0))))
 292       (save-excursion
 293         (goto-char (point-min))
 294         (mapc 'jabber-chat-insert-backlog-entry (nreverse backlog-entries))))))
 295
 296 (add-to-list 'jabber-message-chain 'jabber-process-chat)
 297
 298 (defun jabber-process-chat (jc xml-data)
 299   "If XML-DATA is a one-to-one chat message, handle it as such."
 300   ;; For now, everything that is not a public MUC message is
 301   ;; potentially a 1to1 chat message.
 302   (when (not (jabber-muc-message-p xml-data))
 303     ;; Note that we handle private MUC messages here.
 304     (let ((from (jabber-xml-get-attribute xml-data 'from))
 305           (error-p (jabber-xml-get-children xml-data 'error))
 306           (body-text (car (jabber-xml-node-children
 307                            (car (jabber-xml-get-children
 308                                  xml-data 'body))))))
 309       ;; First check if we would output anything for this stanza.
 310       (when (or error-p
 311                 (run-hook-with-args-until-success 'jabber-chat-printers xml-data :foreign :printp))
 312         ;; If so, create chat buffer, if necessary...
 313         (with-current-buffer (if (jabber-muc-sender-p from)
 314                                  (jabber-muc-private-create-buffer
 315                                   jc
 316                                   (jabber-jid-user from)
 317                                   (jabber-jid-resource from))
 318                                (jabber-chat-create-buffer jc from))
 319           ;; ...add the message to the ewoc...
 320           (let ((node
 321                  (ewoc-enter-last jabber-chat-ewoc (list (if error-p :error :foreign) xml-data :time (current-time)))))
 322             (jabber-maybe-print-rare-time node))
 323
 324           ;; ...and call alert hooks.
 325           (dolist (hook '(jabber-message-hooks jabber-alert-message-hooks))
 326             (run-hook-with-args hook
 327                                 from (current-buffer) body-text
 328                                 (funcall jabber-alert-message-function
 329                                          from (current-buffer) body-text))))))))
 330
 331 (defun jabber-chat-send (jc body)
 332   "Send BODY through connection JC, and display it in chat buffer."
 333   ;; Build the stanza...
 334   (let* ((id (apply 'format "emacs-msg-%d.%d.%d" (current-time)))
 335          (stanza-to-send `(message
 336                            ((to . ,jabber-chatting-with)
 337                             (type . "chat")
 338                             (id . ,id))
 339                            (body () ,body))))
 340     ;; ...add additional elements...
 341     (dolist (hook jabber-chat-send-hooks)
 342       (nconc stanza-to-send (funcall hook body id)))
 343     ;; ...display it, if it would be displayed.
 344     (when (run-hook-with-args-until-success 'jabber-chat-printers stanza-to-send :local :printp)
 345       (jabber-maybe-print-rare-time
 346        (ewoc-enter-last jabber-chat-ewoc (list :local stanza-to-send :time (current-time)))))
 347     ;; ...and send it...
 348     (jabber-send-sexp jc stanza-to-send)))
 349
 350 (defun jabber-chat-pp (data)
 351   "Pretty-print a <message/> stanza.
 352 \(car data) is either :local, :foreign, :error or :notice.
 353 \(cadr data) is the <message/> stanza.
 354 This function is used as an ewoc prettyprinter."
 355   (let* ((beg (point))
 356          (original-timestamp (when (listp (cadr data))
 357                                (jabber-xml-path (cadr data) '(("jabber:x:delay" . "x")))))
 358          (internal-time
 359           (plist-get (cddr data) :time))
 360          (body (ignore-errors (car
 361                (jabber-xml-node-children
 362                 (car
 363                  (jabber-xml-get-children (cadr data) 'body))))))
 364          (/me-p
 365           (and (> (length body) 4)
 366                (string= (substring body 0 4) "/me "))))
 367
 368     ;; Print prompt...
 369     (let ((delayed (or original-timestamp (plist-get (cddr data) :delayed))))
 370       (case (car data)
 371         (:local
 372          (jabber-chat-self-prompt (or (jabber-x-delay original-timestamp)
 373                                       internal-time)
 374                                   delayed
 375                                   /me-p))
 376         (:foreign
 377          ;; For :error and :notice, this might be a string... beware
 378          (jabber-chat-print-prompt (when (listp (cadr data)) (cadr data))
 379                                    (or (jabber-x-delay original-timestamp)
 380                                        internal-time)
 381                                    delayed
 382                                    /me-p))
 383         ((:error :notice :subscription-request)
 384          (jabber-chat-system-prompt (or (jabber-x-delay original-timestamp)
 385                                         internal-time)))
 386         (:muc-local
 387          (jabber-muc-print-prompt (cadr data) t /me-p))
 388         (:muc-foreign
 389          (jabber-muc-print-prompt (cadr data) nil /me-p))
 390         ((:muc-notice :muc-error)
 391          (jabber-muc-system-prompt))))
 392
 393     ;; ...and body
 394     (case (car data)
 395       ((:local :foreign)
 396        (run-hook-with-args 'jabber-chat-printers (cadr data) (car data) :insert))
 397       ((:muc-local :muc-foreign)
 398        (let ((printers (append jabber-muc-printers jabber-chat-printers)))
 399          (run-hook-with-args 'printers (cadr data) (car data) :insert)))
 400       ((:error :muc-error)
 401        (if (stringp (cadr data))
 402             (insert (jabber-propertize (cadr data) 'face 'jabber-chat-error))
 403          (jabber-chat-print-error (cadr data))))
 404       ((:notice :muc-notice)
 405        (insert (cadr data)))
 406       (:rare-time
 407        (insert (jabber-propertize (format-time-string jabber-rare-time-format (cadr data))
 408                                   'face 'jabber-rare-time-face)))
 409       (:subscription-request
 410        (insert "This user requests subscription to your presence.\n")
 411        (when (and (stringp (cadr data)) (not (zerop (length (cadr data)))))
 412          (insert "Message: " (cadr data) "\n"))
 413        (insert "Accept?\n\n")
 414        (flet ((button
 415                (text action)
 416                (if (fboundp 'insert-button)
 417                    (insert-button text 'action action)
 418                  ;; simple button replacement
 419                  (let ((keymap (make-keymap)))
 420                    (define-key keymap "\r" action)
 421                    (insert (jabber-propertize text 'keymap keymap 'face 'highlight))))
 422                (insert "\t")))
 423          (button "Mutual" 'jabber-subscription-accept-mutual)
 424          (button "One-way" 'jabber-subscription-accept-one-way)
 425          (button "Decline" 'jabber-subscription-decline))))
 426
 427     (when jabber-chat-fill-long-lines
 428       (save-restriction
 429         (narrow-to-region beg (point))
 430         (jabber-chat-buffer-fill-long-lines)))
 431
 432     (put-text-property beg (point) 'read-only t)
 433     (put-text-property beg (point) 'front-sticky t)
 434     (put-text-property beg (point) 'rear-nonsticky t)))
 435
 436 (defun jabber-rare-time-needed (time1 time2)
 437   "Return non-nil if a timestamp should be printed between TIME1 and TIME2."
 438   (not (string= (format-time-string jabber-rare-time-format time1)
 439                 (format-time-string jabber-rare-time-format time2))))
 440
 441 (defun jabber-message-time (entry)
 442   "Return time of ENTRY, a message in internal format."
 443   (or (when (listp (cadr entry))
 444         (jabber-x-delay (jabber-xml-path (cadr entry) '(("jabber:x:delay" . "x")))))
 445       (plist-get (cddr entry) :time)))
 446
 447 (defun jabber-maybe-print-rare-time (node)
 448   "Print rare time before NODE, if appropriate."
 449   (let* ((prev (ewoc-prev jabber-chat-ewoc node))
 450          (data (ewoc-data node))
 451          (prev-data (when prev (ewoc-data prev))))
 452     (when (and jabber-print-rare-time
 453                (or (null prev)
 454                    (jabber-rare-time-needed (jabber-message-time prev-data)
 455                                             (jabber-message-time data))))
 456       (ewoc-enter-before jabber-chat-ewoc node (list :rare-time (jabber-message-time data))))))
 457
 458 (defun jabber-chat-print-prompt (xml-data timestamp delayed dont-print-nick-p)
 459   "Print prompt for received message in XML-DATA.
 460 TIMESTAMP is the timestamp to print, or nil to get it
 461 from a jabber:x:delay element.
 462 If DELAYED is true, print long timestamp
 463 \(`jabber-chat-delayed-time-format' as opposed to
 464 `jabber-chat-time-format').
 465 If DONT-PRINT-NICK-P is true, don't include nickname."
 466   (let ((from (jabber-xml-get-attribute xml-data 'from))
 467         (timestamp (or timestamp
 468                        (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x)))))))
 469     (insert (jabber-propertize
 470              (format-spec jabber-chat-foreign-prompt-format
 471                           (list
 472                            (cons ?t (format-time-string
 473                                      (if delayed
 474                                          jabber-chat-delayed-time-format
 475                                        jabber-chat-time-format)
 476                                      timestamp))
 477                            (cons ?n (if dont-print-nick-p "" (jabber-jid-displayname from)))
 478                            (cons ?u (or (jabber-jid-username from) from))
 479                            (cons ?r (jabber-jid-resource from))
 480                            (cons ?j (jabber-jid-user from))))
 481              'face 'jabber-chat-prompt-foreign
 482              'help-echo
 483              (concat (format-time-string "On %Y-%m-%d %H:%M:%S" timestamp) " from " from)))))
 484
 485 (defun jabber-chat-system-prompt (timestamp)
 486   (insert (jabber-propertize
 487            (format-spec jabber-chat-foreign-prompt-format
 488                         (list
 489                          (cons ?t (format-time-string jabber-chat-time-format
 490                                                       timestamp))
 491                          (cons ?n "")
 492                          (cons ?u "")
 493                          (cons ?r "")
 494                          (cons ?j "")))
 495            'face 'jabber-chat-prompt-system
 496            'help-echo
 497            (concat (format-time-string "System message on %Y-%m-%d %H:%M:%S" timestamp)))))
 498
 499 (defun jabber-chat-self-prompt (timestamp delayed dont-print-nick-p)
 500   "Print prompt for sent message.
 501 TIMESTAMP is the timestamp to print, or nil for now.
 502 If DELAYED is true, print long timestamp
 503 \(`jabber-chat-delayed-time-format' as opposed to
 504 `jabber-chat-time-format').
 505 If DONT-PRINT-NICK-P is true, don't include nickname."
 506   (let* ((state-data (fsm-get-state-data jabber-buffer-connection))
 507          (username (plist-get state-data :username))
 508          (server (plist-get state-data :server))
 509          (resource (plist-get state-data :resource))
 510          (nickname username))
 511     (insert (jabber-propertize
 512              (format-spec jabber-chat-local-prompt-format
 513                           (list
 514                            (cons ?t (format-time-string
 515                                      (if delayed
 516                                          jabber-chat-delayed-time-format
 517                                        jabber-chat-time-format)
 518                                      timestamp))
 519                            (cons ?n (if dont-print-nick-p "" nickname))
 520                            (cons ?u username)
 521                            (cons ?r resource)
 522                            (cons ?j (concat username "@" server))))
 523              'face 'jabber-chat-prompt-local
 524              'help-echo
 525              (concat (format-time-string "On %Y-%m-%d %H:%M:%S" timestamp) " from you")))))
 526
 527 (defun jabber-chat-print-error (xml-data)
 528   "Print error in given <message/> in a readable way."
 529   (let ((the-error (car (jabber-xml-get-children xml-data 'error))))
 530     (insert
 531      (jabber-propertize
 532       (concat "Error: " (jabber-parse-error the-error))
 533       'face 'jabber-chat-error))))
 534
 535 (defun jabber-chat-print-subject (xml-data who mode)
 536   "Print subject of given <message/>, if any."
 537   (let ((subject (car
 538                   (jabber-xml-node-children
 539                    (car
 540                     (jabber-xml-get-children xml-data 'subject))))))
 541     (when (not (zerop (length subject)))
 542       (case mode
 543         (:printp
 544          t)
 545         (:insert
 546          (insert (jabber-propertize
 547                   "Subject: " 'face 'jabber-chat-prompt-system)
 548                  (jabber-propertize
 549                   subject
 550                   'face 'jabber-chat-text-foreign)
 551                  "\n"))))))
 552
 553 (defun jabber-chat-print-body (xml-data who mode)
 554   (run-hook-with-args-until-success 'jabber-body-printers xml-data who mode))
 555
 556 (defun jabber-chat-normal-body (xml-data who mode)
 557   "Print body for received message in XML-DATA."
 558   (let ((body (car
 559                (jabber-xml-node-children
 560                 (car
 561                  (jabber-xml-get-children xml-data 'body))))))
 562     (when body
 563
 564       (when (eql mode :insert)
 565         (if (and (> (length body) 4)
 566                  (string= (substring body 0 4) "/me "))
 567             (let ((action (substring body 4))
 568                   (nick (cond
 569                          ((eq who :local)
 570                           (plist-get (fsm-get-state-data jabber-buffer-connection) :username))
 571                          ((jabber-muc-message-p xml-data)
 572                           (jabber-jid-resource (jabber-xml-get-attribute xml-data 'from)))
 573                          (t
 574                           (jabber-jid-displayname (jabber-xml-get-attribute xml-data 'from))))))
 575               (insert (jabber-propertize
 576                        (concat nick
 577                                " "
 578                                action)
 579                        'face 'jabber-chat-prompt-system)))
 580           (insert (jabber-propertize
 581                    body
 582                    'face (case who
 583                            ((:foreign :muc-foreign) 'jabber-chat-text-foreign)
 584                            ((:local :muc-local) 'jabber-chat-text-local))))))
 585       t)))
 586
 587 (defun jabber-chat-print-url (xml-data who mode)
 588   "Print URLs provided in jabber:x:oob namespace."
 589   (let ((foundp nil))
 590     (dolist (x (jabber-xml-node-children xml-data))
 591       (when (and (listp x) (eq (jabber-xml-node-name x) 'x)
 592                  (string= (jabber-xml-get-attribute x 'xmlns) "jabber:x:oob"))
 593         (setq foundp t)
 594
 595         (when (eql mode :insert)
 596           (let ((url (car (jabber-xml-node-children
 597                            (car (jabber-xml-get-children x 'url)))))
 598                 (desc (car (jabber-xml-node-children
 599                             (car (jabber-xml-get-children x 'desc))))))
 600             (insert "\n"
 601                     (jabber-propertize
 602                      "URL: " 'face 'jabber-chat-prompt-system)
 603                     (format "%s <%s>" desc url))))))
 604     foundp))
 605
 606 (defun jabber-chat-goto-address (xml-data who mode)
 607   "Call `goto-address' on the newly written text."
 608   (when (eq mode :insert)
 609     (ignore-errors
 610       (goto-address))))
 611
 612 ;; jabber-compose is autoloaded in jabber.el
 613 (add-to-list 'jabber-jid-chat-menu
 614              (cons "Compose message" 'jabber-compose))
 615
 616 (defun jabber-send-message (jc to subject body type)
 617   "send a message tag to the server"
 618   (interactive (list (jabber-read-account)
 619                      (jabber-read-jid-completing "to: ")
 620                      (jabber-read-with-input-method "subject: ")
 621                      (jabber-read-with-input-method "body: ")
 622                      (read-string "type: ")))
 623   (jabber-send-sexp jc
 624                     `(message ((to . ,to)
 625                                ,(if (> (length type) 0)
 626                                     `(type . ,type)))
 627                               ,(if (> (length subject) 0)
 628                                    `(subject () ,subject))
 629                               ,(if (> (length body) 0)
 630                                    `(body () ,body))))
 631   (if (and jabber-history-enabled (not (string= type "groupchat")))
 632       (jabber-history-log-message "out" nil to body (current-time))))
 633
 634 (add-to-list 'jabber-jid-chat-menu
 635              (cons "Start chat" 'jabber-chat-with))
 636
 637 (defun jabber-chat-with (jc jid &optional other-window)
 638   "Open an empty chat window for chatting with JID.
 639 With a prefix argument, open buffer in other window.
 640 Returns the chat buffer."
 641   (interactive (let ((jid
 642                       (jabber-read-jid-completing "chat with:"))
 643                      (account
 644                       (jabber-read-account)))
 645                  (list
 646                   account jid current-prefix-arg)))
 647   (let ((buffer (jabber-chat-create-buffer jc jid)))
 648     (if other-window
 649         (switch-to-buffer-other-window buffer)
 650       (switch-to-buffer buffer))))
 651
 652 (defun jabber-chat-with-jid-at-point (&optional other-window)
 653   "Start chat with JID at point.
 654 Signal an error if there is no JID at point.
 655 With a prefix argument, open buffer in other window."
 656   (interactive "P")
 657   (let ((jid-at-point (get-text-property (point)
 658                                          'jabber-jid))
 659         (account (get-text-property (point)
 660                                     'jabber-account)))
 661     (if (and jid-at-point account)
 662         (jabber-chat-with account jid-at-point other-window)
 663       (error "No contact at point"))))
 664
 665 (provide 'jabber-chat)
 666
 667 ;; arch-tag: f423eb92-aa87-475b-b590-48c93ccba9be