1 ;;; This is a cheap, pigeon lisp mode. One Day, it'll be replaced with
6 (defcustom *defun-prompt-regexp
* nil
7 "*If non-nil, a regexp to ignore before a defun.
8 This is only necessary if the opening paren or brace is not in column 0.
9 See function `beginning-of-defun'."
10 :type
'(choice (const nil
)
14 (defvar *emacs-lisp-mode-syntax-table
*
15 (let ((table (make-syntax-table)))
16 (loop for i from
(char-code #\
0) to
(char-code #\
9) do
17 (modify-syntax-entry (code-char i
) :symbol-constituent
:table table
))
18 (loop for i from
(char-code #\A
) to
(char-code #\Z
) do
19 (modify-syntax-entry (code-char i
) :symbol-constituent
:table table
))
21 (loop for i from
(char-code #\a) to
(char-code #\z
) do
22 (modify-syntax-entry (code-char i
) :symbol-constituent
:table table
))
24 (loop for c in
'(#\
{ #\|
#\
} #\~
#|
127 |
#) do
25 (modify-syntax-entry c
:symbol-constituent
:table table
))
27 (modify-syntax-entry #\Space
:whitespace
:table table
)
28 (modify-syntax-entry #\Tab
:whitespace
:table table
)
29 ;; XXX what is \f ? (modify-syntax-entry ?\f :whitespace :table table)
30 (modify-syntax-entry #\Newline
:end-comment
:table table
)
31 ;; This is probably obsolete since nowadays such features use overlays.
32 ;; ;; Give CR the same syntax as newline, for selective-display.
33 ;; (modify-syntax-entry ?\^m "> " :table table)
34 (modify-syntax-entry #\
; :comment :table table)
35 (modify-syntax-entry #\
` :quote
:table table
)
36 (modify-syntax-entry #\' :quote
:table table
)
37 (modify-syntax-entry #\
, :quote
:table table
)
38 (modify-syntax-entry #\
@ :quote
:table table
)
39 ;; Used to be singlequote; changed for flonums.
40 (modify-syntax-entry #\.
:symbol-constituent
:table table
)
41 (modify-syntax-entry #\
# :quote
:table table
)
42 (modify-syntax-entry #\" :string
:table table
)
43 (modify-syntax-entry #\\ :escape
:table table
)
44 (modify-syntax-entry #\
( :open
:extra
#\
) :table table
)
45 (modify-syntax-entry #\
) :close
:extra
#\
( :table table
)
46 (modify-syntax-entry #\
[ :open
:extra
#\
] :table table
)
47 (modify-syntax-entry #\
] :close
:extra
#\
[ :table table
)
50 (defvar *lisp-mode-syntax-table
*
51 (let ((table (copy-syntax-table *emacs-lisp-mode-syntax-table
*)))
52 (modify-syntax-entry #\
[ :symbol-constituent
:table table
)
53 (modify-syntax-entry #\
] :symbol-constituent
:table table
)
54 (modify-syntax-entry #\
# :quote
:flags
'(:comment-start-first
:comment-end-second
:comment-style
) :table table
)
55 (modify-syntax-entry #\|
:string
:flags
'(:comment-start-second
:comment-end-first
:comment-style
:comment-nested
) :table table
)
58 (defvar *lisp-interaction-mode
*
59 (make-instance 'major-mode
60 :name
"Lisp Interaction"
61 :map
(let ((m (make-sparse-keymap)))
62 (define-key m
(make-key :char
#\j
:control t
) 'eval-print-last-sexp
)
63 (define-key m
(make-key :char
#\Tab
) 'lisp-indent-line
)
64 (define-key m
(make-key :char
#\i
:control t
) 'lisp-indent-line
)
65 (define-key m
(make-key :char
#\q
:control t
:meta t
) 'indent-sexp
)
66 (define-key m
(make-key :char
#\x
:control t
:meta t
) 'eval-defun
)
68 :syntax-table
*lisp-mode-syntax-table
*)
71 (defun buffer-end (arg)
72 "Return the \"far end\" position of the buffer, in direction ARG.
73 If ARG is positive, that's the end of the buffer.
74 Otherwise, that's the beginning of the buffer."
75 (if (> arg
0) (point-max) (point-min)))
77 (defvar *end-of-defun-function
* nil
78 "If non-nil, function for function `end-of-defun' to call.
79 This is used to find the end of the defun instead of using the normal
80 recipe (see `end-of-defun'). Major modes can define this if the
81 normal method is not appropriate.")
83 (defcommand end-of-defun
((&optional arg
)
85 "Move forward to next end of defun.
86 With argument, do it that many times.
87 Negative argument -N means move back to Nth preceding end of defun.
89 An end of a defun occurs right after the close-parenthesis that
90 matches the open-parenthesis that starts a defun; see function
93 If variable `*end-of-defun-function*' is non-nil, its value
94 is called as a function to find the defun's end."
95 (or (not (eq *this-command
* 'end-of-defun
))
96 (eq *last-command
* 'end-of-defun
)
97 ;;XXX (and transient-mark-mode mark-active)
99 (if (or (null arg
) (= arg
0)) (setq arg
1))
100 (if *end-of-defun-function
*
103 (funcall *end-of-defun-function
*))
104 ;; Better not call beginning-of-defun-function
105 ;; directly, in case it's not defined.
106 (beginning-of-defun (- arg
)))
108 (while (and (> arg
0) (< (point) (point-max)))
114 (beginning-of-defun-raw 1)))
117 (or (bobp) (forward-char -
1))
118 (beginning-of-defun-raw -
1)))
121 (skip-whitespace-forward)
122 (if (looking-at ";|\\n") ; XXX: used to be comment starter \\s<
125 (message "point: ~d ~d" (point) pos
)))
129 (beginning-of-defun-raw 1)
133 (if (beginning-of-defun-raw 2)
136 (skip-whitespace-forward)
137 (if (looking-at ";|\\n") ; XXX: used to be comment starter \\s<
139 (goto-char (point-min)))))
140 (setq arg
(1+ arg
))))))
142 (defvar *forward-sexp-function
* nil
143 "If non-nil, `forward-sexp' delegates to this function.
144 Should take the same arguments and behave similarly to `forward-sexp'.")
146 (defcommand forward-sexp
((&optional
(arg 1))
148 "Move forward across one balanced expression (sexp).
149 With ARG, do it that many times. Negative arg -N means
150 move backward across N balanced expressions."
151 (if *forward-sexp-function
*
152 (funcall *forward-sexp-function
* arg
)
154 (goto-char (or (scan-sexps (point) arg
) (buffer-end arg
)))
155 (if (< arg
0) (backward-prefix-chars)))))
157 (defcommand backward-sexp
((&optional
(arg 1))
159 "Move backward across one balanced expression (sexp).
160 With ARG, do it that many times. Negative arg -N means
161 move forward across N balanced expressions."
162 (forward-sexp (- arg
)))
164 (defcommand forward-list
((&optional arg
)
166 "Move forward across one balanced group of parentheses.
167 With ARG, do it that many times.
168 Negative arg -N means move backward across N groups of parentheses."
169 (or arg
(setq arg
1))
170 (goto-char (or (scan-lists (point) arg
0) (buffer-end arg
))))
172 (defcommand backward-list
((&optional arg
)
174 "Move backward across one balanced group of parentheses.
175 With ARG, do it that many times.
176 Negative arg -N means move forward across N groups of parentheses."
177 (or arg
(setq arg
1))
178 (forward-list (- arg
)))
180 (defcommand eval-last-sexp
()
181 (let ((start (point))
183 ;; some nice'n'gross point handling
187 (handler-case (eval-echo (buffer-substring-no-properties start end
))
188 (error (c) (message "Eval error: ~a" c
)))))
190 (defcommand eval-print-last-sexp
()
191 (let ((start (point))
193 ;; some nice'n'gross point handling
197 (handler-case (eval-print (buffer-substring-no-properties start end
))
198 (error (c) (message "Eval error: ~a" c
)))))
200 (defcommand lisp-interaction-mode
()
201 (set-major-mode *lisp-interaction-mode
*))
203 (defvar *lisp-indent-offset
* nil
204 "If non-nil, indent second line of expressions that many more columns.")
206 (defvar *lisp-indent-function
* 'common-lisp-indent-function
)
208 (defcommand lisp-indent-line
((&optional whole-exp
)
210 "Indent current line as Lisp code.
211 With argument, indent any additional lines of the same expression
212 rigidly along with this one."
213 (let ((indent (calculate-lisp-indent)) shift-amt end
214 (pos (- (point-max) (point)))
215 (beg (progn (beginning-of-line) (point))))
216 (skip-whitespace-forward)
217 (if (or (null indent
) (looking-at ";;;")) ; XXX: used to be comment starter \\s<
218 ;; Don't alter indentation of a ;;; comment line
219 ;; or a line that starts in a string.
220 (goto-char (- (point-max) pos
))
222 (if (and (looking-at ";") (not (looking-at ";;"))) ; XXX: used to be comment starter \\s<
223 ;; Single-semicolon comment lines should be indented
224 ;; as comment lines, not as code.
225 (progn (indent-for-comment) (forward-char -
1))
227 (if (listp indent
) (setq indent
(car indent
)))
228 (setq shift-amt
(- indent
(current-column)))
229 (if (zerop shift-amt
)
232 (delete-region beg
(point))
233 (indent-to indent
)))))
234 ;; If initial point was within line's indentation,
235 ;; position after the indentation. Else stay at same point in text.
236 (if (> (- (point-max) pos
) (point))
237 (goto-char (- (point-max) pos
)))
238 ;; If desired, shift remaining lines of expression the same amount.
239 (and whole-exp
(not (zerop shift-amt
))
250 (indent-code-rigidly beg end shift-amt
))))))
252 (defvar *calculate-lisp-indent-last-sexp
*)
254 (defun calculate-lisp-indent (&optional parse-start
)
255 "Return appropriate indentation for current line as Lisp code.
256 In usual case returns an integer: the column to indent to.
257 If the value is nil, that means don't change the indentation
258 because the line starts inside a string.
260 The value can also be a list of the form (COLUMN CONTAINING-SEXP-START).
261 This means that following lines at the same level of indentation
262 should not necessarily be indented the same as this line.
263 Then COLUMN is the column to indent to, and CONTAINING-SEXP-START
264 is the buffer position of the start of the containing expression."
267 (let ((indent-point (point))
269 ;; setting this to a number inhibits calling hook
272 *calculate-lisp-indent-last-sexp
* containing-sexp
)
274 (goto-char parse-start
)
275 (beginning-of-defun))
276 ;; Find outermost containing sexp
277 (while (< (point) indent-point
)
278 (message "flitz ~d" indent-point
(point))
279 (setq state
(parse-partial-sexp (point) indent-point
:target-depth
0)))
280 ;; Find innermost containing sexp
283 (> (setq paren-depth
(parse-state-depth state
)) 0))
285 (setq *calculate-lisp-indent-last-sexp
* (parse-state-this-level-start state
))
286 (message "gaah ~d" *calculate-lisp-indent-last-sexp
*)
287 (setq containing-sexp
(parse-state-prev-level-start state
))
288 ;; Position following last unclosed open.
289 (goto-char (1+ containing-sexp
))
290 ;; Is there a complete sexp since then?
291 (if (and *calculate-lisp-indent-last-sexp
*
292 (> *calculate-lisp-indent-last-sexp
* (point)))
293 ;; Yes, but is there a containing sexp after that?
294 (let ((peek (parse-partial-sexp *calculate-lisp-indent-last-sexp
*
295 indent-point
:target-depth
0)))
296 (if (setq retry
(parse-state-prev-level-start peek
)) (setq state peek
)))))
297 (message "retry ~a" retry
)
300 ;; Innermost containing sexp found
302 (goto-char (1+ containing-sexp
))
303 (if (not *calculate-lisp-indent-last-sexp
*)
304 ;; indent-point immediately follows open paren.
306 (setq desired-indent
(current-column))
308 ;; Find the start of first element of containing sexp.
309 (parse-partial-sexp (point) *calculate-lisp-indent-last-sexp
* :target-depth
0 :stop-before t
)
310 (cond ((looking-at "\\(") ; XXX used to be open \\s(
311 ;; First element of containing sexp is a list.
312 ;; Indent under that list.
314 ((> (save-excursion (forward-line 1) (point))
315 *calculate-lisp-indent-last-sexp
*)
317 ;; This is the first line to start within the containing sexp.
318 ;; It's almost certainly a function call.
319 (if (= (point) *calculate-lisp-indent-last-sexp
*)
320 ;; Containing sexp has nothing before this line
321 ;; except the first element. Indent under that element.
323 ;; Skip the first element, find start of second (the first
324 ;; argument of the function call) and indent under.
325 (progn (forward-sexp 1)
326 (parse-partial-sexp (point)
327 *calculate-lisp-indent-last-sexp
*
328 :target-depth
0 :stop-before t
)))
329 (backward-prefix-chars))
331 ;; Indent beneath first sexp on same line as
332 ;; `*calculate-lisp-indent-last-sexp*'. Again, it's
333 ;; almost certainly a function call.
334 (goto-char *calculate-lisp-indent-last-sexp
*)
336 (parse-partial-sexp (point) *calculate-lisp-indent-last-sexp
*
337 :target-depth
0 :stop-before t
)
338 (backward-prefix-chars)))))))
339 ;; Point is at the point to indent under unless we are inside a string.
340 ;; Call indentation hook except when overridden by *lisp-indent-offset*
341 ;; or if the desired indentation has already been computed.
342 (let ((normal-indent (current-column)))
343 (cond ((parse-state-in-string state
)
344 ;; Inside a string, don't change indentation.
346 ((and (integerp *lisp-indent-offset
*) containing-sexp
)
347 ;; Indent by constant offset
348 (goto-char containing-sexp
)
349 (+ (current-column) *lisp-indent-offset
*))
351 ((and (boundp '*lisp-indent-function
*)
352 *lisp-indent-function
*
354 (or (funcall *lisp-indent-function
* indent-point state
)
359 (defvar *beginning-of-defun-function
* nil
360 "If non-nil, function for `beginning-of-defun-raw' to call.
361 This is used to find the beginning of the defun instead of using the
362 normal recipe (see `beginning-of-defun'). Major modes can define this
363 if defining `*defun-prompt-regexp*' is not sufficient to handle the mode's
366 The function (of no args) should go to the line on which the current
367 defun starts, and return non-nil, or should return nil if it can't
368 find the beginning.")
370 (defcommand beginning-of-defun-raw
((&optional
(arg 1))
372 "Move point to the character that starts a defun.
373 This is identical to function `beginning-of-defun', except that point
374 does not move to the beginning of the line when `*defun-prompt-regexp*'
377 If variable `*beginning-of-defun-function*' is non-nil, its value
378 is called as a function to find the defun's beginning."
379 (if *beginning-of-defun-function
*
382 (funcall *beginning-of-defun-function
*))
383 ;; Better not call *end-of-defun-function* directly, in case
385 (end-of-defun (- arg
)))
390 (let ((mdata (if *defun-prompt-regexp
*
391 (re-search-backward (concat (if *open-paren-in-column-0-is-defun-start
*
393 "(?:" *defun-prompt-regexp
* ")\\(")
394 :error
'move
:count
(or arg
1))
395 (search-backward (format nil
"~%(") ;; FIXME: doesn't match beginning of buffer
396 :error
'move
:count
(or arg
1))))) ;; used to be ^\\(
398 (goto-char (1- (match-end mdata
0)))
401 (defcommand beginning-of-defun
((&optional
(arg 1))
403 "Move backward to the beginning of a defun.
404 With ARG, do it that many times. Negative arg -N
405 means move forward to Nth following beginning of defun.
406 Returns t unless search stops due to beginning or end of buffer.
408 Normally a defun starts when there is a char with open-parenthesis
409 syntax at the beginning of a line. If `*defun-prompt-regexp*' is
410 non-nil, then a string which matches that regexp may precede the
411 open-parenthesis, and point ends up at the beginning of the line.
413 If variable `*beginning-of-defun-function*' is non-nil, its value
414 is called as a function to find the defun's beginning."
415 (or (not (eq *this-command
* 'beginning-of-defun
))
416 (eq *last-command
* 'beginning-of-defun
)
417 ;;XXX (and transient-mark-mode mark-active)
419 (and (beginning-of-defun-raw arg
)
420 (progn (beginning-of-line) t
)))
422 (defcommand indent-code-rigidly
((start end arg
&optional nochange-regexp
)
423 :region-beginning
:region-end
:prefix
)
424 "Indent all lines of code, starting in the region, sideways by ARG columns.
425 Does not affect lines starting inside comments or strings, assuming that
426 the start of the region is not inside them.
428 Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.
429 The last is a regexp which, if matched at the beginning of a line,
430 means don't indent that line."
434 (setq end
(point-marker))
437 (setq state
(parse-partial-sexp (point)
439 (forward-line 1) (point))
441 (while (< (point) end
)
442 (or (car (nthcdr 3 state
))
444 (looking-at nochange-regexp
))
445 ;; If line does not start in string, indent it
446 (let ((indent (current-indentation)))
447 (delete-region (point) (progn (skip-whitespace-forward) (point)))
449 (indent-to (max 0 (+ indent arg
)) 0))))
450 (setq state
(parse-partial-sexp (point)
452 (forward-line 1) (point))
453 :old-state state
))))))
456 (defcommand indent-sexp
((&optional endpos
))
457 "Indent each line of the list starting just after point.
458 If optional arg ENDPOS is given, indent each line, stopping when
459 ENDPOS is encountered."
460 (let ((indent-stack (list nil
))
462 ;; If ENDPOS is non-nil, use nil as STARTING-POINT
463 ;; so that calculate-lisp-indent will find the beginning of
464 ;; the defun we are in.
465 ;; If ENDPOS is nil, it is safe not to scan before point
466 ;; since every line we indent is more deeply nested than point is.
467 (starting-point (if endpos nil
(point)))
469 last-depth bol outer-loop-done inner-loop-done state this-indent
)
471 ;; Get error now if we don't have a complete sexp after point.
472 (save-excursion (forward-sexp 1)))
474 (setq outer-loop-done nil
)
475 (while (if endpos
(< (point) (ensure-number endpos
))
476 (not outer-loop-done
))
477 (setq last-depth next-depth
479 ;; Parse this line so we can learn the state
480 ;; to indent the next line.
481 ;; This inner loop goes through only once
482 ;; unless a line ends inside a string.
483 (while (and (not inner-loop-done
)
484 (not (setq outer-loop-done
(eobp))))
485 (setq state
(parse-partial-sexp (point) (progn (end-of-line) (point))
487 (setq next-depth
(parse-state-depth state
))
488 ;; If the line contains a comment other than the sort
489 ;; that is indented like code,
490 ;; indent it now with indent-for-comment.
491 ;; Comments indented like code are right already.
492 ;; In any case clear the in-comment flag in the state
493 ;; because parse-partial-sexp never sees the newlines.
494 (if (parse-state-in-comment state
) ;;(car (nthcdr 4 state))
495 (progn (indent-for-comment)
497 (setf (parse-state-in-comment state
) nil
))) ;;(setcar (nthcdr 4 state) nil)))
498 ;; If this line ends inside a string,
499 ;; go straight to next line, remaining within the inner loop,
500 ;; and turn off the \-flag.
501 (if (parse-state-in-string state
) ;;(car (nthcdr 3 state))
504 (setf (parse-state-in-string state
) nil
));;(setf (car (nthcdr 5 state)) nil))
505 (setq inner-loop-done t
)))
509 (setq indent-stack
(nconc indent-stack
510 (make-list (- next-depth
) :initial-element nil
))
511 last-depth
(- last-depth next-depth
)
513 (or outer-loop-done endpos
514 (setq outer-loop-done
(<= next-depth
0)))
518 (while (> last-depth next-depth
)
519 (setq indent-stack
(cdr indent-stack
)
520 last-depth
(1- last-depth
)))
521 (while (< last-depth next-depth
)
522 (setq indent-stack
(cons nil indent-stack
)
523 last-depth
(1+ last-depth
)))
524 ;; Now go to the next line and indent it according
525 ;; to what we learned from parsing the previous one.
528 (skip-whitespace-forward)
529 ;; But not if the line is blank, or just a comment
530 ;; (except for double-semi comments; indent them as usual).
531 (if (or (eobp) (looking-at "\\w|\\n")) ;; FIXME: used to be "\\s<|\\n"
534 (if (and (car indent-stack
)
535 (>= (car indent-stack
) 0))
536 (setq this-indent
(car indent-stack
))
537 (let ((val (calculate-lisp-indent
538 (if (car indent-stack
) (- (car indent-stack
))
541 (setq this-indent val
)
543 (setf (car indent-stack
)
544 (setq this-indent val
))
546 (setf (car indent-stack
) (- (car (cdr val
))))
547 (setq this-indent
(car val
)))))))
548 (if (and this-indent
(/= (current-column) this-indent
))
549 (progn (delete-region bol
(point))
550 (indent-to this-indent
)))))))
552 (setq outer-loop-done
(= (point) last-point
))
553 (setq last-point
(point)))))))
555 (defun lisp-indent-region (start end
)
556 "Indent every line whose first char is between START and END inclusive."
558 (let ((endmark (copy-marker end
)))
560 (and (bolp) (not (eolp))
562 (indent-sexp endmark
)
563 (set-marker endmark nil
))))
565 (defun eval-defun-1 (form)
566 "Treat some expressions specially.
567 Reset the `defvar' and `defcustom' variables to the initial value.
568 Reinitialize the face according to the `defface' specification."
569 ;; The code in edebug-defun should be consistent with this, but not
570 ;; the same, since this gets a macroexpended form.
571 (cond ((not (listp form
))
573 ((and (eq (car form
) 'defvar
)
574 (cdr-safe (cdr-safe form
))
575 (boundp (cadr form
)))
576 ;; Force variable to be re-set.
577 `(progn (defvar ,(nth 1 form
) nil
,@(nthcdr 3 form
))
578 (setf ,(nth 1 form
) ,(nth 2 form
)))) ;; used to be setq-default
579 ;; `defcustom' is now macroexpanded to
580 ;; `custom-declare-variable' with a quoted value arg.
581 ((and (eq (car form
) 'custom-declare-variable
)
582 (boundp (eval (nth 1 form
)))) ;; used to be default-boundp
583 ;; Force variable to be bound.
584 ;; XXX: we can't handle defcustom
585 ;;(set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form))))
587 ;; `defface' is macroexpanded to `custom-declare-face'.
588 ((eq (car form
) 'custom-declare-face
)
590 ;; XXX: what do we do with this?
591 ;; (setq face-new-frame-defaults
592 ;; (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults))
593 ;; (put (eval (nth 1 form)) 'face-defface-spec nil)
594 ;; ;; Setting `customized-face' to the new spec after calling
595 ;; ;; the form, but preserving the old saved spec in `saved-face',
596 ;; ;; imitates the situation when the new face spec is set
597 ;; ;; temporarily for the current session in the customize
598 ;; ;; buffer, thus allowing `face-user-default-spec' to use the
599 ;; ;; new customized spec instead of the saved spec.
600 ;; ;; Resetting `saved-face' temporarily to nil is needed to let
601 ;; ;; `defface' change the spec, regardless of a saved spec.
602 ;; (prog1 `(prog1 ,form
603 ;; (put ,(nth 1 form) 'saved-face
604 ;; ',(get (eval (nth 1 form)) 'saved-face))
605 ;; (put ,(nth 1 form) 'customized-face
607 ;; (put (eval (nth 1 form)) 'saved-face nil))
609 ((eq (car form
) 'progn
)
610 (cons 'progn
(mapcar 'eval-defun-1
(cdr form
))))
613 (defcommand eval-defun-2
()
614 "Evaluate defun that point is in or before.
615 The value is displayed in the minibuffer.
616 If the current defun is actually a call to `defvar',
617 then reset the variable using the initial value expression
618 even if the variable already has some other value.
619 \(Normally `defvar' does not change the variable's value
620 if it already has a value.\)
622 With argument, insert value in current buffer after the defun.
623 Return the result of evaluation."
624 (let* ((*debug-on-error
* *eval-expression-debug-on-error
*)
625 (*print-length
* *eval-expression-print-length
*)
626 (*print-level
* *eval-expression-print-level
*)
627 ;; FIXME: accum the eval/compiler output and i guess do
628 ;; something with it, cept in this case we don't.
629 (*debug-io
* (make-string-output-stream))
630 (*standard-output
* *debug-io
*)
631 (*error-output
* *debug-io
*))
633 ;; FIXME: In gnu emacs eval-region handles recording which file defines
634 ;; a function or variable. How do we do that in CL?
636 (let ( ;;XXX (standard-output t)
638 ;; Read the form from the buffer, and record where it ends.
643 (setq form
(read-from-buffer))
645 ;; Alter the form if necessary. FIXME: we don't macroexpand
646 ;; but really we want to macroexpand down to defvar (and
647 ;; friends) which could be several layers of expansion
648 ;; down. We don't want to go all the way since defvar is
650 (setq form
(eval-defun-1 form
;; (macroexpand form)
654 (defcommand eval-defun
((edebug-it)
656 "Evaluate the top-level form containing point, or after point.
658 If the current defun is actually a call to `defvar' or `defcustom',
659 evaluating it this way resets the variable using its initial value
660 expression even if the variable already has some other value.
661 \(Normally `defvar' and `defcustom' do not alter the value if there
664 If `eval-expression-debug-on-error' is non-nil, which is the default,
665 this command arranges for all errors to enter the debugger.
667 With a prefix argument, instrument the code for Edebug.
669 If acting on a `defun' for FUNCTION, and the function was
670 instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not
671 instrumented, just FUNCTION is printed.
673 If not acting on a `defun', the result of evaluation is displayed in
674 the minibuffer. This display is controlled by the variables
675 `eval-expression-print-length' and `eval-expression-print-level',
678 (declare (ignore edebug-it
))
681 ;; (eval-defun (not edebug-all-defs)))
683 (if (null *eval-expression-debug-on-error
*)
685 (let ((old-value (gensym "t")) new-value value
)
686 (let ((*debug-on-error
* old-value
))
687 (setq value
(eval-defun-2))
688 (setq new-value
*debug-on-error
*))
689 (unless (eq old-value new-value
)
690 (setq *debug-on-error
* new-value
))
694 (provide :lice-0.1
/lisp-mode
)