* riece-history.el (riece-history-insinuate): In

riece-after-switch-to-channel-functions, check whether the last
channel is nil.

* riece-xemacs.el (riece-event-buffer): New alias.
(riece-event-point): New alias.

* riece-emacs.el (riece-event-buffer): New function.
(riece-event-point): New function.

* riece-display.el (riece-update-user-list-buffer): Use
riece-format-identity to add 'riece-identity property to user
names.

* riece-button.el (riece-user-button-popup-menu): New variable.
(riece-identity-button): Rename from riece-channel-button.
(riece-button-switch-to-identity): Rename from
riece-channel-button-action.
(riece-identity-button-popup-menu): Rename from
riece-channel-button-popup-menu; set point to the position the
event occurred.
(riece-user-button-join-partner): New function.
(riece-user-button-set-operators): New function.
(riece-user-button-set-speakers): New function.
(riece-user-button-finger): New function.
(riece-make-identity-button-map): New function.
(riece-button-map-identity-region): New function; splitted from
riece-button-add-identity-button.
(riece-button-add-identity-button): Use it.
(riece-button-update-user-list-buffer): New function.
(riece-button-insinuate): Add riece-button-update-user-list-buffer
to riece-update-buffer-functions.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cf4203b..55c7bd1 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,40 @@
 2003-10-13  Daiki Ueno  <ueno@unixuser.org>
 
+       * riece-history.el (riece-history-insinuate): In
+       riece-after-switch-to-channel-functions, check whether the last
+       channel is nil.
+
+       * riece-xemacs.el (riece-event-buffer): New alias.
+       (riece-event-point): New alias.
+
+       * riece-emacs.el (riece-event-buffer): New function.
+       (riece-event-point): New function.
+
+       * riece-display.el (riece-update-user-list-buffer): Use
+       riece-format-identity to add 'riece-identity property to user
+       names.
+
+       * riece-button.el (riece-user-button-popup-menu): New variable.
+       (riece-identity-button): Rename from riece-channel-button.
+       (riece-button-switch-to-identity): Rename from
+       riece-channel-button-action.
+       (riece-identity-button-popup-menu): Rename from
+       riece-channel-button-popup-menu; set point to the position the
+       event occurred.
+       (riece-user-button-join-partner): New function.
+       (riece-user-button-set-operators): New function.
+       (riece-user-button-set-speakers): New function.
+       (riece-user-button-finger): New function.
+       (riece-make-identity-button-map): New function.
+       (riece-button-map-identity-region): New function; splitted from
+       riece-button-add-identity-button.
+       (riece-button-add-identity-button): Use it.
+       (riece-button-update-user-list-buffer): New function.
+       (riece-button-insinuate): Add riece-button-update-user-list-buffer
+       to riece-update-buffer-functions.
+
+2003-10-13  Daiki Ueno  <ueno@unixuser.org>
+
        * riece-xemacs.el (riece-mouse-2): New variable.
        (riece-popup-menu-popup): New function.
 

diff --git a/lisp/riece-button.el b/lisp/riece-button.el
index b024dd6..4a2867c 100644 (file)
--- a/lisp/riece-button.el
+++ b/lisp/riece-button.el
@@ -36,15 +36,23 @@
 
 (defconst riece-channel-button-popup-menu
   '("Channel"
-    ["Switch" riece-channel-button-switch-to-channel]
-    ["Part" riece-channel-button-part]
-    ["List" riece-channel-button-list])
-  "Menu for channel buttons")
+    ["Switch To Channel" riece-channel-button-switch-to-channel]
+    ["Part Channel" riece-channel-button-part]
+    ["List Channel" riece-channel-button-list])
+  "Menu for channel buttons.")
+
+(defconst riece-user-button-popup-menu
+  '("User"
+    ["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])
+  "Menu for user buttons.")
 
 (defvar help-echo-owns-message)
-(define-widget 'riece-channel-button 'push-button
+(define-widget 'riece-identity-button 'push-button
   "A channel button."
-  :action 'riece-channel-button-action
+  :action 'riece-button-switch-to-identity
   :help-echo
   (lambda (widget/window &optional overlay pos)
     ;; Needed to properly clear the message due to a bug in
@@ -61,18 +69,27 @@
                   (widget-value (widget-at (overlay-start overlay))))
               (widget-value widget/window))))))
 
