;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
;;; Commentary:
-;;
+
;; This module provides multi-click mouse support for GNU Emacs versions
;; 19.18 and later. I've tried to make it behave more like standard X
;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
;;
;; (overlay-put mouse-drag-overlay 'face 'bold)
-;;; Code: =================================================================
+;;; Code:
(provide 'mouse-sel)
(require 'mouse)
(require 'thingatpt)
-(require 'backquote)
;;=== User Variables ======================================================
type for this selection should be stored.")
(defvar mouse-sel-set-selection-function
- (if (fboundp 'x-set-selection)
- 'x-set-selection)
+ (function (lambda (selection value)
+ (if (eq selection 'PRIMARY)
+ (x-select-text value)
+ (x-set-selection selection value))))
"Function to call to set selection.
Called with two arguments:
SELECTION, the name of the selection concerned, and
- VALUE, the text to store.")
+ VALUE, the text to store.
+This sets the selection as well as the cut buffer for the older applications.
+Use (setq mouse-sel-set-selection-function 'x-set-selection) if you don't care
+for them.")
(defvar mouse-sel-get-selection-function
- (if (fboundp 'x-get-selection)
- 'x-get-selection)
+ (function (lambda (selection)
+ (if (eq selection 'PRIMARY)
+ (x-cut-buffer-or-selection-value)
+ (x-get-selection selection))))
"Function to call to get the selection.
Called with one argument:
SELECTION: the name of the selection concerned.")
-(defvar mouse-sel-selection-owner-p-function
- (if (fboundp 'x-selection-owner-p)
- 'x-selection-owner-p)
- "Function to check whether Emacs still owns the selection.
-Called with one argument:
-
- SELECTION: the name of the selection concerned.")
-
;;=== Support/access functions ============================================
(defun mouse-sel-determine-selection-thing (nclicks)
(funcall mouse-sel-get-selection-function selection)
(get 'mouse-sel-internal-selection selection)))
-(defun mouse-sel-selection-owner-p (selection)
- "Determine whether Emacs owns the specified SELECTION."
- (if mouse-sel-selection-owner-p-function
- (funcall mouse-sel-selection-owner-p-function selection)
- t))
-
(defun mouse-sel-selection-overlay (selection)
"Return overlay corresponding to SELECTION."
(let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist))))
(if (and (eq direction 1) (not (eobp))) (forward-char 1))
;; Move to start/end of selected thing
- (let ((goal (point))
- last)
+ (let ((goal (point)))
(goto-char (if (eq 1 direction) min max))
(condition-case nil
(progn
(while (> (* direction (- goal (point))) 0)
- (setq last (point))
(forward-thing selection-thing direction))
(let ((end (point)))
(forward-thing selection-thing (- direction))
(goto-char
(if (> (* direction (- goal (point))) 0)
- end last))))
+ end (point)))))
(error))))
;; Move overlay
(push-mark (point) 'nomsg)
(insert (or (funcall mouse-sel-get-selection-function selection) "")))))
-;;=== Validate selection ==================================================
-
-(defun mouse-sel-validate-selection ()
- "Validate selections in mouse-sel-selection-alist.
-For each listed selection, remove the selection overlay if Emacs no longer
-owns the selection."
- (let ((owner-p-function mouse-sel-selection-owner-p-function)
- (alist mouse-sel-selection-alist)
- selection overlay)
- (if owner-p-function
- (while alist
- (setq selection (car (car alist))
- overlay (symbol-value (nth 1 (car alist)))
- alist (cdr alist))
- (or (funcall owner-p-function selection)
- (delete-overlay overlay))))))
-
-(add-hook 'pre-command-hook 'mouse-sel-validate-selection)
+;;=== Handle loss of selections ===========================================
+
+(defun mouse-sel-lost-selection-hook (selection)
+ "Remove the overlay for a lost selection."
+ (let ((overlay (mouse-sel-selection-overlay selection)))
+ (delete-overlay overlay)))
+
+(add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
;;=== Key bindings ========================================================
'mouse-sel-selection-alist
'mouse-sel-set-selection-function
'mouse-sel-get-selection-function
- 'mouse-sel-selection-owner-p-function
'mouse-yank-at-point)))
;; mouse-sel.el ends here.