X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Friece-button.el;h=27e4a73e272fd717adb1adedc2af09d34bfdb1f4;hb=414534e6c105af7f5ba16cfe2499e437df15bc9b;hp=f75ac2fc32632a9f1984f6bfb55dc0910c9faebe;hpb=b846150f43ae9faeaa00d2c55be93e3c1b248092;p=elisp%2Friece.git diff --git a/lisp/riece-button.el b/lisp/riece-button.el index f75ac2f..27e4a73 100644 --- a/lisp/riece-button.el +++ b/lisp/riece-button.el @@ -1,4 +1,4 @@ -;;; riece-button.el --- adding buttons in channel buffers +;;; riece-button.el --- display useful buttons in IRC buffers ;; Copyright (C) 1998-2003 Daiki Ueno ;; Author: Daiki Ueno @@ -19,13 +19,12 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: -;; To use, add the following line to your ~/.riece/init.el: -;; (add-to-list 'riece-addons 'riece-button) +;; NOTE: This is an add-on module for Riece. ;;; Code: @@ -45,10 +44,13 @@ '("User" ["Finger (WHOIS)" riece-user-button-finger] ["Start Private Conversation" riece-user-button-join-partner] - ["Give Channel Operator Privileges" riece-user-button-set-operators] - ["Allow To Speak" riece-user-button-set-speakers]) + ["Set +o" riece-user-button-set-operators] + ["Set +v" riece-user-button-set-speakers]) "Menu for user buttons.") +(defconst riece-button-description + "Display useful buttons in IRC buffers.") + (defvar help-echo-owns-message) (define-widget 'riece-identity-button 'push-button "A channel button." @@ -59,7 +61,7 @@ ;; wid-edit (XEmacs only). (if (boundp 'help-echo-owns-message) (setq help-echo-owns-message t)) - (format "%S: switch to %s; down-mouse-3: more options" + (format (riece-mcat "%S: switch to %s; down-mouse-3: more options") (aref riece-mouse-2 0) ;; XEmacs will get a single widget arg; Emacs 21 will get ;; window, overlay, position. @@ -76,11 +78,34 @@ This function is used as a callback for a channel button." (if (riece-identity-member channel riece-current-channels) (riece-command-switch-to-channel channel) (message "%s" (substitute-command-keys - "Type \\[riece-command-join] to join the channel"))))) + (riece-mcat + "Type \\[riece-command-join] to join the channel")))))) + +(defun riece-identity-button-click (event) + "Call widget-button-click and select the last selected window." + (interactive "e") ;widget-button-click has + ;interactive spec "@e" + (let ((buffer (current-buffer)) + (point (point)) + window) + (unwind-protect + (save-excursion + (set-buffer (riece-event-buffer event)) + (goto-char (riece-event-point event)) + (widget-button-click event)) + ;; riece-button-switch-to-identity changes window-configuration + ;; so we must select the last selected window by _buffer_. + (if (setq window (get-buffer-window buffer)) + (progn + (select-window window) + (set-window-point window point)) + (if riece-debug + (riece-debug (format "buffer %s not visible" + (buffer-name buffer)))))))) (defun riece-identity-button-popup-menu (event) "Popup the menu for identity buttons." - (interactive "@e") + (interactive "e") (save-excursion (set-buffer (riece-event-buffer event)) (goto-char (riece-event-point event)) @@ -113,7 +138,7 @@ This function is used as a callback for a channel button." (defun riece-user-button-set-operators () (interactive) - (let (group) + (let (group users) (if (riece-region-active-p) (save-excursion (riece-scan-property-region @@ -123,29 +148,25 @@ This function is used as a callback for a channel button." (setq group (cons (get-text-property start 'riece-identity) group))))) (setq group (list (get-text-property (point) 'riece-identity)))) + (setq users (riece-with-server-buffer + (riece-identity-server riece-current-channel) + (riece-channel-get-users (riece-identity-prefix + riece-current-channel)))) (if (setq group (delq nil (mapcar (lambda (identity) - (riece-with-server-buffer (riece-identity-server - riece-current-channel) - (if (and (member - (riece-identity-prefix identity) - (riece-channel-get-users - (riece-identity-prefix - riece-current-channel))) - (not (member - (riece-identity-prefix identity) - (riece-channel-get-operators - (riece-identity-prefix - riece-current-channel))))) - identity))) + (unless (memq ?o (cdr (riece-identity-assoc + (riece-identity-prefix identity) + users + t))) + identity)) group))) (riece-command-set-operators (mapcar #'riece-identity-prefix group))))) (defun riece-user-button-set-speakers () (interactive) - (let (group) + (let (group users) (if (riece-region-active-p) (save-excursion (riece-scan-property-region @@ -155,28 +176,19 @@ This function is used as a callback for a channel button." (setq group (cons (get-text-property start 'riece-identity) group))))) (setq group (list (get-text-property (point) 'riece-identity)))) + (setq users (riece-with-server-buffer + (riece-identity-server riece-current-channel) + (riece-channel-get-users (riece-identity-prefix + riece-current-channel)))) (if (setq group (delq nil (mapcar (lambda (identity) - (riece-with-server-buffer (riece-identity-server - riece-current-channel) - (if (and (member - (riece-identity-prefix identity) - (riece-channel-get-users - (riece-identity-prefix - riece-current-channel))) - (not (member - (riece-identity-prefix identity) - (riece-channel-get-operators - (riece-identity-prefix - riece-current-channel)))) - (not (member - (riece-identity-prefix identity) - (riece-channel-get-speakers - (riece-identity-prefix - riece-current-channel))))) - identity))) + (unless (memq ?v (cdr (riece-identity-assoc + (riece-identity-prefix identity) + users + t))) + identity)) group))) (riece-command-set-speakers (mapcar #'riece-identity-prefix group))))) @@ -187,54 +199,118 @@ This function is used as a callback for a channel button." (defun riece-make-identity-button-map () (let ((map (make-sparse-keymap))) (set-keymap-parent map (current-local-map)) + (define-key map [down-mouse-2] 'riece-identity-button-click) (define-key map [down-mouse-3] 'riece-identity-button-popup-menu) map)) (defvar riece-identity-button-map) (defun riece-button-add-identity-button (start end) - (riece-scan-property-region - 'riece-identity - start end - (lambda (start end) - (let ((inhibit-read-only t) - buffer-read-only) - (widget-convert-button 'riece-identity-button start end - (get-text-property start 'riece-identity)) - (add-text-properties start end - (list 'local-map riece-identity-button-map - 'keymap riece-identity-button-map)))))) + (if (get 'riece-button 'riece-addon-enabled) + (riece-scan-property-region + 'riece-identity + start end + (lambda (start end) + (let ((inhibit-read-only t) + buffer-read-only) + (widget-convert-button 'riece-identity-button start end + (get-text-property start 'riece-identity)) + (add-text-properties + start end + (list 'local-map riece-identity-button-map + 'keymap riece-identity-button-map))))))) (defun riece-button-update-buffer () (riece-button-add-identity-button (point-min) (point-max))) -(defun riece-button-requires () - '(riece-highlight)) - (defvar riece-channel-list-mode-map) (defvar riece-user-list-mode-map) (defvar riece-dialogue-mode-map) + +(defun riece-button-channel-list-mode-hook () + (set-keymap-parent riece-channel-list-mode-map widget-keymap) + (set (make-local-variable 'riece-identity-button-map) + (riece-make-identity-button-map)) + (add-hook 'riece-update-buffer-functions + 'riece-button-update-buffer t t)) + +(defun riece-button-user-list-mode-hook () + (set-keymap-parent riece-user-list-mode-map widget-keymap) + (set (make-local-variable 'riece-identity-button-map) + (riece-make-identity-button-map)) + (add-hook 'riece-update-buffer-functions + 'riece-button-update-buffer t t)) + +(defun riece-button-dialogue-mode-hook () + (set-keymap-parent riece-dialogue-mode-map widget-keymap) + (set (make-local-variable 'riece-identity-button-map) + (riece-make-identity-button-map))) + (defun riece-button-insinuate () + (save-excursion + (when riece-channel-list-buffer + (set-buffer riece-channel-list-buffer) + (riece-button-channel-list-mode-hook)) + (when riece-user-list-buffer + (set-buffer riece-user-list-buffer) + (riece-button-user-list-mode-hook)) + (let ((buffers riece-buffer-list)) + (while buffers + (set-buffer (car buffers)) + (if (eq (derived-mode-class major-mode) + 'riece-dialogue-mode) + (riece-button-dialogue-mode-hook)) + (setq buffers (cdr buffers))))) (add-hook 'riece-channel-list-mode-hook - (lambda () - (set-keymap-parent riece-channel-list-mode-map widget-keymap) - (set (make-local-variable 'riece-identity-button-map) - (riece-make-identity-button-map)) - (add-hook 'riece-update-buffer-functions - 'riece-button-update-buffer t t))) + 'riece-button-channel-list-mode-hook) (add-hook 'riece-user-list-mode-hook - (lambda () - (set-keymap-parent riece-user-list-mode-map widget-keymap) - (set (make-local-variable 'riece-identity-button-map) - (riece-make-identity-button-map)) - (add-hook 'riece-update-buffer-functions - 'riece-button-update-buffer t t))) + 'riece-button-user-list-mode-hook) (add-hook 'riece-dialogue-mode-hook - (lambda () - (set-keymap-parent riece-dialogue-mode-map widget-keymap) - (set (make-local-variable 'riece-identity-button-map) - (riece-make-identity-button-map)))) + 'riece-button-dialogue-mode-hook) (add-hook 'riece-after-insert-functions 'riece-button-add-identity-button)) +(defun riece-button-uninstall () + (let ((buffers riece-buffer-list)) + (save-excursion + (while buffers + (set-buffer (car buffers)) + (remove-hook 'riece-update-buffer-functions + 'riece-button-update-buffer t) + (if (local-variable-p 'riece-identity-button-map + (car buffers)) + (kill-local-variable 'riece-identity-button-map)) + (setq buffers (cdr buffers))))) + (remove-hook 'riece-channel-list-mode-hook + 'riece-button-channel-list-mode-hook) + (remove-hook 'riece-user-list-mode-hook + 'riece-button-user-list-mode-hook) + (remove-hook 'riece-dialogue-mode-hook + 'riece-button-dialogue-mode-hook) + (remove-hook 'riece-after-insert-functions + 'riece-button-add-identity-button)) + +(defun riece-button-enable () + (let ((pointer riece-buffer-list)) + (while pointer + (with-current-buffer (car pointer) + (if (eq (derived-mode-class major-mode) + 'riece-dialogue-mode) + (riece-button-update-buffer))) + (setq pointer (cdr pointer))) + (if riece-current-channel + (riece-emit-signal 'user-list-changed riece-current-channel)) + (riece-emit-signal 'channel-list-changed))) + +(defun riece-button-disable () + (save-excursion + (let ((pointer riece-buffer-list)) + (while pointer + ;; On XEmacs, BUFFER arg of widget-map-buttons is ignored. + (set-buffer (car pointer)) + (widget-map-buttons + (lambda (widget maparg) + (widget-leave-text widget))) + (setq pointer (cdr pointer)))))) + (provide 'riece-button) ;;; riece-button.el ends here