Index: lisp/mouse.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/mouse.el,v retrieving revision 1.8 diff -u -r1.8 mouse.el --- mouse.el 1998/03/31 20:11:08 1.8 +++ mouse.el 1998/04/29 17:53:44 @@ -978,8 +978,7 @@ )))) (defun default-mouse-track-has-selection-p (buffer) - (and (or (not (eq 'x (console-type))) - (x-selection-owner-p)) + (and (selection-owner-p) (extent-live-p primary-selection-extent) (not (extent-detached-p primary-selection-extent)) (eq buffer (extent-object primary-selection-extent)))) @@ -1043,9 +1042,10 @@ ;; (sit-for 0.15 t) (zmacs-activate-region))) - ((eq 'x (console-type)) + ((or (eq 'x (console-type)) + (eq 'mswindows (console-type))) (if (= start end) - (x-disown-selection type) + (disown-selection type) (if (consp default-mouse-track-extent) ;; own the rectangular region ;; this is a hack @@ -1055,11 +1055,11 @@ (while r (insert (extent-string (car r)) "\n") (setq r (cdr r))) - (x-own-selection (buffer-substring (point-min) (point-max))) + (own-selection (buffer-substring (point-min) (point-max))) (kill-buffer (current-buffer)))) - (x-own-selection (cons (set-marker (make-marker) start) - (set-marker (make-marker) end)) - type))))) + (own-selection (cons (set-marker (make-marker) start) + (set-marker (make-marker) end)) + type))))) (if (and (eq 'x (console-type)) (not (= start end))) ;; I guess cutbuffers should do something with rectangles too. Index: lisp/msw-init.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/msw-init.el,v retrieving revision 1.4 diff -u -r1.4 msw-init.el --- msw-init.el 1998/04/17 05:41:24 1.4 +++ msw-init.el 1998/04/29 17:53:47 @@ -48,6 +48,18 @@ ;; any toolbar-related color resources. (if (and (featurep 'xpm) (featurep 'toolbar)) (init-x-toolbar)) + (add-hook 'zmacs-deactivate-region-hook + (lambda () + (if (console-on-window-system-p) + (disown-selection)))) + (add-hook 'zmacs-activate-region-hook + (lambda () + (if (console-on-window-system-p) + (activate-region-as-selection)))) + (add-hook 'zmacs-update-region-hook + (lambda () + (if (console-on-window-system-p) + (activate-region-as-selection)))) ;; Old-style mswindows bindings. The new-style mswindows bindings ;; (namely Ctrl-X, Ctrl-C and Ctrl-V) are already spoken for by XEmacs. (define-key global-map '(control insert) 'mswindows-copy-clipboard) Index: lisp/msw-select.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/msw-select.el,v retrieving revision 1.2 diff -u -r1.2 msw-select.el --- msw-select.el 1998/02/04 04:26:02 1.2 +++ msw-select.el 1998/04/29 17:53:48 @@ -82,3 +82,55 @@ ;; (setq zmacs-region-stays t) )) (error "there is no selection to cut or copy")))) + +(defvar mswindows-selection-owned-p nil + "Whether we have a selection or not. +MS-Windows has no concept of ownership; don't use this.") + +(defun mswindows-own-selection (data &optional type) + "Make an MS Windows selection of type TYPE and value DATA. +The argument TYPE is ignored, and DATA specifies the contents. +DATA may be a string, +a symbol, an integer (or a cons of two integers or list of two integers). + +The selection may also be a cons of two markers pointing to the same buffer, +or an overlay. In these cases, the selection is considered to be the text +between the markers *at whatever time the selection is examined*. +Thus, editing done in the buffer after you specify the selection +can alter the effective value of the selection. + +The data may also be a vector of valid non-vector selection values. + +Interactively, the text of the region is used as the selection value." + (interactive (if (not current-prefix-arg) + (list (read-string "Store text for pasting: ")) + (list (substring (region-beginning) (region-end))))) + (or (valid-simple-selection-p data) + (and (vectorp data) + (let ((valid t) + (i (1- (length data)))) + (while (>= i 0) + (or (valid-simple-selection-p (aref data i)) + (setq valid nil)) + (setq i (1- i))) + valid)) + (signal 'error (list "invalid selection" data))) + (if data + (setq mswindows-selection-owned-p data) + (setq mswindows-selection-owned-p nil)) + (setq primary-selection-extent + (select-make-extent-for-selection + data primary-selection-extent)) + (setq zmacs-region-stays t) + data) + +(defun mswindows-disown-selection (&optional secondary-p) + "Assuming we own the selection, disown it. With an argument, discard the +secondary selection instead of the primary selection." + (setq mswindows-selection-owned-p nil)) + +(defun mswindows-selection-owner-p (&optional selection) + "Return t if current emacs process owns the given Selection. +The arg is ignored." + (not (eq mswindows-selection-owned-p nil))) + Index: lisp/select.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/select.el,v retrieving revision 1.1 diff -u -r1.1 select.el --- select.el 1998/04/28 00:24:46 1.1 +++ select.el 1998/04/29 17:53:49 @@ -1,6 +1,8 @@ ;;; select.el --- Lisp interface to windows selections. -;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1998 Andy Piper. +;; Copyright (C) 1990, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1995 Sun Microsystems. ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, dumped @@ -70,7 +72,7 @@ (interactive) (case (device-type (selected-device)) (x (x-selection-owner-p selection)) - (mswindows t) + (mswindows (mswindows-selection-owner-p selection)) (otherwise nil))) (defun selection-exists-p (&optional selection) @@ -84,5 +86,146 @@ (x (x-selection-exists-p selection)) (mswindows t) (otherwise nil))) + +(defun own-selection (data &optional type) + "Make an Windows selection of type TYPE and value DATA. +The argument TYPE (default `PRIMARY') says which selection, +and DATA specifies the contents. DATA may be a string, +a symbol, an integer (or a cons of two integers or list of two integers). + +The selection may also be a cons of two markers pointing to the same buffer, +or an overlay. In these cases, the selection is considered to be the text +between the markers *at whatever time the selection is examined*. +Thus, editing done in the buffer after you specify the selection +can alter the effective value of the selection. + +The data may also be a vector of valid non-vector selection values. + +Interactively, the text of the region is used as the selection value." + (interactive (if (not current-prefix-arg) + (list (read-string "Store text for pasting: ")) + (list (substring (region-beginning) (region-end))))) + (case (device-type (selected-device)) + (x (x-own-selection data type)) + (mswindows (mswindows-own-selection data type)) + (otherwise nil))) + +(defun disown-selection (&optional secondary-p) + "Assuming we own the selection, disown it. With an argument, discard the +secondary selection instead of the primary selection." + (case (device-type (selected-device)) + (x (x-disown-selection secondary-p)) + (mswindows (mswindows-disown-selection secondary-p)) + (otherwise nil))) + +;; from x-init.el +;; selections and active regions + +;; If and only if zmacs-regions is true: + +;; When a mark is pushed and the region goes into the "active" state, we +;; assert it as the Primary selection. This causes it to be hilighted. +;; When the region goes into the "inactive" state, we disown the Primary +;; selection, causing the region to be dehilighted. + +;; Note that it is possible for the region to be in the "active" state +;; and not be hilighted, if it is in the active state and then some other +;; application asserts the selection. This is probably not a big deal. + +(defun activate-region-as-selection () + (if (marker-buffer (mark-marker t)) + (own-selection (cons (point-marker t) (mark-marker t))))) + +; moved from x-select.el +(defvar primary-selection-extent nil + "The extent of the primary selection; don't use this.") + +(defvar secondary-selection-extent nil + "The extent of the secondary selection; don't use this.") + +(defun select-make-extent-for-selection (selection previous-extent) + ;; Given a selection, this makes an extent in the buffer which holds that + ;; selection, for highlighting purposes. If the selection isn't associated + ;; with a buffer, this does nothing. + (let ((buffer nil) + (valid (and (extentp previous-extent) + (extent-object previous-extent) + (buffer-live-p (extent-object previous-extent)))) + start end) + (cond ((stringp selection) + ;; if we're selecting a string, lose the previous extent used + ;; to highlight the selection. + (setq valid nil)) + ((consp selection) + (setq start (min (car selection) (cdr selection)) + end (max (car selection) (cdr selection)) + valid (and valid + (eq (marker-buffer (car selection)) + (extent-object previous-extent))) + buffer (marker-buffer (car selection)))) + ((extentp selection) + (setq start (extent-start-position selection) + end (extent-end-position selection) + valid (and valid + (eq (extent-object selection) + (extent-object previous-extent))) + buffer (extent-object selection))) + (t + (signal 'error (list "invalid selection" selection)))) + + (if valid + nil + (condition-case () + (if (listp previous-extent) + (mapcar 'delete-extent previous-extent) + (delete-extent previous-extent)) + (error nil))) + + (if (not buffer) + ;; string case + nil + ;; normal case + (if valid + (set-extent-endpoints previous-extent start end) + (setq previous-extent (make-extent start end buffer)) + + ;; Make the extent be closed on the right, which means that if + ;; characters are inserted exactly at the end of the extent, the + ;; extent will grow to cover them. This is important for shell + ;; buffers - suppose one makes a selection, and one end is at + ;; point-max. If the shell produces output, that marker will remain + ;; at point-max (its position will increase). So it's important that + ;; the extent exhibit the same behavior, lest the region covered by + ;; the extent (the visual indication), and the region between point + ;; and mark (the actual selection value) become different! + (set-extent-property previous-extent 'end-open nil) + + (cond + (mouse-track-rectangle-p + (setq previous-extent (list previous-extent)) + (default-mouse-track-next-move-rect start end previous-extent) + )) + previous-extent)))) + +;; moved from x-select.el +(defun valid-simple-selection-p (data) + (or (stringp data) + ;FSFmacs huh?? (symbolp data) + (integerp data) + (and (consp data) + (integerp (car data)) + (or (integerp (cdr data)) + (and (consp (cdr data)) + (integerp (car (cdr data)))))) + (extentp data) + (and (consp data) + (markerp (car data)) + (markerp (cdr data)) + (marker-buffer (car data)) + (marker-buffer (cdr data)) + (eq (marker-buffer (car data)) + (marker-buffer (cdr data))) + (buffer-live-p (marker-buffer (car data))) + (buffer-live-p (marker-buffer (cdr data)))))) ;;; select.el ends here Index: lisp/x-select.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/x-select.el,v retrieving revision 1.3 diff -u -r1.3 x-select.el --- x-select.el 1998/03/31 20:11:13 1.3 +++ x-select.el 1998/04/29 17:54:02 @@ -73,78 +73,6 @@ "Return text pasted to the clipboard." (x-get-selection 'CLIPBOARD)) - -(defvar primary-selection-extent nil - "The extent of the primary selection; don't use this.") - -(defvar secondary-selection-extent nil - "The extent of the secondary selection; don't use this.") - - -(defun x-select-make-extent-for-selection (selection previous-extent) - ;; Given a selection, this makes an extent in the buffer which holds that - ;; selection, for highlighting purposes. If the selection isn't associated - ;; with a buffer, this does nothing. - (let ((buffer nil) - (valid (and (extentp previous-extent) - (extent-object previous-extent) - (buffer-live-p (extent-object previous-extent)))) - start end) - (cond ((stringp selection) - ;; if we're selecting a string, lose the previous extent used - ;; to highlight the selection. - (setq valid nil)) - ((consp selection) - (setq start (min (car selection) (cdr selection)) - end (max (car selection) (cdr selection)) - valid (and valid - (eq (marker-buffer (car selection)) - (extent-object previous-extent))) - buffer (marker-buffer (car selection)))) - ((extentp selection) - (setq start (extent-start-position selection) - end (extent-end-position selection) - valid (and valid - (eq (extent-object selection) - (extent-object previous-extent))) - buffer (extent-object selection))) - (t - (signal 'error (list "invalid selection" selection)))) - - (if valid - nil - (condition-case () - (if (listp previous-extent) - (mapcar 'delete-extent previous-extent) - (delete-extent previous-extent)) - (error nil))) - - (if (not buffer) - ;; string case - nil - ;; normal case - (if valid - (set-extent-endpoints previous-extent start end) - (setq previous-extent (make-extent start end buffer)) - - ;; Make the extent be closed on the right, which means that if - ;; characters are inserted exactly at the end of the extent, the - ;; extent will grow to cover them. This is important for shell - ;; buffers - suppose one makes a selection, and one end is at - ;; point-max. If the shell produces output, that marker will remain - ;; at point-max (its position will increase). So it's important that - ;; the extent exhibit the same behavior, lest the region covered by - ;; the extent (the visual indication), and the region between point - ;; and mark (the actual selection value) become different! - (set-extent-property previous-extent 'end-open nil) - - (cond - (mouse-track-rectangle-p - (setq previous-extent (list previous-extent)) - (default-mouse-track-next-move-rect start end previous-extent) - )) - previous-extent)))) - ;; FSFmacs calls this `x-set-selection', and reverses the ;; arguments (duh ...). This order is more logical. (defun x-own-selection (data &optional type) @@ -185,34 +113,17 @@ (x-disown-selection-internal type)) (cond ((eq type 'PRIMARY) (setq primary-selection-extent - (x-select-make-extent-for-selection + (select-make-extent-for-selection data primary-selection-extent))) ((eq type 'SECONDARY) (setq secondary-selection-extent - (x-select-make-extent-for-selection + (select-make-extent-for-selection data secondary-selection-extent)))) (setq zmacs-region-stays t) data) (defun x-valid-simple-selection-p (data) - (or (stringp data) - ;FSFmacs huh?? (symbolp data) - (integerp data) - (and (consp data) - (integerp (car data)) - (or (integerp (cdr data)) - (and (consp (cdr data)) - (integerp (car (cdr data)))))) - (extentp data) - (and (consp data) - (markerp (car data)) - (markerp (cdr data)) - (marker-buffer (car data)) - (marker-buffer (cdr data)) - (eq (marker-buffer (car data)) - (marker-buffer (cdr data))) - (buffer-live-p (marker-buffer (car data))) - (buffer-live-p (marker-buffer (cdr data)))))) + (valid-simple-selection-p data)) (defun x-own-secondary-selection (selection &optional type) "Make a secondary X Selection of the given argument. The argument may be a Index: lisp/x-toolbar.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/x-toolbar.el,v retrieving revision 1.9 diff -u -r1.9 x-toolbar.el --- x-toolbar.el 1998/04/07 05:39:28 1.9 +++ x-toolbar.el 1998/04/29 17:54:06 @@ -93,9 +93,9 @@ (interactive) (call-interactively toolbar-print-function)) -(defcustom toolbar-cut-function 'x-kill-primary-selection +(defcustom toolbar-cut-function 'kill-primary-selection "*Function to call when the cut icon is selected." - :type '(radio (function-item x-kill-primary-selection) + :type '(radio (function-item kill-primary-selection) (function :tag "Other")) :group 'toolbar) @@ -103,9 +103,9 @@ (interactive) (call-interactively toolbar-cut-function)) -(defcustom toolbar-copy-function 'x-copy-primary-selection +(defcustom toolbar-copy-function 'copy-primary-selection "*Function to call when the copy icon is selected." - :type '(radio (function-item x-copy-primary-selection) + :type '(radio (function-item copy-primary-selection) (function :tag "Other")) :group 'toolbar) @@ -113,9 +113,9 @@ (interactive) (call-interactively toolbar-copy-function)) -(defcustom toolbar-paste-function 'x-yank-clipboard-selection +(defcustom toolbar-paste-function 'yank-clipboard-selection "*Function to call when the paste icon is selected." - :type '(radio (function-item x-yank-clipboard-selection) + :type '(radio (function-item yank-clipboard-selection) (function :tag "Other")) :group 'toolbar)