* riece-xemacs.el (riece-mouse-2): New variable.

(riece-popup-menu-popup): New function.

* riece-emacs.el (riece-mouse-2): New variable.
(riece-popup-menu-bogus-filter-constructor): New macro.
(riece-popup-menu-popup): New function.

* riece-commands.el (riece-command-list): Use identity prefix
instead of formatted identity.

* riece-button.el (riece-channel-button-popup-menu): New variable.
(riece-channel-button): Arrange help-echo.
(riece-channel-button-switch-to-channel): New function.
(riece-channel-button-part): New function.
(riece-channel-button-list): New function.
(riece-channel-button-map): New variable.
(riece-button-add-channel-buttons): Add 'local-map and 'keymap
properties on channel buttons.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4590d95..cf4203b 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,24 @@
+2003-10-13  Daiki Ueno  <ueno@unixuser.org>
+
+       * riece-xemacs.el (riece-mouse-2): New variable.
+       (riece-popup-menu-popup): New function.
+
+       * riece-emacs.el (riece-mouse-2): New variable.
+       (riece-popup-menu-bogus-filter-constructor): New macro.
+       (riece-popup-menu-popup): New function.
+
+       * riece-commands.el (riece-command-list): Use identity prefix
+       instead of formatted identity.
+
+       * riece-button.el (riece-channel-button-popup-menu): New variable.
+       (riece-channel-button): Arrange help-echo.
+       (riece-channel-button-switch-to-channel): New function.
+       (riece-channel-button-part): New function.
+       (riece-channel-button-list): New function.
+       (riece-channel-button-map): New variable.
+       (riece-button-add-channel-buttons): Add 'local-map and 'keymap
+       properties on channel buttons.
+

 2003-10-13  Daiki Ueno  <ueno@unixuser.org>
 
        * riece-button.el (riece-button-insinuate): Buttonize channel buffers.
 2003-10-13  Daiki Ueno  <ueno@unixuser.org>
 
        * riece-button.el (riece-button-insinuate): Buttonize channel buffers.

