X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fmouse.el;h=c42c8aa2f06c56541d95ca2bfca2129483f1600b;hp=a401d3b1a17d02b9d8064b0e7deadaf4c3ad0c1b;hb=113b194be934327de99a168d809271db252c07c4;hpb=b267e52aa03bee2c488c8a78824d96cf2d9a6ccc

diff --git a/lisp/mouse.el b/lisp/mouse.el
index a401d3b..c42c8aa 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,48 @@ 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 (not (console-on-window-system-p))
+      (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")
+  (let ((text (if check-cutbuffer-p
+		  (or (condition-case () (get-selection) (error ()))
+		      (get-cutbuffer)
+		      (error "No selection or cut buffer available"))
+		(get-selection))))
+    (cond (move-point-event
+	   (mouse-set-point move-point-event)
+	   (push-mark (point)))
+	  ((interactive-p)
+	   (push-mark (point))))
+    (insert text)
+    ))
 
 
 (defun mouse-select ()
@@ -960,7 +997,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))
@@ -1385,6 +1422,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)
@@ -1395,11 +1433,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))