--- /dev/null
+;;; select.el --- Lisp interface to windows selections.
+
+;; 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
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs
+
+;;; Code:
+
+(defun copy-primary-selection ()
+ "Copy the selection to the Clipboard and the kill ring."
+ (interactive)
+ (and (console-on-window-system-p)
+ (cut-copy-clear-internal 'copy)))
+(define-obsolete-function-alias
+ 'x-copy-primary-selection
+ 'copy-primary-selection)
+
+(defun kill-primary-selection ()
+ "Copy the selection to the Clipboard and the kill ring, then delete it."
+ (interactive "*")
+ (and (console-on-window-system-p)
+ (cut-copy-clear-internal 'cut)))
+(define-obsolete-function-alias
+ 'x-kill-primary-selection
+ 'kill-primary-selection)
+
+(defun delete-primary-selection ()
+ "Delete the selection without copying it to the Clipboard or the kill ring."
+ (interactive "*")
+ (and (console-on-window-system-p)
+ (cut-copy-clear-internal 'clear)))
+(define-obsolete-function-alias
+ 'x-delete-primary-selection
+ 'delete-primary-selection)
+
+(defun yank-clipboard-selection ()
+ "Insert the current Clipboard selection at point."
+ (interactive "*")
+ (case (device-type (selected-device))
+ (x (x-yank-clipboard-selection))
+ (mswindows (mswindows-paste-clipboard))
+ (otherwise nil)))
+
+(defun selection-owner-p (&optional selection)
+ "Return t if current emacs process owns the given Selection.
+The arg should be the name of the selection in question, typically one
+of the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience,
+the symbol nil is the same as PRIMARY, and t is the same as
+SECONDARY.)"
+ (interactive)
+ (case (device-type (selected-device))
+ (x (x-selection-owner-p selection))
+ (mswindows (mswindows-selection-owner-p selection))
+ (otherwise nil)))
+
+(defun selection-exists-p (&optional selection)
+ "Whether there is an owner for the given Selection.
+The arg should be the name of the selection in question, typically one
+of the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience,
+the symbol nil is the same as PRIMARY, and t is the same as
+SECONDARY."
+ (interactive)
+ (case (device-type (selected-device))
+ (x (x-selection-exists-p selection))
+ (mswindows (mswindows-selection-exists-p))
+ (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 own-clipboard (string)
+ "Paste the given string to the Clipboard."
+ (case (device-type (selected-device))
+ (x (x-own-clipboard string))
+ (mswindows (mswindows-own-clipboard string))
+ (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))))
+(define-obsolete-function-alias
+ 'x-select-make-extent-for-selection
+ 'select-make-extent-for-selection)
+
+;; 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))))))
+(define-obsolete-function-alias
+ 'x-valid-simple-selection-p
+ 'valid-simple-selection-p)
+
+(defun cut-copy-clear-internal (mode)
+ (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode))
+ (or (selection-owner-p)
+ (error "emacs does not own the primary selection"))
+ (setq last-command nil)
+ (or primary-selection-extent
+ (error "the primary selection is not an extent?"))
+ (save-excursion
+ (let (rect-p b s e)
+ (cond
+ ((consp primary-selection-extent)
+ (setq rect-p t
+ b (extent-object (car primary-selection-extent))
+ s (extent-start-position (car primary-selection-extent))
+ e (extent-end-position (car (reverse primary-selection-extent)))))
+ (t
+ (setq rect-p nil
+ b (extent-object primary-selection-extent)
+ s (extent-start-position primary-selection-extent)
+ e (extent-end-position primary-selection-extent))))
+ (set-buffer b)
+ (cond ((memq mode '(cut copy))
+ (if rect-p
+ (progn
+ ;; why is killed-rectangle free? Is it used somewhere?
+ ;; should it be defvarred?
+ (setq killed-rectangle (extract-rectangle s e))
+ (kill-new (mapconcat 'identity killed-rectangle "\n")))
+ (copy-region-as-kill s e))
+ ;; Maybe killing doesn't own clipboard. Make sure it happens.
+ ;; This memq is kind of grody, because they might have done it
+ ;; some other way, but owning the clipboard twice in that case
+ ;; wouldn't actually hurt anything.
+ (or (and (consp kill-hooks) (memq 'own-clipboard kill-hooks))
+ (own-clipboard (car kill-ring)))))
+ (cond ((memq mode '(cut clear))
+ (if rect-p
+ (delete-rectangle s e)
+ (delete-region s e))))
+ (disown-selection nil)
+ )))
+(define-obsolete-function-alias
+ 'x-cut-copy-clear-internal
+ 'cut-copy-clear-internal)
+
+;;; select.el ends here
projects / chise / xemacs-chise.git.1 / blobdiff