1 ;;; riece-button.el --- adding buttons in channel buffers
2 ;; Copyright (C) 1998-2003 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; To use, add the following line to your ~/.riece/init.el:
28 ;; (add-to-list 'riece-addons 'riece-button)
32 (require 'riece-commands)
33 (require 'riece-identity)
37 (defconst riece-channel-button-popup-menu
39 ["Switch To Channel" riece-channel-button-switch-to-channel]
40 ["Part Channel" riece-channel-button-part]
41 ["List Channel" riece-channel-button-list])
42 "Menu for channel buttons.")
44 (defconst riece-user-button-popup-menu
46 ["Finger (WHOIS)" riece-user-button-finger]
47 ["Start Private Conversation" riece-user-button-join-partner]
48 ["Give Channel Operator Privileges" riece-user-button-set-operators]
49 ["Allow To Speak" riece-user-button-set-speakers])
50 "Menu for user buttons.")
52 (defvar riece-button-enabled nil)
54 (defconst riece-button-description
55 "Display useful buttons in IRC buffers")
57 (defvar help-echo-owns-message)
58 (define-widget 'riece-identity-button 'push-button
60 :action 'riece-button-switch-to-identity
62 (lambda (widget/window &optional overlay pos)
63 ;; Needed to properly clear the message due to a bug in
64 ;; wid-edit (XEmacs only).
65 (if (boundp 'help-echo-owns-message)
66 (setq help-echo-owns-message t))
67 (format "%S: switch to %s; down-mouse-3: more options"
68 (aref riece-mouse-2 0)
69 ;; XEmacs will get a single widget arg; Emacs 21 will get
70 ;; window, overlay, position.
71 (riece-format-identity
73 (with-current-buffer (riece-overlay-buffer overlay)
74 (widget-value (widget-at (riece-overlay-start overlay))))
75 (widget-value widget/window))))))
77 (defun riece-button-switch-to-identity (widget &optional event)
78 "Switch to identity stored in WIDGET.
79 This function is used as a callback for a channel button."
80 (let ((channel (widget-value widget)))
81 (if (riece-identity-member channel riece-current-channels)
82 (riece-command-switch-to-channel channel)
83 (message "%s" (substitute-command-keys
84 "Type \\[riece-command-join] to join the channel")))))
86 (defun riece-identity-button-popup-menu (event)
87 "Popup the menu for identity buttons."
90 (set-buffer (riece-event-buffer event))
91 (goto-char (riece-event-point event))
92 (riece-popup-menu-popup
93 (if (riece-channel-p (riece-identity-prefix
94 (get-text-property (point) 'riece-identity)))
95 riece-channel-button-popup-menu
96 riece-user-button-popup-menu)
99 (defun riece-channel-button-switch-to-channel ()
101 (riece-command-switch-to-channel
102 (get-text-property (point) 'riece-identity)))
104 (defun riece-channel-button-part ()
107 (get-text-property (point) 'riece-identity)))
109 (defun riece-channel-button-list ()
112 (riece-identity-prefix (get-text-property (point) 'riece-identity))))
114 (defun riece-user-button-join-partner ()
116 (riece-command-join-partner
117 (get-text-property (point) 'riece-identity)))
119 (defun riece-user-button-set-operators ()
122 (if (riece-region-active-p)
124 (riece-scan-property-region
126 (region-beginning) (region-end)
128 (setq group (cons (get-text-property start 'riece-identity)
130 (setq group (list (get-text-property (point) 'riece-identity))))
131 (setq users (riece-with-server-buffer
132 (riece-identity-server riece-current-channel)
133 (riece-channel-get-users (riece-identity-prefix
134 riece-current-channel))))
139 (unless (memq ?o (cdr (riece-identity-assoc
140 (riece-identity-prefix identity)
145 (riece-command-set-operators (mapcar #'riece-identity-prefix group)))))
147 (defun riece-user-button-set-speakers ()
150 (if (riece-region-active-p)
152 (riece-scan-property-region
154 (region-beginning) (region-end)
156 (setq group (cons (get-text-property start 'riece-identity)
158 (setq group (list (get-text-property (point) 'riece-identity))))
159 (setq users (riece-with-server-buffer
160 (riece-identity-server riece-current-channel)
161 (riece-channel-get-users (riece-identity-prefix
162 riece-current-channel))))
167 (unless (memq ?v (cdr (riece-identity-assoc
168 (riece-identity-prefix identity)
173 (riece-command-set-speakers (mapcar #'riece-identity-prefix group)))))
175 (defun riece-user-button-finger ()
177 (riece-command-finger (get-text-property (point) 'riece-identity)))
179 (defun riece-make-identity-button-map ()
180 (let ((map (make-sparse-keymap)))
181 (set-keymap-parent map (current-local-map))
182 (define-key map [down-mouse-3] 'riece-identity-button-popup-menu)
185 (defvar riece-identity-button-map)
186 (defun riece-button-add-identity-button (start end)
187 (if riece-button-enabled
188 (riece-scan-property-region
192 (let ((inhibit-read-only t)
194 (widget-convert-button 'riece-identity-button start end
195 (get-text-property start 'riece-identity))
198 (list 'local-map riece-identity-button-map
199 'keymap riece-identity-button-map)))))))
201 (defun riece-button-update-buffer ()
202 (riece-button-add-identity-button (point-min) (point-max)))
204 (defvar riece-channel-list-mode-map)
205 (defvar riece-user-list-mode-map)
206 (defvar riece-dialogue-mode-map)
207 (defun riece-button-insinuate ()
208 (add-hook 'riece-channel-list-mode-hook
210 (set-keymap-parent riece-channel-list-mode-map widget-keymap)
211 (set (make-local-variable 'riece-identity-button-map)
212 (riece-make-identity-button-map))
213 (add-hook 'riece-update-buffer-functions
214 'riece-button-update-buffer t t)))
215 (add-hook 'riece-user-list-mode-hook
217 (set-keymap-parent riece-user-list-mode-map widget-keymap)
218 (set (make-local-variable 'riece-identity-button-map)
219 (riece-make-identity-button-map))
220 (add-hook 'riece-update-buffer-functions
221 'riece-button-update-buffer t t)))
222 (add-hook 'riece-dialogue-mode-hook
224 (set-keymap-parent riece-dialogue-mode-map widget-keymap)
225 (set (make-local-variable 'riece-identity-button-map)
226 (riece-make-identity-button-map))))
227 (add-hook 'riece-after-insert-functions 'riece-button-add-identity-button))
229 (defun riece-button-enable ()
230 (setq riece-button-enabled t)
231 (let ((pointer riece-buffer-list))
233 (with-current-buffer (car pointer)
234 (if (eq (derived-mode-class major-mode)
235 'riece-dialogue-mode)
236 (riece-button-update-buffer)))
237 (setq pointer (cdr pointer)))
238 (if riece-current-channel
239 (riece-emit-signal 'user-list-changed riece-current-channel))
240 (riece-emit-signal 'channel-list-changed)))
242 (defun riece-button-disable ()
243 (setq riece-button-enabled nil)
245 (let ((pointer riece-buffer-list))
247 ;; On XEmacs, BUFFER arg of widget-map-buttons is ignored.
248 (set-buffer (car pointer))
250 (lambda (widget maparg)
251 (widget-leave-text widget)))
252 (setq pointer (cdr pointer))))))
254 (provide 'riece-button)
256 ;;; riece-button.el ends here