From 27a98a62d1c46b057428cc3ed964743b69628299 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2013 23:15:53 -0500 Subject: [PATCH] Separate mouse-1-click-follows-link from mouse-drag-region. * lisp/mouse.el (mouse--down-1-maybe-follows-link): New function. (key-translation-map): Use it to implement mouse-1-click-follows-link. (mouse-drag-line, mouse-drag-track): Remove mouse-1-click-follows-link code. (mouse--remap-link-click-p): Remove. * src/keyboard.c (access_keymap_keyremap): Accept nil return value from functions to mean "no change". * src/keyboard.h (EVENT_START, EVENT_END, POSN_WINDOW, POSN_POSN) (POSN_WINDOW_POSN, POSN_TIMESTAMP): Be careful since events may come from Elisp via unread-command-events. --- lisp/ChangeLog | 25 +++++++++----- lisp/mouse.el | 94 +++++++++++++++++++++++--------------------------- src/ChangeLog | 21 +++++++---- src/keyboard.c | 2 +- src/keyboard.h | 12 +++---- 5 files changed, 83 insertions(+), 71 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9dc7f06e02c..5e625aed387 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,10 +1,19 @@ +2013-03-09 Stefan Monnier + + Separate mouse-1-click-follows-link from mouse-drag-region. + * mouse.el (mouse--down-1-maybe-follows-link): New function. + (key-translation-map): Use it to implement mouse-1-click-follows-link. + (mouse-drag-line, mouse-drag-track): + Remove mouse-1-click-follows-link code. + (mouse--remap-link-click-p): Remove. + 2013-03-08 Jambunathan K * hi-lock.el (hi-lock-read-regexp-defaults-function): New var. (hi-lock-read-regexp-defaults): New defun. (hi-lock-line-face-buffer, hi-lock-face-buffer) - (hi-lock-face-phrase-buffer): Propagate above change. Update - docstring (bug#13892). + (hi-lock-face-phrase-buffer): Propagate above change. + Update docstring (bug#13892). * subr.el (find-tag-default-as-regexp): New defun. * replace.el (read-regexp): Propagate above change. @@ -45,13 +54,13 @@ 2013-03-07 Dmitry Gutov - * progmodes/js.el (js--multi-line-declaration-indentation): Merge - from js2-mode (https://github.com/mooz/js2-mode/issues/89). + * progmodes/js.el (js--multi-line-declaration-indentation): + Merge from js2-mode (https://github.com/mooz/js2-mode/issues/89). 2013-03-06 Dmitry Gutov - * progmodes/ruby-mode.el (ruby-syntax-propertize-function): Only - propertize regexp when not inside a string (Bug#13885). + * progmodes/ruby-mode.el (ruby-syntax-propertize-function): + Only propertize regexp when not inside a string (Bug#13885). 2013-03-06 Alan Mackenzie @@ -62,8 +71,8 @@ 2013-03-05 Michael Albinus - * net/tramp-compat.el (tramp-compat-delete-directory): Implement - TRASH argument. + * net/tramp-compat.el (tramp-compat-delete-directory): + Implement TRASH argument. 2013-03-05 Dmitry Gutov diff --git a/lisp/mouse.el b/lisp/mouse.el index bd7242e3b20..f820d3aa6d7 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -93,6 +93,49 @@ point at the click position." :version "22.1" :group 'mouse) +(defun mouse--down-1-maybe-follows-link (&optional _prompt) + "Turn `mouse-1' events into `mouse-2' events if follows-link. +Expects to be bound to `down-mouse-1' in `key-translation-map'." + (if (or (null mouse-1-click-follows-link) + (not (eq (if (eq mouse-1-click-follows-link 'double) + 'double-down-mouse-1 'down-mouse-1) + (car-safe last-input-event))) + (not (mouse-on-link-p (event-start last-input-event))) + (and (not mouse-1-click-in-non-selected-windows) + (not (eq (selected-window) + (posn-window (event-start last-input-event)))))) + nil + (let ((this-event last-input-event) + (timedout + (sit-for (if (numberp mouse-1-click-follows-link) + (/ (abs mouse-1-click-follows-link) 1000.0) + 0)))) + (if (if (and (numberp mouse-1-click-follows-link) + (>= mouse-1-click-follows-link 0)) + timedout (not timedout)) + nil + + (let ((event (read-event))) + (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double) + 'double-mouse-1 'mouse-1)) + ;; Turn the mouse-1 into a mouse-2 to follow links. + (let ((newup (if (eq mouse-1-click-follows-link 'double) + 'double-mouse-2 'mouse-2)) + (newdown (if (eq mouse-1-click-follows-link 'double) + 'double-down-mouse-2 'down-mouse-2))) + ;; If mouse-2 has never been done by the user, it doesn't have + ;; the necessary property to be interpreted correctly. + (put newup 'event-kind (get (car event) 'event-kind)) + (put newdown 'event-kind (get (car this-event) 'event-kind)) + (push (cons newup (cdr event)) unread-command-events) + (vector (cons newdown (cdr this-event)))) + (push event unread-command-events) + nil)))))) + +(define-key key-translation-map [down-mouse-1] + #'mouse--down-1-maybe-follows-link) +(define-key key-translation-map [double-down-mouse-1] + #'mouse--down-1-maybe-follows-link) ;; Provide a mode-specific menu on a mouse button. @@ -418,8 +461,6 @@ must be one of the symbols `header', `mode', or `vertical'." (window (posn-window start)) (frame (window-frame window)) (minibuffer-window (minibuffer-window frame)) - (on-link (and mouse-1-click-follows-link - (mouse-on-link-p start))) (side (and (eq line 'vertical) (or (cdr (assq 'vertical-scroll-bars (frame-parameters frame))) @@ -507,12 +548,6 @@ must be one of the symbols `header', `mode', or `vertical'." (- growth))))))) ;; Process the terminating event. (unless dragged - (when (and (mouse-event-p event) on-link - (mouse--remap-link-click-p start-event event)) - ;; If mouse-2 has never been done by the user, it doesn't have - ;; the necessary property to be interpreted correctly. - (put 'mouse-2 'event-kind 'mouse-click) - (setcar event 'mouse-2)) (push event unread-command-events)))) (defun mouse-drag-mode-line (start-event) @@ -770,7 +805,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (setq mouse-selection-click-count-buffer (current-buffer)) (deactivate-mark) (let* ((scroll-margin 0) ; Avoid margin scrolling (Bug#9541). - (original-window (selected-window)) ;; We've recorded what we needed from the current buffer and ;; window, now let's jump to the place of the event, where things ;; are happening. @@ -788,15 +822,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (nth 3 bounds) ;; Don't count the mode line. (1- (nth 3 bounds)))) - (on-link (and mouse-1-click-follows-link - ;; Use start-point before the intangibility - ;; treatment, in case we click on a link inside - ;; intangible text. - (mouse-on-link-p start-posn))) (click-count (1- (event-click-count start-event))) - (remap-double-click (and on-link - (eq mouse-1-click-follows-link 'double) - (= click-count 1))) ;; Suppress automatic hscrolling, because that is a nuisance ;; when setting point near the right fringe (but see below). (auto-hscroll-mode-saved auto-hscroll-mode) @@ -809,8 +835,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (if (< (point) start-point) (goto-char start-point)) (setq start-point (point)) - (if remap-double-click - (setq click-count 0)) ;; Activate the region, using `mouse-start-end' to determine where ;; to put point and mark (e.g., double-click will select a word). @@ -826,6 +850,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (track-mouse (while (progn (setq event (read-event)) + (trace-values event) (or (mouse-movement-p event) (memq (car-safe event) '(switch-frame select-window)))) (unless (memq (car-safe event) '(switch-frame select-window)) @@ -900,21 +925,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (or end-point (= (window-start start-window) start-window-start))) - (when (and on-link - (= start-point (point)) - (mouse--remap-link-click-p start-event event)) - ;; If we rebind to mouse-2, reselect previous selected - ;; window, so that the mouse-2 event runs in the same - ;; situation as if user had clicked it directly. Fixes - ;; the bug reported by juri@jurta.org on 2005-12-27. - (if (or (vectorp on-link) (stringp on-link)) - (setq event (aref on-link 0)) - (select-window original-window) - (setcar event 'mouse-2) - ;; If this mouse click has never been done by the - ;; user, it doesn't have the necessary property to be - ;; interpreted correctly. - (put 'mouse-2 'event-kind 'mouse-click))) (push event unread-command-events))))))) (defun mouse--drag-set-mark-and-point (start click click-count) @@ -932,22 +942,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (set-mark beg) (goto-char end))))) -(defun mouse--remap-link-click-p (start-event end-event) - (or (and (eq mouse-1-click-follows-link 'double) - (= (event-click-count start-event) 2)) - (and - (not (eq mouse-1-click-follows-link 'double)) - (= (event-click-count start-event) 1) - (= (event-click-count end-event) 1) - (or (not (integerp mouse-1-click-follows-link)) - (let ((t0 (posn-timestamp (event-start start-event))) - (t1 (posn-timestamp (event-end end-event)))) - (and (integerp t0) (integerp t1) - (if (> mouse-1-click-follows-link 0) - (<= (- t1 t0) mouse-1-click-follows-link) - (< (- t0 t1) mouse-1-click-follows-link)))))))) - - ;; Commands to handle xterm-style multiple clicks. (defun mouse-skip-word (dir) "Skip over word, over whitespace, or over identical punctuation. diff --git a/src/ChangeLog b/src/ChangeLog index 69e8303111a..ae25a3c5d00 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2013-03-09 Stefan Monnier + + * keyboard.h (EVENT_START, EVENT_END, POSN_WINDOW, POSN_POSN) + (POSN_WINDOW_POSN, POSN_TIMESTAMP): Be careful since events may come + from Elisp via unread-command-events. + + * keyboard.c (access_keymap_keyremap): Accept nil return value from + functions to mean "no change". + 2013-03-08 Paul Eggert region-cache.c, scroll.c, search.c: Use bool for booleans. @@ -19,8 +28,8 @@ * lisp.h (find_newline, find_newline_no_quit): Adjust prototype. * bidi.c (bidi_find_paragraph_start): Pass byte position to find_newline_no_quit, thus eliminating CHAR_TO_BYTE. - * editfns.c (Fconstrain_to_field): Break long line. Adjust - call to find_newline. + * editfns.c (Fconstrain_to_field): Break long line. + Adjust call to find_newline. * indent.c (vmotion): Adjust calls to find_newline_no_quit. Use DEC_BOTH to start next search from the previous buffer position, where appropriate. @@ -270,8 +279,8 @@ 2013-03-02 Eli Zaretskii - * textprop.c (Fadd_text_properties, Fremove_text_properties): If - the interval tree changes as a side effect of calling + * textprop.c (Fadd_text_properties, Fremove_text_properties): + If the interval tree changes as a side effect of calling modify_region, re-do processing starting from the call to validate_interval_range. (Bug#13743) @@ -347,8 +356,8 @@ * textprop.c (Fadd_text_properties, Fremove_text_properties) (Fremove_list_of_text_properties): Skip all of the intervals in the region between START and END that already have resp. don't - have the requested properties, not just the first one. Add - assertions that the loop afterwards always modifies the + have the requested properties, not just the first one. + Add assertions that the loop afterwards always modifies the properties. (Bug#13743) 2013-02-25 Stefan Monnier diff --git a/src/keyboard.c b/src/keyboard.c index 914378947ed..a66c28dc3d3 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -8699,7 +8699,7 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt, barf--don't ignore it. (To ignore it safely, we would need to gcpro a bunch of other variables.) */ - if (! (VECTORP (next) || STRINGP (next))) + if (! (NILP (next) || VECTORP (next) || STRINGP (next))) error ("Function %s returns invalid key sequence", SSDATA (SYMBOL_NAME (tem))); } diff --git a/src/keyboard.h b/src/keyboard.h index c6ade35dd52..8bb1c409efc 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -421,18 +421,18 @@ typedef struct _widget_value (EVENT_HAS_PARAMETERS (event) ? XCAR (event) : (event)) /* Extract the starting and ending positions from a composite event. */ -#define EVENT_START(event) (XCAR (XCDR (event))) -#define EVENT_END(event) (XCAR (XCDR (XCDR (event)))) +#define EVENT_START(event) (CAR_SAFE (CDR_SAFE (event))) +#define EVENT_END(event) (CAR_SAFE (CDR_SAFE (CDR_SAFE (event)))) /* Extract the click count from a multi-click event. */ #define EVENT_CLICK_COUNT(event) (Fnth (make_number (2), (event))) /* Extract the fields of a position. */ -#define POSN_WINDOW(posn) (XCAR (posn)) -#define POSN_POSN(posn) (XCAR (XCDR (posn))) +#define POSN_WINDOW(posn) (CAR_SAFE (posn)) +#define POSN_POSN(posn) (CAR_SAFE (CDR_SAFE (posn))) #define POSN_SET_POSN(posn,x) (XSETCAR (XCDR (posn), (x))) -#define POSN_WINDOW_POSN(posn) (XCAR (XCDR (XCDR (posn)))) -#define POSN_TIMESTAMP(posn) (XCAR (XCDR (XCDR (XCDR (posn))))) +#define POSN_WINDOW_POSN(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (posn)))) +#define POSN_TIMESTAMP(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (posn))))) #define POSN_SCROLLBAR_PART(posn) (Fnth (make_number (4), (posn))) /* A cons (STRING . STRING-CHARPOS), or nil in mouse-click events. -- 2.39.2