Contents in 1999-06-04-13 of release-21-2.

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

diff --git a/lisp/mouse.el b/lisp/mouse.el
index ced0442..c42c8aa 100644 (file)
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -68,13 +68,13 @@ text is inserted."
   :group 'mouse)
 
 (defcustom mouse-highlight-text 'context
   :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
 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))
   :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 ()
   "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)
   (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)
+    ))

 
 \f
 (defun mouse-select ()
 
 \f
 (defun mouse-select ()

@@ -780,7 +817,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.
 ;; 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)
   (cond ((eq mouse-highlight-text 'context)
         (eq syntax ?_))
        ((eq mouse-highlight-text 'symbol)

@@ -788,22 +825,33 @@ at the initial click position."
        (t
         nil)))
 
        (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
 (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))
                   (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
                 (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)
        ((eq type 'line)
         (if forwardp (end-of-line) (beginning-of-line)))
        ((eq type 'buffer)

@@ -949,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
             ;; 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))
             ;;
             (and (eq (console-type) 'x)
                  (sit-for 0.15 t))

@@ -1374,6 +1422,7 @@ and `mode-motion-hook'."
     (cond ((extentp help)
            (or inhibit-help-echo
                (eq help last-help-echo-object) ;save some time
     (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)
                (let ((hprop (extent-property help 'help-echo)))
                  (setq last-help-echo-object help)
                  (or (stringp hprop)

@@ -1384,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
                 (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)))
               (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))
           (last-help-echo-object
           (clear-help-echo)))
     (if mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer))