From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: storm@cua.dk (Kim F. Storm) Newsgroups: gmane.emacs.devel Subject: [PATCH] mouse-1 click follows link Date: Fri, 29 Oct 2004 15:04:46 +0200 Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Message-ID: NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1099055111 17966 80.91.229.6 (29 Oct 2004 13:05:11 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Fri, 29 Oct 2004 13:05:11 +0000 (UTC) Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Oct 29 15:05:01 2004 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1CNWRA-0007Tt-00 for ; Fri, 29 Oct 2004 15:05:00 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CNWZ1-0002lS-0K for ged-emacs-devel@m.gmane.org; Fri, 29 Oct 2004 09:13:07 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.33) id 1CNWYr-0002l4-6e for emacs-devel@gnu.org; Fri, 29 Oct 2004 09:12:57 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.33) id 1CNWYp-0002kY-UC for emacs-devel@gnu.org; Fri, 29 Oct 2004 09:12:56 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CNWYp-0002kV-Ol for emacs-devel@gnu.org; Fri, 29 Oct 2004 09:12:55 -0400 Original-Received: from [212.88.64.25] (helo=mail-relay.sonofon.dk) by monty-python.gnu.org with smtp (Exim 4.34) id 1CNWQs-0007HX-3g for emacs-devel@gnu.org; Fri, 29 Oct 2004 09:04:42 -0400 Original-Received: (qmail 38553 invoked from network); 29 Oct 2004 13:04:39 -0000 Original-Received: from unknown (HELO kfs-l.imdomain.dk.cua.dk) (213.83.150.2) by 0 with SMTP; 29 Oct 2004 13:04:39 -0000 Original-To: emacs-devel@gnu.org User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/21.3.50 (gnu/linux) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:29143 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:29143 Here is the full patch (without doc updates) for the proposed mouse-1-click-follows-link functionality, including rewriting of tooltips and making C-h k aware of the remapping. Index: mouse.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/mouse.el,v retrieving revision 1.253 diff -c -r1.253 mouse.el *** mouse.el 28 Oct 2004 23:33:23 -0000 1.253 --- mouse.el 29 Oct 2004 12:57:49 -0000 *************** *** 48,53 **** --- 48,77 ---- :type 'boolean :group 'mouse) + (defcustom mouse-1-click-follows-link 350 + "Non-nil means that clicking mouse-1 on a link follows the link. + This is only done for links which have the mouse-face property. + + If value is the symbol double, a double click follows the link. + + If value is an integer, the time elapsed between pressing and + releasing the mouse button determines whether to follow the link + or perform the normal mouse-1 action (typically set point). + The absolute numeric value specifices the maximum duration of a + \"short click\" in milli-seconds. A positive value means that a + short click follows the link, and a longer click performs the + normal action. A negative value gives the opposite behaviour. + + Otherwise, a single mouse-1 click unconditionally follows the link. + + Note that dragging the mouse never follows the link." + :version "21.4" + :type '(choice (const :tag "Disabled" nil) + (const :tag "Double click" double) + (number :tag "Single click time limit" :value 350) + (other :tag "Single click" t)) + :group 'mouse) + ;; Provide a mode-specific menu on a mouse button. *************** *** 731,736 **** --- 755,764 ---- (run-hooks 'mouse-leave-buffer-hook) (mouse-drag-region-1 start-event)))) + (defun mouse-on-link-p (pos) + (and (get-char-property pos 'mouse-face) + (not (get-char-property pos 'dont-follow-link)))) + (defun mouse-drag-region-1 (start-event) (mouse-minibuffer-check start-event) (let* ((echo-keystrokes 0) *************** *** 746,751 **** --- 774,780 ---- (nth 3 bounds) ;; Don't count the mode line. (1- (nth 3 bounds)))) + on-link remap-double-click (click-count (1- (event-click-count start-event)))) (setq mouse-selection-click-count click-count) (setq mouse-selection-click-count-buffer (current-buffer)) *************** *** 755,760 **** --- 784,796 ---- (if (< (point) start-point) (goto-char start-point)) (setq start-point (point)) + (setq on-link (and mouse-1-click-follows-link + (mouse-on-link-p start-point))) + (setq remap-double-click (and on-link + (eq mouse-1-click-follows-link 'double) + (= click-count 1))) + (if remap-double-click ;; Don't expand mouse overlay in links + (setq click-count 0)) (let ((range (mouse-start-end start-point start-point click-count))) (move-overlay mouse-drag-overlay (car range) (nth 1 range) (window-buffer start-window)) *************** *** 877,882 **** --- 913,938 ---- (or end-point (= (window-start start-window) start-window-start))) + (if (and on-link + (not end-point) + (consp event) + (or remap-double-click + (and + (not (eq mouse-1-click-follows-link 'double)) + (= click-count 0) + (= (event-click-count event) 1) + (not (input-pending-p)) + (or (not (integerp mouse-1-click-follows-link)) + (let ((t0 (posn-timestamp (event-start start-event))) + (t1 (posn-timestamp (event-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))))) + (or (not double-click-time) + (sit-for 0 (if (integerp double-click-time) + double-click-time 500) t))))) + (setcar event 'mouse-2)) (setq unread-command-events (cons event unread-command-events))))) (delete-overlay mouse-drag-overlay))))) *** help.el 25 Oct 2004 14:43:57 +0200 1.270 --- help.el 29 Oct 2004 12:35:18 +0200 *************** *** 609,625 **** (princ "\n which is ") (describe-function-1 defn) (when up-event ! (let ((defn (or (string-key-binding up-event) (key-binding up-event)))) (unless (or (null defn) (integerp defn) (equal defn 'undefined)) ! (princ "\n\n-------------- up event ---------------\n\n") ! (princ (key-description up-event)) (if (windowp window) (princ " at that spot")) (princ " runs the command ") (prin1 defn) (princ "\n which is ") ! (describe-function-1 defn)))) ! (print-help-return-message))))))) (defun describe-mode (&optional buffer) --- 609,666 ---- (princ "\n which is ") (describe-function-1 defn) (when up-event ! (let ((ev (aref up-event 0)) ! (descr (key-description up-event)) ! (hdr "\n\n-------------- up event ---------------\n\n") ! defn ! mouse-1-tricky mouse-1-remapped) ! (when (and (consp ev) ! (eq (car ev) 'mouse-1) ! (windowp window) ! mouse-1-click-follows-link ! (not (eq mouse-1-click-follows-link 'double)) ! (with-current-buffer (window-buffer window) ! (mouse-on-link-p (posn-point (event-start ev))))) ! (setq mouse-1-tricky (integerp mouse-1-click-follows-link) ! mouse-1-remapped (or (not mouse-1-tricky) ! (> mouse-1-click-follows-link 0))) ! (if mouse-1-remapped ! (setcar ev 'mouse-2))) ! (setq defn (or (string-key-binding up-event) (key-binding up-event))) (unless (or (null defn) (integerp defn) (equal defn 'undefined)) ! (princ (if mouse-1-tricky ! "\n\n----------------- up-event (short click) ----------------\n\n" ! hdr)) ! (setq hdr nil) ! (princ descr) (if (windowp window) (princ " at that spot")) + (if mouse-1-remapped + (princ " is remapped to \n which" )) (princ " runs the command ") (prin1 defn) (princ "\n which is ") ! (describe-function-1 defn)) ! (when mouse-1-tricky ! (setcar ev ! (if (> mouse-1-click-follows-link 0) 'mouse-1 'mouse-2)) ! (setq defn (or (string-key-binding up-event) (key-binding up-event))) ! (unless (or (null defn) (integerp defn) (equal defn 'undefined)) ! (princ (or hdr ! "\n\n----------------- up-event (long click) ----------------\n\n")) ! (princ "Pressing ") ! (princ descr) ! (if (windowp window) ! (princ " at that spot")) ! (princ (format " for longer than %d milli-seconds\n" ! (abs mouse-1-click-follows-link))) ! (if (not mouse-1-remapped) ! (princ " remaps it to which" )) ! (princ " runs the command ") ! (prin1 defn) ! (princ "\n which is ") ! (describe-function-1 defn)))) ! (print-help-return-message)))))))) (defun describe-mode (&optional buffer) *** tooltip.el 01 Sep 2003 17:45:17 +0200 1.34 --- tooltip.el 29 Oct 2004 12:36:23 +0200 *************** *** 480,486 **** (defun tooltip-show-help-function (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." ! (let ((previous-help tooltip-help-message)) (setq tooltip-help-message msg) (cond ((null msg) ;; Cancel display. This also cancels a delayed tip, if --- 481,505 ---- (defun tooltip-show-help-function (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." ! (let ((previous-help tooltip-help-message) ! mp pos) ! (if (and mouse-1-click-follows-link ! (stringp msg) ! (save-match-data ! (string-match "^mouse-2" msg)) ! (setq mp (mouse-pixel-position)) ! (consp (setq pos (cdr mp))) ! (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp))) ! (windowp (posn-window pos))) ! (with-current-buffer (window-buffer (posn-window pos)) ! (if (mouse-on-link-p (posn-point pos)) ! (setq msg (concat ! (cond ! ((eq mouse-1-click-follows-link 'double) "double-") ! ((and (integerp mouse-1-click-follows-link) ! (< mouse-1-click-follows-link 0)) "Long ") ! (t "")) ! "mouse-1" (substring msg 7)))))) (setq tooltip-help-message msg) (cond ((null msg) ;; Cancel display. This also cancels a delayed tip, if -- Kim F. Storm http://www.cua.dk