(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-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.
* riece-history.el (riece-channel-list-history-face): New face.
(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."
;; 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
(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-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
(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 ()
(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? "))
(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
(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
"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
projects / elisp / riece.git / commitdiff