home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-19.28-src.tgz / tar.out / fsf / emacs / lisp / mouse-sel.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  16KB  |  455 lines
  1. ;;; mouse-sel.el --- Multi-click selection support for Emacs 19
  2.  
  3. ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
  6. ;; Keywords: mouse
  7. ;; Version: 2.1
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;;; Commentary:
  22. ;;
  23. ;; This module provides multi-click mouse support for GNU Emacs versions
  24. ;; 19.18 and later.  I've tried to make it behave more like standard X
  25. ;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
  26. ;; Basically:
  27. ;;
  28. ;;   * Clicking mouse-1 starts (cancels) selection, dragging extends it.
  29. ;;
  30. ;;   * Clicking or dragging mouse-3 extends the selection as well.
  31. ;;
  32. ;;   * Double-clicking on word constituents selects words.
  33. ;;     Double-clicking on symbol constituents selects symbols.
  34. ;;     Double-clicking on quotes or parentheses selects sexps.
  35. ;;     Double-clicking on whitespace selects whitespace.
  36. ;;     Triple-clicking selects lines.
  37. ;;
  38. ;;   * Selecting sets the region & X primary selection, but does NOT affect
  39. ;;     the kill-ring.  Because the mouse handlers set the primary selection
  40. ;;     directly, mouse-sel sets the variables interprogram-cut-function
  41. ;;     and interprogram-paste-function to nil.
  42. ;;
  43. ;;   * Clicking mouse-2 pastes contents of primary selection at the mouse
  44. ;;     position.
  45. ;;
  46. ;;   * Pressing mouse-2 while selecting or extending copies selection
  47. ;;     to the kill ring.  Pressing mouse-1 or mouse-3 kills it.
  48. ;;     
  49. ;;   * Double-clicking mouse-3 also kills selection.
  50. ;;
  51. ;; This module requires my thingatpt.el module, which it uses to find the
  52. ;; bounds of words, lines, sexps, etc.
  53. ;;
  54. ;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
  55. ;;
  56. ;;--- Customisation -------------------------------------------------------
  57. ;;
  58. ;; * You may want to use none or more of following:
  59. ;;
  60. ;;      ;; Enable region highlight
  61. ;;      (transient-mark-mode 1)
  62. ;;
  63. ;;      ;; But only in the selected window
  64. ;;      (setq highlight-nonselected-windows nil)
  65. ;;      
  66. ;;      ;; Enable pending-delete
  67. ;;      (delete-selection-mode 1)
  68. ;;
  69. ;; * You can control the way mouse-sel binds it's keys by setting the value
  70. ;;   of mouse-sel-default-bindings before loading mouse-sel.
  71. ;;
  72. ;;   (a) If mouse-sel-default-bindings = t (the default)
  73. ;;   
  74. ;;       Mouse sets and pastes selection
  75. ;;       mouse-1        mouse-select
  76. ;;       mouse-2        mouse-insert-selection
  77. ;;         mouse-3        mouse-extend
  78. ;;
  79. ;;       Selection/kill-ring interaction is disabled
  80. ;;         interprogram-cut-function   = nil
  81. ;;         interprogram-paste-function = nil
  82. ;;
  83. ;;   (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
  84. ;;   
  85. ;;       Mouse sets selection, and pastes from kill-ring
  86. ;;       mouse-1        mouse-select
  87. ;;       mouse-2        mouse-yank-at-click
  88. ;;       mouse-3        mouse-extend
  89. ;;  
  90. ;;       Selection/kill-ring interaction is retained
  91. ;;         interprogram-cut-function   = x-select-text
  92. ;;         interprogram-paste-function = x-cut-buffer-or-selection-value
  93. ;;         
  94. ;;       What you lose is the ability to select some text in
  95. ;;       delete-selection-mode and yank over the top of it.
  96. ;;       
  97. ;;   (c) If mouse-sel-default-bindings = nil, no bindings are made.
  98. ;;
  99. ;; * By default, mouse-insert-selection (mouse-2) inserts the selection at
  100. ;;   the mouse position.  You can tell it to insert at point instead with:
  101. ;;
  102. ;;     (setq mouse-yank-at-point t)
  103. ;;
  104. ;; * I like to leave point at the end of the region nearest to where the
  105. ;;   mouse was, even though this makes region highlighting mis-leading (the
  106. ;;   cursor makes it look like one extra character is selected).  You can
  107. ;;   disable this behaviour with:
  108. ;;
  109. ;;     (setq mouse-sel-leave-point-near-mouse nil)
  110. ;;
  111. ;; * Normally, the selection highlight will be removed when the mouse is
  112. ;;   lifted.  You can tell mouse-sel to retain the selection highlight
  113. ;;   (useful if you don't use transient-mark-mode) with:
  114. ;;
  115. ;;     (setq mouse-sel-retain-highlight t)
  116. ;;
  117. ;; * By default, mouse-select cycles the click count after 3 clicks.  That
  118. ;;   is, clicking mouse-1 four times has the same effect as clicking it
  119. ;;   once, clicking five times has the same effect as clicking twice, etc.
  120. ;;   Disable this behaviour with:
  121. ;;
  122. ;;     (setq mouse-sel-cycle-clicks nil)
  123. ;;
  124. ;; * The variables mouse-sel-{set,get,check}-selection-function control how
  125. ;;   the selection is handled.  Under X Windows, these variables default so
  126. ;;   that the X primary selection is used.  Under other windowing systems,
  127. ;;   alternate functions are used, which simply store the selection value
  128. ;;   in a variable.
  129. ;;
  130. ;;--- Hints ---------------------------------------------------------------
  131. ;;
  132. ;; * You can change the selection highlight face by altering the properties
  133. ;;   of mouse-drag-overlay, eg.
  134. ;;
  135. ;;     (overlay-put mouse-drag-overlay 'face 'bold)
  136. ;;
  137. ;; * Pasting from the primary selection under emacs 19.19 is SLOW (there's
  138. ;;   a two second delay).  The following code will cause mouse-sel to use
  139. ;;   the cut buffer rather than the primary selection.  However, be aware
  140. ;;   that cut buffers are OBSOLETE, and some X applications may not support
  141. ;;   them.
  142. ;;   
  143. ;;     (setq mouse-sel-set-selection-function 'x-select-text
  144. ;;           mouse-sel-get-selection-function 'x-get-cut-buffer)
  145. ;;           
  146. ;;--- Warnings ------------------------------------------------------------
  147. ;;
  148. ;; * When selecting sexps, the selection extends by sexps at the same
  149. ;;   nesting level.  This also means the selection cannot be extended out
  150. ;;   of the enclosing nesting level.  This is INTENTIONAL.
  151.  
  152. ;;; Code: =================================================================
  153.  
  154. (provide 'mouse-sel)
  155.  
  156. (require 'mouse)
  157. (require 'thingatpt)
  158.  
  159. ;;=== Version =============================================================
  160.  
  161. (defconst mouse-sel-version "2.1" 
  162.   "The version number of mouse-sel (as string).")
  163.  
  164. ;;=== User Variables ======================================================
  165.  
  166. (defvar mouse-sel-leave-point-near-mouse t
  167.   "*Leave point near last mouse position.
  168. If non-nil, \\[mouse-select] and \\[mouse-extend] leave point at the end
  169. of the region nearest to where the mouse last was.
  170. If nil, point is always placed at the beginning of the region.")
  171.  
  172. (defvar mouse-sel-retain-highlight nil
  173.   "*Retain highlight after dragging is finished.
  174. If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will
  175. remain highlighted.
  176. If nil, highlighting turns off when you release the mouse button.")
  177.  
  178. (defvar mouse-sel-cycle-clicks t
  179.   "*If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks.
  180. Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc.")
  181.  
  182. (defvar mouse-sel-default-bindings t
  183.   "Set to nil before loading `mouse-sel' to prevent default mouse bindings.")
  184.  
  185. ;;=== Selection ===========================================================
  186.  
  187. (defvar mouse-sel-selection-type nil "Type of current selection")
  188. (make-variable-buffer-local 'mouse-sel-selection-type)
  189.  
  190. (defvar mouse-sel-selection "" 
  191.   "Store the selection value when using a window systems other than X.")
  192.  
  193. (defvar mouse-sel-set-selection-function 
  194.   (if (fboundp 'x-set-selection)
  195.       (function (lambda (s) (x-set-selection 'PRIMARY s)))
  196.     (function (lambda (s) (setq mouse-sel-selection s))))
  197.   "Function to call to set selection.
  198. Called with one argument, the text to select.")
  199.  
  200. (defvar mouse-sel-get-selection-function
  201.   (if (fboundp 'x-get-selection)
  202.       'x-get-selection 
  203.     (function (lambda () mouse-sel-selection)))
  204.   "Function to call to get the selection.
  205. Called with no argument.")
  206.  
  207. (defvar mouse-sel-check-selection-function
  208.   (if (fboundp 'x-selection-owner-p)
  209.       'x-selection-owner-p 
  210.     nil)
  211.   "Function to check whether Emacs still owns the selection.
  212. Called with no arguments.")
  213.  
  214. (defun mouse-sel-determine-selection-type (NCLICKS)
  215.   "Determine what \"thing\" `mouse-sel' should operate on.
  216. The first argument, NCLICKS, is the number of consecutive
  217. mouse clicks at the same position."
  218.   (let* ((next-char (char-after (point)))
  219.      (char-syntax (if next-char (char-syntax next-char)))
  220.      (nclicks (if mouse-sel-cycle-clicks (1+ (% (1- NCLICKS) 3)) NCLICKS)))
  221.     (cond
  222.      ((= nclicks 1) nil)
  223.      ((>= nclicks 3) 'line)
  224.      ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
  225.      ((memq next-char '(? ?\t ?\n)) 'whitespace)
  226.      ((eq char-syntax ?_) 'symbol)
  227.      ((eq char-syntax ?w) 'word))))
  228.  
  229. (defun mouse-select (EVENT)
  230.   "Set region/selection using the mouse.
  231.  
  232. Clicking sets point to click position, and deactivates the mark
  233. if you are in Transient Mark mode.
  234. Dragging extends region/selection.
  235.  
  236. Double-clicking on word constituents selects words.
  237. Double-clicking on symbol constituents selects symbols.
  238. Double-clicking on quotes or parentheses selects sexps.
  239. Double-clicking on whitespace selects whitespace.
  240. Triple-clicking selects lines.
  241.  
  242. Clicking mouse-2 while selecting copies the region to the kill-ring.
  243. Clicking mouse-1 or mouse-3 kills the region.
  244.  
  245. This should be bound to a down-mouse event."
  246.   (interactive "e")
  247.   (mouse-set-point EVENT)
  248.   (setq mouse-sel-selection-type
  249.     (mouse-sel-determine-selection-type (event-click-count EVENT)))
  250.   (let ((object-bounds (bounds-of-thing-at-point mouse-sel-selection-type)))
  251.     (if object-bounds
  252.     (progn
  253.       (setq mark-active t)
  254.       (goto-char (car object-bounds))
  255.       (set-mark (cdr object-bounds)))
  256.       (deactivate-mark)))
  257.   (mouse-extend))
  258.  
  259. (defun mouse-extend (&optional EVENT)
  260.   "Extend region/selection using the mouse.
  261.  
  262. See documentation for mouse-select for more details.
  263.  
  264. This should be bound to a down-mouse event."
  265.   (interactive "e")
  266.   (if EVENT (select-window (posn-window (event-end EVENT))))
  267.   (let* ((use-region (and (or EVENT transient-mark-mode) mark-active))
  268.      (min (if use-region (region-beginning) (point)))
  269.      (max (if use-region (region-end) (point)))
  270.      (orig-window (selected-window))
  271.      (orig-window-frame (window-frame orig-window))
  272.      (top (nth 1 (window-edges orig-window)))
  273.      (bottom (nth 3 (window-edges orig-window)))
  274.      (orig-cursor-type 
  275.       (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))
  276.      direction
  277.      event)
  278.  
  279.     ;; Inhibit normal region highlight
  280.     (setq mark-active nil)
  281.  
  282.     ;; Highlight region (forcing re-highlight)
  283.     (move-overlay mouse-drag-overlay min max (current-buffer))
  284.     (overlay-put mouse-drag-overlay 'face
  285.          (overlay-get mouse-drag-overlay 'face))
  286.  
  287.     ;; Bar cursor
  288.     (if (fboundp 'modify-frame-parameters)
  289.     (modify-frame-parameters (selected-frame) '((cursor-type . bar))))
  290.  
  291.     ;; Handle dragging
  292.     (unwind-protect
  293.     (progn 
  294.       (track-mouse
  295.         
  296.         (while (if EVENT        ; Use initial event
  297.                (prog1
  298.                (setq event EVENT)
  299.              (setq EVENT nil))
  300.              (setq event (read-event))
  301.              (and (consp event)
  302.               (memq (car event) '(mouse-movement switch-frame))))
  303.           
  304.           (let ((end (event-end event)))
  305.             
  306.         (cond
  307.              
  308.          ;; Ignore any movement outside the frame
  309.          ((eq (car-safe event) 'switch-frame) nil)
  310.          ((and (posn-window end)
  311.                (not (eq (let ((posn-w (posn-window end)))
  312.                   (if (windowp posn-w)
  313.                       (window-frame posn-w)
  314.                     posn-w))
  315.                 (window-frame orig-window)))) nil)
  316.              
  317.          ;; Different window, same frame
  318.          ((not (eq (posn-window end) orig-window))
  319.           (let ((end-row (cdr (cdr (mouse-position)))))
  320.             (cond
  321.              ((and end-row (not (bobp)) (< end-row top))
  322.               (mouse-scroll-subr orig-window (- end-row top)
  323.                      mouse-drag-overlay max))
  324.              ((and end-row (not (eobp)) (>= end-row bottom))
  325.               (mouse-scroll-subr orig-window (1+ (- end-row bottom))
  326.                      mouse-drag-overlay min))
  327.              )))
  328.  
  329.          ;; On the mode line
  330.          ((eq (posn-point end) 'mode-line)
  331.           (mouse-scroll-subr orig-window 1 mouse-drag-overlay min))
  332.  
  333.          ;; In original window
  334.          (t (goto-char (posn-point end)))
  335.  
  336.          )
  337.         ;; Determine direction of drag
  338.         (cond
  339.          ((and (not direction) (not (eq min max)))
  340.           (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
  341.          ((and (not (eq direction -1)) (<= (point) min))
  342.           (setq direction -1))
  343.          ((and (not (eq direction 1)) (>= (point) max))
  344.           (setq direction 1)))
  345.         
  346.         (if (not mouse-sel-selection-type) nil
  347.           
  348.           ;; If dragging forward, goal is next character
  349.           (if (and (eq direction 1) (not (eobp))) (forward-char 1))
  350.           
  351.           ;; Move to start/end of selected thing
  352.           (let ((goal (point))
  353.             last)
  354.             (goto-char (if (eq 1 direction) min max))
  355.             (condition-case nil
  356.             (progn
  357.               (while (> (* direction (- goal (point))) 0)
  358.                 (setq last (point))
  359.                 (forward-thing mouse-sel-selection-type 
  360.                        direction))
  361.               (let ((end (point)))
  362.                 (forward-thing mouse-sel-selection-type
  363.                        (- direction))
  364.                 (goto-char
  365.                  (if (> (* direction (- goal (point))) 0)
  366.                  end last))))
  367.               (error))))
  368.         
  369.         ;; Move overlay
  370.         (move-overlay mouse-drag-overlay
  371.                   (if (eq 1 direction) min (point))
  372.                   (if (eq -1 direction) max (point))
  373.                   (current-buffer))
  374.           
  375.         )))            ; end track-mouse
  376.  
  377.       (let ((overlay-start (overlay-start mouse-drag-overlay))
  378.         (overlay-end (overlay-end mouse-drag-overlay)))
  379.  
  380.         ;; Set region
  381.         (if (eq overlay-start overlay-end)
  382.         (deactivate-mark)
  383.           (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
  384.           (progn
  385.             (set-mark overlay-start)
  386.             (goto-char overlay-end))
  387.         (set-mark overlay-end)
  388.         (goto-char overlay-start)))
  389.         
  390.         ;; Set selection
  391.         (if (and mark-active mouse-sel-set-selection-function)
  392.         (funcall mouse-sel-set-selection-function 
  393.              (buffer-substring overlay-start overlay-end)))
  394.           
  395.         ;; Handle copy/kill
  396.         (cond
  397.          ((eq (car-safe last-input-event) 'down-mouse-2)
  398.           (copy-region-as-kill overlay-start overlay-end)
  399.           (read-event) (read-event))
  400.          ((memq (car-safe last-input-event) '(down-mouse-1 down-mouse-3))
  401.           (kill-region overlay-start overlay-end)
  402.           (deactivate-mark)
  403.           (read-event) (read-event))
  404.          ((eq (car-safe last-input-event) 'double-mouse-3)
  405.           (kill-region overlay-start overlay-end)
  406.           (deactivate-mark)))))
  407.  
  408.       ;; Restore cursor
  409.       (if (fboundp 'modify-frame-parameters)
  410.       (modify-frame-parameters 
  411.        (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
  412.       
  413.       ;; Remove overlay
  414.       (or mouse-sel-retain-highlight
  415.       (delete-overlay mouse-drag-overlay)))))
  416.  
  417. (defun mouse-insert-selection (click)
  418.   "Insert the contents of the selection at mouse click.
  419. If `mouse-yank-at-point' is non-nil, insert at point instead."
  420.   (interactive "e")
  421.   (or mouse-yank-at-point 
  422.       (mouse-set-point click))
  423.   (deactivate-mark)
  424.   (if mouse-sel-get-selection-function
  425.       (insert (or (funcall mouse-sel-get-selection-function) ""))))
  426.  
  427. (defun mouse-sel-validate-selection ()
  428.   "Remove selection highlight if emacs no longer owns the primary selection."
  429.   (or (not mouse-sel-check-selection-function)
  430.       (funcall mouse-sel-check-selection-function)
  431.       (delete-overlay mouse-drag-overlay)))
  432.  
  433. (add-hook 'pre-command-hook 'mouse-sel-validate-selection)
  434.  
  435. ;;=== Key bindings ========================================================
  436.  
  437. (if (not mouse-sel-default-bindings) nil
  438.   
  439.   (global-unset-key [mouse-1])
  440.   (global-unset-key [drag-mouse-1])
  441.   (global-unset-key [mouse-3])
  442.   
  443.   (global-set-key [down-mouse-1]    'mouse-select)
  444.   (global-set-key [down-mouse-3]     'mouse-extend)
  445.   
  446.   (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
  447.     
  448.     (global-set-key [mouse-2]     'mouse-insert-selection)
  449.     (setq interprogram-cut-function nil
  450.       interprogram-paste-function nil))
  451.   
  452.   )
  453.  
  454. ;; mouse-sel.el ends here.
  455.