Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
3109d63f
Commit
3109d63f
authored
Mar 17, 1993
by
Eric S. Raymond
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Initial revision
parent
76550a57
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
532 additions
and
0 deletions
+532
-0
lisp/emacs-lisp/lselect.el
lisp/emacs-lisp/lselect.el
+228
-0
lisp/select.el
lisp/select.el
+304
-0
No files found.
lisp/emacs-lisp/lselect.el
0 → 100644
View file @
3109d63f
;;; lselect.el --- Lucid interface to X Selections
;; Keywords: emulations
;; This won't completely work until we support or emulate Lucid-style extents.
;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
;; Based on Lucid's selection code.
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Code:
;;; The selection code requires us to use certain symbols whose names are
;;; all upper-case; this may seem tasteless, but it makes there be a 1:1
;;; correspondence between these symbols and X Atoms (which are upcased.)
(
fset
'x-get-cutbuffer
'x-get-cut-buffer
)
(
fset
'x-store-cutbuffer
'x-set-cut-buffer
)
(
or
(
find-face
'primary-selection
)
(
make-face
'primary-selection
))
(
or
(
find-face
'secondary-selection
)
(
make-face
'secondary-selection
))
(
defun
x-get-secondary-selection
()
"Return text selected from some X window."
(
x-get-selection-internal
'SECONDARY
'STRING
))
(
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
face
)
;; 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-buffer
previous-extent
)
(
buffer-name
(
extent-buffer
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-buffer
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-buffer
selection
)
(
extent-buffer
previous-extent
)))
buffer
(
extent-buffer
selection
)))
)
(
if
(
and
(
not
valid
)
(
extentp
previous-extent
)
(
extent-buffer
previous-extent
)
(
buffer-name
(
extent-buffer
previous-extent
)))
(
delete-extent
previous-extent
))
(
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
))
;; use same priority as mouse-highlighting so that conflicts between
;; the selection extent and a mouse-highlighted extent are resolved
;; by the usual size-and-endpoint-comparison method.
(
set-extent-priority
previous-extent
mouse-highlight-priority
)
(
set-extent-face
previous-extent
face
)))))
(
defun
x-own-selection
(
selection
&optional
type
)
"Make a primary X Selection of the given argument.
The argument may be a string, a cons of two markers, or an extent.
In the latter cases the selection is considered to be the text
between the markers, or the between extents endpoints."
(
interactive
(
if
(
not
current-prefix-arg
)
(
list
(
read-string
"Store text for pasting: "
))
(
list
(
cons
;; these need not be ordered.
(
copy-marker
(
point-marker
))
(
copy-marker
(
mark-marker
))))))
(
or
type
(
setq
type
'PRIMARY
))
(
x-set-selection
selection
type
)
(
cond
((
eq
type
'PRIMARY
)
(
setq
primary-selection-extent
(
x-select-make-extent-for-selection
selection
primary-selection-extent
'primary-selection
)))
((
eq
type
'SECONDARY
)
(
setq
secondary-selection-extent
(
x-select-make-extent-for-selection
selection
secondary-selection-extent
'secondary-selection
))))
selection
)
(
defun
x-own-secondary-selection
(
selection
&optional
type
)
"Make a secondary X Selection of the given argument. The argument may be a
string or a cons of two markers (in which case the selection is considered to
be the text between those markers.)"
(
interactive
(
if
(
not
current-prefix-arg
)
(
list
(
read-string
"Store text for pasting: "
))
(
list
(
cons
;; these need not be ordered.
(
copy-marker
(
point-marker
))
(
copy-marker
(
mark-marker
))))))
(
x-own-selection
selection
'SECONDARY
))
(
defun
x-own-clipboard
(
string
)
"Paste the given string to the X Clipboard."
(
x-own-selection
string
'CLIPBOARD
))
(
defun
x-disown-selection
(
&optional
secondary-p
)
"Assuming we own the selection, disown it. With an argument, discard the
secondary selection instead of the primary selection."
(
x-disown-selection-internal
(
if
secondary-p
'SECONDARY
'PRIMARY
)))
(
defun
x-dehilight-selection
(
selection
)
"for use as a value of x-lost-selection-hooks."
(
cond
((
eq
selection
'PRIMARY
)
(
if
primary-selection-extent
(
let
((
inhibit-quit
t
))
(
delete-extent
primary-selection-extent
)
(
setq
primary-selection-extent
nil
)))
(
if
zmacs-regions
(
zmacs-deactivate-region
)))
((
eq
selection
'SECONDARY
)
(
if
secondary-selection-extent
(
let
((
inhibit-quit
t
))
(
delete-extent
secondary-selection-extent
)
(
setq
secondary-selection-extent
nil
)))))
nil
)
(
setq
x-lost-selection-hooks
'x-dehilight-selection
)
(
defun
x-notice-selection-requests
(
selection
type
successful
)
"for possible use as the value of x-sent-selection-hooks."
(
if
(
not
successful
)
(
message
"Selection request failed to convert %s to %s"
selection
type
)
(
message
"Sent selection %s as %s"
selection
type
)))
(
defun
x-notice-selection-failures
(
selection
type
successful
)
"for possible use as the value of x-sent-selection-hooks."
(
or
successful
(
message
"Selection request failed to convert %s to %s"
selection
type
)))
;(setq x-sent-selection-hooks 'x-notice-selection-requests)
;(setq x-sent-selection-hooks 'x-notice-selection-failures)
;;; Random utility functions
(
defun
x-kill-primary-selection
()
"If there is a selection, delete the text it covers, and copy it to
both the kill ring and the Clipboard."
(
interactive
)
(
or
(
x-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
(
set-buffer
(
extent-buffer
primary-selection-extent
))
(
kill-region
(
extent-start-position
primary-selection-extent
)
(
extent-end-position
primary-selection-extent
)))
(
x-disown-selection
nil
))
(
defun
x-delete-primary-selection
()
"If there is a selection, delete the text it covers *without* copying it to
the kill ring or the Clipboard."
(
interactive
)
(
or
(
x-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
(
set-buffer
(
extent-buffer
primary-selection-extent
))
(
delete-region
(
extent-start-position
primary-selection-extent
)
(
extent-end-position
primary-selection-extent
)))
(
x-disown-selection
nil
))
(
defun
x-copy-primary-selection
()
"If there is a selection, copy it to both the kill ring and the Clipboard."
(
interactive
)
(
setq
last-command
nil
)
(
or
(
x-selection-owner-p
)
(
error
"emacs does not own the primary selection"
))
(
or
primary-selection-extent
(
error
"the primary selection is not an extent?"
))
(
save-excursion
(
set-buffer
(
extent-buffer
primary-selection-extent
))
(
copy-region-as-kill
(
extent-start-position
primary-selection-extent
)
(
extent-end-position
primary-selection-extent
))))
(
defun
x-yank-clipboard-selection
()
"If someone owns a Clipboard selection, insert it at point."
(
interactive
)
(
setq
last-command
nil
)
(
let
((
clip
(
x-get-clipboard
)))
(
or
clip
(
error
"there is no clipboard selection"
))
(
push-mark
)
(
insert
clip
)))
;;; lselect.el ends here.
lisp/select.el
0 → 100644
View file @
3109d63f
;;; select.el --- lisp portion of standard selection support.
;; Keywords: internal
;; Copyright (c) 1993 Free Software Foundation, Inc.
;; Based partially on earlier release by Lucid.
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Code:
;; This is for temporary compatibility with pre-release Emacs 19.
(
fset
'x-selection
'x-get-selection
)
(
defun
x-get-selection
(
&optional
type
data-type
)
"Return the value of an X Windows selection.
The argument TYPE (default `PRIMARY') says which selection,
and the argument DATA-TYPE (default `STRING') says how to convert the data."
(
x-get-selection-internal
(
or
type
'PRIMARY
)
(
or
data-type
'STRING
)))
(
defun
x-get-clipboard
()
"Return text pasted to the clipboard."
(
x-get-selection-internal
'CLIPBOARD
'STRING
))
(
defun
x-set-selection
(
type
data
)
"Make an X 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),
or a cons of two markers pointing to the same buffer.
In the last case, the selection is considered to be the text
between the markers.
The data may also be a vector of valid non-vector selection values."
(
interactive
(
if
(
not
current-prefix-arg
)
(
list
(
read-string
"Store text for pasting: "
))
(
list
(
cons
;; these need not be ordered.
(
copy-marker
(
point-marker
))
(
copy-marker
(
mark-marker
))))))
;; This is for temporary compatibility with pre-release Emacs 19.
(
if
(
stringp
type
)
(
setq
type
(
intern
type
)))
(
or
(
x-valid-simple-selection-p
data
)
(
and
(
vectorp
data
)
(
let
((
valid
t
)
(
i
(
1-
(
length
data
))))
(
while
(
>=
i
0
)
(
or
(
x-valid-simple-selection-p
(
aref
data
i
))
(
setq
valid
nil
))
(
setq
i
(
1-
i
)))
valid
))
(
signal
'error
(
list
"invalid selection"
data
)))
(
or
type
(
setq
type
'PRIMARY
))
(
if
data
(
x-own-selection-internal
type
data
)
(
x-disown-selection-internal
type
))
data
)
(
defun
x-valid-simple-selection-p
(
data
)
(
or
(
stringp
data
)
(
symbolp
data
)
(
integerp
data
)
(
and
(
consp
data
)
(
integerp
(
car
data
))
(
or
(
integerp
(
cdr
data
))
(
and
(
consp
(
cdr
data
))
(
integerp
(
car
(
cdr
data
))))))
;;; (and (fboundp 'extentp)
;;; (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-name
(
marker-buffer
(
car
data
)))
(
buffer-name
(
marker-buffer
(
cdr
data
))))))
;;; Cut Buffer support
(
defun
x-get-cut-buffer
(
&optional
which-one
)
"Returns the value of one of the 8 X server cut-buffers. Optional arg
WHICH-ONE should be a number from 0 to 7, defaulting to 0.
Cut buffers are considered obsolete; you should use selections instead."
(
x-get-cut-buffer-internal
(
if
which-one
(
aref
[CUT_BUFFER0
CUT_BUFFER1
CUT_BUFFER2
CUT_BUFFER3
CUT_BUFFER4
CUT_BUFFER5
CUT_BUFFER6
CUT_BUFFER7]
which-one
)
'CUT_BUFFER0
)))
(
defun
x-set-cut-buffer
(
string
)
"Store STRING into the X server's primary cut buffer.
The previous value of the primary cut buffer is rotated to the secondary
cut buffer, and the second to the third, and so on (there are 8 buffers.)
Cut buffers are considered obsolete; you should use selections instead."
;; Check the data type of STRING.
(
substring
string
0
0
)
(
x-rotate-cut-buffers-internal
1
)
(
x-store-cut-buffer-internal
'CUT_BUFFER0
string
))
;;; Functions to convert the selection into various other selection types.
;;; Every selection type that Emacs handles is implemented this way, except
;;; for TIMESTAMP, which is a special case.
(
defun
xselect-convert-to-string
(
selection
type
value
)
(
cond
((
stringp
value
)
value
)
;;; ((extentp value)
;;; (save-excursion
;;; (set-buffer (extent-buffer value))
;;; (buffer-substring (extent-start-position value)
;;; (extent-end-position value))))
((
and
(
consp
value
)
(
markerp
(
car
value
))
(
markerp
(
cdr
value
)))
(
or
(
eq
(
marker-buffer
(
car
value
))
(
marker-buffer
(
cdr
value
)))
(
signal
'error
(
list
"markers must be in the same buffer"
(
car
value
)
(
cdr
value
))))
(
save-excursion
(
set-buffer
(
or
(
marker-buffer
(
car
value
))
(
error
"selection is in a killed buffer"
)))
(
buffer-substring
(
car
value
)
(
cdr
value
))))
(
t
nil
)))
(
defun
xselect-convert-to-length
(
selection
type
value
)
(
let
((
value
(
cond
((
stringp
value
)
(
length
value
))
;;; ((extentp value)
;;; (extent-length value))
((
and
(
consp
value
)
(
markerp
(
car
value
))
(
markerp
(
cdr
value
)))
(
or
(
eq
(
marker-buffer
(
car
value
))
(
marker-buffer
(
cdr
value
)))
(
signal
'error
(
list
"markers must be in the same buffer"
(
car
value
)
(
cdr
value
))))
(
abs
(
-
(
car
value
)
(
cdr
value
)))))))
(
if
value
; force it to be in 32-bit format.
(
cons
(
ash
value
-16
)
(
logand
value
65535
))
nil
)))
(
defun
xselect-convert-to-targets
(
selection
type
value
)
;; return a vector of atoms, but remove duplicates first.
(
let*
((
all
(
cons
'TIMESTAMP
(
mapcar
'car
selection-converter-alist
)))
(
rest
all
))
(
while
rest
(
cond
((
memq
(
car
rest
)
(
cdr
rest
))
(
setcdr
rest
(
delq
(
car
rest
)
(
cdr
rest
))))
((
eq
(
car
(
cdr
rest
))
'_EMACS_INTERNAL
)
; shh, it's a secret
(
setcdr
rest
(
cdr
(
cdr
rest
))))
(
t
(
setq
rest
(
cdr
rest
)))))
(
apply
'vector
all
)))
(
defun
xselect-convert-to-delete
(
selection
type
value
)
(
x-disown-selection-internal
selection
)
;; A return value of nil means that we do not know how to do this conversion,
;; and replies with an "error". A return value of NULL means that we have
;; done the conversion (and any side-effects) but have no value to return.
'NULL
)
(
defun
xselect-convert-to-filename
(
selection
type
value
)
(
cond
;;; ((extentp value)
;;; (buffer-file-name (or (extent-buffer value)
;;; (error "selection is in a killed buffer"))))
((
and
(
consp
value
)
(
markerp
(
car
value
))
(
markerp
(
cdr
value
)))
(
buffer-file-name
(
or
(
marker-buffer
(
car
value
))
(
error
"selection is in a killed buffer"
))))
(
t
nil
)))
(
defun
xselect-convert-to-charpos
(
selection
type
value
)
(
let
(
a
b
tmp
)
(
cond
((
cond
;;; ((extentp value)
;;; (setq a (extent-start-position value)
;;; b (extent-end-position value)))
((
and
(
consp
value
)
(
markerp
(
car
value
))
(
markerp
(
cdr
value
)))
(
setq
a
(
car
value
)
b
(
cdr
value
))))
(
setq
a
(
1-
a
)
b
(
1-
b
))
; zero-based
(
if
(
<
b
a
)
(
setq
tmp
a
a
b
b
tmp
))
(
cons
'SPAN
(
vector
(
cons
(
ash
a
-16
)
(
logand
a
65535
))
(
cons
(
ash
b
-16
)
(
logand
b
65535
))))))))
(
defun
xselect-convert-to-lineno
(
selection
type
value
)
(
let
(
a
b
buf
tmp
)
(
cond
((
cond
((
and
(
consp
value
)
(
markerp
(
car
value
))
(
markerp
(
cdr
value
)))
(
setq
a
(
marker-position
(
car
value
))
b
(
marker-position
(
cdr
value
))
buf
(
marker-buffer
(
car
value
))))
;;; ((extentp value)
;;; (setq buf (extent-buffer value)
;;; a (extent-start-position value)
;;; b (extent-end-position value)))
)
(
save-excursion
(
set-buffer
buf
)
(
setq
a
(
count-lines
1
a
)
b
(
count-lines
1
b
)))
(
if
(
<
b
a
)
(
setq
tmp
a
a
b
b
tmp
))
(
cons
'SPAN
(
vector
(
cons
(
ash
a
-16
)
(
logand
a
65535
))
(
cons
(
ash
b
-16
)
(
logand
b
65535
))))))))
(
defun
xselect-convert-to-colno
(
selection
type
value
)
(
let
(
a
b
buf
tmp
)
(
cond
((
cond
((
and
(
consp
value
)
(
markerp
(
car
value
))
(
markerp
(
cdr
value
)))
(
setq
a
(
car
value
)
b
(
cdr
value
)
buf
(
marker-buffer
a
)))
;;; ((extentp value)
;;; (setq buf (extent-buffer value)
;;; a (extent-start-position value)
;;; b (extent-end-position value)))
)
(
save-excursion
(
set-buffer
buf
)
(
goto-char
a
)
(
setq
a
(
current-column
))
(
goto-char
b
)
(
setq
b
(
current-column
)))
(
if
(
<
b
a
)
(
setq
tmp
a
a
b
b
tmp
))
(
cons
'SPAN
(
vector
(
cons
(
ash
a
-16
)
(
logand
a
65535
))
(
cons
(
ash
b
-16
)
(
logand
b
65535
))))))))
(
defun
xselect-convert-to-os
(
selection
type
size
)
(
symbol-name
system-type
))
(
defun
xselect-convert-to-host
(
selection
type
size
)
(
system-name
))
(
defun
xselect-convert-to-user
(
selection
type
size
)
(
user-full-name
))
(
defun
xselect-convert-to-class
(
selection
type
size
)
x-emacs-application-class
)
;; We do not try to determine the name Emacs was invoked with,
;; because it is not clean for a program's behavior to depend on that.
(
defun
xselect-convert-to-name
(
selection
type
size
)
"emacs"
)
(
defun
xselect-convert-to-integer
(
selection
type
value
)
(
and
(
integerp
value
)
(
cons
(
ash
value
-16
)
(
logand
value
65535
))))
(
defun
xselect-convert-to-atom
(
selection
type
value
)
(
and
(
symbolp
value
)
value
))
(
defun
xselect-convert-to-identity
(
selection
type
value
)
; used internally
(
vector
value
))
(
setq
selection-converter-alist
'
((
TEXT
.
xselect-convert-to-string
)
(
STRING
.
xselect-convert-to-string
)
(
TARGETS
.
xselect-convert-to-targets
)
(
LENGTH
.
xselect-convert-to-length
)
(
DELETE
.
xselect-convert-to-delete
)
(
FILE_NAME
.
xselect-convert-to-filename
)
(
CHARACTER_POSITION
.
xselect-convert-to-charpos
)
(
LINE_NUMBER
.
xselect-convert-to-lineno
)
(
COLUMN_NUMBER
.
xselect-convert-to-colno
)
(
OWNER_OS
.
xselect-convert-to-os
)
(
HOST_NAME
.
xselect-convert-to-host
)
(
USER
.
xselect-convert-to-user
)
(
CLASS
.
xselect-convert-to-class
)
(
NAME
.
xselect-convert-to-name
)
(
ATOM
.
xselect-convert-to-atom
)
(
INTEGER
.
xselect-convert-to-integer
)
(
_EMACS_INTERNAL
.
xselect-convert-to-identity
)
))
(
provide
'select
)
;;; select.el ends here.
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment