xemacs-beta: lisp/mouse.el comparison

comparison lisp/mouse.el @ 286:57709be46d1b r21-0b41

Import from CVS: tag r21-0b41

author	cvs
date	Mon, 13 Aug 2007 10:35:03 +0200
parents	558f606b08ae
children	e11d67e05968

comparison

equal deleted inserted replaced

-:9a3756523c1b
+:57709be46d1b
 	     ;; always sufficient but it seems to give something
 	     ;; approaching a 99% success rate.  Making it higher yet
 	     ;; would help guarantee success with the price that the
 	     ;; delay would start to become noticable.
 	     ;;
-	     (sit-for 0.15 t)
+	     (and (eq (console-type) 'x)
+		  (sit-for 0.15 t))
 	     (zmacs-activate-region)))
-	  ((or (eq 'x (console-type))
+	  ((console-on-window-system-p)
-	       (eq 'mswindows (console-type)))
 	   (if (= start end)
 	       (disown-selection type)
 	     (if (consp default-mouse-track-extent)
 		 ;; own the rectangular region
 		 ;; this is a hack
 	;;
 	;; remove the existing selection to unclutter the display
 	(if (not adjust)
 	    (cond (zmacs-regions
 		   (zmacs-deactivate-region))
-		  ((eq 'x (console-type))
+		  ((console-on-window-system-p)
-		   (x-disown-selection)))))
+		   (disown-selection)))))
 (setq default-mouse-track-down-event nil))))
 (defun default-mouse-track-down-hook (event click-count)
 (setq default-mouse-track-down-event (copy-event event))
 nil)
 other mouse buttons."
 (interactive "e")
 (if (not (specifier-instance vertical-divider-draggable-p
 			       (event-window event)))
 (error "Not over a window!"))
-(letf* ((window (event-window event))
+(with-specifier-instance
-	  (frame (event-channel event))
+vertical-divider-shadow-thickness
-	  (last-timestamp (event-timestamp event))
+(- (specifier-instance vertical-divider-shadow-thickness
-	  (doit t)
+			     (event-window event)))
-	  ((specifier-instance vertical-divider-shadow-thickness window)
+(event-window event)
-	   (- (specifier-instance vertical-divider-shadow-thickness window))))
+(let* ((window (event-window event))
-(while doit
+	   (frame (event-channel event))
-(let ((old-right (caddr (window-pixel-edges window)))
+	   (last-timestamp (event-timestamp event))
-	    (old-left (car (window-pixel-edges window)))
+	   (doit t))
-	    (backup-conf (current-window-configuration frame))
+(while doit
-	    (old-edges-all-windows (mapcar 'window-pixel-edges (window-list))))
+	(let ((old-right (caddr (window-pixel-edges window)))
+	      (old-left (car (window-pixel-edges window)))
-	;; This is borrowed from modeline.el:
+	      (backup-conf (current-window-configuration frame))
-	;; requeue event and quit if this is a misc-user, eval or
+	      (old-edges-all-windows (mapcar 'window-pixel-edges (window-list))))
-	;;   keypress event.
-	;; quit if this is a button press or release event, or if the event
+	  ;; This is borrowed from modeline.el:
-	;;   occurred in some other frame.
+	  ;; requeue event and quit if this is a misc-user, eval or
-	;; drag if this is a mouse motion event and the time
+	  ;;   keypress event.
-	;;   between this event and the last event is greater than
+	  ;; quit if this is a button press or release event, or if the event
-	;;   drag-modeline-event-lag.
+	  ;;   occurred in some other frame.
-	;; do nothing if this is any other kind of event.
+	  ;; drag if this is a mouse motion event and the time
-	(setq event (next-event event))
+	  ;;   between this event and the last event is greater than
-	(cond ((or (misc-user-event-p event)
+	  ;;   drag-modeline-event-lag.
-		   (key-press-event-p event))
+	  ;; do nothing if this is any other kind of event.
-	       (setq unread-command-events (nconc unread-command-events
+	  (setq event (next-event event))
-						  (list event))
+	  (cond ((or (misc-user-event-p event)
-		     doit nil))
+		     (key-press-event-p event))
-	      ((button-release-event-p event)
+		 (setq unread-command-events (nconc unread-command-events
-	       (setq doit nil))
+						    (list event))
-	      ((button-event-p event)
+		       doit nil))
-	       (setq doit nil))
+		((button-release-event-p event)
-	      ((not (motion-event-p event))
+		 (setq doit nil))
-	       (dispatch-event event))
+		((button-event-p event)
-	      ((not (eq frame (event-frame event)))
+		 (setq doit nil))
-	       (setq doit nil))
+		((not (motion-event-p event))
-	      ((< (abs (- (event-timestamp event) last-timestamp))
+		 (dispatch-event event))
-		  drag-modeline-event-lag))
+		((not (eq frame (event-frame event)))
-	      (t
+		 (setq doit nil))
-	       (setq last-timestamp (event-timestamp event))
+		((< (abs (- (event-timestamp event) last-timestamp))
-	       ;; Enlarge the window, calculating change in characters
+		    drag-modeline-event-lag))
-	       ;; of default font. Do not let the window to become
+		(t
-	       ;; less than alolwed minimum (not because that's critical
+		 (setq last-timestamp (event-timestamp event))
-	       ;; for the code performance, just the visual effect is
+		 ;; Enlarge the window, calculating change in characters
-	       ;; better: when cursor goes to the left of the next left
+		 ;; of default font. Do not let the window to become
-	       ;; divider, the vindow being resized shrinks to minimal
+		 ;; less than alolwed minimum (not because that's critical
-	       ;; size.
+		 ;; for the code performance, just the visual effect is
-	       (enlarge-window (max (- window-min-width (window-width window))
+		 ;; better: when cursor goes to the left of the next left
-				    (/ (- (event-x-pixel event) old-right)
+		 ;; divider, the vindow being resized shrinks to minimal
-				       (face-width 'default window)))
+		 ;; size.
-			       t window)
+		 (enlarge-window (max (- window-min-width (window-width window))
-	       ;; Backout the change if some windows got deleted, or
+				      (/ (- (event-x-pixel event) old-right)
-	       ;; if the change caused more than two windows to resize
+					 (face-width 'default window)))
-	       ;; (shifting the whole stack right is ugly), or if the
+				 t window)
-	       ;; left window side has slipped (right side cannot be
+		 ;; Backout the change if some windows got deleted, or
-	       ;; moved any funrther to the right, so enlarge-window
+		 ;; if the change caused more than two windows to resize
-	       ;; plays bad games with the left edge.
+		 ;; (shifting the whole stack right is ugly), or if the
-	       (if (or (/= (count-windows) (length old-edges-all-windows))
+		 ;; left window side has slipped (right side cannot be
-		       (/= old-left (car (window-pixel-edges window)))
+		 ;; moved any funrther to the right, so enlarge-window
-		       ;; This check is very hairy. We allow any number
+		 ;; plays bad games with the left edge.
-		       ;; of left edges to change, but only to the same
+		 (if (or (/= (count-windows) (length old-edges-all-windows))
-		       ;; new value. Similar procedure is for the right edges.
+			 (/= old-left (car (window-pixel-edges window)))
-		       (let ((all-that-bad nil)
+			 ;; This check is very hairy. We allow any number
-			     (new-left-ok nil)
+			 ;; of left edges to change, but only to the same
-			     (new-right-ok nil))
+			 ;; new value. Similar procedure is for the right edges.
-			 (mapcar* (lambda (window old-edges)
+			 (let ((all-that-bad nil)
-				    (let ((new (car (window-pixel-edges window))))
+			       (new-left-ok nil)
-				      (if (/= new (car old-edges))
+			       (new-right-ok nil))
-					  (if (and new-left-ok
+			   (mapcar* (lambda (window old-edges)
-						   (/= new-left-ok new))
+				      (let ((new (car (window-pixel-edges window))))
-					      (setq all-that-bad t)
+					(if (/= new (car old-edges))
-					    (setq new-left-ok new)))))
+					    (if (and new-left-ok
-				  (window-list) old-edges-all-windows)
+						     (/= new-left-ok new))
-			 (mapcar* (lambda (window old-edges)
+						(setq all-that-bad t)
-				    (let ((new (caddr (window-pixel-edges window))))
+					      (setq new-left-ok new)))))
-				      (if (/= new (caddr old-edges))
+				    (window-list) old-edges-all-windows)
-					  (if (and new-right-ok
+			   (mapcar* (lambda (window old-edges)
-						   (/= new-right-ok new))
+				      (let ((new (caddr (window-pixel-edges window))))
-					      (setq all-that-bad t)
+					(if (/= new (caddr old-edges))
-					    (setq new-right-ok new)))))
+					    (if (and new-right-ok
-				  (window-list) old-edges-all-windows)
+						     (/= new-right-ok new))
-			 all-that-bad))
+						(setq all-that-bad t)
-		   (set-window-configuration backup-conf))))
+					      (setq new-right-ok new)))))
-	))))
+				    (window-list) old-edges-all-windows)
+			   all-that-bad))
+		     (set-window-configuration backup-conf))))
+	  )))))
 (setq vertical-divider-map (make-keymap))
 (define-key vertical-divider-map 'button1 'drag-window-divider)
 ;;; mouse.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/mouse.el @ 286:57709be46d1b r21-0b41