1 ;;; riece-button.el --- display useful buttons in IRC buffers -*- lexical-binding: t -*-
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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 ;; NOTE: This is an add-on module for Riece.
31 (require 'riece-commands)
32 (require 'riece-identity)
36 (defconst riece-channel-button-popup-menu
38 ["Switch To Channel" riece-channel-button-switch-to-channel]
39 ["Part Channel" riece-channel-button-part]
40 ["List Channel" riece-channel-button-list])
41 "Menu for channel buttons.")
43 (defconst riece-user-button-popup-menu
45 ["Finger (WHOIS)" riece-user-button-finger]
46 ["Start Private Conversation" riece-user-button-join-partner]
47 ["Set +o" riece-user-button-set-operators]
48 ["Set +v" riece-user-button-set-speakers])
49 "Menu for user buttons.")
51 (defconst riece-button-description
52 "Display useful buttons in IRC buffers.")
54 (defvar help-echo-owns-message)
55 (define-widget 'riece-identity-button 'push-button
57 :action 'riece-button-switch-to-identity
59 (lambda (widget/window &optional overlay _pos)
60 ;; Needed to properly clear the message due to a bug in
61 ;; wid-edit (XEmacs only).
62 (if (boundp 'help-echo-owns-message)
63 (setq help-echo-owns-message t))
64 (format (riece-mcat "%S: switch to %s; down-mouse-3: more options")
65 (aref riece-mouse-2 0)
66 ;; XEmacs will get a single widget arg; Emacs 21 will get
67 ;; window, overlay, position.
68 (riece-format-identity
70 (with-current-buffer (riece-overlay-buffer overlay)
71 (widget-value (widget-at (riece-overlay-start overlay))))
72 (widget-value widget/window))))))
74 (defun riece-button-switch-to-identity (widget &optional _event)
75 "Switch to identity stored in WIDGET.
76 This function is used as a callback for a channel button."
77 (let ((channel (widget-value widget)))
78 (if (riece-identity-member channel riece-current-channels)
79 (riece-command-switch-to-channel channel)
80 (message "%s" (substitute-command-keys
82 "Type \\[riece-command-join] to join the channel"))))))
84 (defun riece-identity-button-click (event)
85 "Call widget-button-click and select the last selected window."
86 (interactive "e") ;widget-button-click has
87 ;interactive spec "@e"
88 (let ((buffer (current-buffer))
92 (with-current-buffer (riece-event-buffer event)
93 (goto-char (riece-event-point event))
94 (widget-button-click event))
95 ;; riece-button-switch-to-identity changes window-configuration
96 ;; so we must select the last selected window by _buffer_.
97 (if (setq window (get-buffer-window buffer))
99 (select-window window)
100 (set-window-point window point))
102 (riece-debug (format "buffer %s not visible"
103 (buffer-name buffer))))))))
105 (defun riece-identity-button-popup-menu (event)
106 "Popup the menu for identity buttons."
108 (with-current-buffer (riece-event-buffer event)
109 (goto-char (riece-event-point event))
110 (riece-popup-menu-popup
111 (if (riece-channel-p (riece-identity-prefix
112 (get-text-property (point) 'riece-identity)))
113 riece-channel-button-popup-menu
114 riece-user-button-popup-menu)
117 (defun riece-channel-button-switch-to-channel ()
119 (riece-command-switch-to-channel
120 (get-text-property (point) 'riece-identity)))
122 (defun riece-channel-button-part ()
125 (get-text-property (point) 'riece-identity)))
127 (defun riece-channel-button-list ()
130 (riece-identity-prefix (get-text-property (point) 'riece-identity))))
132 (defun riece-user-button-join-partner ()
134 (riece-command-join-partner
135 (get-text-property (point) 'riece-identity)))
137 (defun riece-user-button-set-operators ()
140 (if (riece-region-active-p)
142 (riece-scan-property-region
144 (region-beginning) (region-end)
146 (setq group (cons (get-text-property start 'riece-identity)
148 (setq group (list (get-text-property (point) 'riece-identity))))
149 (setq users (riece-with-server-buffer
150 (riece-identity-server riece-current-channel)
151 (riece-channel-get-users (riece-identity-prefix
152 riece-current-channel))))
157 (unless (memq ?o (cdr (riece-identity-assoc
158 (riece-identity-prefix identity)
163 (riece-command-set-operators (mapcar #'riece-identity-prefix group)))))
165 (defun riece-user-button-set-speakers ()
168 (if (riece-region-active-p)
170 (riece-scan-property-region
172 (region-beginning) (region-end)
174 (setq group (cons (get-text-property start 'riece-identity)
176 (setq group (list (get-text-property (point) 'riece-identity))))
177 (setq users (riece-with-server-buffer
178 (riece-identity-server riece-current-channel)
179 (riece-channel-get-users (riece-identity-prefix
180 riece-current-channel))))
185 (unless (memq ?v (cdr (riece-identity-assoc
186 (riece-identity-prefix identity)
191 (riece-command-set-speakers (mapcar #'riece-identity-prefix group)))))
193 (defun riece-user-button-finger ()
195 (riece-command-finger (get-text-property (point) 'riece-identity)))
197 (defun riece-make-identity-button-map ()
198 (let ((map (make-sparse-keymap)))
199 (set-keymap-parent map (current-local-map))
200 (define-key map [down-mouse-2] 'riece-identity-button-click)
201 (define-key map [down-mouse-3] 'riece-identity-button-popup-menu)
204 (defvar riece-identity-button-map)
205 (defun riece-button-add-identity-button (start end)
206 (if (get 'riece-button 'riece-addon-enabled)
207 (riece-scan-property-region
211 (let ((inhibit-read-only t)
213 (widget-convert-button 'riece-identity-button start end
214 (get-text-property start 'riece-identity))
217 (list 'local-map riece-identity-button-map
218 'keymap riece-identity-button-map)))))))
220 (defun riece-button-update-buffer ()
221 (riece-button-add-identity-button (point-min) (point-max)))
223 (defvar riece-channel-list-mode-map)
224 (defvar riece-user-list-mode-map)
225 (defvar riece-dialogue-mode-map)
227 (defun riece-button-channel-list-mode-hook ()
228 (set-keymap-parent riece-channel-list-mode-map widget-keymap)
229 (set (make-local-variable 'riece-identity-button-map)
230 (riece-make-identity-button-map))
231 (add-hook 'riece-update-buffer-functions
232 'riece-button-update-buffer t t))
234 (defun riece-button-user-list-mode-hook ()
235 (set-keymap-parent riece-user-list-mode-map widget-keymap)
236 (set (make-local-variable 'riece-identity-button-map)
237 (riece-make-identity-button-map))
238 (add-hook 'riece-update-buffer-functions
239 'riece-button-update-buffer t t))
241 (defun riece-button-dialogue-mode-hook ()
242 (set-keymap-parent riece-dialogue-mode-map widget-keymap)
243 (set (make-local-variable 'riece-identity-button-map)
244 (riece-make-identity-button-map)))
246 (defun riece-button-insinuate ()
248 (when riece-channel-list-buffer
249 (set-buffer riece-channel-list-buffer)
250 (riece-button-channel-list-mode-hook))
251 (when riece-user-list-buffer
252 (set-buffer riece-user-list-buffer)
253 (riece-button-user-list-mode-hook))
254 (let ((buffers riece-buffer-list))
256 (set-buffer (car buffers))
257 (if (riece-derived-mode-p 'riece-dialogue-mode)
258 (riece-button-dialogue-mode-hook))
259 (setq buffers (cdr buffers)))))
260 (add-hook 'riece-channel-list-mode-hook
261 'riece-button-channel-list-mode-hook)
262 (add-hook 'riece-user-list-mode-hook
263 'riece-button-user-list-mode-hook)
264 (add-hook 'riece-dialogue-mode-hook
265 'riece-button-dialogue-mode-hook)
266 (add-hook 'riece-after-insert-functions 'riece-button-add-identity-button))
268 (defun riece-button-uninstall ()
269 (let ((buffers riece-buffer-list))
272 (set-buffer (car buffers))
273 (remove-hook 'riece-update-buffer-functions
274 'riece-button-update-buffer t)
275 (if (local-variable-p 'riece-identity-button-map
277 (kill-local-variable 'riece-identity-button-map))
278 (setq buffers (cdr buffers)))))
279 (remove-hook 'riece-channel-list-mode-hook
280 'riece-button-channel-list-mode-hook)
281 (remove-hook 'riece-user-list-mode-hook
282 'riece-button-user-list-mode-hook)
283 (remove-hook 'riece-dialogue-mode-hook
284 'riece-button-dialogue-mode-hook)
285 (remove-hook 'riece-after-insert-functions
286 'riece-button-add-identity-button))
288 (defun riece-button-enable ()
289 (let ((pointer riece-buffer-list))
291 (with-current-buffer (car pointer)
292 (if (riece-derived-mode-p 'riece-dialogue-mode)
293 (riece-button-update-buffer)))
294 (setq pointer (cdr pointer)))
295 (if riece-current-channel
296 (riece-emit-signal 'user-list-changed riece-current-channel))
297 (riece-emit-signal 'channel-list-changed)))
299 (defun riece-button-disable ()
301 (let ((pointer riece-buffer-list))
303 ;; On XEmacs, BUFFER arg of widget-map-buttons is ignored.
304 (set-buffer (car pointer))
306 (lambda (widget _maparg)
307 (widget-leave-text widget)))
308 (setq pointer (cdr pointer))))))
310 (provide 'riece-button)
312 ;;; riece-button.el ends here