jabber-menu.el

   1 ;; jabber-menu.el - menu definitions
   2
   3 ;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
   4 ;; Copyright (C) 2003, 2004 - Magnus Henoch - mange@freemail.hu
   5
   6 ;; This file is a part of jabber.el.
   7
   8 ;; This program 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 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program 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 this program; if not, write to the Free Software
  20 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21
  22 (defvar jabber-menu (make-sparse-keymap "jabber-menu"))
  23
  24 (defun jabber-menu (&optional remove)
  25   "Put \"Jabber\" menu on menubar.
  26 With prefix argument, remove it."
  27   (interactive "P")
  28   (define-key global-map
  29     [menu-bar jabber-menu]
  30     (and (not remove) (cons "Jabber" jabber-menu))))
  31
  32 (define-key jabber-menu
  33   [jabber-menu-connect]
  34   '("Connect" . jabber-connect))
  35
  36 (define-key jabber-menu
  37   [jabber-menu-disconnect]
  38   '("Disconnect" . jabber-disconnect))
  39
  40 (define-key jabber-menu
  41     [jabber-menu-roster]
  42   '("Switch to roster" . jabber-switch-to-roster-buffer))
  43
  44 (define-key jabber-menu
  45   [jabber-menu-customize]
  46   '("Customize" . jabber-customize))
  47
  48 (define-key jabber-menu
  49   [jabber-menu-info]
  50   '("Help" . jabber-info))
  51
  52 (define-key jabber-menu
  53   [jabber-menu-status]
  54   (cons "Set Status" (make-sparse-keymap "set-status")))
  55
  56 (defmacro jabber-define-status-key (title show)
  57   (list 'let (list ( list 'func (list 'make-symbol (list 'concat "jabber-send-presence-" show)))
  58                    (list 'menu-item (list 'make-symbol (list 'concat "jabber-menu-status-" show))))
  59         (list 'fset 'func `(lambda () (interactive)
  60                              (jabber-send-presence ,show
  61                                                    (jabber-read-with-input-method "status message: " *jabber-current-status* '*jabber-status-history*)
  62                                                    (format "%d" *jabber-current-priority*))))
  63         (list 'define-key 'jabber-menu
  64               (list 'vector ''jabber-menu-status 'menu-item)
  65               (list 'cons title 'func))))
  66
  67 ;;;(dolist (presence jabber-presence-strings)
  68 ;;;  (jabber-define-status-key (cdr presence) (car presence)))
  69 ;;(jabber-define-status-key "Online" "")
  70
  71 (jabber-define-status-key "Chatty" "chat")
  72 ;;(jabber-define-status-key "Away" "away")
  73 ;;(jabber-define-status-key "Extended Away" "xa")
  74 (jabber-define-status-key "Do not Disturb" "dnd")
  75 (define-key jabber-menu
  76     [jabber-menu-status jabber-menu-status-xa]
  77   '("Extended Away" . jabber-send-xa-presence))
  78 (define-key jabber-menu
  79     [jabber-menu-status jabber-menu-status-away]
  80   '("Away" . jabber-send-away-presence))
  81 (define-key jabber-menu
  82     [jabber-menu-status jabber-menu-status-online]
  83   '("Online" . jabber-send-default-presence))
  84
  85 (defvar jabber-jid-chat-menu nil
  86   "Menu items for chat menu")
  87
  88 (defvar jabber-jid-info-menu nil
  89   "Menu item for info menu")
  90
  91 (defvar jabber-jid-roster-menu nil
  92   "Menu items for roster menu")
  93
  94 (defvar jabber-jid-muc-menu nil
  95   "Menu items for MUC menu")
  96
  97 (defvar jabber-jid-service-menu nil
  98   "Menu items for service menu")
  99
 100 (defun jabber-popup-menu (which-menu)
 101   "Popup specified menu"
 102   (let* ((mouse-event (and (listp last-input-event) last-input-event))
 103          (choice (widget-choose "Actions" which-menu mouse-event)))
 104     (if mouse-event
 105         (mouse-set-point mouse-event))
 106     (if choice
 107         (call-interactively choice))))
 108
 109 (defun jabber-popup-chat-menu ()
 110   "Popup chat menu"
 111   (interactive)
 112   (jabber-popup-menu jabber-jid-chat-menu))
 113
 114 (defun jabber-popup-info-menu ()
 115   "Popup info menu"
 116   (interactive)
 117   (jabber-popup-menu jabber-jid-info-menu))
 118
 119 (defun jabber-popup-roster-menu ()
 120   "Popup roster menu"
 121   (interactive)
 122   (jabber-popup-menu jabber-jid-roster-menu))
 123
 124 (defun jabber-popup-muc-menu ()
 125   "Popup MUC menu"
 126   (interactive)
 127   (jabber-popup-menu jabber-jid-muc-menu))
 128
 129 (defun jabber-popup-service-menu ()
 130   "Popup service menu"
 131   (interactive)
 132   (jabber-popup-menu jabber-jid-service-menu))
 133
 134 (defun jabber-popup-combined-menu ()
 135   "Popup combined menu"
 136   (interactive)
 137   (jabber-popup-menu (append jabber-jid-chat-menu jabber-jid-info-menu jabber-jid-roster-menu jabber-jid-muc-menu)))
 138
 139 (provide 'jabber-menu)
 140
 141 ;;; arch-tag: 5147f52f-de47-4348-86ff-b799d7a75e3f