From: ueno Date: Mon, 13 Oct 2003 19:04:10 +0000 (+0000) Subject: * riece-history.el (riece-history-insinuate): In X-Git-Tag: riece-0_1_3~7 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=9436c85cb7acc3f4aeb5566722eaae326958b4a1;p=elisp%2Friece.git * 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 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,40 @@ 2003-10-13 Daiki Ueno + * 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 + * 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 --- 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 --- 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 --- 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 --- 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 --- 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)