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))
next prev parent 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).