From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/17794 Path: main.gmane.org!not-for-mail From: Hrvoje Niksic Newsgroups: gmane.emacs.gnus.general Subject: Switching window for buttons Date: 12 Oct 1998 23:18:42 +0200 Sender: owner-ding@hpc.uh.edu Message-ID: NNTP-Posting-Host: coloc-standby.netfonds.no X-Trace: main.gmane.org 1035156430 2733 80.91.224.250 (20 Oct 2002 23:27:10 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sun, 20 Oct 2002 23:27:10 +0000 (UTC) Return-Path: Original-Received: from gizmo.hpc.uh.edu (gizmo.hpc.uh.edu [129.7.102.31]) by sclp3.sclp.com (8.8.5/8.8.5) with ESMTP id RAA25063 for ; Mon, 12 Oct 1998 17:19:43 -0400 (EDT) Original-Received: from sina.hpc.uh.edu (sina.hpc.uh.edu [129.7.3.5]) by gizmo.hpc.uh.edu (8.7.6/8.7.3) with ESMTP id PAF31611; Mon, 12 Oct 1998 15:50:29 -0500 Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Mon, 12 Oct 1998 16:19:24 -0500 (CDT) Original-Received: from sclp3.sclp.com (root@sclp3.sclp.com [209.195.19.139]) by sina.hpc.uh.edu (8.7.3/8.7.3) with ESMTP id QAA14732 for ; Mon, 12 Oct 1998 16:19:14 -0500 (CDT) Original-Received: from jagor.srce.hr (hniksic@jagor.srce.hr [161.53.2.130]) by sclp3.sclp.com (8.8.5/8.8.5) with ESMTP id RAA25047 for ; Mon, 12 Oct 1998 17:19:02 -0400 (EDT) Original-Received: (from hniksic@localhost) by jagor.srce.hr (8.9.0/8.9.0) id XAA03745; Mon, 12 Oct 1998 23:18:42 +0200 (MET DST) Original-To: XEmacs Patches , ding@gnus.org, wmperry@aventail.com X-Attribution: Hrvoje X-Face: &{dT~)Pu6V<0y?>3p$;@vh\`C7xB~A0T-J%Og)J,@-1%q6Q+, gs<-9M#&`I8cJp2b1{vPE|~+JE+gx;a7%BG{}nY^ehK1"q#rG O,Rn1A_Cy%t]V=Brv7h * wid-edit.el (widget-button-click): Don't switch window. --- lisp/wid-edit.el.orig Sun Aug 23 12:37:45 1998 +++ lisp/wid-edit.el Mon Oct 12 23:13:23 1998 @@ -1063,48 +1063,49 @@ (defun widget-button-click (event) "Invoke button below mouse pointer." - (interactive "@e") - (cond ((event-glyph event) - (widget-glyph-click event)) - ((widget-event-point event) - (let* ((pos (widget-event-point event)) - (button (get-char-property pos 'button))) - (if button - (let* ((extent (widget-get button :button-extent)) - (face (extent-property extent 'face)) - (mouse-face (extent-property extent 'mouse-face)) - (help-echo (extent-property extent 'help-echo))) - (unwind-protect - (progn - ;; Merge relevant faces, and make the result mouse-face. - (let ((merge `(widget-button-pressed-face ,mouse-face))) - (nconc merge (if (listp face) - face (list face))) - (setq merge (delete-if-not 'find-face merge)) - (set-extent-property extent 'mouse-face merge)) - (unless (widget-apply button :mouse-down-action event) - ;; Wait for button release. - (while (not (button-release-event-p - (setq event (next-event)))) - (dispatch-event event))) - ;; Disallow mouse-face and help-echo. - (set-extent-property extent 'mouse-face nil) - (set-extent-property extent 'help-echo nil) - (setq pos (widget-event-point event)) - (unless (eq (current-buffer) (extent-object extent)) - ;; Barf if dispatch-event tripped us by - ;; changing buffer. - (error "Buffer changed during mouse motion")) - ;; Do the associated action. - (when (and pos (extent-in-region-p extent pos pos)) - (widget-apply-action button event))) - ;; Unwinding: fully release the button. - (set-extent-property extent 'mouse-face mouse-face) - (set-extent-property extent 'help-echo help-echo))) - ;; This should not happen! - (error "`widget-button-click' called outside button")))) - (t - (message "You clicked somewhere weird")))) + (interactive "e") + (with-current-buffer (event-buffer event) + (cond ((event-glyph event) + (widget-glyph-click event)) + ((widget-event-point event) + (let* ((pos (widget-event-point event)) + (button (get-char-property pos 'button))) + (if button + (let* ((extent (widget-get button :button-extent)) + (face (extent-property extent 'face)) + (mouse-face (extent-property extent 'mouse-face)) + (help-echo (extent-property extent 'help-echo))) + (unwind-protect + (progn + ;; Merge relevant faces, and make the result mouse-face. + (let ((merge `(widget-button-pressed-face ,mouse-face))) + (nconc merge (if (listp face) + face (list face))) + (setq merge (delete-if-not 'find-face merge)) + (set-extent-property extent 'mouse-face merge)) + (unless (widget-apply button :mouse-down-action event) + ;; Wait for button release. + (while (not (button-release-event-p + (setq event (next-event)))) + (dispatch-event event))) + ;; Disallow mouse-face and help-echo. + (set-extent-property extent 'mouse-face nil) + (set-extent-property extent 'help-echo nil) + (setq pos (widget-event-point event)) + (unless (eq (current-buffer) (extent-object extent)) + ;; Barf if dispatch-event tripped us by + ;; changing buffer. + (error "Buffer changed during mouse motion")) + ;; Do the associated action. + (when (and pos (extent-in-region-p extent pos pos)) + (widget-apply-action button event))) + ;; Unwinding: fully release the button. + (set-extent-property extent 'mouse-face mouse-face) + (set-extent-property extent 'help-echo help-echo))) + ;; This should not happen! + (error "`widget-button-click' called outside button")))) + (t + (message "You clicked somewhere weird"))))) (defun widget-button1-click (event) "Invoke glyph below mouse pointer." -- Hrvoje Niksic | Student at FER Zagreb, Croatia --------------------------------+-------------------------------- You can only be young once, but you can be immature forever.