unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Daniel Koning <dk@danielkoning.com>
To: martin rudalics <rudalics@gmx.at>
Cc: 6130@debbugs.gnu.org, busk <busk@lysator.liu.se>
Subject: bug#6130: 23.1; artist-mode spray-can malfunction
Date: Tue, 20 Jan 2015 18:26:27 -0600	[thread overview]
Message-ID: <m2d269kmh8.fsf@danielkoning.com> (raw)
In-Reply-To: <54BB8375.9000506@gmx.at> (martin rudalics's message of "Sun, 18 Jan 2015 10:57:09 +0100")

[-- Attachment #1: Type: text/plain, Size: 1252 bytes --]

martin rudalics <rudalics@gmx.at> writes:

>> I added a line to check for frames.
>
> No - this might be dangerous for now.  Suppose we have callers that
> relied on `posnp' to return nil in that case.  They would all of sudden
> have to deal with the fact that they get a frame now, so more or less we
> could reintroduce the problem you try to fix presently.  Please take
> this out for the moment but state in the doc-string that `posnp' returns
> nil if the first element of OBJ is a frame.  Later on we can change this
> as you did and see what happens.

Okay, but I think this should be a reasonably high priority for the
maintainers of this part of the lisp tree. Aren't there likely to be
quite a few undiscovered bugs, some perhaps quite destructive, that
result from following the behavior as it was documented, just as there
are (presumably) places where new bugs would manifest if `posnp' were
brought in line with its advertised behavior? In any case, I've appended
a FIXME comment in addition to revising the docstring.

I added the log entry to the highest-level ChangeLog file, since I
edited files in lisp/ and doc/ (even though the doc/ changes were only
in reference to functionality implemented under lisp/). Is that right?

Daniel

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Fix for #6130 --]
[-- Type: text/x-patch, Size: 9833 bytes --]

diff --git a/ChangeLog b/ChangeLog
index 309b04f..53d7bb4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2015-01-20  Daniel Koning  <dk@danielkoning.com>
+
+	Prevent artist-mode from creating runaway timers.
+	* lisp/textmodes/artist.el: Cancel timers if an error occurs
+	during continuous drawing.
+	* lisp/subr.el: Make `posn-col-row' work with all mouse position
+	objects. Correct docstring of `posnp'.
+	* doc/lispref/commands.texi: Describe actual range of values that
+	mouse position objects can have.
+	Fixes: bug#6130
+
 2015-01-16  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Give up on -Wsuggest-attribute=const
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 36c7445..6fdc8e2 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -1489,8 +1489,10 @@ prefix @samp{drag-}.  For example, dragging the mouse with button 2
 held down generates a @code{drag-mouse-2} event.  The second and third
 elements of the event give the starting and ending position of the
 drag, as mouse position lists (@pxref{Click Events}).  You can access
-the second element of any mouse event in the same way, with no need to
-distinguish drag events from others.
+the second element of any mouse event in the same way.  However, the
+drag event may end outside the boundaries of the frame that was
+initially selected.  In that case, the third element's position list
+contains that frame in place of a window.
 
 The @samp{drag-} prefix follows the modifier key prefixes such as
 @samp{C-} and @samp{M-}.
@@ -1635,7 +1637,10 @@ represented by lists that look like this:
 
 @noindent
 @var{position} is a mouse position list (@pxref{Click Events}),
-specifying the current position of the mouse cursor.
+specifying the current position of the mouse cursor.  As with the
+end-position of a drag event, this position list may represent a
+location outside the boundaries of the initially selected frame, in
+which case the list contains that frame in place of a window.
 
 The special form @code{track-mouse} enables generation of motion
 events within its body.  Outside of @code{track-mouse} forms, Emacs
@@ -1850,6 +1855,14 @@ into another window.  That produces a pair of events like these:
                    -453816))
 @end smallexample
 
+The frame with input focus might not take up the entire screen, and
+the user might move the mouse outside the scope of the frame. Inside
+the @code{track-mouse} special form, that produces an event like this:
+
+@smallexample
+(mouse-movement (#<frame *ielm* 0x102849a30> nil (563 . 205) 532301936))
+@end smallexample
+
 To handle a SIGUSR1 signal, define an interactive function, and
 bind it to the @code{signal usr1} event sequence:
 
@@ -2014,7 +2027,9 @@ Events}); and @code{nil} otherwise.
 various parts of it:
 
 @defun posn-window position
-Return the window that @var{position} is in.
+Return the window that @var{position} is in.  If @var{position}
+represents a location outside the frame where the event was initiated,
+return that frame instead.
 @end defun
 
 @defun posn-area position
diff --git a/lisp/subr.el b/lisp/subr.el
index 0534585..b37d17f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1082,7 +1082,10 @@ The return value is a positive integer."
 ;;;; Extracting fields of the positions in an event.
 
 (defun posnp (obj)
-  "Return non-nil if OBJ appears to be a valid `posn' object."
+  "Return non-nil if OBJ appears to be a valid `posn' object that specifies a window. If OBJ is a valid `posn' object, but specifies a frame rather than a window, return nil."
+  ;; FIXME: Correct the behavior of this function so that all valid
+  ;; `posn' objects are recognized, after updating other code that
+  ;; depends on its present behavior.
   (and (windowp (car-safe obj))
        (atom (car-safe (setq obj (cdr obj))))                ;AREA-OR-POS.
        (integerp (car-safe (car-safe (setq obj (cdr obj))))) ;XOFFSET.
@@ -1142,24 +1145,28 @@ For a scroll-bar event, the result column is 0, and the row
 corresponds to the vertical position of the click in the scroll bar.
 POSITION should be a list of the form returned by the `event-start'
 and `event-end' functions."
-  (let* ((pair   (posn-x-y position))
-	 (window (posn-window position))
-	 (area   (posn-area position)))
+  (let* ((pair            (posn-x-y position))
+         (frame-or-window (posn-window position))
+         (frame           (if (framep frame-or-window)
+                              frame-or-window
+                            (window-frame frame-or-window)))
+         (window          (when (windowp frame-or-window) frame-or-window))
+         (area            (posn-area position)))
     (cond
-     ((null window)
+     ((null frame-or-window)
       '(0 . 0))
      ((eq area 'vertical-scroll-bar)
       (cons 0 (scroll-bar-scale pair (1- (window-height window)))))
      ((eq area 'horizontal-scroll-bar)
       (cons (scroll-bar-scale pair (window-width window)) 0))
      (t
-      (let* ((frame (if (framep window) window (window-frame window)))
-	     ;; FIXME: This should take line-spacing properties on
-	     ;; newlines into account.
-	     (spacing (when (display-graphic-p frame)
-			(or (with-current-buffer (window-buffer window)
-			      line-spacing)
-			    (frame-parameter frame 'line-spacing)))))
+      ;; FIXME: This should take line-spacing properties on
+      ;; newlines into account.
+      (let* ((spacing (when (display-graphic-p frame)
+                        (or (with-current-buffer
+                                (window-buffer (frame-selected-window frame))
+                              line-spacing)
+                            (frame-parameter frame 'line-spacing)))))
 	(cond ((floatp spacing)
 	       (setq spacing (truncate (* spacing
 					  (frame-char-height frame)))))
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 8a2383c..85d9410 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -4963,52 +4963,55 @@ The event, EV, is the mouse event."
     (artist-funcall init-fn x1 y1)
     (if (not artist-rubber-banding)
 	(artist-no-rb-set-point1 x1 y1))
-    (track-mouse
-      (while (or (mouse-movement-p ev)
-		 (member 'down (event-modifiers ev)))
-	(setq ev-start-pos (artist-coord-win-to-buf
-			    (posn-col-row (event-start ev))))
-	(setq x1 (car ev-start-pos))
-	(setq y1 (cdr ev-start-pos))
-
-	;; Cancel previous timer
-	(if timer
-	    (cancel-timer timer))
-
-	(if (not (eq initial-win (posn-window (event-start ev))))
-	    ;; If we moved outside the window, do nothing
-	    nil
-
-	  ;; Still in same window:
-	  ;;
-	  ;; Check if user presses or releases shift key
-	  (if (artist-shift-has-changed shift-state ev)
-
-	      ;; First check that the draw-how is the same as we
-	      ;; already have. Otherwise, ignore the changed shift-state.
-	      (if (not (eq draw-how
-			   (artist-go-get-draw-how-from-symbol
-			    (if (not shift-state) shifted unshifted))))
-		  (message "Cannot switch to shifted operation")
-
-		;; progn is "implicit" since this is the else-part
-		(setq shift-state (not shift-state))
-		(setq op          (if shift-state shifted unshifted))
-		(setq draw-how    (artist-go-get-draw-how-from-symbol op))
-		(setq draw-fn     (artist-go-get-draw-fn-from-symbol op))))
-
-	  ;; Draw the new shape
-	  (setq shape (artist-funcall draw-fn x1 y1))
-	  (artist-move-to-xy x1 y1)
-
-	  ;; Start the timer to call `draw-fn' repeatedly every
-	  ;; `interval' second
-	  (if (and interval draw-fn)
-	      (setq timer (run-at-time interval interval draw-fn x1 y1))))
-
-	;; Read next event
-	(setq ev (read-event))))
-
+    (unwind-protect
+        (track-mouse
+          (while (or (mouse-movement-p ev)
+                     (member 'down (event-modifiers ev)))
+            (setq ev-start-pos (artist-coord-win-to-buf
+                                (posn-col-row (event-start ev))))
+            (setq x1 (car ev-start-pos))
+            (setq y1 (cdr ev-start-pos))
+
+            ;; Cancel previous timer
+            (if timer
+                (cancel-timer timer))
+
+            (if (not (eq initial-win (posn-window (event-start ev))))
+                ;; If we moved outside the window, do nothing
+                nil
+
+              ;; Still in same window:
+              ;;
+              ;; Check if user presses or releases shift key
+              (if (artist-shift-has-changed shift-state ev)
+
+                  ;; First check that the draw-how is the same as we
+                  ;; already have. Otherwise, ignore the changed shift-state.
+                  (if (not (eq draw-how
+                               (artist-go-get-draw-how-from-symbol
+                                (if (not shift-state) shifted unshifted))))
+                      (message "Cannot switch to shifted operation")
+
+                    ;; progn is "implicit" since this is the else-part
+                    (setq shift-state (not shift-state))
+                    (setq op          (if shift-state shifted unshifted))
+                    (setq draw-how    (artist-go-get-draw-how-from-symbol op))
+                    (setq draw-fn     (artist-go-get-draw-fn-from-symbol op))))
+
+              ;; Draw the new shape
+              (setq shape (artist-funcall draw-fn x1 y1))
+              (artist-move-to-xy x1 y1)
+
+              ;; Start the timer to call `draw-fn' repeatedly every
+              ;; `interval' second
+              (if (and interval draw-fn)
+                  (setq timer (run-at-time interval interval draw-fn x1 y1))))
+
+            ;; Read next event
+            (setq ev (read-event))))
+      ;; Cleanup: get rid of any active timer.
+      (if timer
+          (cancel-timer timer)))
     ;; Cancel any timers
     (if timer
 	(cancel-timer timer))

  reply	other threads:[~2015-01-21  0:26 UTC|newest]

Thread overview: 22+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2010-05-07 12:17 bug#6130: 23.1; artist-mode spray-can malfunction busk
2015-01-17  5:25 ` Daniel Koning
2015-01-17 13:56   ` martin rudalics
2015-01-18  5:47     ` Daniel Koning
2015-01-18  9:57       ` martin rudalics
2015-01-21  0:26         ` Daniel Koning [this message]
2015-01-21  8:22           ` martin rudalics
2015-01-21 15:22           ` Stefan Monnier
2015-01-21 16:54             ` martin rudalics
2015-01-22 17:02               ` Stefan Monnier
2015-01-22 18:23                 ` martin rudalics
2015-01-22 23:08                   ` Stefan Monnier
2015-01-23  8:26                     ` martin rudalics
2015-01-23  9:43                       ` Eli Zaretskii
2015-01-23 16:54                         ` martin rudalics
2015-01-23 21:05                           ` Stefan Monnier
2015-01-23 21:26                             ` Eli Zaretskii
2015-01-23 21:52                               ` Daniel Koning
2015-01-24  8:12                                 ` Eli Zaretskii
2015-01-24  9:08                                   ` martin rudalics
2015-01-24  9:49                                     ` Eli Zaretskii
2016-04-06  9:17 ` Johan Busk Eriksson

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=m2d269kmh8.fsf@danielkoning.com \
    --to=dk@danielkoning.com \
    --cc=6130@debbugs.gnu.org \
    --cc=busk@lysator.liu.se \
    --cc=rudalics@gmx.at \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).