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
0231f2dc
Commit
0231f2dc
authored
Dec 21, 1991
by
Jim Blandy
Browse files
Initial revision
parent
2b529dd2
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
1267 additions
and
0 deletions
+1267
-0
lisp/emacs-lisp/autoload.el
lisp/emacs-lisp/autoload.el
+290
-0
lisp/emacs-lisp/debug.el
lisp/emacs-lisp/debug.el
+347
-0
lisp/play/blackbox.el
lisp/play/blackbox.el
+420
-0
lisp/progmodes/asm-mode.el
lisp/progmodes/asm-mode.el
+210
-0
No files found.
lisp/emacs-lisp/autoload.el
0 → 100644
View file @
0231f2dc
;;; Maintain autoloads in loaddefs.el.
;;; Copyright (C) 1991 Free Software Foundation, Inc.
;;; Written by Roland McGrath.
;;;
;;; This program 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 1, or (at your option)
;;; any later version.
;;;
;;; This program 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.
;;;
;;; A copy of the GNU General Public License can be obtained from this
;;; program's author (send electronic mail to roland@ai.mit.edu) or from
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
;;;
(
defun
make-autoload
(
form
file
)
"Turn FORM, a defun or defmacro, into an autoload for source file FILE.
Returns nil if FORM is not a defun or defmacro."
(
let
((
car
(
car-safe
form
)))
(
if
(
or
(
eq
car
'defun
)
(
eq
car
'defmacro
))
(
let
(
name
doc
macrop
)
(
setq
macrop
(
eq
car
'defmacro
))
(
setq
form
(
cdr
form
))
(
setq
name
(
car
form
))
;; Ignore the arguments.
(
setq
form
(
cdr
(
cdr
form
)))
(
setq
doc
(
car
form
))
(
if
(
stringp
doc
)
(
setq
form
(
cdr
form
))
(
setq
doc
nil
))
(
list
'autoload
(
list
'quote
name
)
file
doc
(
eq
(
car-safe
(
car
form
))
'interactive
)
macrop
))
nil
)))
(
defconst
generate-autoload-cookie
";;;###autoload"
"Magic comment that tells \\[update-file-autoloads]
to make the following form into an autoload. This string should be
meaningless to Lisp (e.g., a comment).
This string is used:
;;;###autoload
\(defun function-to-be-autoloaded () ...)
If this string appears alone on a line, the following form will be
read and an autoload made for it. If there is further text on the line,
that text will be copied verbatim to `generated-autoload-file'."
)
(
defconst
generate-autoload-section-header
"\f\n;;;### "
"String inserted before the form identifying
the section of autoloads for a file."
)
(
defconst
generate-autoload-section-trailer
"\n;;;***\n"
"String which indicates the end of the section of autoloads for a file."
)
;; Forms which have doc-strings which should be printed specially.
;; A doc-string-elt property of ELT says that (nth ELT FORM) is
;; the doc-string in FORM.
;; Note: defconst and defvar should NOT be marked in this way.
;; We don't want to produce defconsts and defvars that make-docfile can
;; grok, because then it would grok them twice, once in foo.el (where they
;; are given with ;;;###autoload) and once in loaddefs.el.
(
put
'autoload
'doc-string-elt
3
)
(
defun
generate-file-autoloads
(
file
)
"Insert at point a loaddefs autoload section for FILE.
autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-regexp' (which see).
If FILE is being visited in a buffer, the contents of the buffer
are used."
(
interactive
"fGenerate autoloads for file: "
)
(
let
((
outbuf
(
current-buffer
))
(
inbuf
(
find-file-noselect
file
))
(
autoloads-done
'
())
(
load-name
(
let
((
name
(
file-name-nondirectory
file
)))
(
if
(
string-match
"\\.elc?$"
name
)
(
substring
name
0
(
match-beginning
0
))
name
)))
(
print-length
nil
)
(
floating-output-format
"%20e"
)
(
done-any
nil
)
output-end
)
(
message
"Generating autoloads for %s..."
file
)
(
save-excursion
(
set-buffer
inbuf
)
(
save-excursion
(
save-restriction
(
widen
)
(
goto-char
(
point-min
))
(
while
(
not
(
eobp
))
(
skip-chars-forward
" \t\n\f"
)
(
cond
((
looking-at
(
regexp-quote
generate-autoload-cookie
))
(
search-forward
generate-autoload-cookie
)
(
skip-chars-forward
" \t"
)
(
setq
done-any
t
)
(
if
(
eolp
)
;; Read the next form and make an autoload.
(
let*
((
form
(
prog1
(
read
(
current-buffer
))
(
forward-line
1
)))
(
autoload
(
make-autoload
form
load-name
))
(
doc-string-elt
(
get
(
car-safe
form
)
'doc-string-elt
)))
(
if
autoload
(
setq
autoloads-done
(
cons
(
nth
1
form
)
autoloads-done
))
(
setq
autoload
form
))
(
if
(
and
doc-string-elt
(
stringp
(
nth
doc-string-elt
autoload
)))
;; We need to hack the printing because the
;; doc-string must be printed specially for
;; make-docfile (sigh).
(
let*
((
p
(
nthcdr
(
1-
doc-string-elt
)
autoload
))
(
elt
(
cdr
p
)))
(
setcdr
p
nil
)
(
princ
"\n("
outbuf
)
(
mapcar
(
function
(
lambda
(
elt
)
(
prin1
elt
outbuf
)
(
princ
" "
outbuf
)))
autoload
)
(
princ
"\"\\\n"
outbuf
)
(
princ
(
substring
(
prin1-to-string
(
car
elt
))
1
)
outbuf
)
(
if
(
null
(
cdr
elt
))
(
princ
")"
outbuf
)
(
princ
" "
outbuf
)
(
princ
(
substring
(
prin1-to-string
(
cdr
elt
))
1
)
outbuf
))
(
terpri
outbuf
))
(
print
autoload
outbuf
)))
;; Copy the rest of the line to the output.
(
let
((
begin
(
point
)))
(
forward-line
1
)
(
princ
(
buffer-substring
begin
(
point
))
outbuf
))))
((
looking-at
";"
)
;; Don't read the comment.
(
forward-line
1
))
(
t
(
forward-sexp
1
)
(
forward-line
1
))))))
(
set-buffer
outbuf
)
(
setq
output-end
(
point-marker
)))
(
if
done-any
(
progn
(
insert
generate-autoload-section-header
)
(
prin1
(
list
'autoloads
autoloads-done
load-name
file
(
nth
5
(
file-attributes
file
)))
outbuf
)
(
terpri
outbuf
)
(
insert
";;; Generated autoloads from "
file
"\n"
)
(
goto-char
output-end
)
(
insert
generate-autoload-section-trailer
)))
(
message
"Generating autoloads for %s...done"
file
)))
(
defconst
generated-autoload-file
"loaddefs.el"
"*File \\[update-file-autoloads] puts autoloads into.
A .el file can set this in its local variables section to make its
autoloads go somewhere else."
)
;;;###autoload
(
defun
update-file-autoloads
(
file
)
"Update the autoloads for FILE in `generated-autoload-file'
\(which FILE might bind in its local variables)."
(
interactive
"fUpdate autoloads for file: "
)
(
let
((
load-name
(
let
((
name
(
file-name-nondirectory
file
)))
(
if
(
string-match
"\\.elc?$"
name
)
(
substring
name
0
(
match-beginning
0
))
name
)))
(
done
nil
)
(
existing-buffer
(
get-file-buffer
file
)))
(
save-excursion
;; We want to get a value for generated-autoload-file from
;; the local variables section if it's there.
(
set-buffer
(
find-file-noselect
file
))
(
set-buffer
(
find-file-noselect
generated-autoload-file
))
(
save-excursion
(
save-restriction
(
widen
)
(
goto-char
(
point-min
))
(
while
(
search-forward
generate-autoload-section-header
nil
t
)
(
let
((
form
(
condition-case
()
(
read
(
current-buffer
))
(
end-of-file
nil
))))
(
if
(
string=
(
nth
2
form
)
load-name
)
(
let
((
begin
(
match-beginning
0
))
(
last-time
(
nth
4
form
))
(
file-time
(
nth
5
(
file-attributes
file
))))
(
if
(
and
(
or
(
null
existing-buffer
)
(
not
(
buffer-modified-p
existing-buffer
)))
(
listp
last-time
)
(
=
(
length
last-time
)
2
)
(
or
(
>
(
car
last-time
)
(
car
file-time
))
(
and
(
=
(
car
last-time
)
(
car
file-time
))
(
>=
(
nth
1
last-time
)
(
nth
1
file-time
)))))
(
message
"Autoload section for %s is up to date."
file
)
(
search-forward
generate-autoload-section-trailer
)
(
delete-region
begin
(
point
))
(
generate-file-autoloads
file
))
(
setq
done
t
))))))
(
if
done
()
;; Have the user tell us where to put the section.
(
save-window-excursion
(
switch-to-buffer
(
current-buffer
))
(
with-output-to-temp-buffer
"*Help*"
(
princ
(
substitute-command-keys
(
format
"\
Move
point
to
where
the
autoload
section
for
%s
should
be
inserted.
Then
do
\\[exit-recursive-edit].
"
file))))
(recursive-edit))
(generate-file-autoloads file)))
(if (and (null existing-buffer)
(setq existing-buffer (get-file-buffer file)))
(kill-buffer existing-buffer)))))
;;;###autoload
(defun update-autoloads-here ()
"
Update
the
sections
of
the
current
buffer
generated
by
\\[update-file-autoloads].
"
(interactive)
(let ((generated-autoload-file (buffer-file-name)))
(save-excursion
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
(let* ((form (condition-case ()
(read (current-buffer))
(end-of-file nil)))
(file (nth 3 form)))
(if (and (stringp file)
(or (get-file-buffer file)
(file-exists-p file)))
()
(setq file (if (y-or-n-p (format "
Library
\"%s\"
(
load
\
file
\"%s\"
)
doesn
't
exist.
Remove
its
autoload
section?
"
(nth 2 form) file))
t
(condition-case ()
(read-file-name (format "
Find
\"%s\"
load
file:
"
(nth 2 form))
nil nil t)
(quit nil)))))
(if file
(let ((begin (match-beginning 0)))
(search-forward generate-autoload-section-trailer)
(delete-region begin (point))))
(if (stringp file)
(generate-file-autoloads file)))))))
;;;###autoload
(defun update-directory-autoloads (dir)
"
Run
\\[update-file-autoloads]
on
each
.
el
file
in
DIR.
"
(interactive "
DUpdate
autoloads
for
directory:
")
(mapcar 'update-file-autoloads
(directory-files dir nil "
\\.el$
")))
;;;###autoload
(defun batch-update-autoloads ()
"
Update
the
autoloads
for
the
files
or
directories
on
the
command
line.
Runs
\\[update-file-autoloads]
on
files
and
\\[update-directory-autoloads]
on
directories.
Must
be
used
only
with
-batch,
and
kills
Emacs
on
completion.
Each
file
will
be
processed
even
if
an
error
occurred
previously.
For
example,
invoke
\"emacs
-batch
-f
batch-byte-compile
*.el\"
"
(if (not noninteractive)
(error "
batch-update-file-autoloads
is
to
be
used
only
with
-batch
"))
(let ((lost nil)
(args command-line-args-left))
(while args
(catch 'file
(condition-case lossage
(if (file-directory-p (expand-file-name (car args)))
(update-directory-autoloads (car args))
(update-file-autoloads (car args)))
(error (progn (message "
>>Error
processing
%s:
%s
"
(car args) lossage)
(setq lost t)
(throw 'file nil)))))
(setq args (cdr args)))
(save-some-buffers t)
(message "
Done
"
)
(
kill-emacs
(
if
lost
1
0
))))
(
provide
'autoload
)
lisp/emacs-lisp/debug.el
0 → 100644
View file @
0231f2dc
;; Debuggers and related commands for Emacs
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
;; 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 1, 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.
(
defvar
debug-function-list
nil
"List of functions currently set for debug on entry."
)
;;;###autoload
(
setq
debugger
'debug
)
;;;###autoload
(
defun
debug
(
&rest
debugger-args
)
"Enter debugger. Returns if user says \"continue\".
Arguments are mainly for use when this is called from the internals
of the evaluator.
You may call with no args, or you may pass nil as the first arg and
any other args you like. In that case, the list of args after the
first will be printed into the backtrace buffer."
(
message
"Entering debugger..."
)
(
let
(
debugger-value
(
debugger-match-data
(
match-data
))
(
debug-on-error
nil
)
(
debug-on-quit
nil
)
(
debugger-buffer
(
let
((
default-major-mode
'fundamental-mode
))
(
generate-new-buffer
"*Backtrace*"
)))
(
debugger-old-buffer
(
current-buffer
))
(
debugger-step-after-exit
nil
)
;; Don't keep reading from an executing kbd macro!
(
executing-macro
nil
)
(
cursor-in-echo-area
nil
))
(
unwind-protect
(
save-excursion
(
save-window-excursion
(
pop-to-buffer
debugger-buffer
)
(
erase-buffer
)
(
let
((
standard-output
(
current-buffer
))
(
print-escape-newlines
t
)
(
print-length
50
))
(
backtrace
))
(
goto-char
(
point-min
))
(
debugger-mode
)
(
delete-region
(
point
)
(
progn
(
search-forward
"\n debug("
)
(
forward-line
1
)
(
point
)))
(
debugger-reenable
)
(
cond
((
memq
(
car
debugger-args
)
'
(
lambda
debug
))
(
insert
"Entering:\n"
)
(
if
(
eq
(
car
debugger-args
)
'debug
)
(
progn
(
backtrace-debug
4
t
)
(
delete-char
1
)
(
insert
?*
)
(
beginning-of-line
))))
((
eq
(
car
debugger-args
)
'exit
)
(
insert
"Return value: "
)
(
setq
debugger-value
(
nth
1
debugger-args
))
(
prin1
debugger-value
(
current-buffer
))
(
insert
?\n
)
(
delete-char
1
)
(
insert
?
)
(
beginning-of-line
))
((
eq
(
car
debugger-args
)
'error
)
(
insert
"Signalling: "
)
(
prin1
(
nth
1
debugger-args
)
(
current-buffer
))
(
insert
?\n
))
((
eq
(
car
debugger-args
)
t
)
(
insert
"Beginning evaluation of function call form:\n"
))
(
t
(
prin1
(
if
(
eq
(
car
debugger-args
)
'nil
)
(
cdr
debugger-args
)
debugger-args
)
(
current-buffer
))
(
insert
?\n
)))
(
message
""
)
(
let
((
inhibit-trace
t
)
(
standard-output
nil
)
(
buffer-read-only
t
))
(
message
""
)
(
recursive-edit
))))
;; So that users do not try to execute debugger commands
;; in an invalid context
(
kill-buffer
debugger-buffer
)
(
store-match-data
debugger-match-data
))
(
setq
debug-on-next-call
debugger-step-after-exit
)
debugger-value
))
(
defun
debugger-step-through
()
"Proceed, stepping through subexpressions of this expression.
Enter another debugger on next entry to eval, apply or funcall."
(
interactive
)
(
setq
debugger-step-after-exit
t
)
(
message
"Proceeding, will debug on next eval or call."
)
(
exit-recursive-edit
))
(
defun
debugger-continue
()
"Continue, evaluating this expression without stopping."
(
interactive
)
(
message
"Continuing."
)
(
exit-recursive-edit
))
(
defun
debugger-return-value
(
val
)
"Continue, specifying value to return.
This is only useful when the value returned from the debugger
will be used, such as in a debug on exit from a frame."
(
interactive
"XReturn value (evaluated): "
)
(
setq
debugger-value
val
)
(
princ
"Returning "
t
)
(
prin1
debugger-value
)
(
exit-recursive-edit
))
(
defun
debugger-jump
()
"Continue to exit from this frame, with all debug-on-entry suspended."
(
interactive
)
;; Compensate for the two extra stack frames for debugger-jump.
(
let
((
debugger-frame-offset
(
+
debugger-frame-offset
2
)))
(
debugger-frame
))
;; Turn off all debug-on-entry functions
;; but leave them in the list.
(
let
((
list
debug-function-list
))
(
while
list
(
fset
(
car
list
)
(
debug-on-entry-1
(
car
list
)
(
symbol-function
(
car
list
))
nil
))
(
setq
list
(
cdr
list
))))
(
message
"Continuing through this frame"
)
(
exit-recursive-edit
))
(
defun
debugger-reenable
()
"Turn all debug-on-entry functions back on."
(
let
((
list
debug-function-list
))
(
while
list
(
or
(
consp
(
symbol-function
(
car
list
)))
(
debug-convert-byte-code
(
car
list
)))
(
fset
(
car
list
)
(
debug-on-entry-1
(
car
list
)
(
symbol-function
(
car
list
))
t
))
(
setq
list
(
cdr
list
)))))
(
defun
debugger-frame-number
()
"Return number of frames in backtrace before the one point points at."
(
save-excursion
(
beginning-of-line
)
(
let
((
opoint
(
point
))
(
count
0
))
(
goto-char
(
point-min
))
(
if
(
or
(
equal
(
buffer-substring
(
point
)
(
+
(
point
)
6
))
"Signal"
)
(
equal
(
buffer-substring
(
point
)
(
+
(
point
)
6
))
"Return"
))
(
progn
(
search-forward
":"
)
(
forward-sexp
1
)))
(
forward-line
1
)
(
while
(
progn
(
forward-char
2
)
(
if
(
=
(
following-char
)
?\(
)
(
forward-sexp
1
)
(
forward-sexp
2
))
(
forward-line
1
)
(
<=
(
point
)
opoint
))
(
setq
count
(
1+
count
)))
count
)))
;; Chosen empirically to account for all the frames
;; that will exist when debugger-frame is called
;; within the first one that appears in the backtrace buffer.
;; Assumes debugger-frame is called from a key;
;; will be wrong if it is called with Meta-x.
(
defconst
debugger-frame-offset
8
""
)
(
defun
debugger-frame
()
"Request entry to debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(
interactive
)
(
beginning-of-line
)
(
let
((
level
(
debugger-frame-number
)))
(
backtrace-debug
(
+
level
debugger-frame-offset
)
t
))
(
if
(
=
(
following-char
)
?
)
(
let
((
buffer-read-only
nil
))
(
delete-char
1
)
(
insert
?*
)))
(
beginning-of-line
))
(
defun
debugger-frame-clear
()
"Do not enter to debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(
interactive
)
(
beginning-of-line
)
(
let
((
level
(
debugger-frame-number
)))
(
backtrace-debug
(
+
level
debugger-frame-offset
)
nil
))
(
if
(
=
(
following-char
)
?*
)
(
let
((
buffer-read-only
nil
))
(
delete-char
1
)
(
insert
?
)))
(
beginning-of-line
))
(
defun
debugger-eval-expression
(
exp
)
(
interactive
"xEval: "
)
(
save-excursion
(
if
(
null
(
buffer-name
debugger-old-buffer
))
;; old buffer deleted
(
setq
debugger-old-buffer
(
current-buffer
)))
(
set-buffer
debugger-old-buffer
)
(
eval-expression
exp
)))
(
defvar
debugger-mode-map
nil
)
(
if
debugger-mode-map
nil
(
let
((
loop
?
))
(
setq
debugger-mode-map
(
make-keymap
))
(
suppress-keymap
debugger-mode-map
)
(
define-key
debugger-mode-map
"-"
'negative-argument
)
(
define-key
debugger-mode-map
"b"
'debugger-frame
)
(
define-key
debugger-mode-map
"c"
'debugger-continue
)
(
define-key
debugger-mode-map
"j"
'debugger-jump
)
(
define-key
debugger-mode-map
"r"
'debugger-return-value
)
(
define-key
debugger-mode-map
"u"
'debugger-frame-clear
)
(
define-key
debugger-mode-map
"d"
'debugger-step-through
)
(
define-key
debugger-mode-map
"l"
'debugger-list-functions
)
(
define-key
debugger-mode-map
"h"
'describe-mode
)
(
define-key
debugger-mode-map
"q"
'top-level
)
(
define-key
debugger-mode-map
"e"
'debugger-eval-expression
)
(
define-key
debugger-mode-map
" "
'next-line
)))
(
put
'debugger-mode
'mode-class
'special
)
(
defun
debugger-mode
()
"Mode for backtrace buffers, selected in debugger.
\\<debugger-mode-map>
A line starts with `*' if exiting that frame will call the debugger.
Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'.
When in debugger due to frame being exited,
use the \\[debugger-return-value] command to override the value
being returned from that frame.
Use \\[debug-on-entry] and \\[cancel-debug-on-entry] to control
which functions will enter the debugger when called.
Complete list of commands:
\\{debugger-mode-map}"
(
kill-all-local-variables
)
(
setq
major-mode
'debugger-mode
)
(
setq
mode-name
"Debugger"
)
(
setq
truncate-lines
t
)
(
set-syntax-table
emacs-lisp-mode-syntax-table
)
(
use-local-map
debugger-mode-map
))
;;;###autoload
(
defun
debug-on-entry
(
function
)
"Request FUNCTION to invoke debugger each time it is called.
If the user continues, FUNCTION's execution proceeds.
Works by modifying the definition of FUNCTION,
which must be written in Lisp, not predefined.
Use \\[cancel-debug-on-entry] to cancel the effect of this command.
Redefining FUNCTION also does that."
(
interactive
"aDebug on entry (to function): "
)
(
debugger-reenable
)
(
if
(
subrp
(
symbol-function
function
))
(
error
"Function %s is a primitive"
function
))
(
or
(
consp
(
symbol-function
function
))
(
debug-convert-byte-code
function
))
(
or
(
consp
(
symbol-function
function
))
(
error
"Definition of %s is not a list"
function
))
(
fset
function
(
debug-on-entry-1
function
(
symbol-function
function
)
t
))
(
or
(
memq
function
debug-function-list
)
(
setq
debug-function-list
(
cons
function
debug-function-list
)))
function
)
;;;###autoload
(
defun
cancel-debug-on-entry
(
&optional
function
)
"Undo effect of \\[debug-on-entry] on FUNCTION.
If argument is nil or an empty string, cancel for all functions."
(
interactive
"aCancel debug on entry (to function): "
)
(
debugger-reenable
)
(
if
(
and
function
(
not
(
string=
function
""
)))
(
progn
(
fset
function
(
debug-on-entry-1
function
(
symbol-function
function
)
nil
))
(
setq
debug-function-list
(
delq
function
debug-function-list
))
function
)
(
message
"Cancelling debug-on-entry for all functions"
)
(
mapcar
'cancel-debug-on-entry
debug-function-list
)))
(
defun
debug-convert-byte-code
(
function
)
(
let
((
defn
(
symbol-function
function
)))
(
if
(
not
(
consp
defn
))
;; Assume a compiled code object.
(
let*
((
contents
(
append
defn
nil
))
(
body
(
list
(
list
'byte-code
(
nth
1
contents
)
(
nth
2
contents
)
(
nth
3
contents
)))))
(
if
(
nthcdr
5
contents
)
(
setq
body
(
cons
(
list
'interactive
(
nth
5
contents
))
body
)))
(
if
(
nth
4
contents
)
(
setq
body
(
cons
(
nth
4
contents
)
body
)))
(
fset
function
(
cons
'lambda
(
cons
(
car
contents
)
body
)))))))
(
defun
debug-on-entry-1
(
function
defn
flag
)
(
if
(
subrp
defn
)
(
error
"%s is a built-in function"
function
)
(
if
(
eq
(
car
defn
)
'macro
)
(
debug-on-entry-1
function
(
cdr
defn
)
flag
)
(
or
(
eq
(
car
defn
)
'lambda
)
(
error
"%s not user-defined Lisp function"
function
))
(
let
(
tail
prec
)
(
if
(
stringp
(
car
(
nthcdr
2
defn
)))
(
setq
tail
(
nthcdr
3
defn
)
prec
(
list
(
car
defn
)
(
car
(
cdr
defn
))
(
car
(
cdr
(
cdr
defn
)))))
(
setq
tail
(
nthcdr
2
defn
)