XEmacs 21.2.20 "Yoko".

[chise/xemacs-chise.git-] / lisp / mouse.el

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 7c07a20..0afebb8 100644 (file)
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -84,11 +84,52 @@ 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")
+  ;; 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)
+    ))
 
 \f
 (defun mouse-select ()
@@ -185,9 +226,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
@@ -1385,6 +1427,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 +1438,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))