X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-button.el;h=a3b915c6d1c087003152747fbdfd671534078a65;hp=4a2867cd9b97576c5b2427053dba94548c86b2e3;hb=32f0d2d03f51102e8577ce8a603264839936c04f;hpb=25f675dd30aeec0d4f6450905f15023cb05e92ff diff --git a/lisp/riece-button.el b/lisp/riece-button.el index 4a2867c..a3b915c 100644 --- a/lisp/riece-button.el +++ b/lisp/riece-button.el @@ -43,12 +43,17 @@ (defconst riece-user-button-popup-menu '("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] - ["Finger (WHOIS)" riece-user-button-finger]) + ["Allow To Speak" riece-user-button-set-speakers]) "Menu for user buttons.") +(defvar riece-button-enabled nil) + +(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." @@ -65,8 +70,8 @@ ;; window, overlay, position. (riece-format-identity (if overlay - (with-current-buffer (overlay-buffer overlay) - (widget-value (widget-at (overlay-start overlay)))) + (with-current-buffer (riece-overlay-buffer overlay) + (widget-value (widget-at (riece-overlay-start overlay)))) (widget-value widget/window)))))) (defun riece-button-switch-to-identity (widget &optional event) @@ -113,75 +118,63 @@ 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-button-map-identity-region + (riece-scan-property-region + 'riece-identity (region-beginning) (region-end) (lambda (start end) (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-button-map-identity-region + (riece-scan-property-region + 'riece-identity (region-beginning) (region-end) (lambda (start end) (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))))) (defun riece-user-button-finger () (interactive) - (riece-command-finger - (riece-identity-prefix (get-text-property (point) 'riece-identity)))) + (riece-command-finger (get-text-property (point) 'riece-identity))) (defun riece-make-identity-button-map () (let ((map (make-sparse-keymap))) @@ -189,68 +182,43 @@ This function is used as a callback for a channel button." (define-key map [down-mouse-3] 'riece-identity-button-popup-menu) map)) -(defun riece-button-map-identity-region (start end function) - (catch 'done - (while t - ;; Search for the beginning of the button region. - (unless (get-text-property start 'riece-identity) - (setq start (next-single-property-change start 'riece-identity - nil end))) - (if (= start end) - (throw 'done nil)) - ;; Search for the end of the button region. - (let* ((identity (get-text-property start 'riece-identity)) - (button-end (next-single-property-change start 'riece-identity - nil end))) - (if (= button-end end) - (throw 'done nil)) - (funcall function start button-end) - (setq start button-end))))) - (defvar riece-identity-button-map) (defun riece-button-add-identity-button (start end) - (riece-button-map-identity-region - 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 riece-button-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-channel-list-buffer () - (save-excursion - (set-buffer riece-channel-list-buffer) - (riece-button-add-identity-button (point-min) (point-max)))) - -(defun riece-button-update-user-list-buffer () - (save-excursion - (set-buffer riece-user-list-buffer) - (riece-button-add-identity-button (point-min) (point-max)))) - -(defun riece-button-requires () - '(riece-highlight)) +(defun riece-button-update-buffer () + (riece-button-add-identity-button (point-min) (point-max))) (defvar riece-channel-list-mode-map) (defvar riece-user-list-mode-map) (defvar riece-dialogue-mode-map) (defun riece-button-insinuate () - (add-hook 'riece-update-buffer-functions - 'riece-button-update-channel-list-buffer t) - (add-hook 'riece-update-buffer-functions - 'riece-button-update-user-list-buffer t) (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)))) + (riece-make-identity-button-map)) + (add-hook 'riece-update-buffer-functions + 'riece-button-update-buffer t t))) (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)))) + (riece-make-identity-button-map)) + (add-hook 'riece-update-buffer-functions + 'riece-button-update-buffer t t))) (add-hook 'riece-dialogue-mode-hook (lambda () (set-keymap-parent riece-dialogue-mode-map widget-keymap) @@ -258,6 +226,31 @@ This function is used as a callback for a channel button." (riece-make-identity-button-map)))) (add-hook 'riece-after-insert-functions 'riece-button-add-identity-button)) +(defun riece-button-enable () + (setq riece-button-enabled t) + (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 () + (setq riece-button-enabled nil) + (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