X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fmouse.el;h=9cdab7bf3280b932804657128ed427a5696e4e0c;hp=ced0442e9708b40cb33831fb27b44b1aa9549eac;hb=716cfba952c1dc0d2cf5c968971f3780ba728a89;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/lisp/mouse.el b/lisp/mouse.el index ced0442..9cdab7b 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -68,13 +68,13 @@ text is inserted." :group 'mouse) (defcustom mouse-highlight-text 'context - "*Choose the default double-click highlighting behaviour. + "*Choose the default double-click highlighting behavior. If set to `context', double-click will highlight words when the mouse is at a word character, or a symbol if the mouse is at a symbol character. If set to `word', double-click will always attempt to highlight a word. If set to `symbol', double-click will always attempt to highlight a - symbol (the default behaviour in previous XEmacs versions)." + symbol (the default behavior in previous XEmacs versions)." :type '(choice (const context) (const word) (const symbol)) @@ -84,11 +84,54 @@ If set to `symbol', double-click will always attempt to highlight a "Function that is called upon by `mouse-yank' to actually insert text.") (defun mouse-consolidated-yank () + "Insert the current selection or, if there is none under X insert +the X cutbuffer. A mark is pushed, so that the inserted text lies +between point and mark." (interactive) - (case (device-type) - (x (x-yank-function)) - (tty (yank)) - (otherwise (yank)))) + (if (and (not (console-on-window-system-p)) + (and (featurep 'gpm) + (not gpm-minor-mode))) + (yank) + (push-mark) + (if (region-active-p) + (if (consp zmacs-region-extent) + ;; pirated code from insert-rectangle in rect.el + ;; perhaps that code should be modified to handle a list of extents + ;; as the rectangle to be inserted? + (let ((lines zmacs-region-extent) + (insertcolumn (current-column)) + (first t)) + (push-mark) + (while lines + (or first + (progn + (forward-line 1) + (or (bolp) (insert ?\n)) + (move-to-column insertcolumn t))) + (setq first nil) + (insert (extent-string (car lines))) + (setq lines (cdr lines)))) + (insert (extent-string zmacs-region-extent))) + (insert-selection t)))) + +(defun insert-selection (&optional check-cutbuffer-p move-point-event) + "Insert the current selection into buffer at point." + (interactive "P") + ;; we fallback to the clipboard if the current selection is not existent + (let ((text (if check-cutbuffer-p + (or (get-selection-no-error) + (get-cutbuffer) + (get-selection-no-error 'CLIPBOARD) + (error "No selection, clipboard or cut buffer available")) + (or (get-selection-no-error) + (get-selection 'CLIPBOARD))))) + (cond (move-point-event + (mouse-set-point move-point-event) + (push-mark (point))) + ((interactive-p) + (push-mark (point)))) + (insert text) + )) (defun mouse-select () @@ -185,9 +228,10 @@ This functions has to be improved. Currently it is just a (working) test." (if (click-inside-extent-p event zmacs-region-extent) ;; okay, this is a drag (cond ((featurep 'offix) - (offix-start-drag-region event - (extent-start-position zmacs-region-extent) - (extent-end-position zmacs-region-extent))) + (offix-start-drag-region + event + (extent-start-position zmacs-region-extent) + (extent-end-position zmacs-region-extent))) ((featurep 'cde) ;; should also work with CDE (cde-start-drag-region event @@ -780,7 +824,7 @@ at the initial click position." ;; Decide what will be the SYMBOLP argument to ;; default-mouse-track-{beginning,end}-of-word, according to the ;; syntax of the current character and value of mouse-highlight-text. -(defsubst default-mouse-symbolp (syntax) +(defsubst default-mouse-track-symbolp (syntax) (cond ((eq mouse-highlight-text 'context) (eq syntax ?_)) ((eq mouse-highlight-text 'symbol) @@ -788,22 +832,33 @@ at the initial click position." (t nil))) +;; Return t if point is at an opening quote character. This is +;; determined by testing whether the syntax of the following character +;; is `string', which will always be true for opening quotes and +;; always false for closing quotes. +(defun default-mouse-track-point-at-opening-quote-p () + (save-excursion + (forward-char 1) + (eq (buffer-syntactic-context) 'string))) + (defun default-mouse-track-normalize-point (type forwardp) (cond ((eq type 'word) ;; trap the beginning and end of buffer errors (ignore-errors (setq type (char-syntax (char-after (point)))) (if forwardp - (if (= type ?\() + (if (or (= type ?\() + (and (= type ?\") + (default-mouse-track-point-at-opening-quote-p))) (goto-char (scan-sexps (point) 1)) - (if (= type ?\)) - (forward-char 1) - (default-mouse-track-end-of-word - (default-mouse-symbolp type)))) - (if (= type ?\)) + (default-mouse-track-end-of-word + (default-mouse-track-symbolp type))) + (if (or (= type ?\)) + (and (= type ?\") + (not (default-mouse-track-point-at-opening-quote-p)))) (goto-char (scan-sexps (1+ (point)) -1)) (default-mouse-track-beginning-of-word - (default-mouse-symbolp type)))))) + (default-mouse-track-symbolp type)))))) ((eq type 'line) (if forwardp (end-of-line) (beginning-of-line))) ((eq type 'buffer) @@ -949,7 +1004,7 @@ at the initial click position." ;; always sufficient but it seems to give something ;; approaching a 99% success rate. Making it higher yet ;; would help guarantee success with the price that the - ;; delay would start to become noticable. + ;; delay would start to become noticeable. ;; (and (eq (console-type) 'x) (sit-for 0.15 t)) @@ -1328,7 +1383,7 @@ and `mode-motion-hook'." ;; vars is a list of glyph variables to check for a pointer ;; value. (vars (cond - ;; Checking if button is non-nil is not sufficent + ;; Checking if button is non-nil is not sufficient ;; since the pointer could be over a blank portion ;; of the toolbar. ((event-over-toolbar-p event) @@ -1374,6 +1429,7 @@ and `mode-motion-hook'." (cond ((extentp help) (or inhibit-help-echo (eq help last-help-echo-object) ;save some time + (eq (selected-window) (minibuffer-window)) (let ((hprop (extent-property help 'help-echo))) (setq last-help-echo-object help) (or (stringp hprop) @@ -1384,11 +1440,12 @@ and `mode-motion-hook'." (toolbar-button-enabled-p help)) (or (not toolbar-help-enabled) (eq help last-help-echo-object) ;save some time + (eq (selected-window) (minibuffer-window)) (let ((hstring (toolbar-button-help-string button))) (setq last-help-echo-object help) (or (stringp hstring) (setq hstring (funcall hstring help))) - (show-help-echo hstring)))) + (and hstring (show-help-echo hstring))))) (last-help-echo-object (clear-help-echo))) (if mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer)) @@ -1468,10 +1525,10 @@ other mouse buttons." (setq last-timestamp (event-timestamp event)) ;; Enlarge the window, calculating change in characters ;; of default font. Do not let the window to become - ;; less than alolwed minimum (not because that's critical + ;; less than allowed minimum (not because that's critical ;; for the code performance, just the visual effect is ;; better: when cursor goes to the left of the next left - ;; divider, the vindow being resized shrinks to minimal + ;; divider, the window being resized shrinks to minimal ;; size. (enlarge-window (max (- window-min-width (window-width window)) (/ (- (event-x-pixel event) old-right) @@ -1481,7 +1538,7 @@ other mouse buttons." ;; if the change caused more than two windows to resize ;; (shifting the whole stack right is ugly), or if the ;; left window side has slipped (right side cannot be - ;; moved any funrther to the right, so enlarge-window + ;; moved any further to the right, so enlarge-window ;; plays bad games with the left edge. (if (or (/= (count-windows) (length old-edges-all-windows)) (/= old-left (car (window-pixel-edges window)))