From b6af7ad77431b8ce0c66b1ca9eaf04fd7d966fa4 Mon Sep 17 00:00:00 2001 From: ueno Date: Mon, 13 Oct 2003 07:56:26 +0000 Subject: [PATCH] * 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. --- lisp/ChangeLog | 21 +++++++++++++++++++++ lisp/riece-button.el | 46 +++++++++++++++++++++++++++++++++++++++++++--- lisp/riece-commands.el | 2 +- lisp/riece-emacs.el | 33 +++++++++++++++++++++++++++++++++ lisp/riece-xemacs.el | 16 ++++++++++++++++ lisp/riece.el | 1 - 6 files changed, 114 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4590d95..cf4203b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,26 @@ 2003-10-13 Daiki Ueno + * 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 + * riece-button.el (riece-button-insinuate): Buttonize channel buffers. * riece-history.el (riece-channel-list-history-face): New face. diff --git a/lisp/riece-button.el b/lisp/riece-button.el index fcf3026..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,12 +62,39 @@ (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 @@ -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 () diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el index 55c0f23..bdfcc68 100644 --- 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))) - (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? ")) diff --git a/lisp/riece-emacs.el b/lisp/riece-emacs.el index e46f8c5..0addfbd 100644 --- a/lisp/riece-emacs.el +++ b/lisp/riece-emacs.el @@ -27,6 +27,39 @@ (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 diff --git a/lisp/riece-xemacs.el b/lisp/riece-xemacs.el index ff3eba3..9a5cc6a 100644 --- 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) +;;; 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 diff --git a/lisp/riece.el b/lisp/riece.el index 0e67411..40353b9 100644 --- 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 - "m" riece-dialogue-enter-message "M" riece-command-change-mode "n" riece-command-change-nickname "\C-n" riece-command-names -- 1.7.10.4