jabber-compose.el

   1 ;;; jabber-compose.el --- compose a Jabber message in a buffer
   2
   3 ;; Copyright (C) 2006, 2007  Magnus Henoch
   4
   5 ;; Author: Magnus Henoch <mange@freemail.hu>
   6 ;; Keywords:
   7
   8 ;; This file is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; This file is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21 ;; Boston, MA 02110-1301, USA.
  22
  23 ;;; Code:
  24
  25 ;;;###autoload
  26 (defun jabber-compose (jc &optional recipient)
  27   "Create a buffer for composing a Jabber message."
  28   (interactive (list (jabber-read-account)
  29                      (jabber-read-jid-completing "To whom? ")))
  30
  31   (with-current-buffer (get-buffer-create
  32                         (generate-new-buffer-name
  33                          (concat
  34                           "Jabber-Compose"
  35                           (when recipient
  36                             (format "-%s" (jabber-jid-displayname recipient))))))
  37     (set (make-local-variable 'jabber-widget-alist) nil)
  38     (setq jabber-buffer-connection jc)
  39     (use-local-map widget-keymap)
  40
  41     (insert (jabber-propertize "Compose Jabber message\n" 'face 'jabber-title-large))
  42
  43     (insert (substitute-command-keys "\\<widget-field-keymap>Completion available with \\[widget-complete].\n"))
  44     (push (cons :recipients
  45                 (widget-create '(repeat :tag "Recipients" jid)
  46                                :value (when recipient
  47                                         (list recipient))))
  48           jabber-widget-alist)
  49
  50     (insert "\nSubject: ")
  51     (push (cons :subject
  52                 (widget-create 'editable-field :value ""))
  53           jabber-widget-alist)
  54
  55     (insert "\nText:\n")
  56     (push (cons :text
  57                 (widget-create 'text :value ""))
  58           jabber-widget-alist)
  59
  60     (insert "\n")
  61     (widget-create 'push-button :notify #'jabber-compose-send "Send")
  62
  63     (widget-setup)
  64
  65     (switch-to-buffer (current-buffer))
  66     (goto-char (point-min))))
  67
  68 (defun jabber-compose-send (&rest ignore)
  69   (let ((recipients (widget-value (cdr (assq :recipients jabber-widget-alist))))
  70         (subject (widget-value (cdr (assq :subject jabber-widget-alist))))
  71         (text (widget-value (cdr (assq :text jabber-widget-alist)))))
  72     (when (null recipients)
  73       (error "No recipients specified"))
  74
  75     (dolist (to recipients)
  76       (jabber-send-message jabber-buffer-connection to subject text nil))
  77
  78     (bury-buffer)
  79     (message "Message sent")))
  80
  81 (provide 'jabber-compose)
  82 ;; arch-tag: 59032c00-994d-11da-8d97-000a95c2fcd0