-(defun riece-channel-button-action (widget &optional event)
-  "Callback for channel buttons."
+(defun riece-button-switch-to-identity (widget &optional event)
+  "Switch to identity stored in WIDGET.
+This function is used as a callback for a channel button."
   (let ((channel (widget-value widget)))
     (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")))))
 
-(defun riece-channel-button-popup-menu (event)
-  "Popup the menu for channel buttons."
+(defun riece-identity-button-popup-menu (event)
+  "Popup the menu for identity buttons."
   (interactive "@e")
-  (riece-popup-menu-popup riece-channel-button-popup-menu event))
+  (save-excursion
+    (set-buffer (riece-event-buffer event))
+    (goto-char (riece-event-point event))
+    (riece-popup-menu-popup
+     (if (riece-channel-p (riece-identity-prefix
+                          (get-text-property (point) 'riece-identity)))
+        riece-channel-button-popup-menu
+       riece-user-button-popup-menu)
+     event)))
 
 (defun riece-channel-button-switch-to-channel ()
   (interactive)
@@ -89,57 +106,157 @@
   (riece-command-list
    (riece-identity-prefix (get-text-property (point) 'riece-identity))))
 
-(defvar riece-channel-button-map
+(defun riece-user-button-join-partner ()
+  (interactive)
+  (riece-command-join-partner
+   (get-text-property (point) 'riece-identity)))
+
+(defun riece-user-button-set-operators ()
+  (interactive)
+  (let (group)
+    (if (riece-region-active-p)
+       (save-excursion
+         (riece-button-map-identity-region
+          (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))))
+    (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)))
+                    group)))
+       (riece-command-set-operators (mapcar #'riece-identity-prefix group)))))
+
+(defun riece-user-button-set-speakers ()
+  (interactive)
+  (let (group)
+    (if (riece-region-active-p)
+       (save-excursion
+         (riece-button-map-identity-region
+          (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))))
+    (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)))
+                    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))))
+
+(defun riece-make-identity-button-map ()
   (let ((map (make-sparse-keymap)))
-    (set-keymap-parent map riece-channel-list-mode-map)
-    (define-key map [down-mouse-3] 'riece-channel-button-popup-menu)
+    (set-keymap-parent map (current-local-map))
+    (define-key map [down-mouse-3] 'riece-identity-button-popup-menu)
     map))
 
-(defun riece-button-add-channel-buttons (start end)
-  (save-excursion
-    (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)))
-       ;; 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)
-           (if (riece-channel-p (riece-identity-prefix identity))
-               (progn
-                 (widget-convert-button 'riece-channel-button start
-                                        button-end identity)
-                 (add-text-properties
-                  start button-end
-                  (list 'local-map riece-channel-button-map
-                        'keymap riece-channel-button-map))))
-           (setq start button-end)))))))
+(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))))))
 
 (defun riece-button-update-channel-list-buffer ()
-  (if riece-channel-list-buffer-mode
-      (save-excursion
-       (set-buffer riece-channel-list-buffer)
-       (let ((inhibit-read-only t)
-             buffer-read-only)
-         (riece-button-add-channel-buttons (point-min) (point-max))))))
+  (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))
 
+(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)
-             (add-hook 'riece-update-buffer-functions
-                       'riece-button-update-channel-list-buffer t)))
+             (set (make-local-variable 'riece-identity-button-map)
+                  (riece-make-identity-button-map))))
+  (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-dialogue-mode-hook
            (lambda ()
-             (set-keymap-parent riece-dialogue-mode-map widget-keymap)))
-  (add-hook 'riece-after-insert-functions 'riece-button-add-channel-buttons))
+             (set-keymap-parent riece-dialogue-mode-map widget-keymap)
+             (set (make-local-variable 'riece-identity-button-map)
+                  (riece-make-identity-button-map))))
+  (add-hook 'riece-after-insert-functions 'riece-button-add-identity-button))
 
 (provide 'riece-button)
 

diff --git a/lisp/riece-display.el b/lisp/riece-display.el
index 288b46c..f739af4 100644 (file)
--- a/lisp/riece-display.el
+++ b/lisp/riece-display.el
@@ -59,11 +59,17 @@
              buffer-read-only)
          (erase-buffer)
          (while users
-           (if (member (car users) operators)
-               (insert "@" (car users) "\n")
-             (if (member (car users) speakers)
-                 (insert "+" (car users) "\n")
-               (insert " " (car users) "\n")))
+           (insert (if (member (car users) operators)
+                       "@"
+                     (if (member (car users) speakers)
+                         "+"
+                       " "))
+                   (riece-format-identity
+                    (riece-make-identity (car users)
+                                         (riece-identity-server
+                                          riece-current-channel))
+                    t)
+                   "\n")
            (setq users (cdr users))))))))
 
 (defun riece-update-channel-list-buffer ()

diff --git a/lisp/riece-emacs.el b/lisp/riece-emacs.el
index 0addfbd..8d0de2e 100644 (file)
--- a/lisp/riece-emacs.el
+++ b/lisp/riece-emacs.el
@@ -28,7 +28,6 @@
   'set-case-syntax-pair)
 
 ;;; stolen (and renamed) from gnus-ems.el.
-
 ;;; In GNU Emacs, user can intercept whole mouse tracking events by
 ;;; assigning [mouse-X].  In XEmacs, however, which causes different
 ;;; effect, that is, the command assigned to [mouse-X] only catches
@@ -53,12 +52,25 @@
           function)))))
 
 (defun riece-popup-menu-popup (menu event)
-  (let ((function (riece-popup-menu-bogus-filter-constructor menu))
-       (pos (event-start event)))
-    (when (symbolp function)
-      (select-window (posn-window pos))
-      (goto-char (posn-point pos))
-      (funcall function))))
+  (let ((function (riece-popup-menu-bogus-filter-constructor menu)))
+    (if function
+       (funcall function))))
+
+(defun riece-event-buffer (event)
+  "Return the buffer of the window over which mouse event EVENT occurred."
+  (window-buffer (posn-window (event-start event))))
+
+(defun riece-event-point (event)
+  "Return the character position of the mouse event EVENT."
+  (posn-point (event-start event)))
+
+;;; stolen (and renamed) from gnus-ems.el.
+(defun riece-region-active-p ()
+  "Say whether the region is active."
+  (and (boundp 'transient-mark-mode)
+       transient-mark-mode
+       (boundp 'mark-active)
+       mark-active))
 
 (provide 'riece-emacs)
 

diff --git a/lisp/riece-history.el b/lisp/riece-history.el
index e49b356..d46d4dc 100644 (file)
--- a/lisp/riece-history.el
+++ b/lisp/riece-history.el
@@ -89,8 +89,9 @@
              (setq riece-channel-history nil)))
   (add-hook 'riece-after-switch-to-channel-functions
            (lambda (last)
-             (unless (riece-identity-equal last riece-current-channel)
-               (ring-insert riece-channel-history last))))
+             (if (and last
+                      (not (riece-identity-equal last riece-current-channel)))
+                 (ring-insert riece-channel-history last))))
   (add-hook 'riece-format-channel-list-line-functions
            'riece-history-format-channel-list-line)
   (if (memq 'riece-highlight riece-addons)

diff --git a/lisp/riece-xemacs.el b/lisp/riece-xemacs.el
index 9a5cc6a..f884117 100644 (file)
--- a/lisp/riece-xemacs.el
+++ b/lisp/riece-xemacs.el
@@ -71,8 +71,7 @@ Modify whole identification by side effect."
 (defalias 'riece-set-case-syntax-pair
   'put-case-table-pair)
 
-;;; stolen (and renamed) from gnus-ems.el.
-
+;;; stolen (and renamed) from gnus-xmas.el.
 ;;; In GNU Emacs, user can intercept whole mouse tracking events by
 ;;; assigning [mouse-X].  In XEmacs, however, which causes different
 ;;; effect, that is, the command assigned to [mouse-X] only catches
@@ -83,9 +82,14 @@ Modify whole identification by side effect."
 ;;; semi-def.el.
 (defun riece-popup-menu-popup (menu event)
   (let ((response (get-popup-menu-response menu event)))
-    (set-buffer (event-buffer event))
-    (goto-char (event-point event))
-    (funcall (event-function response) (event-object response))))
+    (if response
+       (funcall (event-function response) (event-object response)))))
+
+(defalias 'riece-event-buffer 'event-buffer)
+(defalias 'riece-event-point 'event-point)
+
+;;; stolen (and renamed) from gnus-xmas.el.
+(defalias 'riece-region-active-p 'region-active-p)
 
 (provide 'riece-xemacs)