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

   1 ;;; jabber-compose.el --- compose a Jabber message in a buffer  -*- lexical-binding: t; -*-
   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
  29 JC is the Jabber connection."
  30   (interactive (list (jabber-read-account)
  31                      (jabber-read-jid-completing "To whom? ")))
  32
  33   (with-current-buffer (get-buffer-create
  34                         (generate-new-buffer-name
  35                          (concat
  36                           "Jabber-Compose"
  37                           (when recipient
  38                             (format "-%s" (jabber-jid-displayname recipient))))))
  39     (set (make-local-variable 'jabber-widget-alist) nil)
  40     (setq jabber-buffer-connection jc)
  41     (use-local-map widget-keymap)
  42
  43     (insert (jabber-propertize "Compose Jabber message\n" 'face 'jabber-title-large))
  44
  45     (insert (substitute-command-keys "\\<widget-field-keymap>Completion available with \\[widget-complete].\n"))
  46     (push (cons :recipients
  47                 (widget-create '(repeat :tag "Recipients" jid)
  48                                :value (when recipient
  49                                         (list recipient))))
  50           jabber-widget-alist)
  51
  52     (insert "\nSubject: ")
  53     (push (cons :subject
  54                 (widget-create 'editable-field :value ""))
  55           jabber-widget-alist)
  56
  57     (insert "\nText:\n")
  58     (push (cons :text
  59                 (widget-create 'text :value ""))
  60           jabber-widget-alist)
  61
  62     (insert "\n")
  63     (widget-create 'push-button :notify #'jabber-compose-send "Send")
  64
  65     (widget-setup)
  66
  67     (switch-to-buffer (current-buffer))
  68     (goto-char (point-min))))
  69
  70 (defun jabber-compose-send (&rest _ignore)
  71   (let ((recipients (widget-value (cdr (assq :recipients jabber-widget-alist))))
  72         (subject (widget-value (cdr (assq :subject jabber-widget-alist))))
  73         (text (widget-value (cdr (assq :text jabber-widget-alist)))))
  74     (when (null recipients)
  75       (error "No recipients specified"))
  76
  77     (dolist (to recipients)
  78       (jabber-send-message jabber-buffer-connection to subject text nil))
  79
  80     (bury-buffer)
  81     (message "Message sent")))
  82
  83 (provide 'jabber-compose)
  84 ;; arch-tag: 59032c00-994d-11da-8d97-000a95c2fcd0