diff --git a/lisp/riece-button.el b/lisp/riece-button.el
index fcf3026..b024dd6 100644 (file)
--- a/lisp/riece-button.el
+++ b/lisp/riece-button.el
@@ -34,6 +34,13 @@
 (require 'riece-misc)
 (require 'wid-edit)
 
 (require 'riece-misc)
 (require 'wid-edit)
 

+(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")
+

 (defvar help-echo-owns-message)
 (define-widget 'riece-channel-button 'push-button
   "A channel button."
 (defvar help-echo-owns-message)
 (define-widget 'riece-channel-button 'push-button
   "A channel button."


@@ -44,7 +51,8 @@
     ;; wid-edit (XEmacs only).
     (if (boundp 'help-echo-owns-message)
        (setq help-echo-owns-message t))
     ;; wid-edit (XEmacs only).
     (if (boundp 'help-echo-owns-message)
        (setq help-echo-owns-message t))

-    (format "Switch to %s"
+    (format "%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.
            (riece-format-identity
            ;; XEmacs will get a single widget arg; Emacs 21 will get
            ;; window, overlay, position.
            (riece-format-identity


@@ -54,12 +62,39 @@
               (widget-value widget/window))))))
 
 (defun riece-channel-button-action (widget &optional event)
               (widget-value widget/window))))))
 
 (defun riece-channel-button-action (widget &optional event)

+  "Callback for channel buttons."

   (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")))))
 
   (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."
+  (interactive "@e")
+  (riece-popup-menu-popup riece-channel-button-popup-menu event))
+
+(defun riece-channel-button-switch-to-channel ()
+  (interactive)
+  (riece-command-switch-to-channel
+   (get-text-property (point) 'riece-identity)))
+
+(defun riece-channel-button-part ()
+  (interactive)
+  (riece-command-part
+   (get-text-property (point) 'riece-identity)))
+
+(defun riece-channel-button-list ()
+  (interactive)
+  (riece-command-list
+   (riece-identity-prefix (get-text-property (point) 'riece-identity))))
+
+(defvar riece-channel-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)
+    map))
+

 (defun riece-button-add-channel-buttons (start end)
   (save-excursion
     (catch 'done
 (defun riece-button-add-channel-buttons (start end)
   (save-excursion
     (catch 'done


@@ -75,8 +110,13 @@
          (if (= button-end end)
              (throw 'done nil)
            (if (riece-channel-p (riece-identity-prefix identity))
          (if (= button-end end)
              (throw 'done nil)
            (if (riece-channel-p (riece-identity-prefix identity))

-               (widget-convert-button
-                'riece-channel-button start button-end 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-update-channel-list-buffer ()
            (setq start button-end)))))))
 
 (defun riece-button-update-channel-list-buffer ()

diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el
index 55c0f23..bdfcc68 100644 (file)
--- a/lisp/riece-commands.el
+++ b/lisp/riece-commands.el
@@ -241,7 +241,7 @@ the layout to the selected layout-name."
            (if (and riece-current-channel
                     (riece-channel-p (riece-identity-prefix
                                       riece-current-channel)))
            (if (and riece-current-channel
                     (riece-channel-p (riece-identity-prefix
                                       riece-current-channel)))

-               (cons (riece-format-identity riece-current-channel t)
+               (cons (riece-identity-prefix riece-current-channel)

                      0))))))
   (if (or (not (equal pattern ""))
          (yes-or-no-p "Really want to query LIST without argument? "))
                      0))))))
   (if (or (not (equal pattern ""))
          (yes-or-no-p "Really want to query LIST without argument? "))

diff --git a/lisp/riece-emacs.el b/lisp/riece-emacs.el
index e46f8c5..0addfbd 100644 (file)
--- a/lisp/riece-emacs.el
+++ b/lisp/riece-emacs.el
@@ -27,6 +27,39 @@
 (defalias 'riece-set-case-syntax-pair
   'set-case-syntax-pair)
 
 (defalias 'riece-set-case-syntax-pair
   '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
+;;; button-release events.
+(defvar riece-mouse-2 [mouse-2])
+
+;;; popup-menu compatibility stuff, stolen (and renamed) from
+;;; semi-def.el.
+(defmacro riece-popup-menu-bogus-filter-constructor (menu)
+  ;; #### Kludge for FSF Emacs-style menu.
+  (let ((bogus-menu (make-symbol "bogus-menu")))
+    `(let (,bogus-menu selection function)
+       (easy-menu-define ,bogus-menu nil nil ,menu)
+       (setq selection (x-popup-menu t ,bogus-menu))
+       (when selection
+        (setq function (lookup-key ,bogus-menu (apply #'vector selection)))
+        ;; If a callback entry has no name, easy-menu wraps its value.
+        ;; See `easy-menu-make-symbol'.
+        (if (eq t (compare-strings "menu-function-" 0 nil
+                                   (symbol-name function) 0 14))
+            (car (last (symbol-function function)))
+          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))))
+

 (provide 'riece-emacs)
 
 ;;; riece-emacs.el ends here
 (provide 'riece-emacs)
 
 ;;; riece-emacs.el ends here

diff --git a/lisp/riece-xemacs.el b/lisp/riece-xemacs.el
index ff3eba3..9a5cc6a 100644 (file)
--- a/lisp/riece-xemacs.el
+++ b/lisp/riece-xemacs.el
@@ -71,6 +71,22 @@ Modify whole identification by side effect."
 (defalias 'riece-set-case-syntax-pair
   'put-case-table-pair)
 
 (defalias 'riece-set-case-syntax-pair
   'put-case-table-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
+;;; button-release events.
+(defvar riece-mouse-2 [button2])
+
+;;; popup-menu compatibility stuff, stolen (and renamed) from
+;;; 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))))
+

 (provide 'riece-xemacs)
 
 ;;; riece-xemacs.el ends here
 (provide 'riece-xemacs)
 
 ;;; riece-xemacs.el ends here

diff --git a/lisp/riece.el b/lisp/riece.el
index 0e67411..40353b9 100644 (file)
--- a/lisp/riece.el
+++ b/lisp/riece.el
@@ -147,7 +147,6 @@ If optional argument SAFE is nil, overwrite previous definitions."
     "j" riece-command-join
     "\C-k" riece-command-kick
     "l" riece-command-list
     "j" riece-command-join
     "\C-k" riece-command-kick
     "l" riece-command-list

-    "m" riece-dialogue-enter-message

     "M" riece-command-change-mode
     "n" riece-command-change-nickname
     "\C-n" riece-command-names
     "M" riece-command-change-mode
     "n" riece-command-change-nickname
     "\C-n" riece-command-names