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
)))
391 (and (if *defun-prompt-regexp
*
392 (re-search-backward (concat (if *open-paren-in-column-0-is-defun-start
*
394 "(?:" *defun-prompt-regexp
* ")\\(")
395 :error
'move
:count
(or arg
1))
396 (search-backward (format nil
"~%(") ;; FIXME: doesn't match beginning of buffer
397 :error
'move
:count
(or arg
1))) ;; used to be ^\\(
398 (progn (goto-char (1- (match-end 0))) t
))))))
400 (defcommand beginning-of-defun
((&optional
(arg 1))
402 "Move backward to the beginning of a defun.
403 With ARG, do it that many times. Negative arg -N
404 means move forward to Nth following beginning of defun.
405 Returns t unless search stops due to beginning or end of buffer.
407 Normally a defun starts when there is a char with open-parenthesis
408 syntax at the beginning of a line. If `*defun-prompt-regexp*' is
409 non-nil, then a string which matches that regexp may precede the
410 open-parenthesis, and point ends up at the beginning of the line.
412 If variable `*beginning-of-defun-function*' is non-nil, its value
413 is called as a function to find the defun's beginning."
414 (or (not (eq *this-command
* 'beginning-of-defun
))
415 (eq *last-command
* 'beginning-of-defun
)
416 ;;XXX (and transient-mark-mode mark-active)
418 (and (beginning-of-defun-raw arg
)
419 (progn (beginning-of-line) t
)))
421 (defcommand indent-code-rigidly
((start end arg
&optional nochange-regexp
)
422 :region-beginning
:region-end
:prefix
)
423 "Indent all lines of code, starting in the region, sideways by ARG columns.
424 Does not affect lines starting inside comments or strings, assuming that
425 the start of the region is not inside them.
427 Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.
428 The last is a regexp which, if matched at the beginning of a line,
429 means don't indent that line."
433 (setq end
(point-marker))
436 (setq state
(parse-partial-sexp (point)
438 (forward-line 1) (point))
440 (while (< (point) end
)
441 (or (car (nthcdr 3 state
))
443 (looking-at nochange-regexp
))
444 ;; If line does not start in string, indent it
445 (let ((indent (current-indentation)))
446 (delete-region (point) (progn (skip-whitespace-forward) (point)))
448 (indent-to (max 0 (+ indent arg
)) 0))))
449 (setq state
(parse-partial-sexp (point)
451 (forward-line 1) (point))
452 :old-state state
))))))
455 (defcommand indent-sexp
((&optional endpos
))
456 "Indent each line of the list starting just after point.
457 If optional arg ENDPOS is given, indent each line, stopping when
458 ENDPOS is encountered."
459 (let ((indent-stack (list nil
))
461 ;; If ENDPOS is non-nil, use nil as STARTING-POINT
462 ;; so that calculate-lisp-indent will find the beginning of
463 ;; the defun we are in.
464 ;; If ENDPOS is nil, it is safe not to scan before point
465 ;; since every line we indent is more deeply nested than point is.
466 (starting-point (if endpos nil
(point)))
468 last-depth bol outer-loop-done inner-loop-done state this-indent
)
470 ;; Get error now if we don't have a complete sexp after point.
471 (save-excursion (forward-sexp 1)))
473 (setq outer-loop-done nil
)
474 (while (if endpos
(< (point) (ensure-number endpos
))
475 (not outer-loop-done
))
476 (setq last-depth next-depth
478 ;; Parse this line so we can learn the state
479 ;; to indent the next line.
480 ;; This inner loop goes through only once
481 ;; unless a line ends inside a string.
482 (while (and (not inner-loop-done
)
483 (not (setq outer-loop-done
(eobp))))
484 (setq state
(parse-partial-sexp (point) (progn (end-of-line) (point))
486 (setq next-depth
(parse-state-depth state
))
487 ;; If the line contains a comment other than the sort
488 ;; that is indented like code,
489 ;; indent it now with indent-for-comment.
490 ;; Comments indented like code are right already.
491 ;; In any case clear the in-comment flag in the state
492 ;; because parse-partial-sexp never sees the newlines.
493 (if (parse-state-in-comment state
) ;;(car (nthcdr 4 state))
494 (progn (indent-for-comment)
496 (setf (parse-state-in-comment state
) nil
))) ;;(setcar (nthcdr 4 state) nil)))
497 ;; If this line ends inside a string,
498 ;; go straight to next line, remaining within the inner loop,
499 ;; and turn off the \-flag.
500 (if (parse-state-in-string state
) ;;(car (nthcdr 3 state))
503 (setf (parse-state-in-string state
) nil
));;(setf (car (nthcdr 5 state)) nil))
504 (setq inner-loop-done t
)))
508 (setq indent-stack
(nconc indent-stack
509 (make-list (- next-depth
) :initial-element nil
))
510 last-depth
(- last-depth next-depth
)
512 (or outer-loop-done endpos
513 (setq outer-loop-done
(<= next-depth
0)))
517 (while (> last-depth next-depth
)
518 (setq indent-stack
(cdr indent-stack
)
519 last-depth
(1- last-depth
)))
520 (while (< last-depth next-depth
)
521 (setq indent-stack
(cons nil indent-stack
)
522 last-depth
(1+ last-depth
)))
523 ;; Now go to the next line and indent it according
524 ;; to what we learned from parsing the previous one.
527 (skip-whitespace-forward)
528 ;; But not if the line is blank, or just a comment
529 ;; (except for double-semi comments; indent them as usual).
530 (if (or (eobp) (looking-at "\\w|\\n")) ;; FIXME: used to be "\\s<|\\n"
533 (if (and (car indent-stack
)
534 (>= (car indent-stack
) 0))
535 (setq this-indent
(car indent-stack
))
536 (let ((val (calculate-lisp-indent
537 (if (car indent-stack
) (- (car indent-stack
))
540 (setq this-indent val
)
542 (setf (car indent-stack
)
543 (setq this-indent val
))
545 (setf (car indent-stack
) (- (car (cdr val
))))
546 (setq this-indent
(car val
)))))))
547 (if (and this-indent
(/= (current-column) this-indent
))
548 (progn (delete-region bol
(point))
549 (indent-to this-indent
)))))))
551 (setq outer-loop-done
(= (point) last-point
))
552 (setq last-point
(point)))))))
554 (defun lisp-indent-region (start end
)
555 "Indent every line whose first char is between START and END inclusive."
557 (let ((endmark (copy-marker end
)))
559 (and (bolp) (not (eolp))
561 (indent-sexp endmark
)
562 (set-marker endmark nil
))))
564 (defun eval-defun-1 (form)
565 "Treat some expressions specially.
566 Reset the `defvar' and `defcustom' variables to the initial value.
567 Reinitialize the face according to the `defface' specification."
568 ;; The code in edebug-defun should be consistent with this, but not
569 ;; the same, since this gets a macroexpended form.
570 (cond ((not (listp form
))
572 ((and (eq (car form
) 'defvar
)
573 (cdr-safe (cdr-safe form
))
574 (boundp (cadr form
)))
575 ;; Force variable to be re-set.
576 `(progn (defvar ,(nth 1 form
) nil
,@(nthcdr 3 form
))
577 (setf ,(nth 1 form
) ,(nth 2 form
)))) ;; used to be setq-default
578 ;; `defcustom' is now macroexpanded to
579 ;; `custom-declare-variable' with a quoted value arg.
580 ((and (eq (car form
) 'custom-declare-variable
)
581 (boundp (eval (nth 1 form
)))) ;; used to be default-boundp
582 ;; Force variable to be bound.
583 ;; XXX: we can't handle defcustom
584 ;;(set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form))))
586 ;; `defface' is macroexpanded to `custom-declare-face'.
587 ((eq (car form
) 'custom-declare-face
)
589 ;; XXX: what do we do with this?
590 ;; (setq face-new-frame-defaults
591 ;; (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults))
592 ;; (put (eval (nth 1 form)) 'face-defface-spec nil)
593 ;; ;; Setting `customized-face' to the new spec after calling
594 ;; ;; the form, but preserving the old saved spec in `saved-face',
595 ;; ;; imitates the situation when the new face spec is set
596 ;; ;; temporarily for the current session in the customize
597 ;; ;; buffer, thus allowing `face-user-default-spec' to use the
598 ;; ;; new customized spec instead of the saved spec.
599 ;; ;; Resetting `saved-face' temporarily to nil is needed to let
600 ;; ;; `defface' change the spec, regardless of a saved spec.
601 ;; (prog1 `(prog1 ,form
602 ;; (put ,(nth 1 form) 'saved-face
603 ;; ',(get (eval (nth 1 form)) 'saved-face))
604 ;; (put ,(nth 1 form) 'customized-face
606 ;; (put (eval (nth 1 form)) 'saved-face nil))
608 ((eq (car form
) 'progn
)
609 (cons 'progn
(mapcar 'eval-defun-1
(cdr form
))))
612 (defcommand eval-defun-2
()
613 "Evaluate defun that point is in or before.
614 The value is displayed in the minibuffer.
615 If the current defun is actually a call to `defvar',
616 then reset the variable using the initial value expression
617 even if the variable already has some other value.
618 \(Normally `defvar' does not change the variable's value
619 if it already has a value.\)
621 With argument, insert value in current buffer after the defun.
622 Return the result of evaluation."
623 (let* ((*debug-on-error
* *eval-expression-debug-on-error
*)
624 (*print-length
* *eval-expression-print-length
*)
625 (*print-level
* *eval-expression-print-level
*)
626 ;; FIXME: accum the eval/compiler output and i guess do
627 ;; something with it, cept in this case we don't.
628 (*debug-io
* (make-string-output-stream))
629 (*standard-output
* *debug-io
*)
630 (*error-output
* *debug-io
*))
632 ;; FIXME: In gnu emacs eval-region handles recording which file defines
633 ;; a function or variable. How do we do that in CL?
635 (let ( ;;XXX (standard-output t)
637 ;; Read the form from the buffer, and record where it ends.
642 (setq form
(read-from-buffer))
644 ;; Alter the form if necessary. FIXME: we don't macroexpand
645 ;; but really we want to macroexpand down to defvar (and
646 ;; friends) which could be several layers of expansion
647 ;; down. We don't want to go all the way since defvar is
649 (setq form
(eval-defun-1 form
;; (macroexpand form)
653 (defcommand eval-defun
((edebug-it)
655 "Evaluate the top-level form containing point, or after point.
657 If the current defun is actually a call to `defvar' or `defcustom',
658 evaluating it this way resets the variable using its initial value
659 expression even if the variable already has some other value.
660 \(Normally `defvar' and `defcustom' do not alter the value if there
663 If `eval-expression-debug-on-error' is non-nil, which is the default,
664 this command arranges for all errors to enter the debugger.
666 With a prefix argument, instrument the code for Edebug.
668 If acting on a `defun' for FUNCTION, and the function was
669 instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not
670 instrumented, just FUNCTION is printed.
672 If not acting on a `defun', the result of evaluation is displayed in
673 the minibuffer. This display is controlled by the variables
674 `eval-expression-print-length' and `eval-expression-print-level',
677 (declare (ignore edebug-it
))
680 ;; (eval-defun (not edebug-all-defs)))
682 (if (null *eval-expression-debug-on-error
*)
684 (let ((old-value (gensym "t")) new-value value
)
685 (let ((*debug-on-error
* old-value
))
686 (setq value
(eval-defun-2))
687 (setq new-value
*debug-on-error
*))
688 (unless (eq old-value new-value
)
689 (setq *debug-on-error
* new-value
))
693 (provide :lice-0.1
/lisp-mode
)