X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-button.el;h=b024dd6d64b3f3df32daaaa0bb1ec59b00f381a7;hp=f65e7bf0ba55428023313ad63f1114d825ca33e1;hb=9f0f8e8f7c1fefd0ae6712872f9dcb78ae3ea11c;hpb=a86316a5d418673f99e35a21a59356b57a778a3d;ds=sidebyside

diff --git a/lisp/riece-button.el b/lisp/riece-button.el
index f65e7bf..b024dd6 100644
--- a/lisp/riece-button.el
+++ b/lisp/riece-button.el
@@ -34,6 +34,13 @@
 (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."
@@ -44,7 +51,8 @@
     ;; 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
@@ -54,13 +62,40 @@
 	       (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")))))
 
-(defun riece-button-add-channel-buttons (start end length)
+(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
       (while t
@@ -75,8 +110,13 @@
 	  (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 ()
@@ -85,7 +125,7 @@
 	(set-buffer riece-channel-list-buffer)
 	(let ((inhibit-read-only t)
 	      buffer-read-only)
-	  (riece-button-add-channel-buttons (point-min) (point-max) nil)))))
+	  (riece-button-add-channel-buttons (point-min) (point-max))))))
 
 (defun riece-button-requires ()
   '(riece-highlight))
@@ -95,7 +135,11 @@
 	    (lambda ()
 	      (set-keymap-parent riece-channel-list-mode-map widget-keymap)
 	      (add-hook 'riece-update-buffer-functions
-			'riece-button-update-channel-list-buffer t))))
+			'riece-button-update-channel-list-buffer t)))
+  (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))
 
 (provide 'riece-button)