Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
1a2b6c52
Commit
1a2b6c52
authored
Nov 08, 1993
by
Richard M. Stallman
Browse files
Initial revision
parent
794572af
Changes
3
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
1623 additions
and
0 deletions
+1623
-0
lisp/mouse-sel.el
lisp/mouse-sel.el
+437
-0
lisp/progmodes/pascal.el
lisp/progmodes/pascal.el
+980
-0
lisp/thingatpt.el
lisp/thingatpt.el
+206
-0
No files found.
lisp/mouse-sel.el
0 → 100644
View file @
1a2b6c52
;;; mouse-sel.el --- Multi-click selection support for Emacs 19
;; Copyright (C) 1993 Free Software Foundation, Inc.
;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
;; Keywords: mouse
;; Version: $Revision: 1.20 $
;; 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.
;;; Commentary:
;;
;; This module provides multi-click mouse support for GNU Emacs versions
;; 19.18 and later. I've tried to make it behave more like standard X
;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
;; Basically:
;;
;; * Clicking mouse-1 starts (cancels) selection, dragging extends it.
;;
;; * Clicking or dragging mouse-3 extends the selection as well.
;;
;; * Double-clicking on word constituents selects words.
;; Double-clicking on symbol constituents selects symbols.
;; Double-clicking on quotes or parentheses selects sexps.
;; Double-clicking on whitespace selects whitespace.
;; Triple-clicking selects lines.
;;
;; * Selecting sets the region & X primary selection, but does NOT affect
;; the kill-ring. Because the mouse handlers set the primary selection
;; directly, mouse-sel sets the variables interprogram-cut-function
;; and interprogram-paste-function to nil.
;;
;; * Clicking mouse-2 pastes contents of primary selection.
;;
;; * Pressing mouse-2 while selecting or extending copies selected text
;; to the kill ring. Pressing mouse-1 or mouse-3 kills it.
;;
;; This module requires my thingatpt.el module, version 1.14 or later, which
;; it uses to find the bounds of words, lines, sexps, etc.
;;
;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
;;
;; You may also want to use one or more of following:
;;
;; ;; Enable region highlight
;; (transient-mark-mode 1)
;;
;; ;; But only in the selected window
;; (setq highlight-nonselected-windows nil)
;;
;; ;; Enable pending-delete
;; (delete-selection-mode 1)
;;
;;--- Customisation -------------------------------------------------------
;;
;; * You can control the way mouse-sel binds it's keys by setting the value
;; of mouse-sel-default-bindings before loading mouse-sel.
;;
;; (a) If mouse-sel-default-bindings = t (the default)
;;
;; Mouse sets and pastes selection
;; mouse-1 mouse-select
;; mouse-2 mouse-insert-selection
;; mouse-3 mouse-extend
;;
;; Selection/kill-ring interaction is disabled
;; interprogram-cut-function = nil
;; interprogram-paste-function = nil
;;
;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
;;
;; Mouse sets selection, and pastes from kill-ring
;; mouse-1 mouse-select
;; mouse-2 mouse-yank-at-click
;; mouse-3 mouse-extend
;;
;; Selection/kill-ring interaction is retained
;; interprogram-cut-function = x-select-text
;; interprogram-paste-function = x-cut-buffer-or-selection-value
;;
;; What you lose is the ability to select some text in
;; delete-selection-mode and yank over the top of it.
;;
;; (c) If mouse-sel-default-bindings = nil, no bindings are made.
;;
;; * I like to leave point at the end of the region nearest to where the
;; mouse was, even though this makes region highlighting mis-leading (the
;; cursor makes it look like one extra character is selected). You can
;; disable this behaviour with:
;;
;; (setq mouse-sel-leave-point-near-mouse nil)
;;
;; * Normally, the selection highlight will be removed when the mouse is
;; lifted. You can tell mouse-sel to retain the selection highlight
;; (useful if you don't use transient-mark-mode) with:
;;
;; (setq mouse-sel-retain-highlight t)
;;
;; * By default, mouse-select cycles the click count after 3 clicks. That
;; is, clicking mouse-1 four times has the same effect as clicking it
;; once, clicking five times has the same effect as clicking twice, etc.
;; Disable this behaviour with:
;;
;; (setq mouse-sel-cycle-clicks nil)
;;
;; * The variables mouse-sel-{set,get,check}-selection-function control how
;; the selection is handled. Under X Windows, these variables default so
;; that the X primary selection is used. Under other windowing systems,
;; alternate functions are used, which simply store the selection value
;; in a variable.
;;
;;--- Hints ---------------------------------------------------------------
;;
;; * You can change the selection highlight face by altering the properties
;; of mouse-drag-overlay, eg.
;;
;; (overlay-put mouse-drag-overlay 'face 'bold)
;;
;; * Pasting from the primary selection under emacs 19.19 is SLOW (there's
;; a two second delay). The following code will cause mouse-sel to use
;; the cut buffer rather than the primary selection. However, be aware
;; that cut buffers are OBSOLETE, and some X applications may not support
;; them.
;;
;; (setq mouse-sel-set-selection-function 'x-select-text
;; mouse-sel-get-selection-function 'x-get-cut-buffer)
;;
;;--- Warnings ------------------------------------------------------------
;;
;; * When selecting sexps, the selection extends by sexps at the same
;; nesting level. This also means the selection cannot be extended out
;; of the enclosing nesting level. This is INTENTIONAL.
;;; Code:
(
provide
'mouse-sel
)
(
require
'mouse
)
(
require
'thingatpt
)
;;=== Version =============================================================
(
defconst
mouse-sel-version
(
substring
"$Revision: 1.20 $"
11
-2
)
"The revision number of mouse-sel (as string). The complete RCS id is:
$Id: mouse-sel.el,v 1.20 1993/09/30 23:57:32 mike Exp $"
)
;;=== User Variables ======================================================
(
defvar
mouse-sel-leave-point-near-mouse
t
"*Leave point near last mouse position.
If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
of the region nearest to where the mouse last was.
If nil, point will always be placed at the beginning of the region."
)
(
defvar
mouse-sel-retain-highlight
nil
"*Retain highlight on mouse-drag-overlay.
If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will
remain highlighted.
If nil, highlighting will be turned off when the mouse is lifted."
)
(
defvar
mouse-sel-cycle-clicks
t
"*If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks.
Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc."
)
(
defvar
mouse-sel-default-bindings
t
"Set to nil before loading mouse-sel to prevent default mouse bindings."
)
;;=== Selection ===========================================================
(
defvar
mouse-sel-selection-type
nil
"Type of current selection"
)
(
make-variable-buffer-local
'mouse-sel-selection-type
)
(
defvar
mouse-sel-selection
""
"This variable is used to store the selection value when mouse-sel is
used on windowing systems other than X Windows."
)
(
defvar
mouse-sel-set-selection-function
(
if
(
eq
window-system
'x
)
(
function
(
lambda
(
s
)
(
x-set-selection
'PRIMARY
s
)))
(
function
(
lambda
(
s
)
(
setq
mouse-sel-selection
s
))))
"Function to call to set selection.
Called with one argument, the text to select."
)
(
defvar
mouse-sel-get-selection-function
(
if
(
eq
window-system
'x
)
'x-get-selection
(
function
(
lambda
()
mouse-sel-selection
)))
"Function to call to get the selection.
Called with no argument, it should return the selected text."
)
(
defvar
mouse-sel-check-selection-function
(
if
(
eq
window-system
'x
)
'x-selection-owner-p
nil
)
"Function to check whether emacs still owns the selection.
Called with no arguments."
)
(
defun
mouse-sel-determine-selection-type
(
NCLICKS
)
"Determine what `thing' \\[mouse-select] and \\[mouse-extend] should
select by. The first argument is NCLICKS, is the number of consecutive
mouse clicks at the same position."
(
let*
((
next-char
(
char-after
(
point
)))
(
char-syntax
(
if
next-char
(
char-syntax
next-char
)))
(
nclicks
(
if
mouse-sel-cycle-clicks
(
1+
(
%
(
1-
NCLICKS
)
3
))
NCLICKS
)))
(
cond
((
=
nclicks
1
)
nil
)
((
>=
nclicks
3
)
'line
)
((
memq
char-syntax
'
(
?\(
?\)
?\"
?
'
))
'sexp
)
((
memq
next-char
'
(
?
?\t
?\n
))
'whitespace
)
((
eq
char-syntax
?_
)
'symbol
)
((
eq
char-syntax
?w
)
'word
))))
(
defun
mouse-select
(
EVENT
)
"Set region/selection using the mouse.
On click, point & mark are set to click position, and mark is disabled.
Dragging extends region/selection.
Double-clicking on word constituents selects words.
Double-clicking on symbol constituents selects symbols.
Double-clicking on quotes or parentheses selects sexps.
Double-clicking on whitespace selects whitespace.
Triple-clicking selects lines.
Clicking mouse-2 while selecting copies the region to the kill-ring.
Clicking mouse-1 or mouse-3 kills the region.
This should be bound to a down-mouse event."
(
interactive
"e"
)
(
mouse-set-point
EVENT
)
(
setq
mouse-sel-selection-type
(
mouse-sel-determine-selection-type
(
event-click-count
EVENT
)))
(
let
((
object-bounds
(
bounds-of-thing-at-point
mouse-sel-selection-type
)))
(
if
object-bounds
(
progn
(
setq
mark-active
t
)
(
goto-char
(
car
object-bounds
))
(
set-mark
(
cdr
object-bounds
)))
(
deactivate-mark
)))
(
mouse-extend
))
(
defun
mouse-extend
(
&optional
EVENT
)
"Extend region/selection using the mouse.
See documentation for mouse-select for more details.
This should be bound to a down-mouse event."
(
interactive
"e"
)
(
if
EVENT
(
select-window
(
posn-window
(
event-end
EVENT
))))
(
let*
((
min
(
if
mark-active
(
region-beginning
)
(
point
)))
(
max
(
if
mark-active
(
region-end
)
(
point
)))
(
orig-window
(
selected-window
))
(
orig-window-frame
(
window-frame
orig-window
))
(
top
(
nth
1
(
window-edges
orig-window
)))
(
bottom
(
nth
3
(
window-edges
orig-window
)))
(
orig-cursor-type
(
cdr
(
assoc
'cursor-type
(
frame-parameters
(
selected-frame
)))))
direction
event
)
;; Inhibit normal region highlight
(
setq
mark-active
nil
)
;; Highlight region (forcing re-highlight)
(
move-overlay
mouse-drag-overlay
min
max
(
current-buffer
))
(
overlay-put
mouse-drag-overlay
'face
(
overlay-get
mouse-drag-overlay
'face
))
;; Bar cursor
(
modify-frame-parameters
(
selected-frame
)
'
((
cursor-type
.
bar
)))
;; Handle dragging
(
unwind-protect
(
progn
(
track-mouse
(
while
(
if
EVENT
; Use initial event
(
prog1
(
setq
event
EVENT
)
(
setq
EVENT
nil
))
(
setq
event
(
read-event
))
(
and
(
consp
event
)
(
memq
(
car
event
)
'
(
mouse-movement
switch-frame
))))
(
let
((
end
(
event-end
event
)))
(
cond
;; Ignore any movement outside the frame
((
eq
(
car-safe
event
)
'switch-frame
)
nil
)
((
and
(
posn-window
end
)
(
not
(
eq
(
window-frame
(
posn-window
end
))
(
window-frame
orig-window
))))
nil
)
;; Different window, same frame
((
not
(
eq
(
posn-window
end
)
orig-window
))
(
let
((
end-row
(
cdr
(
cdr
(
mouse-position
)))))
(
cond
((
and
end-row
(
not
(
bobp
))
(
<
end-row
top
))
(
mouse-scroll-subr
(
-
end-row
top
)
mouse-drag-overlay
max
))
((
and
end-row
(
not
(
eobp
))
(
>=
end-row
bottom
))
(
mouse-scroll-subr
(
1+
(
-
end-row
bottom
))
mouse-drag-overlay
min
))
)))
;; On the mode line
((
eq
(
posn-point
end
)
'mode-line
)
(
mouse-scroll-subr
1
mouse-drag-overlay
min
))
;; In original window
(
t
(
goto-char
(
posn-point
end
)))
)
;; Determine direction of drag
(
cond
((
and
(
not
direction
)
(
not
(
eq
min
max
)))
(
setq
direction
(
if
(
<
(
point
)
(
/
(
+
min
max
)
2
))
-1
1
)))
((
and
(
not
(
eq
direction
-1
))
(
<=
(
point
)
min
))
(
setq
direction
-1
))
((
and
(
not
(
eq
direction
1
))
(
>=
(
point
)
max
))
(
setq
direction
1
)))
(
if
(
not
mouse-sel-selection-type
)
nil
;; If dragging forward, goal is next character
(
if
(
and
(
eq
direction
1
)
(
not
(
eobp
)))
(
forward-char
1
))
;; Move to start/end of selected thing
(
let
((
goal
(
point
))
last
)
(
goto-char
(
if
(
eq
1
direction
)
min
max
))
(
condition-case
nil
(
progn
(
while
(
>
(
*
direction
(
-
goal
(
point
)))
0
)
(
setq
last
(
point
))
(
forward-thing
mouse-sel-selection-type
direction
))
(
let
((
end
(
point
)))
(
forward-thing
mouse-sel-selection-type
(
-
direction
))
(
goto-char
(
if
(
>
(
*
direction
(
-
goal
(
point
)))
0
)
end
last
))))
(
error
))))
;; Move overlay
(
move-overlay
mouse-drag-overlay
(
if
(
eq
1
direction
)
min
(
point
))
(
if
(
eq
-1
direction
)
max
(
point
))
(
current-buffer
))
)))
; end track-mouse
(
let
((
overlay-start
(
overlay-start
mouse-drag-overlay
))
(
overlay-end
(
overlay-end
mouse-drag-overlay
)))
;; Set region
(
if
(
eq
overlay-start
overlay-end
)
(
deactivate-mark
)
(
if
(
and
mouse-sel-leave-point-near-mouse
(
eq
direction
1
))
(
progn
(
set-mark
overlay-start
)
(
goto-char
overlay-end
))
(
set-mark
overlay-end
)
(
goto-char
overlay-start
)))
;; Set selection
(
if
(
and
mark-active
mouse-sel-set-selection-function
)
(
funcall
mouse-sel-set-selection-function
(
buffer-substring
overlay-start
overlay-end
)))
;; Handle copy/kill
(
cond
((
eq
(
car-safe
last-input-event
)
'down-mouse-2
)
(
copy-region-as-kill
overlay-start
overlay-end
)
(
read-event
)
(
read-event
))
((
memq
(
car-safe
last-input-event
)
'
(
down-mouse-1
down-mouse-3
))
(
kill-region
overlay-start
overlay-end
)
(
deactivate-mark
)
(
read-event
)
(
read-event
)))))
;; Restore cursor
(
modify-frame-parameters
(
selected-frame
)
(
list
(
cons
'cursor-type
orig-cursor-type
)))
;; Remove overlay
(
or
mouse-sel-retain-highlight
(
delete-overlay
mouse-drag-overlay
)))))
(
defun
mouse-insert-selection
(
click
)
"Insert the contents of the selection at mouse click."
(
interactive
"e"
)
(
mouse-set-point
click
)
(
deactivate-mark
)
(
if
mouse-sel-get-selection-function
(
insert
(
or
(
funcall
mouse-sel-get-selection-function
)
""
))))
(
defun
mouse-sel-validate-selection
()
"Remove selection highlight if emacs no longer owns the primary selection."
(
or
(
not
mouse-sel-check-selection-function
)
(
funcall
mouse-sel-check-selection-function
)
(
delete-overlay
mouse-drag-overlay
)))
(
add-hook
'pre-command-hook
'mouse-sel-validate-selection
)
;;=== Key bindings ========================================================
(
if
(
not
mouse-sel-default-bindings
)
nil
(
global-unset-key
[mouse-1]
)
(
global-unset-key
[drag-mouse-1]
)
(
global-unset-key
[mouse-3]
)
(
global-set-key
[down-mouse-1]
'mouse-select
)
(
global-set-key
[down-mouse-3]
'mouse-extend
)
(
if
(
eq
mouse-sel-default-bindings
'interprogram-cut-paste
)
nil
(
global-set-key
[mouse-2]
'mouse-insert-selection
)
(
setq
interprogram-cut-function
nil
interprogram-paste-function
nil
))
)
;; mouse-sel.el ends here.
lisp/progmodes/pascal.el
0 → 100644
View file @
1a2b6c52
This diff is collapsed.
Click to expand it.
lisp/thingatpt.el
0 → 100644
View file @
1a2b6c52
;;; thingatpt.el --- Get the `thing' at point
;; Copyright (C) 1991,1992,1993 Free Software Foundation, Inc.
;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
;; Keywords: extensions
;; Created: Thu Mar 28 13:48:23 1991
;; Version: $Revision: 1.16 $
;; 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.
;;; Commentary:
;;
;; This file provides routines for getting the `thing' at the location of
;; point, whatever that `thing' happens to be. The `thing' is defined by
;; it's beginning and end positions in the buffer.
;;
;; The function bounds-of-thing-at-point finds the beginning and end
;; positions by moving first forward to the end of the `thing', and then
;; backwards to the beginning. By default, it uses the corresponding
;; forward-`thing' operator (eg. forward-word, forward-line).
;;
;; Special cases are allowed for using properties associated with the named
;; `thing':
;;
;; forward-op Function to call to skip forward over a `thing' (or
;; with a negative argument, backward).
;;
;; beginning-op Function to call to skip to the beginning of a `thing'.
;; end-op Function to call to skip to the end of a `thing'.
;;
;; Reliance on existing operators means that many `things' can be accessed
;; without further code: eg.
;; (thing-at-point 'line)
;; (thing-at-point 'page)
;;; Code:
(
provide
'thingatpt
)
;;=== Version =============================================================
(
defconst
thing@pt-version
(
substring
"$Revision: 1.16 $"
11
-2
)
"The revision number of thing@pt (as string). The complete RCS id is:
$Id: thing@pt.el,v 1.16 1993/09/30 23:54:56 mike Exp $"
)
;;=== Basic movement ======================================================
;;;###autoload
(
defun
forward-thing
(
THING
&optional
N
)
"Move forward to the end of the next THING."
(
let
((
forward-op
(
or
(
get
THING
'forward-op
)
(
intern-soft
(
format
"forward-%s"
THING
)))))
(
if
(
fboundp
forward-op
)
(
funcall
forward-op
(
or
N
1
))
(
error
"Can't determine how to move over %ss"
THING
))))
;;=== General routines ====================================================
;;;###autoload
(
defun
bounds-of-thing-at-point
(
THING
)
"Determine the start and end buffer locations for the THING at point,
where THING is an entity for which there is a either a corresponding
forward-THING operation, or corresponding beginning-of-THING and
end-of-THING operations, eg. 'word, 'sentence, 'defun.
Return a cons cell '(start . end) giving the start and end positions."
(
let
((
orig
(
point
)))
(
condition-case
nil
(
save-excursion
(
let
((
end
(
progn
(
funcall
(
or
(
get
THING
'end-op
)
(
function
(
lambda
()
(
forward-thing
THING
1
)))))
(
point
)))
(
beg
(
progn
(
funcall
(
or
(
get
THING
'beginning-op
)
(
function
(
lambda
()
(
forward-thing
THING
-1
)))))
(
point
))))
(
if
(
and
beg
end
(
<=
beg
orig
)
(
<
orig
end
))
(
cons
beg
end
))))
(
error
nil
))))
;;;###autoload
(
defun
thing-at-point
(
THING
)
"Return the THING at point, where THING is an entity defined by
bounds-of-thing-at-point."
(
let
((
bounds
(
bounds-of-thing-at-point
THING
)))
(
if
bounds
(
buffer-substring
(
car
bounds
)
(
cdr
bounds
)))))
;;=== Go to beginning/end =================================================
(
defun
beginning-of-thing
(
THING
)
(
let
((
bounds
(
bounds-of-thing-at-point
THING
)))
(
or
bounds
(
error
"No %s here"
THING
))
(
goto-char
(
car
bounds
))))
(
defun
end-of-thing
(
THING
)
(
let
((
bounds
(
bounds-of-thing-at-point
THING
)))
(
or
bounds
(
error
"No %s here"
THING
))
(
goto-char
(
cdr
bounds
))))
;;=== Special cases =======================================================
;;--- Sexps ---
(
defun
in-string-p
()
(
let
((
orig
(
point
)))
(
save-excursion
(
beginning-of-defun
)
(
nth
3
(
parse-partial-sexp
(
point
)
orig
)))))
(
defun
end-of-sexp
()
(
let
((
char-syntax
(
char-syntax
(
char-after
(
point
)))))
(
if
(
or
(
eq
char-syntax
?\)
)
(
and
(
eq
char-syntax
?\"
)
(
in-string-p
)))
(
forward-char
1
)
(
forward-sexp
1
))))
(
put
'sexp
'end-op
'end-of-sexp
)
;;--- Lists ---
(
put
'list
'end-op
(
function
(
lambda
()
(
up-list
1
))))
(
put
'list
'beginning-op
'backward-sexp
)
;;--- Filenames ---
(
defvar
file-name-chars
"~/A-Za-z0-9---_.${}#%,"
"Characters allowable in filenames."
)
(
put
'filename
'end-op
(
function
(
lambda
()
(
skip-chars-forward
file-name-chars
))))
(
put
'filename
'beginning-op
(
function
(
lambda
()
(
skip-chars-backward
file-name-chars
(
point-min
)))))
;;--- Whitespace ---
(
defun
forward-whitespace
(
ARG
)
(
interactive
"p"
)
(
if
(
natnump
ARG
)
(
re-search-forward
"[ \t]+\\|\n"
nil
nil
ARG
)
(
while
(
<
ARG
0
)
(
if
(
re-search-backward
"[ \t]+\\|\n"
nil
nil
)
(
or
(
eq
(
char-after
(
match-beginning
0
))
10
)
(
skip-chars-backward
" \t"
)))
(
setq
ARG
(
1+
ARG
)))))
;;--- Buffer ---
(
put
'buffer
'end-op
'end-of-buffer
)
(
put
'buffer
'beginning-op
'beginning-of-buffer
)
;;--- Symbols ---
(
defun
forward-symbol
(
ARG
)
(
interactive
"p"
)
(
if
(
natnump
ARG
)
(
re-search-forward
"\\(\\sw\\|\\s_\\)+"
nil
nil
ARG
)
(
while
(
<
ARG
0
)
(
if
(
re-search-backward
"\\(\\sw\\|\\s_\\)+"
nil
nil
)
(
skip-syntax-backward
"w_"
))
(
setq
ARG
(
1+
ARG
)))))
;;=== Aliases =============================================================
(
defun
word-at-point
()
(
thing-at-point
'word
))
(
defun
sentence-at-point
()
(
thing-at-point
'sentence
))
(
defun
read-from-whole-string
(
STR
)
"Read a lisp expression from STR, signalling an error if the entire string
was not used."
(
let*
((
read-data
(
read-from-string
STR
))
(
more-left
(
condition-case
nil
(
progn
(
read-from-string
(
substring
STR
(
cdr
read-data
)))
t
)
(
end-of-file
nil
))))
(
if
more-left
(
error
"Can't read whole string"
)
(
car
read-data
))))